This is a version of the game Pelmanism ("Matching Pairs"), in which you have to use your memory to match pairs in the shortest possible number of attempts: the game may of more interest to younger family members.
Installation
Unzip the file and extract the folder into your PEQB64 directory. In the IDE make sure that you have the Run Option “Save EXE in source folder” checked.
Pelmanism.zip (Size: 1.11 MB / Downloads: 6)
Playing the Game
From the Start Menu, select the difficulty. There are three levels of difficulty: 8, 18 and 30 pairs.
For the largest-sized puzzle, your screen width needs to be larger than 1300. Regrettably, the code has not been written to enable you to adjust the window size if your monitor does not have a higher enough resolution.
In the game selections are made by single mouse click. When a square is clicked, it turns over to reveal the image. A second square reveals another picture. If the two are the same they will remain displayed, but if they are different they will turn back over.
By default, there are sounds when pictures turn over. You can turn these sounds off, if desired.
You can exit the program at any time, or you can start another game.
Installation
Unzip the file and extract the folder into your PEQB64 directory. In the IDE make sure that you have the Run Option “Save EXE in source folder” checked.
Pelmanism.zip (Size: 1.11 MB / Downloads: 6)
Playing the Game
From the Start Menu, select the difficulty. There are three levels of difficulty: 8, 18 and 30 pairs.
For the largest-sized puzzle, your screen width needs to be larger than 1300. Regrettably, the code has not been written to enable you to adjust the window size if your monitor does not have a higher enough resolution.
In the game selections are made by single mouse click. When a square is clicked, it turns over to reveal the image. A second square reveals another picture. If the two are the same they will remain displayed, but if they are different they will turn back over.
By default, there are sounds when pictures turn over. You can turn these sounds off, if desired.
You can exit the program at any time, or you can start another game.
Code: (Select All)
': Clock Patience by Magdha 2025-11-21 [from QB64v2 (ex Qwerkey)]
': This program uses
': InForm-PE for QB64-PE - v1.5.8 based upon InForm by Fellippe Heitor
': Copyright (c) 2025 QB64 Phoenix Edition Team
': https://github.com/QB64-Phoenix-Edition/InForm-PE
'-----------------------------------------------------------
': Controls' IDs: ------------------------------------------------------------------
DIM SHARED Pelmanism AS LONG
DIM SHARED ExitBT AS LONG
DIM SHARED NewGameBT AS LONG
DIM SHARED AudioFM AS LONG
DIM SHARED AudioOnRB AS LONG
DIM SHARED AudioOffRB AS LONG
DIM SHARED BestScoreLB AS LONG
DIM SHARED ScoreLB AS LONG
DIM SHARED PelmanismLB AS LONG
DIM SHARED SetSkillLevelLB AS LONG
DIM SHARED OneBT AS LONG
DIM SHARED TwoBT AS LONG
DIM SHARED ThreeBT AS LONG
DIM SHARED PairingsCompletedLB AS LONG
CONST NoObjectsLess1%% = 67
DIM SHARED BestScore%(2), GameLevel%%(2, 1), InPlay%%, Level%%, FrameRate%, NoRemaining%%, Score%, DoNewGame%%
DIM SHARED Images&(NoObjectsLess1%%), ObverseImg&, Background&, Highlight&
DIM SHARED ValidMouse%%, XX%%, YY%%, FirstV%%, FirstH%%, Flipping%%, TurningBack%%, FlipCount%%, Paused%%, PCount%%, FirstGo%%
REDIM SHARED Motion%%(10, 6, 2), Choisi%%(10, 6), Grid%%(10, 6)
': External modules: ---------------------------------------------------------------
'$INCLUDE:'InForm\InForm.bi'
'$INCLUDE:'InForm\xp.uitheme'
'$INCLUDE:'Pelmanism InForm.frm'
': Event procedures & Functions: ---------------------------------------------------------------
FUNCTION MakeHardware& (Img&)
MakeHardware& = _COPYIMAGE(Img&, 33)
_FREEIMAGE Img&
END FUNCTION
SUB __UI_BeforeInit
RANDOMIZE (TIMER)
$EXEICON:'.\Balloons.ico'
GameLevel:
DATA 4,4
DATA 6,6
DATA 10,6
RESTORE GameLevel
FOR N%% = 0 TO 2
FOR M%% = 0 TO 1
READ GameLevel%%(N%%, M%%)
NEXT M%%
NEXT N%%
'Create Images
ImageNames:
DATA Bananas,Cherry,Carrots,Pepper,Tomato,Cat,Egg,Beer,Acorn,Feather,Squirrel,IcedBun,LightBulb,GoldCup
DATA Parrot,LadyMouse,Mushrooms,Pineapple,Balloons,Rose,CloverLeaf,Goose,Raccoon,Raspberry,Violin,TeddyBear
DATA Clock,Shoes,Wrench,Hammer,Computer,Matches,Diamond,WineGlass,Frog,Chimp,Apricot,RollsRoyce,Knight,Bee
DATA Fish,IceCream,SnowFlake,XmasTree,Butterfly,Rainbow,Penguin,Fox,Hummingbird,Cashews,Tulips,Matryoshka
DATA Lion,Apple,Hat,Heart,Key1,Ladybird,Strawberry,TV,Dog,Dolphin,Koala,Earth,Olives,Einstein,Plane,Flag
RESTORE ImageNames
FOR N%% = 0 TO NoObjectsLess1%%
READ Dum$
Images&(N%%) = _LOADIMAGE(Dum$ + ".png", 33)
NEXT N%%
IF RND > 0.5 THEN
ObverseImg& = _LOADIMAGE("Back1.png", 33)
ELSE
ObverseImg& = _LOADIMAGE("Back2.png", 33)
END IF
TempImg& = _NEWIMAGE(104, 104, 32)
_DEST TempImg&
COLOR _RGB32(0, 176, 0), _RGBA32(100, 100, 100, 0)
CLS
LINE (0, 0)-(103, 103), , B
LINE (1, 1)-(102, 102), , B
Highlight& = MakeHardware&(TempImg&)
'Load/Set Initial Data
IF _FILEEXISTS("pelman.dat") THEN
OPEN "pelman.dat" FOR INPUT AS #1
FOR N%% = 0 TO 2
INPUT #1, BestScore%(N%%)
NEXT N%%
CLOSE #1
END IF
DoNewGame%% = False
END SUB
SUB __UI_OnLoad
Control(BestScoreLB).Top = 6
Control(ScoreLB).Top = 100
Control(PairingsCompletedLB).Top = 176
CALL NouveauJeu
_SCREENMOVE 10, 5
END SUB
SUB __UI_BeforeUpdateDisplay
'This event occurs at approximately 30 frames per second.
'You can change the update frequency by calling SetFrameRate DesiredRate%
STATIC XPos%, YPos%
IF InPlay%% THEN
_PUTIMAGE (0, 0), Background&
IF ValidMouse%% THEN _PUTIMAGE (5 + 107 * XX%%, 5 + 107 * YY%%), Highlight&
FOR HorizPos%% = 1 TO GameLevel%%(Level%%, 0)
FOR VertPos%% = 1 TO GameLevel%%(Level%%, 1)
IF Motion%%(HorizPos%%, VertPos%%, 2) THEN
'Turn back
IF Paused%% THEN
_PUTIMAGE (107 * (HorizPos%% - 1) + 7, 107 * (VertPos%% - 1) + 7), Images&(Grid%%(HorizPos%%, VertPos%%)) 'Fronts
PCount%% = PCount%% + 1
IF PCount%% = 40 THEN
Paused%% = False
PCount%% = 0
END IF
ELSE
IF FlipCount%% = 0 THEN
XPos% = 107 * (HorizPos%% - 1) + 7
YPos% = 107 * (VertPos%% - 1) + 7
END IF
IF FlipCount%% < 50 THEN
_PUTIMAGE (FlipCount%% + XPos%, YPos%)-(XPos% + 100 - FlipCount%%, YPos% + 100), Images&(Grid%%(HorizPos%%, VertPos%%))
ELSE
_PUTIMAGE (XPos% + FlipCount%%, YPos%)-(XPos% + 100 - FlipCount%%, YPos% + 100), ObverseImg&
END IF
FlipCount%% = FlipCount%% + 2
IF FlipCount%% = 100 THEN
FlipCount%% = 0
Motion%%(HorizPos%%, VertPos%%, 2) = False
Motion%%(HorizPos%%, VertPos%%, 0) = False
IF HorizPos%% = FirstH%% AND VertPos%% = FirstV%% THEN
FrameRate% = 40
SetFrameRate FrameRate%
Flipping%% = False
TurningBack%% = False
FirstV%% = 50
ELSE
Motion%%(FirstH%%, FirstV%%, 2) = True
END IF
END IF
END IF
ELSEIF Motion%%(HorizPos%%, VertPos%%, 1) THEN
'Turn forward
IF FlipCount%% = 0 THEN
XPos% = 107 * (HorizPos%% - 1) + 7
YPos% = 107 * (VertPos%% - 1) + 7
END IF
IF FlipCount%% < 50 THEN
_PUTIMAGE (XPos% + 100 - FlipCount%%, YPos%)-(XPos% + FlipCount%%, YPos% + 100), ObverseImg&
ELSE
_PUTIMAGE (100 - FlipCount%% + XPos%, YPos%)-(XPos% + FlipCount%%, YPos% + 100), Images&(Grid%%(HorizPos%%, VertPos%%))
END IF
FlipCount%% = FlipCount%% + 2
IF FlipCount%% = 100 THEN
FlipCount%% = 0
Flipping%% = False
Motion%%(HorizPos%%, VertPos%%, 1) = False
Motion%%(HorizPos%%, VertPos%%, 0) = True
IF FirstGo%% THEN
FirstGo%% = False
ELSE
FirstGo%% = True
IF Grid%%(HorizPos%%, VertPos%%) = Grid%%(FirstH%%, FirstV%%) THEN 'Matched pair
Choisi%%(HorizPos%%, VertPos%%) = True 'Registers that that grid position cannot be clicked any more
Choisi%%(FirstH%%, FirstV%%) = True
NoRemaining%% = NoRemaining%% - 2
IF NoRemaining%% = 0 THEN
'Tah-dah sound (completed)
IF Control(AudioOnRB).Value THEN _SNDPLAYFILE ("fanfare.mp3")
Control(PairingsCompletedLB).Disabled = False
Control(PairingsCompletedLB).Hidden = False
ELSE
'Ching sound (match)
IF Control(AudioOnRB).Value THEN _SNDPLAYFILE ("match3.mp3")
END IF
ELSE
'Initiate sequential turn back
FrameRate% = 60
SetFrameRate FrameRate%
Motion%%(HorizPos%%, VertPos%%, 2) = True
Flipping%% = True
TurningBack%% = True
Paused%% = True
PCount%% = 0
IF Control(AudioOnRB).Value THEN _SNDPLAYFILE ("nomatch1.mp3"), , 0.2
END IF
IF Score% < 99 THEN
Score% = Score% + 1
Caption(ScoreLB) = "Score:" + STR$(Score%)
END IF
IF NoRemaining%% = 0 THEN
'Pairings Completed
IF Score% < BestScore%(Level%%) OR BestScore%(Level%%) = 0 THEN
BestScore%(Level%%) = Score%
Caption(BestScoreLB) = "Best Score: " + LTRIM$(STR$(BestScore%(Level%%)))
END IF
END IF
END IF
END IF
ELSEIF Motion%%(HorizPos%%, VertPos%%, 0) THEN
_PUTIMAGE (107 * (HorizPos%% - 1) + 7, 107 * (VertPos%% - 1) + 7), Images&(Grid%%(HorizPos%%, VertPos%%)) 'Fronts
ELSE
_PUTIMAGE (107 * (HorizPos%% - 1) + 7, 107 * (VertPos%% - 1) + 7), ObverseImg& 'Backs
END IF
NEXT VertPos%%
NEXT HorizPos%%
END IF
END SUB
SUB __UI_BeforeUnload
'If you set __UI_UnloadSignal = False here you can
'cancel the user's request to close.
END SUB
SUB __UI_Click (id AS LONG)
SELECT CASE id
CASE Pelmanism
IF ValidMouse%% THEN
HorizPos%% = XX%% + 1
VertPos%% = YY%% + 1
IF Choisi%%(HorizPos%%, VertPos%%) OR (FirstH%% = HorizPos%% AND FirstV%% = VertPos%%) THEN
'Do nothing
ELSE
Motion%%(HorizPos%%, VertPos%%, 1) = True 'Set this cell turning
Flipping%% = True
IF FirstGo%% THEN
FirstH%% = HorizPos%%
FirstV%% = VertPos%%
END IF
END IF
END IF
CASE ExitBT
IF InPlay%% THEN
InPlay%% = False
ELSE
CALL Finale
END IF
CASE NewGameBT
DoNewGame%% = True
InPlay%% = False
CASE OneBT
Level%% = 0
CALL MakePairs
CASE TwoBT
Level%% = 1
CALL MakePairs
CASE ThreeBT
Level%% = 2
CALL MakePairs
END SELECT
END SUB
SUB __UI_MouseEnter (id AS LONG)
END SUB
SUB __UI_MouseLeave (id AS LONG)
END SUB
SUB __UI_FocusIn (id AS LONG)
END SUB
SUB __UI_FocusOut (id AS LONG)
'This event occurs right before a control loses focus.
'To prevent a control from losing focus, set __UI_KeepFocus = True below.
END SUB
SUB __UI_MouseDown (id AS LONG)
END SUB
SUB __UI_MouseUp (id AS LONG)
END SUB
SUB __UI_KeyPress (id AS LONG)
'When this event is fired, __UI_KeyHit will contain the code of the key hit.
'You can change it and even cancel it by making it = 0
END SUB
SUB __UI_TextChanged (id AS LONG)
END SUB
SUB __UI_ValueChanged (id AS LONG)
END SUB
SUB __UI_FormResized
END SUB
SUB NouveauJeu
DoNewGame%% = False
_DELAY 0.1
FrameRate% = 40
SetFrameRate FrameRate%
Control(__UI_FormID).Width = 310
Control(__UI_FormID).Height = 360
Control(PelmanismLB).Disabled = False
Control(PelmanismLB).Hidden = False
Control(SetSkillLevelLB).Disabled = False
Control(SetSkillLevelLB).Hidden = False
Control(OneBT).Disabled = False
Control(OneBT).Hidden = False
Control(TwoBT).Disabled = False
Control(TwoBT).Hidden = False
Control(ThreeBT).Disabled = False
Control(ThreeBT).Hidden = False
Control(NewGameBT).Disabled = True
Control(NewGameBT).Hidden = True
Control(AudioFM).Disabled = True
Control(AudioFM).Hidden = True
Control(BestScoreLB).Disabled = True
Control(BestScoreLB).Hidden = True
Control(ScoreLB).Disabled = True
Control(ScoreLB).Hidden = True
Control(PairingsCompletedLB).Disabled = True
Control(PairingsCompletedLB).Hidden = True
Control(ExitBT).Left = Control(__UI_FormID).Width - 96
Control(ExitBT).Top = Control(__UI_FormID).Height - 39
SetFocus ExitBT
END SUB
SUB Finale
'Freeimages
_FREEIMAGE ObverseImg&
_FREEIMAGE Highlight&
FOR N%% = 0 TO NoObjectsLess1%%
_FREEIMAGE Images&(N%%)
NEXT N%%
OPEN "pelman.dat" FOR OUTPUT AS #1
FOR N%% = 0 TO 2
PRINT #1, BestScore%(N%%)
NEXT N%%
CLOSE #1
SYSTEM
END SUB
SUB MakePairs
InPlay%% = True
Score% = 0
NoRemaining%% = GameLevel%%(Level%%, 0) * GameLevel%%(Level%%, 1)
NoPairs%% = 0
FirstV%% = 50
ValidMouse%% = False
Flipping%% = False
TurningBack%% = False
FlipCount%% = 0
Paused%% = False
PCount%% = 0
FirstGo%% = True
REDIM Motion%%(10, 6, 2), Choisi%%(10, 6), Grid%%(10, 6)
REDIM Selected%%(30)
RANDOMIZE (TIMER)
WHILE NoRemaining%% > 0
Vacant%% = False
WHILE NOT Vacant%%
HorizPos%% = 1 + INT(GameLevel%%(Level%%, 0) * RND)
VertPos%% = 1 + INT(GameLevel%%(Level%%, 1) * RND)
IF Grid%%(HorizPos%%, VertPos%%) = 0 THEN Vacant%% = True
WEND
NewPair%% = False
WHILE NOT NewPair%%
PairNo%% = 1 + INT(NoObjectsLess1%% * RND)
PairsExists%% = False
N%% = 1
WHILE NOT PairsExists%% AND N%% <= NoPairs%%
IF PairNo%% = Selected%%(N%%) THEN PairsExists%% = True
N%% = N%% + 1
WEND
IF NOT PairsExists%% THEN NewPair%% = True
WEND
NoPairs%% = NoPairs%% + 1
Selected%%(NoPairs%%) = PairNo%%
Grid%%(HorizPos%%, VertPos%%) = PairNo%%
Vacant%% = False
WHILE NOT Vacant%%
HorizPos%% = 1 + INT(GameLevel%%(Level%%, 0) * RND): VertPos%% = 1 + INT(GameLevel%%(Level%%, 1) * RND)
IF Grid%%(HorizPos%%, VertPos%%) = 0 THEN Vacant%% = True
WEND
Selected%%(NoPairs%%) = PairNo%%
Grid%%(HorizPos%%, VertPos%%) = PairNo%%
NoRemaining%% = NoRemaining%% - 2
WEND
NoRemaining%% = GameLevel%%(Level%%, 0) * GameLevel%%(Level%%, 1)
Control(__UI_FormID).Width = 307 + (GameLevel%%(Level%%, 0) - 1) * 107
Control(__UI_FormID).Height = 114 + (GameLevel%%(Level%%, 1) - 1) * 107
Control(ExitBT).Left = Control(__UI_FormID).Width - 96
Control(ExitBT).Top = Control(__UI_FormID).Height - 39
Control(NewGameBT).Left = Control(__UI_FormID).Width - 96
Control(NewGameBT).Top = Control(__UI_FormID).Height - 73
Control(AudioFM).Left = Control(__UI_FormID).Width - 122
Control(AudioFM).Top = Control(__UI_FormID).Height - 169
Control(BestScoreLB).Left = Control(__UI_FormID).Width - 178
Control(ScoreLB).Left = Control(__UI_FormID).Width - 178
Control(PairingsCompletedLB).Left = Control(__UI_FormID).Width - 138
Control(PelmanismLB).Disabled = True
Control(PelmanismLB).Hidden = True
Control(SetSkillLevelLB).Disabled = True
Control(SetSkillLevelLB).Hidden = True
Control(OneBT).Disabled = True
Control(OneBT).Hidden = True
Control(TwoBT).Disabled = True
Control(TwoBT).Hidden = True
Control(ThreeBT).Disabled = True
Control(ThreeBT).Hidden = True
Control(NewGameBT).Disabled = False
Control(NewGameBT).Hidden = False
Control(AudioFM).Disabled = False
Control(AudioFM).Hidden = False
Control(BestScoreLB).Disabled = False
Control(BestScoreLB).Hidden = False
Control(ScoreLB).Disabled = False
Control(ScoreLB).Hidden = False
IF BestScore%(Level%%) <> 0 THEN
Caption(BestScoreLB) = "Best Score:" + STR$(BestScore%(Level%%))
ELSE
Caption(BestScoreLB) = "Best Score:"
END IF
Caption(ScoreLB) = "Score:"
SetFocus ExitBT
Blight& = _NEWIMAGE(110, 110, 32)
_DEST Blight&
COLOR _RGB32(255, 255, 255), _RGBA32(100, 100, 100, 0)
CLS
LINE (0, 0)-(109, 109), , B
LINE (1, 1)-(108, 108), , B
LINE (2, 2)-(107, 107), , B
TempImg& = _NEWIMAGE(6 + (GameLevel%%(Level%%, 0)) * 107, 6 + (GameLevel%%(Level%%, 1)) * 107, 32)
_DEST TempImg&
COLOR _RGB32(255, 255, 255), _RGBA32(100, 100, 100, 0)
CLS
FOR N%% = 0 TO GameLevel%%(Level%%, 0) - 1
FOR M%% = 0 TO GameLevel%%(Level%%, 1) - 1
_PUTIMAGE (2 + N%% * 107, 2 + M%% * 107), Blight&
NEXT M%%
NEXT N%%
LINE (4, 4)-(2 + GameLevel%%(Level%%, 0) * 107, 2 + GameLevel%%(Level%%, 1) * 107), , B
Background& = MakeHardware&(TempImg&)
_FREEIMAGE Blight&
_DELAY 0.1
WHILE InPlay%%
_LIMIT 2 * FrameRate%
XMouse% = __UI_MouseLeft: YMouse% = __UI_MouseTop
ValidMouse%% = False
IF XMouse% > 7 AND XMouse% < (GameLevel%%(Level%%, 0)) * 107 AND YMouse% > 7 AND YMouse% < (GameLevel%%(Level%%, 1)) * 107 THEN
IF NOT Flipping%% THEN ValidMouse%% = True
XX%% = (XMouse% - 7) \ 107
YY%% = (YMouse% - 7) \ 107
END IF
K$ = INKEY$
IF K$ <> "" THEN
IF ASC(K$) = 27 THEN InPlay%% = False
END IF
K$ = ""
__UI_DoEvents
WEND
_FREEIMAGE Background&
IF DoNewGame%% THEN
CALL NouveauJeu
ELSE
CALL Finale
END IF
END SUB
'$INCLUDE:'InForm\InForm.ui'
