home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 64 / 064.d81 / tod.pal (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  3KB  |  197 lines
  1. 100 rem open2,8,1,"tod baby.o"
  2. 110 sys700
  3. 120 ;
  4. 130 .opt oo
  5. 140 ;
  6. 150 status = $90
  7. 160 buffer = $0200
  8. 170 frmevl = $ad9e
  9. 180 getcomma = $aefd
  10. 190 illquan = $b248
  11. 200 irqvec = $314
  12. 210 ;
  13. 220 ;
  14. 230 jmp hook ;
  15. 240 jmp drop ;
  16. 250 ;
  17. 260 current .byte 0,0,0,0
  18. 270 values .byte 0,0,0,0
  19. 280 ;
  20. 290 ;---------------------
  21. 300 ;
  22. 310 fbyte jsr getcomma ;
  23. 320 jsr frmevl ;
  24. 330 jmp $b1aa ;
  25. 340 ;
  26. 350 ;
  27. 360 hook = *
  28. 370 jsr fbyte ; fetch column number
  29. 380 sty column ;
  30. 390 ;
  31. 400 jsr fbyte ; fetch row number
  32. 410 sty row ;
  33. 420 ;
  34. 430 jsr fbyte ; fetch color value
  35. 440 sty color ;
  36. 450 ;
  37. 460 jsr getcomma ; fetch 'print using'
  38. 470 jsr frmevl ;  string/deal/baby
  39. 480 jsr 46755 ;
  40. 490 ;
  41. 500 cmp #9 ;
  42. 510 bcc hypno ;
  43. 520 jmp $a571 ;
  44. 530 ;
  45. 540 hypno sta length ; save baby's leng
  46. 550 ;
  47. 560 lda row ; see if row is legal
  48. 570 cmp #25 ;
  49. 580 bcs ohno ;
  50. 590 clc ;
  51. 600 lda length ; exit if length = 0
  52. 610 beq ohno ;
  53. 620 adc column ; if length+column>40
  54. 630 cmp #41 ;  then exit this baby
  55. 640 bcc allok ;  else life (NULL)es on
  56. 650 ohno jmp illquan ;
  57. 660 ;
  58. 670 allok = *
  59. 680 ldy #0 ; init most sig. byte
  60. 690 lda #0 ; init least sig. byte
  61. 700 ldx row ; fetch row count
  62. 710 beq suit ; exit if on row zero
  63. 720 ;
  64. 730 silk clc ;
  65. 740 adc #40 ;
  66. 750 bcc sharp ;
  67. 760 iny ;
  68. 770 sharp dex ;
  69. 780 bne silk ;
  70. 790 ;
  71. 800 suit clc ;
  72. 810 adc column ;
  73. 820 sta $fb ;
  74. 830 sta $fd ;
  75. 840 tya ;
  76. 850 php ;
  77. 860 adc 648 ;
  78. 870 sta $fc ;
  79. 880 tya ;
  80. 890 plp ;
  81. 900 adc #$d8 ;
  82. 910 sta $fe ;
  83. 920 ;
  84. 930 ldx #3 ; zero-out the tod baby
  85. 940 lda #0 ;
  86. 950 gsl sta $dd08,x ;
  87. 960 sta values,x ;
  88. 970 dex ;
  89. 980 bpl gsl ;
  90. 990 ;
  91. 1000 lda #>myirq ; do not re-install
  92. 1010 cmp irqvec+1 ;  my baby
  93. 1020 bne notmine ;
  94. 1030 rts ;
  95. 1040 ;
  96. 1050 notmine php ; save int status
  97. 1060 sei ;
  98. 1070 ldx irqvec+1 ; install my baby
  99. 1080 stx oldirq+1 ;  and preserve old
  100. 1090 sta irqvec+1 ;  vector at the
  101. 1100 lda #<myirq ;  same time
  102. 1110 ldx irqvec ;
  103. 1120 stx oldirq ;
  104. 1130 sta irqvec ;
  105. 1140 plp ;
  106. 1150 rts ;
  107. 1160 ;
  108. 1170 ;------------------------
  109. 1180 ;
  110. 1190 drop = *
  111. 1200 lda irqvec+1 ; exit if not my irq
  112. 1210 cmp #>myirq ;
  113. 1220 bne getback ;
  114. 1230 php ;
  115. 1240 sei ;
  116. 1250 lda oldirq ; restore old irq vec
  117. 1260 sta irqvec ;
  118. 1270 lda oldirq+1 ;
  119. 1280 sta irqvec+1 ;
  120. 1290 plp ;
  121. 1300 getback rts ;
  122. 1310 ;
  123. 1320 ;-----------------------
  124. 1330 ;
  125. 1340 myirq = *
  126. 1350 php ;
  127. 1360 sei ;
  128. 1370 ldx #3 ; copy tod reg's to
  129. 1380 acdc lda $dd08,x ;  local buffer
  130. 1390 sta current,x ;
  131. 1400 dex ;
  132. 1410 bpl acdc ;
  133. 1420 ;
  134. 1430 ldx #3 ; compare with old values
  135. 1440 tears lda current,x ;
  136. 1450 cmp values,x ;
  137. 1460 bne tcb ;
  138. 1470 dex ;
  139. 1480 bne tears ;
  140. 1490 plp ; process old irq if the time
  141. 1500 jmp (oldirq) ;  hasn't changed
  142. 1510 ;
  143. 1520 tcb ldx #3 ; new values now become
  144. 1530 cheap lda current,x ;  the old
  145. 1540 sta values,x ;  values!
  146. 1550 dex ;
  147. 1560 bpl cheap ;
  148. 1570 ;
  149. 1580 ldy length ;
  150. 1590 dey ;
  151. 1600 lda values+1 ; handle seconds
  152. 1610 jsr commonl ;
  153. 1620 bmi exit ;
  154. 1630 lda values+1 ;
  155. 1640 and #$7f ;
  156. 1650 jsr commonu ;
  157. 1660 bmi exit ;
  158. 1670 lda #$3a ; print a colon
  159. 1680 jsr commonok ;
  160. 1690 bmi exit ;
  161. 1700 lda values+2 ; handle minutes
  162. 1710 jsr commonl ;
  163. 1720 bmi exit ;
  164. 1730 lda values+2 ;
  165. 1740 and #$7f ;
  166. 1750 jsr commonu ;
  167. 1760 bmi exit ;
  168. 1770 lda #$3a ; print a colon
  169. 1780 jsr commonok ;
  170. 1790 bmi exit ;
  171. 1800 lda values+3 ; handle hours
  172. 1810 jsr commonl ;
  173. 1820 bmi exit ;
  174. 1830 lda values+2 ;
  175. 1840 and #$1f ;
  176. 1850 jsr commonu ;
  177. 1860 exit plp ;
  178. 1870 jmp (oldirq) ;
  179. 1880 ;
  180. 1890 commonu lsr a ;
  181. 1900 lsr a ;
  182. 1910 lsr a ;
  183. 1920 lsr a ;
  184. 1930 ;
  185. 1940 commonl and #15 ;
  186. 1950 ora #$30 ;
  187. 1960 commonok sta ($fb),y ;
  188. 1970 lda color ;
  189. 1980 sta ($fd),y ;
  190. 1990 dey ;
  191. 2000 rts ;
  192. 2010 color *=*+1
  193. 2020 row *=*+1
  194. 2030 column *=*+1
  195. 2040 length *=*+1
  196. 2050 oldirq *=*+2
  197.