Initial revision
[ssr] / StraySrc / Libraries / Steel / s / bbc
1 ;
2 ; bbc.s
3 ;
4 ; Low-level graphics and mouse/keyboard handling
5 ;
6 ; © 1994-1998 Straylight
7 ;
8
9 ;----- Licensing note -------------------------------------------------------
10 ;
11 ; This file is part of Straylight's Steel library.
12 ;
13 ; Steel is free software; you can redistribute it and/or modify
14 ; it under the terms of the GNU General Public License as published by
15 ; the Free Software Foundation; either version 2, or (at your option)
16 ; any later version.
17 ;
18 ; Steel is distributed in the hope that it will be useful,
19 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ; GNU General Public License for more details.
22 ;
23 ; You should have received a copy of the GNU General Public License
24 ; along with Steel. If not, write to the Free Software Foundation,
25 ; 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
26
27 ;----- Standard stuff -------------------------------------------------------
28
29 GET libs:header
30 GET libs:swis
31
32 AREA |C$$Code|,CODE,READONLY
33
34 ;----- VDU and character output ---------------------------------------------
35
36 ; --- bbc_vdu ---
37 ;
38 ; On entry: a1 == a character to output
39
40 EXPORT bbc_vdu
41 bbc_vdu SWI XOS_WriteC
42 MOVVC a1,#0
43 MOVS pc,lr
44
45 ; --- bbc_vduw ---
46 ;
47 ; On entry: a1 == halfword to output
48
49 EXPORT bbc_vduw
50 bbc_vduw SWI XOS_WriteC
51 MOVVC a1,a1,LSR #8
52 SWIVC XOS_WriteC
53 MOVVC a1,#0
54 MOVS pc,lr
55
56 ; --- bbc_vduq ---
57 ;
58 ; On entry: APCS args contain bytes to output
59
60 bbc__vduqTable DCB 1,2,1,1,1,1,1,1
61 DCB 1,1,1,1,1,1,1,1
62 DCB 1,2,3,6,1,1,2,10
63 DCB 9,6,1,1,5,5,1,3
64
65 EXPORT bbc_vduq
66 bbc_vduq ROUT
67
68 STMFD sp!,{a2-a4} ;Stack extra args
69 ADR a2,bbc__vduqTable ;Point to the table
70 CMP a1,#' ' ;Is the char a control char?
71 MOVGE a2,#1 ;Yes -- only one in the queue
72 LDRLTB a2,[a2,a1] ;No -- load queue length
73 MOV a3,sp ;Point to queue on the stack
74
75 00bbc_vduq SWI XOS_WriteC ;Write the character out
76 ADDVS sp,sp,#12 ;If it failed, reclaim stack
77 MOVVSS pc,lr ;And quit right this second
78 SUBS a2,a2,#1 ;Decrement the byte counter
79 LDRGT a1,[a3],#4 ;If more, get another byte
80 BGT %00bbc_vduq ;And print that one too
81
82 ADD sp,sp,#12 ;Bump the stack back again
83 MOV a1,#0 ;No error returned
84 MOVS pc,lr ;Return to the caller
85
86 ; --- bbc_stringprint ---
87 ;
88 ; On entry: a1 == pointer to a NULL-terminated string
89
90 EXPORT bbc_stringprint
91 bbc_stringprint SWI XOS_Write0
92 MOVVC a1,#0
93 MOVS pc,lr
94
95 ; --- bbc_cls ---
96 ;
97 ; On entry: --
98
99 EXPORT bbc_cls
100 bbc_cls SWI XOS_WriteI+12
101 MOVVC a1,#0
102 MOVS pc,lr
103
104 ; --- bbc_colour ---
105 ;
106 ; On entry: a1 == text colour to set
107
108 EXPORT bbc_colour
109 bbc_colour SWI XOS_WriteI+17
110 SWIVC XOS_WriteC
111 MOVVC a1,#0
112 MOVS pc,lr
113
114 ; --- bbc_pos ---
115 ;
116 ; On entry: --
117 ; On exit: a1 == x coord of text cursor
118
119 EXPORT bbc_pos
120 bbc_pos MOV a1,#&86
121 SWI XOS_Byte
122 MOV a1,a2
123 MOVS pc,lr
124
125 ; --- bbc_vpos ---
126 ;
127 ; On entry: --
128 ; On exit: a1 == y coord of text cursor
129
130 EXPORT bbc_vpos
131 bbc_vpos MOV a1,#&86
132 SWI XOS_Byte
133 MOV a1,a3
134 MOVS pc,lr
135
136 ; --- bbc_tab ---
137 ;
138 ; On entry: a1 == x coordinate to move to
139 ; a2 == y coordinate to move to
140
141 EXPORT bbc_tab
142 bbc_tab SWI XOS_WriteI+31
143 SWIVC XOS_WriteC
144 MOVVC a1,a2
145 SWIVC XOS_WriteC
146 MOVVC a1,#0
147 MOVS pc,lr
148
149 ;----- Graphics output ------------------------------------------------------
150
151 ; --- bbc_plot ---
152 ;
153 ; On entry: a1 == plot code number
154 ; a2 == x coordinate to plot at
155 ; a3 == y coordinate to plot at
156
157 EXPORT bbc_plot
158 bbc_plot SWI XOS_Plot
159 MOVVC a1,#0
160 MOVS pc,lr
161
162 ; --- bbc_mode ---
163 ;
164 ; On entry: a1 == new mode number to set
165
166 EXPORT bbc_mode
167 bbc_mode SWI XOS_WriteI+22
168 SWIVC XOS_WriteC
169 MOVVC a1,#0
170 MOVS pc,lr
171
172 ; --- bbc_move ---
173 ;
174 ; On entry: a1 == x coordinate to move to
175 ; a2 == y coordinate to move to
176
177 EXPORT bbc_move
178 bbc_move MOV a3,a2
179 MOV a2,a1
180 MOV a1,#4
181 SWI XOS_Plot
182 MOVVC a1,#0
183 MOVS pc,lr
184
185 ; --- bbc_moveby ---
186 ;
187 ; On entry: a1 == x offset to move to
188 ; a2 == y offset to move to
189
190 EXPORT bbc_moveby
191 bbc_moveby MOV a3,a2
192 MOV a2,a1
193 MOV a1,#0
194 SWI XOS_Plot
195 MOVVC a1,#0
196 MOVS pc,lr
197
198 ; --- bbc_draw ---
199 ;
200 ; On entry: a1 == x coordinate to draw to
201 ; a2 == y coordinate to draw to
202
203 EXPORT bbc_draw
204 bbc_draw MOV a3,a2
205 MOV a2,a1
206 MOV a1,#5
207 SWI XOS_Plot
208 MOVVC a1,#0
209 MOVS pc,lr
210
211 ; --- bbc_drawby ---
212 ;
213 ; On entry: a1 == x offset to draw to
214 ; a2 == y offset to draw to
215
216 EXPORT bbc_drawby
217 bbc_drawby MOV a3,a2
218 MOV a2,a1
219 MOV a1,#1
220 SWI XOS_Plot
221 MOVVC a1,#0
222 MOVS pc,lr
223
224 ; --- bbc_rectangle ---
225 ;
226 ; On entry: a1 == bottom left x coordinate
227 ; a2 == bottom left y coordinate
228 ; a3 == rectangle width
229 ; a4 == rectangle height
230
231 EXPORT bbc_rectangle
232 bbc_rectangle MOV ip,a3 ;Look after rectangle width
233 MOV a3,a2
234 MOV a2,a1
235 MOV a1,#4
236 SWI XOS_Plot
237 MOVVC a1,#9
238 MOVVC a2,ip
239 MOVVC a3,#0
240 SWIVC XOS_Plot
241 MOVVC a1,#9
242 MOVVC a2,#0
243 MOVVC a3,a4
244 SWIVC XOS_Plot
245 MOVVC a1,#9
246 RSBVC a2,ip,#0
247 MOVVC a3,#0
248 SWIVC XOS_Plot
249 MOVVC a1,#9
250 MOVVC a2,#0
251 RSBVC a3,a4,#0
252 SWIVC XOS_Plot
253 MOVVC a1,#0
254 MOVS pc,lr
255
256 ; --- bbc_rectanglefill ---
257 ;
258 ; On entry: a1 == bottom left x coordinate
259 ; a2 == bottom left y coordinate
260 ; a3 == rectangle width
261 ; a4 == rectangle height
262
263 EXPORT bbc_rectanglefill
264 bbc_rectanglefill
265 MOV ip,a3
266 MOV a3,a2
267 MOV a2,a1
268 MOV a1,#4
269 SWI XOS_Plot
270 MOVVC a1,#&61 ;Rectangle plot relative
271 MOVVC a2,ip
272 MOVVC a3,a4
273 SWIVC XOS_Plot
274 MOVVC a1,#0
275 MOVS pc,lr
276
277 ; --- bbc_circle ---
278 ;
279 ; On entry: a1 == x coordinate of centre
280 ; a2 == y coordinate of centre
281 ; a3 == radius of circle
282
283 EXPORT bbc_circle
284 bbc_circle MOV a4,a3
285 MOV a3,a2
286 MOV a2,a1
287 MOV a1,#4
288 SWI XOS_Plot
289 MOVVC a1,#&91
290 MOVVC a2,a4
291 MOVVC a3,#0
292 SWIVC XOS_Plot
293 MOVVC a1,#0
294 MOVS pc,lr
295
296 ; --- bbc_circlefill ---
297 ;
298 ; On entry: a1 == x coordinate of centre
299 ; a2 == y coordinate of centre
300 ; a3 == radius of circle
301
302 EXPORT bbc_circlefill
303 bbc_circlefill MOV a4,a3
304 MOV a3,a2
305 MOV a2,a1
306 MOV a1,#4
307 SWI XOS_Plot
308 MOVVC a1,#&99
309 MOVVC a2,a4
310 MOVVC a3,#0
311 SWIVC XOS_Plot
312 MOVVC a1,#0
313 MOVS pc,lr
314
315 ; --- bbc_origin ---
316 ;
317 ; On entry: a1 == x coordinate to move origin to
318 ; a2 == x coordinate to move origin to
319
320 EXPORT bbc_origin
321 bbc_origin SWI XOS_WriteI+29
322 SWIVC XOS_WriteC
323 MOVVC a1,a1,LSR #8
324 SWIVC XOS_WriteC
325 MOVVC a1,a2
326 SWIVC XOS_WriteC
327 MOVVC a1,a1,LSR #8
328 SWIVC XOS_WriteC
329 MOVVC a1,#0
330 MOVS pc,lr
331
332 ; --- bbc_gwindow ---
333 ;
334 ; On entry: a1 == bottom left x coord
335 ; a2 == bottom left y coord
336 ; a3 == top right x coord
337 ; a4 == top right y coord
338
339 EXPORT bbc_gwindow
340 bbc_gwindow SWI XOS_WriteI+24
341 SWIVC XOS_WriteC
342 MOVVC a1,a1,LSR #8
343 SWIVC XOS_WriteC
344 MOVVC a1,a2
345 SWIVC XOS_WriteC
346 MOVVC a1,a1,LSR #8
347 SWIVC XOS_WriteC
348 MOVVC a1,a3
349 SWIVC XOS_WriteC
350 MOVVC a1,a1,LSR #8
351 SWIVC XOS_WriteC
352 MOVVC a1,a4
353 SWIVC XOS_WriteC
354 MOVVC a1,a1,LSR #8
355 SWIVC XOS_WriteC
356 MOVVC a1,#0
357 MOVS pc,lr
358
359 ; --- bbc_clg ---
360 ;
361 ; On entry: --
362
363 EXPORT bbc_clg
364 bbc_clg SWI XOS_WriteI+16
365 MOVVC a1,#0
366 MOVS pc,lr
367
368 ; --- bbc_fill ---
369 ;
370 ; On entry: a1 == x coordinate to fill from
371 ; a2 == y coordinate to fill from
372 ;
373 ; WARNING: this call uses the OS flood-fill, which is (or at least used to
374 ; be) very badly broken. Use with care, or crash horribly. We may change
375 ; to use our own flood fill algorithm some day, but don't hold your breath.
376
377 EXPORT bbc_fill
378 bbc_fill MOV a3,a2
379 MOV a2,a1
380 MOV a1,#&85
381 SWI XOS_Plot
382 MOVVC a1,#0
383 MOVS pc,lr
384
385 ; --- bbc_gcol ---
386 ;
387 ; On entry: a1 == gcol action
388 ; a2 == gcol value
389
390 EXPORT bbc_gcol
391 bbc_gcol SWI XOS_WriteI+18
392 SWIVC XOS_WriteC
393 MOVVC a1,a2
394 SWIVC XOS_WriteC
395 MOVVC a1,#0
396 MOVS pc,lr
397
398 ; --- bbc_tint ---
399 ;
400 ; On entry: a1 == tint action (what colour to set)
401 ; a2 == tint value
402
403 EXPORT bbc_tint
404 bbc_tint SWI XOS_WriteI+23 ;1
405 ANDVC a1,a1,#&03
406 SWIVC XOS_WriteC ;2
407 MOVVC a1,a2,LSL #6
408 ANDVC a1,a1,#&C0
409 SWIVC XOS_WriteC ;3
410 SWIVC XOS_WriteI+0 ;4
411 SWIVC XOS_WriteI+0 ;5
412 SWIVC XOS_WriteI+0 ;6
413 SWIVC XOS_WriteI+0 ;7
414 SWIVC XOS_WriteI+0 ;8
415 SWIVC XOS_WriteI+0 ;9
416 SWIVC XOS_WriteI+0 ;10
417 MOVVC a1,#0
418 MOVS pc,lr
419
420 ; --- bbc_palette ---
421 ;
422 ; On entry: a1 == logical colour to remap
423 ; a2 == physical colour to assign
424 ; a3 == red level to assign
425 ; a4 == green level to assign
426 ; [sp] == blue level to assign
427
428 EXPORT bbc_palette
429 bbc_palette SWI XOS_WriteI+19
430 SWIVC XOS_WriteC
431 MOVVC a1,a2
432 SWIVC XOS_WriteC
433 MOVVC a1,a3
434 SWIVC XOS_WriteC
435 MOVVC a1,a4
436 SWIVC XOS_WriteC
437 LDRVC a1,[sp]
438 SWIVC XOS_WriteC
439 MOVVC a1,#0
440 MOVS pc,lr
441
442 ; --- bbc_point ---
443 ;
444 ; On entry: a1 == x coordinate of point to read
445 ; a2 == y coordinate of point to read
446 ; On exit; a1 == logical colour at the point, or &FF if not on-screen
447 ;
448 ; NOTE: The RISC_OSLib version is utterly buggered. For no known reason,
449 ; the fools decided to pass parameters in wholewords rather than OS_Word's
450 ; own inimitable halfwords, meaning that RISC_OSLib's bbc_point invariably
451 ; returns 0. We side-step the entire issue by using OS_ReadPoint instead.
452
453 EXPORT bbc_point
454 bbc_point MOV ip,v1
455 SWI XOS_ReadPoint
456 MOV v1,ip
457 MOVVS a1,#&FF
458 ANDVC a1,a3,#&FF
459 MOVS pc,lr
460
461 ; --- bbc_vduvar ---
462 ;
463 ; On entry: a1 == variable number to read
464 ; On exit: a1 == variable value read
465
466 EXPORT bbc_vduvar
467 bbc_vduvar MOV a2,#-1 ;Terminator for input array
468 STMFD sp!,{a1-a3} ;Store on stack, with output
469 MOV a1,sp ;Point to the input array
470 ADD a2,a1,#8 ;Point to output word
471 SWI XOS_ReadVduVariables ;Read the variable's value
472 ADD sp,sp,#8 ;Point sp at the value
473 LDMIA sp!,{a1} ;Read the value
474 MOVS pc,lr
475
476 ; --- bbc_vduvars ---
477 ;
478 ; On entry: a1 == pointer to input array
479 ; a2 == pointer to output array
480
481 EXPORT bbc_vduvars
482 bbc_vduvars SWI XOS_ReadVduVariables
483 MOVVC a1,#0
484 MOVS pc,lr
485
486 ; --- bbc_modevar ---
487 ;
488 ; On entry: a1 == mode number to read variable for
489 ; a2 == variable number
490 ; On exit: a1 == variable value
491
492 EXPORT bbc_modevar
493 bbc_modevar SWI XOS_ReadModeVariable
494 MOV a1,a3
495 MOVS pc,lr
496
497 ;----- Keyboard handling ----------------------------------------------------
498
499 ; --- bbc_get ---
500 ;
501 ; On entry: --
502 ; On exit: a1 == key code read, bit 8 set if escape condition
503
504 EXPORT bbc_get
505 bbc_get SWI XOS_ReadC
506 ORRCS a1,a1,#&100
507 MOVS pc,lr
508
509 ; --- bbc_inkey ---
510 ;
511 ; On entry: a1 == time to wait, or -ve inkey number
512
513 EXPORT bbc_inkey
514 bbc_inkey MOV a3,a1,LSR #8
515 AND a3,a3,#&FF
516 AND a2,a1,#&FF
517 MOV a1,#&81
518 SWI XOS_Byte
519 CMP a3,#&FF
520 MOVEQ a1,#-1
521 MOVNE a1,a2
522 MOVS pc,lr
523
524 ; --- bbc_cursor ---
525 ;
526 ; On entry: a1 == new text cursor mode
527
528 EXPORT bbc_cursor
529 bbc_cursor SWI XOS_WriteI+23 ;1
530 SWIVC XOS_WriteI+1 ;2
531 SWIVC XOS_WriteC ;3
532 SWIVC XOS_WriteI+0 ;4
533 SWIVC XOS_WriteI+0 ;5
534 SWIVC XOS_WriteI+0 ;6
535 SWIVC XOS_WriteI+0 ;7
536 SWIVC XOS_WriteI+0 ;8
537 SWIVC XOS_WriteI+0 ;9
538 SWIVC XOS_WriteI+0 ;10
539 MOVVC a1,#0
540 MOVS pc,lr
541
542 ;----- Mouse handling -------------------------------------------------------
543
544 ; --- bbc_mouse ---
545 ;
546 ; On entry: a1 == where to put x coordinate
547 ; a2 == where to put y coordinate
548 ; a3 == where to put button status
549 ; a4 == where to put time of click
550
551 EXPORT bbc_mouse
552 bbc_mouse STMFD sp!,{v1-v4,lr}
553 MOV v1,a1
554 MOV v2,a2
555 MOV v3,a3
556 MOV v4,a4
557 SWI XOS_Mouse
558 LDMVSFD sp!,{v1-v4,pc}^
559 CMP v1,#0
560 STRNE a1,[v1]
561 CMP v2,#0
562 STRNE a2,[v2]
563 CMP v3,#0
564 STRNE a3,[v3]
565 CMP v4,#0
566 STRNE a4,[v4]
567 MOV a1,#0
568 LDMFD sp!,{v1-v4,pc}^
569
570 ; --- bbc_mouserect ---
571 ;
572 ; On entry: a1 == mouse rectangle bottom left x coord
573 ; a2 == mouse rectangle bottom left y coord
574 ; a3 == mouse rectangle top right x coord
575 ; a4 == mouse rectangle top right y coord
576
577 EXPORT bbc_mouserect
578 bbc_mouserect SUB sp,sp,#12
579 MOV ip,#1
580 STRB ip,[sp,#0]
581 MOV ip,a1
582 STRB ip,[sp,#1]
583 MOV ip,a1,LSR #8
584 STRB ip,[sp,#2]
585 MOV ip,a2
586 STRB ip,[sp,#3]
587 MOV ip,a2,LSR #8
588 STRB ip,[sp,#4]
589 MOV ip,a3
590 STRB ip,[sp,#5]
591 MOV ip,a3,LSR #8
592 STRB ip,[sp,#6]
593 MOV ip,a4
594 STRB ip,[sp,#7]
595 MOV ip,a4,LSR #8
596 STRB ip,[sp,#8]
597 MOV a1,#21
598 MOV a2,sp
599 SWI XOS_Word
600 ADD sp,sp,#12
601 MOVVC a1,#0
602 MOVS pc,lr
603
604 ;----- Strangeness ----------------------------------------------------------
605
606 ; --- bbc_adval ---
607 ;
608 ; NOTE: Since I don't have a clue about what the RISC_OSLib version's trying
609 ; to do, although at a guess it's utterly wrong. I'll just do it properly.
610 ;
611 ; On entry: a1 == reason code for OS_Byte 128
612 ; On exit: a1 == output of OS_Byte 128
613
614 EXPORT bbc_adval
615 bbc_adval AND a2,a1,#&FF
616 MOV a1,#&80
617 SWI XOS_Byte
618 MOVVS a1,#&80000000
619 ORRVC a1,a2,a3,LSL #8
620 MOVS pc,lr
621
622 ;----- Messing about with sound ---------------------------------------------
623
624 ; --- bbc_getbeat ---
625 ;
626 ; On entry: --
627 ; On exit: a1 == current beat value
628
629 EXPORT bbc_getbeat
630 bbc_getbeat MOV a1,#0
631 SWI XSound_QBeat
632 MOVS pc,lr
633
634 ; --- bbc_getbeats ---
635 ;
636 ; On entry: --
637 ; On exit: a1 == previous bar length
638
639 EXPORT bbc_getbeats
640 bbc_getbeats MOV a1,#-1
641 SWI XSound_QBeat
642 MOVS pc,lr
643
644 ; --- bbc_gettempo ---
645 ;
646 ; On entry: --
647 ; On exit: a1 == tempo for beat counter
648
649 EXPORT bbc_gettempo
650 bbc_gettempo MOV a1,#0
651 SWI XSound_QTempo
652 MOVS pc,lr
653
654 ; --- bbc_setbeats ---
655 ;
656 ; On entry: a1 == new bar length
657
658 EXPORT bbc_setbeats
659 bbc_setbeats SWI XSound_QBeat
660 MOVVC a1,#0
661 MOVS pc,lr
662
663 ; --- bbc_settempo ---
664 ;
665 ; On entry: a1 == new tempo for beat counter
666
667 EXPORT bbc_settempo
668 bbc_settempo SWI XSound_QTempo
669 MOVVC a1,#0
670 MOVS pc,lr
671
672 ; --- bbc_sound ---
673 ;
674 ; On entry: a1 == channel number
675 ; a2 == amplitude of noise to make
676 ; a3 == pitch to make the noise
677 ; a4 == duration of noise
678 ; [sp] == time to make the noise, or -2 for `right now'
679
680 EXPORT bbc_sound
681 bbc_sound ROUT
682
683 LDR ip,[sp] ;Get the time to make noise
684 CMP ip,#-2 ;Do we make noises right now?
685 BEQ %00bbc_sound ;Yes -- deal with that case
686
687 ORR a4,a3,a4,LSL #16 ;Pack the arguments up
688 ORR a3,a1,a2,LSL #16
689 MOV a1,ip ;Get the time to schedule
690 MOV a2,#0 ;Use Sound_ControlPacked
691 SWI XSound_QSchedule ;Schedule the noise nicely
692 MOVVC a1,#0
693 MOVS pc,lr
694
695 00bbc_sound SWI XSound_Control ;Just make a noise now
696 MOVVS a1,#0
697 MOVS pc,lr
698
699 ; --- bbc_soundoff ---
700 ;
701 ; On entry: --
702
703 EXPORT bbc_soundoff
704 bbc_soundoff MOV a1,#1
705 SWI XSound_Enable
706 MOVVC a1,#0
707 MOVS pc,lr
708
709 ; --- bbc_soundon ---
710 ;
711 ; On entry: --
712
713 EXPORT bbc_soundon
714 bbc_soundon MOV a1,#2
715 SWI XSound_Enable
716 MOVVC a1,#0
717 MOVS pc,lr
718
719 ; --- bbc_stereo ---
720 ;
721 ; On entry: a1 == channel to set position of
722 ; a2 == new stereo position of channel
723
724 EXPORT bbc_stereo
725 bbc_stereo SWI XSound_Stereo
726 MOVVC a1,#0
727 MOVS pc,lr
728
729 ; --- bbc_voices ---
730 ;
731 ; On entry: a1 == number of voices to set
732
733 EXPORT bbc_voices
734 bbc_voices MOV ip,v1
735 MOV a2,#0
736 MOV a3,#0
737 MOV a4,#0
738 MOV v1,#0
739 SWI XSound_Configure
740 MOV v1,ip
741 MOVVC a1,#0
742 MOVS pc,lr
743
744 ;----- That's all, folks ----------------------------------------------------
745
746 END