image of READY prompt

Wang2200.org

Listing of file='CAT.newo' on disk='vmedia/701-2737G.wvd.zip'

# Sector 110, program filename = 'CAT.newo'
0010 REM CAT.newo - Includes;  CAT.VLIS, CAT.FO/C, CAT.FLIS, CAT.PRIM, CAT.OPE
     N, CAT.RD, CAT.LIST,    DELETE U2$() FROM LINE 4502
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)
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
4582 DEFFN'217(U3,V7(6),U7$,U8$)
   : M=0
   : U1$()=" "
   : R1$=BIN(0)
   : V3$=U8$
   : GOSUB 4788
   : GOSUB 4642
   : IF V7(4)=0THEN R1$=BIN(3)
   : STR(U4$,V3+1,1)="0"
   : $CLOSE#U0
   : $CLOSE#0
   : RETURN
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
4642 M=M+1
   : V1=0
   : IF U7$<>" "THEN 4644
   : U3(1)=U3(4)
   : GOTO 4646
4644 GOSUB 4610
   : IF V7(4)=0THEN 4838
   : U3(1)=V7(4)
4646 U3(2)=0
   : V1=0
   : IF U3=0OR V7(6)=0THEN 4838
4648 IF U3(1)<>0THEN 4650
   : V1=0
   : GOTO 4838
4650 GOSUB 4710
   : V7(6)=V7(6)-V7(9)
   : U3(1)=VAL(STR(V2$(),4,2),2)
   : IF VAL(STR(V2$(),3,1))=0THEN 4652
   : STR(U1$(),,128)=STR(V2$(),129,128)
   : GOTO 4838
4652 IF V7(6)>0THEN 4648
   : V7(6)=V7(6)+V7(9)-1
4654 IF V7(6)>=V7(9)THEN 4656
   : STR(U1$(),1+U3(2)*16,16)=STR(V2$(),6+V7(6)*18,16)
   : HEXUNPACKSTR(V2$(),V7(6)*18+22,2)TO STR(U2$(),1+U3(2)*4,4)
   : U3(2)=U3(2)+1
   : V7(6)=V7(6)+1
   : V1=V1+1
4656 IF V1=U3THEN 4838
   : IF V7(6)<V7(9)THEN 4654
   : IF U3(1)=0THEN 4838
   : GOSUB 4710
   : U3(1)=VAL(STR(V2$(),4,2),2)
   : V7(6)=0
   : GOTO 4654
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
4806 DEFFN'236(U3,V7(6))
   : M=0
   : GOSUB 4756
   : U7$=" "
   : GOSUB 4642
   : GOTO 4836
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