home *** CD-ROM | disk | FTP | other *** search
/ Transactor / Transactor_09_1986_Transactor_Publishing.d64 / comp2.pal (.txt) < prev    next >
Commodore BASIC  |  2023-02-26  |  5KB  |  233 lines
  1. 100 sys 700 ;activate pal 64 assembler
  2. 110 ; picture compressor
  3. 120 ; optimizes hi-res pic
  4. 130 ; and saves on disk
  5. 140 ; this version saves from memory
  6. 150 ; at $2000:
  7. 160 ;  sys(*),"d:filename"
  8. 170 ; or loads to load addr:
  9. 180 ;  sys(*+3),"filename"
  10. 190 ;
  11. 200 ; save"@0:comp2.pal",8
  12. 210 ;
  13. 220 .opt oo
  14. 230 *=$c000
  15. 240 ;
  16. 250 jmp compress
  17. 260 jmp decomp
  18. 270 ;
  19. 280 picture  .word $2000 ;bitmap loc'n
  20. 290 repcount .byte 1 ;counts repetition
  21. 300 newbyt   .byte 0 ;current mem byte
  22. 310 prevbyt  .byte 0 ;previous byte
  23. 320 sendflag .byte 0 ;comp/decomp flag
  24. 330 banksav  .byte 0 ;orig loc 1 value
  25. 340 endpic   .word 0 ;end of bitmap
  26. 350 ;
  27. 360 piclen  =8000   ;bitmap byte length
  28. 370 picptr  =$fb
  29. 380 ;kernel routines:
  30. 390 setlfs =$ffba
  31. 400 setnam =$ffbd
  32. 410 open   =$ffc0
  33. 420 chrout =$ffd2
  34. 430 getin  =$ffe4
  35. 440 close  =$ffc3
  36. 450 chkout =$ffc9
  37. 460 chkin  =$ffc6
  38. 470 clrchn =$ffcc
  39. 480 readst =$ffb7
  40. 490 ;
  41. 500 compress =*
  42. 510 lda #1
  43. 520 sta sendflag
  44. 530 ldy #1       ;secondary address
  45. 540 bne cp1
  46. 550 ;
  47. 560 decomp =*
  48. 570 lda #0
  49. 580 sta sendflag
  50. 590 ldy #2       ;secondary address
  51. 600 cp1 =*
  52. 610 ;
  53. 620 lda 1        ;bank select reg
  54. 630 sta banksav  ;store for later
  55. 640 lda #8       ;file #8
  56. 650 tax          ;device #8
  57. 660 jsr setlfs   ;open 8,8,1 or 2
  58. 670 jsr $aefd    ;check for comma
  59. 680 jsr $ad9e    ;evaluate expression
  60. 690 jsr $ad8f    ;check for string
  61. 700 ldy #0
  62. 710 lda ($64),y  ;string length
  63. 720 pha: iny
  64. 730 lda ($64),y  ;string addr low
  65. 740 tax: iny
  66. 750 lda ($64),y  ;string addr hi
  67. 760 tay: pla
  68. 770 jsr setnam   ;filename=above string
  69. 780 jsr open     ;open file
  70. 790 ldx #8       ;file #8 for chkin/out
  71. 800 ;
  72. 810 ldy #0
  73. 820 lda sendflag ;compress or load
  74. 830 beq nosnd    ;nosnd=load
  75. 840 jsr chkout   ;output to file
  76. 850 lda picture
  77. 860 jsr chrout   ;start addr lo
  78. 870 lda picture+1
  79. 880 jsr chrout   ;start addr hi
  80. 890 jsr sendpic  ;send picture to file
  81. 900 jmp ss1      ;close files and exit
  82. 910 nosnd =*
  83. 920 jsr chkin    ;get load addr first
  84. 930 jsr getin
  85. 940 sta picptr   ;load addr lo
  86. 950 jsr getin
  87. 960 sta picptr+1 ;load addr hi
  88. 970 jsr getpic   ;get picture
  89. 980 ss1 =*
  90. 990 ;
  91. 1000 jsr clrchn   ;clear i/o channels
  92. 1010 lda #8
  93. 1020 jsr close    ;close file #8
  94. 1030 rts          ;all finished!
  95. 1040 ;
  96. 1050 ;
  97. 1060 sendpic =*   ;compress picture
  98. 1070 lda picture  ;start addr lo
  99. 1080 sta picptr
  100. 1090 clc
  101. 1100 adc #<piclen ;find last pic byte
  102. 1110 sta endpic   ;last byte lo
  103. 1120 lda picture+1
  104. 1130 sta picptr+1 ;start addr hi
  105. 1140 adc #>piclen
  106. 1150 sta endpic+1 ;last byte hi
  107. 1160 ;
  108. 1170 jsr getbyt   ;read byte from mem
  109. 1180 sta prevbyt  ;initialize prev byte
  110. 1190 ldy #1       ;get 2nd byte next
  111. 1200 ;
  112. 1210 nextout =*
  113. 1220 jsr outbyte  ;fetch byte or group
  114. 1230 ;
  115. 1240 lda picptr+1 ;see if at pic end
  116. 1250 cmp endpic+1
  117. 1260 bne sp1
  118. 1270 lda picptr
  119. 1280 cmp endpic
  120. 1290 bcc nextout  ;do next byte
  121. 1300 rts
  122. 1310 sp1 =*
  123. 1320 bcc nextout  ;do next byte
  124. 1330 jsr writerep ;write last group
  125. 1340 rts          ;all bytes done
  126. 1350 ;
  127. 1360 ;
  128. 1370 outbyte =*   ;check next byte
  129. 1380 jsr getbyt   ;read byte from mem
  130. 1390 sta newbyt
  131. 1400 cmp prevbyt  ;compare to previous
  132. 1410 bne diff     ;different"?
  133. 1420 ;
  134. 1430 inc repcount ;same, inc count
  135. 1440 bne ok       ;[177]255 repetiti[145]s"?
  136. 1450 dec repcount ;set to 255
  137. 1460 jsr writerep ;write repeat code
  138. 1470 lda #1       ;restart count
  139. 1480 sta repcount
  140. 1490 ok =*
  141. 1500 jmp obfin    ;finished outbyte
  142. 1510 ;
  143. 1520 diff =*      ;new byte different
  144. 1530 lda repcount ;check count
  145. 1540 cmp #4       ;3 or more the same"?
  146. 1550 bcs docode   ;yes, s[128] rep code
  147. 1560 ;no, just [153] byte n times
  148. 1570 tax          ;# reps [129] loop
  149. 1580 lda prevbyt  ;byte [164] repeat
  150. 1590 cmp #254     ;ctrl byte"?
  151. 1600 beq docode   ;yes, must code it
  152. 1610 ;
  153. 1620 nlp =*       ;repeat loop
  154. 1630 lda prevbyt
  155. 1640 jsr chrout   ;send byte
  156. 1650 dex          ;do .x times
  157. 1660 bne nlp
  158. 1670 lda #1       ;restart count
  159. 1680 sta repcount
  160. 1690 jmp obfin    ;finished subrtn
  161. 1700 ;
  162. 1710 docode =*    ;write repeat code
  163. 1720 jsr writerep
  164. 1730 lda #1       ;restart count
  165. 1740 sta repcount
  166. 1750 ;
  167. 1760 obfin =*
  168. 1770 lda newbyt
  169. 1780 sta prevbyt  ;prev=new
  170. 1790 inc picptr   ;next address
  171. 1800 bne ob1
  172. 1810 inc picptr+1
  173. 1820 ob1 =*
  174. 1830 rts
  175. 1840 ;
  176. 1850 ;
  177. 1860 writerep =*  ;write repeat code
  178. 1870 lda #254     ;special control byte
  179. 1880 jsr chrout
  180. 1890 lda prevbyt  ;byte to repeat
  181. 1900 jsr chrout
  182. 1910 lda repcount ;number of reps
  183. 1920 jsr chrout
  184. 1930 rts
  185. 1940 ;
  186. 1950 ;
  187. 1960 getbyt =*
  188. 1970 sei          ;disable interrupts
  189. 1980 lda 1        ;cpu bank register
  190. 1990 and #$fc     ;select ram
  191. 2000 sta 1
  192. 2010 lda (picptr),y ;read byte
  193. 2020 pha
  194. 2030 lda banksav  ;get original state
  195. 2040 sta 1        ;and restore
  196. 2050 cli
  197. 2060 pla
  198. 2070 rts
  199. 2080 ;
  200. 2090 ;
  201. 2100 getpic =*    ;uncompress
  202. 2110 jsr getin
  203. 2120 cmp #254     ;rep indicator
  204. 2130 beq getrep
  205. 2140 ;normal byte, just store it
  206. 2150 sta (picptr),y
  207. 2160 inc picptr   ;next address
  208. 2170 bne gr0
  209. 2180 inc picptr+1
  210. 2190 gr0 =*
  211. 2200 jmp gpfin
  212. 2210 ;
  213. 2220 getrep =*
  214. 2230 jsr getin    ;byte to repeat
  215. 2240 pha
  216. 2250 jsr getin    ;# of repetitions
  217. 2260 tax
  218. 2270 pla
  219. 2280 replp =*     ;repeat byte n times
  220. 2290 sta (picptr),y
  221. 2300 inc picptr   ;next address
  222. 2310 bne gr1
  223. 2320 inc picptr+1
  224. 2330 gr1 =*
  225. 2340 dex
  226. 2350 bne replp
  227. 2360 ;
  228. 2370 gpfin =*
  229. 2380 jsr readst   ;read disk status
  230. 2390 beq getpic   ;do until end-of-file
  231. 2400 rts
  232. 2410 .end
  233.