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