Listing of file='609Escm4' on disk='vmedia/701-2736G.wvd.zip'
# Sector 869, program filename = '609Escm4'
0010 REM ************************ 609Escm4 ********************************
0030 DIM U1$(8),U2$(8)4,I2$2,V4$1
: UNPACK(############)STR(D8$(),191,6)TO F
0060 DEFFNJ(I)=POS(V0$()=" ")-1
: IF J7(1)=99THEN 220
: IF J7(1)<10OR D1$<>HEX(50)THEN 150
: $PACK(F=HEX(A019A0066006A002A001))V1$()FROMA6$(),A7$(),A0(),A8$(),A9$()
: V4$="A"
: GOSUB '221(A1,1,2,1,1)
: IF R1$<>HEX(00)THEN 2545
0150 IF A1=-1THEN 220
: $PACK(F=HEX(A019A005A007A002))U1$()FROMA6$(),A7$(12),HEX(00000000000000),
"10"
: IF A5=0THEN STR(U1$(),108,1)=HEX(FF)
: GOSUB '235(A1,U1$())
: IF R1$<>HEX(00)THEN GOSUB 2270
0220 GOSUB '212(A1)
: IF POS(HEX(0007)=R1$)=0THEN GOSUB 2275
: A1=J6(3)
: C3,C4=J6(2)
: J1$()=D9$()
: V0=J6(4)
: B4$=J8$
: $UNPACK(F=HEX(A019A0066006A002A001))D8$()TO A6$(),A7$(),A0(),A8$(),A9$()
: A0(3)=F
: V4$="P"
: V1$()=J1$()
: GOSUB '221(A1,1,1,1,1)
: IF R1$<>HEX(00)THEN 2540
: R5$=A7$(1)
: V0$()=J3$()
: J1=J6(1)
0430 GOSUB '100(C3,J1$(),V0)
: MAT J0=ZER
: MAT J7=ZER
: D7=0
: STR(B0$,POS(B0$=".")+1)=STR(C0$,5,1)&"."&STR(C0$,1,4)
: GOSUB 2085
: COM CLEAR J2$()
: LOAD DA T(D7$(1))
1050 DEFFN'100(C3,V1$(),A)
: C4$=" "
: IF C3<1THEN C3=8
: IF C3>123OR STR(V1$(),C3*2-1,2)=HEX(FFFF)THEN C3=INT((POS(-STR(V1$(),15,2
32)<FF)-1)/2)+8
: IF STR(V1$(),2*C3-1,2)=HEX(0000)THEN 1080
: C5=VAL(STR(V1$(),2*C3-1),2)
: IF C3=123OR STR(V1$(),2*C3+1,2)=HEX(FFFF)THEN 1070
: GOSUB 1090
: C6=VAL(STR(V1$(),2*C-1,2),2)-VAL(STR(V1$(),2*C3-1,2),2)
: RETURN
1070 C6=A-C5+1
: C4$="E"
: RETURN
1080 C5$="S"
: RETURN
1090 C=C3
1100 C=C+1
: IF STR(V1$(),2*C-1,2)=HEX(0000)THEN 1100
: RETURN
2085 C3$="Loading Editor"
: GOTO 2445
2220 C3$,B2$="Error closing attached glossary"
: RETURN
2225 C3$,B2$="Error closing file"
: RETURN
2230 C3$,B2$="Error closing glossary file"
: RETURN
2235 C3$,B2$="Error closing prototype document"
: RETURN
2265 C3$,B2$="Error writing FCB"
: RETURN
2270 GOSUB 2265
: GOTO 2295
2275 GOSUB 2225
: GOTO 2295
2295 IF R1$>HEX(29)THEN CONVERT VAL(R1$)TO I2$,(##)
: ELSE HEXUNPACKR1$TO I2$
: IF Y5$<>" "AND B2$<>" "THEN B2$=B2$&" - error = "&I2$
: IF Y5$<>" "THEN GOSUB '31
: PRINT AT(23,0,80);HEX(07);B5$(2);C3$;" - error = ";I2$;" - please Cancel"
;B5$(1);
: KEYIN S2$
: RETURN
2405 DEFFN'37(C3$)
: IF C3$=" "THEN 2420
: PRINT HEX(0706);AT(23,40,39);B5$(2);C3$;B5$(1);
2420 I6$=C3$
: RETURN
2430 PRINT AT(23,0,80);HEX(0706);B5$(2);C3$;" - please Cancel";B5$(1);
: RETURN
2435 PRINT HEX(0306);AT(7,30);B5$(3);C3$;" ";C6$;B5$(1)
: RETURN
2440 PRINT HEX(06);AT(23,40,20);B5$(2);C3$;B5$(1);
: RETURN
2445 PRINT HEX(06);AT(0,63,17);B5$(2);C3$;B5$(1);
: RETURN
2450 PRINT HEX(06);AT(23,0,39);B5$(2);C3$;B5$(1);
: RETURN
2510 B2$="Error reading page"
: CONVERT C3TO STR(B2$,LEN(B2$)+2),(###)
: GOTO 2550
2540 B2$="Error rewriting page table"
: GOTO 2550
2545 B2$="Error rewriting admin page"
: GOTO 2550
2550 IF R1$>HEX(29)THEN CONVERT VAL(R1$)TO I2$,(##)
: ELSE HEXUNPACKR1$TO I2$
: B2$=B2$&" - error = "&I2$
: IF Y5$=" "THEN B2$=B2$&" - please Cancel"
: IF Y5$<>" "THEN GOSUB '31
2560 PRINT AT(23,0,80);HEX(0607);B5$(2);B2$;B5$(1);
: KEYIN S2$,,2570
: GOTO 2560
2570 IF POS(HEX(F050)=S2$)>0THEN GOSUB '31
: GOTO 2560
2689 PACK(############)STR(D8$(),191,6)FROMF
3000 DEFFN'31
: A5=0
: A5$()="609CloseJCATSMAL"
: A5$=R3$()
: R3$()=STR(R3$(),10)
: IF A1>-1OR A2>-1THEN LOAD T<2>A5$()
: COM CLEAR C
: LOAD TA5$
4502 DIM V2$(256)1,V5$(160)1,V2$67,V3$16,U3$(10)2,U2$85,U2(6),R1$1,V8$4,V7$2,U
7$68,V6$1,U1$2,V0$8,U0$(128)2,V7(10),U3(9),U5(10)
: DIM R1$1,V5$(160)1,V1$(3)82,V7$(256)1,U0(23),V9$2,V1$2,U0$3,U3$1,U7$(256)
1,U0$(128)2,U4$4,V4$1,V6(9),V9(9),U5(10),V5(7)
4524 DEFFN'211(U7$,U8$,U9$,V6$)
: M=0
: IF V6$=HEX(01)OR V6$=HEX(FF)THEN 4526
: R1$=BIN(6)
: RETURN
4526 V3$=U8$
: GOSUB 4788
: GOSUB 4610
: IF V7(4)>0THEN 4530
4528 R1$=BIN(3)
: GOTO 4542
4530 U3(1)=V7(4)
: GOSUB 4710
: V7(8)=3
: IF VAL(STR(V2$(),3,1))<>1THEN 4528
: IF STR(V2$(),V7(8)+5,6)=U9$OR STR(V2$(),V7(8)+5,6)=" "THEN 4532
: R1$=BIN(5)
: GOTO 4542
4532 IF STR(V2$(),V7(8)+4,1)<>HEX(FF)THEN 4536
4534 R1$=BIN(6)
: GOTO 4542
4536 IF STR(V2$(),V7(8)+4,1)<>HEX(00)THEN 4538
: STR(V2$(),V7(8)+4,1)=V6$
: GOTO 4540
4538 IF V6$=HEX(01)THEN STR(V2$(),V7(8)+4,1)=BIN(VAL(STR(V2$(),V7(8)+4,1))+1)
: ELSE GOTO 4534
4540 STR(V2$(),V7(8)+23,2)=BIN(U9,2)
: GOSUB 4714
: STR(V5$(),V3*32+1,32)=STR(V2$(),4,32)
: V2=VAL(STR(V5$(),V3*32+29,1))
: U1$()=STR(V2$(),129,128)
: GOTO 4544
4542 STR(U4$,V3+1,1)="0"
4544 $CLOSE#U0
: $CLOSE#0
: RETURN
4546 DEFFN'212(V3)
: M=0
: GOSUB 4726
: U3(1)=VAL(STR(V5$(),V7(8)+15,2),2)
: GOSUB 4710
: IF STR(V5$(),V7(8)+4,1)=HEX(FF)THEN STR(V5$(),V7(8)+4,1)=BIN(0)
: ELSE STR(V5$(),V7(8)+4,1)=BIN(VAL(STR(V5$(),V7(8)+4,1))-1)
: STR(V2$(),4,32)=STR(V5$(),V7(8)+1,32)
: GOSUB 4714
: IF U4=V3THEN U4=-1
: STR(U4$,V3+1,1)="0"
: $CLOSE#U0
: $CLOSE#0
: RETURN
4552 DEFFN'235(V3,U1$())
: M=0
: GOSUB 4726
: U3(1)=VAL(STR(V5$(),V7(8)+15,2),2)
: GOSUB 4710
: STR(V2$(),129,128)=STR(U1$(),,128)
: STR(V2$(),3,33)=BIN(1)&STR(V5$(),V7(8)+1,32)
: GOSUB 4714
: GOTO 4836
4610 M=M+1
: GOSUB 4724
: V7(4)=0
: V7(4)=U3(4)
: U3(9)=0
: STR(U7$,LEN(U7$)+1,1)="."
4612 GOSUB 4722
: U3(9)=U3(9)+1
: U2(U3(9)),U3(1)=V7(4)
: GOSUB 4616
: IF U3(2)<>0THEN 4614
: V7(4)=0
: GOTO 4838
4614 V7(4)=VAL(STR(V2$(),U3(2)+16,2),2)
: V7(3)=V7(3)-1
: IF V7(3)=0THEN 4838
: GOTO 4612
4616 M=M+1
: U3(6)=0
4618 GOSUB 4710
: IF V7(9)<>0THEN 4620
: U3(2)=0
: GOTO 4622
4620 MAT SEARCHSTR(V2$(),6,V7(9)*18),=STR(V3$)TO U3$()STEP 18
: U3(2)=VAL(U3$(),2)
: IF U3(2)=0THEN 4622
: U3(2)=U3(2)+5
: GOTO 4838
4622 U3(6)=U3(1)
: U3(1)=VAL(STR(V2$(),4,2),2)
: IF U3(1)<>0THEN 4618
: GOTO 4838
4698 $OPEN #U0
: ERRORGOTO 4830
4700 DATA LOAD DC OPEN T#U0,V0$
: ERRORIF V0$<>"WPSYSTEM"THEN STR(U4$,POS(U4$="0")-1,1)="0"
: GOTO 4830
4702 LIMITS T#U0,U3(1),U3(2),U3(3)
: ERRORGOTO 4830
4704 U9=U3(1)
: U3(3)=1
: GOSUB 4706
: U3(4)=VAL(STR(V2$(),,2),2)
: U3(1)=U3(4)
: RETURN
4706 DATA LOAD BA T#U0,(U3(3)+U9)V2$()
: ERRORGOTO 4830
4708 RETURN
4710 DATA LOAD BA T#U0,(U3(1)+U9)V2$()
: ERRORGOTO 4830
4712 V7(9)=VAL(STR(V2$(),,2),2)
: RETURN
4714 IF U3(1)>0THEN STR(V2$(),255,2)=BIN(4,2)
: DATA SAVE BA T#U0,(U3(1)+U9)V2$()
: ERRORGOTO 4830
4716 RETURN
4718 STR(V2$(),255,2)=BIN(3,2)
: DATA SAVE BA T#U0,(U3(3)+U9)V2$()
: ERRORGOTO 4830
4720 RETURN
4722 V3$=STR(U7$,,(POS(U7$=".")-1))
: U7$=STR(U7$,POS(U7$=".")+1)
: RETURN
4724 MAT SEARCHU7$,="."TO U3$()
: MAT SEARCHU3$(),=HEX(0000)TO U3$()STEP 2
: V7(3)=(1+VAL(U3$(),2))/2
: RETURN
4726 IF V3>=0AND V3<4THEN 4728
: R1$=BIN(8)
: GOTO 4832
4728 V7(8)=V3*32
: R1$=BIN(0)
: IF VAL(STR(V5$(),V7(8)+4,1))>0THEN 4730
: R1$=BIN(7)
: GOTO 4832
4730 U0=15-V3
: U9=VAL(STR(V5$(),V7(8)+23,2),2)
: RETURN
4756 R1$=BIN(0)
: U0=0
: V0$="WPSYSTEM"
: GOTO 4698
4788 M=M+1
: GOSUB 4756
: GOSUB 4616
: IF U3(2)<>0THEN 4790
: R1$=BIN(3)
: GOTO 4834
4790 HEXUNPACKSTR(V2$(),U3(2)+16,2)TO V8$
: V8$=STR(V8$,,3)
: V3=POS(U4$="0")
: IF V3>0THEN 4792
: R1$=BIN(4)
: GOTO 4834
4792 U0=16-V3
: STR(U4$,V3,1)="1"
: V3=V3-1
: V0$=V3$
: SELECT #U0<V8$>
: GOSUB 4698
: $CLOSE#0
: GOTO 4838
4830 R1$=BIN(ERR)
4832 RETURN CLEAR
4834 IF M=0THEN 4836
: M=M-1
: GOTO 4832
4836 $CLOSE#U0
: $CLOSE#0
: RETURN
4838 M=M-1
: RETURN
4932 DEFFN'240(U5(8),V9(2),V6(2),V6(3))
: U0(21)=V9(2)
: V9(1),U5(9)=U5(8)
: IF V9(2)>0THEN 4934
: V6(3)=1
: V6(2)=U5(8)
: RETURN
4934 IF V9(2)<V6(3)THEN 4936
: U0(21)=V9(2)-V6(3)+1
: U5(9)=V6(2)
4936 FOR U=1TO U0(21)
: V9(1)=U5(9)
: GOSUB 4986
: U5(9)=VAL(STR(V7$(),2*MOD(V9(1)-1,V5)+1,2),2)
: IF V9(1)=0THEN 5004
: NEXT U
: R1$=HEX(00)
: V6(3)=V9(2)
: V6(2)=V9(1)
: RETURN
4938 DEFFN'241(V9(1))
: IF V9(1)<1THEN RETURN
: GOSUB 4986
: U5(9)=VAL(STR(V7$(),2*MOD(V9(1)-1,V5)+1,2),2)
: RETURN
4984 GOSUB 4986
: RETURN
4986 V9(5)=U5(1)+INT((V9(1)-1)/V5)
: IF U5(4)=U0AND U5(6)=V5(2)THEN 4988
: U5(4)=U0
: U5(6)=V5(2)
: GOTO 4992
4988 IF V9(5)=V6(4)AND U3$=HEX(FF)AND V5(7)=0THEN RETURN
: V5(7)=0
: IF U5(10)=0THEN 4992
: DATA SAVE BA T#U0,(V6(4)+V5(2))V7$()
: ERRORGOTO 4996
4990 IF U6=1THEN DATA SAVE BA T#U0,(V6(4)+V5(2)+U5(3)*V2)V7$()
: ERRORGOTO 4996
4992 DATA LOAD BA T#U0,(V9(5)+V5(2))V7$()
: ERRORGOTO 4996
4994 V6(4)=V9(5)
: RETURN
4996 RETURN CLEAR
4998 RETURN CLEAR
5000 RETURN CLEAR
: $CLOSE#U0
5002 U0(18)=-1
: R1$=BIN(ERR)
: RETURN
5004 RETURN CLEAR
5006 U0(18)=-1
: $CLOSE#U0
: RETURN CLEAR
: RETURN
5012 DEFFN'220(V3,V6,V9,V8,U5(2))
: U0(19)=0
: GOSUB 5020
: RETURN
5016 DEFFN'221(V3,V6,V9,V8,U5(2))
: GOSUB 5018
: RETURN
5018 DEFFN'228(V3,V6,V9,V8,U5(2))
: U0(19)=1
5020 U7=V9
: V5(5)=0
: V9(6)=LEN(STR(V0$(),V6))
: GOSUB 5132
: GOSUB 5158
: GOSUB '240(U5(8),V9-1,V6(2),V6(3))
: FOR U=1TO V8
: GOSUB '241(U5(9))
: U0$(U)=BIN(V9(1),2)
: IF V9(1)<>0THEN 5022
: R1$=HEX(20)
: GOTO 5006
5022 IF U5(9)=0THEN R1$=HEX(28)
: IF U0(19)=0THEN 5026
: IF U5(2)=2THEN V1$()=STR(V0$(),V9(9)*(U-1)+V6,V9(9))
: DATA SAVE DA T#U0,(V5(2)+1+V2*(V9(1)-1))V1$(),U0$
: ERRORGOTO 5000
5024 GOTO 5030
5026 DATA LOAD DA T#U0,(V5(2)+1+V2*(V9(1)-1))V1$(),U0$
: ERRORGOTO 5000
5028 IF U=1THEN V4$=U0$
: V5(5)=V5(5)+V9(9)
: IF U5(2)<>2THEN 5030
: IF V5(5)>V9(6)THEN STR(V0$(),V9(9)*(U-1)+V6,V9(9))=STR(V1$(),,V9(9)-(V5(5
)-V9(6)))
: ELSE STR(V0$(),V9(9)*(U-1)+V6,V9(9))=V1$()
5030 NEXT U
: U0(11)=U0(23)
: U0(23)=-1
: GOSUB 5148
: GOSUB 5138
: U0(23)=U0(11)
: RETURN
5132 U5(10)=0
: V6(1)=V3*U0(5)
: V5(7)=1
: GOSUB 5140
: STR(U0$,,1)=V4$
: IF V3=U4THEN RETURN
: U4=V3
: IF V3<>4THEN U0=15-V3
5134 U5(8)=VAL(STR(V5$(),V6(1)+11,2),2)
: U5(7)=VAL(STR(V5$(),V6(1)+17,2),2)
: V6(2)=VAL(STR(V5$(),V6(1)+19,2),2)
: V6(3)=VAL(STR(V5$(),V6(1)+21,2),2)
: V2=VAL(STR(V5$(),V6(1)+29,1))
: MAT REDIM V1$(3*V2)82
: U5(1)=VAL(STR(V5$(),V6(1)+27,2),2)
: U8=VAL(STR(V5$(),V6(1)+25,2),2)
5136 V0=VAL(STR(V5$(),V6(1)+2,2),2)
: U0$=V4$&STR(V5$(),V6(1)+31,2)
: U5(3)=VAL(STR(V5$(),V6(1)+13,2),2)
: V9(9)=246*V2
: U6=VAL(STR(V5$(),V6(1)+30,1))
: RETURN
5138 IF U0(2)=-1THEN $CLOSE#U0
: RETURN
5140 V5(2)=VAL(STR(V5$(),V6(1)+23,2),2)-1
: U0(4)=VAL(STR(V5$(),V6(1)+15,2),2)
: U3$=STR(V5$(),V6(1)+4,1)
: IF U3$=HEX(FF)OR U0(18)=1THEN RETURN
: IF V3<>4THEN U0=15-V3
: DATA LOAD BA T#U0,(U0(4)+V5(2)+1)U7$()
: ERRORGOTO 5000
5142 STR(V5$(),V6(1)+1,U0(5))=STR(U7$(),4,U0(5))
: U4=-1
: RETURN
5144 DATA SAVE BA T#U0,(V6(4)+V5(2))V7$()
: ERRORGOTO 4998
5146 IF U6=1THEN DATA SAVE BA T#U0,(V6(4)+V5(2)+U5(3)*V2)V7$()
: ERRORGOTO 4998
5148 STR(V5$(),V6(1)+11,4)=BIN(U5(8),2)&BIN(U5(3),2)
: STR(V5$(),V6(1)+17,6)=BIN(U5(7),2)&BIN(V6(2),2)&BIN(V6(3),2)
: STR(V5$(),V6(1)+2,2)=BIN(V0,2)
: IF U3$=HEX(FF)AND MOD(V9,U0(23))<>0OR U0(23)=-1THEN RETURN
: IF U3$=HEX(FF)THEN DATA LOAD BA T#U0,(U0(4)+V5(2)+1)U7$()
: ERRORGOTO 4998
5152 STR(U7$(),4,U0(5))=STR(V5$(),V6(1)+1,U0(5))
: DATA SAVE BA T#U0,(U0(4)+V5(2)+1)U7$()
: ERRORGOTO 4998
5154 RETURN
5158 IF U7+V8<V0+2AND U7=INT(U7)AND U7>0THEN 5166
: ELSE GOTO 5162
: IF U7+V8<V0+2AND U7=INT(U7)AND U7>0THEN 5168
5162 R1$=HEX(25)
: GOTO 5004
5164 IF V0=0THEN V9=1
5166 IF V3=4THEN 5170
: IF U5(2)=1THEN U0(1)=LEN(STR(V1$()))
: ELSE U0(1)=LEN(STR(V0$()))
: IF V8*V2*246<=U0(1)-V6+1+245-MOD(U0(1)-1,246)AND V6=INT(V6)AND V6>0THEN 5
170
: R1$=HEX(23)
: GOTO 5004
5168 IF V0<>0THEN 5170
: R1$=HEX(24)
: GOTO 5004
5170 IF V9<=V0AND V9=INT(V9)AND V9>0THEN 5174
: IF V9<>V0+1THEN 5172
: R1$=HEX(28)
: GOTO 5176
5172 R1$=HEX(22)
: GOTO 5004
5174 IF V3<5AND V3>=0AND V3=INT(V3)THEN 5176
: R1$=HEX(08)
: GOTO 5004
5176 IF VAL(U3$)>0THEN 5178
: R1$=HEX(07)
: GOTO 5004
5178 IF V8<>INT(V8)OR V8<1THEN 5162
: IF V8<129THEN 5180
: R1$=HEX(29)
: GOTO 5004
5180 R1$=HEX(00)
: IF V3<>4THEN U0=15-V3
: $OPEN #U0
: RETURN