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