' +--------------------------------------------------------------------+
    ' |       WARNING              WARNING              WARNING            |
    ' |                                                                    |
    ' |       To use in QB45 IDE, load as QB /l qb.qlb SEAMENU.BAS         |
    ' +--------------------------------------------------------------------+
    ' +--------------------------------------------------------------------+
    ' |                                                                    |
    ' |                   - S e a M e n u . B a s -                        |
    ' |                                                                    |
    ' |                                                                    |
    ' |                   Public Domain -  FreeWare                        |
    ' +--------------------------------------------------------------------+
    ' +--------------------------------------------------------------------+
    ' |                      - ABOUT THE AUTHOR -                          |
    ' +--------------------------------------------------------------------+
    ' |                                                                    |
    ' | Hello. My name is Don Smith and I am a thirty-year retired teacher |
    ' | of Math/History/Spanish residing in Orange County, California. I   |
    ' | am also a former six-year Sergeant of Marines. Who-Rah! On certain |
    ' | forums I am known as MarineDon.My email is: smithdonb@earthlink.net|
    ' |                                                                    |
    ' +--------------------------------------------------------------------+
    ' |                 - COPYING AND DISTIBUTING -                        |
    ' +--------------------------------------------------------------------+
    ' | Since this code is public domain and freeware, anyone may freely   |
    ' | copy and distribute it. If you use the QuickBasic code in one of   |
    ' | your own programs, you do not have to cite my name as the author,  |
    ' | and you may even change its name. However, if you are to give your |
    ' | name as author, you'll want to take out the author information     |
    ' | at lines 85-104.                                                   |
    ' +--------------------------------------------------------------------+
    ' +--------------------------------------------------------------------+
    ' |                          SeaMenu.Bas                               |
    ' +--------------------------------------------------------------------+
    ' |  SeaMenu was written on 03/28/2002 by Don Smith. SeaMenu.Bas and   |
    ' |  SeaMenu.Exe are both Public Domain and FreeWare. The SeaMenu      |
    ' |  program works interactively within a batch file. The documentation|
    ' |  file, SeaMenu.Txt explains in detail how to use the program.      |
    ' +--------------------------------------------------------------------+
    ' |  Author: Don Smith                                                 |
    ' |  Email: smithdonb@earthlink.net                                    |
    ' |-------------------+------------------------------------------------+
    ' |  Compiling Info:  |                                                |
    ' |  --------------   |        A practice batch file is:               |
    ' |  BC  : SEAMENU    |              MainMenu.Bat                      |
    ' |  LINK: SEAMENU    |                                                |
    ' |  LIB : QB BCom45  |                                                |
    ' +-------------------+------------------------------------------------+

    DEFINT A-Z

    TYPE RegType
         AX    AS INTEGER
         bx    AS INTEGER
         CX    AS INTEGER
         DX    AS INTEGER
         bp    AS INTEGER
         si    AS INTEGER
         di    AS INTEGER
         Flags AS INTEGER
    END TYPE

    DIM SHARED Regs AS RegType
    DECLARE FUNCTION Exist% (Spec$)

    DECLARE SUB Bye CDECL ALIAS "_exit" (BYVAL Selection%)
    DECLARE SUB Interrupt (intnum AS INTEGER, inreg AS RegType, outreg AS RegType)
    DECLARE SUB TinyBox (ULRow%, ULCol%, LRRow%, LRCol%, BoxColrFG%, BoxColrBG%)

    ComFile$ = COMMAND$
    FOR FindSlash% = 1 TO LEN(ComFile$)
        Slash$ = MID$(ComFile$, FindSlash%, 1)
        IF Slash$ = "/" THEN
            Colr$ = MID$(ComFile$, FindSlash% + 1, LEN(ComFile$) - FindSlash% + 1)
            Colr$ = RTRIM$(LTRIM$(Colr$))
            RegColr% = VAL(Colr$)
            ComFile$ = LEFT$(ComFile$, FindSlash% - 1)
            ComFile$ = RTRIM$(LTRIM$(ComFile$))
        END IF
    NEXT
    IF ComFile$ = "" THEN
        ErrMessage% = 1
        GOTO errorhandler
    ELSEIF ComFile$ = "A" OR ComFile$ = "a" THEN
        COLOR 15, 0: CLS
        CALL TinyBox(1, 1, 9, 78, 15, 0)
        COLOR 12, 0
        LOCATE 2, 34: PRINT "Author";
        LOCATE 4, 3
        COLOR 15, 0
        PRINT "My name is Donald Bernard Smith and I am the author of SeaMenu.  I will not";
        LOCATE 5, 3
        PRINT "give my Social Security number, but for purposes of identification, my USMC";
        LOCATE 6, 3
        PRINT "military I.D. number is 1672175.     SeaMenu is Public Domain FreeWare.";
        LOCATE 7, 3
        PRINT "Today's date is 03/28/2002.";
        LOCATE 7, 33
        COLOR 11, 0
        PRINT "EMail: smithdonb@earthlink.net";
        COLOR 15, 0
        LOCATE 11, 1: PRINT STRING$(40, " ");
        COLOR 7, 0: LOCATE , , 1, 6, 7: END
    END IF
    There% = Exist%(ComFile$)
    IF There% = 0 THEN
        ErrMessage% = 2
        GOTO errorhandler
    END IF

    OPEN ComFile$ FOR INPUT AS #1
    REDIM M$(25)
    MaxItems% = 1
    DO
        LINE INPUT #1, Line$
        Line$ = RTRIM$(LTRIM$(Line$))
        IF LEFT$(Line$, 2) = "::" THEN
            IF MID$(Line$, 4, 1) = "*" THEN
                EXIT DO
            END IF
            IF MaxItems% >= 19 THEN
                EXIT DO
            END IF
            IF MID$(Line$, 4, 1) = "$" THEN
                Title$ = MID$(Line$, 5, LEN(Line$) - 4)
            END IF
            IF MID$(Line$, 4, 1) = "#" THEN
                M$(MaxItems%) = MID$(Line$, 6, LEN(Line$))
                M$(MaxItems%) = LEFT$(M$(MaxItems%), 23)
                MaxItems% = MaxItems% + 1
            END IF
            IF MID$(Line$, 4, 1) = "%" THEN
                FKeys$ = MID$(Line$, 5, LEN(Line$) - 4)
            END IF
            IF MID$(Line$, 4, 1) = "@" THEN
               B$ = MID$(Line$, 5, LEN(Line$) - 4)
            END IF
        END IF
    LOOP UNTIL EOF(1)
    CLOSE #1
    Selection% = 1
    Row% = 6

loopdeloop:
    IF Title$ = "" OR M$(1) = "" THEN
        ErrMessage% = 3
        GOTO errorhandler
    END IF
    IF RegColr% = 0 THEN
        RegColr% = 31
    END IF
    FG% = RegColr% MOD 16
    BG% = RegColr% \ 16
    COLOR FG%, BG%: CLS
    IF RegColr% > 15 AND RegColr% < 128 THEN
        HiLiteColr% = 15
        HiLiteColrFG% = 15
        HiLiteColrBG% = 0
    ELSEIF RegColr% > 0 AND RegColr% < 16 THEN
        HiLiteColr% = 112
        HiLiteColrFG% = 0
        HiLiteColrBG% = 15
    END IF
    Col% = 28
    MaxItems% = MaxItems% - 1
    LenLine% = 33
    SD% = 1
    CALL TinyBox(2, 21, 4, 54, FG%, BG%)  'title box
    LOCATE Row% - 3, 40 - (LEN(Title$) \ 2) - 2
    COLOR FG%, BG%: PRINT Title$
    ULRow% = Row% - 1: ULCol% = 21: LRRow% = MaxItems% + 6: LRCol% = 54
    CALL TinyBox(ULRow%, ULCol%, LRRow%, LRCol%, FG%, BG%)     'menu box
    IF B$ <> "" THEN
        IF MaxItems% < 17 THEN
            CALL TinyBox(MaxItems% + 7, 21, MaxItems% + 9, 54, FG%, BG%)
            LOCATE MaxItems% + 8, 40 - (LEN(B$) \ 2) - 2
            COLOR FG%, BG%
            PRINT B$;
        END IF
    END IF
    FOR Jefe% = 1 TO MaxItems%
        HotKey$ = HotKey$ + LEFT$(M$(Jefe%), 1)
    NEXT
    LetrOrNum% = 0
    HotKey$ = UCASE$(HotKey$)
    IF Selection% = 0 THEN Selection% = 1
    FindRow% = Row%
    FOR xyz% = 1 TO MaxItems%
        LOCATE FindRow%, Col%, 0
        IF LEFT$(M$(xyz%), 1) = "-" THEN
            LOCATE , Col% - 7, 0: COLOR FG%, BG%
            PRINT (CHR$(195) + STRING$(LenLine%, CHR$(196)) + CHR$(180));
        ELSE
            COLOR FG%, BG%: PRINT " " + M$(xyz%) + " ";
        END IF
        FindRow% = Row% + (xyz% * SD%)
    NEXT
    DO
        LOCATE Row% + (Selection% * SD%) - SD%, Col%, 0
        COLOR HiLiteColrFG%, HiLiteColrBG%
        PRINT " " + M$(Selection%) + " ";
        DO
            k$ = INKEY$
        LOOP UNTIL LEN(k$) > 0
        k% = CVI(k$ + CHR$(0))
       
        IF k% = 27 THEN    'Press <Esc> and exit
            Selection% = 27
            GOTO what.choice
        ELSEIF k% = 13 THEN        '<Enter>
            GOTO what.choice
        'K% = 27 <Esc>  K% = 122 is last letter, or "z".
        ELSEIF k% > 27 AND k% < 123 THEN
            IF k$ <> "-" THEN
                LetrOrNum% = INSTR(HotKey$, UCASE$(k$))
                IF LetrOrNum% <> 0 THEN
                    Selection% = LetrOrNum%
                    ExitCode% = k%
                    GOTO what.choice
                END IF
            END IF
        ELSEIF k% = 20480 THEN                            '<DnArrow>
            GOSUB up.or.down
        ELSEIF k% = 18432 THEN                            '<UpArrow>
            GOSUB up.or.down
        ELSEIF k% > 15103 OR k% < 17409 THEN         'F1 - F10
            IF k% = -31488 THEN                    'F11
                Selection% = 211
                GOTO what.choice
            ELSEIF k% = -31232 THEN                'F12
                Selection = 212
                GOTO what.choice
            END IF
           
            IdentKey$ = STR$(((k% - 15104) \ 256) + 1)
            IdentKey$ = LTRIM$(RTRIM$(IdentKey$))
            IF IdentKey$ = "10" THEN
                IdentKey$ = "0"
            END IF
            IF INSTR(FKeys$, IdentKey$) > 0 THEN
                IF IdentKey$ = "0" THEN
                    Selection% = 210
                    GOTO what.choice
                ELSE
                    Selection% = VAL(IdentKey$)
                    Selection% = Selection% + 200
                    ExitCode% = k%
                    GOTO what.choice
                END IF
            END IF
        END IF
    LOOP

up.or.down:
    COLOR FG%, BG%
    LOCATE Row% + (Selection% * SD%) - SD%, Col%, 0
    PRINT " " + M$(Selection%) + " ";
    IF k% = 18432 THEN    '<UpArrow>
        Selection% = Selection% - 1
        IF Selection% = 0 THEN Selection% = MaxItems%
        IF M$(Selection%) = "-" THEN
            Selection% = Selection% - 1
        END IF
    ELSEIF k% = 20480 THEN      '<DnArrow>
        Selection% = Selection% + 1
        IF Selection% > MaxItems% THEN Selection% = 1
        IF M$(Selection%) = "-" THEN
            Selection% = Selection% + 1
        END IF
    ELSE
        Selection% = LetrOrNum%
    END IF
    RETURN

what.choice:
    IF Selection% > 0 THEN
        COLOR 7, 0: LOCATE , , 1, 6, 7
        CALL Bye(Selection%)
    END IF
    END

errorhandler:
    COLOR 15, 0: CLS
    CALL TinyBox(1, 14, 17, 64, 15, 0)
    COLOR 12, 0
    LOCATE 2, 33: PRINT "<<<Error>>>"; : COLOR 15, 0
    LOCATE 3, 14: PRINT CHR$(195) + STRING$(50, "Ä") + CHR$(180);
    LOCATE 4, 18: PRINT "Error is probably caused by one of the below:";
    LOCATE 5, 18: PRINT STRING$(44, "-");
    LOCATE 6, 18: PRINT "1. No batch file name was given.";
    LOCATE 7, 18: PRINT "2. Unable to find the indicated file.";
    LOCATE 8, 18: PRINT "3. Error in batch file.  Read SeaMenu.Txt";
    LOCATE 9, 18: PRINT "4. DOS error in naming file.";
    LOCATE 10, 14: PRINT CHR$(195) + STRING$(50, "Ä") + CHR$(180);
    LOCATE 11, 18: PRINT "WARNING! SeaMenu.Exe must be run from a batch";
    LOCATE 12, 18: PRINT "file. Enter MAINMENU.BAT at DOS prompt to see";
    LOCATE 13, 18: PRINT "how it works. To read the documentation file,"
    LOCATE 14, 18: PRINT "SeaMenu.Txt, press <Enter> now.";
    LOCATE 15, 14: PRINT CHR$(195) + STRING$(50, "Ä") + CHR$(180);
    LOCATE 16, 30: PRINT "Press <Esc> To Exit";
    COLOR 12, 0
    LOCATE 11, 18: PRINT "WARNING!";
    COLOR 11, 0
    LOCATE 14, 38: PRINT "Enter"
    LOCATE 16, 37: PRINT "Esc"

    COLOR 12, 0
    IF ErrMessage% = 1 THEN
        LOCATE 6, 16: PRINT CHR$(251);
    ELSEIF ErrMessage% = 2 THEN
        LOCATE 7, 16: PRINT CHR$(251);
    ELSEIF ErrMessage% = 3 THEN
        LOCATE 8, 16: PRINT CHR$(251);
    ELSEIF ErrMessage% = 4 THEN
        LOCATE 9, 16: PRINT CHR$(251);
    END IF
    SOUND 2100, 2
    DO
        PoundKey$ = INKEY$
        IF PoundKey$ = CHR$(27) THEN
            COLOR 7, 0: CLS : LOCATE , , 1, 6, 7: END
        ELSEIF PoundKey$ = CHR$(13) THEN
            SHELL "SeeBee.Exe" + " " + "SeaMenu.Txt"
            COLOR 7, 0: CLS : LOCATE , , 1, 6, 7: END
        END IF
    LOOP

FUNCTION Exist% (Spec$) STATIC

    ' +----------------------------------------------------------------------+
    ' |                       FUNCTION Exist% (Spec$)                        |
    ' +----------------------------------------------------------------------+
    ' |                                                                      |
    ' | Function returns -1 if exists and 0 if not.                          |
    ' | Spec$ is any string like: Spec$ = "*.ext" up to 79 letters.          |
    ' | The Spec$ can also include a path and 8.3 filename!                  |
    ' |                                                                      |
    ' +----------------------------------------------------------------------+
    ' |                  Example of FUNCTION Exist% (Spec$)                  |
    ' +----------------------------------------------------------------------+
    ' | Spec$ = "mainmenu.bat"                                               |
    ' | DoesExist% = Exist%(Spec$)                                           |
    ' | COLOR 15, 1: CLS                                                     |
    ' | IF DoesExist% = -1 THEN                                              |
    ' |     PRINT "FileSpec DOES indeed exist."                              |
    ' | ELSEIF DoesExist% = 0 THEN                                           |
    ' |     PRINT "FileSpec does NOT exist."                                 |
    ' | END IF                                                               |
    ' | END                                                                  |
    ' +----------------------------------------------------------------------+


    DIM DTA AS STRING * 44                'This is DOS' work area
    'Used by CALL Interrupt
    DIM LocalSpec AS STRING * 80          'Using a fixed-length string
    'supports both QB and PDS
    LocalSpec$ = Spec$ + CHR$(0)          'Add a CHR$(0) for DOS
    Exist% = -1                           'Assume the file is present
    Regs.AX = &H1A00                      'Assign DTA service
    Regs.DX = VARPTR(DTA)                 'Show DOS where to place it
    CALL Interrupt(&H21, Regs, Regs)
    Regs.AX = &H4E00                      'Find first matching file
    Regs.CX = 39                          'Any file attribute okay
    Regs.DX = VARPTR(LocalSpec)
    CALL Interrupt(&H21, Regs, Regs)      'See if there's a match
    IF Regs.Flags AND 1 THEN              'If the Carry flag is set
      Exist% = 0                          '  there were no matches
    END IF
END FUNCTION

SUB TinyBox (ULRow%, ULCol%, LRRow%, LRCol%, BoxColrFG%, BoxColrBG%)

    ' +----------------------------------------------------------------------+
    ' |                          SUB TinyBox                                 |
    ' +----------------------------------------------------------------------+
    ' |  ULRow.......Upper Left Row.                                         |
    ' |  LRRow.......Lower Right Row.                                        |
    ' |  ULCol.......Upper Left Column.                                      |
    ' |  LRCol.......Lower Right Column.                                     |
    ' |  BoxFGColr...The Foreground Color The Box.                           |
    ' |  BoxBGColr...The Back Ground Color Of The Box.                       |
    ' +----------------------------------------------------------------------+

    COLOR BoxColrFG%, BoxColrBG%
    LOCATE ULRow%, ULCol%
    PRINT CHR$(218) + STRING$(LRCol% - ULCol%, CHR$(196)) + CHR$(191)

    FOR BoxY% = ULRow% + 1 TO LRRow% - 1
        LOCATE BoxY%, ULCol%
        PRINT CHR$(179) + STRING$(LRCol% - ULCol%, " ") + CHR$(179);
    NEXT
    LOCATE LRRow%, ULCol%
    PRINT CHR$(192) + STRING$(LRCol% - ULCol%, CHR$(196)) + CHR$(217);
END SUB