Mennonite's Pretty Good Highlighting Menu for Kriegspiel Referee

DIM menuoption$(1 TO 20) 'not needed if there aren't to be many options...

''run this after you create the background intro screen with the first program i put on here.
''this returns the variable Typed which is=-1 for ESC, or selected 1 to [etc.]

ShowOddMenuLegend = 1 'i like it. if you hate it, turn it off :)

menuoption$(1) = "1. For one, I'm ok"
menuoption$(2) = "2. And You're ok"
menuoption$(3) = "3. But He's nuts..."
menuoption$(4) = "4. 3! no, 4 sir!"
menuoption$(5) = "5. Is right out!"
menuoption$(6) = "6. Hello!"
menuoption$(7) = "7. My name is Inigo Montoya"
menuoption$(8) = "8. Screw This!"
menuoption$(9) = "" 'last option must be empty... yes you can have > 8 or 9
FinalOptionSameAsEscKey = 1 'set to 0 if you don't want last option to Quit

'count menu options
numenuopts = -1
DO
numenuopts = numenuopts + 1
LOOP UNTIL menuoption$(numenuopts + 1) = ""

'the big messy loop that does everything :(
'...but i'm still very fond of it ;)
Typed = 1
DO

menulegend$ = SPACE$(6)
IF numenuopts > 1 THEN
SELECT CASE Typed
CASE IS = 1
menulegend$ = CHR$(32) + CHR$(25) + CHR$(32) + CHR$(25) + CHR$(32) + CHR$(25)
CASE IS = numenuopts
menulegend$ = CHR$(24) + CHR$(32) + CHR$(24) + CHR$(32) + CHR$(24) + CHR$(32)
CASE ELSE
menulegend$ = CHR$(24) + CHR$(32) + CHR$(24) + CHR$(25) + CHR$(32) + CHR$(25)
END SELECT
END IF

IF wheretohlight = 0 THEN wheretohlight = 1
menuline = 0

'display up and down arrows
IF ShowOddMenuLegend <> 0 THEN
COLOR 7, 1
FOR menulegendy = 16 TO 21
LOCATE menulegendy, 77
PRINT MID$(menulegend$, menulegendy - 15, 1)
NEXT menulegendy
END IF

'type and highlight menu
DO
menuline = menuline + 1: IF dispstart < 1 THEN dispstart = 1
LOCATE menuline + 15, 51: htemp$ = menuoption$(menuline + dispstart - 1)
IF menuline = wheretohlight THEN COLOR 3, 0 ELSE COLOR 0, 3
PRINT LEFT$(htemp$ + SPACE$(27), 27 - SGN(ABS(ShowOddMenuLegend)))
LOOP UNTIL menuline >= 6 OR menuline + dispstart - 1 >= numenuopts

'arrow key handler designed to work in QB and FB without modification
'note: rest of routine NOT tested in FB... but should avoid chr$(0) problem.
DO: keyput$ = INKEY$: LOOP UNTIL keyput$ <> "" 'simulate input$(1) with inkey$
IF LEN(keyput$) > 1 THEN MID$(keyput$, 1, 1) = CHR$(255)
IF INSTR("234567890", keyput$) AND numenuopts = 1 THEN keyput$ = "ab" 'fixed
SELECT CASE LCASE$(keyput$)
CASE CHR$(255) + "h", CHR$(255) + "k", CHR$(255) + "i" 'up (also left or pgup)
IF wheretohlight > 1 THEN
wheretohlight = wheretohlight - 1
ELSE
IF dispstart > 1 THEN dispstart = dispstart - 1
END IF
Typed = dispstart + wheretohlight - 1
CASE CHR$(255) + "p", CHR$(255) + "m", CHR$(255) + "q" 'down (also rt or pgdn)
IF Typed < numenuopts THEN
IF wheretohlight < 6 THEN
wheretohlight = wheretohlight + 1
ELSE
IF dispstart + 5 < numenuopts THEN dispstart = dispstart + 1
END IF
Typed = dispstart + wheretohlight - 1
END IF
CASE CHR$(27)
Typed = -1 'quit!
CASE SPACE$(1), CHR$(13) 'or enter
Typed = Typed + .5 'selection!
CASE "1", "2", "3", "4", "5", "6", "7", "8", "9"
'allow actual numbers 1 through 9
IF numenuopts = 1 THEN
IF keyput$ = "1" THEN Typed = Typed + .5 'treat specially as enter key
ELSE
'normal
IF VAL(keyput$) <= numenuopts THEN
dispstart = 0
DO: dispstart = dispstart + 1: LOOP UNTIL dispstart + 5 >= VAL(keyput$)
wheretohlight = VAL(keyput$) - dispstart + 1
Typed = dispstart + wheretohlight - 1
END IF
END IF
CASE ELSE
COLOR 0, 3
LOCATE 14, 51: PRINT "Use Arrow Keys-then [Enter]"
timert = TIMER + 1.5: DO: emptybuffer$ = INKEY$ 'prevent long wait bug XD
LOOP UNTIL TIMER > timert OR TIMER < timert - 1.5 * 1.2
COLOR 0, 3
LOCATE 14, 51: PRINT " Kriegspiel Referee - Menu "
END SELECT

LOOP UNTIL Typed < 0 OR Typed <> INT(Typed): Typed = INT(Typed)
IF Typed = numenuopts AND FinalOptionSameAsEscKey THEN Typed = -1
COLOR 7, 0
'yay...

'following line can be removed:
CLS : PRINT "option"; LEFT$(" ", (Typed < 0) * -1); Typed; "selected"