home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 120 / 120.d81 / compressor (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  6KB  |  184 lines
  1. 5 rem *******************************
  2. 6 rem *
  3. 7 rem *   initialize stuff
  4. 8 rem *
  5. 9 rem *******************************
  6. 10 poke56,56:clr:rem lower basic
  7. 20 dv=peek(186):ifdv<8thendv=8:rem check for device #
  8. 30 poke53281,0:poke53280,0:print"[147]the compressor":ad=36864:mo=36608:co=49152
  9. 40 rem ad=address of toolbox,mo=routine to move color memory of koala pic
  10. 50 rem co=routine that compresses pic
  11. 59 rem ****load ml routines****
  12. 60 sys57812"toolbox 9000",dv,0:poke780,0:poke781,0:poke782,144:sys65493
  13. 61 sysad+30,"comp font",dv,56*256:poke53272,31
  14. 62 sysad+30,"dir 4000",dv,4*4096
  15. 70 sysad+30,"shp compressor",dv,co
  16. 81 rem *******************************
  17. 82 rem *
  18. 83 rem * get choice from main menu
  19. 84 rem *
  20. 85 rem *******************************
  21. 90 ifjj=0thengosub440:rem print main menu
  22. 100 sysad+21,160:sys ad+48,8,11,31,3,3+128,129,0:onf%gosub110,640,310:goto100
  23. 101 rem ******************************
  24. 102 rem *
  25. 103 rem *     compress pic
  26. 104 rem *
  27. 105 rem ******************************
  28. 110 sysad+15,7,24,9,20,255,11
  29. 115 sys ad,"$:*=p",dv,53248,8,8,10,13,1:rem choose pic from directory
  30. 120 iff$=""thenreturn:rem stop pressed, then return to main menu
  31. 130 ifleft$(f$,2)="dd"orleft$(f$,4)="rph."thenty=0:sys ad+30,f$,dv,23552:goto150
  32. 135 ifright$(f$,4)="mpic"thenty=2:sys ad+30,f$,dv,24576:goto150:rem adv. ocp
  33. 136 ifright$(f$,3)="pic"thenty=1:sys ad+30,f$,dv,24576:goto150:rem ocp art stdio
  34. 137 ifleft$(f$,3)="pi."thenty=4:sys ad+30,f$,dv,24576:goto150
  35. 138 ifleft$(f$,2)="p-"thenty=5:sys ad+30,f$,dv,24576:goto150
  36. 140 ty=3:sysad+30,f$,dv,24576:rem koala
  37. 150 sys ad+72,3,27,4,6:rem shadow window
  38. 160 sys ad+15,4,28,3,5,160,7:rem open window
  39. 170 sys ad+24,5,4,"[158]save file? [146]            "
  40. 180 sys ad+24,16,4,""
  41. 190 sys ad+66,5,5,12:rem get save filename
  42. 200 ifw$=""thenreturn:rem no file? return to main menu
  43. 210 s$=w$+".shp,p,w":rem add .shp extension to filename
  44. 211 sys ad+72,9,18,3,6
  45. 212 sys ad+15,10,19,2,5,160,3
  46. 213 sys ad+24,11,3,"optimize"
  47. 214 sys ad+24,11,4," normal "
  48. 215 sys ad+48,3,11,18,2,3,7,0
  49. 216 op=0
  50. 217 iff%=1thenop=1
  51. 220 a5=peek(53265):poke53265,a5or32:rem bitmap mode
  52. 230 a0=peek(53270):ifty>1thenpoke53270,a0or16:rem multi-color mode
  53. 240 a2=peek(53272):poke53272,120:rem color(screen) memory
  54. 250 a6=peek(56576):poke56576,(a6and252)or2:rem bitmap location
  55. 260 ifty=0then270
  56. 261 on ty gosub 292,295,297,299,301
  57. 270 close15:open 15,dv,15:open 2,dv,2,s$:input#15,e,e$,t,s:ife<>0then370
  58. 280 rem *****open save file, store compressed pic with sys co*****
  59. 290 sys co,op:input#15,e,e$,t,s:ife<>0then370
  60. 291 close2:gosub410:return:rem close file, return to main menu
  61. 292 sys ad+60,32576,33576,23552:return
  62. 295 sys ad+60,32576,33576,23552:sys ad+60,33592,34592,55296
  63. 296 poke53281,peek(33577):return
  64. 297 sys ad+60,32576,33576,23552:sys ad+60,33576,34576,55296
  65. 298 poke53281,peek(34576):return
  66. 299 sys ad+60,32768,33768,23552:sys ad+60,33792,34792,55296
  67. 300 poke53281,peek(32640):return
  68. 301 sys ad+60,32768,33768,23552:sys ad+60,33792,34792,55296
  69. 302 poke53281,peek(34815):return
  70. 305 rem *****************************
  71. 306 rem *
  72. 307 rem *  return to loadstar
  73. 308 rem *
  74. 309 rem *****************************
  75. 310 poke56,40960/256:clr:rem reset basic pointer
  76. 320 a$="hello connect":fori=8to9:close2:open2,i,2:close2:ifstthen340
  77. 330 close15:open15,i,15,"r0:"+a$+"="+a$:input#15,er:close15:ifer=63then350
  78. 340 next:print"[147]":poke186,8:end
  79. 350 poke646,peek(53281):print"[147]load"chr$(34)a$chr$(34)","i
  80. 360 print"run":poke631,13:poke632,13:poke198,2:end
  81. 361 rem ******************************
  82. 362 rem *
  83. 363 rem * print disk error, return to
  84. 364 rem * main menu
  85. 365 rem *
  86. 366 rem ******************************
  87. 370 close2:gosub410:printe;e$;t;s:print"press a key to continue"
  88. 380 close15:rem error
  89. 390 poke198,0:wait198,1:geta$:print"[147]":goto90
  90. 400 rem *****************************
  91. 401 rem *
  92. 402 rem * restore text screen
  93. 403 rem *
  94. 404 rem *****************************
  95. 410 poke53265,a5:poke53270,a0:poke53272,a2:poke56576,a6
  96. 420 poke53281,0:poke53280,0:print"[147]":return
  97. 430 rem *****************************
  98. 431 rem *
  99. 432 rem *   print main menu
  100. 433 rem *
  101. 434 rem *****************************
  102. 440 print"[147]":sysad+15,0,39,0,0,100,1:sysad+15,0,39,1,1,160,7
  103. 442 sysad+15,0,39,2,2,99,5:print"[158]";:sysad+27,1,"[211] [212] [193] [210]   [195] [207][160][205] [208] [210][160][197][160][211] [211][160][207] [210]"
  104. 450 sys ad+15,2,37,5,19,128,15:sysad+15,2,37,4,4,93,7:sysad+15,2,37,20,20,94,7
  105. 452 sysad+15,1,1,5,19,91,7:sysad+15,38,38,5,19,92,7
  106. 454 print"[146][158]";:sysad+24,1,4,"[176]":sysad+24,38,4,"[174]":sysad+24,1,20,"[173]"
  107. 456 sysad+24,38,20,"[189]"
  108. 460 sys ad+15,9,31,7,13,255,11
  109. 470 sysad+15,10,32,6,12,160,5:sys ad+15,11,31,7,11,160,3
  110. 480 sysad+24,12,8,"[159][195]ompress [208]ic"
  111. 490 sys ad+24,12,9,"[211]end [196]isk [195]ommands"
  112. 500 sys ad+24,12,10,"[210]eturn [212]o [204][207][193][196][211][212][193][210]"
  113. 505 rem *******shp compressor******
  114. 510 printchr$(159):sysad+24,0,10,""
  115. 610 sys ad+27,23,"[195][210][211][210]/[210][197][212][213][210][206] [212]o [211]elect"
  116. 620 jj=1:sysad+18,160:return
  117. 630 rem ******************************
  118. 631 rem *
  119. 632 rem *  dos commands
  120. 633 rem *
  121. 634 rem ******************************
  122. 640 gosub2000:sysad+21,160
  123. 650 sys ad+15,4,24,9,15,255,11
  124. 660 sys ad+15,5,25,8,14,160,7:sysad+15,6,24,9,13,160,5:print"";
  125. 680 sys ad+24,7,9,"[211]cratch [198]ile"
  126. 690 sys ad+24,7,10,"[210]ename [198]ile"
  127. 700 sys ad+24,7,11,"[201]nitialize [196]rive"
  128. 710 sys ad+24,7,12,"[214]iew [196]irectory"
  129. 720 sys ad+24,7,13,"[205]ain [205]enu"
  130. 730 sys ad+48,9,6,24,5,5,1,0
  131. 740 onf%gosub760,1060,1030,990:return
  132. 750 rem ****scratch file****
  133. 760 sysad+72,3,24,14,19
  134. 770 sys ad+15,4,25,13,18,160,4
  135. 780 printchr$(156);chr$(18);
  136. 790 sys ad+24,8,14,"put disk with"
  137. 800 sys ad+24,5,15,"file to be scratched"
  138. 810 sys ad+24,10,16,"into drive"
  139. 820 sys ad+24,8,17,"(press return)"
  140. 830 geta$:ifa$<>chr$(13)then830
  141. 840 sys ad+72,19,35,4,17
  142. 850 sys ad,"$:*",dv,53248,20,3,10,5,1
  143. 860 iff$=""thenreturn
  144. 870 sys ad+72,10,27,5,10
  145. 880 sys ad+15,11,28,4,9,160,3
  146. 890 l=int((18-len(f$))/2)
  147. 900 sys ad+24,l+11,5,f$
  148. 910 printchr$(158)
  149. 920 sys ad+24,13,7,"   scratch   "
  150. 930 sys ad+24,13,8,"don't scratch"
  151. 940 sys ad+48,7,13,25,2,7,1,0
  152. 950 iff%=2thenreturn
  153. 960 sys ad+42,"s:"+f$,dv
  154. 970 return
  155. 980 rem ******directory******
  156. 990 sys ad+72,5,22,5,18
  157. 1000 print"[147][159]":poke186,dv:pokee53272,23:sys4*4096:print:print"[208]ress [210][197][212][213][210][206]"
  158. 1010 wait197,1:poke198,0:poke53272,31:return
  159. 1020 rem ******initialize disk******
  160. 1030 sys ad+42,"i0:",dv
  161. 1040 return
  162. 1050 rem ******rename file******
  163. 1060 sys ad+15,19,38,8,23,255,11
  164. 1070 sys ad+24,20,7,"[159]                    "
  165. 1080 sys ad+24,20,8,"[159]  file to rename?   "
  166. 1090 sys ad,"$:*",dv,53248,20,9,10,3,1
  167. 1100 iff$=""thenreturn
  168. 1110 sys ad+72,3,31,5,7
  169. 1120 sys ad+15,4,32,4,6,160,12
  170. 1130 sys ad+24,5,5,"[152]rename to? [129]                "
  171. 1140 sys ad+24,16,5,""
  172. 1150 sys ad+66,5,3,16
  173. 1155 ifw$=""thenreturn
  174. 1160 sys ad+42,"r:"+w$+"="+f$,dv
  175. 1170 return
  176. 2000 sysad+15,30,35,4,14,255,11:sysad+15,31,36,3,13,160,13:print"[153]";
  177. 2010 fori=0to8:sysad+24,32,4+i,str$(8+i):next
  178. 2015 poke781,23:sys59903:poke199,0:sysad+27,23,"[208]lease [211]elect [196]esired [196]rive"
  179. 2020 sysad+48,4,32,35,9,13,1,0:dv=f%+7:close2:open2,dv,2:close2
  180. 2030 ifstthen2020
  181. 2040 sysad+21,160:return
  182. 10000 close15:open15,8,15,"s:compressor":save"compressor",8:input#15,a,a$
  183. 10010 print:printa$:close15:end
  184.