image of READY prompt

Wang2200.org

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

# Sector 92, program filename = 'IDS2PIX8'
1001 REM "IDS2PIX8" - USED WITH START MODULE AT RUN TIME GIVEN DATE & USER ID
1002 COM R7$(1)80,R2$6,R4$3,R3$(10)9,R7$64,R8$1,R0,E(8),E8,E9,E,G,A,E0(8),E3$8
     ,E4$6,E0$8,F6$1,F2$8,F4$14,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,J,K,X,E7$8,F3$3,E1$8,E2$8,F6$1,Y,E$(E8)1,F$(E9)1,E6$(E)1,E1$
     (G)56
   : H=G
   : FOR I=1TO 1716STEP 245
   : READ STR(E$(),I)
   : NEXT I
   : $TRAN(E$(),HEX(22A2))R
   : E4$=R2$
   : DIM F0(6)
   : R3$()=STR(E$(),131,8)
   : FOR A=1TO 15
   : IF STR(E$(),A*3+83,3)=" "THEN 1090
   : SELECT #A<STR(E$(),A*3+83,3)>
   : ERRORX=ERR
   : GOTO 1310
1090 NEXT A
   : HEXPACKE8$(7)FROMSTR(E$(),87,2)
   : ERRORX=ERR
   : GOTO 1310
1094 %SELECT #0<STR(E$(),95,3)>: ERROR X=ERR: GOTO 1310
1096 F4$=STR(E$(),86,3)&STR(E$(),2,8)&STR(E$(),101,3)
   : F6$()=ALL(4E)
   : STR(F6$(),11,4)="YYYY"
   : F6$(15)=HEX(FF)
   : F6$(53)="Y"
   : R7$(1)=STR(E$(),147,64)
   : IF R0>0AND R0<97AND MOD(R0-#PART,16)=0THEN 1200
   : DATA LOAD DC OPEN T#2,"IDS2f001"
   : ERRORGOTO 1152
1151 GOTO 1160
1152 DATA SAVE DC OPEN T#2,(3)"IDS2f001"
   : ERRORPRINT HEX(0307)
   : PRINT "Fatal error in IDEAS-2 Release 2.1 system program IDS2PIX3"
   : PRINT "Start module unable to open necessary system file IDS2f001"
   : END
1155 F0=1
   : F0(1)=#ID
   : R0=#PART
   : $OPEN #2
   : DATA SAVE DC #2,F0,F0()
   : DATA SAVE DC #2,END
   : GOTO 1200
1160 $OPEN #2
   : DATA LOAD DC #2,F0,F0()
   : R0=0
   : FOR I=1TO F0
   : IF F0(I)=#IDTHEN R0=(I-1)*16+#PART
   : NEXT I
   : IF R0>0THEN 1200
   : IF F0<6THEN 1175
   : $CLOSE#2
   : PRINT HEX(0307)
   : PRINT "Fatal error in IDEAS-2 Release 2.1 system program IDS2PIX3"
   : PRINT "System CPU file IDS2f001 is full - Unable to add new CPU #"
   : END
1175 F0=F0+1
   : F0(F0)=#ID
   : R0=(F0-1)*16+#PART
   : DBACKSPACE #2,1S
   : DATA SAVE DC #2,F0,F0()
1200 E$="IDS2fsxx"
   : IF R0>=#PARTTHEN CONVERT (R0-#PART)/16+1TO STR(E$,7,2),(##)
   : LIMITS T#2,E$,A,B,C,D
   : IF D=2AND B-A>=165THEN 1300
   : IF D=0THEN 1230
   : DIM J1$8
   : J1=0
   : J1$="JUNKxxxx"
1220 J1=J1+1
   : CONVERT J1TO STR(J1$,5,4),(####)
   : LIMITS T#2,J1$,A,B,C,D
   : IF D<>0THEN 1220
   : SCRATCH T#2,E$
   : SAVE DC T#2,(E$)J1$1000,1000
   : SCRATCH T#2,J1$
1230 DATA SAVE DC OPEN T#2,(166)E$
   : ERRORPRINT HEX(0307)
   : PRINT "Fatal error in IDEAS-2 Release 2.1 system program IDS2PIX3"
   : PRINT "Start module unable to open necessary system file ";E$
   : END
1240 DATA LOAD DC OPEN T#2,E$
   : MAT REDIM E3$(9)83
   : E3$()=" "
   : DATA SAVE DC #2,E3$()
   : DSKIP #2,161S
   : DATA SAVE DC #2,END
   : LIMITS T#2,E$,A,B,C,D
   : FOR I=A+3TO A+163
   : DATA SAVE BA T#2,(I)STR(E3$(),,256)
   : NEXT I
   : STR(E3$(),,8)=ALL(30)
   : DATA SAVE BA T#2,(A+3)STR(E3$(),,256)
1300 $CLOSE#2
   : GOTO 1405
1310 PRINT HEX(0607020402000E);AT(23,0);"Error message:   Fatal device selecti
     on error attempting to open #";A;"/ ";STR(E$(),A*3+83,3);" !";HEX(010F05)
   : IF STR(E$(),139,8)=" "THEN STOP
   : ELSE LOAD T#4,STR(E$(),139,8)1000,
   : STOP "CANNOT FIND SYSTEM FILES -- SELECT DEVICE # 0 TO THE IDEAS SYSTEM P
     ACK"
1405 DIM F8$(6)83,F9$(6)83
   : SELECT PRINT 005
   : IF H=1THEN 1420
   : PRINT HEX(0306020402000E);AT(0,0);BOX(1,79);" ";STR(E$(),2,8);" - ";STR(E
     $(),22,32);"        Open Application Data Files"
1420 L=0
   : F=3
   : IF H=1THEN 1685
   : GOSUB 1735
   : FOR I=1TO 60
   : F0=L+1
   : K=714+I*17
   : IF E$(K)<>"S"AND E$(K)<>"R"THEN 1680
   : F5$=STR(E$(),I*8+243,8)
   : IF F5$=" "THEN 1680
   : E7$=F5$OR ALL(20)
   : GOSUB '39(E7$,5)
   : W=P
   : Y=A
   : IF Q=0THEN 1705
   : DATA LOAD DA T#P,(A)F8$()
   : FOR J=0TO 16
   : IF J=0THEN F9$()=F8$()
   : IF J=0THEN 1520
   : K=K+1
   : IF E$(K)<>"S"AND E$(K)<>"R"THEN 1675
1495 F5$=STR(F8$(),267+J*8,8)
   : IF F5$=" "THEN 1675
   : E7$=F5$OR ALL(20)
   : GOSUB '39(E7$,5)
   : Y=A
   : W=P
   : IF Q=0THEN 1705
   : DATA LOAD DA T#P,(A)F9$()
1520 MAT SEARCHE$()<86,45>,=STR(F9$(),105,3)TO F9$STEP 3
   : IF F9$=HEX(0000)THEN 1710
1530 R=INT((VAL(F9$,2)+2)/3)
   : GOSUB '39(STR(F9$(),2,8),R)
   : IF Q=0THEN 1715
   : L=L+1
   : GOSUB 1740
   : E1$(L)=STR(F9$(),2,8)&BIN(R)&BIN(F0,2)&STR(F9$(),403,1)&STR(F9$(),405,42)
     &BIN(A,2)
1555 UNPACK(####)STR(E1$(L),13)TO Q
   : STR(E1$(L),13,2)=BIN(Q,2)
   : S=(N-2)/VAL(STR(E1$(L),43),2)
   : STR(E1$(L),46,2)=BIN(S,2)
   : S=S-VAL(STR(E1$(L),45))
   : A=VAL(STR(E1$(L),50))
   : B=VAL(STR(E1$(L),51))
   : STR(E1$(L),19,2)=BIN(MIN(S*B/A,VAL(STR(E1$(L),48),2)),2)
   : F=MAX(F,VAL(STR(F9$(),416))+VAL(STR(F9$(),417)))
   : IF J=0THEN 1600
1575 STR(E1$(L),52,2)=STR(E1$(VAL(STR(E1$(L),10),2)),52,2)
   : STR(E1$(L),13,2)=STR(E1$(VAL(STR(E1$(L),10),2)),13,2)
   : IF STR(E1$(VAL(STR(E1$(L),10),2)),9,1)>HEX(0F)THEN STR(E1$(L),9,1)=OR HEX
     (80)
   : GOTO 1675
1600 IF STR(F9$(),75,3)<>" "AND STR(F9$(),75,3)<>R4$THEN STR(E1$(L),52,1)="G"
   : IF STR(F9$(),79,3)<>" "AND STR(F9$(),79,3)<>R4$THEN STR(E1$(L),53,1)="G"
   : IF STR(F9$(),404,1)=HEX(01)THEN 1675
   : FOR V=1TO VAL(STR(F9$(),404,1))-1
   : IF STR(F9$(),251+V*3,3)=" "THEN 1730
   : MAT SEARCHE$()<86,45>,=STR(F9$(),251+V*3,3)TO F9$STEP 3
   : IF F9$=HEX(0000)THEN 1730
1635 R=INT((VAL(F9$,2)+2)/3)
   : GOSUB '39(STR(F9$(),2,8),R)
   : Y=1E9
   : IF Q=0THEN 1715
   : E1$(L+V)=STR(F9$(),2,8)&BIN(R)&BIN(F0,2)&HEX(00)&STR(F9$(),405,42)&BIN(A,
     2)
   : STR(E1$(L+V),13,2)=STR(E1$(L),13)
   : F9$=BIN((N-2)/VAL(STR(E1$(L+V),43),2),2)
1660 S=VAL(F9$,2)
   : A=VAL(STR(E1$(L+V),50))
   : B=VAL(STR(E1$(L+V),51))
   : STR(E1$(L+V),45,5)=HEX(00)&STR(F9$,,2)&BIN(S*B/A,2)
   : STR(E1$(L+V),19,2)=STR(E1$(L+V),48)
   : NEXT V
   : L=L+VAL(STR(F9$(),404,1))-1
1675 NEXT J
   : IF L>=H-1THEN I=60
1680 NEXT I
1685 L=L+1
   : IF STR(F4$,4,8)<>"IDS2PCST"THEN 1690
   : L=24
   : F=80
1690 LOAD T#2,"IDS2PIX9"
1695 DEFFN'39(F5$,P)
   : IF STR(F5$,,4)="IDS2"OR STR(F5$,,4)="ids2"THEN P=2
   : T=P
   : LIMITS T#P,F5$,A,M,N,Q
   : ERRORPRINT AT(20,0,80);"Disk error on device #";P;" - check device";
   : STOP
   : END
1700 RETURN
1705 F0$="Control file "&HEX(22)&E7$&HEX(22)&" for "&HEX(22)&F5$&HEX(22)&" not
      on device # 5 / "&STR(E$(),98,3)&"."
   : GOTO 1720
1710 F0$="Device address "&STR(F9$(),105,3)&" for file "&HEX(22)&STR(F9$(),2,8
     )&HEX(22)&" has not been selected."
   : GOTO 1720
1715 F0$="Data file "&HEX(22)&STR(F9$(),2,8)&HEX(22)&" not found on device "&S
     TR(E$(),R*3+83,3)&"."
   : PRINT AT(20,0);HEX(07);HEX(0E);F0$
1716 PRINT AT(21,0);"If possible, enter a correct address for ";HEX(22);STR(F9
     $(),2,8);HEX(22);", else enter ";HEX(22);"END";HEX(22);".  ";
   : LINPUT -STR(F9$(),105,3)
   : IF STR(F9$(),105,3)="END"THEN END
1717 MAT SEARCHE$()<86,45>,=STR(F9$(),105,3)TO F9$STEP 3
   : IF F9$>HEX(0000)THEN 1718
   : PRINT HEX(07);AT(22,0);"Address not selected in START program";
   : GOTO 1716
1718 PRINT AT(20,0,230);
   : IF Y=1E9THEN 1720
   : DATA SAVE DA T#W,(Y)F9$()
   : GOTO 1530
1720 PRINT AT(20,10);HEX(07);"Error ";HEX(0E);F0$
   : STOP
   : END
1730 F0$="Device address "&STR(F9$(),251+V*3,3)&" for volume "&BIN(V+48)&" of
     file "&HEX(22)&STR(F9$(),2,8)&HEX(22)&" not selected."
   : GOTO 1720
1735 PRINT HEX(0F);AT(23,0);"Now opening data file number ";
   : D9=0
   : D8=LEN(STR(E1$()))/56-1
   : RETURN
1740 D9=D9+1
   : PRINT AT(23,28,25);D9;" of ";D8;
   : RETURN