1   PROGRAM RENUM1,2.1(116)     !Basic program line renumbering utility
2 ! RENUMBERED ON 05/25/85
3 ! Donated to AMUS, May 1985
4 ! Modified from original renumbering program vintage 1981 - author unknown.
5 ! Modified by: Chuck Brite, Trinity Gospel Temple, Canton, Ohio
6 MAP1 NMBR,S,5                 !Line number part of the source line
7 MAP1 REST,S,132               !Balance of the source line
8 MAP1 SRC'LINE,S,132           !Entire source line
9 MAP1 SAV'SRCE,S,132,""        !Saves first line when not a comment
10 MAP1 FILNAM,S,15             !Inputted name
11 MAP1 NAME,S,15               !Inputted name + extension
12 MAP1 NEWNAM,S,15             !Output file name
13 MAP1 OLDNAM,S,15             !Name to give old source file
14 MAP1 NEWLIN,F                !Line number to give date line
15 MAP1 PRTLIN,S,5              !String version of NEWLIN
16 MAP1 START'LINE,F            !Starting line number of source file
17 MAP1 COPY'TO,F               !Starting line of output file
18 MAP1 END'LINE,F              !Ending line of source file
19 MAP1 INCR,F                  !Increment to use
20 MAP1 A,F                     !Working Variables
21 MAP1 B,F                     !
22 MAP1 C,F                     !
23 MAP1 D,S,3                   !
24 MAP1 YN,S,1                  !
25 MAP1 POS,F                   !Marks end of line number
26 MAP1 BINDATE,B,4             !Variable for system date
27 MAP1 DATFILL,@BINDATE        !
28      MAP2 MMM,B,1            !
29      MAP2 DDD,B,1            !
30      MAP2 YYY,B,1            !
31 MAP1 DATT,S,8                !Date as MM/DD/YY
32
33 START:
34      BINDATE = DATE
35      DATT=(MMM USING "#Z") + "/" + (DDD USING "#Z") + "/" + (YYY USING "#Z")
36      PRINT TAB(-1,0);"PROGRAM RENUMERING UTILITY VERSION 2.1";
37 GET'FILNAM:
38      PRINT TAB(10,5);TAB(-1,10);
39      PRINT "Enter filename or END to exit (Extension BAS is default)--->";
40      INPUT LINE FILNAM
41      IF FILNAM = "END" OR FILNAM = "" &
               GOTO EXIT
42      IF INSTR(1,FILNAM,".")=0 &
               NAME = FILNAM + ".BAS" &
       ELSE &
               NAME = FILNAM
43      LOOKUP NAME,A
44      IF A=0 &
               PRINT CHR$(7);TAB(12,5);"Sorry, ";NAME;" was not found!"; :&
               FOR A = 1 TO 10000 : NEXT :&
               GOTO GET'FILNAM         !AM100 & T users change 10000 to 1000
45      A = INSTR(1,FILNAM,":") + 1     !Does name have a device? (ie- DSK2:)
46      IF A > 1 &
               FILNAM = FILNAM[A,-1]   !Delete device name from FILNAM
47      A = INSTR(1,FILNAM,".") + 1     !Does name have an extension? (.BAS)
48      IF A > 1 &
               FILNAM = FILNAM[1,A-1]  !Delete extension from FILNAM
49 CONDITIONS:
50      PRINT TAB(12,5);"Use standard conditions? (ie: Renumber all lines in the";
51      PRINT TAB(13,5);"source program - the output file numbering to start at line";
52      PRINT TAB(14,5);"100 and increment by 10.)";
53      PRINT TAB(16,5);"Standard conditions?  (RETURN/N)--->";
54      INPUT LINE YN
55      IF YN # "N" AND YN # "n" &
               GOTO STANDARD
56      PRINT TAB(18,5);"Start with which line number in source program--->";
57      INPUT LINE START'LINE
58      IF START'LINE = 0 &
               START'LINE = 1
59      PRINT TAB(19,5);"Copy to what start number in the output program--->";
60      INPUT LINE COPY'TO
61      IF COPY'TO = 0 &
               COPY'TO = 100
62      PRINT TAB(20,5);"End with what line number in the source program--->";
63      INPUT LINE END'LINE
64      IF END'LINE = 0 &
               END'LINE = 65534
65      PRINT TAB(21,5);"Use what line number increment (default=10)--->";
66      INPUT LINE INCR
67      IF INCR = 0 &
               INCR = 10
68 ANYCNG:
69      PRINT TAB(23,5);"Any Change? (Y/RETURN)--->";
70      INPUT LINE YN
71      IF YN = "Y" OR YN = "y" &
               PRINT TAB(12,5);TAB(-1,10); :&
               GOTO CONDITIONS
72 OPEN'FILES:
73      PRINT TAB(2,1);TAB(-1,10);"RENUMBERING ";NAME;
74      OPEN #1,NAME,INPUT
75      B = INSTR(1,NAME,".") - 1
76      NEWNAM = NAME[1,B] + ".NEW"
77      LOOKUP NEWNAM,A
78      IF A # 0 &
               KILL NEWNAM
79      OPEN #2,NEWNAM,OUTPUT
80      OLDNAM = NAME[1,B] + ".REN"
81      LOOKUP OLDNAM,A
82      IF A # 0 &
               KILL OLDNAM
83 TITLE'LINE:
84      INPUT LINE #1,SRC'LINE          !Read first line
85      CALL GET'LINE'NUMB
86      NMBR = SRC'LINE[1,(POS-1)]
87      REST = SRC'LINE[POS,-1]
88      IF NMBR >= START'LINE &
               NMBR = COPY'TO
89      A = INSTR(1,REST,"PROGRAM")     !Check for PROGRAM statement
90      B = INSTR(1,REST,"(")           !Check for edit number
91      C = INSTR(1,REST,")")
92      IF A=0 OR B=0 OR C=0 OR B<A &
               CALL TITLE :&
               SRC'LINE = NMBR + "   PROGRAM "+FILNAM+",1.0(99) !"+ SRC'LINE :&
       ELSE &
               SRC'LINE = NMBR + REST
93      B = INSTR(1,SRC'LINE,"(")       !Get new location of edit number
94      C = INSTR(1,SRC'LINE,")")
95      PRINT TAB(3,1);TAB(-1,10);TAB(10,30);"SOURCE";TAB(10,40);"OUTPUT";TAB(12,28);
96      IF START'LINE <> 1 &
               PRINT TAB(12,35);"Running";TAB(12,28);
97 UPDATE'VERSION'NUM:
98      B = B+1 : C=C-1                 !Get edit number between parentheses
99      A = VAL(SRC'LINE[B,C])          !A is the edit number
100     IF A > 126 AND A < 131 &
               A = 131                 !Fix apparent bug in PROGRAM statement
101     D = STR(A + 1)                  !Increment edit number by one
102     SRC'LINE = SRC'LINE[1,B-1] + D + SRC'LINE[C+1,-1]
103     PRINT #2,SRC'LINE               !Output first line
104     CALL DATE'LINE
105 READ'2ND'SOURCE'LINE:
106     INPUT LINE #1, SRC'LINE
107     IF INSTR(1,SRC'LINE,"RENUM") = 0 &
               GOTO READ1      !Does 2nd source line have "RENUMBERED"?
                               !If not, bypass next input
108 READ'SOURCE'FILE:
109     INPUT LINE #1,SRC'LINE
110     IF EOF(1)=1 &
               GOTO DONE
111 READ1:
112     CALL GET'LINE'NUMB
113     NMBR=SRC'LINE[1,(POS-1)]
114     IF VAL(NMBR) < START'LINE &
               PRINT #2,SRC'LINE :&
               GOTO READ'SOURCE'FILE
115     IF VAL(NMBR) > END'LINE AND VAL(NMBR) <= COPY'TO &
               CALL BAD'RANGE
116     IF VAL(NMBR) > END'LINE &
               PRINT #2,SRC'LINE :&
               PRINT TAB(14,34);TAB(-1,9);"Bypassing"; :&
               GOTO READ'SOURCE'FILE
117     PRINT "   ";NMBR;SPACE(9);TAB(12,40);COPY'TO;TAB(12,28);
118     REST=SRC'LINE[POS,-1]
119     NMBR=COPY'TO
120     SRC'LINE=NMBR+REST
121     PRINT #2, SRC'LINE
122     COPY'TO=COPY'TO + INCR
123     GOTO READ'SOURCE'FILE
124
125 DONE:
126     CLOSE #1 : CLOSE #2 : B=0
127     XCALL RENAME,NAME,OLDNAM,A      !*.BAS to *.REN
128     IF A # 0 &
               B=1 : GOTO RENAME'ERR
129     XCALL RENAME,NEWNAM,NAME,A      !*.NEW to *.BAS
130     IF A # 0 &
               B=2 : GOTO RENAME'ERR
131 END'LINE:
132     PRINT TAB(4,1);TAB(-1,10);"DONE";
133     PRINT TAB(6,1);"OK to compile?  (RETURN/N)--->";
134     INPUT LINE YN
135     IF YN = "N" OR YN = "n" &
               GOTO EXIT
136 CREATE'COMMAND'FILE:
137     OPEN #3,"REN.CMD",OUTPUT
138     PRINT #3,":R"
139     PRINT #3,"COMPIL "+NAME+"/M"
140     PRINT #3,":S"
141     PRINT #3,"ERASE REN.CMD"
142     PRINT #3,":<"
143     PRINT #3," "
144     PRINT #3,"DONE"
145     PRINT #3,">"
146     CLOSE #3
147     PRINT
148     CHAIN "REN.CMD"
149
150 !**************************** EXCEPTIONS *******************************
151
152 EXIT:
153     PRINT TAB(-1,0);TAB(4,1);"EXIT"
154     PRINT : PRINT : END
155
156 STANDARD:
157     START'LINE = 1
158     COPY'TO = 100
159     END'LINE = 65534
160     INCR = 10
161     GOTO OPEN'FILES
162
163 BAD'RANGE:
164     PRINT CHR$(7);TAB(20,5);"Insufficient space to renumber with the increment you specified!";
165     PRINT TAB(21,5)"Try again using smaller increment.";
166     CLOSE #1: CLOSE #2
167     PRINT TAB(23,5);"RETURN to continue--->";
168     INPUT LINE YN
169     PRINT TAB(3,1);TAB(-1,10);
170     GOTO CONDITIONS
171
172 RENAME'ERR:
173     PRINT TAB(4,1);TAB(-1,10);TAB(8,1);"ERROR...";
174     IF B=1 &
               PRINT NAME; &
       ELSE &
               PRINT NEWNAM;
175     PRINT " could not be renamed!"
176     END
177
178 !************************** SUBROUTINES ********************************
179
180 GET'LINE'NUMB:
181     A=INSTR(1,SRC'LINE," ")
182     B=INSTR(1,SRC'LINE,CHR(9))
183     IF A=0 AND B=0 &
               POS=(LEN(SRC'LINE)+1) &
       ELSE IF A=0 &
               POS=B &
       ELSE IF B=0 &
               POS=A &
       ELSE IF B>A &
               POS=A &
       ELSE IF A>B &
               POS=B
184     RETURN
185
186 DATE'LINE:                          !Put date on 2nd output line
187     NEWLIN = (VAL(NMBR) + 1)
188     PRTLIN = STR(NEWLIN)
189     SRC'LINE = PRTLIN + " ! RENUMBERED ON "+DATT
190     PRINT #2,SRC'LINE               !Output second line
191 NEW'LINE'NUM:
192     IF INCR = 1 &
               COPY'TO = NEWLIN + INCR &
       ELSE IF NMBR >= START'LINE &
               COPY'TO = COPY'TO + INCR
193     IF SAV'SRCE = "" &
               RETURN
194     IF INCR < 3 &
               NEWLIN = NEWLIN + INCR &
       ELSE &
               NEWLIN = COPY'TO
195     PRTLIN = STR(NEWLIN)
196     SRC'LINE = PRTLIN + SAV'SRCE
197     PRINT #2,SRC'LINE       !Output original first source line as line 3.
198     SAV'SRCE = ""
199     GOTO NEW'LINE'NUM
200
201 TITLE:
202     A = INSTR(1,REST,"!")           !Is there a comment character?
203     IF A = 0 OR A > 2 &
               A= INSTR(1,REST,"REM")  !Is there a REMark statement?
204     PRINT TAB(4,1);TAB(-1,10);
205     SRC'LINE = ""
206     IF A > 0 AND A < 3 &
               GOTO COMMENT            !Original source line has comment
207 INPUT'TITLE:                        !Original source line has no comment.
208     SAV'SRCE = REST[A+1,-1]         !Save contents for third output line
209     PRINT "Enter title to follow PROGRAM statement.  50-60 characters maximum.";
210     PRINT TAB(6,1);"Enter Title----->";
211     INPUT LINE SRC'LINE
212     RETURN
213 COMMENT:
214     PRINT "First source line is as follows:";
215     PRINT TAB(6,10);REST;
216     PRINT TAB(8,1);"Enter new title (50-60 characters) below or <RETURN> if no change.";
217     PRINT TAB(10,1);"New Title ----->";
218     INPUT LINE SRC'LINE
219     IF SRC'LINE = "" &
               SRC'LINE = REST         !No change, keep it the same.
220     RETURN

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.