image of READY prompt

Wang2200.org

Listing of file='DE1.020A' on disk='vmedia/701-2110C.wvd.zip'

# Sector 98, program filename = 'DE1.020A'
0010 REM DE1.020A, 02-01, (04/23/79) COPYRIGHT WANG LABORATORIES, INC. 1979
0060 GOTO 1750
0080 DEFFN'180
0210 MAT REDIM O$(N0)1
   : GOSUB '15
   : PRINT F$
   : B$=" "
   : C$=" "
   : MAT SEARCHH1$()<1,N0>,<>C$TO H$()
   : IF H$(1)<>HEX(0000)THEN 310
   : PRINT
   : GOTO 320
0310 PRINT "RECORD";A1-1
0320 $GIO/005(A000400D400A,Z$)H1$()<1,N3>
   : $GIO/005(A000400D400A400A,Z$)H1$()<N4,N3>
   : PRINT "RECORD";A1
   : $GIO/005(A000400D400A400A400A400A,Z$)D$()<1,N3>
0380 MAT SEARCHH1$()<2*N0+1,N0>,<>C$TO H$()
   : IF H$(1)<>HEX(0000)THEN 420
   : PRINT
   : GOTO 430
0420 PRINT "RECORD";A1+1
0430 $GIO/005(A000400D400A,Z$)H1$()<2*N0+1,N3>
   : $GIO/005(A000400D,Z$)H1$()<5*N3+1,N3>
   : MAT COPY H1$()<N0+1,N0>TO O$()<1,N0>
   : J=1
0510 PRINT HEX(0D010A0A0A0A0A0A0A0A0A0A)
   : $GIO/005(A000400D400A,Z$)O$()<1,N3>
   : $GIO/005(A000400D,Z$)O$()<N4,N3>
0570 INIT(09)H1$()
   : IF J<=N3THEN 630
   : IF J=N4THEN 670
   : $GIO/005(A000,Z$)H1$()<1,J-N4>
   : GOTO 670
0630 PRINT HEX(0C)
   : IF J=1THEN 670
   : $GIO/005(A000,Z$)H1$()<1,J-1>
0670 KEYIN B$,690,1000
   : GOTO 670
0690 Z$=HEX(5BC75CCC5DC35FC42020)
   : $TRAN(B$,Z$)R
   : IF B$=HEX(0D)THEN 1630
   : IF B$=HEX(08)THEN 900
   : IF B$=HEX(E5)THEN 960
   : IF B$>HEX(7F)THEN 670
   : O$(J)=B$
   : PRINT B$;
   : J=J+1
   : IF J=N4THEN 860
   : IF J<=N0THEN 670
   : J=N0
   : GOTO 510
0860 PRINT
   : GOTO 670
0900 IF J=1THEN 670
   : J=J-1
   : O$(J)=" "
   : GOTO 510
0960 INIT(20)O$()
   : J=1
   : GOTO 510
1000 IF B$=HEX(00)THEN 1660
   : ON VAL(B$)-7GOTO 1330,1390,1440,1490,1510,1580,1560,1690
   : ON VAL(B$)-15GOTO 1090,1120,1150,1180,1210,1220,1240,1260,1280,1300
   : IF B$=HEX(1F)THEN 8480
   : GOTO 670
1080 DEFFN'16HEX(AC)
1090 B$=HEX(2C)
   : GOTO 690
1110 DEFFN'17HEX(5B)
1120 B$=HEX(5B)
   : GOTO 690
1140 DEFFN'18HEX(5D)
1150 B$=HEX(5D)
   : GOTO 690
1170 DEFFN'19HEX(5C)
1180 B$=HEX(5C)
   : GOTO 690
1200 DEFFN'20HEX(5F)
1210 B$=HEX(5F)
   : GOTO 690
1220 DEFFN'21HEX(20)
   : B$=HEX(20)
   : GOTO 690
1240 DEFFN'22HEX(20)
   : B$=HEX(20)
   : GOTO 690
1260 DEFFN'23HEX(20)
   : B$=HEX(20)
   : GOTO 690
1280 DEFFN'24HEX(20)
   : B$=HEX(20)
   : GOTO 690
1300 DEFFN'25HEX(20)
   : B$=HEX(20)
   : GOTO 690
1330 INIT(20)H1$()
   : MAT COPY H1$()<1,N0+1-J>TO O$()<J,N0+1-J>
   : GOTO 510
1390 MAT COPY O$()<J+1,N0-J>TO O$()<J,N0-J>
   : O$(N0)=" "
   : GOTO 510
1440 MAT COPY -O$()<J,N0-J>TO -O$()<J+1,N0-J>
   : O$(J)=" "
   : GOTO 510
1490 J=J+4
1510 J=J+1
   : IF J<=N0THEN 510
   : J=N0
   : GOTO 510
1560 J=J-4
1580 J=J-1
   : IF J>0THEN 510
   : J=1
   : GOTO 510
1630 J=0
   : RETURN
1660 J=1
   : RETURN
1690 J=2
   : RETURN
1730 DEFFN'0
   : RETURN CLEAR
1750 GOSUB '15
1760 A1,A2,A3=0
   : INPUT C$
   : GOTO 1750
1800 PRINT HEX(0D0A);"COMMAND = ";
   : GOTO 1760
1860 PRINT "ENTER FIRST RECORD TO ";F$;" (DEFAULT =";A1;")";
   : INPUT A1
   : IF A1<1THEN 1860
   : RETURN
1910 PRINT "ENTER LAST RECORD TO ";F$;" (DEFAULT =";A2;")";
   : INPUT A2
   : RETURN
1950 PRINT "PUT RECORDS BEFORE WHAT LOCATION, DEFAULT = END";
   : A3=(G-1)/2+1
   : INPUT A3
   : RETURN
2000 $GIO/215(060207001262400040004000,Z$)
   : IF STR(Z$,8,1)=HEX(00)THEN 2040
   : PRINT "PRINTER NOT READY";HEX(0D)
   : GOTO 2000
2040 PRINT TAB(63);HEX(0D);
   : RETURN
2070 PRINT "ENTER FILE NAME";
   : IF F$<>"LIST"THEN 2100
   : PRINT "   DEFAULT = EDIT AREA";
2100 B$=" "
   : INPUT B$
   : IF B$="080"THEN 2070
   : IF B$="128"THEN 2070
   : RETURN
2160 C$=" "
   : PRINT "DOES THE FILE ";B$;" CURRENTLY EXIST";
   : INPUT C$
   : IF C$="Y"THEN 2210
   : IF C$<>"N"THEN 2160
2210 RETURN
2270 PRINT F$;" IS INVALID."
   : GOTO 1800
2280 PRINT "INVALID RECORD NUMBER."
   : GOTO 1800
2290 PRINT "EDIT AREA EMPTY"
   : GOTO 1800
2300 PRINT "FILE FULL.  LAST RECORD WRITTEN =";A1-2
   : GOTO 1800
2310 PRINT HEX(0D0A);"EDIT AREA FULL"
   : GOTO 1800
   : ON ERRORSTR(Z$,1,3),STR(Z$,4,4)GOTO 2330
2330 SELECT PRINT 005
   : IF STR(Z$,1,2)="48"THEN 1800
   : IF STR(Z$,1,2)="80"THEN 2420
   : IF STR(Z$,1,3)="D82"THEN 2420
   : IF STR(Z$,1,2)="79"THEN 2430
   : IF STR(Z$,1,3)="D83"THEN 2430
   : IF STR(Z$,1,2)="74"THEN 2440
   : IF STR(Z$,1,3)="D86"THEN 2440
2410 PRINT "INVALID OPERATION (";STR(Z$,1,7);")";TAB(63)
   : GOTO 1800
2420 PRINT "FILE DOES NOT EXIST."
   : GOTO 1800
2430 PRINT "FILE ALREADY EXISTS."
   : GOTO 1800
2440 PRINT "NO ROOM ON DISK FOR NEW FILE"
   : GOTO 1800
2530 DEFFN'1
   : RETURN CLEAR
2550 F$="LIST"
   : GOSUB '15
   : PRINT F$
   : GOSUB 2070
   : IF B$=" "THEN 2630
   : GOSUB '40(B$)
   : DATA LOAD DC OPEN T#2,B$
   : GOTO 2680
2630 IF G=1THEN 2290
   : GOSUB '60
   : GOSUB 1860
   : GOSUB 1910
2680 C$="N"
   : D4=1
   : INPUT "ENTER OUTPUT FORMAT (N=NORMAL,H=HEX,  DEFAULT=NORMAL)",C$
   : IF C$="N"THEN 2750
   : IF C$<>"H"THEN 2680
   : D4=2
2750 GOSUB 3070
   : IF B$<>" "THEN 2930
2780 KEYIN C$,2810,2800
   : GOTO 2810
2800 IF C$=HEX(00)THEN 2890
2810 GOSUB '70(A1,0)
   : GOSUB 3460
   : PRINT A1
   : ON D4GOSUB 3370,3220
   : A1=A1+1
   : IF A1<=A2THEN 2780
2870 IF D3<>2THEN 2890
   : GOSUB '154
2890 SELECT PRINT 005(64)
   : GOTO 1750
2930 GOSUB '100
2950 KEYIN C$,2980,2970
   : GOTO 2980
2970 IF C$=HEX(00)THEN 2890
2980 GOSUB '105
   : IF J=0THEN 2870
   : GOSUB 3460
   : PRINT A1+1
   : J=M1
   : ON D4GOSUB 3370,3220
   : A1=A1+1
   : GOTO 2950
3070 C$="C"
   : D3=2
   : SELECT #5005,PRINT 005(65)
   : L8=15-2*D4
3110 INPUT "ENTER OUTPUT DEVICE (C=CRT, P=PRINTER)",C$
   : IF C$="C"THEN 3190
   : IF C$<>"P"THEN 3110
   : D3=1
   : L8=56-D4
   : GOSUB 2000
   : PRINT "KEY '0 TO TERMINATE PRINTING";HEX(0D)
   : SELECT PRINT 215(133),#5215
3190 GOSUB 3500
   : RETURN
3220 MAT REDIM O$(4)N0/4
   : FOR I=1TO 3STEP 2
   : PRINT TAB(C);
   : HEXPRINT O$(I);
   : IF D3=1THEN 3300
   : PRINT
   : L9=L9+1
   : PRINT TAB(C);
3300 HEXPRINT O$(I+1)
   : L9=L9+1
   : NEXT I
   : L9=L9+1
   : MAT REDIM O$(N0)1
   : RETURN
3370 MAT REDIM O$(2)N3
   : PRINT TAB(C);STR(O$(1),1,N3);
   : IF D3=1THEN 3420
   : PRINT
   : L9=L9+1
3420 PRINT TAB(C);O$(2)
   : L9=L9+2
   : RETURN
3460 IF L9<L8THEN 3660
   : IF D3<>2THEN 3500
   : GOSUB '154
   : IF C$=HEX(00)THEN 3680
3500 L9=0
   : PRINT HEX(0C03)
   : IF B$=" "THEN 3560
   : PRINT HEX(0E);B$;HEX(0F)
   : PRINT
   : L9=L9+2
3560 PRINT TAB(C);
   : $GIO#5(A000,Z$)D$()<1,N3>
   : IF D3+D4=4THEN 3640
   : IF D3=1THEN 3620
   : PRINT
   : L9=L9+1
3620 PRINT TAB(C);
   : $GIO#5(A000,Z$)D$()<N4,N3>
3640 PRINT
   : L9=L9+1
3660 RETURN
3680 RETURN CLEAR
3690 GOTO 1750
3740 DEFFN'2
   : F$="LOAD"
   : GOSUB '15
   : PRINT F$
   : GOSUB 2070
   : GOSUB '40(B$)
   : DATA LOAD DC OPEN T#2,B$
   : GOSUB '100
3840 IF G>N2*2-1THEN 2310
   : GOSUB '105
   : IF J=0THEN 1750
   : GOSUB '70((G+1)/2,1)
   : G=G+2
   : GOTO 3840
3930 DEFFN'3
   : RETURN CLEAR
3950 F$="SAVE"
   : GOSUB '15
   : PRINT F$
   : IF G=1THEN 2290
3990 GOSUB 2070
   : GOSUB '40(B$)
   : GOSUB 2160
   : IF C$="N"THEN 4130
4070 C$="Y"
   : INPUT "OK TO REPLACE (Y/N, DEFAULT = YES)",C$
   : IF C$="N"THEN 3990
   : IF C$<>"Y"THEN 4070
   : DATA LOAD DC OPEN T#2,B$
4130 GOSUB '60
   : GOSUB 1860
   : GOSUB 1910
   : IF C$="Y"THEN 4170
   : DATA SAVE DC OPEN T#2,(INT((A2-A1+3)/N1+4)),B$
4170 GOSUB '110
   : IF J=1THEN 2300
   : GOTO 1750
4230 DEFFN'4
   : RETURN CLEAR
4250 F$="EDIT"
   : GOSUB '15
   : PRINT F$
   : A1=1
   : GOSUB 1860
   : B$=" "
   : IF A1=0THEN 2280
   : IF A1>(G+1)/2THEN 2280
4330 INIT(20)H1$(),O$()
   : MAT REDIM H1$(6)64
   : IF A1>N2THEN 2310
   : FOR I=1TO 3
   : IF A1-2+I=0THEN 4410
   : IF A1-2+I>=(G+1)/2THEN 4410
   : GOSUB '70(A1-2+I,0)
   : MAT COPY O$()<1,N0>TO H1$()<1+(I-1)*N0,N0>
4410 NEXT I
   : GOSUB '180
   : ON JGOTO 1750,4540
   : GOSUB '70(A1,1)
   : IF A1<(G+1)/2THEN 4510
   : IF G>N2*2-1THEN 2310
   : G=G+2
4510 A1=A1+1
   : GOTO 4330
4540 IF A1=1THEN 4330
   : A1=A1-1
   : GOTO 4330
4600 DEFFN'10
   : RETURN CLEAR
4620 F$="INSERT"
   : GOSUB '15
   : PRINT F$
   : GOSUB 1950
   : A1=A3
4670 INIT(20)H1$()
   : IF A1=0THEN 2280
   : IF A1>(G+1)/2THEN 2280
   : IF G>N2*2-1THEN 2310
   : MAT REDIM H1$(6)64
   : FOR I=1TO 2
   : IF A1-2+I=0THEN 4770
   : IF A1-2+I>=(G+1)/2THEN 4770
   : GOSUB '70(A1-2+I,0)
   : MAT COPY O$()<1,N0>TO H1$()<1+(I-1)*2*N0,N0>
4770 NEXT I
   : GOSUB '180
   : IF J<>0THEN 1750
   : GOSUB '70((G+1)/2,1)
   : GOSUB '130((G+1)/2,(G+1)/2,A1)
   : G=G+2
   : A1=A1+1
   : GOTO 4670
4910 DEFFN'9
   : RETURN CLEAR
4930 F$="DELETE"
   : GOSUB '15
   : PRINT F$
   : IF G=1THEN 2290
   : GOSUB '60
   : GOSUB 1860
   : GOSUB 1910
   : GOSUB '130(A1,A2,N2+1)
   : G=G-(A2-A1+1)*2
   : GOTO 1750
5070 DEFFN'5
   : RETURN CLEAR
5090 F$="MOVE"
   : GOSUB '15
   : PRINT F$
   : IF G=1THEN 2290
   : GOSUB '60
   : GOSUB 1860
   : GOSUB 1910
   : GOSUB 1950
   : GOSUB '61
   : GOSUB '130(A1,A2,A3)
   : GOTO 1750
5240 DEFFN'6
   : RETURN CLEAR
5260 F$="COPY"
   : GOSUB '15
   : PRINT F$
   : IF G=1THEN 2290
   : GOSUB '60
   : GOSUB 1860
   : GOSUB 1910
   : GOSUB 1950
   : GOSUB '61
   : IF G+(A2-A1)*2>2*N2-1THEN 2310
   : G1=G
   : FOR I=1TO A2-A1+1
   : GOSUB '70(A1-1+I,0)
   : GOSUB '70((G+1)/2,1)
   : G=G+2
   : NEXT I
   : GOSUB '130((G1+1)/2,(G-1)/2,A3)
   : GOTO 1750
5510 DEFFN'7
   : RETURN CLEAR
5530 F$="SEARCH"
   : GOSUB '15
   : PRINT F$
   : IF G=1THEN 2290
   : GOSUB '60
   : B$=" "
   : PRINT "ENTER CHARACTER STRING TO BE LOCATED";
   : INPUT B$
   : Z$=HEX(5BC75CCC5DC35FC42CAC2020)
   : $TRAN(B$,Z$)R
   : GOSUB 1860
   : GOSUB 1910
   : GOSUB 3070
5660 IF A1>A2THEN 5780
   : KEYIN C$,5700,5690
   : GOTO 5700
5690 IF C$=HEX(00)THEN 5780
5700 GOSUB '70(A1,0)
   : A1=A1+1
   : MAT SEARCHO$(),=B$TO H$()
   : IF H$(1)=HEX(0000)THEN 5660
   : GOSUB 3460
   : PRINT A1-1
   : GOSUB 3370
   : GOTO 5660
5780 IF D3<>2THEN 5800
   : GOSUB '154
5800 SELECT PRINT 005
   : GOTO 1750
6150 DEFFN'60
   : IF A1<>0THEN 6200
   : A1=1
   : A2=(G-1)/2
6200 IF A2<>0THEN 6220
   : A2=A1
6220 IF A1>(G-1)/2THEN 6260
   : IF A2<A1THEN 6260
   : IF A2>(G-1)/2THEN 6260
   : RETURN
6260 RETURN CLEAR
6270 GOTO 2280
6330 DEFFN'61
   : IF A1*A2*A3=0THEN 6410
   : IF A1>(G-1)/2THEN 6410
   : IF A2<A1THEN 6410
   : IF A2>(G-1)/2THEN 6410
   : IF A3>(G+1)/2THEN 6410
   : IF A3<A1THEN 6430
   : IF A3>A2THEN 6430
6410 RETURN CLEAR
6420 GOTO 2280
6430 RETURN
6480 DEFFN'70(E0,E)
   : MAT REDIM O$(2)N3
   : E0=E0*2-1
   : MAT COPY P$()<E0,2>TO H$()<1,2>
   : H$=H$(1)
   : AND (H$,0C)
   : ROTATE(H$,6)
   : AND (STR(H$(1),1,1),03)
   : E0=H6+256*VAL(H$(1))+VAL(STR(H$(1),2))
   : IF E0=E1-1THEN 6690
   : DATA LOAD BA T#4,(E0,E1)H2$()
6690 IF E=0THEN 6740
   : MAT COPY O$()<1,N0>TO H2$()<1+(VAL(H$)-1)*N0,N0>
   : DATA SAVE BA T#4,(E0,E1)H2$()
   : RETURN
6740 MAT COPY H2$()<1+(VAL(H$)-1)*N0,N0>TO O$()<1,N0>
   : J=LEN(O$(1))
   : IF O$(2)=" "THEN 6780
   : J=N3+LEN(O$(2))
6780 RETURN
6890 DEFFN'100
   : MAT REDIM H1$(4)62
   : DATA LOAD DC #2,H1$()
   : K=3
   : M=VAL(STR(H1$(1),2))
   : RETURN
7020 DEFFN'105
   : IF K<>MTHEN 7110
   : J=0
   : IF STR(H1$(1),1,1)=HEX(F0)THEN 7210
   : GOSUB '100
7110 MAT COPY H1$()<K,1>TO H$()<1,1>
   : M1=VAL(H$(1))
   : IF M1<=N0THEN 7160
   : M1=N0
   : PRINT "RECORD TRUNCATED";HEX(070D0A)
   : L9=L9+1
7160 INIT(20)O$()
   : MAT COPY H1$()<K+1,M1>TO O$()<1,M1>
   : K=K+VAL(H$(1))+1
   : J=1
7210 RETURN
7260 DEFFN'110
7380 A3=A1
   : MAT REDIM H1$(4)62
   : INIT(00)H1$()
   : K=3
7420 GOSUB '70(A1,0)
   : A1=A1+1
   : M1=N0
   : IF ABS(K-3)+ABS(A1-A3-1)=0THEN 7510
   : M1=J
7510 IF K+M1<=247THEN 7650
   : BIN(STR(H1$(1),2,1))=K
   : J=1
   : LIMITS T#2,G1,A,B
   : IF B>A-3THEN 7790
   : DATA SAVE DC #2,H1$()
   : INIT(00)H1$()
   : K=3
7650 BIN(H$(2))=M1
   : MAT COPY H$()<3,1>TO H1$()<K,1>
   : MAT COPY O$()<1,M1>TO H1$()<K+1,M1>
   : K=K+M1+1
   : IF A1>(G-1)/2 THEN 7750
   : IF A1<=A2 THEN 7420
7750 BIN(STR(H1$(1),2,1))=K
   : J=0
7790 STR(H1$(1),1,1)=HEX(F0)
   : DATA SAVE DC #2,H1$()
   : DATA SAVE DC #2,END
   : RETURN
7960 DEFFN'130(L,L1,L2)
   : MAT REDIM H1$(6)64
   : L=L*2-1
   : L1=L1*2-1
   : L2=L2*2-1
8030 J=L1-L+2
   : IF J<=384THEN 8060
   : J=384
8060 IF J>0THEN 8080
   : RETURN
8080 IF L2<=LTHEN 8160
   : L2=L2-J
   : GOSUB '210(J)
   : L1=L1-J
   : GOTO 8030
8160 GOSUB '210(J)
   : L=L+J
   : GOTO 8030
8250 DEFFN'210(J)
   : MAT COPY P$()<L,J>TO H1$()<1,J>
   : MAT COPY P$()<L+J,N2*2+1-L-J>TO P$()<L,N2*2+1-L-J>
   : MAT COPY -P$()<L2,N2*2+1-L2-J>TO -P$()<L2+J,N2*2+1-L2-J>
   : MAT COPY H1$()<1,J>TO P$()<L2,J>
   : L2=L2+J
   : RETURN
8390 IF S1<>D1THEN 8460
   : PRINT HEX(030A);"MOUNT SYSTEM DISK IN ADDRESS ";A$(S1)
   : PRINT "KEY RETURN(EXEC) TO RESUME.";
8420 KEYIN C$,8440,8420
   : GOTO 8420
8440 IF C$<>HEX(0D)THEN 8420
   : PRINT
8460 RETURN
8480 DEFFN'31
   : GOSUB 8390
   : COM CLEAR H6
   : LOAD DC T#1,"MENU010A"
8580 DEFFN'40(R9$)
   : PRINT "AVAILABLE ADDRESSES"
   : PRINT "1 - ";A$(1);"     4 - ";A$(4)
   : PRINT "2 - ";A$(2);"     5 - ";A$(5)
   : PRINT "3 - ";A$(3);"     6 - ";A$(6)
8630 PRINT "ENTER ADDRESS FOR FILE: ";B$;" (DEFAULT =";D1;")";
   : INPUT D1
   : IF D1<>INT(D1)THEN 8630
   : ON D1GOTO 8700,8730,8760,8790,8820,8850
   : D1=1
   : GOTO 8630
8700 SELECT #2310
   : GOTO 8870
8730 SELECT #2320
   : GOTO 8870
8760 SELECT #2330
   : GOTO 8870
8790 SELECT #2B10
   : GOTO 8870
8820 SELECT #2B20
   : GOTO 8870
8850 SELECT #2B30
8870 PRINT "MOUNT DISK IN ADDRESS ";A$(D1)
   : GOSUB '154
   : RETURN
8960 DEFFN'154
   : PRINT "KEY RETURN(EXEC) TO CONTINUE";
8980 KEYIN C$,9000,9030
   : GOTO 8980
9000 IF C$<>HEX(0D)THEN 8980
   : PRINT
   : RETURN
9030 IF C$<>HEX(00)THEN 8980
   : PRINT
   : RETURN
9120 DEFFN'15
   : SELECT PRINT 005(65)
   : PRINT HEX(03);" '0=ENTER COMMAND  '1=LIST  '2=LOAD  '3=SAVE  '4=EDIT  '5=
     MOVE"
   : PRINT TAB(6);"'6=COPY  '7=SEARCH  '9=DELETE  '10=INSERT  '31=MENU"
9160 PRINT TAB(13);"NUMBER OF RECORDS IN EDIT AREA =";(G-1)/2
   : PRINT TAB(22);"COMMAND = ";
   : RETURN