image of READY prompt

Wang2200.org

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"