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