Recall - a memory - test game

[PhilOfPerth]

Memory Plus Match

I have memory game that combines with match game of Basic coding "words" or symbol pairs eg if you see x then match is y, select's match is case, do match is loop, dim match as,... might want to read through pairs so no surprises. This does use mouse. Matching adds another level to the fight against Alzheimer's but to me coding itself is even better protection!

Code: (Select All)

Option _Explicit
DefInt A-Z
Randomize Timer
_Title "Word Memory Game" '  by bplus started 2019-07-24
'This is to extend Memory Series to words and test further Button tools.
'Along with testing button tools there is an experiment here to see if 2 word pairs that make sense
'are easier to remember than match A with N and Z with M..., rather arbitrary pairings we did in last game.

Rem +inder: Button Memory Game
' The goal here is 2 Fold:
'   Broaden the Memory Game series to more than letters,
'   And develop some potential button library procedures.
' 1. Button Type
' 2. Button Draw
' 3. Buttons Layout  'setup a whole keypad of buttons, assuming base 1 for first index
' 4. ButtonIndexClicked  'get the button index clicked, assuming base 1 for first index

' ============== Instructions: ========================================================
'This game uses QB64 keywords or symbols that have complementary word or symbol.
'Some are obvious no brainers like WHILE is paired with WEND, ( with ) and IF with THEN.
'Some might might not occur to you, eg I have DIM and AS matched up, see data statements below.


'1. Button Type common to all buttons
Type ButtonType
    X As Integer
    Y As Integer
    W As Integer
    H As Integer
    FC As _Unsigned Long 'fore color is the color of anything printed
    BC As _Unsigned Long 'back color  is the color of button
    L As String 'label
    IMG As Long 'image handle
    O As Integer 'O stands for On or Off reveal string/img of button function or keep hidden
End Type

Const xmax = 800, ymax = 500, sbc = &HFF005500, sfc = &HFFAAAADD 'screen stuff
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 360, 60
ReDim Shared Btn(1 To 1) As ButtonType, nBtns 'so setup can set values to these globals
ReDim Shared shuffle(1 To 1) As String 'container of strings from data
Dim Shared nRevealed
Dim i, s$, b1Index, b2Index, tStart!, clickCnt

Color sfc, sbc: Cls
setUpGame
While 1
    tStart! = Timer(.001)
    initRound
    updateScreen
    Do
        i = ButtonIndexClicked
        If i Then 'reveals, click counts only count if they are revealing
            If b1Index = 0 Then 'first reveal box
                If Btn(i).O <> -1 Then b1Index = i: Btn(i).O = -1: clickCnt = clickCnt + 1
            Else '2nd reveal box
                If Btn(i).O <> -1 Then b2Index = i: Btn(i).O = -1: clickCnt = clickCnt + 1
            End If
            updateScreen
        End If
        If b2Index <> 0 Then 'check pair, if they are a matched pair leave them revealed
            If Match(Btn(b1Index).L, Btn(b2Index).L) = 0 Then 'no match
                _Delay 1
                Btn(b1Index).O = 0: Btn(b2Index).O = 0
                nRevealed = nRevealed - 2 'when complete = number of squares then done
                updateScreen
            End If
            b1Index = 0: b2Index = 0 'clear box clicks
        End If
        _Limit 60
    Loop Until nRevealed = nBtns
    s$ = "Completed in" + Str$(Int(Timer(.001) - tStart!)) + " secs and" + Str$(clickCnt) + " clicks."
    Locate 3, (xmax / 8 - Len(s$)) / 2: Print s$
    _Delay 7
Wend

matchData:
Data "IF THEN","DO LOOP","WHILE WEND","( )","SUB FUNCTION","SELECT CASE","OPTION _EXPLICIT","FOR NEXT"
Data "INPUT OUTPUT","X Y","LEFT$ RIGHT$","DIM AS","HELLO WORLD","CSRLIN POS","SIN COS"

Function Match (s1$, s2$)
    Dim i, pair$
    Restore matchData
    For i = 1 To 15
        Read pair$:
        If leftOf$(pair$, " ") = s1$ Then
            If rightOf$(pair$, " ") = s2$ Then Match = -1: Exit Function
        Else
            If leftOf$(pair$, " ") = s2$ Then
                If rightOf$(pair$, " ") = s1$ Then Match = -1: Exit Function
            End If
        End If
    Next
End Function

Sub updateScreen
    Dim i
    Cls: nRevealed = 0 '              (shared) detect how many boxes are revealed
    For i = 1 To nBtns
        DrawButton (i)
        If Btn(i).O Then nRevealed = nRevealed + 1
    Next
End Sub

Sub initRound 'reassign letters and hide them all
    Dim i, r
    For i = nBtns To 2 Step -1 ' shuffle stuff in array
        r = Int(i * Rnd) + 1
        Swap shuffle(i), shuffle(r)
    Next
    For i = 1 To nBtns '       reset or reassign values
        Btn(i).L = shuffle(i): Btn(i).O = 0
    Next
End Sub

Sub setUpGame
    Dim i, pair$ '(main) CONST xmax = 800, ymax = 300, boxSize = 50
    Const xBtns = 5, yBtns = 6 ' Board N x M  across, down
    Const spacer = 10 ' space between buttons VVVV sets SHARED nBtns needed in lines after call
    LayoutButtons 0, 0, xmax, ymax, 100, 50, xBtns, yBtns, spacer, &HFFAAAAFF, &HFF000088
    ReDim shuffle(1 To nBtns) As String ' load shuffle array for shuffling later (SHARED)
    For i = 1 To nBtns Step 2 'load shuffle with words/symbol pairs
        Read pair$
        shuffle(i) = leftOf$(pair$, " "): shuffle(i + 1) = rightOf$(pair$, " ")
    Next
End Sub

'2. Button draw for the index of an array Btn() of ButtonType's, assuming standard default font
Sub DrawButton (index As Integer)
    Dim dc As _Unsigned Long, dbc As _Unsigned Long, ox, oy, s$
    dc = _DefaultColor: dbc = _BackgroundColor
    Line (Btn(index).X, Btn(index).Y)-Step(Btn(index).W, Btn(index).H), &HFF000000, BF
    Line (Btn(index).X, Btn(index).Y)-Step(Btn(index).W - 3, Btn(index).H - 3), &HFFFFFFFF, BF
    Line (Btn(index).X + 1, Btn(index).Y + 1)-Step(Btn(index).W - 3, Btn(index).H - 3), Btn(index).BC, BF
    If Btn(index).O Then
        If 8 * Len(Btn(index).L) > Btn(index).W - 4 Then 'string is too long for button
            s$ = Mid$(Btn(index).L, 1, Int((Btn(index).W - 4) / 8)) 'fit part of string into button
            ox = 2
        Else
            s$ = Btn(index).L: ox = (Btn(index).W - 8 * Len(Btn(index).L)) \ 2
        End If
        oy = (Btn(index).H - 16) \ 2
        Color &HFF000000, &H0
        _PrintString (Btn(index).X + ox - 1, Btn(index).Y + oy - 1), s$
        Color Btn(index).FC
        _PrintString (Btn(index).X + ox, Btn(index).Y + oy), s$
        Color dc, dbc
    End If
End Sub

' 3. Layout buttons
' this sub will setup button locations for shared Btn() as ButtonType with first button index = 1
' also shared is nBtns whic will set/reset here
SUB LayoutButtons (areaX AS INTEGER, areaY AS INTEGER, areaW AS INTEGER, areaH AS INTEGER, btnW, btnH,_
    BtnsAcross, BtnsDown, spacer, Fore AS _UNSIGNED LONG, Back AS _UNSIGNED LONG)
    Dim xoffset, yoffset, xx, yy, xSide, ySide, i
    nBtns = BtnsAcross * BtnsDown '               Total btns (shared) in main declares section
    ReDim Btn(1 To nBtns) As ButtonType '     ready to rec data (shared) in main declares section
    xoffset = Int((areaW - btnW * BtnsAcross - spacer * (BtnsAcross - 1)) / 2) + areaX
    yoffset = Int((areaH - btnH * BtnsDown - spacer * (BtnsDown - 1)) / 2) + areaY
    xSide = btnW + spacer: ySide = btnH + spacer
    For yy = 1 To BtnsDown '                    set screen XY locations for all boxes
        For xx = 1 To BtnsAcross
            i = i + 1
            Btn(i).X = xoffset + (xx - 1) * xSide
            Btn(i).Y = yoffset + (yy - 1) * ySide
            Btn(i).W = btnW
            Btn(i).H = btnH
            Btn(i).FC = Fore
            Btn(i).BC = Back
        Next
    Next
End Sub

'4. Button Index Clicked
Function ButtonIndexClicked
    Dim m, mx, my, mb, i
    While _MouseInput: Wend
    mb = _MouseButton(1) '            left button down
    If mb Then '                      get last place mouse button was down
        While mb '                    wait for mouse button release as a "click"
            m = _MouseInput: mb = _MouseButton(1): mx = _MouseX: my = _MouseY
        Wend
        For i = 1 To nBtns '         now find which box was clicked
            If mx > Btn(i).X And mx < Btn(i).X + Btn(i).W Then
                If my > Btn(i).Y And my < Btn(i).Y + Btn(i).H Then
                    ButtonIndexClicked = i: Exit Function
                End If
            End If
        Next
    End If
End Function

'old tools from toolbox
Function leftOf$ (source$, of$)
    If InStr(source$, of$) > 0 Then leftOf$ = Mid$(source$, 1, InStr(source$, of$) - 1)
End Function

Function rightOf$ (source$, of$)
    If InStr(source$, of$) > 0 Then rightOf$ = Mid$(source$, InStr(source$, of$) + Len(of$))
End Function

Buttons make a good start to a Do-It-Yourself GUI tool kit.

That's nice! I like how it helps build up the pairing skills for writing code. But what about triple-bungers like IF - THEN - Else? Could it include an option for selecting three? Just a thought... Anyway, good job. I learned a few things.