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 FunctionButtons make a good start to a Do-It-Yourself GUI tool kit.
b = b + ...