10REM Text compresser 20REM (C) 1996 By Jon Ripley 30REM Version 1.10 17/02/96 40REM Will only compress ASCII (Text) files and Teletext files. 50REM Tends to lose the last couple o f bytes when compressing. To solve this add a few spaces on to the end of the fi le you want to compress. 60REM This program is PD 70REM Please DO NOT ALTER this progra m 80DEFFNS="TxtComp" 90MODE7:PROCinit 100ONERRORMODE7:CLOSE#0:IF ERR<>17 REP ORT:PRINT" at line ";ERL:END 110PRINT 120FORX=0TO1:PROCcentre(CHR$141+CHR$(1 29+X)+"Text Compressor/Decompressor "):N EXT 130PRINTTAB(0,22); 140FORX=0TO1:PROCcentre(CHR$141+CHR$(1 33+X)+"(C) 1996 Jon Ripley"):NEXT 150VDU28,0,20,39,4,23,1,0;0;0;0;0; 160PRINT''' 170PROCb(" 1) Compress file") 180PROCb(" 2) Decompress file") 190PROCb(" 3) Exit Program") 200PRINT 210PROCb(" Enter selection:") 220REPEAT 230C$=GET$ 240UNTILINSTR("123",C$):PRINTC$ 250IF C$="3" MODE7:END 260CLS:*. 270PRINT'"File to ";STRING$(-(ASCC$=50 ),"de")"compress:"; 280INPUT""A$ 290INPUT"Save as:"B$ 300IF C$="1" PROCcompress(A$,B$) ELSE PROCdecompress(A$,B$) 310PRINT'"Another file?"; 320REPEATA$=GET$:UNTILINSTR("YyNn",A$) :PRINTA$ 330IF INSTR("Yy",A$) RUN 340END 350DEFPROCb(D$):VDU141:PRINTD$:VDU141: PRINTD$:ENDPROC 360DEFPROCdecompress(in$,out$) 370input=OPENINin$ 380output=OPENOUTout$ 390PROCtext`decompress 400CLOSE#input 410CLOSE#output 420ENDPROC 430DEFPROCcompress(in$,out$) 440input=OPENINin$ 450output=OPENOUTout$ 460PROCtext`file 470CLOSE#input 480CLOSE#output 490ENDPROC 500DEFPROCcentre(A$) 510PRINTTAB(20-LENA$/2);A$; 520ENDPROC 530DEFPROCtext`decompress 540A%=TRUE 550E%=0 560REPEAT 570inbyte%=FNbyte 580IFinbyte%<=9 BPUT#output,ASCMID$(" aeiorstln",inbyte%+1,1):GOTO630 590outbyte%=(inbyte%-8)*16+FNbyte 600IFoutbyte%=127 outbyte%=(FNbyte*16) +FNbyte:GOTO620 610IFoutbyte%=32 outbyte%=13 620BPUT#output,outbyte% 630UNTILEOF#input AND A% 640ENDPROC 650DEFFNbyte 660A%=NOTA% 670IFA% THEN=R% ELSEC%=BGET#input:R%=C %AND15:=C% DIV16 680DEF PROCtext`file 690IC%=0:OC%=0:OB%=0:OBE=1 700REPEAT 710C%=BGET#input 720IFEOF#input PROCout8:GOTO830 730IC%=IC%+1 740IFC%<33 GOTO 810 750IFC%<97 PROCout8:GOTO830 760IFC%=127 C%=255 770IFC%>127 Z%=C%:C%=127:PROCout8:C%=Z %-128:PROCout8:GOTO830 780A%=AV%(C%-97) 790IFA%=0 PROCout8 ELSEPROCout4 800GOTO830 810IFC%=32 A%=0:PROCout4:GOTO830 820IFC%=13 C%=32:PROCout8 830UNTILEOF#input 840BPUT#output,OB% 850ENDPROC 860DEFPROCout4 870IF OBE OB%=A%*16:OBE=0:ENDPROC 880OB%=OB%+A% 890BPUT#output,OB% 900OBE=1 910OC%=OC%+1 920ENDPROC 930DEFPROCout8 940OC%=OC%+1 950CL%=C%DIV16+8 960CR%=C%AND15 970IFOBE BPUT#output,CL%*16+CR%:ENDPRO C 980OB%=OB%+CL% 990BPUT#output,OB% 1000OB%=CR%*16 1010ENDPROC 1020DEFPROCinit 1030DIM AV%(126-97) 1040FORI%=97TO122 1050READ C$ 1060IF C$<>"" AV%(I%-97)=VALC$ 1070NEXT 1080DATA1,,,,2,,,,3,,,8,,9,4,,,5,6,7,,, ,,,,0 1090ENDPROC