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