10 REM >LZSSD
   20 REM by Steven Flintham
   30 REM
   40 REM Version 1.00
   50 REM
   60 REM Tuesday 26th March 1996
   70 REM Wednesday 27th March 1996
   80 REM Wednesday 3rd April 1996
   90 REM Thursday 4th April 1996
  100 REM Monday 8th April 1996
  110 REM Wednesday 10th April 1996
  120 REM Saturday 13th April 1996
  130 :
  140 MODE 7
  150 PROCoff
  160 PROCinit1
  170 PROCload_mc
  180 PROCinit2
  190 PROCget_files
  200 PROCdecompress(input$,output$)
  210 IF FNanother GOTO 190
  220 VDU 22,7
  230 PROCenable
  240 END
  250 :
  260 DEF PROCinit1
  270 gf_status%=0
  280 ON ERROR PROCerror
  290 PROCdisable
  300 PROCtitle
  310 PRINT'"Please wait, initialising..."
  320 use_file_buffer%=TRUE
  330 DIM block% 64
  340 IF use_file_buffer% THEN DIM file_buff% 512
  350 CLOSE #0
  360 ENDPROC
  370 :
  380 DEF PROCinit2
  390 DIM workspace% 4226:REM enough workspace for 12/7 decompression
  400 ENDPROC
  410 :
  420 DEF PROCerror
  430 IF gf_status%<>0 AND ERR>=128 THEN REPORT:PRINT:GOTO 190
  440 VDU 22,7
  450 CLOSE #0
  460 PROCenable
  470 IF ERR<>17 THEN REPORT:PRINT " at line ";ERL
  480 END
  490 :
  500 DEF PROCdisable
  510 *FX4,1
  520 ENDPROC
  530 :
  540 DEF PROCenable
  550 *FX4
  560 ENDPROC
  570 :
  580 DEF PROCoff
  590 VDU 23,1,0;0;0;0;
  600 ENDPROC
  610 :
  620 DEF PROCon
  630 VDU 23,1,1;0;0;0;
  640 ENDPROC
  650 :
  660 DEF PROCload_mc
  670 LOCAL fname$,in%,base%,apply%,diff%,old%,new%,A%,X%,Y%
  680 IF use_file_buffer% THEN fname$="LZSSDFB" ELSE fname$="LZSSDFX"
  690 in%=OPENIN(fname$)
  700 IF in%=0 THEN PRINT'"Sorry, I can't find ";fname$;"."':PROCenable:END
  710 DIM code% FNword(in%)
  720 ?block%=in%
  730 block%!1=code%
  740 block%!5=FNword(in%)
  750 A%=4:X%=block% MOD 256:Y%=block% DIV 256:CALL &FFD1
  760 base%=FNword(in%)
  770 FOR apply%=1 TO FNword(in%)
  780 diff%=FNword(in%)
  790 old%=code%?diff%+256*code%?(diff%+1)
  800 new%=old%-base%+code%
  810 code%?diff%=new% MOD 256:code%?(diff%+1)=new% DIV 256
  820 NEXT
  830 CLOSE #in%
  840 in_file=&77
  850 out_file=&82
  860 buffer=&83
  870 buffer_size=&85
  880 break_even=&78
  890 offset_bits=&79
  900 length_bits=&7A
  910 out_size=&7F
  920 in_x=&8F
  930 in_y=code%+&1C0
  940 out_x=code%+&1C1
  950 out_y=code%+&1C2
  960 IF NOT use_file_buffer% THEN ENDPROC
  970 in_y=code%+&213
  980 out_x=code%+&214
  990 out_y=code%+&215
 1000 file_buffer=&8C
 1010 ENDPROC
 1020 :
 1030 DEF FNword(chan%)
 1040 =BGET #chan%+256*BGET #chan%
 1050 :
 1060 DEF PROCoscli($block%)
 1070 LOCAL X%,Y%
 1080 X%=block% MOD 256
 1090 Y%=block% DIV 256
 1100 CALL &FFF7
 1110 ENDPROC
 1120 :
 1130 DEF PROCtitle
 1140 CLS
 1150 PRINTTAB(7,0);CHR$141;CHR$132;CHR$157;CHR$135;"LZSS decompression  ";CHR$156
 1160 PRINTTAB(7,1);CHR$141;CHR$132;CHR$157;CHR$135;"LZSS decompression  ";CHR$156
 1170 PRINT CHR$131;"Version 1.00 (C) Steven Flintham 1996"
 1180 ENDPROC
 1190 :
 1200 DEF PROCget_files
 1210 IF gf_status%=1 THEN GOTO 1270
 1220 IF gf_status%=2 THEN GOTO 1310
 1230 PROCtitle
 1240 VDU 28,0,24,39,4
 1250 PRINT "Whenever a filename is requested you canalso enter a * command"
 1260 gf_status%=1
 1270 REPEAT
 1280 input$=FNfname_oscli("Input file: ")
 1290 UNTIL FNvalid_input(input$)
 1300 gf_status%=2
 1310 REPEAT
 1320 output$=FNfname_oscli("Output file: ")
 1330 UNTIL FNvalid_output(output$)
 1340 gf_status%=0
 1350 VDU 26
 1360 ENDPROC
 1370 :
 1380 DEF FNfname_oscli(prompt$)
 1390 LOCAL fname$
 1400 REPEAT
 1410 PRINT'prompt$;
 1420 fname$=FNstrip_spaces(FNinput(1,255,FALSE)):PRINT
 1430 IF LEFT$(fname$,1)="*" AND LEN(fname$)<64 THEN PROCoscli(fname$)
 1440 UNTIL LEFT$(fname$,1)<>"*"
 1450 =fname$
 1460 :
 1470 DEF FNstrip_spaces(line$)
 1480 REPEAT
 1490 IF LEFT$(line$,1)=" " THEN line$=MID$(line$,2)
 1500 UNTIL LEFT$(line$,1)<>" "
 1510 =line$
 1520 :
 1530 DEF FNvalid_input(fname$)
 1540 LOCAL chan%,read_header%,version%
 1550 chan%=OPENIN(fname$)
 1560 IF chan%=0 THEN PRINT'"That file does not exist!":=FALSE
 1570 FOR read_header%=0 TO 4
 1580 block%?read_header%=BGET #chan%
 1590 NEXT
 1600 CLOSE #chan%
 1610 version%=block%?4:block%?4=13
 1620 IF $block%<>"LZSS" THEN PRINT'"That is not an LZSS file!":=FALSE
 1630 IF version%<>0 THEN PRINT'"That is not a version 0 LZSS file!":=FALSE
 1640 =TRUE
 1650 :
 1660 DEF FNvalid_output(output$)
 1670 LOCAL chan%
 1680 chan%=OPENIN(output$)
 1690 IF chan%=0 THEN =TRUE
 1700 CLOSE #chan%
 1710 PRINT'"That file already exists. Are you sure  you want to overwrite it? (Y/N) ";
 1720 IF NOT FNyes THEN PRINT "No":=FALSE
 1730 PRINT "Yes"
 1740 REM Use OPENOUT to check for write-only errors
 1750 chan%=OPENOUT(output$):CLOSE #chan%
 1760 =TRUE
 1770 :
 1780 DEF PROCdecompress(input$,output$)
 1790 LOCAL in%,buffer_size%,time%,input_size%,output_size%,hr%,min%,sec%,load%,exec%,A%,X%,Y%
 1800 PROCtitle
 1810 PRINT'"Input file: ";CHR$131;RIGHT$(input$,27)
 1820 PRINT "Output file:";CHR$131;RIGHT$(output$,27)
 1830 in%=OPENIN(input$):?in_file=in%
 1840 PTR #in%=5:?offset_bits=BGET #in%:?length_bits=BGET #in%
 1850 PRINT "Offset bits:";CHR$131;?offset_bits
 1860 PRINT "Length bits:";CHR$131;?length_bits
 1870 PRINT'"Please wait, decompressing..."
 1880 PRINT'"Bytes read:   ";CHR$131;"&";:?in_x=POS:?in_y=VPOS:PRINT "000000"
 1890 PRINT "Bytes written:";CHR$131;"&";:?out_x=POS:?out_y=VPOS:PRINT "000000";
 1900 PTR #in%=8:FOR read%=0 TO 3:out_size?read%=BGET #in%:NEXT
 1910 FOR read%=0 TO 7:block%?read%=BGET #in%:NEXT
 1920 load%=!block%:exec%=block%!4
 1930 ?break_even=(1+?offset_bits+?length_bits) DIV 9
 1940 ?buffer=workspace% MOD 256:buffer?1=workspace% DIV 256
 1950 buffer_size%=2^?offset_bits+?break_even+2^?length_bits
 1960 ?buffer_size=buffer_size% MOD 256:buffer_size?1=buffer_size% DIV 256
 1970 IF use_file_buffer% THEN ?file_buffer=file_buff% MOD 256:file_buffer?1=file_buff% DIV 256
 1980 ?out_file=OPENOUT(output$)
 1990 PTR #in%=24
 2000 time%=TIME
 2010 CALL code%
 2020 time%=TIME-time%
 2030 IF time%=0 THEN time%=1:REM avoid minute risk of division by zero
 2040 input_size%=PTR #in%:REM includes header size
 2050 output_size%=PTR #?out_file
 2060 PRINTTAB(?in_x,?in_y);RIGHT$("000000"+STR$~input_size%,6)
 2070 PRINTTAB(?out_x,?out_y);RIGHT$("000000"+STR$~output_size%,6)
 2080 hr%=time% DIV 360000
 2090 min%=(time%-hr%*360000) DIV 6000
 2100 sec%=(time%-hr%*360000-min%*6000) DIV 100
 2110 PRINT'"Time taken:        ";CHR$131;hr%;":";RIGHT$("00"+STR$(min%),2);":";RIGHT$("00"+STR$(sec%),2)
 2120 PRINT "Speed:             ";CHR$131;(100*input_size%) DIV time%;" bytes/second"
 2130 PRINT "Input/output ratio:";CHR$131;input_size%*100 DIV output_size%;"%"
 2140 CLOSE #in%
 2150 CLOSE #?out_file
 2160 $workspace%=output$
 2170 block%!0=workspace%
 2180 block%!2=load%
 2190 block%!6=exec%
 2200 X%=block% MOD 256:Y%=block% DIV 256
 2210 A%=2:CALL &FFDD
 2220 A%=3:CALL &FFDD
 2230 ENDPROC
 2240 :
 2250 DEF FNanother
 2260 PRINT'"Decompress another file? (Y/N)";
 2270 =FNyes
 2280 :
 2290 DEF FNyes
 2300 LOCAL key$
 2310 *FX21
 2320 REPEAT
 2330 key$=CHR$(GET AND &DF)
 2340 UNTIL key$="Y" OR key$="N"
 2350 =(key$="Y")
 2360 :
 2370 DEF FNinput(min%,max%,numeric%)
 2380 LOCAL input$,key$
 2390 input$=""
 2400 *FX21
 2410 PROCon
 2420 REPEAT
 2430 REPEAT
 2440 key$=GET$
 2450 UNTIL (key$>="0" AND key$<="9") OR (NOT numeric% AND key$>=" " AND key$<="~") OR key$=CHR$13 OR key$=CHR$127
 2460 IF key$<>CHR$13 AND key$<>CHR$127 AND LEN(input$)<max% THEN input$=input$+key$:PRINT key$;
 2470 IF key$=CHR$127 AND input$<>"" THEN input$=LEFT$(input$,LEN(input$)-1):VDU 127
 2480 UNTIL LEN(input$)>=min% AND LEN(input$)<=max% AND key$=CHR$13
 2490 PROCoff
 2500 =input$