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