10
20
30 :
40 DIM ctrl% 31,name% 39,pal% 15:X%=ctrl%:Y%=X%DIV256
50 IF HIMEM>&FFFF:DIM mem% &8000 ELSE mem%=&3000
60 INPUT"Screen to compress: "f1$
70 INPUT"Screen mode: "m%
80 INPUT"File to save as: "f2$
90 PRINT'" (RETURN to optimise)":VDU11,11
100 REPEATINPUT"Number of passes: "p%:UNTILp%<9 AND p%>-1
110 PRINT:IF HIMEM<&FFFF:MODEm%
120 ON ERROR REPORT:PROCClose_All:PRINT:END
130 IF LEFT$(f1$,1)="*":OSCLI f1$ ELSE OSCLI"LOAD "+f1$+" "+STR$~mem%
140 IF HIMEM<&FFFF:m%=FNfx(135,0)DIV256
150 FOR x%=0 TO 15:pal%?x%=FNpal(x%) AND 15:NEXT x%
160 IF m%=0:colours%=2 ELSE IF m%=1:colours%=4 ELSE colours%=16
170 IF HIMEM>&FFFF:FOR x%=0 TO colours%-1:PRINT "Palette ";x%;": ";:INPUT ""A%:pal%?x%=A%:NEXT x%
180 IF colours%>8:?mem%=pal%?8+16*pal%?9:mem%?1=pal%?10+16*pal%?11:mem%?2=pal%?12+16*pal%?13:mem%?3=pal%?14+16*pal%?15
190 IF p%=0:p%=FNpasses:IF p%=0:PRINT"Screen not compressable":END
200 OSCLI"SAVE "+f2$+" "+STR$~mem%+"+5000 "+STR$~p%+"0000 FFFF3000"
210 out%=OPENOUT(f2$)
220 ext%=FNsquash(p%,out%)
230 CLOSE#out%:out%=0
240 load%=&FFFF3000
250 IF colours%>4:load%=pal%?4 OR 8*pal%?5 OR 64*pal%?6 OR 512*pal%?7 OR &FFFF3000
260 X%!2=load%:A%=FNfile(f2$,2):IF p%=8:p%=3
270 exec%=(p%-1)*&10000 OR m%*&1000 OR 512*pal%?3 OR 64*pal%?2 OR 8*pal%?1 OR pal%?0
280 X%!6=exec%:A%=FNfile(f2$,3)
290 CLS:PRINT"Compression done."'"Reduced size: &";~ext%;" (";ext%;" bytes)"
300 END
310 :
320 DEFFNsquash(p%,o%)
330 ext%=0:start%=mem%:pass%=p%
340 REPEAT:addr%=start%:start%=start%+1
350 REPEAT:b%=?addr%:n%=0:REPEAT
360 addr%=addr%+p%:n%=n%+1:IF o%:?(addr%-p%)=0
370 UNTIL ?addr%<>b% OR addr%-mem%>&4FFF OR n%=256:IF n%=256:n%=0
380 ext%=ext%+2:IF o%:BPUT#out%,b%:BPUT#out%,n%
390 UNTIL addr%-mem%>&4FFF:pass%=pass%-1
400 UNTIL pass%=0
410 =ext%
420 :
430 DEFFNpasses
440 size%=&5000:p%=0:FOR try%=1 TO 8
450 IF HIMEM>&FFFF:PRINT"Trying passes: ";try%;
460 ext%=FNsquash(try%,0)
470 IF ext%<size%:size%=ext%:p%=try%
480 IF HIMEM>&FFFF:PRINT" - size: ";ext%
490 IF try%=2:try%=3 ELSE IF try%=4:try%=7
500 NEXT try%:=p%
510 :
520 DEFFNfx(A%,X%):LOCAL Y%:Y%=X%DIV256:=((USR&FFF4)AND&FFFF00)DIV256
530 DEFFNpal(A%):?X%=A%:A%=11:CALL &FFF1:=X%?1
540 DEFFNfile(A$,A%):$name%=A$:?X%=name%:X%?1=name%DIV256:=(USR&FFDD)AND&FF
550 DEFPROCClose_All
560 out%=out%:IFout%:A%=out%:out%=0:CLOSE#A%
570 ENDPROC