World of Ham Radio 1997/WOHR97_AmSoft_(1997-02-01).iso/antenna/ant_21/prog/menu.bas

BASIC Source File | 1997-02-01 | 5KB | 242 lines

DECLARE SUB Vmenu (names$(), vpos%, message%, column%, Menu$)
DECLARE SUB Prvmenu (names$(), column%, message%, vpos%)

' vertical menu for regression package
'
CLS
DEFINT A-Z
REM $DYNAMIC
DIM names$(6, 2)
names$(1, 1) = "LINREG"
names$(1, 2) = "Linear Regression"
names$(2, 1) = "MLINREG"
names$(2, 2) = "Multiple Linear Regression (no graph)"
names$(3, 1) = "GEOMREG"
names$(3, 2) = "Geometric Regression"
names$(4, 1) = "EXPREG"
names$(4, 2) = "Exponential Regression"
names$(5, 1) = "NTHREG / POLYREG"
names$(5, 2) = "Nth-order (or Polynomial) Regression"
names$(6, 1) = "[exit]"
names$(6, 2) = "Exit program"
'
' The vpos variable will contain the operator's menu selection
'
vpos = 1
'
' The message variable contains the line where the message will appear
'
message = 20
'
' The column variable contains the value of the column where the menu
' lines will begin to display
'
column = 10
'
' menu$ = "Main menu"
CALL Vmenu(names$(), vpos, message, column, Menu$)
'
' The following lines illustrate that the program works
' and show how to access the result
'
CLS
'
LOCATE 5, 10: PRINT "You chose "; names$(vpos, 1)
FOR w1 = 1 TO 20000
    FOR w2 = 1 TO 10
    NEXT w2
NEXT w1
'
IF names$(vpos, 1) = "LINREG" THEN
    RUN "linreg"
ELSEIF names$(vpos, 1) = "MLINREG" THEN
    RUN "mlinreg"
ELSEIF names$(vpos, 1) = "GEOMREG" THEN
    RUN "geomreg"
ELSEIF names$(vpos, 1) = "EXPREG" THEN
    RUN "expreg"
ELSEIF names$(vpos, 1) = "NTHREG / POLYREG" THEN
    RUN "nthreg"
ELSEIF names$(vpos, 1) = "[exit]" THEN
RUN "bye"
ELSE
    LOCATE 20, 10: PRINT "Selection error!"
    RUN "bye"
END IF
'
'
' No longer needed
'
ERASE names$
END

SUB Prvmenu (names$(), column, message, vpos) STATIC
'
' This subprogram displays the menu
'
v = UBOUND(names$, 1)
'
' Display the menu selections
'
FOR x = 1 TO v
    LOCATE x + 2, column
    IF x = vpos THEN
        '
        ' This is the current selection so display in
        ' inverse video
        '
        COLOR 0, 7
        PRINT names$(x, 1)
        COLOR 7, 0
    ELSE
        PRINT names$(x, 1)
    END IF
NEXT

LOCATE message, column
'
' Erase the old message
'
PRINT SPACE$(50)
LOCATE message, column
'
' Display the current message
'
PRINT names$(vpos, 2)
'
' See if there's room to print the instructions
'
IF v + 4 < message - 2 THEN
    '
    ' Yes there is
    '
    LOCATE v + 4, column
    PRINT "Use first letter or up- and down-arrows to select"
    LOCATE v + 5, column
    PRINT "Press return key to select"
END IF
END SUB

SUB Vmenu (names$(), vpos, message, column, Menu$) STATIC
'
' This subprogram gets the operator's instructions
'
'
' Display the menu title
'
LOCATE 1, column
PRINT Menu$
'
' Display the menu
'
CALL Prvmenu(names$(), column, message, vpos)
'
' Initialize the variable to receive INKEY$
'
r$ = ""
'
' chr$(13) (carriage return) completes the menu selection
'
DO WHILE r$ <> CHR$(13)
    '
    ' Get rid of the previous keypress
    '
    r$ = ""
    DO WHILE r$ = ""
        r$ = INKEY$
    LOOP
    IF LEN(r$) = 2 THEN
        '
        ' A two-byte character such as an arrow
        '
        SELECT CASE ASC(RIGHT$(r$, 1))

            CASE 72: REM up-arrow
                '
                ' Move up one menu choice
                '
                vpos = vpos - 1
                IF vpos < 1 THEN
                    '
                    ' No menu choice there so wrap
                    '
                    vpos = UBOUND(names$, 1)
                END IF
                '
                ' Display the menu
                '
                CALL Prvmenu(names$(), column, message, vpos)

            CASE 80: REM down-arrow
                '
                ' Move down one menu choice
                '
                vpos = vpos + 1
                IF vpos > UBOUND(names$, 1) THEN
                    '
                    ' No menu choice there
                    '
                    vpos = 1
                END IF
                '
                ' Display the menu
                '
                CALL Prvmenu(names$(), column, message, vpos)

            CASE ELSE
                '
                ' No valid two-byte character
                '
                BEEP

        END SELECT

    '
    ' It was a one-byte character
    '
    ELSE
        IF (r$ >= "A" AND r$ <= "Z") OR (r$ >= "a" AND r$ <= "z") THEN
        '
        ' It was a letter
        '
            x = 1
            '
            ' See if it matches a menu choice
            '
            DO WHILE x <= UBOUND(names$, 1)
                IF r$ = LEFT$(names$(x, 1), 1) OR ASC(r$) = ASC(LEFT$(names$(x, 1), 1)) + 32 THEN
                    '
                    ' Found a match
                    '
                    vpos = x
                    '
                    ' Display the menu
                    '
                    CALL Prvmenu(names$(), column, message, vpos)
                    '
                    ' We're done
                    '
                    EXIT DO
                ELSE
                    x = x + 1
                END IF
            LOOP

            IF x > UBOUND(names$, 1) THEN
                '
                ' No matching letter
                '
                BEEP
            END IF

        ELSEIF r$ <> CHR$(13) THEN
            '
            ' Keypress wasn't a letter or carriage return
            '
            BEEP
        END IF
    END IF
LOOP
END SUB