image of READY prompt

Wang2200.org

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)