ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/UTILITY/4DOS/4MENU11W.ZIP/4MENU.BAS

BASIC Source File | 1991-03-08 | 5.3 KB | 186 lines

' Copyright 1991 by Jeffery G. Smith
' All rights reserved.
'
' The files which make up this program release may be distributed freely
' only if they are unaltered and together in a copy of the original
' compressed file.
'
' No fees may be charged for distribution without consent of the author
' except to cover the cost of materials.
'
' This program is provided as is and the author assumes no responsibility
' for its performance.

REM $DYNAMIC
OPTION BASE 1

TYPE ENTRY
    choice AS STRING * 80
    action AS STRING * 80
    inkkey AS STRING * 4
END TYPE

DECLARE FUNCTION countentries% (file AS STRING)
DECLARE FUNCTION getline$ ()
DECLARE SUB getentry (thing AS ENTRY)
DECLARE SUB getname (m AS STRING, b AS STRING)

CONST FALSE% = 0, TRUE% = -1
CONST SCRNHGT% = 25, SCRNWID% = 80, MAXENTRIES% = 19, T% = 4
CONST NULFILE$ = "nul.mnu", LABEL$ = "menulabel", VAR$ = "%menuevar"

ON ERROR GOTO errhandle

COLOR 14, 0, 0
PRINT "4Menu Version 1.0"
PRINT "Copyright 1991 by Jeffery G. Smith"
PRINT "All rights reserved"

mnunm$ = COMMAND$
CALL getname(mnunm$, btmnm$)
filefound% = TRUE%
OPEN mnunm$ FOR INPUT AS #1
CLOSE #1

DO UNTIL filefound% OR mnunm$ = NULFILE$
    INPUT "Input file-name[.mnu] or NUL to exit: ", mnunm$
    CALL getname(mnunm$, btmnm$)
    filefound% = TRUE%
    OPEN mnunm$ FOR INPUT AS #1
    CLOSE #1
LOOP

IF mnunm$ <> NULFILE$ THEN
    entries% = countentries%(mnunm$)
    IF entries% > MAXENTRIES% THEN ERROR 100
    DIM menu(entries%) AS ENTRY
    OPEN mnunm$ FOR INPUT AS #1
    scrnfg$ = getline$
    scrnbg$ = getline$
    menufg$ = getline$
    menubg$ = getline$
    brdrfg$ = getline$
    brdrbg$ = getline$
    style$ = getline$
    IF LEN(style$) > 1 OR VAL(style$) < 0 OR VAL(style$) > 4 THEN ERROR 105
    title$ = getline$

    max% = LEN(title$)
    FOR i% = 1 TO entries%
        CALL getentry(menu(i%))
        max$ = RTRIM$(menu(i%).choice$)
        IF LEN(max$) > max% THEN max% = LEN(max$)
        FOR j% = 1 TO i% - 1
            IF RTRIM$(menu(i%).inkkey$) = RTRIM$(menu(j%).inkkey$) THEN ERROR 101
        NEXT j%
    NEXT i%

    row% = (SCRNHGT% - entries%) / 2
    col% = (SCRNWID% - max%) / 2
    tcol% = col% + ((max% - LEN(title$)) / 2)

    OPEN btmnm$ FOR OUTPUT AS #2
    PRINT #2, ":"; LABEL$
    PRINT #2, TAB(T%); "cls "; scrnfg$; " on "; scrnbg$
    PRINT #2, TAB(T%); "drawbox"; row% - 4; col% - 2; row% + entries% + 1; col% + max% + 1; style$; SPC(1); brdrfg$; " on "; brdrbg$; " fill "; menubg$

    PRINT #2, TAB(T%); "scrput"; row% - 2; tcol%; menufg$; " on "; menubg$; SPC(1); title$
    PRINT #2, TAB(T%); "scrput"; row% - 1; col%; menufg$; " on "; menubg$; SPC(1); STRING$(max%, 196)
    FOR i% = row% TO entries% + row% - 1
        PRINT #2, TAB(T%); "scrput"; i%; col%; menufg$; " on "; menubg$; SPC(1); RTRIM$(menu(i% - row% + 1).choice$)
    NEXT i%

    PRINT #2, TAB(T%); "screen"; i%; col%
    PRINT #2, TAB(T%); "inkey %"; VAR$

    PRINT #2,
    PRINT #2, TAB(T%); "iff "; CHR$(34); VAR$; CHR$(34); " == "; CHR$(34); RTRIM$(menu(1).inkkey$); CHR$(34); " then"
    PRINT #2, TAB(2 * T%); SPC(1); RTRIM$(menu(1).action$)
    FOR i% = 2 TO entries%
        PRINT #2, TAB(T%); "elseiff "; CHR$(34); VAR$; CHR$(34); " == "; CHR$(34); RTRIM$(menu(i%).inkkey$); CHR$(34); " then"
        PRINT #2, TAB(2 * T%); SPC(1); RTRIM$(menu(i%).action$)
    NEXT i%
    PRINT #2, TAB(T%); "else"
    PRINT #2, TAB(2 * T%); "beep 200 4"
    PRINT #2, TAB(2 * T%); "goto "; LABEL$
    PRINT #2, TAB(T%); "endiff"

    CLOSE #2
END IF

END

errhandle:
    IF ERR = 53 THEN
        filefound% = FALSE%
    ELSEIF ERR = 100 THEN
        PRINT : PRINT "Menu has too many entries."
        STOP
    ELSEIF ERR = 101 THEN
        PRINT : PRINT "Key field has too many characters."
        STOP
    ELSEIF ERR = 102 THEN
        PRINT : PRINT "Incorrect number of lines for proper format"
        STOP
    ELSEIF ERR = 103 THEN
        PRINT : PRINT "Same key used for two actions."
        STOP
    ELSEIF ERR = 104 THEN
        PRINT : PRINT "usage: 4menu [description-file]"
        STOP
    ELSEIF ERR = 105 THEN
        PRINT : PRINT "Border style must be in the range 1-4"
        STOP
    ELSE
        ON ERROR GOTO 0
    END IF
RESUME NEXT

REM $STATIC
FUNCTION countentries% (file AS STRING)
    OPEN file$ FOR INPUT AS #1
    count% = -8
    DO UNTIL EOF(1)
        dummy$ = getline$
        count% = count% + 1
        IF (count% > 0) AND (count% MOD 3 = 0) AND (LEN(dummy$) > 4) THEN ERROR 101
    LOOP
    CLOSE #1
    IF (count% < 0) OR (count% MOD 3 <> 0) THEN ERROR 102
    countentries% = count% / 3
END FUNCTION

SUB getentry (thing AS ENTRY)
    thing.choice$ = getline$
    thing.action$ = getline$
    thing.inkkey$ = getline$
END SUB

FUNCTION getline$
    LINE INPUT #1, temp$
    getline$ = RTRIM$(LTRIM$(temp$))
END FUNCTION

SUB getname (m AS STRING, b AS STRING)
    CONST DEFEXT$ = ".mnu", BATEXT$ = ".btm"

    hold$ = LCASE$(LTRIM$(RTRIM$(m$)))
    IF INSTR(hold$, " ") THEN ERROR 104
    IF hold$ = "" THEN ERROR 53
    dot = INSTR(hold$, ".")

    IF dot <> 0 THEN
        m$ = LEFT$(hold$, dot - 1)
    ELSE
        m$ = LCASE$(m$)
    END IF
    b$ = m$ + BATEXT$

    IF dot = 0 THEN
        m$ = m$ + DEFEXT$
    ELSE
        m$ = hold$
    END IF
END SUB