PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

MemoryTest

https://www.purebasic.fr/english/viewtopic.php?t=51901

Page 1 of 1

MemoryTest

Posted: Sat Oct 27, 2012 11:15 pm
by BasicallyPure
This will not test your computer's memory, it will test your memory.

You will be shown a grid of tiles with different symbols and colors.
There are always only two of each kind of symbol.
After a certain ammount of time all symbols will be hidden and you must proceed relying only on your memory.

Click on a tile to show the symbol for that tile.
Only two symbols may be shown at any time.
If the symbols match then your score will increase by 5.
If you guess wrong you score will decrease by 1.
Match all of the tiles to complete the puzzle.

Tested on Windows & Linux

B.P.

Code: Select all

; MemoryTest.pb
; by BasicallyPure
; 10.30.2012
; version 1.21

EnableExplicit

Declare Verify(result, text.s)
Declare Choose()
Declare FlipTile(gadget)
Declare ShuffleTiles()
Declare DrawShapes()
Declare PauseAndShowAll()

Verify(ExamineDesktops(), "ExamineDesktops")

; constants
#Title = "Memory Test"
#PrimaryMonitor = 0
#MenuItemExit = 0
#Ask = #PB_MessageRequester_YesNo
#Yes = #PB_MessageRequester_Yes

;variables
Global Quit, Score, MainWin
Define GridSize = Choose()
Define TileCount = GridSize * GridSize
Define ImgUnsolved = TileCount + 1
Define ImgSolved = TileCount + 2
Define Event, Gadget, MainMenu, TotalMatched, sym, n, x, y
Define WinHeight = DesktopHeight(#PrimaryMonitor) * 0.8
Define WinWidth  = WinHeight + 50
Define TileSize = WinHeight / GridSize
Define Flags = #PB_Window_ScreenCentered | #PB_Window_SystemMenu | #PB_Window_MinimizeGadget
Define Text.s

MainWin  = Verify(OpenWindow(#PB_Any, 0, 0, WinWidth, WinHeight + MenuHeight(), #Title, Flags), "OpenWindow")
MainMenu = Verify(CreateMenu(#PB_Any, WindowID(MainWin)), "CreateMenu")
MenuTitle("File")
MenuItem(#MenuItemExit, "Exit")

ProgressBarGadget(0, WinWidth - 40, 10, 30, WinHeight-20, 0, 300, #PB_ProgressBar_Vertical)

Structure puzzle
   SymNum.i ; symbol number
   Solved.i ; Solved flag
EndStructure

Dim Tile.puzzle(TileCount)
Dim symbol(TileCount)
Dim AllShapes(63)
For n = 0 To 63 : AllShapes(n) = n : Next n

sym = 1
For n = 1 To TileCount Step 2
   symbol(n) = sym : symbol(n + 1) = sym
   sym + 1
Next n

; create image for unsolved 'hidden' tile
Verify(CreateImage(ImgUnsolved, TileSize, TileSize , 32), "CreateImage")
text = " ? "
StartDrawing(ImageOutput(ImgUnsolved))
Box(0, 0, TileSize, TileSize, $FF0000)
DrawText(TileSize/2 - TextWidth(Text)/2, TileSize/2 - TextHeight(Text)/2, Text)
StopDrawing()

; create image for solved tile
Verify(CreateImage(ImgSolved, TileSize, TileSize, 32), "CreateImage")
Text = " Done "
StartDrawing(ImageOutput(ImgSolved))
Box(0, 0, TileSize, TileSize, $00FFFF)
DrawText(TileSize/2 - TextWidth(Text)/2, TileSize/2 - TextHeight(Text)/2, Text)
StopDrawing()

For n = 1 To TileCount ; create imageGadgets and blank images for tiles
   Verify(CreateImage(n, TileSize, TileSize, 32), "CreateImage")
   Verify(ImageGadget(n, x, y, TileSize, TileSize, 0, #PB_Image_Border), "ImageGadget")
   ;position the image gadgets
   x + TileSize
   If x = TileSize * GridSize
      x = 0
      y + TileSize
   EndIf
Next n

ShuffleTiles()
DrawShapes()
PauseAndShowAll()

Repeat ;event loop
   Event = WaitWindowEvent()
   Select Event
      Case #PB_Event_CloseWindow
         Quit = #True
      Case #PB_Event_Menu
         Select EventMenu()
            Case #MenuItemExit
               Quit = #True
         EndSelect
      Case #PB_Event_Gadget
         Gadget = EventGadget()
         Select Gadget
            Case 1 To TileCount
               FlipTile(Gadget)
               If TotalMatched = TileCount
                  Text = "Final Score = " + Str(Score)
                  If MessageRequester(Text, "Try again?", #Ask) = #Yes
                     TotalMatched = 0
                     ShuffleTiles()
                     DrawShapes()
                     PauseAndShowAll()
                  Else
                     Quit = #True
                  EndIf
               EndIf
         EndSelect
   EndSelect
Until Quit = #True

End

Procedure Choose()
   ; set game difficulty
   
   Protected Event, difficulty = 4
   Protected Flags = #PB_Window_ScreenCentered | #PB_Window_Tool
   Verify(OpenWindow(0, 0, 0, 200, 150, "Memory Test", Flags), "OpenWindow")
   StickyWindow(0, 1)
   
   TextGadget(0, 10, 10, 200, 25, "Choose difficulty")
   OptionGadget(1, 010, 040, 080, 30, "Easy")
   OptionGadget(2, 010, 070, 080, 30, "Medium")
   OptionGadget(3, 010, 100, 080, 30, "Hard")
   ButtonGadget(4, 100, 100, 075, 30, "Continue")
   ButtonGadget(5, 100, 040, 075, 30, "Abort")
   SetGadgetState(1, 1)
   
   Repeat
      Event = WaitWindowEvent()
      If Event = #PB_Event_CloseWindow
         End
      ElseIf Event = #PB_Event_Gadget
         Select EventGadget()
            Case 1, 2, 3
               difficulty = EventGadget() * 2 + 2
            Case 4
               Break
            Case 5
               End
         EndSelect
      EndIf
   ForEver
   
   CloseWindow(0)
   ProcedureReturn difficulty
EndProcedure


Procedure ShuffleTiles()
   Shared Tile(), symbol(), TileCount, ImgUnsolved
   Protected n
   
   RandomizeArray(symbol(),1, TileCount)
   
   For n = 1 To TileCount
      Tile(n)\SymNum = symbol(n)
      Tile(n)\Solved = #False
   Next n
   
   SetWindowTitle(MainWin, #Title + "     Click any tile to bypass timer.")
   Score = 0
EndProcedure

Procedure DrawShapes()
   Shared TileCount, TileSize, AllShapes()
   Protected shape, color, n
   Protected mid = TileSize/2
   Protected ofs = TileSize/6
   Protected size = TileSize/3
   
   RandomizeArray(AllShapes())

   For n = 1 To TileCount
      shape = AllShapes(n-1) & %111
      color = (AllShapes(n-1) & %111000) >> 3
      
      Select color
         Case 0 : color = $0000FF ; Red
         Case 1 : color = $00FF00 ; Green
         Case 2 : color = $FF0000 ; Blue
         Case 3 : color = $00FFFF ; Yellow
         Case 4 : color = $FFFF00 ; Cyan
         Case 5 : color = $FF00FF ; Magenta
         Case 6 : color = $808080 ; Gray
         Case 7 : color = $FFFFFF ; White
      EndSelect
      
      StartDrawing(ImageOutput(n))
      FrontColor(color)
      Box(0, 0, TileSize, TileSize, 0)
      
      Select shape
         Case 0 ; circle
            Circle(mid,mid,ofs)
         Case 1 ; square
            Box(mid-ofs,mid-ofs,size,size)
         Case 2 ; up triangle
            LineXY(mid-ofs,mid+ofs,mid+ofs,mid+ofs)
            LineXY(mid-ofs,mid+ofs,mid,mid-ofs)
            LineXY(mid,mid-ofs,mid+ofs,mid+ofs)
            FillArea(mid,mid,color)
         Case 3 ; down triangle
            LineXY(mid-ofs,mid-ofs,mid+ofs,mid-ofs)
            LineXY(mid-ofs,mid-ofs,mid,mid+ofs)
            LineXY(mid+ofs,mid-ofs,mid,mid+ofs)
            FillArea(mid,mid,color)
         Case 4 ; cross
            Box(mid-ofs,mid-ofs/2,size,ofs)
            Box(mid-ofs/2,mid-ofs,ofs,size)
         Case 5 ; hollow square
            Box(mid-ofs,mid-ofs,ofs*2,ofs*2)
            Box(mid-ofs*0.75,mid-ofs*0.75,ofs*1.5,ofs*1.5,0)
         Case 6 ; ring
            Circle(mid,mid,ofs)
            Circle(mid,mid,ofs*0.75,0)
         Case 7 ; diamond
            LineXY(mid-ofs,mid,mid,mid-ofs*1.5)
            LineXY(mid,mid-ofs*1.5,mid+ofs,mid)
            LineXY(mid+ofs,mid,mid,mid+ofs*1.5)
            LineXY(mid,mid+ofs*1.5,mid-ofs,mid)
            FillArea(mid,mid,color)
      EndSelect
      StopDrawing()
   Next n
EndProcedure

Procedure PauseAndShowAll()
   ; user tries to memorize the tiles during this time
   Shared TileCount, ImgUnsolved, Tile()
   Protected CountDown = GetGadgetAttribute(0, #PB_ProgressBar_Maximum)
   Protected Event, n
   
   SetGadgetState(0, CountDown)
   AddWindowTimer(MainWin, 0, 100)
   
   For n = 1 To TileCount
         SetGadgetState(n, ImageID(Tile(n)\SymNum))
   Next n
      
   Repeat
      Event = WaitWindowEvent()
      Select Event
         Case #PB_Event_Timer
            CountDown -1
            SetGadgetState(0, CountDown)
            If CountDown = 0
               RemoveWindowTimer(MainWin, 0)
               For n = 1 To TileCount
                  SetGadgetState(n, ImageID(ImgUnsolved))
               Next n
               SetWindowTitle(MainWin, #Title + "     Score = 0")
               Break
            EndIf
         Case #PB_Event_CloseWindow
            Quit = #True
            Break
         Case #PB_Event_Gadget
            Select EventGadget()
               Case 1 To TileCount
                  CountDown = 1
            EndSelect
         Case #PB_Event_Menu
            Select EventMenu()
               Case #MenuItemExit
                  Quit = #True
                  Break
            EndSelect
      EndSelect
   ForEver
EndProcedure

Procedure FlipTile(Gadget)
   Static TileUp1, TileUp2
   Shared Tile(), ImgUnsolved, ImgSolved, TotalMatched
   
   Macro UpdateScore(n)
      Score + n
      SetWindowTitle(MainWin, #Title + "     Score " + Str(Score))
   EndMacro
   
   If Tile(Gadget)\Solved : ProcedureReturn : EndIf
   
   If Gadget = TileUp1
      SetGadgetState(Gadget, ImageID(ImgUnsolved))
      If TileUp2
         TileUp1 = TileUp2
         TileUp2 = 0
      Else
         TileUp1 = 0
         UpdateScore(-1)
      EndIf
      ProcedureReturn
   EndIf
   
   If Gadget = TileUp2
      SetGadgetState(Gadget, ImageID(ImgUnsolved))
      TileUp2 = 0
      ProcedureReturn
   EndIf
   
   If TileUp1 And TileUp2
      SetGadgetState(TileUp1, ImageID(ImgUnsolved))
      TileUp1 = TileUp2
      TileUp2 = Gadget
   EndIf
   
   SetGadgetState(Gadget, ImageID(Tile(Gadget)\SymNum))
   
   If TileUp1
      TileUp2 = Gadget
      If Tile(TileUp1)\SymNum = Tile(TileUp2)\SymNum
         SetGadgetState(Gadget, ImageID(Tile(Gadget)\SymNum))
         While WindowEvent() : Wend ; Linux needs this
         Delay(500)
         SetGadgetState(TileUp1, ImageID(ImgSolved))
         SetGadgetState(TileUp2, ImageID(ImgSolved))
         Tile(TileUp1)\Solved = #True
         Tile(TileUp2)\Solved = #True
         TotalMatched + 2
         TileUp1 = 0
         TileUp2 = 0
         UpdateScore(5)
      Else
         UpdateScore(-1)
      EndIf
   Else
      TileUp1 = Gadget
   EndIf
   
EndProcedure

Procedure Verify(result, text.s)
   If result = 0
      MessageRequester("Fatal Error!", "Unable to execute --> " + text)
      End
   EndIf
   ProcedureReturn result
EndProcedure

Re: MemoryTest

Posted: Sun Oct 28, 2012 1:07 am
by Inf0Byt3
This is pretty cool, thanks for sharing. I got 2 suggestions if you have time to slip them in: A button to skip the main timer (in case we want to start earlier) and the addition of a second timer to flip the tiles back if they don't match (e.g. after 3 seconds).

Re: MemoryTest

Posted: Sun Oct 28, 2012 2:44 am
by BasicallyPure
I have revised the code.
Now you can skip the timer by pressing the space bar.

I don't think I want to add the 3 second timer but you can flip any tile back by clicking on it again.

B.P.

Re: MemoryTest

Posted: Sun Oct 28, 2012 3:01 am
by electrochrisso
Great little game, I think my memory is shot. :lol:
Thanks for sharing. :)

Re: MemoryTest

Posted: Sun Oct 28, 2012 3:08 am
by leonhardt
mark

Re: MemoryTest

Posted: Sun Oct 28, 2012 4:50 pm
by yrreti
Nice little game BasicallyPure :!:

Maybe it can help me brush up on my recognizance skills a little.
They sure don't work as well as you age. :lol:

Thanks for sharing your program.

yrreti
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited