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)