image of READY prompt

Wang2200.org

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

# Sector 296, program filename = 'HLDA010I'
0010 REM ***** HLDA010I - REVISED 1600 08/18/76 ***** COPYRIGHT WANG LABS, 197
     6
0020 COM P$(36)40,E$(1)2,A$2,T$(200)1,T1$(200)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,M$(16),N$(16)
   : COM CLEAR P$()
0230 INIT(00)A$
   : PRINT HEX(03);TAB(23);"C O P Y   T E X T"
   : I1=9
   : I2=3
   : Q1$="ENTER THE NAME OF THE OUTPUT VOLUME."
   : Q2$="DEFAULT NAME ="
   : STR(Q2$,16)=F$
   : N=8
   : GOSUB '34(Q2$)
   : GOSUB 2500
   : Q3$=Q$
   : I1=1
   : I2=2
   : Q1$="ENTER THE NAME OF THE INPUT VOLUME."
   : Q2$="DEFAULT NAME ="
   : STR(Q2$,16)=F$
   : N=8
0295 GOSUB '34(Q2$)
   : GOSUB 2500
   : Q4$=Q$
   : GOSUB '32("MOUNT THE INPUT & OUTPUT DISKS.  PRESS RETURN (EXEC) TO CONT."
     ,1)
   : I2=3
   : Q$=Q3$
   : GOSUB 8530
   : IF I=0THEN 780
   : I2=2
   : Q$=Q4$
   : GOSUB 8530
   : IF I=0THEN 780
   : IF Q3$=Q4$THEN 580
   : GOSUB '32("ENTER TYPE OF COPY: 'VOLUME', 'DOCUMENT', OR 'PART'.",8)
   : I3=1
0480 IF Q$="VOLUME"THEN 1960
   : IF Q$="volume"THEN 1960
   : I3=2
0510 IF Q$="DOCUMENT"THEN 620
   : IF Q$="document"THEN 620
   : I3=3
   : IF Q$="PART"THEN 620
   : IF Q$="part"THEN 620
   : GOSUB '34("INVALID REPLY.")
   : ON I3GOTO 480,510,510
0580 GOSUB '32("ENTER TYPE OF COPY: 'DOCUMENT' OR 'PART'.",8)
   : GOTO 510
0620 GOSUB 9210
   : GOTO 663
0660 GOSUB 9090
0663 Q1$="ENTER THE NAME OF THE OUTPUT DOCUMENT"
   : N=5
   : Q$,N8$=N9$
   : GOSUB 1060
   : T1=1
   : GOSUB '35(N8$)
   : J0=1
   : C1=1
   : GOSUB 930
0710 IF I3<3THEN 790
   : GOSUB 2100
   : J1=1
   : $GIO/005(4001,I$)
   : K1$="+"
0740 KEYIN K$,750,740
   : GOTO 740
0750 IF K$="+"THEN 1480
   : IF K$="-"THEN 1710
   : IF K$<>HEX(0D)THEN 740
   : IF K1$="+"THEN 1480
   : J1=15*W+1
   : GOTO 800
0780 STR(Q$,LEN(Q$)+2)="DOES NOT EXIST OR IS SCRATCHED."
   : Q1$="RE-MOUNT SYSTEM DISK IF IT HAS BEEN REMOVED AND PRESS RETURN."
   : N=1
   : GOSUB '34(Q$)
   : GOTO 840
0790 GOSUB 1250
0800 GOSUB 1420
   : GOSUB 930
   : IF J0>1THEN 710
   : GOSUB 1770
   : ON I3GOTO 2040
0836 PRINT HEX(03);TAB(23);"C O P Y   T E X T"
   : Q1$="RE-MOUNT SYSTEM DISK IF IT HAS BEEN REMOVED."
   : N=1
   : GOSUB '34("PRESS RETURN (EXEC) TO CONTINUE.")
0840 PRINT HEX(03);TAB(23);"C O P Y   T E X T"
   : GOSUB '32("DO YOU WANT TO COPY MORE?  (Y/N)",1)
0850 IF Q$="Y"THEN 230
   : IF Q$="y"THEN 230
   : IF Q$="N"THEN 900
   : IF Q$="n"THEN 900
   : GOSUB '34("INVALID REPLY.")
   : GOTO 850
0900 GOSUB '15
0930 IF S2=0THEN 1030
   : GOSUB 1170
   : D$=HEX(0F)
   : MAT SEARCHN$(),=D$TO E$()STEP W
   : IF E$(1)>A$THEN 990
   : STOP "BAD DATA ON DISK."
0990 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 930
1030 RETURN
1060 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 1120
   : NEXT I
   : N9$=Q$
   : RETURN
1120 STR(Q$,LEN(Q$)+2)="ALREADY EXISTS."
   : GOSUB '34(Q$)
   : GOTO 1060
1170 DATA LOAD BA T#2,(U+5*S2+T2,A)N$()
   : T2=T2+1
   : IF T2<=5THEN 1220
   : S2=VAL(T$(S2))
   : T2=1
1220 RETURN
1250 J2=15*W+1
   : IF J0>=J2THEN 1280
   : J2=J0
1280 E$(1)=HEX(0F)
   : J1=1
1300 MAT COPY P$()<J1,3*W>TO N$()
   : MAT COPY E$()TO N$()<3*W+1,1>
   : DATA SAVE BA T#3,(V+5*S1+T1,A)N$()
   : T1=T1+1
   : IF T1<=5THEN 1370
   : S1=VAL(T1$(S1))
   : IF S1>0THEN 1360
   : STOP "DISK IS FULL"
1360 T1=1
1370 J1=J1+3*W
   : IF J1<J2THEN 1300
   : RETURN
1420 IF J1<=J0THEN 1430
   : J1=J0
1430 MAT COPY P$()<J1,J0-J1+1>TO P$()
   : J0=J0-J1+1
   : RETURN
1480 J2=15*W+1
   : IF J0>=J2THEN 1510
   : J2=J0
1510 MAT COPY P$()<J1,W>TO M$()<C1,W>
   : C1=C1+W
   : IF C1<3*WTHEN 1630
   : E$(1)=HEX(0F)
   : MAT COPY E$()TO M$()<C1,1>
   : DATA SAVE BA T#3,(V+5*S1+T1,A)M$()
   : C1=1
   : T1=T1+1
   : IF T1<=5THEN 1630
   : S1=VAL(T1$(S1))
   : T1=1
   : IF S1>0THEN 1630
   : STOP "VOLUME IS FULL"
1630 $GIO/005(400A,I$)
1640 J1=J1+W
   : K1$=K$
   : IF J1>=J2THEN 800
   : IF K$=HEX(0D)THEN 1510
   : GOTO 740
1710 $GIO/005(A000400D400A,I$)B$()
   : GOTO 1640
1770 E$(1)=HEX(0F)
   : IF I3=3THEN 1932
1780 MAT COPY E$()TO N$()<C1,1>
   : DATA SAVE BA T#3,(V+5*S1+T1,I$)N$()
1800 C1=1
   : T1=T1+1
   : IF T1<=5THEN 1780
   : STR(N$(13),9)=T1$(S1)
   : T1$(S1)=HEX(00)
   : S1=VAL(STR(N$(13),9))
   : BIN(STR(N$(13),10))=V0
   : BIN(STR(N$(13),11))=W
   : MAT COPY T1$()TO N$()<1,200>
   : DATA SAVE BA T#3,(V,A)N$()
   : N=INT((N9-1)/50)
   : DATA LOAD BA T#3,(N+V+1,A)N$()
   : G$(1)=N9$
   : MAT COPY G$()TO N$()<5*(N9-50*N)-4,5>
   : DATA SAVE BA T#3,(A-1,A)N$()
   : N9=S1
   : RETURN
1932 MAT COPY E$()TO M$()<C1,1>
   : DATA SAVE BA T#3,(V+5*S1+T1,I$)M$()
   : GOTO 1800
1960 FOR L1=1TO 4
   : DATA LOAD BA T#2,(U+L1,A)N$()
   : L2=-4
1985 Q$=" "
   : MAT SEARCHN$()<L2+5,246-L2>,<>STR(Q$,1,5)TO E$()STEP 5
   : IF E$(1)=A$THEN 2060
   : L2=L2+VAL(STR(E$(1),2))+4
   : MAT COPY N$()<L2,5>TO G$()
   : Q$=G$(1)
   : GOTO 660
2040 DATA LOAD BA T#2,(U+L1,A)N$()
   : GOTO 1985
2060 NEXT L1
   : GOTO 836
2100 J2=14*W+1
   : IF J0>J2THEN 2130
   : J2=J0-W
2130 $GIO/005(4003,I$)
   : FOR I=1TO J2STEP W
   : $GIO/005(400DA000400A,I$)P$()<I,W>
   : NEXT I
   : RETURN
2500 IF Q$="STOP"THEN 8760
   : IF Q$="stop"THEN 8760
   : IF Q$=" "THEN 2580
2517 F$=Q$
   : GOSUB 8970
   : IF J=0THEN 2570
   : STR(Q$,LEN(Q$)+2)="IS ALREADY BEING USED."
   : GOSUB '34(Q$)
   : GOTO 2500
2570 RETURN
2580 Q$=F$
   : IF Q$<>" "THEN 2517
   : GOSUB '34("A VOL. NAME MUST BE ENTERED.")
   : GOTO 2500
3000 DIM A9$30
3010 DEFFN'35(A9$)
   : SELECT PRINT 005
   : PRINT HEX(03)
   : PRINT HEX(0A0A0A0A0A)
   : PRINT "     * * * * * * * * * * * * * * * * * * * * * * * * * *"
   : PRINT "     *";TAB(55);"*"
   : PRINT "     *";TAB(23);"COPYING DOCUMENT";TAB(55);"*"
   : PRINT "     *";TAB(12+(38-LEN(A9$))/2);A9$;TAB(55);"*"
   : PRINT "     *";TAB(55);"*"
3100 PRINT "     * * * * * * * * * * * * * * * * * * * * * * * * * *"
   : 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>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 MAT COPY T$()TO T1$()
8540 V=U
   : N9,S1=F
   : T1=1
   : V0=F0
   : GOSUB 8790
   : IF I=0THEN 8690
   : LIMITS T#I2,Q$,U,U1,U2
   : DATA LOAD BA T#I2,(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
8750 DEFFN'15
8760 LOAD DC T#1,"HLDA010A"
8790 B5$,B6$=A$
   : DATA LOAD BA T#I2,(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#I2,(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
8970 LIMITS T#1,"ACTIVE",U1,U2,U2
   : U=0
   : DATA LOAD BA T#6,(U1,A)N$()
   : STR(N$(VAL(Z$)),I1,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
   : J=0
   : DATA SAVE BA T#1,(U1,A)N$()
9040 VERIFY T#1,(U1,U1)
   : RETURN
9090 T2=1
   : N9$=Q$
   : FOR I=1TO 4
   : DATA LOAD BA T#I2,(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
   : ON I3GOTO 9150
   : IF I2=3THEN 9150
   : 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