image of READY prompt

Wang2200.org

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

# Sector 29, program filename = 'DE1.010A'
0010 REM DE1.010A, 02-01 (04/23/79) COPYRIGHT WANG LABORATORIES, INC. 1979
0610 COM H6,G,N0,N1,N2,E1,D1,N3,N4,C
   : COM D$(2)64
   : COM H1$(6)64,H2$(4)64,H$2,H$(2)2,O$(128)1
   : COM B$16,C$1,F$40
0660 DIM R1$8,R2$1,R3$2,R9$8,R9$(16)
0690 D$(1)="....!....1....!....2....!....3....!....4....!....5....!....6...."
   : D$(2)="!....7....!....8....!....9....!....0....!....1....!....2....!..."
   : D1=4
0740 SELECT CO 005(64),PRINT 005(64)
   : PRINT HEX(03)
0760 PRINT HEX(010A)
   : N0=80
   : PRINT "ENTER THE NUMBER OF COLUMNS IN THE CARD IMAGE -";TAB(63)
   : PRINT TAB(63);HEX(0D);"(80 OR 128)  DEFAULT = 80 ";
   : INPUT N0
   : C=4
   : IF N0=80THEN 860
   : C=0
   : IF N0=128THEN 860
   : PRINT HEX(0A);"RE-ENTER"
   : GOTO 760
0860 N1=INT(256/N0)
   : N3=N0/2
   : N4=N3+1
   : D2=S1
   : GOSUB 1830
   : GOSUB '229(4,"EDITAREA")
   : IF R2$>HEX(00)THEN 1200
0940 GOSUB 1720
   : IF D2=S1THEN 1010
   : PRINT HEX(030A);"MOUNT WORK DISK IN ADDRESS ";A$(D2)
   : GOSUB '251
   : IF C$="X"THEN 740
1010 GOSUB '229(4,"EDITAREA")
   : IF R2$>HEX(00)THEN 1200
   : C1=N1*1000
   : PRINT HEX(03)
1060 PRINT HEX(010A)
   : INPUT "ENTER NUMBER OF RECORDS TO ALLOCATE",N2
   : N2=-INT(-N2/N1)*N1
   : IF N2<=0THEN 1110
   : IF N2<=C1THEN 1140
1110 PRINT HEX(010A);TAB(63);HEX(0D010A0A);"RE-ENTER INTEGER BETWEEN 1 AND";C1
   : GOTO 1060
1140 GOSUB '128(4,"EDITAREA",N2/N1+2)
   : IF R2$="0"THEN 1360
   : PRINT TAB(63);HEX(0D);"INSUFFICIENT SPACE ON DISK"
   : GOSUB '251
   : GOTO 940
1200 LIMITS T#4,"EDITAREA",H6,A,B
   : N2=(A-1-H6)*N1
   : IF N2/N1<=1000THEN 1240
   : N2=1000*N1
1240 PRINT HEX(03)
   : PRINT "THE EXISTING WORK FILE HAS CAPACITY FOR";N2;"RECORDS"
1260 C$="Y"
   : INPUT "IS THIS ENOUGH (Y/N, DEFAULT = YES) ",C$
   : IF C$="Y"THEN 1320
   : IF C$="N"THEN 940
   : GOTO 1260
1320 IF R2$=HEX(10)THEN 1350
   : DATA SAVE DC OPEN T#4,"EDITAREA","EDITAREA"
   : GOTO 1360
1350 DATA LOAD DC OPEN T#4,"EDITAREA"
1360 LIMITS T#4,H6,A,B
   : H6=H6-1
   : DSKIP #4,A-H6-2S
   : DATA SAVE DC #4,END
   : F$="(NONE)"
   : LOAD DC T#1,"DE1.012B"
1430 DEFFN'229(R9,R9$)
   : DATA LOAD BA T#R9,(0,R3)R9$()
   : AND (STR(R9$(1),2,1),7F)
   : R4=VAL(STR(R9$(1),2,1))
   : R1$=R9$
   : XOR (STR(R1$,2),R1$)
   : R2$=STR(R1$,8,1)
   : R3$=HEX(0000)
   : ADDC(R3$,R2$)
   : ADDC(R3$,R2$)
   : ADDC(R3$,R2$)
1440 ADD(STR(R3$,1,1),STR(R3$,2,1))
   : R3=VAL(R3$)
   : R3=R3-INT(R3/R4)*R4
   : R5=R3
1450 DATA LOAD BA T#R9,(R3,R)R9$()
   : R6=0
   : FOR R7=1TO 16
   : IF R3<>0THEN 1460
   : IF R7<>1THEN 1460
   : R7=2
1460 R2$=STR(R9$(R7),1,1)
   : IF R2$=HEX(00)THEN 1480
   : IF R2$=HEX(10)THEN 1470
   : IF R2$<>HEX(11)THEN 1490
1470 IF STR(R9$(R7),9,8)<>R9$THEN 1490
   : R6=R7
1480 R7=16
1490 NEXT R7
   : IF R2$=HEX(00)THEN 1500
   : IF R6<>0THEN 1500
   : R2$=HEX(00)
   : R3=R3-1
   : IF R3=R5THEN 1500
   : IF R3>=0THEN 1450
   : R3=R4-1
   : GOTO 1450
1500 RETURN
1510 DEFFN'128(R9,R9$,R1)
   : GOSUB '229(R9,R9$)
   : ON VAL(R2$)-15GOTO 1540,1550
   : R2$="0"
   : DATA LOAD BA T#R9,(0,R3)R9$()
   : AND (STR(R9$(1),3,1),7F)
   : R2=VAL(STR(R9$(1),3,1))*256+VAL(STR(R9$(1),4,1))
   : AND (STR(R9$(1),5,1),7F)
1520 R3=VAL(STR(R9$(1),5,1))*256+VAL(STR(R9$(1),6,1))
   : IF R3-R2<R1THEN 1530
   : DATA SAVE DC OPEN T#R9,(R1),R9$
   : RETURN
1530 R2$="1"
   : RETURN
1540 R2$="2"
   : RETURN
1550 R2$="3"
   : RETURN
1560 DEFFN'251
   : PRINT "KEY RETURN(EXEC) TO RESUME.";
1580 KEYIN C$,1600,1580
   : GOTO 1580
1600 IF C$="X"THEN 1620
   : IF C$<>HEX(0D)THEN 1580
1620 PRINT
   : RETURN
1630 DEFFN'31
   : COM CLEAR H6
   : LOAD DC T#1,"MENU010A"
1720 PRINT HEX(030A0A0A0A0A0A)
   : PRINT TAB(15);"AVAILABLE ADDRESSES"
   : PRINT TAB(15);"1 - ";A$(1);"     4 - ";A$(4)
   : PRINT TAB(15);"2 - ";A$(2);"     5 - ";A$(5)
   : PRINT TAB(15);"3 - ";A$(3);"     6 - ";A$(6)
   : PRINT HEX(010A)
   : D2=1
1790 INPUT "ENTER ADDRESS FOR WORK AREA (DEFAULT = 1) ",D2
   : IF D2<=0THEN 1720
   : IF D2<>INT(D2)THEN 1720
   : IF D2>6THEN 1720
1830 ON D2GOTO 1850,1880,1910,1940,1970,2000
1850 SELECT #4310
   : GOTO 2020
1880 SELECT #4320
   : GOTO 2020
1910 SELECT #4330
   : GOTO 2020
1940 SELECT #4B10
   : GOTO 2020
1970 SELECT #4B20
   : GOTO 2020
2000 SELECT #4B30
2020 RETURN