Listing of file='609menu' on disk='vmedia/701-2739G.wvd.zip'
# Sector 33, program filename = '609menu'
0010 REM 609menu 2.6 WP 07/12/90 - KKB
0110 COM C
0120 DIM C1$8,C2$30,C3$30,C4$8,C5$30,C6$25,C7$25,C8$40,C9$25,D1$75,D2$30,D3$30
,D4$65,D6$1,D7$5,J3$8,J4$2,J5$3
0130 DIM S0(1),S1(4),S2(1),S3(1),S4(1),S5(1),S6(4),S7(1),T1(4),T2(1),T5(1)
0140 DIM S1$(15)2,S1$1,S2$(8)2,T1$(15)80,T2$(4)80,J1$80,J1$(15)80,S2$1,J6$30,J
0$(15)30,T5$(1)6,T1$80,T2$2,J9$8
0145 PRINT HEX(0202000E);
0500 J9=0
0510 GOSUB 2000
: PRINT HEX(0306)
0512 STR(T1$,,8)=$PSTAT(#PART)
0514 IF A4$=" "AND R3$()=" "THEN A4$="609MENU"
: IF A4$=" "AND R3$()<>" "THEN A4$=$PSTAT(#PART)
0520 IF STR(T1$,,8)<>" "THEN 540
0530 LOAD TC1$9000,9999BEG 550
: ERRORPRINT HEX(03070E);C2$;HEX(0F)
: END
0540 LOAD T#J9,STR(T1$,,8)9000,9999BEG 550
: ERRORGOTO 530
0550 GOSUB 2010
: S1$="O"
: S4,S7,T5(1),S6(2)=1
: S3(1),S6,J9=0
: S0(1)=28
: S5(1)=9
: S5,T1(1),T1(2),T1(3),T1(4)=4
: S1(2)=24
: T2$(1),J1$(),J0$()=" "
: T2$(3)=C3$
: S6(3)=5
0560 IF A9$="D"THEN T2$(4)=STR(R2$,3,2)&"/"&STR(R2$,,2)&"/"&STR(R2$,5,2)
: ELSE T2$(4)=STR(R2$,,2)&"/"&STR(R2$,3,2)&"/"&STR(R2$,5,2)
: S6(4)=5
: S1(4)=71
0570 RESTORE
: READ J9$,T2$(1),S0,C0
: IF C0=0THEN 580
: GOSUB 650
: IF C0=1THEN 580
: GOSUB 660
: IF C0=2THEN 580
: FOR J1=3TO C0
: GOSUB 670
: NEXT J1
0580 READ J1$,T1$,J6$
: IF J1$="no more"THEN 600
: IF STR(J6$,,1)="P"OR STR(J6$,,1)="M"THEN GOSUB 590
: GOTO 580
0590 S3(1)=S3(1)+1
: J1$(S3(1))=J1$
: T1$(S3(1))=T1$
: J0$(S3(1))=J6$
: RETURN
0600 PRINT AT(22,0,80)
: IF B4$<>" "THEN PRINT HEX(0E);AT(22,64,);C9$;HEX(0F);
: GOSUB '62
: ON T5+3GOTO 680,780,770,,770
: IF T5<>1THEN 600
: GOSUB 640
: IF D7$<>" "THEN GOSUB 720
: IF J4$<>" "THEN GOSUB 740
: IF D6$="P"THEN 610
: IF D6$="M"THEN 630
: GOSUB '32(C5$)
: GOTO 600
0610 A5$=C4$
: $PSTAT=J9$
: LOAD T#J9,<J0>A5$()
: ERRORT6=ERR
: IF T6<>82THEN 620
: GOSUB '32(C6$)
: GOTO 600
0620 GOSUB '32(C5$)
: GOTO 600
0630 $PSTAT=A5$(1)
: GOTO 510
0640 A5$()=" "
: $UNPACK(D=HEX(012C))J1$(T5(1))TO A5$()
: J0=INT((LEN(A5$())-1)/8)+1
: D6$,D7$,J3$,J4$,J5$=" "
: $UNPACK(D=HEX(012C))J0$(T5(1))TO D6$,D7$,J3$,J4$,J5$
: RETURN
0650 READ J1$
: $PSTAT=STR(J1$,,8)
: RETURN
0660 READ T2$(2)
: J2=LEN(T2$(2))
: S1(2)=40-J2/2
: RETURN
0670 READ J1$
: RETURN
0680 IF B4$<>" "THEN PRINT HEX(070E);AT(22,64,);C9$;HEX(0F);
: S4=0
: S1$="T"
: S5=2
: T1(2)=4
: S6(2)=22
: S1(2)=0
: T2$(1),T5$(1)=" "
: T2$(2)=C7$
: S6=1
: T2(1)=5
: S7(1)=22
: S2(1)=23
: S4(1)=6
0690 GOSUB '62
: ON T5+2GOTO 550,550
: B4$=T5$(1)
: IF B4$=" "THEN PRINT AT(22,64,15);
: FOR J1=1TO LEN(B4$)
: IF VER(STR(B4$,J1,1),"N")=0AND B4$<>" "THEN 700
: GOTO 710
0700 J1=LEN(B4$)
: NEXT J1
: B4$=" "
: GOSUB '32(C8$)
: GOTO 690
0710 NEXT J1
: PRINT AT(22,0,30)
: GOTO 550
0720 CONVERT D7$TO T6
: ERRORGOSUB '32(D1$)
: RETURN
0730 IF T6<=SPACEKTHEN RETURN
: PRINT HEX(070E);AT(23,0,);D2$;T6;D3$;HEX(0F);
: RETURN CLEAR
: GOTO 600
0740 CONVERT J4$TO J9
: ERRORGOSUB '32(D4$)
: GOTO 600
0750 SELECT #J9<J5$>
: ERRORGOSUB '32(D4$)
: GOTO 600
0760 RETURN
0770 IF J9$<>A4$THEN 510
: GOTO 600
0780 IF J9$<>A4$THEN 510
: LOAD T"609EXIT"
: ERRORLOAD T"START"
: ERRORGOTO 600
0800 DEFFN'32(T1$)
: PRINT HEX(070E);AT(23,0,);T1$;HEX(0F);
: RETURN
0810 ON ERRORSTR(T1$,,3),STR(T1$,4,4)GOTO 820
0820 IF STR(T1$,,3)<>"P34"AND STR(T1$,,3)<>"S17"THEN 830
: GOSUB '32(D4$)
: GOTO 600
0830 PRINT HEX(070E);AT(23,0,);"Error ";STR(T1$,,3);" at line ";STR(T1$,4,4);H
EX(0F);
: GOTO 600
2000 C1$="609MENU"
: C2$="Master menu not available"
: RETURN
2010 C3$="Please select next activity"
: C4$="609menu"
: C5$="Program cannot be loaded"
: C6$="Program not available"
: C7$="Please enter password"
: C8$="Enter only letters or numbers "
: C9$="Password active"
2020 D1$="Improper SPACEK value in data statement. May cause error A01"
: D2$="Insufficient memory. A "
: D3$="K partition is required."
: D4$="Program cannot be loaded from address given in data statements"
: D5$="Which command?"
: RETURN
3010 DEFFN'62
: S1$(),S2$()=ALL(00)
: PRINT HEX(06);
: $TRAN(T5$(),HEX(8520))R
3020 IF S5=0THEN 3040
: IF T2$(1)=" "THEN 3030
: PRINT HEX(020402000E);AT(0,40-LEN(T2$(1))/2);T2$(1);
: T1$=ALL(CC)
: IF S6(1)=1THEN PRINT AT(1,0);HEX(0202020F);STR(T1$,,80);
: PRINT HEX(0F0202000F);
3030 IF S5=1THEN 3040
: FOR T6=2TO S5
: PRINT AT(S6(T6),S1(T6));STR(T2$(T6),,LEN(T2$(T6)));
: IF T1(T6)=3THEN PRINT AT(S6(T6)+1,S1(T6));BOX(0,LEN(T2$(T6)))
: NEXT T6
3040 IF S4=0THEN 3060
: S7=0
: FOR T6=1TO S4
: T4=0
: T3=ABS(S5(T6))
: S0=S0(T6)
: S9=S2
: IF S5(T6)>0THEN S9=1
: T0=INT(S3(T6)/S9)
: T1=1
: FOR T7=1TO S9
: IF T7>MOD(S3(T6),S9)THEN T1=0
: T2=S0+S3*(T7-1)
3050 FOR S8=1TO T0+T1
: S7=S7+1
: T4=T4+1
: S1$(S7)=BIN(T3+S8-1)&BIN(T2)
: PRINT AT(T3+S8-1,T2);
: IF T5(T6)=T4THEN PRINT HEX(0202020F0ECC200202000F);
: ELSE PRINT HEX(2E20);
: PRINT STR(T1$(S7),,LEN(T1$(S7)));HEX(0F);
: NEXT S8
: NEXT T7
: NEXT T6
3060 IF S6=0THEN 3070
: T0=0
: T1$=ALL(85)
: FOR T6=1TO S6
: T3=S7(T6)
: S0=S2(T6)
: PRINT HEX(020402000E);AT(T3,S0);
: IF T2(T6)=2THEN PRINT STR(T5$(T6),,S4(T6));
: ELSE PRINT STR(T1$,,S4(T6))
: PRINT HEX(0F);
: FOR T7=1TO S4(T6)
: T0=T0+1
: S2$(T0)=BIN(T3)&BIN(S0+T7-1)
: NEXT T7
: NEXT T6
3070 T0,T2=1
: S2$=S1$
: IF S2$="O"THEN 3080
: T3=S7(1)
: S0=S2(1)
: GOTO 3090
3080 T3=VAL(S1$(T5(1)))
: S0=VAL(STR(S1$(T5(1)),2))
3090 PRINT AT(T3,S0);HEX(0E050F);
: KEYIN S2$,,3340
: PRINT HEX(06);AT(23,0,80);
: ON POS(HEX(820D)=S2$)GOTO 3180,3130
: GOSUB 3470
: ON S7GOTO 3210,3300,,,3300
3100 GOSUB 3600
3110 PRINT AT(23,40);HEX(020402000E07);T1$;
: GOTO 3090
3120 GOSUB 3610
: GOTO 3110
3130 GOSUB 3470
: IF S7=0THEN 3100
: IF S7<>1OR S2$<>HEX(0D)THEN 3140
: T5(T0)=S9
: GOSUB 3290
3140 GOSUB 3540
: GOTO 3090
3160 T5=-1
: RETURN
3170 T5=0
: RETURN
3180 T5=1
: $TRAN(T5$(),HEX(2085))R
: RETURN
3190 T5=2
: RETURN
3200 T5=3
: RETURN
3210 ON POS(HEX(2008)=S2$)GOTO 3260,3270
: T2$=S2$AND HEX(DF)
3220 T6=0
: IF S9=S3(T0)THEN 3240
: FOR T7=1TO S3(T0)-S9
: S2$=STR(T1$(T1+T7),,1)AND HEX(DF)
: IF T2$<>S2$THEN 3230
: T6=S9+T7
: T1=T1+T7
: T7=S3(T0)
3230 NEXT T7
: IF T6>0THEN 3280
3240 IF S9=1THEN 3090
: T1=T1-S9
: FOR T7=1TO S9-1
: S2$=STR(T1$(T1+T7),,1)AND HEX(DF)
: IF T2$<>S2$THEN 3250
: T6=T7
: T1=T1+T7
: T7=S9-1
3250 NEXT T7
: IF T6=0THEN 3090
: GOTO 3280
3260 T6=S9+1
: T1=T1+1
: IF T6<=S3(T0)THEN 3280
: T6=1
: T1=T1-S3(T0)
: GOTO 3280
3270 T6=S9-1
: T1=T1-1
: IF T6>=1THEN 3280
: T6=S3(T0)
: T1=T1+S3(T0)
3280 T5(T0)=T6
: T3=VAL(S1$(T1))
: S0=VAL(STR(S1$(T1),2))
: GOSUB 3290
: GOTO 3090
3290 PRINT AT(T4,S1);HEX(2E20);STR(T1$(S8),,LEN(T1$(S8)));AT(T3,S0);HEX(020202
0F020402000ECC200202000F);STR(T1$(T1),,LEN(T1$(T1)));HEX(0F);
: RETURN
3300 IF S2$=HEX(08)THEN 3330
: STR(T5$(T0),S9,1)=S2$
3310 $TRAN(STR(T5$(T0)),HEX(8520))R
: IF S7=2THEN PRINT HEX(06020402000E);AT(S7(T0),S2(T0));STR(T5$(T0),,S4(T0)
);HEX(0F);
3320 T3=S7(T0)
: S0=S2(T0)+S9
: IF S9=S4(T0)THEN GOSUB 3540
: GOTO 3090
3330 IF S9<2THEN 3090
: S9=S9-2
: STR(T5$(T0),S9+1,1)=" "
: GOTO 3310
3340 PRINT HEX(06);AT(23,0,80);
: ON POS(HEX(46454C4DF05042437E7F48494A0C)=S2$)GOTO 3380,3390,3400,3410,317
0,3160,3190,3200,3130,3130,3420,3420,3420,3350
: GOTO 3120
3350 PRINT HEX(0E);AT(23,0,);D5$;HEX(0F);
3360 KEYIN S2$,3370,3090
: GOTO 3360
3370 PRINT AT(23,0,);
: IF S2$<>"*"THEN 3090
: T5=-2
: RETURN
3380 T3=T3-1
: IF T3<0THEN T3=23
: GOTO 3090
3390 T3=T3+1
: IF T3>23THEN T3=0
: GOTO 3090
3400 S0=S0+1
: IF S0<=79THEN 3090
: S0=0
: GOTO 3390
3410 S0=S0-1
: IF S0>=0THEN 3090
: S0=79
: GOTO 3380
3420 GOSUB 3470
: IF S7=0THEN 3110
: IF S7<>1THEN ON POS(HEX(48494A)=S2$)GOTO 3430,3440,3450
: GOTO 3120
3430 STR(T5$(T0),S9)=" "
: S9=S9-1
: GOTO 3310
3440 IF S4(T0)-S9=0THEN 3090
: MAT COPY STR(T5$(T0),S9+1,S4(T0)-S9)TO STR(T5$(T0),S9,S4(T0)-S9+1)
: S9=S9-1
: GOTO 3310
3450 IF S4(T0)-S9=0THEN 3090
: MAT COPY -STR(T5$(T0),S9,S4(T0)-S9)TO -STR(T5$(T0),S9+1,S4(T0)-S9)
: STR(T5$(T0),S9,1)=" "
: S9=S9-1
: GOTO 3310
3470 S7=0
: T1$=BIN(T3)&BIN(S0)
: MAT SEARCHS1$(),=STR(T1$,,2)TO T2$STEP 2
: IF T2$=HEX(0000)THEN MAT SEARCHS2$(),=STR(T1$,,2)TO T2$STEP 2
: ELSE S7=1
: IF T2$=HEX(0000)THEN RETURN
: T1=(VAL(T2$,2)+1)/2
3480 T6=0
: IF S7<>1THEN 3520
: FOR T7=1TO S4
: T6=T6+S3(T7)
: IF T1>=T6+1THEN 3490
: T0=T7
: T7=S4
3490 NEXT T7
: S9=T1-T6+S3(T0)
: S8=T1-S9+T5(T0)
: T4=VAL(S1$(S8))
: S1=VAL(STR(S1$(S8),2))
: T2$="O"
3500 T2,T6=0
3510 T2=T2+1
: IF STR(S1$,T2,1)=T2$THEN T6=T6+1
: IF T6=T0THEN RETURN
: GOTO 3510
3520 FOR T7=1TO S6
: T6=T6+S4(T7)
: IF T1>=T6+1THEN 3530
: T0=T7
: T7=S6
3530 NEXT T7
: S9=T1-T6+S4(T0)
: S7=T2(T0)
: T2$="T"
: GOTO 3500
3540 IF S2$=HEX(7F)THEN T2=T2-1
: ELSE T2=T2+1
: IF T2>S4+S6THEN T2=1
: IF T2<1THEN T2=S4+S6
: T2$=STR(S1$,T2,1)
3550 T0=0
: FOR T6=1TO T2
: IF T2$=STR(S1$,T6,1)THEN T0=T0+1
: NEXT T6
: IF T2$="T"THEN 3580
3560 S7=1
: S9=T5(T0)
: T1=0
: IF T0=1THEN 3570
: FOR T6=1TO T0-1
: T1=T1+S3(T6)
: NEXT T6
3570 T1=T1+S9
: T3=VAL(S1$(T1))
: S0=VAL(STR(S1$(T1),2))
: RETURN
3580 S7=T2(T0)
: S9=1
: T3=S7(T0)
: S0=S2(T0)
: RETURN
3590 %This is line 3400 - do not renumber lines 3400-3499
3600 T1$="Move cursor"
: RETURN
3610 T1$="Invalid key - ignored"
: RETURN
8000 DEFFN'0"LIST S HEX(03020400000E) D 10,";HEX(0D)
8020 DEFFN'126"LIST S HEX(03) D 0 ,"
8030 DEFFN'1"LIMITS T";HEX(22);"609menu";HEX(22);",G6,G7,G8,G9:PRINTG6,G7,G7-G
6+1,G8,G9: PRINTUSING";HEX(22);"###.##%";HEX(22);",100*(G8-2)/(G7-G6-1)";
HEX(0D)
8040 DEFFN'2"RENUMBER 10-999 TO 10";HEX(0D)
8050 DEFFN'16"CLEAR P 9000,";HEX(0D)
8060 DEFFN'3"PRINT SPACE K - SPACE/1024";HEX(0D)