image of READY prompt

Wang2200.org

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"