image of READY prompt

Wang2200.org

Listing of file='IDS2PF14' on disk='vmedia/701-2715B.wvd.zip'

# Sector 181, program filename = 'IDS2PF14'
1000 REM "IDS2PF14" - DATA FILE EDITOR - FILE INITIALIZATION MODULE
1015 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
   : DIM C(8),C1(8),D(8),J(8)
   : IF E$="Y"THEN D9=1
   : ELSE D9=0
   : MAT REDIM E3$(9)83,E0$(31)8
   : E0$()=E3$()
   : IF F6$(53)="Y"AND STR(F4$,4,8)<>"IDS2PCST"THEN 1023
   : DIM J$8
   : J$="IDS2fsXX"
   : A=(R0-#PART)/16+1
   : IF A>0THEN CONVERT ATO STR(J$,7,2),(##)
   : DATA LOAD DC OPEN T#2,J$
1022 DATA LOAD DC #2,E3$()
   : E$=STR(E3$(),#PART*45-17,45)
   : GOTO 1100
1023 LIMITS T#4,STR(F4$,4,8),A,J,J,J
   : DATA LOAD BA T#4,(A+2)STR(E3$(),,256)
   : E$=STR(E3$(),92,45)
   : GOTO 1100
1100 FOR F9=1TO 31
   : IF E0$(F9)=" "THEN 3130
   : ELSE F1$=E0$(F9)OR ALL(20)
   : SELECT PRINT 405
   : IF D9=1THEN PRINT HEX(060F);AT(22,9);BOX(1,60);" Now initializing file
             Processing is    % complete";
   : IF D9=1THEN PRINT HEX(06020402000E);AT(22,32,8);E0$(F9);AT(22,56);
   : D1=-1
   : GOSUB '39(F1$,5)
   : IF Q=2THEN 1170
1162 F0$="Control file "&F1$&" does not exist"
   : GOSUB '35(E$)
   : GOTO 3130
1170 MAT REDIM E3$(6)83
   : DATA LOAD DA T#P,(A)E3$()
   : MAT J=ZER
   : MAT D=ZER
   : C1=VAL(STR(E3$(),403))
   : C2=VAL(STR(E3$(),404))
   : C3=VAL(STR(E3$(),416))
   : C4=VAL(STR(E3$(),417))
   : C5=VAL(STR(E3$(),418))
   : C6=VAL(STR(E3$(),419))
   : C7=VAL(STR(E3$(),440),2)
   : C8=VAL(STR(E3$(),435),2)
   : D3=100/C7/C8
   : C9=VAL(STR(E3$(),437))/8
   : J1=VAL(STR(E3$(),442))
   : J2=VAL(STR(E3$(),443))
1206 STR(E3$(),251,3)=STR(E3$(),105)
   : FOR I=1TO C2
   : MAT SEARCHE$,=STR(E3$(),I*3+248,3)TO J$STEP 3
   : D(I)=INT((VAL(J$,2)+2)/3)
   : LIMITS T#D(I),E0$(F9),C(I),B,C,D
   : IF C(I)>0AND C<=B-C(I)+1THEN 1216
1215 GOSUB '35("File has not been allocated -- please cancel")
   : F6$(11)="N"
   : GOSUB '34(250)
   : IF Q<>31THEN 1215
   : GOTO 3130
1216 DATA LOAD BA T#D(I),(B)STR(E4$(),,256)
   : STR(E4$(),10,11)="Release 2.1"
   : DATA SAVE BA T#D(I),(B)STR(E4$(),,256)
   : C=C-2
   : IF I=1THEN J4=C/VAL(STR(E3$(),435),2)
   : IF I=1THEN C=C-C9*8*C8
   : J(I)=MIN(C/C8/J1*J2,C7)
   : IF I>1THEN J(I)=MIN(J(I)+J(I-1),C7)
   : NEXT I
   : MAT REDIM E2$(E9)1
   : IF C1=1OR C1>4THEN 1300
   : UNPACK(####)STR(E3$(),405,6)TO A,B,C
   : J3=A+1-B-C
1236 E2$()=HEX(FF)
   : IF B+C>0THEN STR(E2$(),2,B+3*C)=ALL(00)
   : IF C1=4THEN 1300
   : STR(E2$(),1+INT(249*J1/J2))=STR(E2$(),1)
   : MAT REDIM E2$(J1*3)83
1300 N=0
   : MAT C1=C
   : MAT REDIM E3$(24)83
   : E4$()=ALL(FF)
   : FOR I=0TO C8-1
   : C1(1)=C(1)+I*J4+C9*8
   : R=0
   : B=0
   : V=1
   : E3$()=BIN(C9-1)&HEX(01)&BIN(10+C9*C6)&BIN(C6*MIN(C7-1+C9,INT(1983/C6)-1)+
     10,2)&HEX(00000000)&ALL(FF)
   : IF C1<2OR C1>3THEN 1500
   : FOR K=1TO C9
   : Y=0
   : X=MIN(C7-1,K*INT(1983/C6)-C9-1)
1371 Y=Y+1
   : IF X>=J(Y)THEN 1371
   : IF Y>1THEN X=X+2097152*(Y-1)-J(Y-1)
   : X=X+I*J(Y)
   : IF Y>1THEN X=X-I*J(Y-1)
   : F3$=BIN(MOD(X,65536),2)&BIN(INT(X/65536))
   : ON C2GOTO 1425
   : FOR L=2TO C2
   : IF X>=J(L-1)AND X<J(L)THEN STR(F3$,3,1)=STR(F3$,3,1)OR BIN((L-1)*32)
   : NEXT L
1425 IF C1=2OR C1=3THEN STR(E4$(),C3+1)=F3$
   : IF C1=4THEN STR(E4$(),C3+1)=E2$()
   : STR(E3$(),10+(K-1)*C6,C6)=E4$()
   : NEXT K
1500 P=VAL(STR(E3$(),3))
2000 R=R+1
   : ON C1GOTO 2065,,,2060
   : IF C1>4THEN 2065
   : IF R>J(V)THEN V=V+1
   : X=N+I*(J(V)-J(C2))
   : IF V>1THEN X=X-(I+1)*J(V-1)
   : F3$=BIN(MOD(X,65536),2)&BIN((V-1)*32+INT(X/65536))
   : STR(E4$(),C3+1)=F3$
2060 STR(E3$(),P,C6)=E4$()
2065 P=P+C6
   : N=N+1
   : IF C1=1OR C1>3THEN 3000
   : IF R3$(1)="IDS2PU89"THEN 3000
   : IF R=C7OR MOD(R,J2)=0THEN DATA SAVE DA T#D(V),(C1(V),C1(V))E2$()
3000 D2=ROUND((N*D3,0)
   : IF D1=D2OR D9=0THEN 3010
   : D1=D2
   : PRINTUSING 3120,D1,HEX(08080808);
3010 IF P+C6<=1993AND R<C7THEN 2000
   : DATA SAVE DA T#D(1),(C(1)+I*J4+B)E3$()
   : B=B+8
   : IF R=C7THEN 3110
   : E3$()=BIN(C9-(B+8)/8)&HEX(000A)&BIN(10+C6*(MIN(INT(1983/C6),C7-R)-1),2)&H
     EX(00000000)&ALL(FF)
   : P=10
   : GOTO 2000
3110 NEXT I,F9
3120 %###%####
3130 MAT REDIM E2$(250)9,E3$(249)8,E0$(249)1
   : SELECT PRINT 005
   : P=4
   : IF STR(R3$(1),,4)="IDS2"THEN P=2
   : LOAD T#P,R3$(1)1000,
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
   : E$="IDS2PF14"
   : IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
   : STOP "ERROR"