home *** CD-ROM | disk | FTP | other *** search
/ Transactor / Transactor_09_1986_Transactor_Publishing.d64 / comp1.pal (.txt) < prev    next >
Commodore BASIC  |  2023-02-26  |  3KB  |  179 lines
  1. 100 sys700    ;enable pal 64
  2. 110 ;
  3. 120 ; picture compressor -
  4. 130 ; optimizes hi-res picture
  5. 140 ; and saves on disk
  6. 150 ; this version converts file#8 (r)
  7. 160 ; to file#9 (w) with same load addr
  8. 170 ;  sys(*)   compresses 8 to 9
  9. 180 ;  sys(*+3) loads 8 to memory
  10. 190 ;
  11. 200 ;save"@0:comp1.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 repcount .byte 1
  20. 290 newbyt   .byte 0
  21. 300 prevbyt  .byte 0
  22. 310 st8      .byte 0
  23. 320 ;
  24. 330 picptr  =$fb
  25. 340 ;kernel routines:
  26. 350 chrout =$ffd2
  27. 360 getin  =$ffe4
  28. 370 close  =$ffc3
  29. 380 chkout =$ffc9
  30. 390 chkin  =$ffc6
  31. 400 clrchn =$ffcc
  32. 410 readst =$ffb7
  33. 420 ;
  34. 430 compress =*
  35. 440 jsr setin
  36. 450 jsr getin   ;start addr lo
  37. 460 jsr setout
  38. 470 jsr chrout
  39. 480 jsr setin
  40. 490 jsr getin   ;start addr hi
  41. 500 jsr setout
  42. 510 jsr chrout
  43. 520 jsr sendpic ;send picture to file
  44. 530 jmp fin
  45. 540 ;
  46. 550 decomp =*
  47. 560 jsr setin
  48. 570 jsr getin: sta picptr ;load addr lo
  49. 580 jsr getin: sta picptr+1 ;"  "  hi
  50. 590 ldy #0
  51. 600 jsr getpic  ;get picture
  52. 610 ;
  53. 620 fin =*
  54. 630 jsr clrchn
  55. 640 lda #8: jsr close
  56. 650 lda #9: jsr close
  57. 660 rts
  58. 670 ;
  59. 680 ;
  60. 690 sendpic =*
  61. 700 jsr setin
  62. 710 jsr getin
  63. 720 sta prevbyt
  64. 730 nextout =*
  65. 740 jsr outbyte
  66. 750 lda st8
  67. 760 beq nextout
  68. 770 jsr writerep ;last sequence
  69. 780 rts
  70. 790 ;
  71. 800 ;
  72. 810 outbyte =*
  73. 820 jsr setin
  74. 830 jsr getin
  75. 840 pha
  76. 850 jsr readst: sta st8 ;save status
  77. 860 pla
  78. 870 sta newbyt
  79. 880 cmp prevbyt
  80. 890 bne diff
  81. 900 ;
  82. 910 inc repcount
  83. 920 bne ok       ;count past 255"?
  84. 930 dec repcount
  85. 940 jsr writerep ;write rep code
  86. 950 ok [178][172]
  87. 960 jmp obfin
  88. 970 ;
  89. 980 d[139]f [178][172]    ;[162] byte d[139]ferent
  90. 990 lda repcount
  91. 1000 cmp #6
  92. 1010 bcs docode ;m[176]e than 4 the same"?
  93. 1020 ;no, just print byte n times
  94. 1030 tax        ;# reps for loop
  95. 1040 lda prevbyt
  96. 1050 cmp #254   ;ctrl byte"?
  97. 1060 beq docode ;yes, have [164] code it
  98. 1070 ;
  99. 1080 jsr se[164]ut
  100. 1090 lda prevbyt
  101. 1100 nlp [178][172]
  102. 1110 jsr chrout
  103. 1120 dex
  104. 1130 bne nlp
  105. 1140 lda #1: sta repcount
  106. 1150 jmp obfin
  107. 1160 ;
  108. 1170 docode [178][172]
  109. 1180 jsr writerep
  110. 1190 ;
  111. 1200 obfin [178][172]
  112. 1210 lda [162]byt
  113. 1220 sta prevbyt
  114. 1230 rts
  115. 1240 ;
  116. 1250 ;
  117. 1260 writerep [178][172]  ;write repeat code
  118. 1270 jsr se[164]ut
  119. 1280 lda #254     ;special [154]rol byte
  120. 1290 jsr chrout
  121. 1300 lda prevbyt  ;byte [164] repeat
  122. 1310 jsr chrout
  123. 1320 lda repcount ;number of reps
  124. 1330 jsr chrout
  125. 1340 lda #1
  126. 1350 sta repcount ;re[171]initialize count
  127. 1360 rts
  128. 1370 ;
  129. 1380 ;
  130. 1390 [161]pic [178][172]    ;uncompress
  131. 1400 jsr [161]in
  132. 1410 cmp #254     ;rep indica[164]r
  133. 1420 beq [161]rep
  134. 1430 ;n[176]mal byte, just s[164]re it
  135. 1440 jsr s[164]rbyt
  136. 1450 jmp gpfin
  137. 1460 ;
  138. 1470 [161]rep [178][172]    ;repeat byte n times
  139. 1480 jsr [161]in    ;byte [164] repeat
  140. 1490 pha
  141. 1500 jsr [161]in    ;# of repetiti[145]s
  142. 1510 tax
  143. 1520 pla
  144. 1530 replp [178][172]
  145. 1540 jsr s[164]rbyt  ;stick it in mem[176]y
  146. 1550 dex
  147. 1560 bne replp    ;do it .x times
  148. 1570 ;
  149. 1580 gpfin [178][172]
  150. 1590 jsr [135]st   ;check disk status
  151. 1600 beq [161]pic   ;do until [128][171]of[171]file
  152. 1610 rts
  153. 1620 ;
  154. 1630 ;
  155. 1640 s[164]rbyt [178][172]   ;put .a in mem[176]y
  156. 1650 sta (picptr),y
  157. 1660 inc picptr   ;inc[143]ent pointer
  158. 1670 bne sb0
  159. 1680 inc picptr[170]1
  160. 1690 sb0 [178][172]
  161. 1700 rts
  162. 1710 ;
  163. 1720 ;
  164. 1730 setin [178][172] ;set [133] [164] file #8
  165. 1740 pha:txa:pha
  166. 1750 ldx #8
  167. 1760 jsr chkin
  168. 1770 pla:tax:pla
  169. 1780 rts
  170. 1790 ;
  171. 1800 ;
  172. 1810 se[164]ut [178][172] ;set output [164] file #9
  173. 1820 pha:txa:pha
  174. 1830 ldx #9
  175. 1840 jsr chkout
  176. 1850 pla:tax:pla
  177. 1860 rts
  178. 1870 .[128]
  179.