home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / progm / basicaid.zip / PSQUISH.BAS < prev    next >
BASIC Source File  |  1983-11-23  |  5KB  |  61 lines
  1. 10 DEF FNI$(A$)=CHR$(ASC(LEFT$(A$,1))+32*(LEFT$(A$,1)>"Z")):DEFINT B-K,S-Z:A=0:AZ=0:A$="":C$="":D=0:DS=100: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
  2. 20 SD=0:SQ$="":SV$="":T=0:T1=0:T2=0:V$="":X=0:XC$="":XS$="":XP$="":ZC=0:DIM REF(DS*2),PRO(DS):SCREEN 0,0,0:WIDTH 80:COLOR 11,0:KEY OFF:CLS:LINE INPUT"ENTER THE NAME OF THE PROGRAM TO BE SQUISHED: ";SQ$
  3. 30 XS$="N":IP$="N":XC$="N":XP$="N":PRINT:LINE INPUT"ENTER THE NAME FOR THE FINAL SQUISHED PROGRAM: ";SV$:PRINT:LINE INPUT"WOULD YOU LIKE EXTRA SPACES DELETED? (Y/N) ";XS$:IF XS$="" THEN XS$="N"
  4. 35 IF XS$="y" THEN XS$="Y"
  5. 40 PRINT:LINE INPUT"WOULD YOU LIKE REM STATEMENTS DELETED? (Y/N) ";IP$:IF IP$="" THEN IP$="N"
  6. 45 IF IP$="y" THEN IP$="Y"
  7. 50 PRINT:LINE INPUT"WOULD YOU LIKE TO COMBINE LINES? (Y/N) ";XC$:IF XC$="" THEN XC$="N"
  8. 55 IF XC$="y" THEN XC$="Y"
  9. 60 PRINT:LINE INPUT"WOULD YOU LIKE TO PROTECT ANY LINES? (Y/N) ";XP$:IF XP$="" THEN XP$="N"
  10. 65 IF XP$ = "y" THEN XP$ = "Y"
  11. 70 ON ERROR GOTO 560:XS$=FNI$(XS$):IP$=FNI$(IP$):XC$=FNI$(XC$):XP$=FNI$(XP$)
  12. 80 IF XS$="N" AND IP$="N" AND XC$="N" AND XP$="N" THEN RUN
  13. 90 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 90
  14. 100 OPEN SQ$ FOR INPUT AS #1
  15. 110 IF EOF(1) THEN 240
  16. 120 LINE INPUT #1,A$:IF ASC(A$)>58 THEN COLOR 12,0:PRINT:PRINT"**** '";SQ$;"' IS NOT AN ASCII FILE ****":PRINT:COLOR 11,0:END
  17. 130 G1=1:G2=1:G3=1:G4=1:G5=1:G6=1
  18. 140 D=4:T=INSTR(G1,A$,"THEN"):IF T THEN G1=T+D:GOTO 210
  19. 150 T=INSTR(G2,A$,"GOTO"):IF T THEN G2=T+D:GOTO 210
  20. 160 T=INSTR(G3,A$,"ELSE"):IF T THEN G3=T+D:GOTO 210
  21. 170 T=INSTR(G4,A$,"GOSUB"):IF T THEN D=5:G4=T+D:GOTO 210
  22. 180 T=INSTR(G5,A$,"RESUME"):IF T THEN D=6:G5=T+D:GOTO 210
  23. 190 T=INSTR(G6,A$,"RUN"):IF T THEN D=3:G6=T+D:GOTO 210
  24. 200 GOTO 110
  25. 210 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
  26. 220 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 210
  27. 230 GOTO 140
  28. 240 CLOSE:FOR S=1 TO R:FOR S1=S TO R:IF REF(S)<REF(S1) THEN SWAP REF(S),REF(S1)
  29. 250 NEXT S1,S:FOR S=0 TO PV:FOR S1=S TO PV:IF PRO(S)>PRO(S1) THEN SWAP PRO(S),PRO(S1)
  30. 260 NEXT S1,S:OPEN SQ$ FOR INPUT AS #1:OPEN SV$ FOR OUTPUT AS #2:CLS
  31. 270 IF EOF(1) THEN 380
  32. 280 LINE INPUT #1,A$:FOR HH=INSTR(A$," ") TO LEN(A$)-1:IF MID$(A$,HH+1,1)=" " THEN NEXT
  33. 290 PP=HH:X=PP:LN=VAL(A$):LOCATE 1,1:COLOR 11,0:PRINT"SCANNING LINE:";:COLOR 12,0:PRINT LN:PRINT:PRINT STRING$(255,32):LOCATE 3,1:COLOR 14,0:PRINT A$:LOCATE 8,1:COLOR 11,0:PRINT"SCANNING POSITION:    ":PRINT
  34. 300 PRINT"NUMBER OF LINES COMBINED:";:COLOR 12,0:PRINT RE:COLOR 11,0:PRINT:PRINT"NUMBER OF SPACES DELETED:";:COLOR 12,0:PRINT SD:COLOR 11,0:PRINT:PRINT"NUMBER OF REM STATEMENTS DELETED:";:COLOR 12,0:PRINT RD:COLOR 11,0:GOTO 410
  35. 310 IF XC$<>"Y" THEN PRINT #2,A$:GOTO 270
  36. 320 IF C$="" THEN C$=A$:GOTO 270
  37. 330 IF R>0 THEN IF LN=REF(R) THEN R=R-1:GOTO 370 ELSE IF LN>REF(R) THEN R=R-1:GOTO 330
  38. 340 IF INSTR(C$,"IF") OR INSTR(C$,"RETURN") THEN 370
  39. 350 V$=RIGHT$(A$,LEN(A$)-X):IF LEN(C$)+LEN(V$)<240 THEN C$=C$+":"+V$:RE=RE+1 ELSE 370
  40. 360 GOTO 270
  41. 370 PRINT #2,C$:C$=A$:GOTO 270
  42. 380 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
  43. 390 LOCATE 3,1:PRINT STRING$(255,32):LOCATE 3,1:COLOR 14,0:PRINT"PRESS 'L' TO LOAD THE SQUISHED PROGRAM":SOUND 1000,6:SOUND 660,5:COLOR 11,0
  44. 400 Q$=INKEY$:IF Q$="" THEN 400 ELSE CLS:IF Q$="L" OR Q$ = "l" THEN LOAD SV$ ELSE END
  45. 410 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 10,0:PRINT MID$(A$,T,1);:ZC=ZC+1:COLOR 12,0:LOCATE 8,19:PRINT T
  46. 420 COLOR 11,0:IF L$=CHR$(34) THEN IF P THEN P=0 ELSE P=1
  47. 430 IF P THEN 520
  48. 440 IF MID$(A$,T,4)="DATA" THEN DT=1 ELSE IF L$=":" THEN DT=0
  49. 450 IF DT THEN 520
  50. 460 IF L$<>" " OR XS$<>"Y" THEN 500 ELSE IF J$>"" THEN L1$=RIGHT$(J$,1):IF L1$="^" OR (L1$>")" AND L1$<"0") OR (L1$>"9" AND L1$<"A") THEN L$=""
  51. 470 L1$="X":IF T<LEN(A$) THEN L1$=MID$(A$,T+1,1)
  52. 480 IF L1$="^" OR L1$=CHR$(34) OR L1$=" " OR (L1$>")" AND L1$<"0") OR (L1$>"9" AND L1$<"A") THEN L$=""
  53. 490 IF L$="" THEN SD=SD+1
  54. 500 IF PV>PJ THEN IF LN=PRO(PJ) THEN PJ=PJ+1:GOTO 540 ELSE IF LN>PRO(PJ) THEN PJ=PJ+1
  55. 510 IF MID$(A$,T-1,5)=" REM " OR L$="'" THEN IF IP$<>"Y" THEN A$=N$+J$+MID$(A$,T,255):GOTO 540 ELSE RD=RD+1:IF LN=REF(R) THEN R=R-1:A$=N$+J$+"'":GOTO 540 ELSE IF J$="" THEN 270 ELSE 530
  56. 520 J$=J$+L$:NEXT:IF P THEN J$=J$+CHR$(34)
  57. 530 A$=N$+J$:GOTO 310
  58. 540 IF C$<>"" THEN PRINT #2,C$:C$=""
  59. 550 PRINT #2,A$:GOTO 270
  60. 560 IF ERR=53 THEN RUN ELSE ON ERROR GOTO 0
  61.