Listing of file='IDS2PP06' on disk='vmedia/701-2717B.wvd.zip'
# Sector 130, program filename = 'IDS2PP06'
1000 REM "IDS2PP06" - Release 2.1 - INTERACTIVE PROGRAM GENERATOR - EDITS
1005 E6$=F6$(17)AND HEX(02)
: IF E6$=HEX(00)THEN LOAD DA T#2,(D$(1))3701,3899BEG 1010
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: COM E1,C8,C2$19
: IF E0$<>C7$THEN GOSUB '33(E9$(2))
1030 E1=MAX(E1,1)
: IF E1>F0THEN 2000
: GOSUB 2070
: IF MOD(VAL(STR(E2$(E1),6)),16)>7OR VER(E3$(E1),"@FLD###@")=8THEN 1100
1050 E2(3),E2(4)=0
: E1=E1+1
: GOTO 1030
1100 IF STR(E6$(),,16)=STR(C2$,,16)AND C2$<>" "THEN 1125
: GOSUB 2070
: C2$=STR(C7$,,8)&STR(E3$(E1),,8)&BIN(E2(3)+32)
: IF VER(E3$(E1),"@FLD###@")=8THEN STR(C2$,,8)="@SYSSCR@"
: GOTO 1110
1105 E2(3)=VAL(STR(E6$(),17))-32
: GOTO 1125
1110 GOSUB '60(E1$(2),C2$)
: IF STR(E6$(),,16)<>STR(C2$,,16)THEN 2030
1125 IF VAL(E6$(17))>63AND E2(3)>0AND E2(3)<33THEN 2030
1130 E2(4)=E2(3)
: E2(3)=VAL(E6$(17))-31
: STR(C2$,17)=E6$(17)
: D7=VAL(E6$(18))-48
: E$()="Compiling BASIC program - Processing field "&HEX(22)&STR(C2$,9,8)&H
EX(22)&" edit "&HEX(002000)
: CONVERT E2(3)TO STR(E$(),POS(E$()=00),2),(##)
: STR(E$(),76)=STR(E6$(),18,1)&"0"&STR(E6$(),17,1)&"N "&STR(E6$(),,16)
1150 GOSUB '62(E1$(2),1,0)
: I=VAL(F$(2))-47
: ON IGOTO 1161,,,,,,1169,1169,1169
: STR(E$(),I*228-130)=STR(F$(),23,228)
: GOTO 1170
1161 STR(E$(),76)=STR(F$(),,250)
: GOTO 1170
1169 STR(E$(),I*192+122)=STR(F$(),23,192)
1170 IF STR(E6$(),,17)=STR(C2$,,17)THEN 1150
: GOSUB 2070
: UNPACK(####)C0$TO Q
: Q=MAX(Q,1100)
: PACK(####)C0$FROMQ
: IF E2(3)<33AND E2(4)>0THEN 1270
: IF E2(3)>33AND E2(4)>32THEN 1270
: IF E2(3)<33THEN X=E6
: ELSE X=C4
: X=X+INT((E1-1)/60)
: DATA LOAD BA T#3,(X)E4$()
: STR(E4$(),POS(E4$()=9C)+(MOD(E1-1,60)+1)*4-2,2)=C0$
: DATA SAVE BA T#3,(X)E4$()
1270 DATA LOAD BA T#3,(E4-1)E4$()
: STR(E4$(),,1)=HEX(00)
: $TRAN(E4$(),HEX(FDFE))R
: DATA SAVE BA T#3,(E4-1)E4$()
: F$()=HEX(1B)
: IF E$(79)="N"THEN E2(5)=0
: ELSE E2(5)=E4
: IF E2(5)=0THEN 1350
1340 IF E$(81)="N"THEN E6$="Y"
: ELSE E6$="N"
: CONVERT VAL(E$(80))-47TO F9$,(##)
: IF VAL(F9$)=48THEN F9$=STR(F9$,2)
: STR(F$(),2)=HEX(9F)&"F6$("&F9$&")="&HEX(22)&E6$&HEX(22B1FFFFFFBA)
1350 IF D7=0OR D7=3THEN 1380
: IF E2(5)=0THEN E$="H=1"
: ELSE E$="H=1"
: STR(F$(),LEN(F$())+1)=E$&HEX(BA)
1380 GOTO 3020
1500 STOP #
: STOP #
2000 IF LEN(F8$())<3THEN 2010
: F8$(1)=HEX(20)
: STR(F8$(),POS(F8$()=FE))=HEX(0D0000FE)
: DATA SAVE BA T#3,(E4,E4)F8$()
: GOTO 2020
2010 DATA LOAD BA T#3,(E4-1)F8$()
: F8$(1)=HEX(20)
: $TRAN(F8$(),HEX(FEFD))R
: DATA SAVE BA T#3,(E4-1)F8$()
2020 LOAD T#2,"IDS2PP04"1000,
2030 IF E2(3)=0THEN 2040
: IF POS(F8$()=FE)<244THEN 2050
: F8$(1)=HEX(00)
: STR(F8$(),POS(F8$()=FE))=HEX(0D0000FD)
: DATA SAVE BA T#3,(E4,E4)F8$()
: F8$()=HEX(20FF)&STR(C0$,,2)&HEX(9CFF)
: GOTO 2060
2040 IF STR(E6$(),,16)<>STR(C2$,,16)THEN 1050
: GOTO 1130
2050 STR(F8$(),POS(-F8$()>FC))=HEX(0D0000FF)&STR(C0$,,2)&HEX(9CFF)
2060 IF E2(3)<33THEN F9$=HEX(1038)
: ELSE F9$=HEX(1032)
: STR(F8$(),LEN(F8$())+1)=F9$&HEX(FE)
: UNPACK(####)C0$TO Q
: PACK(####)C0$FROMQ+1
: GOTO 2040
2070 MAT REDIM E3$(24)83
: E3$()=" "
: MAT REDIM E3$(ABS(INT(-F0*8/249))*3)83
: DATA LOAD DA T#J0,(J7)E3$()
: MAT REDIM E3$(249)8
: RETURN
3010 E2(6),E2(7),E2(8)=0
: FOR I=554TO 1436STEP 18
: IF POS("PFB"=E$(I))>0THEN E2(6)=E2(6)+1
: NEXT I
: ON D7GOTO 3040,3050,3060,3070,3080,3090,3100
3020 E2(6),E2(7),E2(8)=0
: MAT REDIM E0$(2)51
: E0$()=ALL(FF)
: MAT SEARCHE$()<554,883>,>" "TO E0$()STEP 18
: E2(6)=POS(-E0$()=00)/2-1
: MAT REDIM E0$(249)1
: E0$()=HEX(01)
: ON D7GOTO 3040,3050,3060,3070,3080,3090,3100
: E$="No-op (perform Pass/Fail actions only)"
: I=29
: E8$=" "
: GOTO 3110
3040 E$="Set field(s) = field(s) and/or constant(s)"
: I=26
: E8$="SET FIELD"
: GOTO 3110
3050 E$="Read a record from a data file"
: I=27
: E8$="READ RECORD"
: GOTO 3110
3060 E$="Perform logical test(s)"
: I=9
: E8$="LOGICAL TEST"
: GOTO 3110
3070 E$="Math calculation(s)"
: I=7
: E8$="MATH CALCS"
: GOTO 3110
3080 E$="Range check(s)"
: I=11
: E8$="RANGE TEST"
: GOTO 3110
3090 E$="Table look-up (or look-up & replace)"
: E8$="TABLE TEST"
: I=12
: GOTO 3110
3100 E$=STR(E$(),106,64)
: E8$="USER EXIT"
: I=10
3110 IF E2(2)=0THEN 3160
: IF LEN(F$())>1THEN F$(LEN(F$()))=HEX(BA)
: STR(F$(),LEN(F$())+1)=HEX(A2)&E$&HEX(BA)
3160 PRINT AT(23,0);STR(E$(),,POS(E$()=00));" ";E8$;
: LOAD DA T#2,(D$(I))1000,
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PP06"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"