home *** CD-ROM | disk | FTP | other *** search
/ ftp.whtech.com / ftp.whtech.com.tar / ftp.whtech.com / club100 / txt / crunch.ba < prev    next >
Text File  |  2006-10-19  |  2KB  |  31 lines
  1. 0 'Club 100 Library - 415/939-1246 BBS     937-5039 NEWSLETTER, 932-8856 VOICE
  2. 1 REM CRUNCH.BA 2/3/86 by Dan Thomas. Compress .DO files to 75% of original; SAVEd with <> extension.
  3. 5 GOTO200
  4. 10 I=ASC(INPUT$(1,1)):P=0:FORN=1TO46:IFT(N)=ITHENP=N:N=46
  5. 15 NEXT:IFP=0THENP=255
  6. 20 IFP=1THENA=1ELSEIFP<16THENB=B*2:L=L+1:GOSUB50:A=P-1:P=4ELSEB=B*32+15:L=L+5:GOSUB50
  7. 25 IFP>15THENIFP<47THENA=P-16:P=5ELSEB=B*32+31:L=L+5:GOSUB50:P=8:A=I
  8. 30 L=L+P:B=B*2^P+A:GOSUB50:IFNOTEOF(1)THEN10ELSEIFL>0THENB=B*2^(8-L):L=8:GOSUB50:GOTO500ELSE500
  9. 50 IFL<8THENRETURNELSEL=L-8:C=B:B=BAND2^L-1:V=(BXORC)/2^L:IFV=26THENV=1:S=1ELSEIFV=127THENV=2:S=1ELSEIFV=0THENV=3:S=1
  10. 60 IFS=1THENPRINT#2,CHR$(128);:X=X+1:S=0:PRINTJ;
  11. 70 PRINT#2,CHR$(V);:X=X+1:RETURN
  12. 110 V=0:IFB>=2^(L-1)THENV=T(1):L=L-1:GOTO140ELSEL=L-5:V=B/2^L:IFV=0THEN500
  13. 120 IFV<15THENV=T(V+1)ELSEB=BAND2^L-1:GOSUB150:L=L-5:V=B/2^L:IFV<31THENV=T(V+16)ELSEB=BAND2^L-1:GOSUB150:L=L-8:V=B/2^L
  14. 140 B=BAND2^L-1:PRINT#2,CHR$(V);:X=X+1:GOSUB150:GOTO110
  15. 150 IFL>7ORE=1THENRETURN
  16. 170 V=I:IFEOF(1)THENE=1ELSEI=ASC(INPUT$(1,1)):K=K+1
  17. 175 IFV=128ANDI<4THEN180ELSEB=B*256+V:L=L+8:RETURN
  18. 180 PRINTJ;:IFI=1THENI=26ELSEIFI=2THENI=127ELSEIFI=3THENI=0
  19. 190 GOTO170
  20. 200 MAXFILES=3:DEFINTA-Z:DEFSNGB:DEFSTRF-H,J:DIMT(46):K=0:X=0:I=0:V=0:L=0:B=0:P=0:A=0:N=0:R=0:S=0:C=0:E=0:M=0
  21. 210 J=CHR$(255):F="":G="":H="":CLS:PRINT:FILES:INPUT"FILENAME";F:INPUT"CRUNCH(<0>) OR EXPAND(1)";N
  22. 215 IFN=0ANDRIGHT$(F,2)<>"<>"THENG=LEFT$(F,4)+"<>"ELSEIFN=1ANDRIGHT$(F,2)="<>"THENG=LEFT$(F,LEN(F)-2)ELSE210
  23. 220 F=F+".DO":PRINT"KILL "F" WHEN DONE (Y OR <N>)";:INPUTH:OPENFFORINPUTAS1:OPENGFOROUTPUTAS2:IFN=1THEN400ELSEDIMD(127)
  24. 300 K=K+1:I=ASC(INPUT$(1,1)):IFI<128THEND(I)=D(I)+1
  25. 310 IFNOTEOF(1)THEN300ELSEFORN=1TO46:FORM=0TO127:IFD(M)>=D(T(N))THENT(N)=M
  26. 320 NEXT:PRINTJ;:X=X+1:IFT(N)<>127THENPRINT#2,CHR$(T(N));ELSEPRINT#2,CHR$(T(N-1));:N=46
  27. 330 D(T(N))=0:NEXT:CLOSE1:OPENFFORINPUTAS1:GOTO10
  28. 400 FORN=1TO46:T(N)=ASC(INPUT$(1,1)):K=K+1:IFT(N)=T(N-1)THENN=46
  29. 410 NEXT:GOSUB170:L=0:GOSUB170:GOTO110
  30. 500 BEEP:CLS:PRINT@284,F" ="K"  "G".DO ="X:IFH="Y"THENKILLF
  31.