Listing of file='IDS2PIX4' on disk='vmedia/701-2717B.wvd.zip'
# Sector 784, program filename = 'IDS2PIX4'
1000 REM "IDS2PIX4" - START MODULE COMMON ARRAYS, OPEN APPLICATION FILES
1010 COM F$(E9)1,E6$(J)1,E2$(250)9,E1$(H)56
: DIM F8$(6)83,F9$(6)83
: SELECT PRINT 005
: PRINT HEX(0306020402000E);AT(0,0);BOX(1,79);" ";STR(E$(),2,8);" - ";STR(E
$(),22,32);" Open Application Data Files"
: L=0
: F=3
: GOSUB 1645
: FOR I=1TO 60
: F0=L+1
: K=714+I*17
: IF E$(K)<>"S"AND E$(K)<>"R"THEN 1540
1090 F5$=STR(E$(),I*8+243,8)
: IF F5$=" "THEN 1540
: E7$=F5$OR ALL(20)
: GOSUB '39(E7$,5)
: IF Q=0THEN 1580
: DATA LOAD DA T#P,(A)F8$()
: Y=A
: W=P
: FOR J=0TO 16
: IF J=0THEN F9$()=F8$()
: IF J=0THEN 1250
: K=K+1
: IF E$(K)<>"S"AND E$(K)<>"R"THEN 1530
: F5$=STR(F8$(),267+J*8,8)
: IF F5$=" "THEN 1530
: E7$=F5$OR ALL(20)
: GOSUB '39(E7$,5)
: IF Q=0THEN 1580
1240 DATA LOAD DA T#P,(A)F9$()
: Y=A
: W=P
1250 MAT SEARCHE$()<86,45>,=STR(F9$(),105,3)TO F9$STEP 3
: IF F9$=HEX(0000)THEN 1590
: R=INT((VAL(F9$,2)+2)/3)
: GOSUB '39(STR(F9$(),2,8),R)
: IF Q=0THEN 1600
: L=L+1
: GOSUB 1650
: E1$(L)=STR(F9$(),2,8)&BIN(R)&BIN(F0,2)&STR(F9$(),403,1)&STR(F9$(),405,42)
&BIN(A,2)
1315 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 1390
1350 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 1530
1390 IF STR(F9$(),75,3)<>" "OR STR(F9$(),79,3)<>" "THEN STR(E1$(L),9,1)=OR HEX
(80)
: IF STR(F9$(),404,1)=HEX(01)THEN 1530
: FOR V=1TO VAL(STR(F9$(),404,1))-1
: IF STR(F9$(),251+V*3,3)=" "THEN 1640
: MAT SEARCHE$()<86,45>,=STR(F9$(),251+V*3,3)TO F9$STEP 3
: IF F9$=HEX(0000)THEN 1640
: R=INT((VAL(F9$,2)+2)/3)
: GOSUB '39(STR(F9$(),2,8),R)
: Y=1E9
: IF Q=0THEN 1600
1480 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)
: 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
1520 L=L+VAL(STR(F9$(),404,1))-1
1530 NEXT J
: IF L>=H-1THEN I=60
1540 NEXT I
: L=L+1
: IF STR(F4$,4,8)<>"IDS2PCST"THEN 1560
: L=24
: F=80
1560 GOTO 2030
1570 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
1575 RETURN
1580 F0$="Control file "&HEX(22)&E7$&HEX(22)&" for "&HEX(22)&F5$&HEX(22)&" not
on device # 5 / "&STR(E$(),98,3)&"."
: GOTO 1610
1590 F0$="Device address "&STR(F9$(),105,3)&" for file "&HEX(22)&STR(F9$(),2,8
)&HEX(22)&" has not been selected."
: GOTO 1610
1600 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$
: IF Y=1E9THEN 1620
1601 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
1602 MAT SEARCHE$()<86,45>,=STR(F9$(),105,3)TO F9$STEP 3
: IF F9$>HEX(0000)THEN 1603
: PRINT HEX(07);AT(22,0);"Address not selected in START program";
: GOTO 1601
1603 PRINT AT(20,0,230);
: IF Y=0THEN 1620
: DATA SAVE DA T#W,(Y)F9$()
: GOTO 1250
1610 PRINT AT(20,10);HEX(07);"Error ";HEX(0E);F0$
1620 STOP
: END
1640 F0$="Device address "&STR(F9$(),251+V*3,3)&" for volume "&BIN(V+49)&" of
file "&HEX(22)&STR(F9$(),2,8)&HEX(22)&" not selected."
: GOTO 1610
1645 D8=LEN(STR(E1$()))/56-1
: IF D8>0THEN PRINT HEX(0F);AT(23,0);"Now opening data file number ";
: D9=0
: RETURN
1650 D9=D9+1
: PRINT AT(23,28,25);D9;" of ";D8;
: RETURN
2030 X=LEN(STR(R3$()))-9
: SELECT @PART"IDS2SUBM"
: ERRORLOAD T#2,"IDS2PIX6"1000,
2040 MAT COPY -R3$()<1,X>TO -R3$()<10,X>
: STR(R3$(),,9)="IDS2PIX5"
: IF LEN(STR(E$))<>87THEN STOP "Length of E$ not Valid"
: IF POS(HEX(6040414243)=F6$(17))<>0THEN 2230
: SELECT @PART"IDS2SUBM"
: ERRORE$="Loading Subrtnes"&STR(R3$(),,8)
: IF F6$(53)<>"N"THEN LOAD T#2,"IDS2P003"
2150 E$=$PSTAT(#PART)
: UNPACK(##)STR(E$,27,1)TO X
: E$=$PSTAT(X)
: UNPACK(##.##)STR(E$,12,2)TO X
: F6$(17)=HEX(60)
: IF X>11.50THEN F6$(17)="@"
: IF X>12.25THEN F6$(17)="B"
: IF X>13THEN F6$(17)="C"
2230 F0$=STR(R3$(),,9)
: R3$()=STR(R3$(),10)
: LOAD DC T#2,STR(F0$,,8)1000,
2250 STOP "Minimum required space to operate IDEAS 2 is 28 K "