Listing of file='IDS2PP03' on disk='vmedia/701-2717B.wvd.zip'
# Sector 236, program filename = 'IDS2PP03' 1000 REM "IDS2PP03" - Release 2.1 - INT. PROG. GENERATOR-PT.4-CREATE PROGRAM 1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM" : SELECT PRINT 005 : IF STR(R3$(1),6,1)="P"THEN F3$=HEX(1100) : ELSE F3$=HEX(2000) : F8$()=HEX(00) : Z=E3+4 : DATA LOAD BA T#3,(Z-1)E4$() : MAT SEARCHE4$(),="\CC\CF\C1\C4\D3\D5\C2\D3"TO F9$ : M=VAL(F9$,2) : IF M=0THEN 1110 : IF STR(F$(),2249)<>HEX(0000)THEN 1080 : STR(E4$(),M,1)=" " : STR(E4$(),M+1)=STR(E4$(),M+8) : GOTO 1100 1080 IF POS(STR(F$(),2249)=00)>0THEN 1090 : STR(E4$(),M+12,1)="3" : GOTO 1100 1090 CONVERT POS(STR(F$(),2249)>00)TO STR(E4$(),M+12,1),(#) 1100 DATA SAVE BA T#3,(Z-1)E4$() 1110 M=2 : FOR I=E3+4TO E4-1 : DATA LOAD BA T#3,(I)E4$() : F9$=STR(F$(),2249) : IF F9$=HEX(0000)OR F9$=HEX(0101)THEN 1240 1160 MAT SEARCHE4$(),="E6$=F6$(54)"TO F9$ : IF F9$=HEX(0000)THEN 1240 : Q=VAL(F9$,2) : IF POS(STR(F$(),2249)=00)=0THEN 1200 : STR(E4$(),Q-30)=STR(E4$(),Q+75) : GOTO 1210 1200 STR(E4$(),Q-30,10)=HEX(9A)&"'77("&STR(E4$(),Q+12,4)&")" : STR(E4$(),Q-20,19)=STR(E4$(),Q+37,16)&"F5$" : STR(E4$(),Q-1)=STR(E4$(),Q+63) 1210 DATA SAVE BA T#3,(I)E4$() : GOTO 1160 1240 P=5 1250 MAT SEARCHE4$()<P,>,=HEX(0D0000FF)TO F9$ : IF F9$=HEX(0000)THEN 1330 : P=P+VAL(F9$,2)+3 : MAT SEARCHF$()<,N>,=STR(E4$(),P,2)TO F9$STEP 2 : IF F9$>HEX(0000)THEN 1250 : STR(E4$(),P-4,1)=":" : STR(E4$(),P-3)=STR(E4$(),P+2) : GOTO 1250 1330 P=2 1340 MAT SEARCHE4$()<P,>,=HEX(0D00)TO F9$ : IF F9$=HEX(0000)THEN 1470 : Q=P : P=P+VAL(F9$,2)+2 : L=P-Q+1 : IF M+L<257THEN 1440 : STR(F8$(),POS(-F8$()=0D)+3)=HEX(FD)&ALL(00) : DATA SAVE BA T#3,(Z,Z)F8$() : F8$()=HEX(00) : M=2 1440 STR(F8$(),M)=STR(E4$(),Q,L)&HEX(FD)&ALL(00) : M=M+L-1 : GOTO 1340 1470 NEXT I : IF M>2THEN 1510 : Z=Z-1 : DATA LOAD BA T#3,(Z)F8$() 1510 $TRAN(F8$(),HEX(FEFD))R : STR(F8$(),,1)=HEX(20) : DATA SAVE BA T#3,(Z,Z)F8$() : N=0 : C0$=C0$DSC HEX(01) 1570 N=N+1 : IF E3$(N)=" "THEN 1970 : LIMITS T#2,E3$(N),A,B,C,D : IF D<>1THEN 1570 : A=A+1 : Z=Z-1 : F9$=C0$ : DATA LOAD BA T#3,(Z)F8$() : STR(F8$(),,1)=HEX(00) : $TRAN(F8$(),HEX(FDFE))R : M=POS(F8$()=FD) 1680 DATA LOAD BA T#2,(A,A)E4$() : GOSUB 2310 : P=2 1700 L=POS(STR(E4$(),P)=0D)+2 : Q=P : P=P+L 1730 ON POS(HEX(FDFE)=STR(E4$(),Q,1))GOTO 1680,1770 : IF STR(E4$(),Q+3,1)<>HEX(A2)THEN 1810 : IF POS(STR(E4$(),Q+3)=3A)=0OR POS(STR(E4$(),Q+3)=3A)>POS(STR(E4$(),Q+3)=0 D)THEN 1750 : STR(E4$(),Q+3)=STR(E4$(),Q+3+POS(STR(E4$(),Q+3)=3A)) : L=POS(STR(E4$(),Q)=0D)+2 : P=Q+L : GOTO 1730 1750 IF STR(E4$(),Q,1)=HEX(FF)THEN 1700 1760 IF STR(E4$(),,1)=HEX(00)THEN 1680 1770 STR(F8$(),,1)=HEX(20) : STR(F8$(),M)=HEX(FE)&ALL(00) : DATA SAVE BA T#3,(Z,Z)F8$() : GOTO 1570 1810 B=Q+1 : IF STR(E4$(),Q,1)<HEX(FF)THEN 1760 1830 STR(E4$(),B,2)=STR(E4$(),B,2)DAC F9$ : IF STR(E4$(),B,2)>C0$THEN C0$=STR(E4$(),B,2) : B=B+POS(STR(E4$(),B)>FC) : IF B-Q<LTHEN 1830 1870 IF M+L<256THEN 1940 : STR(F8$(),,1)=HEX(00) : STR(F8$(),M)=HEX(FD)&ALL(00) : DATA SAVE BA T#3,(Z,Z)F8$() : F8$()=" " : M=2 : GOTO 1870 1940 STR(F8$(),M)=STR(E4$(),Q,L) : M=M+L : GOTO 1700 1970 E4=Z : IF POS(STR(F$(),2249)=00)>0THEN 2002 : Y=118 : GOSUB 2465 1990 STR(E4$(),POS(E4$()=FE))=HEX(FF3799CE)&"'77(F6$):E6$=F6$"&HEX(8A)&"F6$(54 ):"&HEX(9F)&"E6$="&HEX(D2)&"00)"&HEX(B1)&"F6$(54)=F6$:"&HEX(E8)&"(F6$,36) :F5$="&HEX(22)&"IDS2SUB"&HEX(22)&"&F6$:"&HEX(9F)&"F6$(17)<"&HEX(225E22B1A 5)&"@PART"&HEX(22)&"IDS2SUBM"&HEX(223A9B0D0000FE) : DATA SAVE BA T#3,(Z-1)E4$() 2002 IF STR(D$(),,8)=" "THEN 2010 : Y=225 : GOSUB 2465 : STR(E4$(),POS(E4$()=FE))=HEX(FF7000CE)&"'75(E3$()):E6$,E9$="&HEX(D2303029 3A9B0D0000FE) : DATA SAVE BA T#3,(Z-1)E4$() 2010 IF STR(D$(5),,1)<>"L"THEN 2015 : GOSUB '63("Generating scree","n display code"," ") : LOAD T#2,"IDS2PP31"1000, 2015 GOSUB '63("Copying generate","d program from work file to program file"," ") 2020 F5$=E9$(POS(" P R B"=STR(R3$(1),6,1))) : LIMITS T#4,F5$,A,B,C,D : Y=D : IF Y<>0THEN 2070 : S=E4-E3+1 : SAVE T#4,(S-1)F5$1000,1000 : ERRORGOSUB '35("Not enough room on output disk -- FN '31tocancel") : F6$(11)="N" : GOSUB '34(250) : GOTO 2300 2060 GOTO 2020 2070 IF Y=2THEN SCRATCH T#4,F5$ : A=ABS(A) : B=ABS(B) : IF B-A>=E4-E3THEN 2160 : E7$="JUNK" : X=0 2110 X=X+1 : CONVERT XTO STR(E7$,5),(####) : LIMITS T#4,E7$,A,B,C,D : IF D<>0THEN 2110 : SCRATCH T#4,F5$ : SAVE T#4,(F5$)E7$1000,1000 : SCRATCH T#4,E7$ : GOTO 2020 2160 FOR I=0TO E4-E3-1 : DATA LOAD BA T#3,(E3+I)E4$() 2180 MAT SEARCHE4$(),="F6$(0"TO F9$ : X=VAL(F9$,2) : IF X=0OR I<3THEN 2210 : STR(E4$(),X+3)=STR(E4$(),X+4)&HEX(00) : GOTO 2180 2210 MAT SEARCHE4$(),="F6$="TO F9$ : X=VAL(F9$,2) : IF X=0OR I<3THEN 2250 : IF STR(E4$(),X+4,1)="P"THEN STR(E4$(),X,3)="H=1" : ELSE STR(E4$(),X,3)="H=0" : STR(E4$(),X+3)=STR(E4$(),X+6)&ALL(00) : GOTO 2210 2250 IF E2(1)=1THEN OR (STR(E4$(),,1),10) : DATA SAVE BA T#4,(A+I)E4$() : NEXT I : E4$()=HEX(20)&BIN(E4-E3+1,2)&ALL(00) : DATA SAVE BA T#4,(B)STR(E4$(),1,256) 2300 IF POS("RB"=STR(R3$(1),6,1))>0AND R3$(1)<>"IDS2CRXX"THEN COM CLEAR F1() : ELSE COM CLEAR E3 : LOAD T#2,R3$(1)1000, 2310 DEFFNA(X)=MAX(POS(STR(E4$(),X)<>20),1) : DEFFNE(X)=MAX(POS(STR(E4$(),X)=20),1) : DEFFNC(X)=POS(STR(E4$(),X)=22) : D=0 2330 IF POS(STR(E4$(),D+1)=FF)=0THEN RETURN : D=D+POS(STR(E4$(),D+1)=FF) : STR(E4$(),D+3)=STR(E4$(),D+2+FNA(D+3)) : IF STR(E4$(),D+3,1)=HEX(D8)THEN 2330 : IF STR(E4$(),D+3,1)=HEX(A2)THEN 2460 2380 IF POS(STR(E4$(),D+3)=20)=0OR POS(STR(E4$(),D+FNE(D+3),2)=FF)<>0OR FNE(D+ 3)>POS(STR(E4$(),D+3)=0D)THEN 2330 : IF FNC(D+3)=0OR FNC(D+3)>POS(STR(E4$(),D+3)=0D)THEN 2440 : IF FNE(D+3)<FNC(D+3)THEN 2440 : D=D+2+FNC(D+3) : D=D+FNC(D+1)-2 : GOTO 2380 2440 STR(E4$(),D+2+FNE(D+3))=STR(E4$(),D+1+FNE(D+3)+FNA(D+2+FNE(D+3))) : GOTO 2380 2460 STR(E4$(),D+4)=STR(E4$(),D+3+FNA(D+4)) : GOTO 2330 2465 DATA LOAD BA T#3,(Z-1)E4$() : IF POS(E4$()=FE)<YTHEN RETURN : STR(E4$(),,1)=HEX(00) : $TRAN(E4$(),HEX(FDFE))R : DATA SAVE BA T#3,(Z-1)E4$() : E4$()=HEX(20FE) : E4,Z=Z+1 : RETURN 3699 ON ERRORE1$,E2$GOTO 3700 3700 DEFFN'31 : E$="IDS2PP03" : IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000, : STOP "ERROR"