+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Games (https://qb64phoenix.com/forum/forumdisplay.php?fid=57)
+---- Thread: RocoLoco - Row & Column math puzzle game. (/showthread.php?tid=2767)
RocoLoco - Row & Column math puzzle game. - Dav - 06-02-2024
RocoLoco is a math puzzle game where you make the rows & columns of numbers in the red inside grid add up the total amount on the edges. Click the red numbers on/off. When the row/column adds up correct, the edge total number will turn on white. Goal is to make the grid numbers all add up correct so all edge numbers are lit up at the same time.
Grid size increases with each level. You can jump to other levels by using the +/- keys. Press H for help menu. ESC quits.
- Dav
Code: (Select All)
'============
'RoCoLoco.bas v2.0
'============
'Row & Column number adding puzzle game.
'Based on popular math game found online.
'Coded by Dav for QB64-PE, Nov/2022
'New for v2: * Playing board now adapts to users desktop size.
' It should displays the same on every screen.
' (Screen size is not hardcoded to specific size)
' * No longer uses external .jpg images for numbers.
' * Change grid size using the +/- keys.
' * Added HELP screen (not much) - press H for it.
' * Added some cheap sound effects.
'
'~~~~~~~~~~~
'HOW TO PLAY:
'Click numbers inside the grid to turn them on/off.
'Each row/column of red number totals must add up to the number
'on the edge of the grid. When they do, the edge numbers will
'turn on too. You must tun on all the edge numbers to solve it.
'
'~~~~~~~~
'CONTROLS:
'
'You can change the grid size anytime by using +/- keys.
'H = Show a simple help screen
'SPACE = Generate a new puzzle grid
'ESC = Quits game
'============================================================
ReDim Shared grid, tiles
'defaults....
grid = 6 '4x4 grid size (4 for inside tiles, 2 for edges = 6)
gridmax = 15
'===
top:
'===
_Title "RoCoLoco - Working..."
tiles = grid * grid ' total number of tiles on board
Screen _NewImage(_DesktopHeight * .80, _DesktopHeight * .80, 32)
tilesize = (_DesktopHeight * .80) / grid
Cls , _RGB(77, 77, 77)
ReDim Shared tilev(tiles) 'make array for all titles values
ReDim Shared tilef(tiles) 'make array for flag if tile is on/off
ReDim Shared tilex(tiles), tiley(tiles) 'x/y positions for tiles
Randomize Timer 'set random seed
'init x/y values for drawing tiles
bc = 1
For x = 1 To grid
For y = 1 To grid
tilex(bc) = (x * tilesize) - tilesize: tiley(bc) = (y * tilesize) - tilesize
tilev(bc) = Int(Rnd * 9 + 1) '<<< for testing only, give all some data
bc = bc + 1
Next
Next
SCRAMTIME = Timer
'==========
regenerate:
'==========
Sound 500 + Rnd * 1000, 1
'generate random tile value and on/off settings
T = grid + 2
For y = 2 To grid - 1
regeneratex:
makesurex = 0: thold = T
For x = 2 To grid - 1
tilev(thold) = Int(Rnd * 5 + 1) 'make random number, from 1-5
If Int(Rnd * grid - (Int(Rnd * 1.5))) = 0 Then
tilef(thold) = 0 'randomly turn tile on/off
makesurex = 1 'make sure at least one out on this column
Else
tilef(thold) = 1
End If
'show something while computing...
Line (tilex(thold), tiley(thold))-(tilex(thold) + tilesize, tiley(thold) + tilesize), _RGB(255, 100, 100), BF
PPRINT tilex(thold) + (tilesize / 1.8), tiley(thold) + (tilesize / 4.5), tilesize / 2, _RGB(255, 255, 255), 0, LTrim$(Str$(tilev(thold)))
thold = thold + 1
Next
'if row didnt have one turned off, do this column over...
If makesurex = 0 Then GoTo regeneratex
T = thold + 2
_Limit 10 * grid 'slow down, let's see it.
Next
'now check rows left to right for on/off, if none off, regenerate
For x = 0 To grid - 3
makesurex = 0
For y = grid + 2 To (grid * grid) - grid - 2 Step grid
If tilef(y + x) = 0 Then makesurex = 1
Next
If makesurex = 0 Then GoTo regenerate
Next
If Timer < (SCRAMTIME + 1) Then GoTo regenerate
'compute left/right edges totals
For y = 0 To grid - 3
total = 0
For x = grid + 2 To (grid * grid) - grid - 2 Step grid
If tilef(y + x) = 1 Then
total = total + tilev(y + x)
End If
Next
tilev(y + x) = total 'set total data to tile
Next
'compute top/bottom edges
For x = grid + 2 To (grid * grid) - grid - 2 Step grid
total = 0
For y = 0 To grid - 3
If tilef(y + x) = 1 Then
total = total + tilev(y + x)
End If
Next
tilev(y + x) = total
Next
'Lastly, mark all inside grid tiles as on, hiding generated solution.
For T = grid + 2 To (grid * grid) - grid - 1
'skip the outside rows
For tt = 1 To grid * grid Step grid
If T = tt Then GoTo skipmark
If T = tt + (grid - 1) Then GoTo skipmark
Next
tilef(T) = 1
skipmark:
Next
GoSub RedrawBoard
tit$ = "RoCoLoco" + Str$(grid - 2) + "x" + LTrim$(Str$(grid - 2)) + " | H = Help"
_Title tit$
_Icon _Display
Do
'wait until mouse button up to continue
While _MouseButton(1) <> 0: n = _MouseInput: Wend
trap = _MouseInput
If _MouseButton(1) Then
mx = _MouseX: my = _MouseY
'cycle through tiles
For T = grid + 2 To (grid * grid) - grid - 1
'skip the outside rows
For tt = 1 To grid * grid Step grid
If T = tt Then GoTo skip
If T = tt + (grid - 1) Then GoTo skip
Next
tx = tilex(T): tx2 = tilex(T) + tilesize
ty = tiley(T): ty2 = tiley(T) + tilesize
If mx >= tx And mx <= tx2 Then
If my >= ty And my <= ty2 Then
If tilef(T) = 0 Then
tilef(T) = 1: 'mark it on
Sound 2500, .1
Else
tilef(T) = 0: 'mark it off
Sound 2000, .1
End If
GoSub RedrawBoard
'check for win
End If
End If
skip:
Next
End If
k$ = UCase$(InKey$)
If k$ <> "" Then
'ESC key quits
If k$ = Chr$(27) Then System
'space key generates new board
If k$ = " " Then GoTo top
If k$ = "+" Then
If grid < 15 Then grid = grid + 1: GoTo top
End If
If k$ = "-" Then
If grid > 5 Then grid = grid - 1: GoTo top
End If
If k$ = "H" Then
back& = _CopyImage(_Display)
Cls , _RGB(77, 77, 77)
ps = (_DesktopHeight * .80) / 5
PPRINT ps / 2 + 2, ps / 3 + 2, ps / 3, _RGB(255, 255, 255), 0, "ROCOLOCO HELP"
PPRINT ps / 2, ps / 3, ps / 3, _RGB(255, 100, 100), 0, "ROCOLOCO HELP"
PPRINT ps / 2, (ps / 3) * 3, ps / 6, _RGB(196, 196, 196), 0, "Click on the numbers to"
PPRINT ps / 2, (ps / 3) * 4, ps / 6, _RGB(196, 196, 196), 0, "turn them On or Off."
PPRINT ps / 2, (ps / 3) * 5, ps / 6, _RGB(196, 196, 196), 0, "Rows And Columns must"
PPRINT ps / 2, (ps / 3) * 6, ps / 6, _RGB(196, 196, 196), 0, "add up to the number on"
PPRINT ps / 2, (ps / 3) * 7, ps / 6, _RGB(196, 196, 196), 0, "the edges. When correct,"
PPRINT ps / 2, (ps / 3) * 8, ps / 6, _RGB(196, 196, 196), 0, "edges will turn white."
PPRINT ps / 2, (ps / 3) * 9, ps / 6, _RGB(196, 196, 196), 0, "Make all edges white to"
PPRINT ps / 2, (ps / 3) * 10, ps / 6, _RGB(196, 196, 196), 0, "solve the math puzzle."
PPRINT ps / 2, (ps / 3) * 11, ps / 6, _RGB(196, 196, 196), 0, "Use +/- keys to change"
PPRINT ps / 2, (ps / 3) * 12, ps / 6, _RGB(196, 196, 196), 0, "the size of the grid."
PPRINT ps / 2, (ps / 3) * 14, ps / 6, _RGB(255, 255, 255), 0, " - PRESS ANY KEY - "
A$ = Input$(1)
_PutImage (0, 0), back&
_FreeImage back&
End If
End If
Loop
End
'========================================================================================
RedrawBoard:
'===========
win = 1
'Draw inside grid numbers first
For d = grid + 2 To (grid * grid) - grid - 1
'skiping the outside rows
For dd = 1 To grid * grid Step grid
If d = dd Then GoTo skipit
If d = dd + (grid - 1) Then GoTo skipit
Next
If tilef(d) = 1 Then
'on
Line (tilex(d), tiley(d))-(tilex(d) + tilesize, tiley(d) + tilesize), _RGB(255, 100, 100), BF
PPRINT tilex(d) + (tilesize / 1.8), tiley(d) + (tilesize / 4.5), tilesize / 2, _RGB(255, 255, 255), 0, LTrim$(Str$(tilev(d)))
Else
'off
Line (tilex(d), tiley(d))-(tilex(d) + tilesize, tiley(d) + tilesize), _RGB(77, 77, 77), BF
PPRINT tilex(d) + (tilesize / 1.8), tiley(d) + (tilesize / 4.5), tilesize / 2, _RGB(96, 96, 96), 0, LTrim$(Str$(tilev(d)))
End If
skipit:
Next
'compute and draw left/right edges
For y = 0 To grid - 3
total = 0
For x = grid + 2 To (grid * grid) - grid - 2 Step grid
If tilef(y + x) = 1 Then
total = total + tilev(y + x)
End If
Next
If tilev(y + x) = total Then
'if total match, highlight it
Line (tilex(y + x), tiley(y + x))-(tilex(y + x) + tilesize, tiley(y + x) + tilesize), _RGB(255, 255, 255), BF 'right side
If Len(LTrim$(Str$(tilev(y + x)))) = 2 Then
PPRINT tilex(y + x) + (tilesize / 2.5), tiley(y + x) + (tilesize / 3.2), tilesize / 3, _RGB(32, 32, 32), 0, LTrim$(Str$(tilev(y + x)))
Else
PPRINT tilex(y + x) + (tilesize / 1.7), tiley(y + x) + (tilesize / 3.2), tilesize / 3, _RGB(32, 32, 32), 0, LTrim$(Str$(tilev(y + x)))
End If
Line (tilex(y + x) - (tilex(y + x)), tiley(y + x))-((tilex(y + x) - (tilex(y + x))) + tilesize, tiley(y + x) + tilesize), _RGB(255, 255, 255), BF 'left side
If Len(LTrim$(Str$(tilev(y + x)))) = 2 Then
PPRINT tilex(y + x) - tilex(y + x) + (tilesize / 2.5), tiley(y + x) + (tilesize / 3.2), tilesize / 3, _RGB(32, 32, 32), 0, LTrim$(Str$(tilev(y + x)))
Else
PPRINT tilex(y + x) - tilex(y + x) + (tilesize / 1.7), tiley(y + x) + (tilesize / 3.2), tilesize / 3, _RGB(32, 32, 32), 0, LTrim$(Str$(tilev(y + x)))
End If
Else
'total doesnt match, don't highlight edge
win = 0
Line (tilex(y + x), tiley(y + x))-(tilex(y + x) + tilesize, tiley(y + x) + tilesize), _RGB(77, 77, 77), BF 'right side
Line (tilex(y + x), tiley(y + x))-(tilex(y + x) + tilesize, tiley(y + x) + tilesize), _RGB(196, 196, 196), B 'right side
If Len(LTrim$(Str$(tilev(y + x)))) = 2 Then
PPRINT tilex(y + x) + (tilesize / 2.5), tiley(y + x) + (tilesize / 3.2), tilesize / 3, _RGB(196, 196, 196), 0, LTrim$(Str$(tilev(y + x)))
Else
PPRINT tilex(y + x) + (tilesize / 1.7), tiley(y + x) + (tilesize / 3.2), tilesize / 3, _RGB(195, 196, 196), 0, LTrim$(Str$(tilev(y + x)))
End If
Line (tilex(y + x) - (tilex(y + x)), tiley(y + x))-((tilex(y + x) - (tilex(y + x))) + tilesize, tiley(y + x) + tilesize), _RGB(77, 77, 77), BF 'left side
Line (tilex(y + x) - (tilex(y + x)), tiley(y + x))-((tilex(y + x) - (tilex(y + x))) + tilesize, tiley(y + x) + tilesize), _RGB(196, 196, 196), B 'left side
If Len(LTrim$(Str$(tilev(y + x)))) = 2 Then
PPRINT tilex(y + x) - tilex(y + x) + (tilesize / 2.5), tiley(y + x) + (tilesize / 3.2), tilesize / 3, _RGB(196, 196, 196), 0, LTrim$(Str$(tilev(y + x)))
Else
PPRINT tilex(y + x) - tilex(y + x) + (tilesize / 1.7), tiley(y + x) + (tilesize / 3.2), tilesize / 3, _RGB(196, 196, 196), 0, LTrim$(Str$(tilev(y + x)))
End If
End If
Next
'compute and draw top/bottom edges
For x = grid + 2 To (grid * grid) - grid - 2 Step grid
total = 0
For y = 0 To grid - 3
If tilef(y + x) = 1 Then
total = total + tilev(y + x)
End If
Next
If tilev(y + x) = total Then
'total matches, hight top/bottom
Line (tilex(y + x), tiley(y + x))-(tilex(y + x) + tilesize, tiley(y + x) + tilesize), _RGB(255, 255, 255), BF 'bottom
If Len(LTrim$(Str$(tilev(y + x)))) = 2 Then
PPRINT tilex(y + x) + (tilesize / 2.5), tiley(y + x) + (tilesize / 3.2), tilesize / 3, _RGB(32, 32, 32), 0, LTrim$(Str$(tilev(y + x)))
Else
PPRINT tilex(y + x) + (tilesize / 1.7), tiley(y + x) + (tilesize / 3.2), tilesize / 3, _RGB(32, 32, 32), 0, LTrim$(Str$(tilev(y + x)))
End If
Line (tilex(y + x), tiley(y + x) - tiley(y + x))-(tilex(y + x) + tilesize, (tiley(y + x) - tiley(y + x)) + tilesize), _RGB(255, 255, 255), BF 'top
If Len(LTrim$(Str$(tilev(y + x)))) = 2 Then
PPRINT tilex(y + x) + (tilesize / 2.5), tiley(y + x) - tiley(y + x) + (tilesize / 3.2), tilesize / 3, _RGB(32, 32, 32), 0, LTrim$(Str$(tilev(y + x)))
Else
PPRINT tilex(y + x) + (tilesize / 1.7), tiley(y + x) - tiley(y + x) + (tilesize / 3.2), tilesize / 3, _RGB(32, 32, 32), 0, LTrim$(Str$(tilev(y + x)))
End If
Else
'doesnt' match, dont hightlight top/bottom edges
win = 0
Line (tilex(y + x), tiley(y + x))-(tilex(y + x) + tilesize, tiley(y + x) + tilesize), _RGB(77, 77, 77), BF 'bottom
Line (tilex(y + x), tiley(y + x))-(tilex(y + x) + tilesize, tiley(y + x) + tilesize), _RGB(196, 196, 196), B 'bottom
If Len(LTrim$(Str$(tilev(y + x)))) = 2 Then
PPRINT tilex(y + x) + (tilesize / 2.5), tiley(y + x) + (tilesize / 3.2), tilesize / 3, _RGB(196, 196, 196), 0, LTrim$(Str$(tilev(y + x)))
Else
PPRINT tilex(y + x) + (tilesize / 1.7), tiley(y + x) + (tilesize / 3.2), tilesize / 3, _RGB(196, 196, 196), 0, LTrim$(Str$(tilev(y + x)))
End If
Line (tilex(y + x), tiley(y + x) - tiley(y + x))-(tilex(y + x) + tilesize, (tiley(y + x) - tiley(y + x)) + tilesize), _RGB(77, 77, 77), BF 'top
Line (tilex(y + x), tiley(y + x) - tiley(y + x))-(tilex(y + x) + tilesize, (tiley(y + x) - tiley(y + x)) + tilesize), _RGB(196, 196, 196), B 'top
If Len(LTrim$(Str$(tilev(y + x)))) = 2 Then
PPRINT tilex(y + x) + (tilesize / 2.5), tiley(y + x) - tiley(y + x) + (tilesize / 3.2), tilesize / 3, _RGB(196, 196, 196), 0, LTrim$(Str$(tilev(y + x)))
Else
PPRINT tilex(y + x) + (tilesize / 1.7), tiley(y + x) - tiley(y + x) + (tilesize / 3.2), tilesize / 3, _RGB(196, 196, 196), 0, LTrim$(Str$(tilev(y + x)))
End If
End If
Next
'see if puzzle completed
If win = 1 Then
Play "mbl16o2cdedefgabagfedc"
'remove unused numbers
For T = grid + 2 To (grid * grid) - grid - 1
'skip the outside rows
For tt = 1 To grid * grid Step grid
If T = tt Then GoTo skipcheck
If T = tt + (grid - 1) Then GoTo skipcheck
Next
If tilef(T) = 0 Then
Line (tilex(T), tiley(T))-(tilex(T) + tilesize, tiley(T) + tilesize), _RGB(77, 77, 77), BF
End If
skipcheck:
Next
_Delay 5
If grid < 15 Then grid = grid + 1
GoTo top
End If
Return
Sub PPRINT (x, y, SquareSize, clr&, trans&, text$)
orig& = _Dest
bit = 32: If _PixelSize(0) = 1 Then bit = 256
For t = 0 To Len(text$) - 1
pprintimg& = _NewImage(16, 16, bit)
_Dest pprintimg&
Cls , trans&: Color clr&
Print Mid$(text$, t + 1, 1);
_ClearColor _RGB(0, 0, 0), pprintimg&
_Dest orig&
x1 = x + (t * SquareSize): x2 = x1 + SquareSize
y1 = y: y2 = y + SquareSize
_PutImage (x1 - (SquareSize / 2), y1)-(x2, y2 + (SquareSize / 3)), pprintimg&
_FreeImage pprintimg&
Next
End SubRE: RocoLoco - Row & Column math puzzle game. - bplus - 06-03-2024
sudoku look out!
RE: RocoLoco - Row & Column math puzzle game. - marbac74 - 06-03-2024
Nice game!
RE: RocoLoco - Row & Column math puzzle game. - Dav - 06-07-2024
Thanks, @marbac74!
@bplus: Sudoku is probably my favorite number puzzle. I made one in QB64 but was too ashamed of the messy code to post it.
It was *really* fun to figure out how to make however. I didn't study other sources and kind of brute-forced my way through making an error checking. Maybe I will clean it up and post it anyway. Mine can't hold a candle to Yours.- Dav