Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Recall2 - a memory improvement game
#1
I've completely re-made my Recall game, and added several new functions. These include: three different sets of tiles (animals, letters and shapes), four levels of difficulty, and saved best-scores for individual games. 

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 = 32
        '  <Space> 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

    CASE IS = 27 '                                                                                               esc - quit
        LOCATE 34, 63: PRINT "Quitting": PLAY end$: _DELAY .5
        SYSTEM
    CASE ELSE
        GOTO NextMove
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

It makes use of several QB64 functions that I, for one, was not that familiar with, and Remarks are added for other "L-Platers", to try to explain how these have been used.

There are four attached files, three of which contain the sets of images, and the fourth the best-scores records.
I'm hoping this will be useful, and interesting, to other members




































' 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 = 32
        '  <Space> 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

    CASE IS = 27 '                                                                                               esc - quit
        LOCATE 34, 63: PRINT "Quitting": PLAY end$: _DELAY .5
        SYSTEM
    CASE ELSE
        GOTO NextMove
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


Attached Files
.7z   Recall2.7z (Size: 98.51 KB / Downloads: 36)
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, W.A.) Big Grin
Please visit my Website at: http://oldendayskids.blogspot.com/
Reply
#2
Hi Phil, tried your game. I select a tile then am pressing enter and nothing is happening. 

I look at your code and see that I should be pressing spacebar, not enter. 

So a little miss on instruction. Sad
b = b + ...
Reply
#3
Thanks for looking, bplus.
Actually the instructions do include that advice (fifth line of Instructions), but obviously I need to make this clearer. I'll fix that.
Thanks for the feedback.
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, W.A.) Big Grin
Please visit my Website at: http://oldendayskids.blogspot.com/
Reply
#4
I am looking at instructions on the puzzle screen:
   
b = b + ...
Reply
#5
The first thing that appears when you open the prog should be the Instructions page... If it isn't, something is amiss. It  works on my system; can you let me know if this screen appears for you please?
In the meantime, I'l look at changing the "pickup" key to be any key (except cursors and Esc).
Edit: I've done that, and it works. I should have done this originally.
Double Edit: I just noticed your "circles" on the running screen, and see what you mean!
Good that you spotted my "deliberate error"!
Sorry, I'll fix that also.
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, W.A.) Big Grin
Please visit my Website at: http://oldendayskids.blogspot.com/
Reply
#6
I just tried to post the modified code, but lost it, so here it is again (if the first one appears, ignore it):
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)
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)
LOCATE 1, 2: PRINT "Score:"; score(plr); TAB(70); name$(plr); " playing"; TAB(125); "Best for this size:"; bestscore(size)
LOCATE 33, 18: PRINT "Use the four cursor-keys to move to a tile to select, then press any other key to select it (or Esc to exit the programme)"
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), 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 = 27 '                                                                                               esc - quit
        LOCATE 34, 63: PRINT "Quitting": PLAY end$: _DELAY .5
        SYSTEM

    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), 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), 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), 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), 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 ELSE
        '  <Space> 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): PLAY bad$
            WIPE "34": LOCATE 34, 61: PRINT "You already selected this tile": _DELAY .5: WIPE "34"
            COLOR _RGB32(255, 200, 200)
            GOTO NextMove
        END IF
        IF found(tilenum) = 2 THEN
            COLOR _RGB32(255, 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)
            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), BF
            ELSE
                LINE (seltile2h, seltile2v)-(seltile2h + 49, seltile2v + 49), _RGB32(100, 100, 100), BF
            END IF
            LINE (520, 22)-(569, 71), BF: LINE (631, 22)-(680, 71), 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)
    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)
        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)
        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)
            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)
        PRINT "Scores"
        COLOR _RGB32(255, 255, 255)
        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, pressing <SPACE> to select each."
    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)
    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.) Big Grin
Please visit my Website at: http://oldendayskids.blogspot.com/
Reply
#7
@PhilOfPerth looks like you have 3 code copies in your last post, ie 3 same name versions of each of your subs.

Probably should delete the code window and Copy/Paste into fresh code window.
b = b + ...
Reply
#8
Thanks again bplus.
I'm still stumbling in the dark with a lot of QB64, as you can see, including posting. 
There are a few other things that should be fixed also, including not needing to specify the background-color every time I change the foreground.
But I'm getting there I think, with a lot of help.   Big Grin
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, W.A.) Big Grin
Please visit my Website at: http://oldendayskids.blogspot.com/
Reply
#9
Hmm... I liked it better when the top 2 pictures cleared after doing a round of 2 selections. I also liked it better when pictures are blacked out when matched instead of staying the color of the cursor panel, very confusing!

Did you drop a clear screen between rounds of 2 selections?

This is what screen looks like after 2 matched pairs
   
b = b + ...
Reply
#10
(04-03-2023, 12:14 PM)bplus Wrote: Hmm... I liked it better when the top 2 pictures cleared after doing a round of 2 selections. I also liked it better when pictures are blacked out when matched instead of staying the color of the cursor panel, very confusing!

Did you drop a clear screen between rounds of 2 selections?

This is what screen looks like after 2 matched pairs

Ouch! 
It seems something was lost in transmission! There's certainly something happened; I get the same results as you with the file I uploaded.  Huh
You're probably right about a CLS missing, or something similar. I'll have a look in a few mins when I finish my chores. Sorry.
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, W.A.) Big Grin
Please visit my Website at: http://oldendayskids.blogspot.com/
Reply




Users browsing this thread: 2 Guest(s)