RBBS in a Box Volume 1 #3.1/RBBSIABOX31.cdr/mlpc/menu.bas

GW-BASIC | 1984-10-04 | 5.0 KB | 172 lines

110      DEFINT I-N
115    'This menu for BASIC programs was translated to structured basic
120    'by Paul McKnight March 26, 1983
125    'DOS 2.0 Version
130    '
135    'constants
140      DEFINT A-H
145      DEFINT O-Z
150      CR$=CHR$(13)
155    '
160     GOTO 25000 ' jump to program
200     '----------------------- PROCEDURE INIT
205      DIM PROG$(64)
210      CLS:WIDTH 80:COLOR 7,0
215      KEY 10, "RUN"+CHR$(34)+"MENU"
220     RETURN ' ------------------------------------------
225    '
300     '----------------------- PROCEDURE INVISIBLE
305      CLS: COLOR 0,0: 'PRINT FILES INVISIBLY
310      LOCATE ,,0 'turn off cursor
315     ' CASE  OPT$  OF
320     IF ( OPT$ ="1" )  THEN ELSE GOTO   335
325          DRIVE$="A:" : FILES "A:*.BAS"
330     GOTO   400
335     IF ( OPT$ ="2" )  THEN ELSE GOTO   350
340          DRIVE$="B:" : FILES "B:*.BAS"
345     GOTO   400
350     IF ( OPT$ ="3" )  THEN ELSE GOTO   365
355          DRIVE$="C:" : FILES "C:*.BAS"
360     GOTO   400
365     IF ( OPT$ ="4" )  THEN ELSE GOTO   380
370          DRIVE$="D:" : FILES "D:*.BAS"
375     GOTO   400
380     IF ( OPT$ ="5" )  THEN ELSE GOTO   395
385          DRIVE$="E:" : FILES "E:*.BAS"
390     GOTO   400
395     ' OTHERWISE
400     ' CEND
405     RETURN ' ------------------------------------------
410    '
500     '----------------------- PROCEDURE DRIVE
505      WHILE INKEY$ <> ""
510      WEND : ' CLEAR INPUT BUFFER
515      OPT$="0"
520      CLS
525      PRINT " McMenu (RatBAS) Version 2.00 3/26/83"
530      PRINT " *********DOS 2.0 VERSION************"
535      PRINT "    MENU OF BASIC PROGRAMS": PRINT
540      PRINT " PRESS 1,2,3,4 OR 5 TO SELECT DRIVE.." : PRINT
545      PRINT " 1  DRIVE A"
550      PRINT " 2  DRIVE B"
555      PRINT " 3  DRIVE C"
560      PRINT " 4  DRIVE D"
565      PRINT " 5  DRIVE E"
570      PRINT :PRINT " (Non-existant drives are mapped"
575      PRINT "  to the last-used drive."
580      WHILE OPT$<"1" OR OPT$>"5"
585        OPT$=INKEY$:
590      WEND
595     GOSUB  300 ' INVISIBLE
600     RETURN ' ------------------------------------------
605    '
700     '----------------------- PROCEDURE READFILES
705      AROW=0  'position in array prog$
710      DONE=FALSE: ROW=2
715      WHILE (DONE=FALSE) AND (ROW<25)
720        COLUMN=0
725        WHILE (COLUMN<66) AND (DONE=FALSE)
730          IF SCREEN(ROW,COLUMN+1)=32  THEN ELSE GOTO  750
735            DONE=TRUE
740            MAXP=AROW
745     GOTO   775
750     ' ELSE]
755            AROW=AROW+1            'Go to next row in array
760            FOR LETTER=1 TO 8        'Read first 8 characters of file name
765            PROG$(AROW)=PROG$(AROW)+CHR$(SCREEN(ROW,COLUMN+LETTER))
770            NEXT LETTER
775           ' IFEnd]
780          COLUMN=COLUMN+18
785        WEND
790        ROW=ROW+1
795      WEND
800     RETURN ' ------------------------------------------
805    '
900     '----------------------- PROCEDURE VISIBLE
905      WIDTH 40:LOCATE 1,4:COLOR 7,0
910      PRINT "BASIC programs on this diskette:"
915      ARRPOS=0: DONE=FALSE: SROW=3: SCOL=1
920      WHILE DONE=FALSE AND SCOL<28
925        WHILE SROW<24 AND DONE=FALSE
930          ARRPOS=ARRPOS+1             'Go to next row in array
935          IF PROG$(ARRPOS)<>""  THEN ELSE GOTO  960
940            LOCATE SROW,SCOL
945            COLOR 0,7:PRINT USING "##";ARRPOS;:
950            COLOR 7,0:PRINT " ";PROG$(ARRPOS);
955     GOTO   970
960     ' ELSE]
965            DONE=TRUE
970           ' IFEnd]
975          SROW=SROW+1
980        WEND
985        SROW=3
990        SCOL=SCOL+13
995      WEND
1000     RETURN ' ------------------------------------------
1005    '
1100     '----------------------- PROCEDURE GET-CHOICE
1105      KEY OFF: LOCATE 25,1:PRINT "ENTER NUMBER OF PROGRAM DESIRED: ";
1110      LOCATE ,,1 'turn cursor on
1115      P=0
1120      WHILE P<1 OR P>MAXP
1125        IF PROG$(10)<>""  THEN ELSE GOTO  1230
1130          LOCATE 25,35:PRINT "     ";:LOCATE 25,35
1135          P1$=""
1140          WHILE P1$=""
1145            P1$=INKEY$
1150          WEND
1155          P1=(VAL(P1$)*10)
1160          PRINT P1$;
1165          P2$=""
1170          WHILE P2$=""
1175            P2$=INKEY$
1180          WEND
1185          IF P2$=CR$  THEN ELSE GOTO  1200
1190            P=VAL(P1$)
1195     GOTO   1220
1200     ' ELSE]
1205            P2=VAL(P2$)
1210            PRINT P2$;
1215            P=P1+P2
1220           ' IFEnd]
1225     GOTO   1245
1230     ' ELSE]
1235          P$=INKEY$
1240          P=VAL(P$)
1245         ' IFEnd]
1250      WEND
1255      PROGRAM$=DRIVE$+PROG$(P)
1260      LOCATE 25,35: PRINT CHR$(1);P;CHR$(1);
1265      RUN PROGRAM$        'Run the program selected.......
1270     RETURN ' ------------------------------------------
1275    '
1300     '----------------------- PROCEDURE ERROR
1305      SOUND 200,9:COLOR 7,0: PRINT: PRINT "ERROR";ERR;"AT LINE";ERL
1310      IF ERR=53  THEN ELSE GOTO  1320
1315        PRINT "There are no basic files on that drive."
1320       ' IFEnd]
1325      PRINT "PRESS F2 TO RUN THE MENU AGAIN"
1330      END
1335     RESUME NEXT ' ---------------------
1340    '
25000     ' =================== PROCEDURE LOCATIONS ===========
25005     '  200 INIT
25010     '  300 INVISIBLE
25015     '  500 DRIVE
25020     '  700 READFILES
25025     '  900 VISIBLE
25030     '  1100 GET-CHOICE
25035     '  1300 ERROR
25040     ' ================== PROGRAM ========================
25045     FALSE = 0: TRUE = NOT FALSE
25050     ON ERROR GOTO  1300
25055     GOSUB  200 ' INIT
25060      FOREVER=TRUE
25065      WHILE FOREVER=TRUE
25070     GOSUB  500 ' DRIVE
25075     GOSUB  700 ' READFILES
25080     GOSUB  900 ' VISIBLE
25085     GOSUB  1100 ' GET-CHOICE
25090      WEND
25095    END