Listing of file='HLDA010H' on disk='vmedia/letter_editor.wvd.zip'
# Sector 254, program filename = 'HLDA010H'
0010 REM ***** HLDA010H - REVISED 1600 08/18/76 ***** COPYRIGHT WANG LABS, 197
6
0030 COM A,A$2,C1,G$,I0$,K1,J,J1,K,K$1,L,L1,M,M$,N$,N$(16),N1$,O,Q$64,S$64
: COM S1$(1)64,Q1$64,Q2$64,B1$2,B2$2,B$(80)1
: COM R1$(16)1,R2$(80)1,R3$(10)1,R4$(10)1,S0,S1,S2,S3,S4,S5,T,T0,T1,T2,T3
: COM X,P1$(81)1,C0,C$(2)40,B$1,D$,D,I,J0,G$(1)10,C,E$(1)2,P,P$(60)40,W
: COM CLEAR A
0230 GOTO 520
0260 IF C>=1THEN 280
: C=1
0280 P=C-INT((C-1)/W)*W
: RETURN
0320 J0=1
: PRINT HEX(01);
0340 $GIO/005,(400DA000400A,I0$)P$()<J0,W>
: J0=J0+W
: IF J0<=15*WTHEN 340
: IF O=0THEN 420
: PRINT HEX(0D);"WORK AREA OVERFLOW";
: P,C=1
0420 $GIO/005,(A000,I0$)R1$()<1,(C-1)/W+1>
: $GIO/005,(A000,I0$)R2$()<1,P>
: RETURN
0450 C0=C1
: IF C0<=15*W+1THEN 480
: C0=15*W+1
0480 RETURN
0510 DEFFN'5
0520 INIT(0A)R1$()
: R1$(1)=HEX(01)
: INIT(09)R2$()
: R2$(1)=HEX(0D)
: C$(1)=HEX(070707080809090908)
: MAT COPY C$()TO R3$()
: C$(1)=HEX(00020401030002040C)
: MAT COPY C$()TO R4$()
: A$=HEX(0000)
: C,P=1
: C2=1921
: GOTO 3450
0680 I=C-P+1
: D$="<"
0700 MAT COPY P$()<I,10>TO G$()
: IF STR(G$(1),1,1)=D$THEN 810
0720 MAT COPY P$()<I+W,10>TO G$()
: IF STR(G$(1),1,1)=B$THEN 1100
: IF STR(G$(1),1,1)=D$THEN 1010
0750 J=1
0760 MAT SEARCHP$()<I+J,W-J>,=D$TO E$()
: IF E$(1)>A$THEN 1180
: I=I+W
: IF I<=C1THEN 700
: RETURN
0810 MAT COPY P$()<I,10>TO G$()
: GOSUB 870
: IF K=0THEN 720
: GOSUB 910
: IF K=1THEN 1100
: GOTO 720
0870 K=POS(G$(1)=3E)
: IF K=0THEN 900
: G$=STR(G$(1),1,K)
0900 RETURN
0910 K=1
0920 IF G$="<EOD>"THEN 1000
: IF G$="<CENTER>"THEN 1000
: IF G$="<MEMO>"THEN 1000
: IF G$="<FORMAT>"THEN 1000
: IF G$="<REW-STOP>"THEN 1000
: IF G$="<REW-GO>"THEN 1000
: IF G$="<PAGE>"THEN 1000
: K=0
1000 RETURN
1010 GOSUB 870
: IF K=0THEN 750
: GOSUB 1060
: IF K=1THEN 1100
: GOTO 750
1060 K=1
: IF G$="<TAB>"THEN 1000
: IF G$="<C-TAB>"THEN 1000
: GOTO 920
1100 H,I=I+W
: MAT SEARCHP$()<I,2401-I>,<>B$TO E$()
: IF E$(1)=A$THEN 1150
: I=I+256*VAL(E$(1))+VAL(STR(E$(1),2))-1
: I=INT((I-1)/W)*W+1
1150 IF I<=15*WTHEN 1170
: I=14*W+1
1170 RETURN
1180 J=J+VAL(STR(E$(1),2))
: MAT COPY P$()<I+J-1,10>TO G$()
: IF STR(G$(1),1,7)="<C-RET>"THEN 1100
: IF STR(G$(1),1,9)="<SW-READ>"THEN 1100
: IF STR(G$(1),1,9)="<BLK-LNK>"THEN 1100
: GOTO 760
1260 MAT COPY S1$()TO P1$()<2,80>
: L1=C1-C+P-W-1
: MAT COPY -P$()<C-P+W+1,L1>TO -P$()<C-P+W+1,2400-C+P-W>
: C2=2401-L1-3*W
: C0=C0+L1
: IF C0<15*W+1THEN 1350
: C0=15*W+1
1350 MAT COPY P1$()<2,80>TO P$()<C,80>
1360 GOSUB 1480
: MAT COPY P$()<2401-L1,L1>TO P$()<J0,2401-J0>
: C1=J0+L1
: J0=C-P+1
1420 GOSUB 1660
: C2=1921
: GOSUB 320
: RETURN
1480 J0=C-P+1
: J1=J0+3*W-1
: MAT SEARCHP$()<J0,W>,<>B$TO E$()
: IF E$(1)<>A$THEN 1560
: J0=J0+W
: RETURN
1540 MAT SEARCHP$()<J0,W>,<>B$TO E$()
: IF E$(1)=A$THEN 1630
1560 MAT COPY -P$()<J0,W>TO C$()
: MAT SEARCHC$(),=B$TO E$()
: D=VAL(STR(E$(1),2))-1
: MAT COPY -P$()<J0+W-D,J1-J0-W+1>TO -P$()<J0+W-D,J1-J0-W+D+1>
: J0=J0+W
: J1=J1+W
: GOTO 1540
1630 RETURN
1660 GOSUB 680
: J0=C-P+1
1670 H=H-W
1680 IF J0>=HTHEN 1970
: MAT COPY -P$()<J0,W>TO C$()
: MAT SEARCHC$(),<>B$TO E$()
: M=W+3-VAL(STR(E$(1),2))
: IF E$(1)=A$THEN 1970
: IF M<3THEN 1830
: MAT COPY P$()<J0+M-3,1>TO E$()
: IF E$(1)="."THEN 1800
: IF E$(1)="-"THEN 1820
: GOTO 1830
1780 M=1
: GOTO 1830
1800 M=M+1
: GOTO 1830
1820 M=M-1
1830 L=W-M+1
: IF L<=0THEN 1910
: MAT COPY -P$()<J0+W,L>TO C$()
: MAT SEARCHC$()<1,L>,=B$TO E$()
: IF E$(1)=A$THEN 1910
: D=L-VAL(STR(E$(1),2))+1
: MAT COPY P$()<J0+W,D>TO P$()<J0+M-1,D>
: MAT COPY P$()<J0+W+D,W-D>TO P$()<J0+W,W>
1910 J0=J0+W
: MAT SEARCHP$()<J0,W>,<>B$TO E$()
: IF E$(1)=A$THEN 1980
: D=VAL(STR(E$(1),2))
: MAT COPY P$()<J0+D-1,W-D+1>TO P$()<J0,W>
: GOTO 1680
1970 RETURN
1980 MAT COPY P$()<J0+W,2401-J0-W>TO P$()<J0,2401-J0>
: C1=C1-W
: J0=J0-W
: GOTO 1670
2040 MAT COPY P$()<C,W-P+1>TO P1$()<2,80>
: GOTO 2130
2080 MAT COPY P1$()<2,80>TO P$()<C,W-P+1>
: J0=C-P+1
: GOTO 1420
2130 IF V1>W-P+1THEN 2170
: D=V1
: MAT COPY P1$()<D+1,80-D>TO P1$()<2,80>
: GOTO 2080
2170 INIT(20)P1$()
: J0=C-P+1
: D=V1+P-1
: E$(1)=" "
: MAT COPY E$()TO P$()<J0+W,D>
: L=INT(D/W)+1
: MAT COPY P$()<J0+L*W,2401-J0-L*W>TO P$()<J0+W,2401-J0-W>
: C1=C1-(L-1)*W
: MAT SEARCHP$()<J0+W,W>,<>B$TO E$()
: IF E$(1)=A$THEN 2300
: D=VAL(STR(E$(1),2))
: MAT COPY P$()<J0+W+D-1,W-D+1>TO P$()<J0+W,W>
: GOTO 2080
2300 MAT COPY P$()<J0+W+W,2401-J0-W-W>TO P$()<J0+W,2401-J0-W>
: GOTO 2080
3130 DATA LOAD BA T#2,(5*S2+T2+U,A)N$()
: T2=T2+1
: IF T2<=5THEN 3180
: S2=VAL(T$(S2))
: T2=1
3180 RETURN
3210 O=0
: IF S2=0THEN 3370
: D$=HEX(0F)
: S0,S1=S2
: T0,T1=T2
: J0=1
3270 IF S2=0THEN 3370
: IF J0>12*W+1THEN 3310
: S3=S2
: T3=T2
3310 GOSUB 3130
: MAT COPY N$()TO P$()<J0,2401-J0>
: MAT SEARCHP$()<J0,2401-J0>,=D$TO E$()
: IF E$(1)=A$THEN 3410
: J0=J0+256*VAL(E$(1))+VAL(STR(E$(1),2))-1
: IF J0<15*WTHEN 3270
3370 F1,C0,C1=J0
: E$(1)=" "
: MAT COPY E$()TO P$()<J0,2401-J0>
: RETURN
3410 STOP "NO HEX(0F) CODE ON DISK."
3440 DEFFN'2
3450 SELECT PRINT 005(250)
: PRINT HEX(03);TAB(18);"G L O B A L R E P L A C E"
: A$=HEX(0000)
: GOSUB 8530
3500 GOSUB 9210
: J0,T2=1
3530 GOSUB 3210
: GOTO 4460
3570 S2=S3
: T2=T3
3590 J0=1
: INIT(20)P$()
: PRINT HEX(03)
: GOTO 3530
3650 S2=S1
: T2=T1
: GOTO 3590
3780 E$(1)=HEX(0F)
: MAT COPY E$()TO P$()<C1,1>
: J0=1
: S4=S1
: S5=VAL(T$(S1))
: BIN(T$(S1))=F
3860 MAT COPY P$()<J0,3*W>TO N$()
: MAT COPY E$()TO N$()<3*W+1,1>
: IF J0>12*W+1THEN 3920
: S3=S1
: T3=T1
3920 GOSUB 4270
: J0=J0+3*W
: IF J0<C1THEN 3860
: IF S2=0THEN 4020
3970 DATA LOAD BA T#2,(5*S2+T2+U,A)N$()
: GOSUB 4270
: T2=T2+1
: IF T2<=5THEN 3970
4020 IF T1=1THEN 4070
: MAT COPY E$()TO N$()
4040 DATA SAVE BA T#2,(5*S1+T1+U,A)N$()
: T1=T1+1
: IF T1<=5THEN 4040
4070 F=VAL(T$(S4))
: IF S2>0THEN 4110
: T$(S4)=HEX(00)
: GOTO 4130
4110 T$(S4)=T$(S2)
: T$(S2)=HEX(00)
4130 BIN(T$(F0))=S5
4140 IF T$(F0)=HEX(00)THEN 4170
: F0=VAL(T$(F0))
: GOTO 4140
4170 GOSUB 9450
: S2=S0
: T2=T0
: J0=1
: INIT(20)P$()
: GOSUB 3210
: GOTO 4630
4270 S4=S1
: DATA SAVE BA T#2,(5*S1+T1+U,A)N$()
: T1=T1+1
: IF T1<=5THEN 4330
: T1=1
: S1=VAL(T$(S1))
4330 RETURN
4460 PRINT HEX(03);TAB(18);"G L O B A L R E P L A C E"
: GOSUB '32("ENTER THE CHARACTERS TO SEARCH FOR",60)
: S9=D-1
: J2=0
: S$=Q$
: GOSUB 5020
: S=POS(S$=20)-1
: IF S>0THEN 4630
: S=1
: GOTO 4630
4580 IF F1<=12*WTHEN 4900
: S2=S3
: T2=T3
: GOSUB 3210
: J2=0
4630 MAT SEARCHP$()<J2+1,12*W-J2>,=STR(S$,1,S)TO E$()
: IF E$(1)=A$THEN 4580
: V1,V2=S
: J2=J2+256*VAL(E$(1))+VAL(STR(E$(1),2))
: MAT COPY P$()<J2,80>TO P1$()
4680 IF P1$(V1)<>STR(S$,V2,1)THEN 4630
: IF P1$(V1)=B$THEN 4800
: V1=V1+1
: IF V1>81THEN 4630
: V2=V2+1
: IF V2<=S9THEN 4680
: C=J2
: IF C0<=15*W+1THEN 4770
: C0=15*W+1
4770 GOSUB 260
: GOSUB 320
: GOTO 5110
4800 V1=V1+1
: IF P1$(V1)<>B$THEN 4840
: IF V1<=80THEN 4800
: GOTO 4630
4840 V2=V2+1
: IF STR(S$,V2,1)<>B$THEN 4680
: IF V2<S9THEN 4840
: GOTO 4630
4900 PRINT HEX(03);TAB(18);"G L O B A L R E P L A C E"
: GOSUB '32("DO YOU WANT TO START OVER? (Y/N)",1)
4930 IF Q$="Y"THEN 3500
: IF Q$="y"THEN 3500
: IF Q$="N"THEN 4990
: IF Q$="n"THEN 4990
: GOSUB '34("INVALID REPLY. ANSWER 'Y' OR 'N'.")
: GOTO 4930
4990 GOSUB '15
5020 GOSUB '32("ENTER THE CHARACTERS TO REPLACE THEM WITH.",60)
: S1$(1)=Q$
: L2=D-1
: GOSUB '32("DO YOU WANT AUTOMATIC REPLACEMENT OF CHARACTER STRINGS? (Y/N)"
,1)
5077 Z1$=Q$
: IF Q$="Y"THEN 5083
: IF Q$="y"THEN 5083
: IF Q$="N"THEN 5083
: IF Q$="n"THEN 5083
: GOSUB '34("INVALID REPLY. ANSWER 'Y' OR 'N'.")
: GOTO 5077
5083 RETURN
5110 KEYIN K$,5120,5120
: IF Q$="Y"THEN 5150
: IF Q$="y"THEN 5150
5120 KEYIN K$,5130,5130
: GOTO 5120
5130 IF K$=" "THEN 4630
: IF K$=HEX(0D)THEN 5150
: GOTO 5120
5150 C=C+V1-1
: P=C-INT((C-1)/W)*W
: MAT COPY P$()<C,W-P+1>TO P1$()
: E$(1)=" "
: MAT COPY E$()TO P$()<C,W-P+1>
: J0=C-P+1+W
: L1=C1-J0
: MAT COPY -P$()<J0,L1>TO -P$()<J0,2401-J0>
: MAT COPY S1$()TO P$()<J2,L2>
: MAT COPY P1$()TO P$()<J2+L2,W>
: C=J2
: P=C-INT((C-1)/W)*W
: GOSUB 1360
: GOTO 3780
8050 DEFFN'32(Q1$,N)
: GOSUB 8460
8070 PRINT HEX(010A);Q1$;HEX(0D0A)
: INIT(2D)Q$
: $GIO/005(40204020A000402F400D,I0$)Q$<1,N>
: Q$=" "
: D=1
: PRINT "? ";
8150 KEYIN D$,8160,8150
: GOTO 8150
8160 IF D$=HEX(0D)THEN 8330
: IF D$=HEX(08)THEN 8280
: IF D$=HEX(A1)THEN 8250
: IF D>NTHEN 8150
: IF D$=HEX(84)THEN 8350
: STR(Q$,D,1)=D$
8220 PRINT D$;
: D=D+1
: GOTO 8150
8250 PRINT HEX(0D0909);
: D=1
: GOTO 8150
8280 IF D=1THEN 8150
: D=D-1
: STR(Q$,D,1)=" "
: PRINT HEX(082008);
: GOTO 8150
8330 PRINT HEX(0D0A)
: RETURN
8350 OR (STR(Q$,D,1),80)
: D$=STR(Q$,D,1)
: GOTO 8220
8400 DEFFN'34(Q2$)
: GOSUB 8460
: PRINT HEX(010A0A0A);Q2$
: GOTO 8070
8460 PRINT HEX(010A);
: GOSUB 8490
: GOSUB 8490
8490 $GIO/005(400DA000400A,I$)B$()<1,W>
: RETURN
8530 Q1$="MOUNT DISK AND ENTER VOLUME NAME."
: Q2$="DEFAULT NAME ="
: STR(Q2$,16)=F$
: N=8
: GOSUB '34(Q2$)
8540 IF Q$=" "THEN 8700
: IF Q$="STOP"THEN 8760
: IF Q$="stop"THEN 8760
: F$=Q$
8570 GOSUB 8790
: IF I>0THEN 8610
: GOSUB '34("VOL. NAME DOES NOT EXIST OR IS SCRATCHED.")
: GOTO 8540
8610 GOSUB 8960
: IF U>0THEN 8650
: GOSUB '34("THIS VOL. IS ALREADY IN USE.")
: GOTO 8540
8650 DATA LOAD BA T#2,(U,B1$)N$()
: MAT COPY N$()TO T$()
: F=VAL(STR(N$(13),9))
: F0=VAL(STR(N$(13),10))
: IF W=VAL(STR(N$(13),11))THEN 8690
: GOSUB '34("LINE LENGTH FOR VOLUME IS WRONG SIZE.")
: GOTO 8540
8690 RETURN
8700 Q$=F$
: IF Q$<>" "THEN 8570
: GOSUB '34("A VOL. NAME MUST BE ENTERED.")
: GOTO 8540
8750 DEFFN'15
8760 LOAD DC T#1,"HLDA010A"
8790 B1$,B2$=A$
: DATA LOAD BA T#2,(B1$,B1$)N$()
: I=0
: STR(B2$,2)=STR(N$(1),2)
8830 D=9
8840 MAT SEARCHN$()<D,257-D>,=STR(Q$,1,8)TO E$()STEP 16
: IF E$(1)>A$THEN 8890
8860 IF B1$>=B2$THEN 8920
: DATA LOAD BA T#2,(B1$,B1$)N$()
: GOTO 8830
8890 D=D+VAL(STR(E$(1),2))-1
: I=(D+7)/16
: IF STR(N$(I),1,1)=HEX(10)THEN 8920
: I=0
: D=D+16
: IF D<256THEN 8840
: GOTO 8860
8920 RETURN
8950 I=9
: GOTO 8970
8960 I=1
8970 LIMITS T#1,"ACTIVE",U1,U2,U2
: U=0
: DATA LOAD BA T#6,(U1,A)N$()
: STR(N$(VAL(Z$)),I,8)=F$
: FOR J=1TO 4
: IF J=VAL(Z$)THEN 9015
: IF STR(N$(J),1,8)=F$THEN 9040
: IF STR(N$(J),9,8)=F$THEN 9040
9015 NEXT J
: DATA SAVE BA T#1,(U1,A)N$()
: LIMITS T#2,F$,U,U1,U2
9040 VERIFY T#1,(1,1)
: RETURN
9090 T2=1
: FOR I=1TO 4
: DATA LOAD BA T#2,(U+I,B1$)N$()
: MAT SEARCHN$()<1,250>,=STR(Q$,1,5)TO E$()STEP 5
: IF E$(1)=A$THEN 9160
: S2=50*(I-1)+(VAL(STR(E$(1),2))+4)/5
: GOSUB '32("ENTER THE NUMBER OF RECORDS TO SKIP",3)
9143 IF Q$=" "THEN 9150
: IF NUM(Q$)=64THEN 9146
: GOSUB '34("INVALID NUMBER.")
: GOTO 9143
9146 CONVERT Q$TO I
9147 IF T$(S2)=HEX(00)THEN 9150
: IF I<1THEN 9150
: S2=VAL(T$(S2))
: I=I-1
: GOTO 9147
9150 RETURN
9160 NEXT I
: S2=0
: RETURN
9210 GOSUB '32("ENTER NAME OF LETTER OR DOCUMENT",5)
9212 IF Q$<>" "THEN 9220
: GOSUB '34("A DOCUMENT NAME MUST BE ENTERED.")
: GOTO 9212
9220 GOSUB 9090
: GOSUB 8460
: IF S2>0THEN 9490
: STR(Q$,LEN(Q$)+2)="IS NOT ON DISK."
: GOSUB '34(Q$)
: GOTO 9212
9450 MAT COPY T$()TO N$()<1,200>
: BIN(STR(N$(13),9))=F
: BIN(STR(N$(13),10))=F0
: BIN(STR(N$(13),11))=W
: DATA SAVE BA T#2,(U,A)N$()
9490 RETURN