image of READY prompt

Wang2200.org

Listing of file='IDS2PR19' on disk='vmedia/701-2716B.wvd.zip'

# Sector 258, program filename = 'IDS2PR19'
1000 REM "IDS2PR19" - Release 2.1 - RPT & BATCH PROGRAM GENERATOR - EDITS
1005 E6$=F6$(17)AND HEX(02)
   : IF E6$=HEX(00)THEN LOAD T#2,"IDS2SUB8"3701,3899BEG 1010
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
   : COM E1,C8,D6$8,D7$6
   : DIM C2$19,J7$12
   : GOSUB 2070
1030 E1=MAX(E1,1)
   : IF E1>249THEN 2030
   : D7$,J7$=STR(F$(),E1*9-8,9)&ALL(00)
   : IF D7$=" "OR D7$=HEX(000000000000)THEN 2030
   : FOR I=1TO 12
   : ROTATEC(STR(J7$,I),-2)
   : NEXT I
   : ADD(J7$,20)
   : IF STR(J7$,9)>" "THEN 1100
1050 E2(3),E2(4)=0
   : E1=E1+1
   : GOTO 1030
1100 C2$=STR(C7$,,8)&STR(J7$,,8)&BIN(E2(3)+32)
   : GOSUB '60(E1$(2),C2$)
   : IF STR(E6$(),,16)<>STR(C2$,,16)THEN 1050
   : E2(4)=E2(3)
   : E2(3)=VAL(E6$(17))-31
   : STR(C2$,17)=E6$(17)
   : D7=VAL(E6$(18))-48
1145 E$()="Compiling BASIC program - Processing operation "&HEX(22)&STR(C2$,9,
     8)&HEX(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)
   : ON VAL(F$(2))-47GOTO 1161,1162,1163,1164,1165,1166,1167,1168,1169
1161 STR(E$(),76)=STR(F$(),,250)
   : GOTO 1170
1162 STR(E$(),326)=STR(F$(),23,228)
   : GOTO 1170
1163 STR(E$(),554)=STR(F$(),23,228)
   : GOTO 1170
1164 STR(E$(),782)=STR(F$(),23,228)
   : GOTO 1170
1165 STR(E$(),1010)=STR(F$(),23,228)
   : GOTO 1170
1166 STR(E$(),1238)=STR(F$(),23,228)
   : GOTO 1170
1167 STR(E$(),1466)=STR(F$(),23,192)
   : GOTO 1170
1168 STR(E$(),1658)=STR(F$(),23,192)
   : GOTO 1170
1169 STR(E$(),1850)=STR(F$(),23,192)
1170 IF STR(E6$(),,17)=STR(C2$,,17)THEN 1150
   : GOSUB 2070
   : UNPACK(####)C0$TO Q
   : Q=MAX(Q,2000)
   : PACK(####)C0$FROMQ
   : IF E2(4)>0THEN 1270
   : X=E3+4
   : 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)
   : E2(5)=E4
   : Q=POS(" 0123456789RP"=STR(J7$,9,1))
   : CONVERT QTO F9$,(##)
   : IF Q<10THEN F9$=STR(F9$,2)
   : STR(F$(),2)=HEX(9F)&"J7<>"&F9$
   : IF STR(J7$,10,1)=" "THEN 1342
1340 IF STR(J7$,11,1)="N"THEN E6$="Y"
   : ELSE E6$="N"
   : CONVERT VAL(STR(J7$,10))-47TO F9$,(##)
   : IF VAL(F9$)=48THEN F9$=STR(F9$,2)
   : F$()=F$()&HEX(8B)&"F6$("&F9$&")="&HEX(22)&E6$&HEX(22)
1342 IF E$(79)="N"THEN 1345
   : IF E$(81)="N"THEN E6$="Y"
   : ELSE E6$="N"
   : CONVERT VAL(E$(80))-47TO F9$,(##)
   : IF VAL(F9$)=48THEN F9$=STR(F9$,2)
   : F$()=F$()&HEX(8B)&"F6$("&F9$&")="&HEX(22)&E6$&HEX(22)
1345 F$()=F$()&HEX(B1FFFFFFBA)
   : 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 LOAD T#2,"IDS2PP28"1000,
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 F8$()=HEX(20FE)THEN 2060
   : 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)
   : GOTO 2060
2040 GOTO 2000
2050 STR(F8$(),POS(-F8$()>FC))=HEX(0D0000FF)
2060 STR(F8$(),POS(-F8$()>FC))=HEX(FF)&STR(C0$,,2)&"F=F1:"&HEX(9CFF1990FE)
   : UNPACK(####)C0$TO Q
   : PACK(####)C0$FROMQ+1
   : GOTO 2040
2070 MAT REDIM E3$(249)8
   : E3$()=" "
   : MAT REDIM E2$(C5)83,E3$(C6)83,F$(C7)83
   : DATA LOAD DA T#3,(C4+6)E2$(),E3$(),F$()
   : MAT REDIM E2$(250)9,E3$(249)8,F$(E9)1
   : RETURN
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
   : E$="IDS2PR19"
   : IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
   : STOP "ERROR"