
1 REM RESEQ[200,200] - RESEQUENCE PROGRAM
100 REM  INITIALIZE VARIBLES
120 DIM P1$[23]V, P2$[23]V  :  REM OLD & NEW PROGRAM NAMES
130 DIM S$[132]V, O$[132]V
160 DIM K$[6]V(5)  :  REM KEY WORDS
180 K$(1)="GOSUB":K$(2)="GOTO":K$(3)="RESUME":K$(4)="THEN":K$(5)="OPEN"
190 J=0
200 REM INPUT OLD AND NEW PROGRAM NAMES, AND OPEN THE FILES
220 PRINT "PROGRAM TO RESEQUENCE "; : INPUT P1$
240 IF LEN(P1$)=0 THEN GOTO 220
260 OPEN #4, P1$ + "/RO/LN:132/EN:2000"
320 PRINT "NEW PROGRAM NAME "; : INPUT P2$
340 IF LEN(P2$) = 0 THEN GOTO 320
360 OPEN #6, P2$ + "/FX/WR/LN:132"
400 REM INPUT LINE NUMBERS
420 PRINT "BEGINNING OLD LINE NUMBER "; :  INPUT L1
440 IF L1<1 THEN GOTO 420
460 IF L1>32767 THEN GOTO 420
520 PRINT "LAST OLD LINE NUMBER "; :  INPUT L2
540 IF L2>32767 THEN GOTO 520
560 IF L2 <= L1 THEN GOTO 420
600 REM INPUT LINE NUMBERS FOR NEW (RESEQUENCED) PROGRAM
620 PRINT "BEGINNING NEW LINE NUMBER "; : INPUT L0
640 IF L0 < 1 THEN GOTO 620
660 IF L0 > 32767 THEN GOTO 620
720 PRINT "LINE NUMBER INCREMENT "; :  INPUT L9
740 IF L9 < 1 THEN GOTO 720
760 IF L9 > 10000 THEN GOTO 720
1000 REM  PASS 1 - CHECK FOR STMTS W/ STMT #'S IN THEM
1020 REM  FILE FOR STORING POSITION, STMT # W/IN STMT, REC # OF STMT
1021 PRINT "PASS 1"
1040 OPEN #3, "STMTS.TMP;1/WR/FX/LN:28"
1100 REM  CYCLE THROUGH OLD PROGRAM STMT BY STMT
1120 FOR R=1 TO 32767
1140  INPUT LINE #4, S$
1150  IF LEN(S$)=0 THEN R=R-1 : GOTO 1900 : REM SKIP NULL LINES
1160   S$=TRM$(LTR$(S$))
1200  REM  SCAN FOR KEY WORDS
1220  FOR I2 = 1 TO 5
1240   P = 1
1260   J = J + 1  :  REM # OF LINES CONTAINING STMT #'S (# OF RECS IN FILE 3)
1280   P = POS(S$, K$(I2), P)
1320   IF P = 0 THEN J = J-1 : GOTO 1800  : REM NO KEY WORD
1325   I=0 : I1=0
1330   I=POS(S$,CHR$(34),I+1,P) : REM LOOK FOR ""
1340   IF I<>0 THEN I1=I1+1 : GOTO 1330 : REM COUNT ""
1345   IF INT((I1+1)/2)*2<>I1 THEN J=J-1 : GOTO 1800 : REM EVEN # OF ""
1350   IF POS(S$,"REM",1,P)<>0 THEN J=J-1 : GOTO 1800 : REM SKIP REMARKS
1360   P = P + LEN(K$(I2))
1365   IF I2=5 THEN P=POS(S$,"/EN:",P)+4 : IF P=4 THEN J=J-1 : GOTO 1800
1370   REM  SEARCH FOR FIRST NON-BLANK FOLLOWING KEY WORD.  SHOULD BE STMT #
1380   IF SBS$(S$,P,1) = " " THEN LET P=P+1 : IF P <= LEN(S$) THEN 1380
1420   IF P > LEN(S$) THEN N = -2 : GOTO 1720 : REM NO NON-BLANK FOUND
1440   A = ASC(SBS$(S$, P, 1))
1450   REM   CHECK IF NUMERIC CHAR FOUND.  IF NOT, IT'S VAR. STMT #; SET FLAG
1455  IF A=58 THEN N=-2 : GOTO 1720 : REM GOT ":" SO END OF STMT
1460   IF A<48 THEN GOTO 1710
1480   IF A>57 THEN GOTO 1710
1500   REM CHECK NEXT 4 PLACES FOR STMT #  (STMT # <= 5 DIGITS)
1520   FOR I1 = 1 TO 4
1530     IF P+I1>LEN(S$) THEN GOTO 1700 : REM AT END OF LINE & ALSO STMT #
1540     A = ASC(SBS$(S$, P+I1, 1))
1560     IF A<48 THEN GOTO 1700        : REM  FOUND NON-DIGIT
1580     IF A>57 THEN GOTO 1700        : REM  FOUND NON-DIGIT
1600   NEXT I1
1700   N = VAL(SBS$(S$, P, I1)) : GOTO 1720  : REM STMT #
1710   N = -1 : REM VAR. STMT #, EXCEPT IF
1715   IF I2=4 THEN 1280 : REM            THEN NOT FOLLOWED BY #; J STAYS SAME
1720   P = -P   :   REM  SAVE POS. AS <0 TO INDICATE STMT. NOT CHANGED
1730 GOSUB 9000 : REM I IS LINE #
1735 REM SAVE POS(P) OF #(N) W/IN LINE(I) OF REC(R)
1740   O$ =RJS$(" "+STR$(P)+" "+STR$(N)+" "+STR$(R)+" "+STR$(I)+" "+STR$(I),28)
1750  PRINT #3, O$
1760   P = -P + I2 : GOTO 1260 : REM MORE OF SAME KEYWORD?
1800  NEXT I2
1900 NEXT R
2000 REM  PASS 2 - RENUMBER LINE NUMBERS & CHANGE LINE #'S IN ARRAY
2001 PRINT "PASS 2"
2100 CLOSE 4 : OPEN #4, P1$+"/RO/LN:132/EN:3000"
2200 FOR L = L0 TO 32767 STEP L9
2220  INPUT LINE #4, S$
2222   S$=TRM$(LTR$(S$))
2225  IF LEN(S$)=0 THEN L=L-L9 : GOTO 2800 : REM  SKIP NULL LINES
2300  GOSUB 9000 :  REM  I = STMT # OF LINE S$
2440  IF I < L1 THEN GOTO 2800   :  REM  DON'T RESEQ
2460  IF I > L2 THEN GOTO 3000   :  REM  RESEQ COMPLETE
2480  REM I IS OLD LINE #; L IS NEW LINE #.  I1 IS CHAR AFTER LINE #
2520  O$ = STR$(L) + SBS$(S$, I1, LEN(S$)-I1+1) :  REM  REPLACE LINE #
2530 O=132 : GOSUB 31000
2535  S$=O$   :   REM                LJS$(S$,132)
2540  PRINT #6, S$
2600  REM  IF OLD # IS IN ARRAY, CHANGE IT
2610   CLOSE 3 : OPEN #3, "STMTS.TMP;1/MO/RN/LN:28"
2620  FOR I1 = 1 TO J
2630  INPUT #3'I1, P,N,R,I2,I3
2632  IF I<>I2 THEN GOTO 2640
2634 REM  LINE I HAS # IN IT.  CHANGE POS TO COMPENSATE FOR NEW LINE # LEN. P<0
2636 P = SGN(P) * (ABS(P)+LEN(STR$(L))-LEN(STR$(I))) : REM KEEP P SAME SIGH
2640  IF I<>N THEN GOTO 2680 : REM NOT IN ARRAY; P STAYS <0
2660  IF P<0 THEN I3=N : N=L : P=-P : REM CHANGE # IF NOT CHANGED.  SAVE OLD #
2680  O$=RJS$(" "+STR$(P)+" "+STR$(N)+" "+STR$(R)+" "+STR$(I2)+" "+STR$(I3),28)
2690   PRINT #3'I1, O$
2700  NEXT I1
2800 NEXT L
3000 REM   PASS 3   CHANGE #'S WITHIN STATEMENTS
3001 PRINT "PASS 3"
3100 REM   CLOSE FILES & RE-OPEN NEW PROGRAM FOR RANDOM ACCESS
3120 CLOSE 4,6
3140  OPEN #6, P2$ + "/MO/RN/LN:132"
3160 INPUT #3'1, P, N, R, L, I3
3180  INPUT LINE #6'R, S$
3190   S$=TRM$(LTR$(S$))
3200 FOR I2 = 1 TO J   : REM  GO THRU ARRAY OF STMTS TO BE CHANGED
3220  IF P > 0 THEN GOTO 3400   :   REM  STMT # IN ARRAY WAS CHANGED
3300  REM  STMT # NOT CHANGED IN ARRAY => PROBLEM OF SOME KIND
3320  IF N>0 THEN IF N<L1 THEN GOTO 3400 : REM # OUT OF RESEQ RANGE
3340  IF N > L2 THEN GOTO 3400  :  REM  # OUT OF RESEQ RANGE
3360  GOSUB 9000  : REM  PROB; GET STMT #, NEW PGM LINE
3370  IF N=-1 THEN PRINT "VAR. STMT# IN ";P2$;" LINE ";I : GOTO 3460
3380  IF N = -2 THEN PRINT "NO STMT # IN ";P2$;" LINE ";I : GOTO 3460
3390  PRINT "NO OLD STMT # ";N;". ";P2$;" LINE ";I;" HAS OLD #." :GOTO 3460
3400  REM  PUT NEW STMT # INTO LINE
3440  O$ = SBS$(S$, 1, P-1) + STR$(N)
3450  O$ = O$ + SBS$(S$, P+LEN(STR$(I3)))
3451  O = 132 : GOSUB 31000
3452   S$=O$   :   REM                LJS$(S$,132)
3454  I = R
3458  IF I2 = J THEN PRINT #6'I, S$ : GOTO 8000 : REM  EOF
3460  INPUT #3'I2+1, P,N,R,L,I3
3480  IF R<>I THEN PRINT #6'I,S$ : INPUT LINE #6'R, S$: S$=TRM$(LTR$(S$))
3481 PRINT S$
3500 NEXT I2
8000 PRINT "RESEQUENCING COMPLETED"
8100 CLOSE 3,4,6
8200 SCRATCH "STMTS.TMP;1"
8300 STOP
9000 REM SUBROUTINE TO GET STMT # OF STMT IN S$. I1 IS POS OF CHAR AFTER STMT#
9100  FOR I1 = 1 TO 6  :  REM  CHECK FIRST 6 CHARS. OF LINE
9120   A = ASC(SBS$(S$, I1, 1))
9140   IF A < 48 THEN GOTO 9320   :REM NON-NUM. CHAR.
9160   IF A > 57 THEN GOTO 9320   :REM NON-NUM. CHAR.
9200  NEXT I1
9300 REM FOUND STMT#. I1 IS CHAR FOLLOWING IT; I IS STMT #
9320  I = VAL(SEG$(S$, 1, I1-1))
9400  RETURN
31000 REM   **********  LJS$(O$,O)  **************
31001 REM   LEFT JUSTIFY O$ IN A STRING OF LENGTH O.  RIGHT-PAD WITH BLANKS
31002 REM   IF LEN(O$) > O, RETURN LEFT O CHARACTERS OF O$
31010 O$=TRM$(O$) : O0=LEN(O$) : IF O0>O THEN O$=SBS$(O$,1,O) : RETURN
31020 FOR O1=1 TO O-O0 : O$=O$+" " : NEXT O1 : RETURN
32767 END
