Listing of file='IDS2PC04' on disk='vmedia/701-2725B.wvd.zip'
# Sector 603, program filename = 'IDS2PC04' 1000 REM 'IDS2PC04' - CONVERSION MODULE - TRANSFERS DATA 1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM" : COM E1$(24)56,F1$(24)80,F0$(24)80 : DIM C5$(8)45,D5$35,D5$(128)2,D2$(128)2,D3$(128)2,D1$2,D4$(1)2,D2$2,D6$(1) 3,D3$8,D4$34,D7$(128)8,R9$3 1040 D4$=HEX(3000310132023303340435053606370738083909200A2B0B2C0C2D0D2E0E240F) : PRINT AT(22,10);"Now moving data to IDEAS2 file. Process is " 1060 FOR K9=1TO P8 : STR(C5$(K9),,8)=D6$ : MAT SEARCHD9$(),=D1$(K9+1)TO D1$STEP 3 : IF D1$=HEX(0000)THEN STOP "ALL IDEAS1 VOLUMES MUST HAVE DISK SLOTS SELECT ED" : J9=(2+VAL(D1$,2))/3 : STR(C5$(K9),9,2)=HEX(01)&BIN(J9) : E6$=STR(D1$(K9+1),2,1) : E6$=AND HEX(0F) : ROTATE(E6$,4) : STR(C5$(K9),11,1)=E6$ 1080 SELECT #6<D1$(K9+1)> : LIMITS T#6,D6$,A5,B5,B5,B5 : IF K9=1THEN C5=A5+1 : DATA LOAD DA T#6,(A5,STR(C5$(K9),44,2))STR(C5$(K9),12,32) : NEXT K9 : U5=1 : UNPACK(####)STR(C5$(1),28,2)TO B6 : D7=VAL(STR(C5$(1),10,1)) : UNPACK(##)STR(C5$(1),13,1)TO K6 : K6=K6+3 : UNPACK(####)STR(C5$(1),30,2)TO C6 : UNPACK(##)STR(C5$(1),17,1)TO Y5 1100 MAT REDIM D7$(6)83 : E7$=C8$OR ALL(20) : DATA LOAD DC OPEN T#5,E7$ : DATA LOAD DC #5,D7$() : GOSUB '77(1,1,C8$,D1$(11)) : CONVERT STR(D7$(),217,1)TO V9 : IF V9=1THEN 1120 : FOR J8=2TO V9 : GOSUB '77(2,J8,C8$,D1$(J8+10)) : NEXT J8 1120 IF STR(D7$(),275,8)=" "THEN 1130 : MAT SEARCHSTR(D7$(),275,128),=HEX(2020202020202020)TO D1$STEP 8 : F$()=D7$() : FOR J8=1TO (VAL(D1$,2)-1)/8 : E7$=STR(F$(),267+8*J8,8)OR ALL(20) : DATA LOAD DC OPEN T#5,E7$ : DATA LOAD DC #5,D7$() : GOSUB '77(3,V9+J8,STR(F$(),267+8*J8,8),D1$(18+J8)) : NEXT J8 1130 R8$="F" : F$(),D7$()=" " : MAT REDIM F$(2250)1,D7$(128)8 : FOR I5=0TO B6-1 : FOR J5=1TO Y5 : DATA LOAD BA T#D7,(C5+I5*C6+J5)D3$() : K7=INT(256/K6) : FOR K5=K7TO 1STEP -1 : PRINT AT(22,53); : PRINTUSING "###",((I5/B6)+(J5-1)/(B6*Y5)+(K7-K5+1)/(B6*Y5*K7))*100; : PRINT HEX(0E);"% complete. " : MAT COPY D3$()<K6*K5-2,3>TO D6$() 1200 IF STR(D6$(),,2)=HEX(FFFF)THEN 1280 : T6=-1 : GOSUB '76(1,D6$(),0) : C3=C3+1 : P5=1 : UNPACK(####)STR(C5$(VAL(STR(C5$(V5),9,1))),42,2)TO L5 1240 B5=257-C3 : IF L5+1-P5>B5THEN 1250 : B5=L5+1-P5 1250 MAT COPY D2$()<C3,B5>TO D7$()<P5,B5> : P5=P5+B5 : C3=1 : E5=E5+1 : IF P5>L5THEN 1260 : DATA LOAD BA T#T5,(E5,N5)D2$() : GOTO 1240 1260 GOSUB 1290 : IF STR(D7$(),,L5)=" "THEN 1280 : F$()=D7$() : GOSUB '42(C8$,0) 1280 NEXT K5 : NEXT J5 : NEXT I5 : GOSUB 1450 : COM CLEAR D1$() : LOAD T#2,"IDS2PC05"1000, 1290 GOSUB 1340 : T5=N5 : D9=1 : D5=A5 1300 IF T5<1THEN 1310 : C3=128 : IF C3>T5THEN C3=T5 : IF D9+C3<=L5THEN MAT COPY -D7$()<D9+C3/2,L5-D9-C3+1>TO -D7$()<D9+C3,L5-D9 -C3+1> : D2$()=STR(D7$(),D9,C3) : MAT REDIM D2$(2)C3/2 : D2$(2)=D2$(1) : ROTATE(D2$(2),4) : AND (D2$(),0F) : $TRAN(D2$(),D4$)R : STR(D7$(),D9,C3)=D2$() : MAT REDIM D2$(128)2 : T5=T5-C3 : D9=D9+C3 : GOTO 1300 1310 IF D5<1THEN RETURN : C3=256 : IF C3>D5THEN C3=D5 : IF D9+C3<=L5THEN MAT COPY -D7$()<D9+C3*.75,L5-D9-C3+1>TO -D7$()<D9+C3,L5- D9-C3+1> : D2$()=STR(D7$(),D9,C3) : MAT REDIM D2$(4)C3/4,D5$(3)C3/4 1320 MAT COPY D2$()TO D5$() : D2$(4)=D2$(3) : AND (D2$(4),FC) : AND (D2$(1),3F) : AND (D2$(2),0F) : AND (D2$(3),03) : AND (D5$(1),C0) : ADD(D2$(2),D5$(1)) : AND (D5$(2),F0) : ADD(D2$(3),D5$(2)) 1330 ROTATE(D2$(2),2) : ROTATE(D2$(3),4) : ROTATE(D2$(4),6) : ADD(D2$(),20) : STR(D7$(),D9,C3)=D2$() : MAT REDIM D2$(128)2,D5$(128)2 : D5=D5-C3 : D9=D9+C3 : GOTO 1310 1340 UNPACK(####)STR(C5$(V5),36,6)TO L5,N5,A5 : N5=N5/2 : A5=A5+SGN(N5-INT(N5)) : N5=INT(N5)*2 : A5=INT(A5/4)*4 : RETURN 1350 DEFFN'76(V5,D6$(1),D6) : UNPACK(##)STR(C5$(V5),12)TO A5 : D3$=D6$() : M5=INT(VAL(STR(D3$,3))/32) : N5=VAL(STR(C5$(V5),9))+M5 : ADDC(STR(D3$,1,2),STR(C5$(N5),44,2)) : D4$()=D3$ : E5=VAL(D4$(1),2) : UNPACK(####)STR(C5$(N5),42)TO Q5 : C3=VAL(STR(D3$,3))-32*M5 : C3=(C3*Q5)/256 : E5=E5+INT(C3) : C3=256*(C3-INT(C3))+1 : T5=VAL(STR(C5$(N5),10)) 1370 ON D6GOTO 1400,1400,1400,1380 : IF STR(C5$(V5),11,1)=STR(C5$(N5),11,1)THEN 1390 1380 D5$=STR(C5$(N5),11) : $GIO(73104480,D5$) 1390 DATA LOAD BA T#T5,(E5,N5)D2$() : D4$()=STR(D2$(),C3,1) : Q5=-1 1400 D5$=STR(C5$(ABS(V5)),11) : $GIO(73104400,D5$) : RETURN 1410 DEFFN'77(Q1,K9,E7$,R9$) : SELECT #6<R9$> : LIMITS T#6,E7$,A5,B5,B7,B8 : STR(E1$(K9),55,2)=BIN(A5,2) : STR(E1$(K9),12,43)=STR(D7$(),403,1)&STR(D7$(),405,42) : A=VAL(STR(E1$(K9),50)) : B=VAL(STR(E1$(K9),51)) : IF Q1=2THEN 1420 : UNPACK(####)STR(E1$(K9),13,2)TO Q : STR(E1$(K9),13,2)=BIN(Q,2) 1420 MAT SEARCHD9$(),=R9$TO D1$STEP 3 : STR(E1$(K9),9,1)=BIN((2+VAL(D1$,2))/3) : STR(E1$(K9),,8)=E7$ : STR(E1$(K9),10,2)=HEX(0001) : IF Q1=2THEN 1440 : S=(B7-2)/VAL(STR(E1$(K9),43),2) : STR(E1$(K9),46,2)=BIN(S,2) : S=S-VAL(STR(E1$(K9),45)) : STR(E1$(K9),19,2)=BIN(MIN(S*B/A,VAL(STR(E1$(K9),48),2)),2) 1430 IF Q1=1THEN RETURN : STR(E1$(K9),52,2)=STR(E1$(1),52) : STR(E1$(K9),13,2)=STR(E1$(1),13) : RETURN 1440 STR(E1$(K9),12,1)=HEX(00) : STR(E1$(K9),13,2)=STR(E1$(1),13) : D1$=BIN((B7-2)/VAL(STR(E1$(K9),43),2),2) : S=VAL(D1$,2) : STR(E1$(K9),45,5)=HEX(00)&D1$&BIN(S*B/A,2) : STR(E1$(K9),19,2)=STR(E1$(K9),48) : RETURN 1450 MAT REDIM D7$(6)83 : E7$=C8$OR ALL(20) : DATA LOAD DC OPEN T#5,E7$ : DATA LOAD DC #5,D7$() : MAT REDIM D3$(32)8 : D3$()=STR(D7$(),275,128) : SELECT #6<D1$(1)> : E$=D6$OR ALL(20) : LIMITS T#6,E$,A,B,B,B : IF A=0THEN STOP "IDEAS1 CONTROL FILE MISSING" 1460 DATA LOAD BA T#6,(A)D2$() : MAT REDIM D2$(32)8 : D2$()=STR(D2$(),129)&ALL(20) : MAT SEARCHD2$(),=HEX(2020202020202020)TO D2$STEP 8 : A1=-1+(7+VAL(D2$,2))/8 1470 GOSUB 1520 : IF A5=0THEN 1510 : DATA LOAD BA T#2,(A5)D5$() : CONVERT STR(D5$(),41,3)TO N5 : N6=1+INT((N5)/16) : FOR J5=1TO N6 : DATA LOAD BA T#2,(A5+J5)D5$() : MAT SEARCHD5$(),=D6$TO D2$STEP 16 : IF D2$<>HEX(0000)THEN 1500 : NEXT J5 : DATA LOAD BA T#2,(A5+N6)D5$() : STR(D5$(),16*MOD(N5,16)+1,16)=D6$&C8$ : GOSUB 1530 : N5=N5+1+A1 : IF N5>512THEN STOP "IDS2fC00 FULL - CALL WANG" 1490 DATA LOAD BA T#2,(A5)D5$() : CONVERT N5TO STR(D5$(),41,3),(###) : DATA SAVE BA T#2,(A5)D5$() : RETURN 1500 STR(D5$(),VAL(D2$,2)+8,8)=C8$ : DATA SAVE BA T#2,(A5+J5)D5$() : J5=N6 : NEXT J5 : IF A1=0THEN RETURN : FOR J6=1TO A1 : D6$=D2$(J6) : GOSUB 1570 : NEXT J6 : RETURN 1510 DATA SAVE DC OPEN T#2,(34)"IDS2fC00" : GOSUB 1520 : D5$()=" " : FOR J5=0TO 33 : DATA SAVE BA T#2,(A5+J5)D5$() : NEXT J5 : D5$()=HEX(82)&"NUMBER OF PAIRS OF IDEAS1/IDEAS2 FILES "&ALL(20) : CONVERT 0TO STR(D5$(),41,3),(###) : DATA SAVE BA T#2,(A5)D5$() : GOTO 1470 1520 LIMITS T#2,"IDS2fC00",A5,B5,B5,B5 : RETURN 1530 IF A1=0THEN 1550 : A2=MOD(N5,16) : IF A2=15THEN 1540 : FOR J7=1TO MIN(15-A2,A1) : STR(D5$(),16*(A2+J7)+1)=D2$(J7) : STR(D5$(),16*(A2+J7)+9)=D3$(J7) : NEXT J7 : GOSUB 1560 : IF A1<=15-A2THEN RETURN 1540 N6=N6+1 : FOR J7=1TO A1+A2-15 : STR(D5$(),16*J7-15)=D2$(J7+15-A2) : STR(D5$(),16*J7-7)=D3$(J7+15-A2) : NEXT J7 1550 GOSUB 1560 : RETURN 1560 DATA SAVE BA T#2,(A5+N6)D5$() : RETURN 1570 FOR J5=1TO N6 : DATA LOAD BA T#2,(A5+J5)D5$() : MAT SEARCHD5$(),=D6$TO D2$STEP 16 : IF D2$<>HEX(0000)THEN 1580 : NEXT J5 : STOP "PRIMARY FILE IS IN fC00 WITHOUT ITS ALTERNATES" : END 1580 STR(D5$(),VAL(D2$,2)+8,8)=D3$(J6) : DATA SAVE BA T#2,(A5+J5)D5$() : J5=N6 : NEXT J5 : RETURN 2070 DEFFN'0"LIST S HEX(03020400000E) D 1000, 8999";HEX(0D) 2080 DEFFN'16"J9$=";HEX(22);"IDS2PC04";HEX(22);":SCRATCH T J9$:SAVE T () J9$10 00,:LIST S HEX(03020400000E) D 1000,8999";HEX(0D) : ON ERRORE1$,E2$GOTO 3700 3700 DEFFN'31 : E$="IDS2PC04" : IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000, : STOP "ERROR"