image of READY prompt

Wang2200.org

Listing of file='HLDA010L' on disk='vmedia/letter_editor.wvd.zip'

# Sector 408, program filename = 'HLDA010L'
0010 REM ***** HLDA010L - REVISED 1610 08/18/76 ***** COPYRIGHT WANG LABS, 197
     6
0030 DIM A$2,B$(80)1,B1$24,B2$24,B3$24,B4$18,B5$(16),C$(80)1,C1$1,C2$1,B5$2,B6
     $2,N$(16)
   : DIM D$1,E$(1)2,G$(1)10,H$(25)2,I$(11)10,K1$(16),K2$(16)
   : DIM P$(8)40,P1$(200)1,P2$(200)1,P3$(200)1,T1$(200)1,V$(1)
   : DIM Q$64,Q1$64,Q2$64,S$(2)40
   : GOTO 5440
0191 $GIO/005(400DA000,I0$)P1$()<1,W0>
   : RETURN
0215 GOSUB 3740
0225 GOSUB 600
   : IF K1=0THEN 270
0240 MAT SEARCHP1$()<1,W0>,<>B$TO E$()
   : IF E$(1)=A$THEN 270
   : GOSUB 820
   : GOTO 240
0270 MAT SEARCHP$()<1,W>,<>B$TO E$()
   : IF E$(1)=A$THEN 355
0295 GOSUB 3200
   : IF D>0THEN 325
   : GOSUB 820
   : GOTO 295
0325 GOSUB 3670
   : MAT SEARCHP$()<1,W>,<>B$TO E$()
   : IF E$(1)=A$THEN 215
   : GOTO 295
0355 GOSUB 1270
   : GOTO 215
0600 IF L9=1THEN 770
   : C1$=P$(1)
   : $TRAN(C1$,B1$)R
   : IF C1$=HEX(FF)THEN 770
   : MAT COPY -P1$()<1,W0>TO C$()
   : MAT SEARCHC$(),<>B$TO E$()
   : D=VAL(STR(E$(1),2))
   : IF D=0THEN 700
   : C2$=C$(D)
   : $TRAN(C2$,B2$)R
   : IF C2$=HEX(FF)THEN 770
0700 C1$=P1$(1)
   : $TRAN(C1$,B3$)R
   : IF C1$=HEX(FF)THEN 770
   : K1=0
   : RETURN
0770 K1=1
   : RETURN
0820 C1$=P1$(1)
   : $TRAN(C1$,B4$)R
   : ON VAL(C1$)GOTO 870,1730,1760,1940
0870 L2=L1
   : MAT COPY P1$()TO P2$()
   : MAT COPY P1$()TO P3$()
   : $TRAN(P2$(),K1$())
   : $TRAN(P3$(),K2$())
   : D=0
0950 MAT SEARCHP2$()<D+1,W0-D>,<B$TO E$()
   : IF E$(1)=A$THEN 1020
   : D=D+VAL(STR(E$(1),2))
   : ON VAL(P2$(D))GOSUB 2140,2190,2330,2370,2400,2430,2550,2530
   : GOTO 950
1020 IF P1$(1)=HEX(84)THEN 2610
1040 IF L9<2THEN 1210
   : MAT COPY -P3$()<L0,W0-L0+1>TO P2$()
   : D$=HEX(03)
   : MAT SEARCHP2$(),<D$TO E$()
   : IF E$(1)=A$THEN 1540
   : D=VAL(STR(E$(1),2))
   : L4=W0-D+1
   : $TRAN(P1$()<L4,W0-L4+1>,Y$)R
   : IF P3$(L4)=HEX(01)THEN 2750
   : IF P3$(L4)=HEX(02)THEN 2700
   : STOP "DE-BUG ERROR 1910"
1180 IF L9<3THEN 1210
   : IF K1=0THEN 1200
   : MAT SEARCHP1$()<W0+1,200-W0>,<>B$TO E$()
   : IF E$(1)=A$THEN 1210
1200 GOSUB 2900
1210 MAT COPY -P1$()<1,W1>TO P2$()
   : MAT SEARCHP2$(),<>B$TO E$()
   : IF E$(1)=A$THEN 1270
   : D=W1-VAL(STR(E$(1),2))+1
   : $GIO#5,(A000,I0$)S$()<1,M1>
   : $GIO#5,(A000400D4000,I0$)P1$()<1,D>
   : GOSUB 191
   : GOTO 1275
1270 $GIO#5,(400A,I0$)
1275 $GIO/005(400A,I0$)
   : GOSUB 1450
   : IF L9>1THEN 1320
   : INIT(20)P1$()
   : GOTO 1380
1320 E$(1)=" "
   : MAT COPY E$()TO P1$()<1,W0>
   : MAT COPY P1$()<W0+1,200-W0>TO P1$()<L1,201-L1>
   : MAT SEARCHP1$()<L1,201-L1>,<>B$TO E$()
   : D=VAL(STR(E$(1),2))
   : IF D=0THEN 1380
   : MAT COPY P1$()<L1+D-1,201-L1-D>TO P1$()<L1,201-L1>
1380 L3=L3+1
   : IF L3<L8THEN 1420
   : GOTO 6100
1420 RETURN
1450 $TRAN(P1$()<1,W1>,B5$())
   : D$="-"
   : MAT SEARCHP1$()<1,W0>,=D$TO E$()
   : IF E$(1)>A$THEN 1510
   : IF P9=1THEN 1530
   : $GIO#5,(400A,I0$)
   : GOTO 1520
1510 $GIO#5,(A000,I0$)S$()<1,M1>
   : $GIO#5,(A000400D,I0$)P1$()<1,W0>
1520 L3=L3+1
1530 RETURN
1540 PRINT HEX(03),"NO ADJUST"
   : PRINT "POSITION CURSOR UNDER FIRST CHARACTER OF NEXT LINE."
   : PRINT "PRESS SPACE FOR NEXT LETTER, BACKSPACE TO BACK UP."
   : PRINT "PRESS ";HEX(22);"-";HEX(22);" TO HYPHENATE AND"
   : PRINT "PRESS CARRIAGE RETURN TO PUT WORD ON NEXT LINE."
   : PRINT
1570 $GIO/005,(A000400D,I0$)P1$()<1,W0>
   : FOR M=1TO L0
   : PRINT HEX(09);
   : NEXT M
1600 KEYIN K$,1605,1600
   : GOTO 1600
1605 IF K$<>" "THEN 1630
   : IF M>=W0-1THEN 1600
   : M=M+1
   : PRINT HEX(09);
   : GOTO 1600
1630 IF K$<>HEX(08)THEN 1645
   : M=M-1
   : PRINT HEX(08);
   : GOTO 1600
1645 L4=M+1
   : D=W0-L4+1
   : IF K$="-"THEN 2700
   : L4=L4-1
   : D=D+1
   : IF K$=HEX(0D)THEN 2750
   : GOTO 1600
1730 INIT(20)P1$()
   : GOSUB 191
   : RETURN
1760 MAT COPY P1$()<2,3>TO G$()
   : CONVERT G$(1)TO L0
   : MAT COPY P1$()<6,3>TO G$()
   : CONVERT G$(1)TO W0
   : IF L9=1THEN 1820
   : W1=W0
1820 MAT COPY P1$()<38,3>TO G$()
   : CONVERT G$(1)TO I
   : J=10
   : INIT(00)T1$()
1860 IF I=0THEN 1730
   : MAT COPY P1$()<J,3>TO G$()
   : CONVERT G$(1)TO K
   : T1$(K)=HEX(01)
   : I=I-1
   : J=J+4
   : GOTO 1860
1940 IF P1$(2)="s"THEN 1980
   : IF P1$(2)="d"THEN 2000
   : IF P1$(2)="p"THEN 2020
   : STOP "ILLEGAL PAGE COMMAND"
1980 P9=1
   : GOTO 1730
2000 P9=2
   : GOTO 1730
2020 ON TGOTO 2023,2027
   : STOP "PROGRAMMING ERROR."
2023 GOSUB 6100
   : GOTO 2030
2027 GOSUB '32("PRESS RETURN (EXEC) TO CONTINUE.",1)
   : PRINT HEX(03);TAB(19);"P R I N T   A D D R E S S E S";HEX(0A0A0A)
2030 L3=0
   : GOTO 1730
2140 MAT COPY P1$()<D+1,200-D>TO P1$()<D,201-D>
   : GOSUB 191
   : MAT COPY P2$()<D+1,200-D>TO P2$()<D,201-D>
   : MAT COPY P3$()<D+2,199-D>TO P3$()<D+1,200-D>
   : RETURN
2190 D$=HEX(01)
   : MAT SEARCHT1$()<D,W0-D+1>,=D$TO E$()
   : T=D+VAL(STR(E$(1),2))
   : IF T=DTHEN 2280
   : MAT COPY -P1$()<D+1,201-T>TO -P1$()<D,201-D>
   : GOSUB 191
   : MAT COPY -P2$()<D+1,201-T>TO -P2$()<D,201-D>
   : MAT COPY -P3$()<D+1,201-T>TO -P3$()<D,201-D>
   : L2=T
   : RETURN
2280 G$(1)="NO TABSTOPS"
   : MAT COPY G$()TO P1$()<D,201-D>
   : GOSUB 191
   : RETURN CLEAR
2310 GOTO 1040
2330 GOSUB 2190
   : L1=L2
   : RETURN
2370 P1$(D)="-"
   : RETURN
2400 P1$(D)=" "
   : RETURN
2430 IF D=1THEN 2480
   : MAT COPY P1$()<D+1,200-D>TO P1$()<D-1,202-D>
   : GOSUB 191
   : MAT COPY P2$()<D+1,200-D>TO P2$()<D-1,202-D>
   : MAT COPY P3$()<D+1,200-D>TO P3$()<D-1,202-D>
   : D=D-2
   : RETURN
2480 MAT COPY P1$()<2,199>TO P1$()
   : GOSUB 191
   : MAT COPY P2$()<2,199>TO P2$()
   : MAT COPY P3$()<2,199>TO P3$()
   : RETURN
2530 L1=1
2550 MAT COPY P1$()<D+1,200-D>TO P1$()<D,201-D>
   : GOSUB 191
   : MAT COPY P2$()<D+1,200-D>TO P2$()<D,201-D>
   : MAT COPY P3$()<D+1,200-D>TO P3$()<D,201-D>
   : RETURN
2610 MAT COPY -P1$()TO P2$()
   : MAT SEARCHP2$(),<>B$TO E$()
   : D=(W0+VAL(STR(E$(1),2))-200)/2
   : MAT COPY P1$()<2,199>TO P2$()
   : INIT(20)P1$()
   : MAT COPY P2$()TO P1$()<D+1,200-D>
   : GOSUB 191
   : GOTO 1040
2700 MAT COPY -P1$()<L4,201-L4-D>TO -P1$()<L4,201-L4>
   : MAT COPY -P3$()<L4,201-L4-D>TO -P3$()<L4,201-L4>
   : P1$(L4)="-"
   : GOSUB 191
   : GOTO 1180
2750 MAT COPY -P1$()<L4+1,200-L4-D>TO -P1$()<L4+1,200-L4>
   : GOSUB 191
   : MAT COPY -P3$()<L4+1,200-L4-D>TO -P3$()<L4+1,200-L4>
   : MAT COPY -P3$()<L2,L4-L2>TO P2$()
   : D$=HEX(01)
   : MAT SEARCHP2$()<1,L4-L2>,<>D$TO E$()
   : IF E$(1)=A$THEN 1210
   : L4=L4-VAL(STR(E$(1),2))
   : MAT COPY P3$()<L2,L4-L2+1>TO P2$()
2840 MAT SEARCHP2$()<1,L4-L2+1>,=D$TO E$()
   : IF E$(1)=A$THEN 1210
   : GOTO 1180
2900 D$=HEX(01)
   : L=L2
   : MAT SEARCHP3$()<L,L4-L+1>,<>D$TO E$()
   : IF E$(1)=A$THEN 3140
   : L=L+VAL(STR(E$(1),2))-1
   : MAT SEARCHP3$()<L,L4-L+1>,=D$TO E$()
   : IF E$(1)=A$THEN 3140
   : L=L2+INT(ABS(RND(1))*(L4-L2))
2990 IF L4=W0THEN 3140
   : MAT SEARCHP3$()<L,L4-L+1>,<>D$TO E$()
   : IF E$(1)=A$THEN 3160
   : L=L+VAL(STR(E$(1),2))-1
   : MAT SEARCHP3$()<L,L4-L+1>,=D$TO E$()
   : IF E$(1)=A$THEN 3160
   : L=L+VAL(STR(E$(1),2))-1
   : MAT COPY -P1$()<L,W0-L>TO -P1$()<L,W0-L+1>
   : GOSUB 191
   : MAT COPY -P3$()<L,W0-L>TO -P3$()<L,W0-L+1>
   : L=L+1
   : L4=L4+1
   : GOTO 2990
3140 RETURN
3160 L=L2
   : GOTO 2990
3200 MAT COPY -P1$()TO P2$()
   : MAT SEARCHP2$(),<>B$TO E$()
   : IF E$(1)>A$THEN 3270
   : P=L1
   : GOTO 3490
3270 D=VAL(STR(E$(1),2))
   : P=203-D
   : IF P2$(D)="."THEN 3370
   : IF P2$(D)="-"THEN 3400
   : IF P2$(D)=HEX(80)THEN 3400
   : GOTO 3490
3370 P=P+1
   : GOTO 3490
3400 P=P-2
3490 IF P>W0+20THEN 3630
   : D=W0-P+21
   : D=(D+W-ABS(D-W))/2
   : MAT COPY -P$()<1,D>TO P3$()
   : $TRAN(P3$(),K2$())
   : D$=HEX(03)
   : MAT SEARCHP3$()<1,D>,<D$TO E$()
   : IF E$(1)=A$THEN 3630
   : D=D-VAL(STR(E$(1),2))+1
   : MAT COPY P$()<D,1>TO E$()
   : IF E$(1)=" "THEN 3620
   : E$(1)=HEX(80)
   : MAT COPY E$()TO P$()<D,1>
3620 RETURN
3630 D=0
   : RETURN
3670 MAT COPY P$()<1,D>TO P1$()<P,D>
   : GOSUB 191
   : IF L9>1THEN 3680
   : $TRAN(P1$(),H$)R
3680 MAT SEARCHP$()<D+1,W-D>,<>B$TO E$()
   : D=D+VAL(STR(E$(1),2))
   : MAT COPY P$()<D,W-D+1>TO P$()<1,W>
   : RETURN
3740 DATA LOAD DA T#1,(U1,U1)P$(1),P$(2)
   : IF P$(1)="/"THEN 3940
   : IF END THEN 3940
   : GOSUB 3990
   : RETURN
3940 K1=1
   : GOSUB 820
   : GOSUB 820
   : PRINT HEX(03);"END OF PROGRAM"
   : GOSUB '15
3990 D$="<"
   : MAT SEARCHP$()<1,W>,=D$TO H$()
   : MAT SEARCHH$(),=A$TO E$()STEP 2
   : E=(VAL(STR(E$(1),2))-1)/2
   : IF E=0THEN 4120
   : FOR X=ETO 1STEP -1
   : B=VAL(STR(H$(X),2))
   : MAT COPY P$()<B,10>TO G$()
   : FOR I=1TO 11
   : J=LEN(I$(I))
   : IF I$(I)=STR(G$(1),1,J)THEN 4130
   : NEXT I
4110 NEXT X
4120 RETURN
4130 MAT COPY P$()<B+J,W+1-B-J>TO P$()<B+1,W-B>
   : MAT COPY V$()<I,1>TO P$()<B,1>
   : GOTO 4110
4170 V$(1)=HEX(87898684858E808F90818C)
   : I$(1)="<TAB>"
   : I$(2)="<C-RET>"
   : I$(3)="<C-TAB>"
   : I$(4)="<CENTER>"
   : I$(5)="<MEMO>"
   : I$(6)="<FORMAT>"
   : I$(7)="<->"
   : I$(8)="<S>"
   : I$(9)="<BS>"
   : I$(10)="<EOD>"
   : I$(11)="<PAGE>"
   : RETURN
5240 B1$=HEX(FF20FF81FF83FF84FF85FF86FF87FF8AFF8CFF8EFF8D)
   : B2$=HEX(FF8AFF83FF89FF8AFF8BFF8D)
   : B3$=HEX(FF8AFF83FF84FF85FF8AFF8CFF8E)
   : GOSUB 4170
   : INIT(20)K1$(),K2$()
   : STR(K1$(3),14,1)=HEX(01)
   : K1$(10)=HEX(060707)
   : K1$(9)=HEX(04202020202003022008202020202005)
   : STR(K1$(2),12,1)=HEX(06)
   : K2$(3)=HEX(01)
5350 STR(K2$(3),14)=HEX(02)
   : A$=HEX(0000)
   : B4$=HEX(01840285038E048C0583068A078B088D)
   : INIT(20)B5$()
   : B5$(9)="-"
   : MAT COPY B5$()<129,128>TO B5$()<130,127>
   : RETURN
5440 PRINT HEX(03);TAB(19);"P R I N T   A D D R E S S E S"
   : Y$=HEX(802D)
   : GOSUB 5240
   : GOSUB '32("TURN PRINTER ON AND PRESS RETURN (EXEC) TO CONTINUE.",4)
   : SELECT #5211
   : T5=2
   : IF Q$="TYPE"THEN 5470
   : IF Q$="type"THEN 5470
   : SELECT #5215
   : T5=1
5470 $GIO#5(400D,I0$)
   : W0,W1=64
   : INIT(00)T1$()
   : L0,L1,L9,P9,M1=1
   : L3=0
   : L8=50
   : H$=HEX(802D)
   : GOSUB '32("SHOULD PRINTER 'EJECT' OR 'STOP' BETWEEN ADDRESSES?",5)
5610 T=1
   : IF Q$="EJECT"THEN 5790
   : IF Q$="eject"THEN 5790
   : T=2
   : IF Q$="STOP"THEN 5790
   : IF Q$="stop"THEN 5790
   : GOSUB '34("INVALID REPLY.")
   : GOTO 5610
5790 X$="HLDA010Y"
   : STR(X$,6,1)=Z$
   : OR (STR(X$,6,1),30)
   : LIMITS T#1,X$,U1,U2,U3
   : GOTO 225
5970 DEFFN'33(Q1$,N)
   : GOSUB '32(Q1$,N)
5990 IF NUM(Q$)<64THEN 6020
   : CONVERT Q$TO Q
   : RETURN
6020 GOSUB '34("ILLEGAL FORMAT FOR A NUMBER")
   : GOTO 5990
6100 IF T5=2THEN 6150
   : $GIO#5(400C,I0$)
   : GOTO 6180
6150 FOR K=1TO 66-L3
   : $GIO#5(400A,I0$)
   : NEXT K
6180 $GIO/005(400A,I0$)
   : L3=0
   : RETURN
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$=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,A)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 IF F$<>" "THEN 8690
   : IF Q$<>" "THEN 8570
   : GOSUB '34("A VOL. NAME MUST BE ENTERED.")
   : GOTO 8540
8750 DEFFN'15
8760 LOAD DC T#1,"HLDA010A"
8790 B5$,B6$=A$
   : DATA LOAD BA T#2,(B5$,B5$)N$()
   : I=0
   : STR(B6$,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 B5$>=B6$THEN 8920
   : DATA LOAD BA T#2,(B5$,B5$)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,B5$)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
   : GOSUB '34("DOCUMENT IS NOT ON DISK.")
   : GOTO 9212
9490 RETURN