image of READY prompt

Wang2200.org

Listing of file='IDS2PUI8' on disk='vmedia/701-2724B.wvd.zip'

# Sector 966, program filename = 'IDS2PUI8'
1000 REM "IDS2PUI8" - INSTALL AN APPLICATION - MOD 7, BEGUN 02/25/82, TSCHETTE
     R
1010 DIM D5$8,D8$2,D9$3
   : IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
   : SELECT #2<C9$(5)>,#4<C9$(7)>
   : IF P8=1THEN 1430
   : IF C7$(1)<>"IDS2PF11"THEN GOSUB 1400
   : IF C7$(1)="IDS2PF11"THEN 1030
   : IF P5>0THEN 1080
   : P6=P6+1
   : C6$,C9$=STR(E6$(),8*P6-7,8)
   : IF C6$=" "THEN 1430
   : IF P4=5OR P8=5THEN GOSUB 1270
1020 GOSUB 1290
   : ON P8GOTO 1010,,,1050
   : GOSUB 1110
   : H8=0
   : GOSUB 1300
   : GOSUB 1310
   : IF P9=0THEN 1030
   : FOR J=1TO P9
   : C6$=E7$(J)
   : GOSUB 1110
   : H8=0
   : GOSUB 1300
   : GOSUB 1310
   : NEXT J
1030 IF P8=2THEN 1010
   : IF P8=4AND P9>0THEN 1080
   : E$="Y"
   : GOSUB 1280
   : E3$()=C9$&E7$()
   : X=2
   : F=0
1040 C7$(1)="IDS2PF14"
   : LOAD T#X,C7$(1)1000,
   : ERRORJ4=ERR
   : IF J4<>82THEN 1100
   : GOSUB 1070
   : IF P7<>2THEN 1040
   : GOSUB '72(C7$(1),C9$(1))
   : GOTO 1040
1050 E9$(1)=C6$
   : GOSUB 1280
   : C7$(1)="IDS2PF11"
   : X=2
   : F=0
1060 LOAD T#X,C7$(1)1000,
   : ERRORJ4=ERR
   : IF J4<>82THEN 1100
   : GOSUB 1070
   : IF P7<>2THEN 1060
   : GOSUB '72(C7$(1),C9$(1))
   : GOTO 1060
1070 IF P7<>2THEN F=F+1
   : IF F=2THEN 1100
   : X=14
   : SELECT #14<C9$(1)>
   : RETURN
1080 P5=P5+1
   : IF P5=17THEN 1090
   : C6$=E7$(P5)
   : IF C6$=" "THEN 1090
   : GOTO 1050
1090 P5,P9=0
   : GOTO 1010
1100 PRINT HEX(070E);AT(23,0,);"Unexpected error ";J4
   : END
1110 SELECT PRINT 005
   : PRINT HEX(06);AT(8,0,);BOX(-1,-79);AT(10,0);BOX(-2,-79);AT(13,0);BOX(-2,-
     79);AT(16,0);BOX(-2,-79);AT(19,0);BOX(-4,-79)
1120 PRINT AT(8,0,);HEX(020400000E);"Enter the source disk address for data fi
     le ";HEX(22);C6$;HEX(2220);
   : LINPUT ?-C7$
   : IF C7$=" "THEN 1120
   : GOSUB 1380
   : IF D2=0THEN 1130
   : GOSUB 1170
   : GOTO 1120
1130 PRINT AT(9,0);
   : LINPUT "Enter the destination disk address"?-C8$
   : IF C8$=" "THEN 1130
   : GOSUB 1340
   : IF D8$>HEX(0000)THEN 1180
   : GOSUB 1140
   : GOTO 1130
1140 GOSUB '35("Address missing from IDEAS device list. Press EXEC or CANCEL."
     )
1150 KEYIN E6$
   : IF E6$<>HEX(1F)THEN RETURN
   : X=2
   : F=0
   : P6=P6-1
1160 LOAD T#X,"IDS2PUI6"1000,
   : ERRORJ4=ERR
   : IF J4<>82THEN 1100
   : GOSUB 1070
   : IF P7<>2THEN 1160
   : GOSUB '72("IDS2PUI6",C9$(1))
   : GOTO 1160
1170 GOSUB '35("Address not legal.  Press EXEC or CANCEL.")
   : GOTO 1150
1180 SELECT #14<C7$>,#15<C8$>
   : LIMITS T#14,C6$,A,B,C,D
   : IF D=2THEN 1190
   : IF D=0THEN E$=C6$&" is not on platter "&C7$&"."
   : IF D=-2THEN E$=C6$&" is a scratched data file on "&C7$
   : IF D=1OR D=-1THEN E$=C6$&" is a program file, not a data file."
   : GOSUB '35(E$)
   : GOTO 1120
1190 IF P7=1THEN GOSUB 1260
1200 MOVE T#14,C6$TO T#15,
   : ERRORJ4=ERR
   : IF J4=83THEN 1220
   : E$=" "
   : IF J4=81OR J4=86THEN E$="Platter "&C8$&" is full. Mount another or choose
      another address."
   : IF J4=85THEN E$="Index of "&C8$&" is full. Mount another or rectify situa
     tion."
   : IF E$=" "THEN 1100
   : GOSUB '35(E$)
   : GOTO 1130
1210 GOSUB 1420
   : RETURN
1220 SCRATCH T#15,C6$
   : MOVE T#14,C6$TO T#15,()
   : ERRORJ4=ERR
   : IF J4=81THEN 1240
   : GOTO 1100
1230 GOTO 1210
   : GOTO 1230
1240 F5$="\CAunk0000"
1250 CONVERT STR(F5$,5,4)TO X
   : X=X+1
   : CONVERT XTO STR(F5$,5,4),(####)
   : LIMITS T#15,F5$,A,B,B,B
   : IF B<>0THEN 1250
   : SCRATCH T#15,C6$
   : SAVE T#15,(C6$)F5$,0
   : SCRATCH T#15,F5$
   : GOTO 1200
1260 PRINT HEX(070E);AT(23,0,);"Mount destination diskette for ";HEX(22);C6$;H
     EX(22);" at ";C8$;" if needed, and/or press EXEC.";
   : KEYIN E6$
   : PRINT HEX(0F);AT(23,0,);
   : RETURN
1270 P4=5
   : SELECT PRINT 005
   : PRINT HEX(06);AT(8,0,);"Which of the above options (1 - 4) do you want fo
     r data file ";C6$;
   : INPUT P8
   : PRINT HEX(06);
   : IF P8<>INT(P8)OR P8<1OR P8>4THEN 1270
   : RETURN
1280 IF STR(R3$(),,9)="IDS2PUI8"THEN RETURN
   : X=LEN(STR(R3$()))-9
   : MAT COPY -R3$()<,X>TO -R3$()<10,X>
   : STR(R3$(),,9)="IDS2PUI8"
   : RETURN
1290 IF P7=1OR P7=3THEN SELECT #5<C9$(4)>
   : ELSE SELECT #5<C9$(8)>
   : H8=0
   : GOSUB 1300
   : E7$()=STR(E$(),275)
   : MAT SEARCHE7$(),=HEX(2020202020202020)TO D8$STEP 8
   : P9=-1+(7+VAL(D8$,2))/8
   : IF P9<0THEN P9=16
   : RETURN
1300 MAT REDIM E$(6)83
   : D5$=C6$OR ALL(20)
   : LIMITS T#5,D5$,A,B,C,D
   : IF D=0THEN 1320
   : DATA LOAD DA T#5,(A)E$()
   : RETURN
1310 SELECT #5<C9$(8)>
   : H8=1
   : GOSUB 1300
   : STR(E$(),105,3)=C8$
   : DATA SAVE DA T#5,(A)E$()
   : IF P7=1OR P7=3THEN SELECT #5<C9$(4)>
   : ELSE SELECT #5<C9$(8)>
   : RETURN
1320 IF H8=1THEN 1330
   : E$="Control file for "&C6$&" missing from "
   : IF P7=1OR P7=3THEN E$=E$&C9$(4)
   : ELSE E$=E$&C9$(8)
   : PRINT AT(12,0);E$
   : END
1330 E$="Mount platter containing control file "&HEX(22)&D5$&HEX(22)&" at "&C9
     $(8)&". Press EXEC or CANCEL"
   : GOSUB '63(STR(E$,,16),STR(E$,17),"!")
   : GOSUB 1150
   : GOTO 1300
1340 F5$="IDS2fs##"
   : CONVERT 1+(R0-#PART)/16TO STR(F5$,7),(##)
   : LIMITS T#2,F5$,A,B,C,D
   : IF A=0THEN 1350
   : MAT REDIM E$(9)83
   : DATA LOAD DA T#2,(A)E$()
   : MAT SEARCHSTR(E$(),45*#PART-17,45),=C8$TO D8$STEP 3
   : RETURN
1350 IF P7=1THEN GOSUB '72(F5$,C9$(5))
   : ELSE GOTO 1370
1360 DEFFN'72(F5$,F7$)
   : PRINT HEX(070E);AT(23,0,);"Mount the system diskette containing ";HEX(22)
     ;F5$;HEX(22);" at ";F7$;" and/or press EXEC.";
   : KEYIN E6$
   : PRINT HEX(0F06);AT(23,0,);
   : RETURN
1370 STOP "F5$ DIDN'T GET CREATED ON HARD SOURCE PLATER"
   : END
1380 D2=0
   : IF POS("3BD"=STR(C7$,,1))=0THEN 1390
   : IF POS("123567"=STR(C7$,2,1))=0THEN 1390
   : IF POS("012345"=STR(C7$,3,1))=0THEN 1390
   : RETURN
1390 D2=1
   : RETURN
1400 PRINT HEX(03020400000E06);AT(0,15);"INSTALL AN APPLICATION - MOVE OR CREA
     TE DATA FILES";HEX(0F);AT(2,0);BOX(5,79);AT(2,1);"Enter option  ";HEX(0E)
     ;P8;HEX(0F);AT(2,19);"1 - Copy just the data file control files";AT(3,19)
     ;"2 - Copy all data files with their data"
1410 PRINT AT(4,19);"3 - Copy all data files without their data";AT(5,19);"4 -
      Re-allocate all data files";AT(6,19);"5 - Stop for operater choice of op
     tion for each data file"
   : RETURN
1420 MAT SEARCHR7$,=C8$TO D8$STEP 3
   : IF D8$>HEX(0000)THEN RETURN
   : STR(R7$,19)=STR(R7$,19)&C8$
   : RETURN
1430 STR(R7$,,3)=" "
1440 PRINT AT(10,0,);
   : LINPUT "Enter desired printer address for application."-STR(R7$,,3)
   : PRINT HEX(06)
   : MAT SEARCH"204211212213214215216",=STR(R7$,,3)TO D8$STEP 3
   : IF D8$>HEX(0000)THEN 1450
   : GOSUB '35("Not a legal printer address")
   : GOTO 1440
1450 STR(R7$,16,3)=" "
1460 PRINT AT(11,0,);
   : LINPUT "Enter desired telecommunications address for application."-STR(R7
     $,16,3)
   : PRINT HEX(06)
   : MAT SEARCH"   01901A01B01C01D01E01F",=STR(R7$,16,3)TO D8$STEP 3
   : IF D8$>HEX(0000)THEN 1470
   : GOSUB '35("Not a legal telecommunications address")
   : GOTO 1460
1470 P6=0
   : IF L=45THEN 1500
   : IF L<=18THEN 1490
   : FOR J=1TO (45-L)/3
   : R7$=R7$&STR(R7$,L-2,3)
   : NEXT J
   : GOTO 1500
1490 FOR J=1TO 9
   : STR(R7$,16+3*J,3)=STR(R7$,4,3)
   : NEXT J
1500 P6=P6+1
   : IF P6>32OR D4$(P6)=" "THEN 1530
1510 LIMITS T#4,D4$(P6),A,B,C,D
   : IF D=1THEN 1520
   : E$="Mount platter containing "&D4$(P6)&" at "&C9$(7)&" & press EXEC or CA
     NCEL"
   : GOSUB '63(STR(E$,,16),STR(E$,17),"!")
   : GOSUB 1150
   : GOTO 1510
1520 PRINT HEX(06);AT(23,0,);
   : DATA LOAD BA T#4,(A+2)STR(E$(),,256)
   : STR(E$(),92,45)=R7$
   : DATA SAVE BA T#4,(A+2)STR(E$(),,256)
   : DATA LOAD BA T#4,(A+1)STR(E$(),,256)
   : MAT SEARCHSTR(E$(),,256),=HEX(A5D731352F)TO D8$
   : STR(E$(),VAL(D8$,2)+5,3)=C9$(5)
   : DATA SAVE BA T#4,(A+1)STR(E$(),,256)
   : GOTO 1500
1530 IF P7=2THEN SELECT #0<C9$(5)>
   : PRINT HEX(020402000E06);AT(13,0,);"Installation is complete.";AT(15,0);
   : END