image of READY prompt

Wang2200.org

Listing of file='IDS2PP22' on disk='vmedia/701-2724B.wvd.zip'

# Sector 669, program filename = 'IDS2PP22'
1000 REM "IDS2PP22" - INTERACTIVE PROGRAM GENERATOR - P/F SPECS W&X FIELD SPEC
     S
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
   : DIM D8$20
   : F5$=F1$
   : GOSUB 3050
   : IF C9=23THEN 1051
   : IF C9=24THEN E4$()=E4$()&HEX(9A)&"'43("&E8$&HEX(29BA9A)&"'54(E$)"&HEX(BA)
   : E8$="Q"
1051 F5$=STR(F2$,5)
   : IF STR(F2$,,4)<>"ROW="AND STR(F2$,,4)<>"COL="THEN 1052
   : CONVERT STR(F2$,5)TO Q
   : CONVERT Q-1TO F5$,(##)
1052 IF STR(F5$,,1)>"0"OR LEN(F5$)=1THEN 1055
   : F5$=STR(F5$,2)
   : GOTO 1052
1055 IF F5$=" "THEN F5$="0"
   : IF STR(F2$,4,1)="="THEN E0$()="Set"
   : IF STR(F2$,4,1)="+"THEN E0$()="Increment"
   : IF STR(F2$,4,1)="-"THEN E0$()="Decrement"
   : MAT SEARCH"ROWCOLPOSDSPKBD",=STR(F2$,,3)TO F9$STEP 3
   : IF F9$>HEX(0001)THEN 1080
   : C4$=HEX(D3)&"E2$("&E8$&"),4,1)"
   : Q=8
   : E0$()=E0$()&" row"
1071 IF STR(F2$,4,1)="="THEN D8$=HEX(8AD2303729E8DE)
   : IF STR(F2$,4,1)="+"THEN D8$=HEX(E8DE)
   : IF STR(F2$,4,1)="-"THEN D8$=HEX(EFDE)
   : D8$=D8$&F5$&"*8"
1080 IF F9$<>HEX(0004)THEN 1090
   : C4$=HEX(D3)&"E2$("&E8$&"),5,1)"
   : Q=2
   : IF STR(F2$,4,1)="="THEN D8$=HEX(8AD2303129E8DE)
   : IF STR(F2$,4,1)="+"THEN D8$=HEX(E8DE)
   : IF STR(F2$,4,1)="-"THEN D8$=HEX(EFDE)
   : D8$=D8$&F5$&"*2"
   : E0$()=E0$()&" column"
1090 IF F9$<>HEX(0007)THEN 1100
   : C4$=HEX(D3)&"E2$("&E8$&"),2,2)"
   : Q=16
   : IF STR(F2$,4,1)="="THEN D8$=HEX(8AD23030304629E8DE)
   : IF STR(F2$,4,1)="+"THEN D8$=HEX(E843DE)
   : IF STR(F2$,4,1)="-"THEN D8$=HEX(EF43DE)
   : D8$=D8$&F5$&"*16,2"
   : E0$()=E0$()&" position"
1100 IF F9$<>HEX(000A)THEN 1110
   : IF STR(F2$,5)="NRML"THEN E6$="4"
   : IF STR(F2$,5)="BRGT"THEN E6$="8"
   : IF STR(F2$,5)="BLNK"THEN E6$="C"
   : C4$=HEX(D3)&"E2$("&E8$&"),7,1)"
   : Q=32
   : D8$=HEX(8AD23346)
   : IF STR(F2$,5)<>"NONE"THEN D8$=D8$&HEX(29E8D2)&E6$&"0"
   : E0$()=E0$()&" display mode to"
1105 IF STR(F2$,5)="NONE"THEN E0$()=E0$()&" none"
   : IF STR(F2$,5)="NRML"THEN E0$()=E0$()&" normal"
   : IF STR(F2$,5)="BRGT"THEN E0$()=E0$()&" bright"
   : IF STR(F2$,5)="BLNK"THEN E0$()=E0$()&" blinking"
1110 IF F9$<>HEX(000D)THEN 1120
   : C4$=HEX(D3)&"E2$("&E8$&"),5,1)"
   : Q=0
   : IF STR(F2$,5)="OFF"THEN E4$()=E4$()&HEX(8A28)&C4$&",FE)"
   : ELSE E4$()=E4$()&HEX(8B28)&C4$&",01)"
   : E4$()=E4$()&HEX(BA)
   : OR (F2$,20)
   : E0$()=E0$()&" keyboard availability switch "&STR(F2$,5)
   : GOTO 2000
1120 E4$()=E4$()&C4$&"="&C4$&D8$&HEX(29BA)
2000 IF C9=23THEN E0$()=E0$()&" for"
   : ELSE E0$()=E0$()&" the field named in"
   : E0$()=E0$()&" field "&HEX(22)&F1$&HEX(22)
   : IF E2(2)>0THEN E4$()=E4$()&HEX(A2)&E0$()&HEX(BA)
   : IF STR(E4$(),LEN(E4$()))=HEX(BA)THEN STR(E4$(),LEN(E4$()))=HEX(1B)
3010 IF POS(E4$()=BA)>0THEN E$=F0$
   : IF E$<>" "THEN STR(F$(),LEN(F$())+1)=E$
   : IF E4$()<>" "THEN STR(F$(),LEN(F$())+1)=STR(E4$(),POS(E4$()>20))
   : LOAD DA T#2,(D$(13))1000,
3020 STOP #
   : PRINT HEX(06020402000E);AT(23,16);"Compiling BASIC program - Now processi
     ng sector";E4-E3+1;
   : RETURN
3040 STOP "END IT"
3050 Q=250
   : IF F5$=" "THEN 3070
   : MAT SEARCHE3$(),=STR(F5$,,8)TO F9$STEP 8
   : IF F9$>HEX(0000)THEN Q=INT((VAL(F9$,2)+7)/8)
   : IF Q<250THEN 3070
   : IF VER(F5$,"@TSTFLD#")=8THEN Q=VAL(STR(F5$,8))+203
   : IF F5$="@SYSBUF0"THEN Q=269
   : F5$=STR(C8$,(VAL(STR(F5$,8))-48)*8+1)
   : GOTO 3050
3070 DEFFN'71(Q)
   : E8$=" "
   : $PACK(F=HEX(1006))E8$FROMQ
   : E8$=STR(E8$,POS(E8$>20))
   : RETURN
3080 IF STR(F5$,,2)="IF"THEN F9$=HEX(8A)
   : IF STR(F5$,,2)="OR"THEN F9$=HEX(8B)
   : IF LEN(E$)>1THEN E$=E$&F9$
   : $TRAN(F9$,HEX(8A8B8B8A))R
   : IF LEN(F0$)>1THEN F0$=F0$&F9$
   : RETURN
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
   : E$="IDS2PP22"
   : IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
   : STOP "ERROR"