Author Topic: Letter Memory (Read 7051 times)

bplus · « **on:** July 20, 2019, 09:15:27 pm »

A simple little game to play until Ken gets his next thing going. :)

Code: QB64: [Select]

OPTION _EXPLICIT
DEFINT A-Z
RANDOMIZE TIMER
_TITLE "Letter Memory Remake" '  by bplus started 2019-06-09 mod structure of first game
 
' Keep clicking boxes until all the letter pairs are revealed.
 
TYPE XYtype
    X AS INTEGER
    Y AS INTEGER
END TYPE
 
TYPE LetterBox
    XY AS XYtype
    Reveal AS INTEGER ' 0, -1 revealed when matched, stay revealed
    Letter AS STRING '  letter to match
END TYPE
 
CONST xmax = 400, ymax = 450, boxSize = 50, xoffLetter = (boxSize - 8) / 2, yoffLetter = (boxSize - 16) / 2 ' for letters in box
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 360, 60
REDIM SHARED LB(1 TO 1) AS LetterBox, nBoxes 'so setup can set values to these globals
REDIM SHARED shuffle(1 TO 1) AS STRING 'container of letter pairs to shuffle and distrbute before each round
DIM SHARED nRevealed, b1Index, b2Index, tStart!, s$
DIM i
setUpGame
WHILE 1
    tStart! = TIMER(.001)
    initRound
    CLS
    updateScreen
    DO
        i = getBoxIndex
        IF i THEN
            IF b1Index = 0 THEN 'first reveal box
                IF LB(i).Reveal <> -1 THEN b1Index = i: LB(i).Reveal = -1
            ELSE '2nd reveal box
                IF LB(i).Reveal <> -1 THEN b2Index = i: LB(i).Reveal = -1
            END IF
            updateScreen
        END IF
        IF b2Index <> 0 THEN 'check match, if they do leave them revealed
            IF LB(b1Index).Letter <> LB(b2Index).Letter THEN 'no match
                _DELAY 1
                LB(b1Index).Reveal = 0: LB(b2Index).Reveal = 0
                nRevealed = nRevealed - 2 'when complete = number of squares then done
                updateScreen
            END IF
            b1Index = 0: b2Index = 0 'clear box clicks
        END IF
        _LIMIT 60
    LOOP UNTIL nRevealed = nBoxes
    COLOR &HFFDDDDDD, &HFF000000
    s$ = "Completed in" + STR$(INT(TIMER(.001) - tStart!)) + " secs."
    LOCATE 2, (xmax / 8 - LEN(s$)) / 2: PRINT s$
    _DELAY 2
WEND
 
FUNCTION getBoxIndex
    DIM m, mx, my, mb, i
    WHILE _MOUSEINPUT: WEND
    mb = _MOUSEBUTTON(1) '            left button down
    IF mb THEN '                      get last place mouse button was down
        WHILE mb '                    wait for mouse button release as a "click"
            m = _MOUSEINPUT: mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
        WEND
        FOR i = 1 TO nBoxes '         now find which box was clicked
            IF mx > LB(i).XY.X AND mx < LB(i).XY.X + boxSize THEN
                IF my > LB(i).XY.Y AND my < LB(i).XY.Y + boxSize THEN
                    getBoxIndex = i: EXIT FUNCTION
                END IF
            END IF
        NEXT
    END IF
END FUNCTION
 
SUB updateScreen
    DIM i
    nRevealed = 0 '              (shared) detect how many boxes are revealed
    FOR i = 1 TO nBoxes
        LINE (LB(i).XY.X, LB(i).XY.Y)-STEP(boxSize, boxSize), &HFFFF0000, BF
        IF LB(i).Reveal = -1 THEN
            COLOR &HFFDDDDDD, &HFFFF0000
            _PRINTSTRING (LB(i).XY.X + xoffLetter, LB(i).XY.Y + yoffLetter), LB(i).Letter
            nRevealed = nRevealed + 1
        END IF
    NEXT
END SUB
 
SUB initRound 'reassign letters and hide them all
    DIM i, r
    FOR i = nBoxes TO 2 STEP -1 ' shuffle stuff in array
        r = INT(i * RND) + 1
        SWAP shuffle(i), shuffle(r)
    NEXT
    FOR i = 1 TO nBoxes '       reset or reassign values
        LB(i).Letter = shuffle(i): LB(i).Reveal = 0
    NEXT
END SUB
 
SUB setUpGame
    DIM i, x, y '(                main) CONST xmax = 400, ymax = 450, boxSize = 50
    CONST xBoxes = 6, yBoxes = 4 '           Board N x M  boxes across, boxes down
    nBoxes = xBoxes * yBoxes '               Total boxes (shared)
    REDIM LB(1 TO nBoxes) AS LetterBox '     ready to rec data (shared)
    'CONST boxSize = 50                '     Screen drawing topleft box locations
    CONST spacer = 5 '                       for XY calc
    CONST xoffset = INT((xmax - boxSize * xBoxes - spacer * (xBoxes - 1)) / 2)
    CONST yoffset = INT((ymax - boxSize * yBoxes - spacer * (yBoxes - 1)) / 2)
    CONST sq = boxSize + spacer '            for XY calc
    FOR y = 1 TO yBoxes '                    set screen XY locations for all boxes
        FOR x = 1 TO xBoxes
            i = i + 1
            LB(i).XY.X = xoffset + (x - 1) * sq
            LB(i).XY.Y = yoffset + (y - 1) * sq
        NEXT
    NEXT
    REDIM shuffle(1 TO nBoxes) AS STRING ' load shuffle array for shuffling later (shared)
    CONST letterPairs = "AABBCCDDEEFFGGHHIIJJKKLLMMNNOOPPQQRRSSTTUUVVWWXXYYZZ11223344556677889900"
    FOR i = 1 TO nBoxes
        shuffle(i) = MID$(letterPairs, i, 1)
    NEXT
END SUB
 

EDIT: updateScreen xoff, yoff made into xoffLetter, yoffLetter CONST's, as not efficient to recalc those for every update.

SierraKen · « **Reply #1 on:** July 20, 2019, 11:39:44 pm »

Wow B+ nice game! Wouldn't help me that good though because my short term memory has been super bad since my head injury decades ago lol. I think I'm going to convert an old ASIC game called Alphabet Invaders to QB64. :)

Ashish · « **Reply #2 on:** July 21, 2019, 12:19:12 am »

Cool game Bplus!

johnno56 · « **Reply #3 on:** July 21, 2019, 12:42:07 am »

Nice game. Bit of a workout for My grey matter as well...

Does it come in blue? lol

J

bplus · « **Reply #4 on:** July 21, 2019, 09:09:51 am »

Thanks guys, should be easy to modify colors, add more buttons for letters and digit pairs... I don't know about pointy ears though. ;-))

Well what do you know!?

Pete · « **Reply #5 on:** July 21, 2019, 12:12:55 pm »

I'll stick with Republican Red!

Easy game...

Pete

TempodiBasic · « **Reply #6 on:** July 21, 2019, 01:09:38 pm »

Cool Bplus!
I find it very fine so that I think to add a simple mod while the ideas are flourishing!

try it please!

Code: QB64: [Select]

OPTION _EXPLICIT
DEFINT A-Z
RANDOMIZE TIMER
_TITLE "Letter Memory Remake" '  by bplus started 2019-06-09 mod structure of first game
 
' Keep clicking boxes until all the letter pairs are revealed.
 
TYPE XYtype
    X AS INTEGER
    Y AS INTEGER
END TYPE
 
TYPE LetterBox
    XY AS XYtype
    Reveal AS INTEGER ' 0, -1 revealed when matched, stay revealed
    Letter AS STRING '  letter to match
END TYPE
 
CONST xmax = 400, ymax = 450, boxSize = 50, xoffLetter = (boxSize - 8) / 2, yoffLetter = (boxSize - 16) / 2 ' for letters in box
 
CONST Topten = "TopTen.SAV", Bonus = 100 ' <---new line TDB
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 360, 60
REDIM SHARED LB(1 TO 1) AS LetterBox, nBoxes 'so setup can set values to these globals
REDIM SHARED shuffle(1 TO 1) AS STRING 'container of letter pairs to shuffle and distrbute before each round
DIM SHARED nRevealed, b1Index, b2Index, tStart!, s$
DIM SHARED Score AS LONG ' <---new line TDB
DIM i
setUpGame
 
WHILE 1
    tStart! = TIMER(.001)
    initRound
    CLS
    updateScreen
    DO
        i = getBoxIndex
        IF i THEN
            IF b1Index = 0 THEN 'first reveal box
                IF LB(i).Reveal <> -1 THEN b1Index = i: LB(i).Reveal = -1
            ELSE '2nd reveal box
                IF LB(i).Reveal <> -1 THEN b2Index = i: LB(i).Reveal = -1
            END IF
            updateScreen
        END IF
        IF b2Index <> 0 THEN 'check match, if they do leave them revealed
            IF LB(b1Index).Letter <> LB(b2Index).Letter THEN 'no match
                _DELAY 1
                LB(b1Index).Reveal = 0: LB(b2Index).Reveal = 0
                nRevealed = nRevealed - 2 'when complete = number of squares then done
                updateScreen
 
                Score = Score + Bonus
            END IF
            b1Index = 0: b2Index = 0 'clear box clicks
        END IF
        _LIMIT 60
    LOOP UNTIL nRevealed = nBoxes
    COLOR &HFFDDDDDD, &HFF000000
    ' qua calcola il tempo come punteggio aggiuntivo
    s$ = "Completed in" + STR$(INT(TIMER(.001) - tStart!)) + " secs."
    LOCATE 2, (xmax / 8 - LEN(s$)) / 2: PRINT s$
    _DELAY 2
WEND
 
FUNCTION getBoxIndex
    DIM m, mx, my, mb, i
    WHILE _MOUSEINPUT: WEND
    mb = _MOUSEBUTTON(1) '            left button down
    IF mb THEN '                      get last place mouse button was down
        WHILE mb '                    wait for mouse button release as a "click"
            m = _MOUSEINPUT: mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
        WEND
        FOR i = 1 TO nBoxes '         now find which box was clicked
            IF mx > LB(i).XY.X AND mx < LB(i).XY.X + boxSize THEN
                IF my > LB(i).XY.Y AND my < LB(i).XY.Y + boxSize THEN
                    getBoxIndex = i: EXIT FUNCTION
                END IF
            END IF
        NEXT
        ' if no nBoxe clicked , user maybe clicks on menubar
        DIM done, High$ ' <---new lines TDB
        IF my < 16 THEN
            SELECT CASE mx
                CASE 55 TO 85
                    ' END
                    COLOR , &HFF0000FF
                    _PRINTSTRING ((xmax - 60) / 2, 400), "QUIT?"
                    _PRINTSTRING ((xmax - 110) / 2, 430), "[YES]  [NO]"
                    done = 0
                    WHILE done = 0
                        done = LEN(INKEY$)
                        IF _MOUSEINPUT THEN
                            IF _MOUSEBUTTON(1) OR _MOUSEBUTTON(2) THEN done = 1
                            mx = _MOUSEX: my = _MOUSEY
                        END IF
                    WEND
                    IF my >= 430 AND my <= 450 THEN
                        IF mx <= 188 AND mx >= 130 THEN
                            ' yes  Quit
                            COLOR , &HFF000000
                            CLS
                            DIM NAMES AS STRING * 8
                            _PRINTSTRING ((xmax - 110) / 2, 380), "ENTER NAME"
                            INPUT NAMES
                            OPEN Topten FOR APPEND AS #1
                            PRINT #1, NAMES + STR$(Score)
                            CLOSE #1
                            'Topten
                            COLOR , &HFF000000
                            CLS
                            IF NOT _FILEEXISTS(Topten) THEN
                                _PRINTSTRING ((xmax - 160) / 2, 100), "File " + Topten + " corrupted"
                            ELSE
                                COLOR , &HFF0000FF
                                LOCATE , 20: PRINT "HIGHSCORES"
                                LOCATE , 20: PRINT " TOP TEN "
                                PRINT: PRINT
                                OPEN Topten FOR INPUT AS #1
                                WHILE NOT EOF(1)
                                    INPUT #1, High$
                                    LOCATE , 15
                                    PRINT High$
                                    _DELAY .5
                                WEND
                                CLOSE #1
                            END IF
 
                            SLEEP 4
                            END
                        ELSE
                            COLOR , &HFF000000
                            CLS
                            updateScreen
                        END IF
                    END IF
 
                CASE 110 TO 158
                    'pause
                    COLOR , &HFF0000FF
                    _PRINTSTRING ((xmax - 60) / 2, 400), "PAUSED"
                    done = 0
                    WHILE done = 0
                        done = LEN(INKEY$)
                        IF _MOUSEINPUT THEN
                            IF _MOUSEBUTTON(1) OR _MOUSEBUTTON(2) THEN done = 1
                        END IF
                    WEND
                    COLOR , &HFF000000
                    CLS
                    updateScreen
                CASE 180 TO 238
                    'Topten
                    COLOR , &HFF000000
                    CLS
                    IF NOT _FILEEXISTS(Topten) THEN
                        _PRINTSTRING ((xmax - 160) / 2, 100), "File " + Topten + " corrupted"
                    ELSE
                        COLOR , &HFF0000FF
                        LOCATE , 20: PRINT "HIGHSCORES"
                        LOCATE , 20: PRINT " TOP TEN "
                        PRINT: PRINT
                        OPEN Topten FOR INPUT AS #1
                        WHILE NOT EOF(1)
                            INPUT #1, High$
                            LOCATE , 15
                            PRINT High$
                            _DELAY .5
                        WEND
                        CLOSE #1
                    END IF
                    done = 0
                    WHILE done = 0
                        done = LEN(INKEY$)
                        IF _MOUSEINPUT THEN
                            IF _MOUSEBUTTON(1) OR _MOUSEBUTTON(2) THEN done = 1
                        END IF
                    WEND
                    COLOR , &HFF000000
                    CLS
                    updateScreen
                CASE 250 TO 294
                    ' Help
                    COLOR , &HFF000000
                    CLS
                    COLOR , &HFF0000FF
                    _PRINTSTRING ((xmax - 60) / 2, 100), "Help:"
                    _PRINTSTRING (5, 120), "-find the matched letters"
                    _PRINTSTRING (5, 140), "-more matches more scores"
                    _PRINTSTRING ((xmax - 60) / 2, 160), "Menu:"
                    _PRINTSTRING (5, 180), "END = quit, Pause = wait, Topten = HighScores"
                    _PRINTSTRING (5, 200), "Help = this screen"
                    done = 0
                    WHILE done = 0
                        done = LEN(INKEY$)
                        IF _MOUSEINPUT THEN
                            IF _MOUSEBUTTON(1) OR _MOUSEBUTTON(2) THEN done = 1
                        END IF
                    WEND
                    COLOR , &HFF000000
                    CLS
                    updateScreen
                CASE ELSE
            END SELECT
        END IF
    END IF
END FUNCTION
 
SUB updateScreen
    DIM i
    nRevealed = 0 '              (shared) detect how many boxes are revealed
    FOR i = 1 TO nBoxes
        LINE (LB(i).XY.X, LB(i).XY.Y)-STEP(boxSize, boxSize), &HFFFF0000, BF
        IF LB(i).Reveal = -1 THEN
            COLOR &HFFDDDDDD, &HFFFF0000
            _PRINTSTRING (LB(i).XY.X + xoffLetter, LB(i).XY.Y + yoffLetter), LB(i).Letter
            nRevealed = nRevealed + 1
        END IF
    NEXT
    '    qua il rigo guida menu
    LINE (1, 1)-(xmax, 15), &HFF0000FF, BF ' <---new lines TDB
    COLOR , &HFF0000FF
    _PRINTSTRING (50, 0), "[END]  [Pause]  [TopTen] [Help] " '55-85  110-158  180-238  250-294
    COLOR &HFFDDDDDD, &HFFFF0000
 
END SUB
 
SUB initRound 'reassign letters and hide them all
    DIM i, r
    FOR i = nBoxes TO 2 STEP -1 ' shuffle stuff in array
        r = INT(i * RND) + 1
        SWAP shuffle(i), shuffle(r)
    NEXT
    FOR i = 1 TO nBoxes '       reset or reassign values
        LB(i).Letter = shuffle(i): LB(i).Reveal = 0
    NEXT
END SUB
 
SUB setUpGame
    DIM i, x, y '(                main) CONST xmax = 400, ymax = 450, boxSize = 50
    CONST xBoxes = 6, yBoxes = 4 '           Board N x M  boxes across, boxes down
    nBoxes = xBoxes * yBoxes '               Total boxes (shared)
    REDIM LB(1 TO nBoxes) AS LetterBox '     ready to rec data (shared)
    'CONST boxSize = 50                '     Screen drawing topleft box locations
    CONST spacer = 5 '                       for XY calc
    CONST xoffset = INT((xmax - boxSize * xBoxes - spacer * (xBoxes - 1)) / 2)
    CONST yoffset = INT((ymax - boxSize * yBoxes - spacer * (yBoxes - 1)) / 2)
    CONST sq = boxSize + spacer '            for XY calc
    FOR y = 1 TO yBoxes '                    set screen XY locations for all boxes
        FOR x = 1 TO xBoxes
            i = i + 1
            LB(i).XY.X = xoffset + (x - 1) * sq
            LB(i).XY.Y = yoffset + (y - 1) * sq
        NEXT
    NEXT
    REDIM shuffle(1 TO nBoxes) AS STRING ' load shuffle array for shuffling later (shared)
    CONST letterPairs = "AABBCCDDEEFFGGHHIIJJKKLLMMNNOOPPQQRRSSTTUUVVWWXXYYZZ11223344556677889900"
    FOR i = 1 TO nBoxes
        shuffle(i) = MID$(letterPairs, i, 1)
    NEXT
 
    ' section score TopTen
    Score = 0 ' <---new lines TDB
    IF NOT _FILEEXISTS(Topten) THEN
        OPEN Topten FOR OUTPUT AS #1
        PRINT #1, " 1. SMcNeill... 100000"
        PRINT #1, " 1. Heitor..... 100000"
        PRINT #1, " 1. Bplus...... 100000"
        PRINT #1, " 1. Pete....... 100000"
        PRINT #1, " 1. Petr....... 100000"
        PRINT #1, " 1. Ashish..... 100000"
        PRINT #1, " 1. Rhosigma... 100000"
        PRINT #1, " 1. Qwerkey.... 100000"
        PRINT #1, " 1. _Vince..... 100000"
        PRINT #1, " 1. The Others. 100000"
        CLOSE #1
    END IF
END SUB
 

fine changing color of back of boxes! It can be another item of the menu!
:-)
Good Playing

@Pete
but do you use C++ to hacking Bplus code?
O_O you're Anonymous! https://www.repubblica.it/images/2011/07/18/184150799-e341c968-23d0-4422-ba68-97dc59b84b8a.jpg
https://images2.alphacoders.com/606/thumb-1920-606513.jpg

johnno56 · « **Reply #7 on:** July 21, 2019, 05:47:28 pm »

bplus,

Not exactly the shade of blue I was expecting, but blue none the less... Cool...

Now... about the letters.... How is your ancient Samarian? lol

bplus · « **Reply #8 on:** July 21, 2019, 09:33:40 pm »

TempodiBasic, that's quite a mod! longer than the original program that took some time!

I did have in mind a mod myself, not quite Sumarian... :)

johnno56 · « **Reply #9 on:** July 22, 2019, 08:54:14 am »

Oh. What about Klingon? Vulcan will do in a pinch (no pun intended) but, if you settle for Romulan, your punishment will be to memorise all the Ferengi Laws of Acquisition...

TempodiBasic · « **Reply #10 on:** July 22, 2019, 12:21:31 pm »

Quote

not quite Sumarian... :)

???
Please what do you mean with sumarian?
Sumerian http://www.ilsapere.org/wp-content/uploads/bfi_thumb/sumeri-1-33i7zodpx38ur4jhrymnsw.jpg
or somariano (dummy or donkey) http://2.bp.blogspot.com/-WnfOoV8iYpc/UycT2mfxmsI/AAAAAAAAAY4/ygQu51cLbUw/s1600/donkey-821x1024.jpg
:D

If you like, you can short my mod and make it fine to you building more SUB and Function at the place of write the same code anywhere, moreover you can use a k-ed position on X an Y for the menu items to click. And a record type to store Topten in file.
Just as you prefer.
;-)
Thanks to give a look.

bplus · « **Reply #11 on:** July 22, 2019, 12:40:50 pm »

Sumarian, Samarian, there is a difference?

Apparently so: https://www.quora.com/Is-Sumerian-the-same-thing-as-Samaritan... wait that's Samaritans, sa-martians??? :D those we learned about from Bible (the good one) and Ancient Aliens program ;-))

Hi TempodiBasic,

The top ten list is great for games of competition, IMHO not so hot for this little app. For me, scores quickly go down with repetition of play because I start to confuse letters in position 1 or 2 games ago.

The code you started might be generalized so one could add it to any great games program along with a sort to put scores from high to low... wait was that already in there? Also I would score times to complete a board of n matches.

TempodiBasic · « **Reply #12 on:** July 22, 2019, 04:27:51 pm »

about

Quote

Also I would score times to complete a board of n matches.

what weight do you think to give to the time used to complete a level?
do you like a formula as scoreTimeBonus = Premium/timePassed and/ or use scoreTimeBonus as multiplier of total score of the match (that is always the same)?

bplus · « **Reply #13 on:** July 22, 2019, 05:55:03 pm »

I'm not interested in scoring this game.

Petr · « **Reply #14 on:** July 23, 2019, 03:15:24 am »

Cool game, BPlus.

and...

Nice hack, Pete :-D

News:

Author Topic: Letter Memory (Read 7051 times)

bplus

Letter Memory

SierraKen

Re: Letter Memory

Ashish

Re: Letter Memory

johnno56

Re: Letter Memory

bplus

Re: Letter Memory

Pete

Re: Letter Memory

TempodiBasic

Re: Letter Memory

johnno56

Re: Letter Memory

bplus

Re: Letter Memory

johnno56

Re: Letter Memory

TempodiBasic

Re: Letter Memory

bplus

Re: Letter Memory

TempodiBasic

Re: Letter Memory

bplus

Re: Letter Memory

Petr

Re: Letter Memory