home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol033 / squish.bas < prev    next >
Encoding:
BASIC Source File  |  1987-01-11  |  10.8 KB  |  190 lines
  1. 1 ' SQUISH Program for basic programs
  2. 2 ' Enhanced version of program appearing in Softside magazine
  3. 3 ' IBM PC BASIC Squish
  4. 4 ' Softside #34, page 34
  5. 5 '
  6. 10 ' Variables used in this program:
  7. 20 '   A -- Temporary numeric storage
  8. 30 '  AZ -- Screen line on which current program line is displayed
  9. 40 '  A$ -- Current program line being SQUISHed
  10. 50 '  C$ -- Contains lines that have been combined
  11. 60 '   D -- Length of reserved word being searched for
  12. 70 '  DS -- The maximum number of user protected lines
  13. 80 '  DT -- Set to 1 if current line contains a DATA statement
  14. 90 '  G1-G6 -- Position in A$ at which INSTR starts searching
  15. 100 '  HH -- Miscellaneous
  16. 110 '  HIGH$ -- Character string after translation to upper case
  17. 120 '  I$ -- Name of a DEF FN to convert a string to a single upper case
  18. 130 '  ICHAR -- Counter in lower-to-upper case subroutine
  19. 140 '  ILINE -- Count of number of program lines read in
  20. 150 '  IP$ -- Set to "Y" if REM statements are to be deleted
  21. 160 '  IPOS -- Position indicator in lower-to-upper case subroutine
  22. 170 '  J$ -- Storage for A$ as it is being reconstructed
  23. 180 '  LN -- Current line number being processed
  24. 190 '  L$,L1$ -- Current character of A$ being processed
  25. 200 '  LOW$ -- Character string before translation to upper case
  26. 210 '  N$ -- Set to STR$(LN)
  27. 220 '  P -- Set to 1 the first time a quote is encountered in a PRINT statement
  28. 230 '       P is set to zero when a second quote or end of line is encountered.
  29. 240 '       All compression functions are canceled while P equals 1
  30. 250 '  PJ -- Points to the current line in PRO(*) being tested
  31. 260 '  PP -- Set to 1 minus the location of the first character in a program
  32. 270 '        line following the line number
  33. 280 '  PV -- Number of protected lines entered
  34. 290 '  PRO(*) -- Optional protected line numbers specified by user
  35. 300 '  Q$ -- Used in INKEY loop
  36. 310 '  R -- Number of line numbers referenced in REF(*)
  37. 320 '  RD -- Total number of REM statemnets deleted
  38. 330 '  RE -- Total number of lines combined
  39. 340 '  REF(*) -- Number of program lines that can be referenced
  40. 350 '  S,S1 -- Miscellaneous, used in sort routine
  41. 360 '  SD -- Total number of spaces deleted
  42. 370 '  SQ$ -- Name of program to be SQUISHed
  43. 380 '  SV$ -- Name to use to save SQUISHed program
  44. 390 '  T,T1,T2 -- Miscellaneous
  45. 400 '  V$ -- The current program line, stripped of its line number
  46. 410 '  X -- Set equal to PP
  47. 420 '  XC$ -- Set to "Y" if lines are to be combined
  48. 430 '  XS$ -- Set to "Y" if extra spaces are to be deleted
  49. 440 '  XP$ -- Set to "Y" if user wishes to protect lines
  50. 450 '  ZC -- Position on line AZ to print L$
  51. 460 ' IBM PC BASIC Squish
  52. 470 ' Softside #34, page 34
  53. 480 '
  54. 490 ' DEFINT
  55. 500 DEFINT B-K,S-Z
  56. 510 ' Initialize variables
  57. 520 A=0:A$="":C$="":D=0:DS=1000:DT=0:G1=0:G2=0:G3=0:G4=0:G5=0:G6=0:HH=0:I$="":IP$="":J$="":LN=0:L$="":L1$="":N$="":P=0:PJ=0:PP=0:PV=0:Q$="":R=0:RD=0:RE=0:S=0:S1=0
  58. 530 SD=0:SQ$="":T=0:T1=0:T2=0:V$="":X=0:XC$="":ZC=0
  59. 540 ' DIMension arrays
  60. 550 DIM REF(2000),PRO(1000)
  61. 560 ' Set up screen
  62. 570 SCREEN 0,0,0:WIDTH 80:CLS:COLOR 7,0:KEY OFF
  63. 580 ' Input name of program to be processed
  64. 590 LINE INPUT"Enter the name of the program to be SQUISHED [.BAS]: ";SQ$
  65. 600 LOW$=SQ$:GOSUB 1670:SQ$=HIGH$
  66. 610 IF INSTR(SQ$,".")=0 THEN SQ$=SQ$+".BAS"
  67. 620 '  Set up default values
  68. 630 XS$="N":IP$="N":XC$="N":XP$="N"
  69. 640 PRINT:LINE INPUT"Enter the name for saving the SQUISHED program [.BAS]: ";SV$
  70. 650 LOW$=SV$:GOSUB 1670:SV$=HIGH$
  71. 660 IF INSTR(SV$,".")=0  THEN SV$=SV$+".BAS"
  72. 670 '  Input run time options
  73. 680 PRINT:LINE INPUT"Would you like extra spaces deleted? (Y/N) ";XS$:IF XS$="" THEN XS$="N"
  74. 690 PRINT:LINE INPUT"Would you like REM statements deleted? (Y/N) ";IP$:IF IP$="" THEN IP$="N"
  75. 700 PRINT:LINE INPUT"Would you like to combine lines? (Y/N) ";XC$:IF XC$="" THEN XC$="N"
  76. 710 PRINT:LINE INPUT"Would you like to protect any lines? (Y/N) ";XP$:IF XP$="" THEN XP$="N"
  77. 720 ' Set error trap and convert INPUT variables
  78. 730 ON ERROR GOTO 1750
  79. 740 LOW$=XS$:GOSUB 1670:XS$=HIGH$
  80. 750 LOW$=IP$:GOSUB 1670:IP$=HIGH$
  81. 760 LOW$=XC$:GOSUB 1670:XC$=HIGH$
  82. 770 LOW$=XP$:GOSUB 1670:XP$=HIGH$
  83. 780 ' If nothing is to be done, reRUN the program
  84. 790 IF XS$="N" AND IP$="N" AND XC$="N" AND XP$="N" THEN RUN
  85. 800 ' Store user protected lines
  86. 810 IF XP$="Y" THEN INPUT"Enter line number to protect (0 to Exit) ";PRO(PV):IF PRO(PV)>0 AND PV<DS THEN PV=PV+1:GOTO 810
  87. 820 CLS
  88. 830 ' OPEN source file for input
  89. 840 OPEN SQ$ FOR INPUT AS #1
  90. 850 LOCATE 4,1:PRINT"Number of lines input: ";
  91. 860 LOCATE 6,1:PRINT"Number of lines referenced: ";
  92. 870 ILINE=1
  93. 880 LOCATE 2,1:PRINT"Reading in "+SQ$+" and recording all referenced line numbers";
  94. 890 ' Check for End Of File and print error if current line number does not start with a line number
  95. 900 IF EOF(1) THEN 1090
  96. 910 LINE INPUT #1,A$:IF ASC(A$)>58 THEN COLOR 12,0:PRINT:PRINT"**** '";SQ$;"' is not an ASCII file ****":PRINT:COLOR 7,0:END
  97. 920 ILINE= ILINE + 1
  98. 930 LOCATE 4,23:COLOR 15,0:PRINT ILINE;:COLOR 7,0
  99. 940 ' Search for reserved words that reference other program lines
  100. 950 G1=1:G2=1:G3=1:G4=1:G5=1:G6=1
  101. 960 D=4:T=INSTR(G1,A$,"THEN"):IF T THEN G1=T+D:GOTO 1040
  102. 970 T=INSTR(G2,A$,"GOTO"):IF T THEN G2=T+D:GOTO 1040
  103. 980 T=INSTR(G3,A$,"ELSE"):IF T THEN G3=T+D:GOTO 1040
  104. 990 T=INSTR(G4,A$,"GOSUB"):IF T THEN D=5:G4=T+D:GOTO 1040
  105. 1000 T=INSTR(G5,A$,"RESUME"):IF T THEN D=6:G5=T+D:GOTO 1040
  106. 1010 T=INSTR(G6,A$,"RUN"):IF T THEN D=3:G6=T+D:GOTO 1040
  107. 1020 GOTO 900
  108. 1030 ' Store all referenced lines into an array
  109. 1040 A=VAL(MID$(A$,T+D)):IF A THEN FOR HH=1 TO R:IF REF(HH)<>A THEN NEXT:R=R+1:REF(R)=A
  110. 1050 LOCATE 6,28:COLOR 15,0:PRINT R:COLOR 7,0
  111. 1060 IF A>0 THEN T=T+D:D=1:T1=INSTR(T,A$,","):T2=INSTR(T,A$,":"):IF T1>0 AND (T2=0 OR T1<T2) THEN T=T1:GOTO 1040
  112. 1070 GOTO 960
  113. 1080 ' Sort all referenced and protected lines in ascending order
  114. 1090 LOCATE 10,1:COLOR 31,0:PRINT "Sorting Referenced Line Numbers";:COLOR 7,0
  115. 1100 CLOSE:FOR S=1 TO R:FOR S1=S TO R:IF REF(S)<REF(S1) THEN SWAP REF(S),REF(S1)
  116. 1110 NEXT S1,S:FOR S=0 TO PV:FOR S1=S TO PV:IF PRO(S)>PRO(S1) THEN SWAP PRO(S),PRO(S1)
  117. 1120 ' reOPEN source file for input and OPEN destination file for output
  118. 1130 NEXT S1,S:OPEN SQ$ FOR INPUT AS #1:OPEN SV$ FOR OUTPUT AS #2:CLS
  119. 1140 ' Get next program line to be processed
  120. 1150 IF EOF(1) THEN 1350
  121. 1160 LINE INPUT #1,A$:FOR HH=INSTR(A$," ") TO LEN(A$)-1:IF MID$(A$,HH+1,1)=" " THEN NEXT
  122. 1170 ' Set up pointer variables and update display
  123. 1180 PP=HH:X=PP:LN=VAL(A$):LOCATE 1,1:COLOR 7,0:PRINT "Scanning line:";:COLOR 12,0:PRINT LN:PRINT:PRINT STRING$(255,32):LOCATE 3,1:COLOR 7,0:PRINT A$:LOCATE 8,1:PRINT"Scanning position:   ":PRINT
  124. 1190 LOCATE 1,26:PRINT"Input file: ";:COLOR 15,0:PRINT SQ$;:LOCATE 1,53:COLOR 7,0:PRINT"Output file: ";:COLOR 15,0:PRINT SV$;:LOCATE 10,1:COLOR 7,0
  125. 1200 PRINT"Number of lines combined:";:COLOR 12,0:PRINT RE:COLOR 7,0:PRINT:PRINT"Number of spaces deleted:";:COLOR 12,0:PRINT SD:COLOR 7,0:PRINT:PRINT"Number of REM statements deleted:";:COLOR 12,0:PRINT RD:COLOR 7,0:GOTO 1410
  126. 1210 ' If combining lines is not allowed then write new line
  127. 1220 IF XC$<>"Y" THEN PRINT #2,A$:GOTO 1150
  128. 1230 ' Set up C$ to start combining lines
  129. 1240 IF C$="" THEN C$=A$:GOTO 1150
  130. 1250 ' Checks if current line is referenced
  131. 1260 IF R>0 THEN IF LN=REF(R) THEN R=R-1:GOTO 1330 ELSE IF LN>REF(R) THEN R=R-1:GOTO 1260
  132. 1270 ' Never combine lines with IF or RETURN statements
  133. 1280 IF INSTR(C$,"IF") OR INSTR(C$,"RETURN") THEN 1330
  134. 1290 ' Combine two program lines and go for more
  135. 1300 V$=RIGHT$(A$,LEN(A$)-X):IF LEN(C$)+LEN(V$)<240 THEN C$=C$+":"+V$:RE=RE+1 ELSE 1330
  136. 1310 GOTO 1150
  137. 1320 ' Not enought space in C$ to combine another line so write it out first, then continue
  138. 1330 PRINT #2,C$:C$=A$:GOTO 1150
  139. 1340 ' Write out last program line and update display
  140. 1350 PRINT #2,C$:CLOSE:COLOR 12,0:LOCATE 8,19:PRINT T:LOCATE 10,26:PRINT RE:LOCATE 12,26:PRINT SD:LOCATE 14,34:PRINT RD
  141. 1360 ' Program complete, prompt for another run
  142. 1370 LOCATE 3,1:PRINT STRING$(255,32):LOCATE 3,1:COLOR 14,0:PRINT"Program Complete. Do you wish to SQUISH another program (Y/N) ":SOUND 1000,6:SOUND 660,5:COLOR 7,0
  143. 1380 Q$=INKEY$:IF Q$="" THEN 1380 ELSE IF Q$="Y" OR Q$="y" THEN RUN ELSE END
  144. 1390 ' Change color of current character being scanned
  145. 1400 LOCATE 8,20:PRINT"   ";
  146. 1410 N$=LEFT$(A$,PP):ZC=160+PP:PP=PP+1:P=0:J$="":DT=0:FOR T=PP TO LEN(A$):L$=MID$(A$,T,1):AZ=INT(ZC/80):LOCATE AZ+1,ZC-AZ*80+1:COLOR 12,0:PRINT MID$(A$,T,1);:ZC=ZC+1:COLOR 12,0:LOCATE 8,19:PRINT T
  147. 1420 ' Set P equal to 1 on first quote mark in a print statement else set P equal to 0 on second
  148. 1430 COLOR 7,0:IF L$=CHR$(34) THEN IF P THEN P=0 ELSE P=1
  149. 1440 ' if the current scan position is within a set of quote marks, skip all normal Squish processing
  150. 1450 IF P THEN 1600
  151. 1460 ' Discontinue processing if DATA is found in current program line
  152. 1470 IF MID$(A$,T,4)="DATA" THEN DT=1 ELSE IF L$=":" THEN DT=0
  153. 1480 IF DT THEN 1600
  154. 1490 ' Remove all spaces when safe to do so and update Spaces Deleted counter
  155. 1500 IF L$<>" " OR XS$<>"Y" THEN 1550 ELSE IF J$>"" THEN L1$=RIGHT$(J$,1):IF L1$="^" OR (L1$>")" AND L1$<"0") OR (L1$>"9" AND L1$<"A") THEN L$=""
  156. 1510 L1$="X":IF T<LEN(A$) THEN L1$=MID$(A$,T+1,1)
  157. 1520 IF L1$="^" OR L1$=CHR$(34) OR L1$=" " OR (L1$>")" AND L1$<"0") OR (L1$>"9" AND L1$<"A") THEN L$=""
  158. 1530 IF L$="" THEN SD=SD+1
  159. 1540 ' Check for user protected line
  160. 1550 IF PV>PJ THEN IF LN=PRO(PJ) THEN PJ=PJ+1:GOTO 1640 ELSE IF LN>PRO(PJ) THEN PJ=PJ+1
  161. 1560 ' Search for REMarks and remove if allowed
  162. 1570 IF MID$(A$,T,3)="REM" OR L$="'" THEN IF IP$<>"Y" THEN A$=N$+J$+MID$(A$,T,255):GOTO 1640 ELSE RD=RD+1:IF LN=REF(R) THEN R=R-1:A$=N$+J$+"'":GOTO 1640 ELSE IF J$="" THEN 1150 ELSE 1620
  163. 1580 ' Construct a new Squished version of the current line in J$
  164. 1590 ' Add a trailing quote mark if none found after a print statement
  165. 1600 J$=J$+L$:NEXT:IF P THEN J$=J$+CHR$(34)
  166. 1610 ' Add the current program line number and jump to line 310
  167. 1620 A$=N$+J$:GOTO 1220
  168. 1630 ' If lines have been combined then save them
  169. 1640 IF C$<>"" THEN PRINT #2,C$:C$=""
  170. 1650 ' Otherwise write new program line
  171. 1660 PRINT #2,A$:GOTO 1150
  172. 1670 ' Subroutine to convert lower to upper case
  173. 1680 HIGH$=""
  174. 1690 FOR IPOS=1 TO LEN(LOW$)
  175. 1700 ICHAR = ASC(MID$(LOW$,IPOS,1))
  176. 1710 IF ICHAR<&H7B THEN IF ICHAR>&H60 THEN ICHAR=ICHAR-&H20
  177. 1720 HIGH$ = HIGH$ + CHR$(ICHAR)
  178. 1730 NEXT IPOS
  179. 1740 RETURN
  180. 1750 ' Error trapping done here
  181. 1760 SOUND 1000,3:SOUND 600,4:COLOR 15,0
  182. 1770 IF ERR=53 THEN PRINT"File "+SQ$+" not found, reenter.":COLOR 7,0:CLS:GOTO 590
  183. 1780 IF ERR=61 THEN PRINT"Disk full, program terminated":GOTO 1840
  184. 1790 IF ERR=67 THEN PRINT"Too many files on disk.":GOTO 1840
  185. 1800 IF ERR=70 THEN PRINT"Disk is write protected.":GOTO 1840
  186. 1810 IF ERR=71 THEN PRINT"Check disk drive.":GOTO 1840
  187. 1820 IF ERR=72 THEN PRINT"Disk media error.":GOTO 1840
  188. 1830 PRINT"***** ERROR ***** BASIC error= "+STR$(ERR)
  189. 1840 COLOR 7,0:END
  190.  IF ERR=72 THEN PRINT"Disk media er