image of READY prompt

Wang2200.org

Listing of file='IDS2PRX4' on disk='vmedia/701-2725B.wvd.zip'

# Sector 81, program filename = 'IDS2PRX4'
1000 REM "IDS2PRX4"
1030 DIM D1$3
   : D1$="X"
   : IF C2=0THEN PRINT HEX(03)
   : F6=0
   : IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
   : E4=E4+1
   : J8=1
   : J9=99
   : IF E0>0THEN GOSUB '55(E0,E4)
   : GOSUB '76("HP")
   : GOSUB '76("HR")
   : FOR I=9TO 0STEP -1
   : D$="H"&BIN(I+48)
   : IF STR(C1$,I+2,1)="Y"THEN GOSUB 1620
   : NEXT I
1130 IF STR(C2$,,1)="Y"THEN GOSUB '76("D")
   : F6$(33)="N"
   : J8,J9=1
   : MAT REDIM E3$(24)83
1170 DATA LOAD DA T#D0,(STR(D$(),C6))E3$()
   : B=VAL(STR(D$(),C6+2),2)
   : IF B+C6<1993THEN 1190
   : IF VAL(STR(E3$(),1992))=0THEN 1188
   : STR(D$(),C6,4)=BIN(VAL(STR(D$(),C6),2)+8,2)&HEX(0001)
   : GOTO 1170
1188 E4$()=ALL(FF)
   : GOTO 1200
1190 E4$()=STR(E3$(),B,C6-1)&STR(D$(),C6,2)&BIN(B+C6-1,2)
1200 D$()=STR(D$(),C7+1)&ALL(FF)
   : MAT SEARCHD$(),>=STR(E4$(),,C7)TO F9$STEP C7
   : Q=VAL(F9$,2)
   : MAT COPY -D$()<Q,C9-Q>TO -D$()<Q+C7,C9-Q>
   : STR(D$(),Q,C7)=E4$()
   : MAT REDIM F$(E9)1
   : E$=ALL(FF)
   : IF STR(D$(),,C6-1)<STR(E$,,C6-1)THEN 1320
   : F6$(2)="N"
   : J8=12
   : GOTO 1540
1320 E$=STR(D$(),C4)
   : J=SGN(D5)
   : T=VAL(STR(E1$(C8),12))
   : IF D6=2THEN GOSUB '67(C8,E$,0)
   : ELSE GOSUB '59(C8,J,E$,0)
   : IF Q>0AND D5>0THEN F6$(18)="Y"
   : ELSE F6$(18)="N"
   : X=5
   : GOSUB '79
   : STR(E$(),,E0(2))=STR(F$(),,E0(2))
1520 GOSUB 1600
   : J9=J8
   : IF J8=1AND STR(C$,,1)<HEX(FF)THEN 1985
   : ON J8GOTO 1130
1540 J7=J7+1
   : IF J7>J8THEN 1570
   : IF STR(C$,J7,1)<HEX(FF)THEN 1985
1550 D$="F"&BIN(J7+46)
   : $TRAN(D$,"R:")R
   : IF STR(C2$,J7,1)>" "THEN GOSUB 1620
   : D1$=" "
   : IF STR(C2$,J7,1)="T"THEN GOSUB 1850
   : GOTO 1540
1570 IF F6$(2)="N"THEN 1585
   : J7=1
   : IF STR(C1$,,1)<HEX(FF)THEN 1985
1575 FOR I=J8TO 2STEP -1
   : D$="H"&BIN(I+46)
   : IF STR(C1$,I,1)>" "THEN GOSUB 1620
   : NEXT I
   : J7=1
   : GOTO 1130
1585 IF STR(C2$,13)>" "THEN GOSUB '76("FP")
   : IF C2=0THEN GOSUB 1962
1590 COM CLEAR F()
   : $CLOSE#1
   : SELECT #1<STR(F4$,,3)>
   : HEXPACKE8$(7)FROMSTR(F4$,2,2)
   : MAT REDIM E4$(16)16
   : GOSUB '40(R3$(1))
   : GOSUB 1600
   : GOTO 1130
1600 DEFFN'71
   : FOR I=1TO F0
   : CONVERT STR(E$(),VAL(STR(E2$(I),2),2)/16,VAL(E2$(I)))TO F(I)
   : ERRORF(I)=0
1605 NEXT I
   : RETURN
1620 DEFFN'76(D$)
   : IF D$="HP"THEN F6$(33)="Y"
   : IF D$="FP"THEN 1980
1625 F0$=ALL(0A)
   : Z=0
1635 MAT REDIM F$(128)2,E4$(128)2
   : MAT SEARCHC1$(),=D$TO F$()STEP 9
   : Z=Z+1
   : IF F$(Z)=HEX(0000)THEN 1945
   : X=INT(VAL(F$(Z),2)/9)+1
   : E$=C1$(X)
   : IF STR(E$,3,1)>" "AND STR(E$,4,1)<>F6$(VAL(STR(E$,3))-47)THEN 1635
   : A=1
   : IF C2=1THEN UNPACK(##)STR(E$,6)TO A
   : B=INT(A/10)
   : IF B=0THEN 1665
   : E0$()=BIN(B+1)&STR(F0$,,B)
   : E8$(6)=HEX(00)
   : GOSUB 1950
   : E$=C1$(X)
   : E8$(6)=" "
1665 IF STR(E$,7,1)=HEX(FF)THEN E0$()=" "&STR(E2$(),VAL(STR(E$,8),2),F5)
   : IF STR(E$,7,1)=HEX(FF)THEN 1690
   : DATA LOAD BA T#F4,(VAL(STR(E$,8),2))E4$()
   : E0$()=" "&STR(E4$(),VAL(STR(E$,7)),F5)
   : AND (E0$(),7F)
1690 A=1
   : IF C2=1THEN UNPACK(##)STR(E$,6)TO A
   : B=INT(A/10)
   : A=MOD(A,10)
   : STR(E0$(),,1)=BIN(LEN(E0$()))
   : IF F6+B+1+A>F2AND C2=1AND F2>0THEN A=MAX(0,F2-F6-B-1)
   : E6$=BIN(X)
   : MAT SEARCHE2$()<8,F3>,=STR(E$,5,1)TO E4$()STEP 9
   : Y=0
1730 Y=Y+1
   : IF E4$(Y)=HEX(0000)THEN 1820
   : Q=(VAL(E4$(Y),2)+8)/9
   : C=VAL(STR(E2$(Q),5))
   : L=VAL(E2$(Q))
   : R=VAL(STR(E2$(Q),9))
   : G=INT(VAL(STR(E2$(Q),7))/8)
   : IF G<=J9THEN 1790
   : STR(E0$(),C+1,R)=" "
   : GOTO 1730
1790 IF Q>F0THEN STR(E0$(),C+1,R)=STR(E$(),VAL(STR(E2$(Q),2),2)/16,R)
   : IF MOD(VAL(STR(E2$(Q),7)),2)=1THEN STR(E$(),VAL(STR(E2$(Q),2),2)/16,L)="
     "
   : IF Q>F0THEN 1730
   : E$=HEX(0000)&STR(E0$(),C+1,R)
   : PRINTUSING TO E$,STR(E$,3),F(Q)
   : STR(E0$(),C+1,R)=STR(E$,3)
   : IF MOD(VAL(STR(E2$(Q),7)),2)=1THEN F(Q)=0
   : GOTO 1730
1818 IF VAL(E6$)=31AND F6$(11)="Y"THEN 1590
   : GOTO 1835
1820 IF C2=0THEN E0$(1)=BIN(MIN(81,VAL(E0$())))
   : GOSUB 1950
   : IF A=0THEN 1821
   : E8$(6)=HEX(00)
   : E0$()=BIN(A+1)&STR(F0$,,A)
   : GOSUB 1950
1821 E8$(6)=" "
   : F6=F6+B+A+C2
   : F7=F7+1
   : IF F7=21AND C2=0THEN GOSUB 1962
   : KEYIN E6$,1835,1818
1835 IF D$="FP"OR F6+B<F2OR F2=0THEN 1635
   : D1$=STR(D$,,2)&BIN(Z)
1850 D$="FP"
   : J6=1
   : IF STR(C2$,13,1)="Y"THEN 1620
1865 IF C2=0THEN 1890
   : IF F6>=F2AND F2<>66THEN 1885
1870 F6=F6+1
   : E0$()=HEX(020A)
   : E8$(6)=HEX(00)
   : GOSUB 1950
   : E8$(6)=" "
   : IF F2<>66THEN 1865
   : IF F6<66THEN 1870
   : ELSE GOTO 1890
1885 IF C2<>1OR F2=66THEN 1890
   : E0$()=HEX(020C)
   : E8$(6)=HEX(00)
   : GOSUB 1950
   : E8$(6)=" "
1890 F6=0
   : E4=E4+1
   : IF E0>0THEN GOSUB '55(E0,E4)
   : J6=2
   : D$="HP"
   : IF STR(C1$,13,1)="Y"THEN 1620
1915 J6=0
   : IF D1$=" "THEN 1945
   : D$=D1$
   : Z=VAL(STR(D1$,3))
   : J9=99
   : GOTO 1635
1945 MAT REDIM F$(E9)1
   : ON J6GOTO 1865,1915
   : RETURN
1950 E6$=" "
   : GOSUB '49(0)
   : IF E8$(5)=HEX(1F)OR E6$=HEX(1F)THEN 1590
   : RETURN
1960 DEFFN'68
   : F(F)=A
   : RETURN
1962 PRINT AT(23,0);"Touch EXECUTE to continue"
   : KEYIN E6$
   : IF E6$=HEX(0D)OR E6$=HEX(82)THEN 1970
   : IF E6$=HEX(1F)AND F6$(11)="Y"THEN 1590
   : PRINT HEX(07);
   : GOTO 1962
1970 PRINT HEX(03)
   : F7=0
   : RETURN
1975 J7=J5
   : GOTO 1625
1980 J5=J7
   : J7=13
1985 F=0
1990 F=F+1
   : IF F<=F1THEN 1994
   : IF J7=13THEN 1975
   : ON J8GOTO 1130
   : ON J7GOTO 1575
   : GOTO 1550
   : GOTO 1990
   : GOTO 1520
1993 %
1994 %
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
   : E$="IDS2PRX4"
   : IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
   : STOP "ERROR"