MemoryTest

Applications, Games, Tools, User libs and useful stuff coded in PureBasic
User avatar
BasicallyPure
Enthusiast
Enthusiast
Posts: 539
Joined: Thu Mar 24, 2011 12:40 am
Location: Iowa, USA

MemoryTest

Post 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
Last edited by BasicallyPure on Wed Oct 31, 2012 1:37 pm, edited 3 times in total.
BasicallyPure
Until you know everything you know nothing, all you have is what you believe.
Inf0Byt3
PureBasic Fanatic
PureBasic Fanatic
Posts: 2236
Joined: Fri Dec 09, 2005 12:15 pm
Location: Elbonia

Re: MemoryTest

Post 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).
None are more hopelessly enslaved than those who falsely believe they are free. (Goethe)
User avatar
BasicallyPure
Enthusiast
Enthusiast
Posts: 539
Joined: Thu Mar 24, 2011 12:40 am
Location: Iowa, USA

Re: MemoryTest

Post 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.
BasicallyPure
Until you know everything you know nothing, all you have is what you believe.
User avatar
electrochrisso
Addict
Addict
Posts: 989
Joined: Mon May 14, 2007 2:13 am
Location: Darling River

Re: MemoryTest

Post by electrochrisso »

Great little game, I think my memory is shot. :lol:
Thanks for sharing. :)
PureBasic! Purely the best 8)
User avatar
leonhardt
Enthusiast
Enthusiast
Posts: 220
Joined: Wed Dec 23, 2009 3:26 pm

Re: MemoryTest

Post by leonhardt »

mark
poor English...

PureBasic & Delphi & VBA
yrreti
Enthusiast
Enthusiast
Posts: 546
Joined: Tue Oct 31, 2006 4:34 am

Re: MemoryTest

Post 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
Post Reply