Listing of file='HLDA010J' on disk='vmedia/letter_editor.wvd.zip'
# Sector 326, program filename = 'HLDA010J'
0010 REM ***** HLDA010J - REVISED 1605 08/18/76 ***** COPYRIGHT WANG LABS, 197
6
0020 COM P$(40)40,E$(1)2,A$2,T$(200)1,T1$(200)1
: COM M$1,M(9,2),K$1
: COM U,V,S1,T1,S2,T2,F$8,F1$8,N9$5
: COM Q$64,Q1$64,Q2$64,B$(80)1,G$(1)10,N$(16)
: COM CLEAR P$()
: INIT(00)A$
: PRINT HEX(03);TAB(23);"M O V E T E X T"
: GOSUB 6000
: GOSUB 6770
: S=S2
: J0=1
: GOSUB 5020
: J1=1
0290 GOSUB 5420
0310 KEYIN K$,320,315
: GOTO 310
0315 IF K$=HEX(0B)THEN 1230
: GOTO 310
0320 IF K1$<>K$THEN 1020
0330 $GIO/005(A000400D400A,I$)K$
: J1=J1+W
: IF J1<=J2THEN 310
: GOSUB 5350
: GOSUB 5020
: IF J0=1THEN 1230
: J1=1
: GOTO 290
0390 CONVERT K$TO L1
: IF M(L1,1)<>0THEN 310
: S3,M(L1,1)=F
: T3=1
: I=J1
: E$(1)=HEX(0F)
: MAT COPY E$()TO N$()<3*W+1,1>
0470 MAT COPY P$()<I,3*W>TO N$()<1,3*W>
: GOSUB 930
: IF S3=0THEN 597
: I=I+3*W
: IF I<J0THEN 470
: IF S2=0THEN 550
: FOR I=T2TO 5
: DATA LOAD BA T#2,(U+5*S2+I,A)N$()
: GOSUB 930
: IF S3=0THEN 597
: NEXT I
0550 INIT(0F)N$()
: FOR I=T3TO 5
: DATA SAVE BA T#2,(U+5*S3+I,A)N$()
: NEXT I
: F=VAL(T$(S3))
: IF F>0THEN 600
0597 STOP "DISK VOLUME IS FULL."
0600 T$(S3)=HEX(00)
: IF S2=0THEN 620
: T$(S3)=T$(S2)
: T$(S2)=HEX(00)
0620 T$(F0)=T$(S1)
0630 IF T$(F0)=HEX(00)THEN 670
: F0=VAL(T$(F0))
: GOTO 630
0670 C1,I=1
: S3=S1
: T3=T1
: BIN(T$(S1))=F
0710 IF I>=J1THEN 810
: MAT COPY P$()<I,W>TO N$()<C1,W>
: I=I+W
: C1=C1+W
: IF C1<3*WTHEN 710
: MAT COPY E$()TO N$()<C1,1>
: GOSUB 930
: IF S3=0THEN 597
: C1=1
: GOTO 710
0810 FOR I=T3TO 5
: MAT COPY E$()TO N$()<C1,1>
: DATA SAVE BA T#2,(U+5*S3+I,A)N$()
: C1=1
: NEXT I
: F=VAL(T$(S3))
: BIN(T$(S3))=M(L1,1)
: M(L2,2)=S3
: GOSUB 9450
: L2=L1
: K1$=K$
: RETURN
0930 IF S3=0THEN 597
: DATA SAVE BA T#2,(U+5*S3+T3,A)N$()
: T3=T3+1
: IF T3<=5THEN 990
: T3=1
: S3=VAL(T$(S3))
0990 RETURN
1020 IF K1$<>" "THEN 1090
: IF K$<"1"THEN 310
: IF K$>"9"THEN 310
: CONVERT K$TO L2
: M(L2,1)=S1
: K1$=K$
: GOTO 330
1090 IF K$=HEX(0D)THEN 1170
: IF K$=HEX(A0)THEN 1170
: IF K$=HEX(CB)THEN 1170
: IF K$=HEX(81)THEN 1230
: IF K$<"1"THEN 310
: IF K$>"9"THEN 310
: GOSUB 390
: S2=M(L1,1)
: T2=1
1170 J0,J1=1
: GOSUB 5020
: GOSUB 5420
: GOTO 330
1230 IF L1=0THEN 1450
: M(L1,2)=M(L1,1)
1231 IF T$(M(L1,2))=HEX(00)THEN 1238
: M(L1,2)=VAL(T$(M(L1,2)))
: GOTO 1231
1238 N=INT((S-1)/50)
: DATA LOAD BA T#2,(U+N+1,A)N$()
: G$(1)=" "
: MAT COPY G$()TO N$()<5*(S-50*N)-4,5>
: DATA SAVE BA T#2,(A-1,A)N$()
: L1=1
: IF M(L1,1)>0THEN 1320
: L1=L1+1
: GOTO 290
1320 N=INT((M(L1,1)-1)/50)
: DATA LOAD BA T#2,(U+N+1,A)N$()
: G$(1)=N9$
: MAT COPY G$()TO N$()<5*(M(L1,1)-50*N)-4,5>
: DATA SAVE BA T#2,(A-1,A)N$()
: L2=L1+1
1380 IF M(L2,1)>0THEN 1410
1390 L2=L2+1
: IF L2<=9THEN 1380
: GOTO 1435
1410 BIN(T$(M(L1,2)))=M(L2,1)
: L1=L2
: GOTO 1390
1435 T$(M(L1,2))=HEX(00)
: GOSUB 9450
1450 PRINT HEX(03);"END OF PROGRAM"
: GOSUB '15
5020 S1=S2
: T1=T2
5027 IF S2=0THEN 5120
: GOSUB 5270
: D$=HEX(0F)
: MAT SEARCHN$(),=D$TO E$()STEP W
: IF E$(1)>A$THEN 5080
: STOP "BAD DATA ON DISK."
5080 L=256*VAL(E$(1))+VAL(STR(E$(1),2))
: MAT COPY N$()TO P$()<J0,L>
: J0=J0+L-1
: IF J0<15*WTHEN 5027
5120 RETURN
5150 FOR I=1TO 4
: DATA LOAD BA T#3,(V+I,A)N$()
: MAT SEARCHN$()<1,250>,=STR(Q$,1,5)TO E$()STEP 5
: IF E$(1)>A$THEN 5220
: NEXT I
: N9$=Q$
: RETURN
5220 STR(Q$,LEN(Q$)+2)="ALREADY EXISTS."
: GOSUB '34(Q$)
: GOTO 5150
5270 DATA LOAD BA T#2,(U+5*S2+T2,A)N$()
: T2=T2+1
: IF T2<=5THEN 5320
: S2=VAL(T$(S2))
: T2=1
5320 RETURN
5350 IF J1<=J0THEN 5370
: J1=J0
5370 MAT COPY P$()<J1,J0-J1+1>TO P$()
: J0=J0-J1+1
: RETURN
5420 J2=14*W+1
: IF J0>J2THEN 5450
: J2=J0-W
5450 $GIO/005(4003,I$)
: FOR I=1TO J2STEP W
: $GIO/005(400DA000400A,I$)P$()<I,W>
: NEXT I
: $GIO/005(4001,I$)
: RETURN
5520 DEFFN'32(Q1$,N)
: GOSUB 5930
5540 PRINT HEX(010A);Q1$;HEX(0D0A)
: INIT(2D)Q$
: $GIO/005(40204020A000402F400D,I0$)Q$<1,N>
: Q$=" "
: D=1
: PRINT "? ";
5620 KEYIN D$,5630,5620
: GOTO 5620
5630 IF D$=HEX(0D)THEN 5800
: IF D$=HEX(08)THEN 5750
: IF D$=HEX(A1)THEN 5720
: IF D>NTHEN 5620
: IF D$=HEX(84)THEN 5820
: STR(Q$,D,1)=D$
5690 PRINT D$;
: D=D+1
: GOTO 5620
5720 PRINT HEX(0D0909);
: D=1
: GOTO 5620
5750 IF D=1THEN 5620
: D=D-1
: STR(Q$,D,1)=" "
: PRINT HEX(082008);
: GOTO 5620
5800 PRINT HEX(0D0A)
: RETURN
5820 OR (STR(Q$,D,1),80)
: D$=STR(Q$,D,1)
: GOTO 5690
5870 DEFFN'34(Q2$)
: GOSUB 5930
: PRINT HEX(010A0A0A);Q2$
: GOTO 5540
5930 PRINT HEX(010A);
: GOSUB 5960
: GOSUB 5960
5960 $GIO/005(400DA000400A,I$)B$()<1,W>
: RETURN
6000 Q1$="MOUNT DISK AND ENTER VOLUME NAME."
: Q2$="DEFAULT NAME ="
: STR(Q2$,16)=F$
: N=8
: GOSUB '34(Q2$)
6010 IF Q$=" "THEN 6170
: IF Q$="STOP"THEN 6230
: IF Q$="stop"THEN 6230
: F$=Q$
6040 GOSUB 6260
: IF I>0THEN 6080
: GOSUB '34("VOL. NAME DOES NOT EXIST OR IS SCRATCHED.")
: GOTO 6010
6080 GOSUB 6430
: IF U>0THEN 6120
: GOSUB '34("THIS VOL. IS ALREADY IN USE.")
: GOTO 6010
6120 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 6160
: GOSUB '34("LINE LENGTH FOR VOLUME IS WRONG SIZE.")
: GOTO 6010
6160 RETURN
6170 Q$=F$
: IF Q$<>" "THEN 6040
: GOSUB '34("A VOL. NAME MUST BE ENTERED.")
: GOTO 6010
6220 DEFFN'15
6230 LOAD DC T#1,"HLDA010A"
6260 B5$,B6$=A$
: DATA LOAD BA T#2,(B5$,B5$)N$()
: I=0
: STR(B6$,2)=STR(N$(1),2)
6300 D=9
6310 MAT SEARCHN$()<D,257-D>,=STR(Q$,1,8)TO E$()STEP 16
: IF E$(1)>A$THEN 6360
6330 IF B5$>=B6$THEN 6390
: DATA LOAD BA T#2,(B5$,B5$)N$()
: GOTO 6300
6360 D=D+VAL(STR(E$(1),2))-1
: I=(D+7)/16
: IF STR(N$(I),1,1)=HEX(10)THEN 6390
: I=0
: D=D+16
: IF D<256THEN 6310
: GOTO 6330
6390 RETURN
6420 I=9
: GOTO 6440
6430 I=1
6440 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 6520
: IF STR(N$(J),1,8)=F$THEN 6550
: IF STR(N$(J),9,8)=F$THEN 6550
6520 NEXT J
: DATA SAVE BA T#1,(U1,A)N$()
: LIMITS T#2,F$,U,U1,U2
6550 VERIFY T#1,(1,1)
: RETURN
6590 T2=1
: N9$=Q$
: FOR I=1TO 4
: DATA LOAD BA T#2,(U+I,B5$)N$()
: MAT SEARCHN$()<1,250>,=STR(Q$,1,5)TO E$()STEP 5
: IF E$(1)=A$THEN 6720
: S2=50*(I-1)+(VAL(STR(E$(1),2))+4)/5
: RETURN
6720 NEXT I
: S2=0
: RETURN
6770 GOSUB '32("ENTER NAME OF LETTER OR DOCUMENT",5)
6780 IF Q$<>" "THEN 6810
: GOSUB '34("A DOCUMENT NAME MUST BE ENTERED.")
: GOTO 6780
6810 GOSUB 6590
: GOSUB 5930
: IF S2>0THEN 6860
: GOSUB '34("DOCUMENT IS NOT ON DISK.")
: GOTO 6780
6860 RETURN
9450 MAT COPY T$()TO N$()<1,200>
: BIN(STR(N$(13),9))=F
: BIN(STR(N$(13),10))=F0*SGN(F)
: BIN(STR(N$(13),11))=W
: DATA SAVE BA T#2,(U,A)N$()
: RETURN