image of READY prompt

Wang2200.org

Listing of file='IDEAS2' on disk='vmedia/701-2717B.wvd.zip'

# Sector 148, program filename = 'IDEAS2'
1000 REM - "IDEAS2  " START MODULE FOR UTILITIES
1001 COM R7$(1)80,R2$6,R4$3,R3$(10)9,R8$1,R0,E(8),E8,E9,E,G,A,E0(8),E3$8,E4$6,
     E0$8,F6$1,F2$8,F5$8,E9$(9)8,E2$(250)9,E3$(249)8,E0$(249)1,B,D,Q,F,F0,F9$2
     ,R,C,H,W,U,F7$8,P,L,E$87,T,Z,E4$(16),N,E6$1,M,E8$(15)1,E8$16,F0$64,O,S,V,
     E9$8,F8$2,I
1003 COM F6$(64)1,E7$8,F3$3,J,X,K,E1$8,E2$8,F6$1,Y
   : COM F0(6),C2$3,D3$2,D2$10,F2$(256)1,D8$3,C4$4
   : COM E7$(4)36
   : DIM F1$48
   : F1$="D22D23D22D23D22D22D22D23D23D23D22D23D22D22D23D22"
   : E8=2075
   : E9=2250
   : G=500
   : H=2
   : E=21
   : E9$(),F6$(17)=" "
   : IF R4$<>" "AND NUM(R2$)=6THEN 2170
1060 E7$(1)="310320330B10B20B30350360370B50B60B70"
   : E7$(2)="D10D11D12D13D14D15D50D51D52D53D54D55"
   : E7$(3)="D20D21D22D23D24D25D60D61D62D63D64D65"
   : E7$(4)="D30D31D32D33D34D35D70D71D72D73D74D75"
   : E9$,C2$=STR(F1$,#PART*3-2,3)
   : SELECT CO 005(80),PRINT 005(80),LIST 005(80)
   : PRINT HEX(06030F)
1260 PRINT AT(0,0);BOX(1,79)
   : PRINT AT(0,1);HEX(020402000E);"I.D.E.A.S."
   : PRINT AT(0,20);"I";HEX(0F);"nquiry, ";
   : PRINT HEX(0E);"D";HEX(0F);"ata ";HEX(0E);"E";HEX(0F);"ntry, and ";
   : PRINT HEX(0E);"A";HEX(0F);"ccess ";HEX(0E);"S";HEX(0F);"ystem";
   : PRINT AT(0,68);"Release 2.1"
   : C=13
   : R=3
   : PRINT AT(R+11,C-3);BOX(05,59)
1350 PRINT AT(R,C-1);BOX(10,55)
   : PRINT AT(R,C);"This module requires that you specify the disk address"
   : PRINT AT(R+1,C);"where the ";HEX(0E);"I.D.E.A.S";HEX(0F);" system utiliti
     es reside.  The disk"
   : PRINT AT(R+2,C);"addresses supported by ";HEX(0E);"I.D.E.A.S.";HEX(0F);"
     are listed below."
1390 PRINT AT(R+4,C);"Please choose the appropriate address for your system"
   : PRINT AT(R+5,C);"from those listed and touch ";HEX(0E);"RETURN";HEX(0F);"
     , or just touch the"
   : PRINT AT(R+6,C);HEX(0E);"RETURN";HEX(0F);" key to accept the default addr
     ess as shown."
1420 PRINT AT(R+8,C);"The disk address you choose (if valid) will become the"
   : PRINT AT(R+9,C);"new default address for this module on this terminal."
   : PRINT AT(R+11,C-2);"------< Valid disk address supported by ";HEX(0E);"I.
     D.E.A.S.";HEX(0F);" >------"
   : GOSUB 2210
1470 PRINT AT(R+18,C-3);BOX(1,59)
1480 C2$=E9$
   : PRINT AT(R+18,C-2);"Please enter ";HEX(020402000E);"I.D.E.A.S.";HEX(0F);"
      system utilities disk address. ";HEX(020404000E);E9$;HEX(080808);
   : K=0
   : K=K+1
1530 PRINT AT(R+18,C+K+52);HEX(05);
1540 KEYIN R8$,,1595
   : PRINT HEX(06);AT(23,0,80);AT(R+18,C+K+52);
   : IF R8$=HEX(0D)OR R8$=HEX(82)THEN 1760
   : IF R8$<>HEX(08)THEN 1600
   : ELSE IF K>1THEN K=K-1
   : GOTO 1530
1595 IF VAL(R8$)=31OR VAL(R8$)=240THEN 1596
   : PRINT HEX(07);
   : GOTO 1540
1596 IF R3$(1)=" "THEN 1597
   : LIMITS TR3$(1),A,B,C,D
   : IF D<>1THEN 1597
   : COM CLEAR E()
   : LOAD TR3$(1)
1597 LIMITS T"START",A,B,C,D
   : IF D<>1THEN 1598
   : COM CLEAR
   : LOAD T"START"
1598 PRINT HEX(07);
   : GOTO 1540
1600 ON K-1GOTO 1650,1680
   : IF POS("3BD"=R8$)>0THEN 1710
   : ELSE PRINT AT(23,0,80);HEX(07);"Invalid character - Must be '3' , 'B' , o
     r 'D'.";
   : GOTO 1530
1650 IF POS("123567"=R8$)>0THEN 1710
   : ELSE PRINT AT(23,0,80);HEX(07);"Invalid character - Must be '1', '2', '3'
     , '5', '6', or '7'.";
   : GOTO 1530
1680 IF POS("012345"=R8$)>0THEN 1710
   : ELSE PRINT AT(23,0,80);HEX(07);"Invalid character - Must be '0', '1', '2'
     , '3', '4', or '5'.";
   : GOTO 1530
1710 STR(C2$,K,1)=R8$
   : $GIO/005(A200,D2$)R8$
   : K=K+1
   : IF K<4THEN 1530
1760 MAT SEARCHE7$(),=STR(C2$,1,3)TO D3$STEP 3
   : PRINT AT(23,0,80);HEX(0F06);
   : IF D3$=HEX(0000)THEN PRINT AT(23,0);HEX(07);C2$;" is not a valid disk add
     ress supported by IDEAS. Choose from the list above.";
   : IF D3$=HEX(0000)THEN 1480
   : SELECT #2<C2$>
   : $GIO#2,(0104020012124400,D2$)
1830 IF STR(D2$,8,1)=HEX(10)THEN PRINT AT(23,0,80);HEX(07);"Device ";C2$;" is
     not currently available.  Please check status and/or address.";
   : IF STR(D2$,8,1)=HEX(10)THEN 1480
   : LIMITS T#2,"IDEAS2",A,B,B,B
   : ERRORPRINT AT(23,0,80);HEX(07);"Disk device error on device ";C2$;". Plea
     se try again.";
   : GOTO 1480
1870 IF B=0THEN PRINT AT(23,0,80);HEX(07);"The IDEAS system utilities are not
     contained on device ";C2$;". Please try again.";
   : IF B=0THEN 1480
   : E9$,STR(F1$,#PART*3-2,3)=C2$
   : GOSUB 2210
   : $OPEN #2
   : I=0
1940 I=I+1
   : IF I>5THEN PRINT AT(23,0,80);HEX(07);"Error in program IDEAS2 ";
   : IF I>5THEN $CLOSE#2
   : IF I>5THEN 1480
   : DATA LOAD BA T#2,(A+I)F2$()
   : MAT SEARCHF2$(),="F1$="TO D3$
   : IF D3$=HEX(0000)THEN 1940
   : STR(F2$(),VAL(D3$,2)+#PART*3+2,3)=C2$
   : DATA SAVE BA T#2,(A+I)F2$()
   : $CLOSE#2
   : LIMITS T#2,"IDS2f001",A,B,C,D
   : IF D=0THEN 2050
2010 DATA LOAD DC OPEN T#2,"IDS2f001"
   : DATA LOAD DC #2,F0,F0()
2020 R0=0
   : FOR I=1TO F0
   : IF F0(I)=#IDTHEN R0=(I-1)*16+#PART
   : NEXT I
   : IF R0>0THEN 2070
2050 LOAD DC T#2,"IDS2PUM1"1000,1470BEG 2055
2055 GOSUB '71
2070 $OPEN #2
   : F2$="IDS2fs  "
   : IF R0>=#PARTTHEN CONVERT (R0-#PART)/16+1TO STR(F2$,7,2),(##)
   : ELSE GOTO 2020
   : LIMITS T#2,F2$,A,B,C,D
   : MAT REDIM E2$(9)83
   : IF A=0THEN 2130
   : IF A>0THEN DATA LOAD DA T#2,(A)E2$()
   : STR(E2$(),#PART*45-17+3,3)=C2$
   : IF A>0THEN DATA SAVE DA T#2,(A)E2$()
2130 $CLOSE#2
   : IF A=0THEN 2050
2170 COM CLEAR Y
   : X=LEN(STR(R3$()))-9
   : MAT COPY -R3$()<1,X>TO -R3$()<10,X>
   : STR(R3$(),,9)="IDS2P002"
   : E$="IDS2P001IDS2P004"
   : LOAD T#2,<2>E$
2210 FOR I=1TO 4
   : FOR J=0TO 11
   : PRINT AT(R+I+11,C-2+5*J);
   : IF STR(E7$(I),J*3+1,3)=E9$THEN PRINT HEX(020400020E);
   : PRINT STR(E7$(I),J*3+1,3);HEX(020402000F)
   : NEXT J,I
   : RETURN
2290 ON ERRORD8$,C4$GOTO 2300
2300 IF D8$="P48"THEN PRINT AT(23,0,80);HEX(07);C2$;" is not currently in the
     master device table of your CPU. Please try again.";
   : IF D8$="P48"THEN 1480
   : PRINT AT(23,0,80);"Unanticipated error # ";D8$;" at line # ";C4$;".  No r
     ecovery has been programmed.";HEX(0107);
   : STOP "ERROR !"