12-17-2025, 05:30 AM
(This post was last modified: 12-18-2025, 11:17 PM by PhilOfPerth.)
Oh yes, now I remember; this is a game for those who feel the need to exercise their memory: "Recall"
Code: (Select All)
DW = _DesktopWidth: DH = _DesktopHeight
sw = 1200: Screen _NewImage(sw, 640, 32) ' Width of display
SetFont: F& = _LoadFont("C:\WINDOWS\fonts\courbd.ttf", 20, "monospace"): _Font F&
_ScreenMove (DW - sw) / 2, (DH - 800) / 2 ' centre display on screen
Common Shared CPR, Txt$, OK$, NumTiles, Tiles(), TileNum, SizeNum, NT(), Name$, Score, Pick, Pick1, Best$(), NumFound
CPR = Int(sw / _PrintWidth("X")) ' Chars Per Row
Randomize Timer
Data 4,6,8,12,16,20,24,30,36,42
GetBestScores:
OK$ = "t120o3l32w1ce"
Dim Best$(10, 2), NT(10)
If Not _FileExists("RecallBest") Then ' if not found,create new records for all levels
Print "Creating new Best-scores": Sleep 1
Open "RecallBest" For Output As #1
For a = 1 To 10
Write #1, "ANON", "1000"
Next
End If
Close
SetGridSizes:
For a = 0 To 9
Read NumTiles
NT(a) = NumTiles
Next
Instructions
GetName:
_KeyClear
yellow: Centre "Type your name (or Enter for anonymous)", 12
Locate 14, 40: Input Name$
Name$ = UCase$(Name$)
If Name$ < "A" Then Name$ = "ANON"
If Len(Name$) > 8 Then Name$ = Left$(Name$, 8)
Cls: Centre Name$, 14: Sleep 1: Cls
SetUpGame:
_KeyClear: Play OK$
Centre "Choose the Image-Set you would like to use, 1 to 4 (default 1: Animals)", 8
white: Locate 10, 40: Print "1. Animals"; Tab(40); "2. Letters"; Tab(40); "3. Objects"; Tab(40); "4. Shapes"
While k < 1: k = _KeyHit: Wend
If k < 49 Or k > 52 Then k = 49 ' default ANIMALS
SetNum = k - 48
Txt$ = "Using "
Select Case SetNum
Case 1
Txt$ = Txt$ + " Animals set"
Case 2
Txt$ = Txt$ + " Letters set"
Case 3
Txt$ = Txt$ + " Objects set"
Case 4
Txt$ = Txt$ + " Shapes set"
End Select
Cls: Play OK$: yellow: Centre Txt$, 15: Sleep 1: Cls
ShowBest
ChooseSize:
yellow: Centre "Choose the level you wish to play (default level 2: 8 tiles)", 24: white
yellow: Centre "or press Delete to reset all records", 25
_KeyClear
k = 0
While k < 13: k = _KeyHit: Wend
If k = 21248 Then ResetRecords: ShowBest
If k < 48 Or k > 57 Then k = 50
SizeNum = k - 48
If SizeNum > 9 Then SizeNum = 2
Cls
Txt$ = "Playing with " + Str$(NT(SizeNum)) + " tiles (Record low: "
If Best$(SizeNum + 1, 2) = "1000" Then Txt$ = Txt$ + "N/A" + ")" Else Txt$ = Txt$ + LTrim$(Best$(SizeNum + 1, 2)) + ")"
Centre Txt$, 12
Sleep 1: Cls
SetupGrid: ' number of tiles, columns and rows in the grid
Select Case SizeNum
Case 0
NumTiles = 4
NumCols = 2
NumRows = 2
Case 1
NumTiles = 6
NumCols = 3
NumRows = 2
Case 2
NumTiles = 8
NumCols = 4
NumRows = 2
Case 3 '
NumTiles = 12
NumCols = 4
NumRows = 3
Case 4
NumTiles = 16
NumCols = 4
NumRows = 4
Case 5
NumTiles = 20
NumCols = 5
NumRows = 4
Case 6
NumTiles = 24
NumCols = 6
NumRows = 4
Case 7
NumTiles = 30
NumCols = 6
NumRows = 5
Case 8
NumTiles = 36
NumCols = 6
NumRows = 6
Case 9
NumTiles = 42
NumCols = 7
NumRows = 6
End Select
PositionGrid:
HorOffset = sw / 2 - (NumCols * 29) ' offset from screen left
VertOffset = 250 - NumRows * 25 ' offset from screen top
SetTilePositions: '
Dim Tiles(NumTiles, 4) ' set array size for this grid
For a = 1 To NumTiles
Tiles(a, 1) = HorOffset + (a - 1) * 58 Mod (58 * NumCols) ' horiz position of each cell
Tiles(a, 2) = VertOffset + Int((a - 1) / NumCols) * 58 ' vert position of each cell
Next
SetTiles:
For a = 1 To NumTiles / 2
handl$ = "recpics" + LTrim$(Str$(SetNum)) + "/" + LTrim$(Str$(a)) + ".png" 'set path to pic
Tiles(a, 3) = _LoadImage(handl$) ' first tile of each pair
Tiles(a + NumTiles / 2, 3) = Tiles(a, 3) ' second tile of each pair
Next
Shuffle:
WIPE "04": Centre "Shuffling...", 12
For a = 1 To 15
Play "t200v30o3l64w8cgp32" ' click,click...
Next
Sleep 1: Cls: WIPE "28"
For a = 1 To NumTiles ' for each tile in turn
swop = Int(Rnd * NumTiles) + 1 ' choose a random tile number
Swap Tiles(a, 3), Tiles(swop, 3) ' swap their images
Next
Centre "Shuffled", 12: Sleep 1: WIPE "12"
white: For a = 1 To NumTiles
Line (Tiles(a, 1), Tiles(a, 2))-(Tiles(a, 1) + 50, Tiles(a, 2) + 50), , BF ' hidden tiles
Next
DrawGrid:
x1 = HorOffset - 3: y1 = VertOffset - 3: x2 = HorOffset + NumCols * 58 - 5: y2 = VertOffset + NumRows * 58 - 5
TileNum = 1
yellow: Line (x1, y1)-(x2, y2), , B
For a = 1 To NumTiles
Select Case Tiles(TileNum, 4) ' (all start as not picked or found yet, status 0)
Case 0 ' not picked or found, show white
white
Line (Tiles(TileNum, 1), Tiles(TileNum, 2))-(Tiles(TileNum, 1) + 50, Tiles(TileNum, 2) + 50), , BF
Case 1 ' picked in pick1, show image
_PutImage (Tiles(TileNum, 1), Tiles(TileNum, 2))-(Tiles(TileNum, 1) + 50, Tiles(TileNum, 2 + 50)), Tiles(TileNum, 3)
Case 2 ' already found - show black and re-try
black
Line (Tiles(TileNum, 1), Tiles(TileNum, 2))-(Tiles(TileNum, 1) + 50, Tiles(TileNum, 2) + 50), , BF
End Select
Next
Pick = 1 ' reset for first of 2 picks
InvitePicks:
Txt$ = "Selected Size: " + LTrim$(Str$(NumTiles)) + " tiles"
yellow: Centre Txt$, 1
Action:
Txt$ = "Your tries: " + LTrim$(Str$(Score)) + " Record (lowest): "
If Best$(SizeNum + 1, 2) = "1000" Then Txt$ = Txt$ + "N/A" Else Txt$ = Txt$ + Best$(SizeNum + 1, 2)
Centre Txt$, 2
Centre "Use the mouse to select 2 tiles", 30
GetPick:
Repick = 0
m = _MouseInput
Do
Do While _MouseInput: Loop ' clear mouse
If _MouseButton(1) Then
x = _MouseX: y = _MouseY
If x < HorOffset Or x > HorOffset + NumCols * 58 Or y < VertOffset Or y > VertOffset + NumRows * 58 Then GoTo GetPick ' ignore if outside grid
tilex = x - (x - HorOffset) Mod 58 ' convert mouse position to grid offset position
tiley = y - (y - VertOffset) Mod 58
TileNum = ((Int((tiley - VertOffset) / 58) + 1) - 1) * NumCols + column + Int((tilex - HorOffset) / 58) + 1 ' find this tile number
If Tiles(TileNum, 4) <> 0 Then Repick = 1: Exit Do
pink: Line (tilex, tiley)-(tilex + 50, tiley + 50), , BF ' colour the tile pink (temporarily)
_Delay .2
TileCheck ' checks both tiles for match, and adjusts Found count
End If
Loop
If Repick = 1 Then GoTo GetPick
'Run
Sub ResetRecords
Cls
Open "Recallbest" For Output As #1
For a = 0 To 9: Write #1, "????", "1000": Next ' write defaults to file
Close
Centre "The Records have been reset", 12
Sleep 1
Open "RecallBest" For Input As #1
For a = 0 To 9
Input #1, Best$(a, 1), Best$(a, 2) ' read back into array
Next
Close
End Sub
Sub ShowBest:
yellow: Centre "Best (lowest) number of attempts for each level", 10
Centre "Level Tiles Lowest By", 12
Locate 13, 1
Open "RecallBest" For Input As #1
For a = 1 To 10
Input #1, Best$(a, 1), Best$(a, 2)
white: Print Tab(33); a - 1; Tab(41); NT(a - 1); Tab(50);
If Best$(a, 2) = "1000" Then Print "N/A"; Else Print Best$(a, 2);
Print Tab(58); Best$(a, 1)
Next
Close
End Sub
Sub TileCheck
If Tiles(TileNum, 4) <> 0 Then Play "o2l32w1ec": Exit Sub ' ignore pick if tile is already found or picked in pick 1
_PutImage (Tiles(TileNum, 1), Tiles(TileNum, 2))-(Tiles(TileNum, 1) + 50, Tiles(TileNum, 2) + 50), Tiles(TileNum, 3) ' show image
If Pick = 1 Then ' if this is first pick of pair.
Tiles(TileNum, 4) = 1
Score = Score + 1
Txt$ = "Your tries: " + Str$(Score) + " Record (lowest): "
If Best$(Size, 2) = "1000" Then Txt$ = Txt$ + "N/A" Else Txt$ = Txt$ + Best$(Size, 2)
yellow: Centre Txt$, 2
Pick1 = TileNum ' set Pick1 to this tile number,
Pick = 2: Exit Sub ' and return for pick 2
Else
CompareTiles: ' this is pick 2
Select Case Tiles(TileNum, 4) ' get tile status (0 = fresh, 1 = pick1, 2 = empty)
Case 0 ' fresh (not already picked or found)
If Tiles(TileNum, 3) = Tiles(Pick1, 3) Then ' if pick 1 and this tile match,
Play OK$: yellow: Centre "A match", 25
Sleep 1: WIPE "25"
NumFound = NumFound + 2 ' add 2 to Found count,
Tiles(TileNum, 4) = 2: Tiles(Pick1, 4) = 2 ' change both status to Found,
black ' and set black as colour to re-paint cell
Else ' but if no match,
Play "o2l32w1ec": Centre "No Match", 25
white
Sleep 1: WIPE "25"
Tiles(Pick1, 4) = 0: Tiles(TileNum, 4) = 0 ' and set both status back to freshwhite ' set white as colour to re-paint cell
End If
Line (Tiles(TileNum, 1), Tiles(TileNum, 2))-(Tiles(TileNum, 1) + 50, Tiles(TileNum, 2) + 50), , BF ' re-paint this tile
Line (Tiles(Pick1, 1), Tiles(Pick1, 2))-(Tiles(Pick1, 1) + 50, Tiles(Pick1, 2) + 50), , BF ' re-paint pick1 tile
End Select
Pick = 1: Pick1 = 0 ' change back to Pick 1
End If
If NumFound = NumTiles Then Finished
End Sub
Sub Finished
Cls
aqua
Play "o3l32cego4c"
Txt$ = "Game finished in " + LTrim$(Str$(Score)) + " tries"
Centre Txt$, 5
Select Case Score
Case Is = NumTiles / 2
Centre "A perfect score! ", 7
Case NumTiles / 2 To NumTiles
Centre "Excellent! ", 7
Case Is < NumTiles * 2
Centre "Well done! ", 7
End Select
UpDateHiScores:
If Score < Val(Best$(SizeNum + 1, 2)) Then
Centre "You created a new Best-Score record for this level!", 9
Best$(SizeNum + 1, 1) = Name$: Best$(SizeNum + 1, 2) = Str$(Score)
Open "RecallBest" For Output As #1
For a = 1 To 10
Write #1, Best$(a, 1), Best$(a, 2)
Next
Close
End If
Sleep 2: Cls
ShowBest
yellow: Centre "Press a key", 26
Sleep
System
End Sub
Sub yellow
Color _RGB(255, 255, 0)
End Sub
Sub white
Color _RGB(255, 255, 255)
End Sub
Sub black
Color _RGB(0, 0, 0)
End Sub
Sub pink
Color _RGB(255, 150, 150)
End Sub
Sub aqua
Color _RGB(100, 250, 200)
End Sub
Sub WIPE (LN$) ' erase lines of text
For A = 1 To Len(LN$) - 1 Step 2
WR = Val(Mid$(LN$, A, 2)) ' number of the row to be erased is 2 digits
Locate WR, 1: Print Space$(CPR - 1);
Next
End Sub
Sub Centre (Txt$, LineNum)
Ctr = Int(CPR / 2 - Len(Txt$) / 2) + 1
Locate LineNum, Ctr
Print Txt$;
End Sub
Sub Instructions
Play OK$: yellow: Centre "Recall", 3
Centre "A Game for one player to test and improve memory and recall skills", 5
Print: Print: white
Print " The playing field is a rectangular grid of tiles, each tile holding one of several pairs"
Print " of hidden pictures or symbols. Before the game starts, the player chooses the type of"
Print " image they prefer (animals, letters, shapes or objects), and a game-level from 0 to 9,"
Print " which sets the number of tiles in the grid (from 4 to 42).": Print
Print " To play, they select two tiles with the mouse for each try. As each tile is selected, it"
Print " is revealed, and when both have been selected, they are compared by the computer.": Print
Print " If the tiles match they are removed. If they don't match, they are re-hidden. The player"
Print " then starts their next try. When all tiles have been found the game ends and the number"
Print " of tries used is shown.": Print
Print " A record is kept of the best (lowest) result for each game-level and if this is beaten,"
Print " the player's name and score replace these."
yellow: Centre "Press a key to start", 22
Sleep
Play OK$
Cls
End Sub
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, Western Australia.) 
Please visit my Website at: http://oldendayskids.blogspot.com/
Please visit my Website at: http://oldendayskids.blogspot.com/