EVMS -- Easy Versatile Menu System
#3
We can now start checking for user responses:

Code: (Select All)
Screen _NewImage(800, 600, 32)
$Color:32

Type Menu_Entries
    Name As String
    HighLight As Integer
    Active As Integer
    xOffset As Integer
    yOffset As Integer
    width As Integer
    height As Integer
End Type

Type Menu_Metadata
    inUse As Integer
    totalChoices As Integer
    xPos As Integer
    yPos As Integer
    width As Integer
    height As Integer
    layout As Integer '0 for left-right, anything else for up-down
    Active As Integer
    Visible As Integer
End Type


Dim Shared Menu(1 To 100) As Menu_Metadata, MenuChoice(1 To 100, 20) As Menu_Entries
Dim Shared As Integer MenuHover, ActiveMenu

mainmenu = DefineMenu("#File" + Chr$(0) + "#Edit" + Chr$(0) + "#Help, Help me, Rhonda!" + Chr$(0) + "Qui#t" + Chr$(0), -1)
SetMenuVisibility mainmenu, -1
SetMenuActive mainmenu, 0


Do
    Cls
    While _MouseInput: Wend
    k = _KeyHit
    mx = _MouseX: my = _MouseY: mb = _MouseButton(1): mb2 = _MouseButton(2)

    If _KeyDown(100308) Or _KeyDown(100307) Then
        Select Case k
            Case 109, 77 'alt-m will toggle my menu here to set it active or not
                If Menu(ActiveMenu).Active Then SetMenuActive ActiveMenu, 0 Else SetMenuActive ActiveMenu, -1
        End Select
    End If

    If k = 27 Then System

    Drawmenus
    result = CheckMenu(k)
    If result Then
        Locate 10, 1: Print "You clicked menu choice:"; MenuChoice(ActiveMenu, result).Name
        Print "Press <ANY KEY> to continue."
        _Display
        Sleep
    End If
    _Limit 30
    _Display
    omb = mb: omb2 = mb2 'store old mouse values
Loop

Sub SetMenuActive (whichmenu, state)
    For i = 1 To 100: Menu(i).Active = 0: Next
    If whichmenu Then
        Menu(whichmenu).Active = state
        If state Then MenuHover = 1 Else MenuHover = 0
        ActiveMenu = whichmenu
    End If
End Sub

Function MouseOverActiveMenu
    If Menu(ActiveMenu).Visible = 0 Then Exit Function
    'the mouse can only be counted as being over the active menu, if the active menu is visible
    mx = _MouseX: my = _MouseY

    If mx > Menu(ActiveMenu).xPos And mx < Menu(ActiveMenu).xPos + Menu(ActiveMenu).width Then 'the mouse is inside the x bounds of our menu
        If my > Menu(ActiveMenu).yPos And my < Menu(ActiveMenu).yPos + Menu(ActiveMenu).height Then 'the mouse is inside the y bounts of our menu
            MouseOverActiveMenu = -1
        End If
    End If
End Function

Function CheckMenu (k) 'pass this your current keyhit value.
    'Checkmenu doesn't actually update or pull info from any buffers itself.  You'll need to get your keystate values elsewhere.
    'as well as have your While _MouseInput: Wend routine elsewhere in your code.

    Static omb, omb2
    mb = _MouseButton(1): mb2 = _MouseButton(2)
    mx = _MouseX: my = _MouseY



    If MouseOverActiveMenu Then
        If Menu(ActiveMenu).Active = 0 Then 'if the menu is unactive and we click on it, make it active
            If mb And Not omb Then SetMenuActive ActiveMenu, -1
        Else 'the menu is already active.  Check to see if we clicked on something
            If Menu(ActiveMenu).layout Then
                If mb And Not omb Then CheckMenu = MenuHover: SetMenuActive ActiveMenu, 0: Exit Function
            Else
                Print "WORK IN PROGRESS"
            End If
        End If

        If Menu(ActiveMenu).layout Then
            If Menu(ActiveMenu).Active Then MenuHover = (my - Menu(ActiveMenu).yPos) \ _FontHeight + 1 Else MenuHover = 0
        Else

        End If
    Else
        If mb And Not omb Then 'clicked outside the active menu
            MenuHover = 0: SetMenuActive ActiveMenu, 0
        End If
    End If
    omb = mb: omb2 = mb2
End Function


Sub Drawmenus
    DC&& = _DefaultColor: BG&& = _BackgroundColor
    Color Black, 0
    For i = 1 To 100
        If Menu(i).inUse And Menu(i).Visible Then
            xp = Menu(i).xPos: yp = Menu(i).yPos
            Line (xp, yp)-Step(Menu(i).width, Menu(i).height), DarkGray, BF
            For j = 1 To Menu(i).totalChoices
                If j = MenuHover Then Color LightGray, Black Else Color Black, 0
                _PrintString (xp + MenuChoice(i, j).xOffset, yp + MenuChoice(i, j).yOffset), MenuChoice(i, j).Name
                h = MenuChoice(i, j).HighLight
                If h <> 0 And Menu(i).Active = -1 Then
                    Color White, 0
                    _PrintString (xp + MenuChoice(i, j).xOffset + (h - 1) * _FontWidth, yp + MenuChoice(i, j).yOffset), Mid$(MenuChoice(i, j).Name, MenuChoice(i, j).HighLight, 1)
                End If
            Next
            If Menu(i).Active = 0 Then Line (xp, yp)-Step(Menu(i).width, Menu(i).height), &H33000000&&, BF
        End If
    Next
    Color DC&&, BG&&
End Sub

Sub SetMenuPos (whichMenu, xPos, yPos)
    Menu(whichMenu).xPos = xPos
    Menu(whichMenu).yPos = yPos
End Sub

Sub SetMenuVisibility (whichMenu, visible)
    Menu(whichMenu).Visible = visible
End Sub

Function DefineMenu (choices$, layout) 'layout 0 for left-right, anything else for up-down
    'first, check for a free menu handle
    For i = 1 To 100
        If Menu(i).inUse = 0 Then Exit For
    Next
    If i > 100 Then Exit Function 'return a value of 0 as we have no available menus

    MIU = i 'Menu in Use


    'parse choices$
    Dim item(1000) As String
    c$ = choices$
    maxWidth = 0
    Do
        count = count + 1
        i = InStr(c$, Chr$(0))
        If i Then
            item(count) = " " + Left$(c$, i - 1) + " "
            c$ = Mid$(c$, i + 1)
        Else
            item(count) = " " + c$ + " "
        End If
        L = Len(item(count))
        If InStr(item(count), "#") Then L = L - 1
        If L > maxWidth Then maxWidth = L
    Loop Until i = 0 Or c$ = ""

    Menu(MIU).inUse = -1
    Menu(MIU).totalChoices = count
    Menu(MIU).xPos = 0 'can set these later
    Menu(MIU).yPos = 0
    If layout Then 'vertical menu
        Menu(MIU).layout = -1
        Menu(MIU).width = maxWidth * _FontWidth
        Menu(MIU).height = count * _FontHeight
    Else 'hortizontal menu
        Menu(MIU).layout = 0
        Menu(MIU).height = _FontHeight
    End If
    Menu(MIU).Active = 0
    Menu(MIU).Visible = 0

    For i = 1 To count
        L = InStr(item(i), "#")
        If L Then
            MenuChoice(MIU, i).HighLight = L
            item(i) = Left$(item(i), L - 1) + Mid$(item(i), L + 1)
        End If
        MenuChoice(MIU, i).Name = item(i)
        MenuChoice(MIU, i).Active = -1
        If layout Then 'vertical
            MenuChoice(MIU, i).xOffset = 0
            MenuChoice(MIU, i).yOffset = (i - 1) * _FontHeight
            MenuChoice(MIU, i).width = Len(item(i)) * _FontWidth
        Else 'hortizontal
            MenuChoice(MIU, i).xOffset = wide
            MenuChoice(MIU, i).yOffset = 0
            wide = wide + Len(item(i)) * _FontWidth
            MenuChoice(MIU, i).width = Len(item(i)) * _FontWidth
            Menu(MIU).width = wide
        End If
        MenuChoice(MIU, i).height = _FontHeight
    Next
    DefineMenu = MIU
End Function


Note:  I've always enjoyed Terry Ritchie's menu library, but it does one thing which doesn't always play nice with my code:  It monopolizes the keyboard and mouse while active.  This menu system is being built upon the base principal of NOT doing that, so you're going to have to pass it keycodes and update your mouse buffers elsewhere in your code for this to work properly.  (Or at all, honestly. Tongue )

Alt-M has now been added to the demo as a way to turn our menu active or inactive.
Mouse click on the inactive menu to make it active.
Move mouse up or down to watch our highlighted choice change to stay current with the mouse.
Click the mouse with the pointer in the menu, and with the menu active, and get a selection!
Click the mouse outside the menu, and the menu goes inactive without a selection.


Keyboard support is still forthcoming. (So far, ALT-M is the only stroke keyed into the program.)
Horizontal layout is still forthcoming.  (We can draw them, but we can't interact with them yet.)

Still definitely a work-in-progress, but it's inching forward into something usable every so slowly!  Wink
Reply


Messages In This Thread
EVMS -- Easy Versatile Menu System - by SMcNeill - 11-24-2022, 10:55 PM
RE: EVMS -- Easy Versatile Menu System - by SMcNeill - 11-25-2022, 04:43 AM



Users browsing this thread: 1 Guest(s)