Transactor/Transactor_14_1986_Transactor_Publishing.d64/scroll.pal

Commodore BASIC | 2023-02-26 | 7KB | 453 lines

1 rem -------------------------------
2 rem    list scroll and line rule
3 rem           scroll.s
4 rem -------------------------------
10 open 2,8,1,"0:scroll.obj"
12 rem open 4,4
14 sys 700
16 .opt o2
18 ;---
20 msgflg = 157 ;run mode
22 lstx = 197 ;last keypress
24 blnsw = 204 ;blink sw
26 gdbln = 206
28 blnon = 207
30 tblx = 214 ;line#
32 ldtb1 = 217 ;screen line links
34 txcadr = 646 ;col for text
36 gdcol = 647
38 lstshf = 654 ;last shift
40 ;---
42 *= $9d00 ;install address
44 jmp listup ;scroll up
46 jmp listdn ;scroll down
48 jmp lrule  ;line ruler
50 jmp lrkill ;kill line ruler
52 ;
54 ;vector tab for background rtns
56 ;set up by profile program
58 brstart *= *+3 ;start int rtn
60 brend *= *+3 ;end int rtn
62 ppstart *= *+3 ;start parallel rtn
64 ppexcl *= *+3 ;run exclusive
66 ppshare *= *+3 ;run shared
68 ppend *= *+3 ;end parallel rtn
70 rescur *= *+3 ;reset cursor
72 bgwork *= *+15 ;remaining jmps
74 ;
76 ;------------------------
78 ;the list scroll routines
80 ;
82 ;run time variables
84 skey = bgwork
86 sshf = skey+1
88 savel = sshf+1
90 savex = savel+1
92 savec = savex+1
94 savev = savec+2
96 first1 = savev+2
98 first2 = first1+1
100 ;
102 ;---entry from interrupt
104 listup = * ;scroll up
106 jsr liston
108 lup jsr listin
110 jsr lstup
112 jsr listout
114 beq lup
116 bne lexit
118 ;
120 ;---entry from interrupt
122 listdn = * ;scroll down
124 jsr liston
126 ldn jsr listin
128 lda #24
130 sta $d6
132 jsr $e56c
134 jsr lstdn
136 jsr listout
138 beq ldn
140 lexit jmp ppend
142 ;
144 ;---initiate parallel program
146 liston = * ;common point for up/dn
148 sty skey ;save entry key
150 stx sshf ;...and shift value
152 lda #$ff
154 sta first1
156 sta first2
158 pla ;ret addr=start of parallel prg
160 clc
162 adc #1
164 tax ;low byte
166 pla
168 adc #0
170 tay ;high byte
172 jmp ppstart ;start parallel program
174 ;
176 ;---list up
178 lstup = *
180 ldx #$ff
182 lu04 inx
184 cpx #25 ;all lines
186 beq lu12
188 lda $d9,x
190 bpl lu04 ;linked
192 jsr gnum ;get num
194 bcc lu04 ;none
196 bcs lu16
198 ;
200 lu12 lda #$ff ;high line num
202 sta $14
204 sta $15
206 lu16 jsr $a613 ;find line
208 ldy $5f ;lo byt
210 cpx $2c ;hi byt
212 bne lu20
214 cpy $2b ;with start
216 bne lu20
218 rts ;no prev lines
220 ;
222 lu20 dex ;lower
224 cpx $2c ;..than start
226 bcs lu24
228 ldx $2c ;correct
230 ldy $2b
232 dey
234 lu24 stx $40
236 sty $3f
238 ldy #0 ;search for
240 lu28 lda ($3f),y
242 beq lu36 ;end of line
244 lu32 iny
246 bne lu28
248 rts ;no more
250 ;
252 lu36 iny ;chk
254 lda ($3f),y ;link lo
256 cmp $5f
258 bne lu32 ;no match
260 iny
262 lda ($3f),y ;chk
264 cmp $60 ;link hi
266 bne lu32
268 dey
270 tya ;make match
272 clc
274 adc $3f
276 sta $5f
278 lda $40
280 adc #0
282 sta $60
284 ldx #24 ;chk last line
286 lda $d9,x
288 bmi lu40 ;not linked
290 ldx #23 ;2nd last
292 jsr $e9ff ;erase
294 lu40 ldx #0 ;to scrl dwn
296 jsr $e968
298 lda $d9
300 ora #$80 ;fix up link
302 sta $d9
304 lda #39 ;and length
306 sta $d5
308 ldx #1 ;set insrt
310 stx $292
312 dex
314 stx $d6 ;home
316 jsr $e9f0 ;position
318 jmp list
320 ;
322 ;---list down
324 lstdn = *
326 ldx #25
328 ld04 dex
330 bmi ld08 ;all lines
332 lda $d9,x
334 bpl ld04 ;linked
336 jsr gnum ;get line num
338 bcc ld04 ;none
340 bcs ld16
342 ;
344 ld08 lda #$ff ;set
346 sta $14 ;..for
348 sta $15 ;..1st line
350 ld12 pha ;save a byte
352 bne ld30
354 ld16 cpx #24 ;last
356 bne ld20
358 ld18 lda #$0d ;ret char
360 bne ld12
362 ld20 cpx #23 ;2nd last
364 bne ld24
366 inx
368 lda $d9,x
370 bpl ld18
372 ld24 lda #$ff
374 bne ld12
376 ld30 inc $14 ;lnum
378 bne ld32
380 inc $15
382 ld32 jsr $a613 ;find line
384 lda $da ;2nd line
386 bmi ld36 ;not linked
388 ora #$80 ;unlink it
390 sta $da
392 ldx #1
394 jsr $e9ff ;erase line
396 ld36 ldx #24 ;last line
398 stx $d6 ;curs row
400 jsr $e9f0 ;set curs
402 pla
404 bmi list
406 jsr $ffd2 ;print ret
408 ;
410 ;---
412 list = *
414 ldy #1
416 lda ($5f),y
418 beq ls24
420 sta savel
422 lda #0
424 sta ($5f),y ;to fool list
426 sty $f ;list qote flg
428 lda $5f
430 sta $3f
432 lda $60
434 sta $40
436 lda #$ff ;to max
438 sta $14
440 sta $15
442 jmp $a6d7 ;into list
444 ;
446 ;---
448 lserv =* ;err vec entry
450 cpx #$0b ;err from
452 beq ls32 ;..eval fxd pt
454 lda savel ;restore
456 ldy #1
458 sta ($3f),y
460 ls24 lda #$0d ;ret
462 jsr $ffd2
464 rts ;end
466 ;
468 ls32 pla:pla
470 pla:pla ;clr rtss
472 jmp ls24
474 ;
476 ;---
478 gnum = * ;get line num
480 jsr $e9f0 ;set line start addr
482 ldy #$ff
484 gn10 iny
486 lda ($d1),y
488 cpy #39
490 beq gn20+1 ;end of line
492 cmp #$20
494 beq gn10
496 cmp #$30
498 bcc gn20+1
500 cmp #$3a
502 bcs gn20+1
504 tya
506 clc
508 adc $d1
510 sta $7a
512 lda $d2
514 adc #0
516 sta $7b
518 jsr $79 ;chr(NULL)t
520 stx savex
522 jsr $a96b ;eval num to binary
524 ldx savex
526 sec
528 gn20 bit $18
530 rts
532 ;
534 ;---
536 listin = *
538 sei
540 ;
542 serv = * ;set err vect
544 lda $300
546 sta savev
548 lda $301
550 sta savev+1
552 lda #<lserv
554 sta $300
556 lda #>lserv
558 sta $301
560 ;
562 scur = * ;save cursor
564 jsr rescur ;reset cursor
566 lda #255 ;set blink off
568 sta blnsw
570 lda $d6
572 sta savec
574 lda $d3
576 sta savec+1
578 lda #0
580 sta $d3 ;column
582 cli
584 jsr ppexcl ;run exclusively
586 rts
588 ;
590 ;---
592 listout = *
594 sei
596 lda #0
598 sta $292 ;clr scroll
600 ;
602 rerv = * ;rst err vect
604 lda savev
606 sta $300
608 lda savev+1
610 sta $301
612 ;
614 rcur = * ;rst cursor
616 lda #0 ;set blink on
618 sta blnsw
620 ldx savec
622 stx $d6
624 lda savec+1
626 sta $d3
628 sec
630 sbc #40
632 bcc rcu10 ;not on 2nd
634 sta $d3
636 rcu10 jsr $e56c ;fix curs
638 ;
640 getkey = *
642 cli
644 ldy skey
646 ldx sshf
648 cpy lstx
650 bne gk40
652 cpx lstshf
654 gk40 rts
656 ;
658 ;---not used: same as rescur
660 rcurs = * ;reset cursor
662 lda blnon ;check blink
664 beq rc10
666 lda gdbln ;orig char
668 ldx gdcol ;orig colr
670 ldy #0
672 sty blnon ;clear blink
674 jsr $ea13 ;reset blink
676 rc10 rts
678 ;
680 ;*************************
682 ;
684 ;basic line ruler routine
686 ;
688 sprt = 832 ;sprite data area
690 spr = 53248 ;sprite register
692 scr = 2040 ;sprite variables
694 lrspyl = bgwork+13
696 lrspyc = bgwork+14
698 ;
700 lrule = * ;entry from interrupt
702 ldx #<ruler ;start addr of bg rtn
704 ldy #>ruler
706 jsr brstart ;start background rtn
708 bne lr30 ;resource is used!
710 ;
712 lda #0;make sprite
714 sta lrspyl
716 sta lrspyc
718 ldx #$3f
720 lr10 sta sprt,x
722 dex
724 bpl lr10
726 ldx #2
728 lda #$ff
730 lr12 sta sprt,x
732 dex
734 bpl lr12
736 ldx #2
738 lr14 sta sprt+27,x
740 dex
742 bpl lr14
744 ;
746 ldx #6
748 lda #13
750 lr20 sta scr,x ;ptrs
752 dex
754 bpl lr20
756 lda txcadr
758 jsr lr50 ;color
760 lda #$60
762 sta spr+16 ;msb x
764 sec
766 lda #216
768 ldx #8
770 lr24 sta spr,x ;x pos
772 sbc #48
774 dex
776 dex
778 bpl lr24
780 lda #8
782 sta spr+10 ;s5 x
784 lda #56
786 sta spr+12 ;s6 x
788 lda #$7f
790 sta spr+29 ;exp x
792 sta spr+21 ;enable
794 ldx #25
796 stx lrspyl
798 lr30 rts
800 ;
802 ;---kill line rule
804 lrkill = *
806 lda #0
808 sta spr+21 ;dsabl
810 jmp brend ;finish
812 ;
814 ;---
816 ruler = *
818 bit msgflg ;run
820 bpl lrkill
822 ;
824 lr40 = * ;position
826 jsr lrcolr
828 ldx tblx
830 cpx lrspyl
832 beq lr30
834 stx lrspyl
836 lda ldtb1,x
838 bmi lr42
840 dex
842 lr42 txa
844 asl a
846 asl a
848 asl a
850 clc
852 adc #49
854 ldx #12
856 lr44 sta spr+1,x ;y pos
858 dex
860 dex
862 bpl lr44
864 lda #0
866 ldx #40
868 cpx $d5 ;max
870 bcs lr46
872 lda #$7f
874 lr46 sta spr+23 ;y exp
876 jmp lr30
878 ;
880 ;---
882 lrcolr = *
884 lda txcadr
886 cmp lrspyc
888 beq lr58
890 lr50 sta lrspyc
892 ldx #6
894 lr52 sta spr+39,x ;color
896 dex
898 bpl lr52
900 lr58 rts
902 ;
904 .end