Listing of file='IDS2PU06' on disk='vmedia/701-2715B.wvd.zip'
# Sector 579, program filename = 'IDS2PU06'
1000 REM "IDS2PU06" - Convert IDEAS2 to TC file - module 2 - 09/22/81
1010 E6$=F6$(17)AND HEX(02)
: IF E6$=HEX(00)THEN LOAD T#2,"IDS2SUB8"3701,3899BEG 1020
1020 MAT REDIM E2$(4)62
: IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: GOSUB 1510
: GOSUB '61(C1$,C9$(1),0)
: IF Q=0THEN 1250
: IF F$()<>" "THEN GOSUB 1040
1030 GOSUB '62(C1$,1,0)
: IF Q=0THEN 1170
: IF J4>J5THEN 1160
: IF J4=J5AND C4>240THEN 1160
: IF F$()<>" "THEN GOSUB 1040
: IF STR(E6$(),,VAL(STR(E1$(V),24)))>C9$(2)THEN 1170
: GOTO 1030
1040 D3=D3+1
: PRINT HEX(06);AT(23,20);D3;
: GOSUB 1270
: IF D8=0THEN RETURN
: D6=D6+1
: IF C1=1THEN 1080
: FOR J1=0TO J6-1
: STR(E2$(),3+J2*(C1(4)+1),1)=BIN(C1(4))
: STR(E2$(),4+J2*(C1(4)+1),C1(4))=STR(F$(),J1*C1(4)+1,MIN(C1(4),C4,LEN(STR(
F$()))-J1*C1(4)))
: J2=J2+1
: IF J2=INT(246/(C1(4)+1))THEN GOSUB 1070
: NEXT J1
: RETURN
1070 STR(E2$(),1,1)=HEX(00)
: STR(E2$(),2,1)=BIN(3+(INT(246/(C1(4)+1)))*(C1(4)+1))
: DATA SAVE DA T#6,(D4,D4)E2$()
: J2=0
: E2$()=" "
: J4=J4+1
: IF J4=J5AND J1<>J6-1THEN 1160
: RETURN
1080 J8=1
: J7=J9
: IF 81-J7>=C4THEN J3=C4
: ELSE J3=81-J7
1090 J2=J2+1
: ON J2GOTO 1100,1110,1120
1100 STR(E2$(),3,1)=HEX(50)
: STR(E2$(),3+J7,J3)=STR(F$(),J8,J3)
: D2=D2+J3
: IF 3+J7+J3-1=83THEN 1140
: J2=0
: GOTO 1140
1110 STR(E2$(),84,1)=HEX(50)
: STR(E2$(),84+J7,J3)=STR(F$(),J8,J3)
: D2=D2+J3
: IF 84+J7+J3-1=164THEN 1140
: J2=1
: GOTO 1140
1120 STR(E2$(),165,1)=HEX(50)
: STR(E2$(),165+J7,J3)=STR(F$(),J8,J3)
: D2=D2+J3
: IF 165+J7+J3-1=245THEN 1130
: J2=2
: GOTO 1140
1130 STR(E2$(),2,1)=HEX(F6)
: STR(E2$(),1,1)=HEX(00)
: DATA SAVE DA T#6,(D4,D4)E2$()
: J2=0
: E2$()=" "
: D2=0
: J4=J4+1
1140 J7=1
: J8=J8+J3
: D1=C4-J8+1
: IF D1<=0THEN 1150
: IF D1>=80THEN J3=80
: ELSE J3=D1
: GOTO 1090
1150 J9=MOD(J9+C4-1,80)+1
: RETURN
1160 PRINT HEX(07);AT(23,0,);"Insufficient room in TC file. Program aborted. K
ey RETURN to continue."
: KEYIN E6$
: MAT REDIM E2$(256)1
: E2$()=ALL(00)
: STR(E2$(),1,1)=HEX(A0)
: STR(E2$(),3,1)=HEX(01)
: DATA SAVE BA T#6,(D5)E2$()
: GOTO 1250
1170 IF C1=1THEN 1200
: IF J2<>0THEN 1180
: DATA LOAD DA T#6,(D4-1,D4)E2$()
: STR(E2$(),1,1)=HEX(F0)
: DATA SAVE DA T#6,(D4-1,D4)E2$()
: GOTO 1190
1180 STR(E2$(),1,1)=HEX(F0)
: STR(E2$(),2,1)=BIN(3+J2*(C1(4)+1))
: DATA SAVE DA T#6,(D4,D4)E2$()
1190 DATA SAVE DA T#6,(D4,D4)END
: MAT REDIM E2$(256)1
: E2$()=ALL(00)
: STR(E2$(),1,1)=HEX(A0)
: STR(E2$(),2,2)=BIN(D4-D7+1,2)
: DATA SAVE BA T#6,(D5)E2$()
: GOTO 1250
1200 D4=INT((C4*D6-1)/240)+D7
: IF D2<=80THEN 1210
: IF D2<=160THEN 1220
: IF D2=0THEN 1240
: STR(E2$(),165,1)=BIN(D2-160)
: STR(E2$(),2,1)=BIN(6+D2)
: GOTO 1230
1210 STR(E2$(),3,1)=BIN(D2)
: STR(E2$(),2,1)=BIN(D2+4)
: GOTO 1230
1220 STR(E2$(),84,1)=BIN(D2-80)
: STR(E2$(),2,1)=BIN(5+D2)
1230 STR(E2$(),1,1)=HEX(F0)
: DATA SAVE DA T#6,(D4,D4)E2$()
: GOTO 1190
1240 DATA LOAD DA T#6,(D4,D4)E2$()
: STR(E2$(),1,1)=HEX(F0)
: DATA SAVE DA T#6,(D4-1,D4)E2$()
: GOTO 1190
1250 COM CLEAR C1
: MAT REDIM E2$(250)9
: IF C5$<>" "THEN SELECT #6<C5$>
: E9$(1)=C1$
: IF F6$(21)="C"AND F6$(20)<>"X"THEN 1260
: R3$()=STR(R3$(),10)
: P=2
: IF F6$(53)="Y"AND STR(R3$(),,4)<>"IDS2"THEN P=4
: LOAD T#P,R3$(1)1000,
1260 F6$(20),F6$(21)=" "
: STR(R3$(),,9)=STR(R3$(),10)
: COM CLEAR E1$()
: H=2
: E=21
: G=500
: E$="IDS2P001IDS2P004"
: IF F6$(17)<>HEX(60)THEN LOAD T#2,<2>E$1000,
: COM CLEAR E()
: LOAD T#2,"IDEAS2"
1270 IF C(1,1)=0THEN 1320
: IF C(2,1)=0THEN 1310
: IF C(3,1)=0THEN 1300
: GOSUB '71(C1(1),C(1,1),C(1,2),C1$(1))
: C6=D9
: IF C6$<>"OR"AND C7$<>"OR"AND D9=0THEN 1330
: GOSUB '71(C1(2),C(2,1),C(2,2),C1$(2))
: C5=D9
: IF C6$<>"OR"AND C7$<>"OR"AND D9=0THEN 1330
: GOSUB '71(C1(3),C(3,1),C(3,2),C1$(3))
: IF C6$<>"OR"AND C7$<>"OR"THEN ON D9+1GOTO 1330,1320
1290 IF C6$="OR"AND C7$="OR"THEN ON C6+C5+D9+1GOTO 1330,1320,1320,1320
: IF C6$<>"OR"THEN ON C6*C5+D9+1GOTO 1330,1320,1320
: ON (C6+C5)*D9+1GOTO 1330,1320,1320
1300 GOSUB '71(C1(1),C(1,1),C(1,2),C1$(1))
: C6=D9
: IF C6$<>"OR"AND D9=0THEN 1330
: GOSUB '71(C1(2),C(2,1),C(2,2),C1$(2))
: IF C6$<>"OR"THEN ON D9+1GOTO 1330,1320
: ON D9+C6+1GOTO 1330,1320,1320
1310 GOSUB '71(C1(1),C(1,1),C(1,2),C1$(1))
: ON D9+1GOTO 1330,1320
1320 D8=1
: RETURN
1330 D8=0
: RETURN
1350 DEFFN'71(C7,C8,C9,E$)
: D9=0
: CONVERT STR(F$(),C8,C9)TO J1
: ERRORGOTO 1380
1360 CONVERT E$TO J3
: ERRORGOTO 1380
1370 ON C7GOTO 1450,1460,1470,1480,1490,1500
1380 ON C7GOTO 1390,1400,1410,1420,1430,1440
1390 IF STR(F$(),C8,C9)=E$THEN D9=1
: RETURN
1400 IF STR(F$(),C8,C9)<E$THEN D9=1
: RETURN
1410 IF STR(F$(),C8,C9)>E$THEN D9=1
: RETURN
1420 IF STR(F$(),C8,C9)<=E$THEN D9=1
: RETURN
1430 IF STR(F$(),C8,C9)>=E$THEN D9=1
: RETURN
1440 IF STR(F$(),C8,C9)<>E$THEN D9=1
: RETURN
1450 IF J1=J3THEN D9=1
: RETURN
1460 IF J1<J3THEN D9=1
: RETURN
1470 IF J1>J3THEN D9=1
: RETURN
1480 IF J1<=J3THEN D9=1
: RETURN
1490 IF J1>=J3THEN D9=1
: RETURN
1500 IF J1<>J3THEN D9=1
: RETURN
1510 SELECT #6<C3$>
: ON C3+3GOTO 1520,1520,1530,1540
: DATA LOAD DC OPEN T#6,C2$
: GOTO 1550
1520 DATA SAVE DC OPEN T#6,(C2$)C2$
: GOTO 1550
1530 DATA SAVE DC OPEN T#6,(C2+2)C2$
: GOTO 1550
1540 SCRATCH T#6,C2$
: GOTO 1520
1550 LIMITS T#6,C2$,D4,D5,J2
: D7=D4
: J5=D5-D4-1
: D2,J2,D3,D6=0
: F$(),E2$()=" "
: J9,J4=1
: IF C1=1THEN C1(4)=80
: J6=1+INT((C4-1)/C1(4))
: PRINT HEX(0F);AT(23,0,);"Processing record # of ";C5;HEX(0E);
: F6$(14)="N"
: RETURN
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PU06"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"