05-31-2025, 03:20 AM
Recall is intended to help improve the memory and recall skills.
Instructions are all in-game.
Maybe this should have gone into Works in Progress,as I intend to convert for mouse operation, but here it is:
Instructions are all in-game.
Maybe this should have gone into Works in Progress,as I intend to convert for mouse operation, but here it is:
Code: (Select All)
DW = _DesktopWidth: DH = _DesktopHeight: sw = 1200
Screen _NewImage(sw, 640, 32)
SetFont: F& = _LoadFont("C:\WINDOWS\fonts\courbd.ttf", 20, "monospace"): _Font F&
LHS = (DW - sw) / 2: Top = (DH - 800) / 2 ' position of window
_ScreenMove LHS, Top ' place window there
Common Shared CPR, Ctr, RowNum, Txt$, k, OK$, Bad$, End$, NumTries, Set, Match, SetNum, NumTiles, Tiles(), TileNum, NumCols, NumRows
Common Shared BestScore, Nm$, Name$, Score, GCtr, CsrV, CsrH, VertOffset, HorOffset, Pick, Pick1, repick, Best$()
CPR = Int(sw / _PrintWidth("X")) ' chars per lina at this screen setting
Ctr = Int((CPR + 1) / 2): GCtr = sw / 2 ' text and graphic horiz centres
Randomize Timer
OK$ = "t120o3l32w1ce": Bad$ = "o2l32w1ec": End$ = "o3l32cego4c": Shuffle$ = "t200v30o3l64w8cgp32" ' sound strings
Dim Best$(10, 2)
If Not _FileExists("RecallBest") Then
Open "RecallBest" For Output As #1
For a = 1 To 10
Write #1, "?", "?" ' create new recors list
Next
End If
Close #1
Instructions
GetImageSet:
Cls: Play OK$
Centre "Choose the Image-Set you would like to use", 8
white: Locate 10, 40: Print "1. Animals"; Tab(40); "2. Letters"; Tab(40); "3. Shapes"; Tab(40); "4. Objects"
While set$ < "1" Or set$ > "4": set$ = InKey$: Wend ' use string to allow Enter for default
SetNum = Val(set$): If SetNum < 1 Then SetNum = 4
Txt$ = "Playing set " + LTrim$(Str$(SetNum))
Select Case SetNum
Case 1
Txt$ = Txt$ + " (Animals)"
Case 2
Txt$ = Txt$ + " (Letters)"
Case 3
Txt$ = Txt$ + " (Shapes)"
Case 4
Txt$ = Txt$ + " (Objects)"
End Select
Cls: Play OK$: yellow: Centre Txt$, 15: Sleep 1: Cls
KeepOrClearRecords:
yellow: Centre "Record (lowest) number of Tries for Levels", 8
Open "RecallBest" For Input As #1
For a = 0 To 9
Input #1, Best$(a, 1), Best$(a, 2) ' load records list
white: Print Tab(38); a; Tab(43); Best$(a, 1); Tab(48); Best$(a, 2)
Next
Close
yellow: Centre "Press Delete to reset all of these records", 21
Centre "(or any other key to keep them)", 22
_KeyClear
GetKeep:
k = _KeyHit
If k < 1 Then GoTo GetKeep
If k = 21248 Then ' Delete key
Open "Recallbest" For Output As #1: For a = 0 To 9: Write #1, "?", "?": Next: Close
Centre "All records have been reset", 24
Else
Centre "The records remain unchanged", 24
End If
Sleep 1: Cls: Play OK$
GetGridSize:
yellow: Centre "Choose size of the Set to be used", 7: white
Locate 9, 40: Print "0. 4 tiles"; Tab(40); "1. 6 tiles"; Tab(40); "2. 8 tiles"; Tab(40); "3. 12 tiles"; Tab(40); "4. 16 tiles"
Print Tab(40); "5. 20 tiles"; Tab(40); "6. 24 tiles"; Tab(40); "7. 30 tiles"; Tab(40); "8. 36 tiles"; Tab(40); "9. 42 tiles"
_KeyClear
While k$ = "": k$ = InKey$: Wend
Set = Val(k$)
If Set < 0 Then Set = 2 ' Enter gives default set 2
Txt$ = "Playing Level " + LTrim$(Str$(Set))
Cls: Play OK$: yellow: Centre Txt$, 15: Sleep 1: Cls
SetupRound:
Select Case Set ' set shape of grid
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
CsrV = 100 + (NumRows) * 58 ' cursor vertical pos starts below grid
CsrH = GCtr - 29 ' cursor horiz pos starts near centre (cells are 58 px wide so cell is across centre)
Dim Tiles(NumTiles, 4) ' 4 elements for each tile: horiz position, vert position, image, and status (free, picked or found)
HorOffset = sw / 2 - (NumCols * 29) ' lhs of grid
VertOffset = 250 - NumRows * 25 ' top of grid
Cls
SetTiles:
For a = 1 To NumTiles
Tiles(a, 1) = HorOffset + (a - 1) * 58 Mod (58 * NumCols) ' set horiz pos of each tile
Tiles(a, 2) = VertOffset + Int((a - 1) / NumCols) * 58 ' set vert pos for each cell
Next
GetPics:
Centre "These tiles will be shuffled and used", 4
For a = 1 To NumTiles / 2
Tiles(a, 3) = _LoadImage("recpics" + LTrim$(Chr$(SetNum + 48)) + "/" + Chr$(64 + a) + ".jpg") ' get images for first half of group of tiles
_PutImage (Tiles(a, 1), Tiles(a, 2))-(Tiles(a, 1) + 50, Tiles(a, 2) + 50), Tiles(a, 3) ' place images at horiz/vert co-ordinates
Tiles(a + NumTiles / 2, 3) = Tiles(a, 3) ' copy images to second half of group of tiles
_PutImage (Tiles(a + NumTiles / 2, 1), Tiles(a + NumTiles / 2, 2))-(Tiles(a + NumTiles / 2, 1) + 50, Tiles(a + NumTiles / 2, 2) + 50), Tiles(a + NumTiles / 2, 3)
Next
Sleep 2: Cls
Shuffle:
Centre "Shuffling tiles...", 28
Sleep 1
For a = 1 To 10
Play Shuffle$
Next
Sleep 1: WIPE "28"
For a = 1 To NumTiles ' select each tile in turn
swop = Int(Rnd * NumTiles) + 1 ' select a random tile
Swap Tiles(a, 3), Tiles(swop, 3) ' swap them
Next
For a = 1 To NumTiles
white
Line (Tiles(a, 1), Tiles(a, 2))-(Tiles(a, 1) + 50, Tiles(a, 2) + 50), , BF ' display tiles as hidden
Next
DrawGrid:
CsrV = VertOffset + NumRows * 58
x1 = HorOffset - 3: y1 = VertOffset - 3: x2 = HorOffset + NumCols * 58 - 5: y2 = VertOffset + NumRows * 58 - 5 ' set position for frame around grid
TileNum = 1
yellow: Line (x1, y1)-(x2, y2), , B ' draw yellow frame
Pick = 1
Centre "Use the four cursor-keys to select a tile, <Space> to select it", 30
StepIn:
NumTries = NumTries + 1
If Found = NumTiles Then Play End$: Done
pink: Line (CsrH, CsrV)-(CsrH + 50, CsrV + 50), , BF
k = 0: _KeyClear
While k = 0: k = _KeyHit: Wend
black: Line (CsrH, CsrV)-(CsrH + 50, CsrV + 50), , BF
TileNum = NumTiles - Int(NumCols / 2)
CsrV = CsrV - 58: CsrH = Tiles(NumTiles - NumCols \ 2, 1) ' reset cursor below grid after each pair-selection
pink: Line (CsrH, CsrV)-(CsrH + 50, CsrV + 50), , BF
Action:
Txt$ = "Your tries: " + LTrim$(Str$(NumTries)) + " Record (lowest): " + Best$(Set, 1)
Centre Txt$, 2
k = 0 ' clear k from previous press
While k < 32: k = _KeyHit: Wend ' wait for key press
Select Case k
Case 18432 ' up cursor
If CsrV < VertOffset + 10 Then GoTo Action ' if already in top row, ignore and get another action
Select Case Tiles(TileNum, 4)
Case 0 ' old tile was not picked or found
white: Line (CsrH, CsrV)-(CsrH + 50, CsrV + 50), , BF ' change cell colour back to white
Case 1 ' old tile had been picked in pick 1 (it won't be 1 if this is still pick 1)
_PutImage (CsrH, CsrV)-(CsrH + 50, CsrV + 50), Tiles(TileNum, 3) ' re-show the image
Case 2 ' old tile had already been found
black: Line (CsrH, CsrV)-(CsrH + 50, CsrV + 50), , BF ' re-colour the cell black
End Select
CsrV = CsrV - 58
TileNum = TileNum - NumCols
status = Tiles(TileNum, 4)
pink: Line (Tiles(TileNum, 1), Tiles(TileNum, 2))-(Tiles(TileNum, 1) + 50, Tiles(TileNum, 2) + 50), , BF
Case 20480 ' down cursor
If CsrV > VertOffset + 58 * (NumRows - 2) Then GoTo Action ' if already in bottom row, ignore and get another action
Select Case Tiles(TileNum, 4)
Case 0
white: Line (CsrH, CsrV)-(CsrH + 50, CsrV + 50), , BF
Case 1
_PutImage (CsrH, CsrV)-(CsrH + 50, CsrV + 50), Tiles(TileNum, 3)
Case 2
black: Line (CsrH, CsrV)-(CsrH + 50, CsrV + 50), , BF
End Select
CsrV = CsrV + 58
TileNum = TileNum + NumCols
pink: Line (Tiles(TileNum, 1), Tiles(TileNum, 2))-(Tiles(TileNum, 1) + 50, Tiles(TileNum, 2) + 50), , BF
Case 19200 ' left cursor
If CsrH < HorOffset + 58 Then GoTo Action ' if already in left column, ignore and get another action
Select Case Tiles(TileNum, 4)
Case 0
white: Line (CsrH, CsrV)-(CsrH + 50, CsrV + 50), , BF
Case 1
_PutImage (CsrH, CsrV)-(CsrH + 50, CsrV + 50), Tiles(TileNum, 3)
Case 2
black: Line (CsrH, CsrV)-(CsrH + 50, CsrV + 50), , BF
End Select
CsrH = CsrH - 58
TileNum = TileNum - 1
pink: Line (Tiles(TileNum, 1), Tiles(TileNum, 2))-(Tiles(TileNum, 1) + 50, Tiles(TileNum, 2) + 50), , BF
Case 19712 ' right cursor
If CsrH > HorOffset + (NumCols - 2) * 58 + 29 Then GoTo Action ' if already in bottom row, ignore and get another action
Select Case Tiles(TileNum, 4)
Case 0
white: Line (CsrH, CsrV)-(CsrH + 50, CsrV + 50), , BF
Case 1
_PutImage (CsrH, CsrV)-(CsrH + 50, CsrV + 50), Tiles(TileNum, 3)
Case 2
black: Line (CsrH, CsrV)-(CsrH + 50, CsrV + 50), , BF
End Select
CsrH = CsrH + 58
TileNum = TileNum + 1
pink: Line (Tiles(TileNum, 1), Tiles(TileNum, 2))-(Tiles(TileNum, 1) + 50, Tiles(TileNum, 2) + 50), , BF
Case 32 ' Space to select tile
If Tiles(TileNum, 4) <> 0 Then Play Bad$: GoTo Action ' (tilenum,4) is status of this tile - if not 0 it has been seleted or found
_PutImage (CsrH, CsrV)-(CsrH + 50, CsrV + 50), Tiles(TileNum, 3) ' tile still clean - show image
If Pick = 1 Then ' if this is the first pick of the pair
Pick1 = TileNum ' store this tile as Pick1,
Tiles(TileNum, 4) = 1 ' change its status to Picked,
Pick = 2 ' and prepare for pick 2
GoTo Action
Else ' but if this is pick 2,
CompareTiles ' call the CompareTiles sub , which returns Repick if already picked or found, or Match if matching pair
If repick = 1 Then GoTo Action
If Match = 1 Then Found = Found + 2 ' increment the Found count
Pick = 1 ' prepare for new first pick
CsrV = VertOffset + NumRows * 58: CsrH = GCtr - 29 ' put cursor at bottom centre of grid
TileNum = NumTiles - Int(NumCols / 2) ' reset tile number to bottom centre tile
GoTo StepIn ' back for next try
End If
End Select
GoTo Action
Sub CompareTiles
Match = 0: repick = 0 ' initialise
Select Case Tiles(TileNum, 4) ' look at status of the current cell
Case 0 ' if still untouched
If Tiles(TileNum, 3) = Tiles(Pick1, 3) Then ' if the same as pick 1 tile
Play OK$: Centre "A match", 25
Sleep 1: Match = 1 ' set Match flag
Tiles(TileNum, 4) = 2: Tiles(Pick1, 4) = 2
black ' make working colour black,
Else ' if not the same as pick 1 tile
Play Bad$
Centre "No Match", 25
Sleep 1: WIPE "25"
Tiles(Pick1, 4) = 0: Tiles(TileNum, 4) = 0 ' return both tiles' status to 0 (unpicked and unfound)
white ' make working colour white,
End If
Line (Tiles(TileNum, 1), Tiles(TileNum, 2))-(Tiles(TileNum, 1) + 50, Tiles(TileNum, 2) + 50), , BF
Line (Tiles(Pick1, 1), Tiles(Pick1, 2))-(Tiles(Pick1, 1) + 50, Tiles(Pick1, 2) + 50), , BF ' colour both in black or white
End Select
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 (RN$) ' erase a row of text (2 digits for each row)
For A = 1 To Len(RN$) - 1 Step 2 ' get pairs of digits from sring
WR = Val(Mid$(RN$, A, 2)) ' get row number to wipe
Locate WR, 1: Print Space$(CPR - 1); ' print a full row of spaces there
Next
End Sub
Sub Centre (Txt$, RowNum) ' centre string on the row
Ctr = Int(CPR / 2 - Len(Txt$) / 2) + 1 ' calculate lhs position for text
Locate RowNum, Ctr: Print Txt$; ' print the text there
End Sub
Sub Done
Cls
aqua
Play End$
NumTries = NumTries + 1 ' include this try in result
Locate 18, 74
Txt$ = "Game finished in " + LTrim$(Str$(NumTries)) + " tries"
Centre Txt$, 12
Select Case NumTries
Case Is = NumTiles / 2
Centre "A perfect score! ", 14 ' all found with no mis-hits (musta cheated!)
Case NumTiles / 2 To NumTiles
Centre "Excellent! ", 14 ' mostly hits
Case Is < NumTiles * 2
Centre "Nicely done! ", 14 ' a few misses
End Select
Centre "Congratulations!", 16
Sleep 1
If Val(Best$(Set, 1)) < 1 Then Best$(Set, 1) = "500" ' cope with no record yet - 500 tries should be ample
If NumTries < Val(Best$(Set, 1)) Then ' beat the record
While InKey$ <> "": Wend ' clear key input
Locate 18, 10: Input "A new record for this Grid-size! What name would you like to use"; Name$
Best$(Set, 1) = LTrim$(Str$(NumTries)): Best$(Set, 2) = UCase$(Name$) ' enter score and name into Best$ array
Open "RecallBest" For Output As #1
For a = 0 To 9: Write #1, Best$(a, 1), Best$(a, 2): Next ' write the record list to file
Close
End If
Cls
yellow: Centre "Record (lowest) number of Tries for Levels", 8
Open "RecallBest" For Input As #1
For a = 0 To 9 ' re-display records
Input #1, Best$(a, 1), Best$(a, 2)
white: Print Tab(38); a; Tab(43); Best$(a, 1); Tab(53); Best$(a, 2)
Next
Close
Sleep 3: Run
End Sub
Sub Instructions
yellow: Centre "Recall", 6
Centre "A Game to test and improve your memory and recall skills", 7
Print: Print: white
Print " The playing field is a rectangular grid of cells, each cell holding one of several pairs"
Print " of hidden pictures or symbols. Before the game starts you choose the type of images you"
Print " prefer, animals, letters, shapes or objects, and a grid-size from 0 to 9, which sets the"
Print " number of tiles in the grid (from 4 to 42).": Print
Print " To play, move within the grid with the four Cursor keys, and select two tiles with the"
Print " Space key for each try. As each tile is selected it is revealed, and when both have been"
Print " selected, the two are compared by the computer.": Print
Print " If the tiles match they are removed. If they don't match, they are re-hidden. You then"
Print " start your next try. When all tiles have been found the game ends and you are scored by"
Print " the number of tries you used, the lower the better.": Print
Print " A (re-settable) record is kept of the best result for each grid-size, and if you beat"
Print " one of these you are invited to enter your name to be placed on this record."
yellow: Centre "Press a key to start", 25
While InKey$ = "": Wend
_KeyClear
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/