home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Loadstar 64
/
064.d81
/
tod.pal
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-08-26
|
3KB
|
197 lines
100 rem open2,8,1,"tod baby.o"
110 sys700
120 ;
130 .opt oo
140 ;
150 status = $90
160 buffer = $0200
170 frmevl = $ad9e
180 getcomma = $aefd
190 illquan = $b248
200 irqvec = $314
210 ;
220 ;
230 jmp hook ;
240 jmp drop ;
250 ;
260 current .byte 0,0,0,0
270 values .byte 0,0,0,0
280 ;
290 ;---------------------
300 ;
310 fbyte jsr getcomma ;
320 jsr frmevl ;
330 jmp $b1aa ;
340 ;
350 ;
360 hook = *
370 jsr fbyte ; fetch column number
380 sty column ;
390 ;
400 jsr fbyte ; fetch row number
410 sty row ;
420 ;
430 jsr fbyte ; fetch color value
440 sty color ;
450 ;
460 jsr getcomma ; fetch 'print using'
470 jsr frmevl ; string/deal/baby
480 jsr 46755 ;
490 ;
500 cmp #9 ;
510 bcc hypno ;
520 jmp $a571 ;
530 ;
540 hypno sta length ; save baby's leng
550 ;
560 lda row ; see if row is legal
570 cmp #25 ;
580 bcs ohno ;
590 clc ;
600 lda length ; exit if length = 0
610 beq ohno ;
620 adc column ; if length+column>40
630 cmp #41 ; then exit this baby
640 bcc allok ; else life (NULL)es on
650 ohno jmp illquan ;
660 ;
670 allok = *
680 ldy #0 ; init most sig. byte
690 lda #0 ; init least sig. byte
700 ldx row ; fetch row count
710 beq suit ; exit if on row zero
720 ;
730 silk clc ;
740 adc #40 ;
750 bcc sharp ;
760 iny ;
770 sharp dex ;
780 bne silk ;
790 ;
800 suit clc ;
810 adc column ;
820 sta $fb ;
830 sta $fd ;
840 tya ;
850 php ;
860 adc 648 ;
870 sta $fc ;
880 tya ;
890 plp ;
900 adc #$d8 ;
910 sta $fe ;
920 ;
930 ldx #3 ; zero-out the tod baby
940 lda #0 ;
950 gsl sta $dd08,x ;
960 sta values,x ;
970 dex ;
980 bpl gsl ;
990 ;
1000 lda #>myirq ; do not re-install
1010 cmp irqvec+1 ; my baby
1020 bne notmine ;
1030 rts ;
1040 ;
1050 notmine php ; save int status
1060 sei ;
1070 ldx irqvec+1 ; install my baby
1080 stx oldirq+1 ; and preserve old
1090 sta irqvec+1 ; vector at the
1100 lda #<myirq ; same time
1110 ldx irqvec ;
1120 stx oldirq ;
1130 sta irqvec ;
1140 plp ;
1150 rts ;
1160 ;
1170 ;------------------------
1180 ;
1190 drop = *
1200 lda irqvec+1 ; exit if not my irq
1210 cmp #>myirq ;
1220 bne getback ;
1230 php ;
1240 sei ;
1250 lda oldirq ; restore old irq vec
1260 sta irqvec ;
1270 lda oldirq+1 ;
1280 sta irqvec+1 ;
1290 plp ;
1300 getback rts ;
1310 ;
1320 ;-----------------------
1330 ;
1340 myirq = *
1350 php ;
1360 sei ;
1370 ldx #3 ; copy tod reg's to
1380 acdc lda $dd08,x ; local buffer
1390 sta current,x ;
1400 dex ;
1410 bpl acdc ;
1420 ;
1430 ldx #3 ; compare with old values
1440 tears lda current,x ;
1450 cmp values,x ;
1460 bne tcb ;
1470 dex ;
1480 bne tears ;
1490 plp ; process old irq if the time
1500 jmp (oldirq) ; hasn't changed
1510 ;
1520 tcb ldx #3 ; new values now become
1530 cheap lda current,x ; the old
1540 sta values,x ; values!
1550 dex ;
1560 bpl cheap ;
1570 ;
1580 ldy length ;
1590 dey ;
1600 lda values+1 ; handle seconds
1610 jsr commonl ;
1620 bmi exit ;
1630 lda values+1 ;
1640 and #$7f ;
1650 jsr commonu ;
1660 bmi exit ;
1670 lda #$3a ; print a colon
1680 jsr commonok ;
1690 bmi exit ;
1700 lda values+2 ; handle minutes
1710 jsr commonl ;
1720 bmi exit ;
1730 lda values+2 ;
1740 and #$7f ;
1750 jsr commonu ;
1760 bmi exit ;
1770 lda #$3a ; print a colon
1780 jsr commonok ;
1790 bmi exit ;
1800 lda values+3 ; handle hours
1810 jsr commonl ;
1820 bmi exit ;
1830 lda values+2 ;
1840 and #$1f ;
1850 jsr commonu ;
1860 exit plp ;
1870 jmp (oldirq) ;
1880 ;
1890 commonu lsr a ;
1900 lsr a ;
1910 lsr a ;
1920 lsr a ;
1930 ;
1940 commonl and #15 ;
1950 ora #$30 ;
1960 commonok sta ($fb),y ;
1970 lda color ;
1980 sta ($fd),y ;
1990 dey ;
2000 rts ;
2010 color *=*+1
2020 row *=*+1
2030 column *=*+1
2040 length *=*+1
2050 oldirq *=*+2