04-04-2023, 12:29 AM
(This post was last modified: 04-04-2023, 12:31 AM by PhilOfPerth.)
Ok, here is the code as it should have been posted. I had changed the Case Is=32 ( the <Space> key option) to
Any Other Key and removed the Case Else, but in doing so had left one or two variables badly bruised, if not broken.
Hopefully, this is the last posting of this programme, and I think then it will be time to hang up my mouse!
Thanks for your help, Coach!
Keep up the good work; you're a great asset to the Group.
Any Other Key and removed the Case Else, but in doing so had left one or two variables badly bruised, if not broken.
Hopefully, this is the last posting of this programme, and I think then it will be time to hang up my mouse!
Thanks for your help, Coach!
Keep up the good work; you're a great asset to the Group.
Code: (Select All)
' np is number of players, size is selected grid-size (1 to 4)
' numtiles is number of tiles to use (12, 20, 30, 42) for selected size
' numcols is number of columns of tiles, set according to chosen numtiles (3, 5, 5, or 7), numrows is number of rows of tiles (numtiles/numcols)
' face is the pic attached to the tile. Is 50px wide and deep, with 4px clearance on all sides. picnum is the number of the face for tilenum (1 to numtiles/2)
' fleft and ftop are positions for grid frame (ftop is always 75)
' gleft and gright are horiz grid cell limits set by numcols (gleft is centre minus half of numcols: 1200/2 - (int(numcols+1)/2*56)
' tiles() is array of shuffled numbers of the pic on each tile, tilenum is number of the tile being addressed
' tleft is position derived from gleft for each tile. gtop and gbottom are pixel position limits for grid. top is top of each tile, derived from gtop
SCREEN _NEWIMAGE(1200, 640, 32)
RANDOMIZE TIMER
COMMON SHARED k, face, start, numtries, size, end$, bestscore(), bestname$(), nm$, name$(), score(), np, plr, match, setnum
DIM bestscore(4), bestname$(4), name$(4), score(4)
ok$ = "o3l32ce": bad$ = "o2l32ec": end$ = "o3l32cego4c"
numpics = 21: midpix = 600: ftop = 75: gtop = ftop + 2
setnum = 49
PLAY ok$
Instructions
ReadIt:
setnum = _KEYHIT
_LIMIT 30
IF setnum < 1 THEN GOTO ReadIt
CLS
_KEYCLEAR
GetASet:
PLAY ok$
LOCATE 18, 42: PRINT "Which Image-Set would you like, from 1 to 3 (Animals, Letters or Shapes)?"
GetSetNumber:
setnum = _KEYHIT
_LIMIT 30
IF setnum < 1 THEN GOTO GetSetNumber
IF setnum < 49 OR setnum > 51 THEN setnum = 49
PLAY ok$
CLS
LOCATE 18, 60: PRINT "Tile set number"; setnum - 48; "will be used": _DELAY 1: CLS ' setnum is 48 more than actual set-number"
GetPlayerNames:
COLOR _RGB32(100, 250, 200), _RGB32(0, 0, 0)
GetAName:
PLAY ok$
np = np + 1
IF np > 4 THEN np = 4: GOTO LastPlr
TryAgain:
_KEYCLEAR
WIPE "18"
LOCATE 18, 56
PRINT "Name of Player"; np; "(or <Enter> for no more)";: INPUT nm$ ' nm$ is name for player 1, np is 1"
IF nm$ = "" THEN np = np - 1: GOTO LastPlr ' if no name given (finished), jump to lastplayer line
IF nm$ < "A" THEN WIPE "18": GOTO TryAgain ' if illegal name, leave np as 1 and try again
name$(np) = UCASE$(nm$)
GOTO GetAName ' but if a good name, keep it as name$(1) and go back to GetAName
LastPlr:
IF np = 0 THEN np = 1
PLAY ok$
IF np = 1 AND name$(1) = "" THEN name$(1) = "SOLO" ' if only one player, call it solo
WIPE "18"
LOCATE 18, 62
PRINT "Number of players is"; np: _DELAY 1: WIPE "18"
plr = 1
GetGridSize:
_KEYCLEAR
LOCATE 18, 52: PRINT "Choose a grid size, 1 to 4 (4 is the largest)"
Sizes:
k = _KEYHIT
_LIMIT 30
IF k < 1 THEN GOTO Sizes
IF k < 49 OR k > 52 THEN k = 49
PLAY ok$
size = k - 48
SELECT CASE k
CASE IS = 49
numtiles = 12
numcols = 3
CASE IS = 50
numtiles = 20
numcols = 5
CASE IS = 51
numtiles = 30
numcols = 5
CASE IS = 52
numtiles = 42
numcols = 7
END SELECT
CLS
numrows = numtiles / numcols: fleft = midpix + 2 - numcols * 27: fwidth = numcols * 54 + 4: fheight = numrows * 54 + 4
gleft = fleft + 2: gright = gleft + numcols * 54 + 2: gbottom = gtop + numrows * 54 + 2: numfound = 0
DIM tiles(numtiles), found(numtiles) ' found() can have one of three values: 0 (normal), 1 (tile is picked), or 2 (tile has been found)
frame$ = "r" + LTRIM$(STR$(fwidth)) + "d" + LTRIM$(STR$(fheight)) + "l" + LTRIM$(STR$(fwidth)) + "u" + LTRIM$(STR$(fheight))
PSET (fleft, ftop): DRAW frame$
PLAY ok$
LOCATE 31, 66: PRINT "Number of tiles is"; numtiles: _DELAY 1: WIPE "31"
PrepTiles:
b = 1
FOR a = 1 TO numtiles - 1 STEP 2
tiles(a) = b: tiles(a + 1) = b
b = b + 1
NEXT
Shuffle:
LOCATE 31, 68: PRINT "Shuffling tiles..."
FOR a = 1 TO 30
PLAY "o1l64msa"
NEXT
_DELAY 1
WIPE "31"
FOR a = 1 TO numtiles
swop = INT(RND * numtiles) + 1
SWAP tiles(a), tiles(swop)
NEXT
DrawGrid:
top = gtop + 1: tleft = gleft + 2: row = numrows + 1 ' first tile is in 2 pixels, down 2 pixels from edge of grid
FOR a = 0 TO numrows - 1
FOR b = 1 TO numcols
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(100, 100, 100), BF
tleft = tleft + 54
NEXT
tleft = gleft + 2
top = top + 54
NEXT
top = top + 6
GetAction:
column = INT(numcols + 1) / 2
selectionnumber = 2 ' set selection number as 2, will toggle before each selection is made
LINE (580, top)-(629, top + 49), _RGB32(250, 80, 80), BF
' before first NextMove, top is 60px below top of bottom tile (which is 346)"
NextMove:
COLOR _RGB32(100, 250, 200), _RGB32(0, 0, 0)
LOCATE 1, 2: PRINT "Score:"; score(plr); TAB(70); name$(plr); " playing"; TAB(125); "Best for this size:"; bestscore(size)
LOCATE 33, 37: PRINT "Use the four cursor-keys to move to a tile to select and press <Enter> to select it"
LOCATE 31, 72: PRINT "Tries:"; numtries
GetAKey ' tile to be moved to can have Found status 0 (unused), 1 (currently selected) or 2 (already found and removed)
IF k < 1 THEN GOTO NextMove
IF row > numrows THEN
LINE (580, top)-(629, top + 49), _RGB32(0, 0, 0), BF
top = gtop + (numrows - 1) * 54 + 1: tleft = 579
row = numrows
tilenum = numtiles - INT(numcols + 1) / 2 + 1
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(250, 80, 80), BF
GOTO NextMove
END IF
SELECT CASE k
CASE IS = 18432 'up
IF row = 1 THEN GOTO NextMove ' limit move to top row
IF found(tilenum) = 2 THEN
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(0, 0, 0), BF
ELSE
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(100, 100, 100), BF
END IF
top = top - 54: row = row - 1
tilenum = tilenum - numcols: picnum = tiles(tilenum)
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(250, 80, 80), BF ' always color tile moved to as red, whatever Found state is
CASE IS = 20480 'down
IF row = numrows THEN GOTO NextMove ' limit move to top row
IF found(tilenum) = 2 THEN
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(0, 0, 0), BF
ELSE
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(100, 100, 100), BF
END IF
top = top + 54: row = row + 1
tilenum = tilenum + numcols: picnum = tiles(tilenum)
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(250, 80, 80), BF ' always color tile moved to as red, whatever Found state is
CASE IS = 19200 'left
IF column = 1 THEN GOTO NextMove ' limit move to top row
IF found(tilenum) = 2 THEN
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(0, 0, 0), BF
ELSE
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(100, 100, 100), BF
END IF
column = column - 1: tleft = tleft - 54
tilenum = tilenum - 1: picnum = tiles(tilenum)
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(250, 80, 80), BF ' always color tile moved to as red, whatever Found state is
CASE IS = 19712 'right
IF column = numcols THEN GOTO NextMove ' limit move to top row
IF found(tilenum) = 2 THEN
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(0, 0, 0), BF
ELSE
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(100, 100, 100), BF
END IF
column = column + 1: tleft = tleft + 54
tilenum = tilenum + 1: picnum = tiles(tilenum)
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(250, 80, 80), BF ' always color tile moved to as red, whatever Found state is
CASE IS = 27 ' esc - quit
LOCATE 34, 63: PRINT "Quitting": PLAY end$: _DELAY .5
SYSTEM
CASE ELSE
' Any other key selects a tile. It may have Found status 0, 1 or 2; picnum is image number on the tile; selects is first or second select
' tleft and top are locations of the tile; tilenum is number of the tile to be selected
IF found(tilenum) = 1 THEN
COLOR _RGB32(255, 0, 0), _RGB32(0, 0, 0): PLAY bad$
WIPE "34": LOCATE 34, 61: PRINT "You already selected this tile": _DELAY .5: WIPE "34"
COLOR _RGB32(255, 200, 200), _RGB32(0, 0, 0)
GOTO NextMove
END IF
IF found(tilenum) = 2 THEN
COLOR _RGB32(255, 0, 0), _RGB32(0, 0, 0): PLAY bad$
WIPE "34": LOCATE 34, 59: PRINT "This tile has already been paired": _DELAY .5: WIPE "34"
COLOR _RGB32(255, 200, 200), _RGB32(0, 0, 0)
GOTO NextMove
END IF
PLAY ok$
IF selectionnumber = 1 THEN ' continue if this tile has not been selected or found yet
seltile1 = tilenum: seltile1h = tleft: seltile1v = top ' preserve selection 1 details
selectionnumber = 2
ELSE
seltile2 = tilenum: seltile2h = tleft: seltile2v = top ' preserve selection 2 details
selectionnumber = 1
END IF
found(tilenum) = 1
face = _LOADIMAGE("recpics" + LTRIM$(CHR$(setnum)) + "/" + CHR$(64 + tiles(tilenum)) + ".jpg")
_PUTIMAGE (tleft, top), face ' show pic on tile
IF selectionnumber = 1 THEN
_PUTIMAGE (520, 22), face ' show first pic above grid at 520 horiz
ELSE
_PUTIMAGE (631, 22), face ' show second pic above grid at 631 horiz
END IF
_FREEIMAGE face
IF selectionnumber = 2 THEN ' compare pictures
IF tiles(seltile1) = tiles(seltile2) THEN ' if they match,
PLAY ok$: PLAY ok$
COLOR _RGB32(100, 255, 255)
LOCATE 34, 71: PRINT "A match!": _DELAY .5: WIPE "34" ' advise Match,
found(seltile1) = 2: found(seltile2) = 2 ' flag both as Found,
numfound = numfound + 2 ' and inc number of found tiles
score(plr) = score(plr) + 2
IF numfound = numtiles THEN Done: SYSTEM
ELSE ' but if they don't match,
COLOR _RGB32(255, 100, 100)
PLAY bad$: PLAY bad$
LOCATE 34, 70: PRINT "No match!": _DELAY .5: WIPE "34" ' advise No match
found(seltile1) = 0: found(seltile2) = 0 ' set flags of both tiles to not picked and not found
plr = plr + 1
IF plr > np THEN plr = 1
END IF
numtries = numtries + 1 '
LINE (seltile1h, seltile1v)-(seltile1h + 49, seltile1v + 49), _RGB32(250, 80, 80), BF
IF found(seltile1) = 2 THEN
LINE (seltile2h, seltile2v)-(seltile2h + 49, seltile2v + 49), _RGB32(0, 0, 0), BF
ELSE
LINE (seltile2h, seltile2v)-(seltile2h + 49, seltile2v + 49), _RGB32(100, 100, 100), BF
END IF
LINE (520, 22)-(569, 71), _RGB32(0, 0, 0), BF: LINE (631, 22)-(680, 71), _RGB32(0, 0, 0), BF ' erase pics above grid
END IF
LOCATE 35, 64: PRINT "Found:"; numfound, ; "Tries:"; numtries
GOTO NextMove ' go back for next round
END SELECT
GOTO NextMove
' ------------------------------------------------------------------------------------------------- subs below -------------------------------------------------------------------------------
SUB WIPE (ln$) ' call with string of 2-digit line numbers only eg "0122" for lines 1 and 22
FOR a = 1 TO LEN(ln$) - 1 STEP 2
LOCATE VAL(MID$(ln$, a, 2)): PRINT SPACE$(149);
NEXT
END SUB
SUB GetAKey
k = 0: _KEYCLEAR
WHILE k < 1
_LIMIT 30
k = _KEYHIT
WEND
END SUB
SUB Done
CLS
COLOR _RGB32(100, 250, 200), _RGB32(0, 0, 0)
PLAY end$
numtries = numtries + 1
'If single player, check against Best for the level and update if necessary, and leave
' if multi player, just list each player's name and score, and leave
IF NOT _FILEEXISTS("recallbest") THEN
OPEN "recallbest" FOR OUTPUT AS #1 ' write new best scores list if none found
FOR a = 1 TO 4: WRITE #1, a * 20, "Default": NEXT
CLOSE #1
END IF
IF np = 1 THEN
LOCATE 18, 50: PRINT "Would you like to reset all previous Best scores?"
ResetBest:
y = _KEYHIT
_LIMIT 30
IF y < 1 THEN GOTO ResetBest
IF y <> 89 AND y <> 121 THEN GOTO GoOn
OPEN "recallbest" FOR OUTPUT AS #1 ' write new best scores list if requested
FOR a = 1 TO 4: WRITE #1, a * 20, "Default": NEXT
CLOSE #1
GoOn:
CLS
LOCATE 18, 1
OPEN "recallbest" FOR INPUT AS #1
PRINT TAB(68); "Previous Best Scores"
COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0)
FOR a = 1 TO 4
INPUT #1, bestscore(a), bestname$(a)
PRINT TAB(65); a, bestscore(a), bestname$(a)
NEXT
CLOSE #1
COLOR _RGB32(100, 250, 200), _RGB32(0, 0, 0)
PRINT: PRINT TAB(48); "You finished in"; numtries; "tries. The previous best for this level was "; bestscore(size)
IF numtries < bestscore(size) THEN
bestscore(size) = numtries: bestname$(size) = name$(plr)
PRINT: PRINT TAB(71); "New Best Scores"
OPEN "recallbest" FOR OUTPUT AS #1 ' write new best scores list if previous best beaten
COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0)
FOR a = 1 TO 4: WRITE #1, bestscore(a), bestname$(a)
PRINT TAB(65); a, bestscore(a), bestname$(a)
NEXT
CLOSE #1
END IF
ELSE
CLS
LOCATE 18, 74
COLOR _RGB32(100, 250, 200), _RGB32(0, 0, 0)
PRINT "Scores"
COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0)
FOR a = 1 TO np
PRINT TAB(70); name$(a), score(a)
NEXT
END IF
SLEEP
END SUB
SUB Instructions
start = -34
FOR a = 0 TO 20
face = _LOADIMAGE("recpics" + LTRIM$(CHR$(setnum)) + "/" + CHR$(65 + a) + ".jpg") ' find the picture
_PUTIMAGE (start + 56, 10), face ' show pic on tile
_PUTIMAGE (start + 56, 64), face
start = start + 55
_FREEIMAGE face
NEXT
LOCATE 10, 72
COLOR _RGB32(100, 250, 200): PRINT "Recall"; TAB(40); "A Game by Phil Taylor to test and improve your memory and recall skills"
COLOR _RGB32(255, 255, 255): PRINT
PRINT TAB(10); "A rectangular grid of tiles is displayed, each holding a hidden picture or symbol. There are two of each picture, as shown above."
PRINT
PRINT TAB(10); "Before the game starts, the player/s choose a grid-size from 1 to 4, which will present 18, 20, 30 or 42 tiles respectively, so"
PRINT
PRINT TAB(10); "some of the tiles may not be used, depending on the grid size selected."
PRINT
PRINT TAB(10); "They may also enter the names they wish to play under, and the type of images they prefer, from animals, letters or shapes."
PRINT
PRINT TAB(10); "Players take turns to move within this grid with the four cursor keys and select two tiles with the <SPACE> key for each turn."
PRINT
PRINT TAB(10); "As each tile is selected it is revealed, and when the second one is selected, the two are compared by the computer."
PRINT
PRINT TAB(10); "If they match they are removed, and the player scores two points and plays again. When all tiles have been found, the game ends."
PRINT
PRINT TAB(10); "A Best Score is kept for each grid-size for single players, or all player scores are shown for multiple players."
PRINT
COLOR _RGB32(100, 250, 200), _RGB32(0, 0, 0)
PRINT TAB(65); "Press a key to start"
END SUB
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, W.A.) 
Please visit my Website at: http://oldendayskids.blogspot.com/
Please visit my Website at: http://oldendayskids.blogspot.com/
I like the sound effects. 