+- 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: Classic 15 puzzle (/showthread.php?tid=3121)
Classic 15 puzzle - Dav - 10-14-2024
Here's the classic 15 puzzle game in QB64. Use arrows to move numbers to the empty place. Put numbers in order 1 to 15 to solve puzzle. Uses the handy Text SUB by @bplus for the big numbers.
- Dav
Code: (Select All)
'============
'15puzzle.bas
'============
'The classic 15 puzzle game in QB64.
'By Dav, OCT/2024
'Use arrows to move numbers to the empty place.
'Put numbers in order 1 to 15 to solve puzzle.
'Text SUB made by bplus (thanks bplus!)
Randomize Timer
dh = Int(_DesktopHeight * .75) 'scale board to 75% of users desktop height
Screen _NewImage(dh, dh, 32)
Dim board(4, 4) '4x4 board
'=== init board
Dim num(15) '15 random numbers
For n = 0 To 14
num(n) = n + 1
Next: num(15) = 0 'this one is empty
For b = 1 To 500 'shuffle
Swap num(Int(Rnd * 15)), num(15)
Next
b = 0 'assign on the board
For row = 0 To 4 - 1
For col = 0 To 4 - 1
board(row, col) = num(b)
If board(row, col) = 0 Then
emptyrow = row: emptycol = col
End If
b = b + 1
Next
Next
GoSub DrawBoard
'=== main loop
Do
'=== get user input
Do
key$ = InKey$: _Limit 30
Loop Until key$ <> ""
Select Case key$
Case Chr$(0) + Chr$(72) 'up
If emptyrow < 4 - 1 Then
board(emptyrow, emptycol) = board(emptyrow + 1, emptycol)
board(emptyrow + 1, emptycol) = 0
emptyrow = emptyrow + 1
End If
Case Chr$(0) + Chr$(80) 'down
If emptyrow > 0 Then
board(emptyrow, emptycol) = board(emptyrow - 1, emptycol)
board(emptyrow - 1, emptycol) = 0
emptyrow = emptyrow - 1
End If
Case Chr$(0) + Chr$(75) 'left
If emptycol < 4 - 1 Then
board(emptyrow, emptycol) = board(emptyrow, emptycol + 1)
board(emptyrow, emptycol + 1) = 0
emptycol = emptycol + 1
End If
Case Chr$(0) + Chr$(77) 'right
If emptycol > 0 Then
board(emptyrow, emptycol) = board(emptyrow, emptycol - 1)
board(emptyrow, emptycol - 1) = 0
emptycol = emptycol - 1
End If
Case Chr$(27) 'quit
End
End Select
GoSub DrawBoard
'== check if puzzle solved
solved = 1: tally = 1
For row = 0 To 4 - 1
For col = 0 To 4 - 1
If board(row, col) <> 0 Then
If board(row, col) <> tally Then solved = 0
tally = tally + 1
End If
Next
Next
If solved = 1 Then Exit Do
Loop
GoSub DrawBoard
Line (0, 0)-(_Width, _Height), _RGBA(0, 0, 0, 150), BF
Text _Width / 4 + 2, _Height / 3 + 2, _Width / 8, _RGB(0, 0, 0), "SOLVED!!"
Text _Width / 4, _Height / 3, _Width / 8, _RGB(255, 255, 0), "SOLVED!!"
_Display
End
'========
DrawBoard:
'========
size = _Width / 4
For row = 0 To 4 - 1
For col = 0 To 4 - 1
x1 = (col * size): x2 = x1 + size
y1 = (row * size): y2 = y1 + size
If board(row, col) = 0 Then
Line (x1, y1)-(x2, y2), _RGB(0, 0, 0), BF
Else
Line (x1, y1)-(x2, y2), _RGB(200, 0, 0), BF
Line (x1, y1)-(x2, y2), _RGB(0, 0, 0), B
p$ = _Trim$(Str$(board(row, col)))
If Len(p$) = 1 Then x1 = x1 + (size / 4)
Text x1 + 2, y1 + 2, size, _RGB(0, 0, 0), p$
Text x1, y1, size, _RGB(255, 255, 255), p$
End If
Next
Next
_Display
Return
Sub Text (x, y, textHeight, K As _Unsigned Long, txt$)
'Text SUB by bplus.
Dim fg As _Unsigned Long, cur&, I&, multi, xlen
fg = _DefaultColor
cur& = _Dest
I& = _NewImage(8 * Len(txt$), 16, 32)
_Dest I&
Color K, _RGBA32(0, 0, 0, 0)
_PrintString (0, 0), txt$
multi = textHeight / 16
xlen = Len(txt$) * 8 * multi
_PutImage (x, y)-Step(xlen, textHeight), I&, cur&
Color fg
_FreeImage I&
End SubRE: Classic 15 puzzle - bplus - 10-14-2024
+1 One of my favorites! I have at least 3 versions
1. mini < 30 LOC (with double parking)
2. mouse
3. 3X3 to 9x9 or more?
even a AI solver
but I forgot all about that TEXT sub, sure enough there it is in my toolbox
I or someone else maybe Petr or Steve used images instead of numbers.
RE: Classic 15 puzzle - Dav - 10-14-2024
Thanks. I’ve been using your Text Sub quite a bit lately. Works faster than the PPRINT SUB I made.
I have a question about the _DEST use the your SUB. I noticed that _DEST is changed in the Text SUB and not restored when the SUB ends with _DEST cur&, and doesn’t seem to to matter, DEST seems to go back to cur& anyway. Does the PUTIMAGE do that for you when using the saved cur& value?
- Dav
RE: Classic 15 puzzle - bplus - 10-14-2024
cur& is just where-ever you happen to be when you call Text. Usually that would be screen 0 but you could be in another image making sub that you plan on evenetually _PutImage or Rotozoom to main screen.
In short, cur& = the current default destination at moment Text is called.
It is curious I didn't reset _Dest to cur& before leaving, maybe _FreeImage of I& resets _Dest back automatically because I& is gone! after _FreeImage I&
RE: Classic 15 puzzle - Dav - 10-14-2024
Yeah, that's it. I made a little test. Once the _DEST image is freed, the _DEST will reset to 0, not to whatever _DEST was before _DESTing to that image. I guess _DEST cur& should be added before exiting the Text SUB.
- Dav
Code: (Select All)
Screen _NewImage(640, 480, 32)
num2& = _NewImage(640, 480, 32) 'a second screen
_Dest num2& 'dest to this just for a test
dotest 'call a sub (we are in _DEST num2&...)
Print "Hello" 'This will show in _DEST 0
Sub dotest
test& = _NewImage(640, 480, 32) 'another screen
_Dest test& 'point there
Print "Test page."
_FreeImage test& 'remove it, DEST will be removed
'(_DEST will not go back to num&, but 0)
End SubRE: Classic 15 puzzle - bplus - 10-15-2024
OK I'm adding that to Text sub, thanks for test.