Author Topic: Match Three  (Read 5201 times)

0 Members and 1 Guest are viewing this topic.

Marked as best answer by SMcNeill on October 27, 2021, 05:47:23 pm

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Match Three
« Reply #15 on: October 27, 2021, 09:46:28 pm »
Code: QB64: [Select]
  1. Type GameTurn_Type
  2.     GridSize As _Byte
  3.     Matches As _Byte
  4. Dim Shared WS, GridSize, Choice, Matches, Center, Guess$, Guess, DisplayScreen, score
  5. Dim GameTurn(10) As GameTurn_Type
  6.  
  7. ReDim Shared Grid(0, 0) As _Byte
  8. Choice = 1
  9.  
  10. GameLimit = 3
  11. GameTurn(0).GridSize = 8: GameTurn(0).Matches = 3
  12. GameTurn(1).GridSize = 12: GameTurn(1).Matches = 3
  13. GameTurn(2).GridSize = 12: GameTurn(2).Matches = 4
  14. GameTurn(3).GridSize = 8: GameTurn(3).Matches = 4
  15.  
  16. renewgrid = -1
  17.  
  18.  
  19. t# = Timer
  20.     If renewgrid Then
  21.         GridSize = GameTurn(GameOn).GridSize: Matches = GameTurn(GameOn).Matches
  22.         GameOn = GameOn + 1
  23.         If GameOn > GameLimit Then Exit Do
  24.         MakeGrid
  25.         DisplayScreen = 0
  26.         renewgrid = 0
  27.     End If
  28.     DisplayGrid
  29.     UserInput
  30.     _Limit 2
  31.     Choice = (Choice + 1) Mod GridSize
  32.     If Choice = 0 Then Choice = GridSize
  33.     If checkwin Then
  34.         score = score + Int(t# - Timer) * 5
  35.         ShowScore
  36.         renewgrid = -1
  37.         t# = Timer
  38.     End If
  39. WS = _NewImage(240, 240, 32)
  40.  
  41. Print "YOU ARE A BIG WEENER!! YAAAYYY!!"
  42. _FreeImage DisplayScreen
  43. DisplayScreen = 0
  44. AutoScale
  45.  
  46.  
  47.  
  48. Function checkwin
  49.     For x = 1 To GridSize
  50.         For y = 1 To GridSize
  51.             If Grid(x, y) <> 0 Then Exit Function
  52.     Next y, x
  53.     checkwin = -1
  54.  
  55. Sub UserInput
  56.     C = Choice - 1
  57.     If C = 0 Then C = GridSize
  58.     k = _KeyHit
  59.     Select Case k
  60.         Case 27
  61.             Screen 0: _FreeImage WS
  62.             WS = _NewImage(240, 240, 32)
  63.             Screen WS
  64.             _Font 8
  65.  
  66.             Cls
  67.             Print "YOU ARE A BIG LOSER!! HAHAHAHA!!"
  68.             _FreeImage DisplayScreen
  69.             DisplayScreen = 0
  70.             AutoScale
  71.             _KeyClear
  72.             Sleep
  73.             System
  74.  
  75.  
  76.         Case 32
  77.             For y = GridSize To 1 Step -1
  78.                 If Grid(C, y) <> 0 Then Exit For
  79.             Next
  80.             If y <> 0 Then
  81.                 '             If Grid(C, y) <> 0 Then
  82.                 If Grid(C, y) = Guess Or Guess = 0 Then
  83.                     Guess = Grid(C, y)
  84.                     Guess$ = Guess$ + _Trim$(Str$(Guess))
  85.                     Grid(C, y) = 0
  86.                     If Len(Guess$) = Matches Then
  87.                         Guess$ = ""
  88.                         Guess = 0
  89.                         score = score + 10 ^ Matches
  90.                     End If
  91.                     DisplayGrid
  92.                 End If
  93.                 '        End If
  94.             End If
  95.     End Select
  96.     _KeyClear
  97.  
  98.  
  99. Sub ShowScore
  100.     If WS <> 0 Then Screen 0: _FreeImage WS
  101.  
  102.     WS = _NewImage(240, 240, 32)
  103.     Screen WS
  104.     _Font 8
  105.     Cls , -1
  106.     Color &HFF000000, 0
  107.     Print "Round", "Score"
  108.  
  109.     Print _Trim$(Str$(GameOn + 1)), _Trim$(Str$(score))
  110.     DisplayScreen = 0
  111.     AutoScale
  112.     _Delay 2
  113.     _KeyClear
  114.     Sleep
  115.     _KeyClear
  116.  
  117.  
  118.  
  119. Sub DisplayGrid
  120.     Cls
  121.     For x = 1 To GridSize: For y = 1 To GridSize
  122.         If Grid(x, y) Then Locate y, x: Print _Trim$(Str$(Grid(x, y)));
  123.     Next y, x
  124.     Locate y, Choice: Print "^";
  125.     Center = 640 - _PrintWidth(String$(Matches, " ")) / 2
  126.     Line (0, GridSize * 8 + 8)-Step(639, 16), -1, BF
  127.     PW = _PrintWidth(String$(Matches, " "))
  128.     Line ((GridSize * 8 - PW) \ 2, GridSize * 8 + 8)-Step(PW, 8), &HFF000000, BF
  129.     _PrintString ((GridSize * 8 - PW) \ 2, GridSize * 8 + 8), Guess$
  130.     AutoScale
  131.  
  132. Sub MakeGrid
  133.     If WS <> 0 Then Screen 0: _FreeImage WS
  134.  
  135.     WS = _NewImage(GridSize * 8, GridSize * 8 + 16, 32)
  136.     Screen WS
  137.     _Font 8 'this creates a 30x32 screen
  138.     ReDim Grid(1 To GridSize, 1 To GridSize) As _Byte
  139.  
  140.     count = -1: value = -1
  141.     For x = 1 To GridSize: For y = 1 To GridSize
  142.         count = (count + 1) Mod Matches
  143.         If count = 0 Then value = (value + 1) Mod Matches
  144.             Grid(y, x) = value + 1
  145.     Next y, x
  146.     If count <> Matches - 1 Then
  147.         For i = count To 0 Step -1
  148.             Grid(GridSize - i, GridSize) = 0
  149.         Next
  150.     End If
  151.  
  152.  
  153.     For x = 1 To GridSize: For y = 1 To GridSize
  154.         xswap = Int(Rnd * GridSize) + 1: yswap = Int(Rnd * GridSize) + 1
  155.         If Grid(x, y) <> 0 And Grid(xswap, yswap) <> 0 Then Swap Grid(xswap, yswap), Grid(x, y) 'Shuffle the grid
  156.     Next y, x
  157.     Guess$ = ""
  158.     Guess = 0
  159.  
  160. Sub AutoScale
  161.     If DisplayScreen = 0 Then
  162.         DW = _DesktopWidth
  163.         DH = _DesktopHeight
  164.         $If WIN Then
  165.             Declare Library "th"
  166.                 Function taskbar_height& ()
  167.             End Declare
  168.             TH = taskbar_height
  169.         $End If
  170.         If TH >= DH Or TH = 0 Then TH = 100
  171.         Scale = (DH - TH) / 640
  172.         DisplayScreen = _NewImage(640 * Scale, 640 * Scale, 32)
  173.         Screen DisplayScreen
  174.         ScreenMove (DW - _Width(DisplayScreen)) \ 2, 0
  175.         _Source WS: _Dest WS
  176.     End If
  177.     _PutImage , WS, DisplayScreen
  178.     _Display
  179.  
  180. Sub ScreenMove (x, y)
  181.     $If BORDERDEC = UNDEFINED Then
  182.         $Let BORDERDEC = TRUE
  183.         Declare Library
  184.             Function glutGet& (ByVal what&)
  185.         End Declare
  186.     $End If
  187.     BorderWidth = glutGet(506)
  188.     TitleBarHeight = glutGet(507)
  189.     _ScreenMove x - BorderWidth, y - BorderWidth - TitleBarHeight
  190.  

Game now runs for multiple rounds before ending, as well as having a scoring system in it.   Bplus's glitch with the autoscale not working should be fixed, and the taskbar height routine shouldn't be an issue for folks on Linux or Mac now. 

At this point, the game is basically finished, unless I want to swap in some bells and whistles like music and images instead of the plain old numbers which we're using here.  In a lot of ways, I kind of like just sticking with the numbers for a sort of retro-Screen 0 type feel for everything.  A simple high score system would be nice to add, but it's a pain in the rump to add and deal with, while sticking to the single-input rule, and my time is limited here before Halloween.  Maybe I'll take time and add that into the game after the holiday comes around and passes.  LOL!  :P

Anywho, test it out.  Tell me what you think, and let me know if you run into any glitches or unexpected behavior with everything.
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: Match Three
« Reply #16 on: October 27, 2021, 09:59:21 pm »
If you decide you want to add a top five scoring system, here's my stripped down version using LINE INPUT: https://www.qb64.org/forum/index.php?topic=4339.msg137511#msg137511

I think we both have custom keyboard input programs, which could substitute for the LINE INPUT statement.

The ASCII Invaders game uses the 1-key method: https://www.qb64.org/forum/index.php?topic=4245.msg137017#msg137017

I might even still have the stripped down 1-key input method, if you're interested.

Pete
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/