image of READY prompt

Wang2200.org

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

# Sector 794, program filename = 'IDS2SUB3'
0013 DEFFN0(Q)=VAL(STR(E0$(),Q))
   : DEFFN1(Q)=VAL(STR(E1$(ABS(V)),Q))
   : DEFFN2(Q)=VAL(STR(E1$(ABS(V)),Q),2)
   : DEFFN5(Q)=MOD(FN1(Q),16)
   : DEFFNP(Q)=FN1(24)+1
   : DEFFN6(Q)=VAL(STR(E0$(),Q),2)
   : DEFFN7(Q)=(1+FN0(1)+FN6(6))/INT(1983/E)
0014 DEFFN3(Q)=VAL(STR(E3$(),3))-Q
   : DEFFN4(Q)=VAL(STR(E3$(),4),2)
0015 DEFFNJ(Q)=VAL(F9$,2)+Q
0482 DEFFN'47
   : D=FN5(9)
   : H,L,Y=FN1(24)
   : P=FN1(25)
   : E=FN1(27)
   : B=FN2(43)
   : S=FN2(46)
0489 T=FN1(12)
   : RETURN
0492 U,H=FN2(55)+MOD(N,B)*S
   : W=24
   : E9$=" "
0495 DEFFN'50(H,W,E9$)
   : MAT REDIM E3$(W)83,E0$(3)83
0497 DATA LOAD DA T#D,(H)E3$()
   : RETURN
0500 STR(E0$(),ABS(Q),2)=STR(E0$(),ABS(Q))ADDCBIN(MOD(SGN(Q),65536),2)
0501 N=MOD(N+SGN(Q),B)
   : RETURN
0504 DATA SAVE DA T#D,(U)E0$()
   : RETURN
0508 STR(E0$(),10+E*(H-U)/8,E)=STR(E3$(),C)
   : RETURN
0511 STR(E3$(),Q,E)=E$
   : IF INT(H)=UTHEN STR(E0$(),FN3(0))=STR(E3$(),FN3(0))
   : E$=STR(E0$(),10+E*(H-U)/8)
   : GOSUB 508
   : STR(E0$(),2,1)=BIN(1+FN7(0))
   : IF INT(H)=UTHEN STR(E3$(),,249)=E0$()
   : DATA SAVE DA T#D,(H)E3$()
   : RETURN
0521 DEFFN'78(F5$)
   : E8$=F5$
   : MAT SEARCHE1$(),=STR(F5$,,8)TO F9$STEP 56
   : Q,V=INT(FNJ(55)/56)
   : IF Q>0THEN RETURN
   : RETURN CLEAR
   : O=14
   : GOTO 442
0529 GOSUB 550
   : P=1
   : GOSUB 593
   : IF N>0THEN HEXPACKF$()FROMSTR(F$(),,N+N)
   : STR(F$(),C)=STR(F$(),C+N)
   : IF A=0THEN RETURN
   : ADD(STR(F$(),C,A+B),E0)
   : FOR P=CTO C+B-ASTEP A
   : ROTATE(STR(F$(),W,A),2)
   : GOSUB 545
   : NEXT P
   : STR(F$(),C+B)=STR(F$(),C+B+A)
   : RETURN
0545 GOSUB 547
   : AND (STR(F$(),W,A),3F)
0547 XOR (STR(F$(),P,A),STR(F$(),W,A))
   : RETURN
0550 UNPACK(####)STR(E1$(FN2(10)),15)TO N,A
   : L=FN2(13)-N-N
   : B=3*A
   : C=N+1
   : W=C+B
   : RETURN
0556 DEFFN'66(V,P)
   : ON TGOSUB 626
   : ELSE GOSUB 550
   : IF P>0THEN STR(F$(),C)=STR(E3$(),P)
   : IF N>0THEN HEXUNPACKSTR(F$(),C,N)TO F$()
   : P=65
   : GOSUB 593
   : ON TGOTO 581
   : IF A=0THEN 592
   : P,C=W+N
   : MAT COPY -F$()<C,L-A-B>TO -F$()<C+A,L-A-B>
   : STR(F$(),C,A)=ALL(00)
   : FOR W=C-BTO C-ASTEP A
   : GOSUB 545
   : ROTATE(STR(F$(),C,A),2)
   : NEXT W
   : ADD(STR(F$(),C-B,A+B),20)
   : GOTO 592
0581 L=FN1(21)+1-N
   : IF A=0THEN 591
   : FOR C=B+1TO B+A
   : ROTATEC(STR(F$(),C,L+N-C),-2)
   : NEXT C
0591 E4$()=F$()
   : GOSUB 617
   : F$()=E4$()
   : IF A>0THEN ADD(STR(F$(),B+1,A),20)
0592 P=33
0593 $TRAN(F$()<,N+N>,@F$<P,>)R
   : RETURN
0596 DEFFN'69(V)
   : W=1
   : FOR C=28TO 40STEP 3
   : IF FN2(C)>0THEN STR(E4$(),W)=STR(F$(),MOD(FN2(C),32768))
   : W=W+FN1(C+2)
   : NEXT C
0603 DEFFN'51(E4$())
   : GOSUB 626
   : $TRAN(E4$()<,B>,@F$)R
   : IF A>0THEN ADD(STR(E4$(),B+1,A),E0)
   : GOSUB 617
   : IF N>0THEN HEXPACKE4$()FROMSTR(E4$(),,B)
   : STR(E4$(),N+1)=STR(E4$(),N+N+1)
   : IF A<4THEN RETURN
   : L=W-N
   : FOR C=N+ATO N+1STEP -1
   : ROTATEC(STR(E4$(),C,L-C),2)
   : NEXT C
   : RETURN
0617 W=1
   : FOR C=28TO 40STEP 3
   : IF FN1(C)>127THEN XOR (STR(E4$(),W,FN1(C+2)),FF)
   : W=W+FN1(C+2)
   : NEXT C
   : IF N+A>0THEN AND (STR(E4$(),,B+A),3F)
   : IF N>0THEN OR (STR(E4$(),,B),30)
   : RETURN
0626 N=FN1(22)
   : A=FN1(23)+MOD(N,2)
   : N=INT(N/2)
   : B=N+N
   : A=A-MOD(A,4)
   : C=N+1
   : RETURN
0635 E$=E4$()
   : GOTO 640
0636 X=3
0637 E$=F1$(V)
0640 DEFFN'59(V,J,E$,X)
   : Q=6
   : GOSUB 482
   : IF T=7THEN H=L+P
   : E7$=STR(E$,,H)ADDCSTR(E$,,H)AND ALL(77)
0645 UNPACK(####.####)E7$TO N,O
   : N,O=INT(MOD(N*O-N+O,1)*B)
0647 DEFFN'52
   : $OPEN #D
0649 GOSUB 492
   : IF X>0AND X<6AND ABS(T-3.5)<>1.5THEN Y=L+P
   : E0$()=E3$()
   : Q=10
   : GOSUB 667
   : H,G=U+8*MIN(FN0(1),INT(FNJ(0)/E))
   : IF ABS(X-1.5)<1AND ABS(T-2.5)<1THEN STR(E$,L+1),F3$=STR(E0$(),E*FN0(2)+10
     -P,P)
   : IF H>UTHEN GOSUB 497
   : Q=FN3(0)
   : GOSUB 667
0655 DEFFN'73
   : IF FNJ(FN3(11))/E+(FN0(1)-VAL(E3$()))*INT(1983/E)-FN0(1)<=FN6(6)THEN Q=1
   : ON XGOTO 670
   : IF X=6THEN RETURN
   : IF FNJ(0)>0AND STR(E3$(),FNJ(FN3(1)),Y)=STR(E$,,Y)AND Q=1THEN 698
   : IF FN6(8)=0THEN 665
   : Q=1
   : GOSUB 501
   : IF N<>OTHEN 649
0665 ON XGOTO ,669
   : O=15
   : GOTO 442
0667 MAT SEARCHE3$()<Q>,>=STR(E$,,Y)TO F9$STEP E
   : RETURN
0669 X=1
   : IF N<>OTHEN 645
0670 IF FN2(48)>FN6(6)THEN 682
   : Q=8
   : GOSUB 500
   : GOSUB 504
   : IF N<>OTHEN 649
   : N=N-1
   : GOSUB 723
   : O=17
   : GOTO 442
0682 Q=6
   : GOSUB 500
   : FOR H=GTO U+8*FN0(2)-8STEP 8
   : IF H<>GTHEN GOSUB 497
   : C=FN4(0)
   : GOSUB 508
0687 IF INT(H)>GTHEN Q=FN3(0)
   : ELSE Q=FNJ(FN3(1))
   : IF X=3THEN RETURN
   : MAT COPY -E3$()<Q,C-Q>TO -E3$()<Q+E,C-Q>
   : GOSUB 511
   : NEXT H
0692 IF H>UTHEN GOSUB 504
0693 MAT REDIM E0$(249)1
   : E0$()=HEX(01)
   : $CLOSE#D
   : RETURN
0698 IF X=2THEN O=16
   : F3$=" "
   : IF P>0THEN F3$=STR(E3$(),FNJ(L+FN3(1)),P)
   : ON X+1GOTO 728,,442
   : E$=ALL(FF)
   : IF T=2OR T=3THEN STR(E$,L+1)=F3$
   : IF T=4THEN STR(E$,L+1)=STR(E4$(),L+1)
   : Q=-6
   : GOSUB 500
   : FOR H=U+8*INT(FN7(0))TO GSTEP -7.99
   : IF H>GTHEN GOSUB 497
   : GOSUB 687
   : C=Q
   : GOSUB 508
   : Q=FN4(0)
   : IF C<QTHEN STR(E3$(),C,Q-C)=STR(E3$(),C+E)
   : C=Q
   : GOSUB 511
   : NEXT H
   : GOSUB 692
0719 IF MOD(N+1,B)=OTHEN RETURN
   : $OPEN #D
   : GOSUB 492
   : E0$()=E3$()
0723 Q=-8
   : GOSUB 500
   : GOSUB 504
   : GOTO 719
0728 Q=1
   : C=FNJ(FN3(1))
   : IF T=4THEN C=C+L
0732 DEFFN'67(V,F3$,X)
   : GOSUB 482
   : ON TGOTO 693,,,755
   : IF X>0THEN RETURN
   : V=FN2(10)
   : IF X>=0THEN X=5
   : C=0
   : IF P=3THEN C=VAL(STR(F3$,3))
   : V=V+INT(C/32)
   : Q=FN5(9)
   : IF D<>QTHEN $CLOSE#D
   : D=Q
   : $OPEN #D
   : C=MOD(C,32)*65536+VAL(F3$,2)
   : Q=FN1(45)
   : R=FN2(19)
   : U=FN2(55)+INT(C/R)*FN2(46)+Q
   : C=MOD(C,R)
   : R=FN1(51)
   : B=FN1(50)
   : U=U+B*INT(C/R)
   : IF X>0THEN GOSUB '50(U,3*B," ")
0753 E=INT(249*B/R)
   : C=MOD(C,R)*E+1
   : IF X<0THEN 693
0755 Q=VAL(STR(E3$(),C))
   : IF Q<255AND Q<>R0THEN Q=-Q
   : IF Q<0OR J<=0THEN 760
   : STR(E3$(),C,1)=BIN(R0)
   : GOSUB 766
0760 C=C+1
   : IF Q>0OR J<=0THEN 693
   : E8$=" "
   : $PACK(F=HEX(1003))E8$FROM-Q
   : GOSUB '38(18,E8$)
   : H=0
   : GOTO 693
0766 GOSUB 767
   : DATA SAVE DA T#D,(U)E3$()
   : RETURN
0767 IF U<=FN2(55)+FN2(43)*FN2(46)THEN RETURN
   : GOSUB '38(56," ")
   : $CLOSE
   : END
0768 FOR M=KTO LEN(STR(E1$()))/56
   : IF VER(E1$(M),"@SORT##@")<8AND VAL(STR(E1$(M),10),2)=KTHEN V=M
   : NEXT M
   : M=V
   : RETURN