05-05-2022, 06:18 AM
Here's a little prog I wrote that helps to keep old Al Zimers at bay. I guess I could use mouse buttons to move, but maybe later...
I know it's basic BASIC, but I'd appreciate a bit of advice on how I could improve it.
'Recall - the latest
but maybe later...
I know it's basic BASIC, but I'd appreciate a bit of advice on how I could improve it.
'Recall - the latest
Code: (Select All)
_FullScreen
Screen 12: Color , 1: Cls
Randomize Timer
' grid sizes 1-3 numtiles=18, 30, 42 for size 1-3 (A-C, A-E, A-G) 3x6, 5x6, 7x6 grids
' num horizontal rows always 6 numrows=6
' numcols calculated as number of cells / 6 ' numcols=numtiles/6
' grid top row always 2 gtop=2
' gridleft column calculated from numcols gleft= 40-int(numcols/2)
' Max players 4 maxplrs=4
' score 2 points per pair,
' letters read from data first char A-G
' colours (11, 12 and 14) in data as chr$(value of colour number + 76) W, X or Z colours 11, 12 and 14 are chr$(87, 88 and 90) or (W, X and Z) (colour 13 not used)
' Player names stored as names$(4), np is no of players, plr is current player default names PLAYER 1 etc
' scores stored as score(6) score(plr)
' grid frame left calculated from gleft gfleft= gleft*8-4
' grid frame top row always 28 gftop=28
' grid frame width calculated from numcols gfwidth= 8*numcols+8
' grid frame height always 102 gfheight=102
Common Shared gridsize$, numtiles, tiles$(), tile, numrows, numcols, gtop, gleft, gbottom, gright, maxplrs, np, plr, score(), letr$, colr$, names$(), gfleft, gftop, gfwidth, gfheight, picks(), pick, IsAMatch
Common Shared csrline, p, pickline, msgline, nameline, namehoriz, keycode, numfound, move$, pick$, match$, nomatch$, error$, old$
Data AW,AW,AX,AX,AZ,AZ,BW,BW,BX,BX,BZ,BZ,CW,CW,CX,CX,CZ,CZ,DW,DW,DX,DX,DZ,DZ,EW,EW,EX,EX,EZ,EZ,FW,FW,FX,FX,FZ,FZ,GW,GW,GX,GX,GZ,GZ
Dim tiles$(42), score(6), names$(6), picks(2)
For A = 1 To 42: Read tiles$(A): Next
move$ = "l16o4c": pick$ = "l16o4ce": match$ = "l16o3cego4c": nomatch$ = "l16o4co3gec": old$ = "l16o3c"
maxplrs = 6: numrows = 6: gtop = 3: gbottom = 8: gftop = 28: gfheight = 102: msgline = 16: csrline = 10: pickline = 12: nameline = 14: csrh = 40: plr = 1
Instructions
GetGridSize:
Color 14
Locate 15, 30
Print "Choose a grid size (1 to 3)"
While InKey$ <> "": Wend
Play move$
ChooseSize:
k$ = InKey$
If k$ = "" Then GoTo ChooseSize
Select Case k$
Case Is = "1"
numtiles = 18 ' numtiles is number of tiles for that size
Case Is = "2"
numtiles = 30
Case Else
numtiles = 42
End Select
numcols = numtiles / 6 ' numcols is number of columns for that numtiles; numrows is always 6
gleft = 39 - Int(numcols / 2) ' gleft is left column of grid
gright = gleft + numcols ' gright is right column of grid
gfleft = gleft * 8 - 4 ' gfleft is left pixels of grid-frame
gfwidth = 8 * numcols + 6 ' gfwidth is width of grid-frame
Cls
Locate 1, 40 - numtiles / 2
For A = 1 To numtiles
Color Asc(Right$(tiles$(A), 1)) - 76 ' color will be taken from right char of tiles$(..)
Print Left$(tiles$(A), 1); ' letter will be taken from left char of tiles$(..)
Next
PresentGgrid:
ShowGrid ' call showgrid sub to display the grid of tiles before shuffling
_Delay .5
Shuffle
ShowGrid ' call showgrid sub again to display shuffled tiles
Sleep 1
ShowHiddenGrid
GetNames:
np = 0
Color 14
Locate msgline, 26: Print "Enter a name for each player"
Print Tab(6); "Press <SPACE> for automatic names and <ENTER> to finish entering names"
GetAName:
Color 15
Locate msgline + 2, 35: Print Space$(10)
While InKey$ <> "": Wend
Locate msgline + 2, 35: Input n$ ' n$ temporary only
If n$ = "" Then GoTo NoMore ' <SPACE> to finish entering names
np = np + 1 ' np is number of players entered, up to maxplrs
If n$ = " " Then n$ = "PLAYER" + Str$(np) ' default names
n$ = UCase$(n$) ' change to upper-case
names$(np) = n$ ' store in names$()
Locate msgline + np + 2, 35
Print names$(np) ' show all capitalised names below msgline
Play ok$
If np = maxplrs Then GoTo NoMore
GoTo GetAName
NoMore:
Play move$
Locate msgline, 1: Print Space$(720) ' clear message area and names display
' _________________________________________________________________________________________________ Start of Game __________________________________________________
NextTurn: ' return here after every player's turn if not matched
ScreenPrep:
ShowScores ' update and redraw after each player's turn
Color 14
Locate csrline, 40: Print "*"
Locate pickline, 35: Print Space$(20)
namehoriz = 40 - Int(Len(names$(plr)) / 2)
Locate nameline, 1: Print Space$(80)
Locate nameline, namehoriz: Print names$(plr): Sleep 1 ' ensure correct player is named
Locate msgline, 23: Print " Press a key to move into the grid "
MoveIn: ' pick has already been set to 1
k$ = InKey$: If k$ = "" Then GoTo MoveIn
Play move$
Locate csrline, 40: Print " "
csrv = gbottom: csrh = 40: tile = numtiles - Int(numcols / 2)
Color 14: Locate csrv, csrh: Print "*"
Locate msgline, 1: Print Space$(80)
Locate msgline, 3: Print "Use the four arrow-keys to move to a tile, then press <SPACE> to select it"
pick = 1 ' first pick. don't inc player as this is done only if match fails
BeginAction:
Locate csrv, csrh: Color 14: Print "*"
k$ = InKey$: If k$ = "" Or k$ = Chr$(13) Then GoTo BeginAction
GetKey (k$) ' 32 for space (pick a tile), or 272, 275,277 or 280 for cursor
Color 15
Select Case keycode
Case Is = 272 ' up
If csrv > gtop Then
Play move$
Locate csrv, csrh
Color 15: If tiles$(tile) <> " N" Then Print Chr$(249) Else Print " "
csrv = csrv - 1: tile = tile - numcols
colr = Asc(Right$(tiles$(tile), 1)) - 76: letr$ = Left$(tiles$(tile), 1)
Locate csrv, csrh: Color 14: Print "*"
GoTo BeginAction
Else GoTo BeginAction
End If
Case Is = 280 ' down
If csrv < gbottom Then
Play move$
Locate csrv, csrh
Color 15: If tiles$(tile) <> " N" Then Print Chr$(249) Else Print " "
colr = Asc(Right$(tiles$(tile), 1)) - 76: letr$ = Left$(tiles$(tile), 1)
csrv = csrv + 1: tile = tile + numcols
colr = Asc(Right$(tiles$(tile), 1)) - 76: letr$ = Left$(tiles$(tile), 1)
Locate csrv, csrh: Color 14: Print "*"
GoTo BeginAction
Else GoTo BeginAction
End If
Case Is = 275 ' left
If csrh > gleft + 1 Then
Play move$
Locate csrv, csrh
Color 15: If tiles$(tile) <> " N" Then Print Chr$(249) Else Print " "
colr = Asc(Right$(tiles$(tile), 1)) - 76: letr$ = Left$(tiles$(tile), 1)
csrh = csrh - 1: tile = tile - 1
colr = Asc(Right$(tiles$(tile), 1)) - 76: letr$ = Left$(tiles$(tile), 1)
Locate csrv, csrh: Color 14: Print "*"
GoTo BeginAction
Else GoTo BeginAction
End If
Case Is = 277 ' right
If csrh < gright Then
Play move$
Locate csrv, csrh
Color 15: If tiles$(tile) <> " N" Then Print Chr$(249) Else Print " "
colr = Asc(Right$(tiles$(tile), 1)) - 76: letr$ = Left$(tiles$(tile), 1)
csrh = csrh + 1: tile = tile + 1
colr = Asc(Right$(tiles$(tile), 1)) - 76: letr$ = Left$(tiles$(tile), 1)
Locate csrv, csrh: Color 14: Print "*"
GoTo BeginAction
Else GoTo BeginAction
End If
Case Is = 32 ' pick a tile
' for both picks:
Play pick$
If tiles$(tile) = " N" Then ' check if already picked - if so, ignore and get another action
Play old$
Locate msgline, 1: Print Space$(80)
Locate msgline, 32
Print "Already matched!"
Sleep 1
ShowHiddenGrid
Locate msgline, 1: Print Space$(80)
GoTo BeginAction
End If
If pick = 2 And tile = picks(1) Then ' check if second pick is same tile as first - if so, get another action
Play nomatch$
Locate msgline, 1: Print Space$(80)
Locate msgline, 25
Print "You have already picked this tile!"
Sleep 1
Locate msgline, 25: Print Space$(40)
GoTo BeginAction
End If
' if we reached here, tile is still live. May be pick 1 or 2 if we got to here, tile is still valid
colr = Asc(Right$(tiles$(tile), 1)) - 76: letr$ = Left$(tiles$(tile), 1) ' show picked tile in situ
Locate csrv, csrh: Color colr: Print letr$; '
picks(pick) = tile ' identify tile as pick 1 or 2
If pick = 1 Then Locate pickline, 37 Else Locate pickline, 43 ' show picked tile in pickline
Print letr$
If pick = 1 Then
pick = 2
GoTo BeginAction
Else
CheckMatch
Locate msgline, 1: Print Space$(80)
GoTo ScreenPrep ' if first pick, change to second and go back for second. If second, check for a match then setup screen again
End If
End Select
' -------------------------------- SUBS BELOW --------------------------------------
Sub Instructions
Locate 1, 19
For a = 1 To 42
colr = Asc(Right$(tiles$(a), 1)) - 76: letr$ = Left$(tiles$(a), 1)
Color colr: Print letr$;
Next
Color
Locate 3, 37: Color 14: Print "Recall": Print Tab(20); "A Game for up to 6 players by Phil Taylor"
Color 15: Print
Print " This game is a fun way to exercise players' memory and recall skills."
Print
Print " A grid of tiles is displayed, each holding a coloured (but hidden) letter."
Print " There are two of each combination of letter and colour, as shown above."
Print
Print " Before the game starts, players choose the number of tiles to be used, either"
Print " 18, 30, or 42."
Print
Print " Players take turns to move within this grid with the ";: Color 14: Print "four cursor keys";: Color 15: Print " and"
Print " select two tiles with the";: Color 14: Print " <SPACE>";: Color 15: Print " key for each turn."
Print
Print " As each tile is selected it is revealed, and when the second one is selected,"
Print " the two are compared. If they match they are removed and the player scores 2"
Print " points and has another turn. But if not, they are re-hidden and the next"
Print " player plays."
Print
Print " Two points are scored for each matching pair of tiles found and when all the"
Print " tiles have been found, the game ends and the winner is announced."
Print
Color 14: Print Tab(27); " Press any key to commence."
Sleep: Cls: Play ok$
End Sub
Sub GetNames ' set names, np and plr=1
End Sub
Sub ShowGrid
For A = 0 To 5: For b = 1 To numcols
Locate gtop + A, gleft + b
Color Asc(Right$(tiles$(A * numcols + b), 1)) - 76
Print Left$(tiles$(A * numcols + b), 1)
Next: Next
PSet (gfleft, gftop): frame$ = "r" + Str$(gfwidth) + "d" + Str$(gfheight) + "l" + Str$(gfwidth) + "u" + Str$(gfheight): Draw frame$
End Sub
Sub ShowHiddenGrid
For A = 0 To numrows - 1
For b = 1 To numcols
Locate gtop + A, gleft + b
tilenum = A * numcols + b
Color 15: If tiles$(tilenum) <> " N" Then Print Chr$(249) Else Print " " ' show grid with tiles hidden
Next
Next
End Sub
Sub ShowScores
Locate 2, 1: For A = 1 To np: Print Tab(2); names$(A); Tab(12); score(A);: Next ' list names and scores at top left
End Sub
Sub GetKey (k$) ' will return asc of key for normal chars, or 200+ asc of second digit for control keys
If Len(k$) > 1 Then keycode = Asc(Right$(k$, 1)) + 200 Else keycode = Asc(UCase$(k$))
End Sub
Sub Shuffle
For A = 1 To numtiles - 1: t2 = Int(Rnd * numtiles) + 1: Swap tiles$(A), tiles$(t2): Next
End Sub
Sub CheckMatch
Locate msgline, 1: Print Space$(80): Locate msgline, 37
'
If tiles$(picks(1)) = tiles$(picks(2)) Then ' a match
Play match$
Print "A match"
score(plr) = score(plr) + 2 ' inc scores and display them
tiles$(picks(1)) = " N": tiles$(picks(2)) = " N"
numfound = numfound + 2
ShowScores
If numfound = numtiles Then EndGame: System
'
Else ' no match
Play nomatch$
Print "No match";: plr = plr + 1: If plr > np Then plr = 1 ' ready for next player's turn if no match
End If
Sleep 1
Locate msgline, 1: Print Space$(80) ' finished with check: clear message line
Locate pickline, 37: Print Space$(8)
csrh = 40: csrv = csrline: tile = numtiles - Int(numcols / 2)
picks1 = 0: picks2 = 0: pick = 1
ShowHiddenGrid
End Sub
Sub EndGame
Cls
Locate 10, 1
Color 14: Print Tab(34); "Final Scores"
Print: Color 15
For a = 1 To np
Print Tab(30); names$(a); Tab(50); score(a)
Next
Sleep
Cls
End Sub