home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast.iso / compress / pcusqnew.bas < prev    next >
BASIC Source File  |  1994-03-04  |  5KB  |  126 lines
  1. 10    '***************************************************************
  2. 20    ' PCUSQNEW.BAS - Version 1.0 - 3/17/85
  3. 30    '    by Kim Levitt - 213-653-6398 (MBBS, 300/1200 baud)
  4. 40    '    Update of original 11/25/84 version of USQ.BAS by
  5. 50    '    Dave (it can't be done) Rand - 805-493-1987 (voice)
  6. 60    '
  7. 65    '    This WILL run on an IBM-PC under interpreter BASICA,
  8. 66    '    but VERY SLOWLY.. When I compiled it under BASCOM
  9. 67    '    and LINKed it with BASCOM.LIB on the PC-AT, it ran
  10. 68    '    fast enough to be useable..
  11. 69    ' 
  12. 70    '**************************************************************
  13. 80    ' INITIALIZATION
  14. 90    '
  15. 100    DEFINT A-Z : GETC$=" " : GETW$="  " ' for speed!
  16. 110    DIM USQ.TABLE%(1,257), BUF$(128), OUTF$(127)
  17. 120    FILE$="" : SF%=0 : FO%=-1 : CSL%=0 : CSH%=0 : OD$=""
  18. 340    '***************************************************************
  19. 350    ' COMMON CODE
  20. 360    '
  21. 370    ' Common code, accessed with blank command line or begining of
  22. 380    ' non-CP/M versions.. (Interactive version)
  23. 390    '
  24. 400    SF%=-1
  25. 410    PRINT : PRINT "PCUSQNEW.BAS -- A SLOW But Sure BASIC Unsqueezer"
  26. 420    PRINT
  27. 430    PRINT "(Enter name of file to 'unsqueeze'. Use upper case ONLY.)"
  28. 440    INPUT "Name of squeezed file";FILE$ : ID$=""
  29. 450    PRINT : PRINT "(Enter 'O' for console output only)"
  30. 460    INPUT "Console output? (Y/N/O)";CO$
  31. 470    IF CO$="O" OR CO$="o" THEN FO%=0 : GOTO 520
  32. 480    IF CO$="N" OR CO$="n" THEN SF%=0
  33. 490    PRINT : PRINT "(Enter return only for current disk)"
  34. 500    INPUT "Output drive";OD$
  35. 510    IF LEN(OD$)=1 THEN OD$=OD$+":"
  36. 520    PRINT : PRINT "Unsqueezing ";ID$;FILE$;" --> ";
  37. 530    OPEN "R", 1, ID$+FILE$, 128
  38. 540    GET #1, 1
  39. 550    IF EOF(1) THEN PRINT "[File not found]" : CLOSE #1 :
  40.        KILL ID$+FILE$ : SYSTEM
  41. 560    FOR X=0 TO 127 : FIELD 1, X AS D$, 1 AS BUF$(X) : NEXT X
  42. 570    GOSUB 900
  43. 580    IF USQ.ERR%<>0 THEN 
  44.        PRINT "[Error in header, or not squeezed]" : SYSTEM
  45. 590    PRINT "(";OD$;OLD.NAME$;")";
  46. 600    IF FO%=0 THEN PRINT " (console output only)" ELSE PRINT
  47. 610    PRINT
  48. 620    IF FO%=0 THEN 650
  49. 630    OPEN "R", 2, OD$+OLD.NAME$, 128 : OUTR%=1 : OUTS%=0
  50. 640    FOR X=0 TO 127 : FIELD #2, X AS D$, 1 AS OUTF$(X) : NEXT X
  51. 650    USQ.EOF%=0
  52. 660    GOSUB 1170
  53. 670    WHILE NOT(USQ.EOF%)
  54. 680       IF INKEY$=CHR$(3) THEN 800
  55. 690       IF SF% AND USQ$=CHR$(26) THEN SF%=0
  56. 700       IF (SF% AND USQ$<>CHR$(10)) THEN PRINT USQ$;
  57. 710       IF FO% THEN GOSUB 840
  58. 720       CSL%=CSL%+ASC(USQ$) : CAR%=INT(CSL%/256) : CSL%=CSL%-(256*CAR%)
  59. 730       CSH%=CSH%+CAR% : CSH%=(CSH% AND 255)
  60. 740       GOSUB 1170
  61. 750    WEND
  62. 760    NCS%=CVI(CHR$(CSL%)+CHR$(CSH%))
  63. 770    IF NCS%<>OLD.CHECK% THEN PRINT : PRINT "[USQ checksum error"; :
  64.        IF FO% THEN PRINT ", check output file]" ELSE PRINT "]"
  65. 780    CLOSE 1 : IF FO% THEN IF OUTS% THEN PUT #2, OUTR% : CLOSE 2 ELSE CLOSE 2
  66. 790    SYSTEM
  67. 800    CLOSE : IF SF% THEN PRINT : PRINT
  68. 810    PRINT "[USQ aborted]"
  69. 820    IF FO% THEN KILL OD$+OLD.NAME$ : PRINT "[";OD$;OLD.NAME$;" killed]"
  70. 830    SYSTEM
  71. 840    '***************************************************************
  72. 850    ' TRANSPARENT FILE OUTPUT ROUTINE
  73. 860    '
  74. 870    LSET OUTF$(OUTS%)=USQ$ : OUTS%=OUTS%+1
  75. 880    IF OUTS%=128 THEN PUT #2, OUTR% : OUTR%=OUTR%+1 : OUTS%=0
  76. 890    RETURN
  77. 900    '***************************************************************
  78. 910    ' OPEN SQUEEZED FILE AND EXTRACT NAME, CHECKSUM AND TABLE
  79. 920    '
  80. 930    CUR.PNT%=128 : CUR.REC%=-1 : USQ.ERR%=0 : GOSUB 1120
  81. 940    IF GETW%<>-138 THEN USQ.ERR%=1 : GOTO 1040
  82. 950    GOSUB 1120 : OLD.CHECK%=GETW%
  83. 960    GOSUB 1050 : OLD.NAME$=""
  84. 970    WHILE GETC$<>CHR$(0) : OLD.NAME$=OLD.NAME$+GETC$ : GOSUB 1050 : WEND
  85. 980    GOSUB 1120 : COUNT%=GETW%
  86. 990    FOR X=0 TO COUNT%-1
  87. 1000       GOSUB 1120 : USQ.TABLE%(0,X)=GETW%
  88. 1010       GOSUB 1120 : USQ.TABLE%(1,X)=GETW%
  89. 1020    NEXT X
  90. 1030    REP.CNT%=0 : USQ.LFT%=0
  91. 1040    RETURN
  92. 1050    '****************************************************************
  93. 1060    ' GET CHARACTER FROM SQUEEZED FILE
  94. 1070    '
  95. 1080    IF CUR.REC%<0 THEN CUR.REC%=0
  96. 1090    IF CUR.PNT%>127 THEN CUR.PNT%=0 : CUR.REC%=CUR.REC%+1 : GET 1,CUR.REC%
  97. 1100    LSET GETC$=BUF$(CUR.PNT%)
  98. 1110    CUR.PNT%=CUR.PNT%+1 : RETURN
  99. 1120    '***************************************************************
  100. 1130    ' GET WORD FROM SQUEEZED FILE
  101. 1140    '
  102. 1150    GOSUB 1050 : MID$(GETW$,1,1)=GETC$ : GOSUB 1050 : MID$(GETW$,2,1)=GETC$
  103. 1160    GETW%=CVI(GETW$) : RETURN
  104. 1170    '***************************************************************
  105. 1180    ' GET UNSQUEEZED CHARACTER
  106. 1190    '
  107. 1200    IF REP.CNT%<>0 THEN USQ$=USQ.LAST$ : REP.CNT%=REP.CNT%-1 : GOTO 1250
  108. 1210    GOSUB 1260 : IF USQ$<>CHR$(144) THEN USQ.LAST$=USQ$ : GOTO 1250
  109. 1220    GOSUB 1260 : REP.CNT%=ASC(USQ$)-2
  110. 1230    IF REP.CNT%=-2 THEN
  111.        REP.CNT%=0 : USQ$=CHR$(144) : USQ.LAST$=USQ$ : GOTO 1250
  112. 1240    USQ$=USQ.LAST$
  113. 1250    RETURN
  114. 1260    '***************************************************************
  115. 1270    ' TABLE LOOKUP ROUTINE
  116. 1280    '
  117. 1290    CUR.USQ%=0
  118. 1300    IF USQ.LFT%=0 THEN GOSUB 1050 : USQ.BYTE%=ASC(GETC$) : USQ.LFT%=8
  119. 1310    BIT%=USQ.BYTE% AND 1 : USQ.BYTE%=INT(USQ.BYTE%/2) : USQ.LFT%=USQ.LFT%-1
  120. 1320    CUR.USQ%=USQ.TABLE%(BIT%,CUR.USQ%)
  121. 1330    IF CUR.USQ%>=0 THEN GOTO 1300
  122. 1340    IF CUR.USQ%<-255 THEN USQ.EOF%=-1 : GOTO 1360
  123. 1350    USQ$=CHR$(-CUR.USQ%-1)
  124. 1360    RETURN
  125. 1370    END
  126.