Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Mastermind
#1
Mastermind is a logic game (I believe it's still available). The object it to deduce a hidden code of six different color buttons using responses to one's guesses. A black button means a color is in the correct position, a whit button means a color is correct but in the wrong position.

Recently I decided to dust this off to experiment with QB64PE graphics and mouse ops. I originally wrote this as a text mode game for my TRS-80.

Enjoy, and feel free to offer constructive criticisms.

Code: (Select All)
' File:         Mastermind.bas
' Purpose:      An implementation of the classic board game Mastermind
' Create Date:  07/27/2022
' Revised:      01/23/2023
' Rev           1.0

OPTION _EXPLICIT
OPTION BASE 1
_TITLE "MASTERMIND"

'-- color constants
CONST RED = _RGB32(255, 0, 0)
CONST GREEN = _RGB32(0, 255, 0)
CONST BLUE = _RGB32(0, 0, 255)
CONST YELLOW = _RGB32(255, 255, 0)
CONST MAGENTA = _RGB32(255, 0, 255)
CONST CYAN = _RGB32(0, 255, 255)
CONST BLACK = _RGB32(0, 0, 0)
CONST WHITE = _RGB32(255, 255, 255)
CONST GRAY = _RGB32(64, 64, 64)
CONST LIGHTGRAY = _RGB32(128, 128, 128)

TYPE Button
    x AS INTEGER 'x coord
    y AS INTEGER 'y coord
    r AS INTEGER 'radius
    c AS _UNSIGNED LONG 'color
END TYPE

CONST TRUE = -1
CONST FALSE = 0

DIM AS INTEGER ix, iz 'general purpose integer variables
DIM SHARED AS INTEGER NumGuesses, GameOver, GameWon
DIM SHARED AS Button Buttons(1 TO 8, 1 TO 13)
DIM AS INTEGER mx, my
DIM AS _UNSIGNED LONG ChosenColor
DIM AS STRING Message

SCREEN _NEWIMAGE(320, 640, 32)
WIDTH 40, 40
_SCREENMOVE _MIDDLE


'------------------------------------------------------------------------------
CLS
ix = _MESSAGEBOX("MASTERMIND", "Welcome to Mastermind. Do you need instructions?", "yesno", "question")
IF ix = 1 THEN ShowInstructions

'The game starts here
DO
    InitButtons
    DrawBoard
    MakeCode
    NumGuesses = 1: GameOver = FALSE: GameWon = FALSE: ChosenColor = 0
    _LIMIT 30

    'the loop for gathering and processing guesses starts here
    DO
        DO WHILE _MOUSEINPUT
            IF _MOUSEBUTTON(1) THEN
                mx = _MOUSEX: my = _MOUSEY
                EXIT DO
            END IF
        LOOP
        DO WHILE _MOUSEINPUT: LOOP 'clean the mouse buffer
        SELECT CASE my
            CASE 380 TO 400 'click is on the guess button row
                IF ChosenColor <> 0 THEN 'a color is selected
                    SELECT CASE mx
                        CASE 30 TO 50
                            'first button
                            Buttons(1, 12).c = ChosenColor
                            ChosenColor = 0
                            ShowButton 1, 12
                            ClearHighlights
                        CASE 60 TO 80
                            'second button
                            Buttons(2, 12).c = ChosenColor
                            ChosenColor = 0
                            ShowButton 2, 12
                            ClearHighlights
                        CASE 90 TO 110
                            'third button
                            Buttons(3, 12).c = ChosenColor
                            ChosenColor = 0
                            ShowButton 3, 12
                            ClearHighlights
                        CASE 120 TO 140
                            Buttons(4, 12).c = ChosenColor
                            ChosenColor = 0
                            ShowButton 4, 12
                            ClearHighlights
                    END SELECT
                END IF
            CASE 445 TO 455
                'on the color select row
                IF ChosenColor = 0 THEN
                    SELECT CASE mx
                        CASE 75 TO 85
                            ChosenColor = RED
                            ClearHighlights
                            HighlightButton 1, 13
                        CASE 105 TO 115
                            ChosenColor = GREEN
                            ClearHighlights
                            HighlightButton 2, 13
                        CASE 135 TO 145
                            ChosenColor = BLUE
                            ClearHighlights
                            HighlightButton 3, 13
                        CASE 165 TO 175
                            ChosenColor = YELLOW
                            ClearHighlights
                            HighlightButton 4, 13
                        CASE 195 TO 205
                            ChosenColor = MAGENTA
                            ClearHighlights
                            HighlightButton 5, 13
                        CASE 225 TO 235
                            ChosenColor = CYAN
                            ClearHighlights
                            HighlightButton 6, 13
                    END SELECT
                END IF
        END SELECT

        'test for keystrokes
        iz = _KEYHIT
        IF iz = 27 THEN END '<ESC> pressed, it's absolute.
        IF iz = 71 OR iz = 103 THEN CheckGuess
        IF GameWon = TRUE OR GameOver = TRUE THEN EXIT DO
    LOOP

    'check for end of game
    FOR ix = 1 TO 4
        ShowButton ix, 11
    NEXT ix

    IF GameWon = TRUE THEN Message = "You WIN! Play again?"
    IF GameOver = TRUE THEN Message = "You lose. Try again?"
    IF _MESSAGEBOX("MASTERMIND", Message, "yesno", "question") = 0 THEN END
LOOP

'end of game code
'------------------------------------------------------------------------------
SUB DrawBoard
    DIM AS INTEGER ix, iy

    '-- the previous guesses
    COLOR WHITE, GRAY
    CLS
    PRINT "       GUESSES           RESPONSES": PRINT
    FOR iy = 1 TO 10
        PRINT iy: PRINT
        FOR ix = 1 TO 8
            ShowButton ix, iy
        NEXT ix
    NEXT iy

    LINE (25, 343)-(145, 377), LIGHTGRAY, B
    _PRINTSTRING (170, 352), "THE CODE"

    FOR ix = 1 TO 4
        ShowButton ix, 12
    NEXT ix
    _PRINTSTRING (170, 384), "YOUR GUESS"

    FOR ix = 1 TO 6
        ShowButton ix, 13
    NEXT ix

    LOCATE 31, 1: COLOR CYAN
    PRINT "Click on a color and then click"
    PRINT "on a guess button. You can click"
    PRINT "as many times as you want.": PRINT
    PRINT "Press <G> when you are ready"
    PRINT "to enter your guess."
    PRINT "Press <ESC> to quit."

END SUB
'------------------------------------------------------------------------------
SUB InitButtons
    DIM AS INTEGER ix, iy

    'guess and response buttons
    FOR ix = 1 TO 4
        FOR iy = 1 TO 12 'guess buttons
            Buttons(ix, iy).x = 40 + (30 * (ix - 1))
            Buttons(ix, iy).y = 40 + (32 * (iy - 1))
            Buttons(ix, iy).r = 10
            Buttons(ix, iy).c = GRAY
        NEXT iy
    NEXT ix
    FOR ix = 5 TO 8 'response buttons
        FOR iy = 1 TO 12
            Buttons(ix, iy).x = 150 + (15 * (ix - 1))
            Buttons(ix, iy).y = 40 + ((iy - 1) * 32)
            Buttons(ix, iy).r = 5
            Buttons(ix, iy).c = GRAY
        NEXT iy
    NEXT ix

    'color buttons
    Buttons(1, 13).x = 80: Buttons(1, 13).y = 450: Buttons(1, 13).r = 10: Buttons(1, 13).c = RED
    Buttons(2, 13).x = 110: Buttons(2, 13).y = 450: Buttons(2, 13).r = 10: Buttons(2, 13).c = GREEN
    Buttons(3, 13).x = 140: Buttons(3, 13).y = 450: Buttons(3, 13).r = 10: Buttons(3, 13).c = BLUE
    Buttons(4, 13).x = 170: Buttons(4, 13).y = 450: Buttons(4, 13).r = 10: Buttons(4, 13).c = YELLOW
    Buttons(5, 13).x = 200: Buttons(5, 13).y = 450: Buttons(5, 13).r = 10: Buttons(5, 13).c = MAGENTA
    Buttons(6, 13).x = 230: Buttons(6, 13).y = 450: Buttons(6, 13).r = 10: Buttons(6, 13).c = CYAN

END SUB
'------------------------------------------------------------------------------
SUB ShowButton (x AS LONG, y AS LONG)
    'x and y are indexes into the Buttons array
    'the desired color must already be set

    CIRCLE (Buttons(x, y).x, Buttons(x, y).y), Buttons(x, y).r, BLACK
    PAINT STEP(0, 0), Buttons(x, y).c, BLACK

END SUB
'------------------------------------------------------------------------------
SUB HighlightButton (x AS LONG, y AS LONG)
    CIRCLE (Buttons(x, y).x, Buttons(x, y).y), Buttons(x, y).r + 1, WHITE
END SUB
'------------------------------------------------------------------------------
SUB ClearHighlights
    DIM AS INTEGER ix

    FOR ix = 1 TO 6
        CIRCLE (Buttons(ix, 13).x, Buttons(ix, 13).y), Buttons(ix, 13).r + 1, GRAY
    NEXT ix

END SUB
'------------------------------------------------------------------------------
SUB ShowInstructions
    COLOR CYAN, GRAY
    CLS
    PRINT "The game is MASTERMIND. The object is"
    PRINT "to guess a hidden code of colored"
    PRINT "buttons. Choose any combination of"
    PRINT "colors and submit a guess. You will"
    PRINT "then see up to four responses. A black"
    PRINT "response means you have a correct"
    PRINT "color in the correct position. A white"
    PRINT "response means you have a correct"
    PRINT "color but in the wrong position. Use"
    PRINT "your previous guesses and responses to"
    PRINT "deduce the correct code.": PRINT
    PRINT "Press any key to begin...": SLEEP
END SUB
'------------------------------------------------------------------------------
SUB MakeCode
    DIM AS INTEGER ix, iy

    RANDOMIZE TIMER
    FOR ix = 1 TO 4
        iy = INT(RND * 6) + 1
        IF iy = 1 THEN Buttons(ix, 11).c = RED
        IF iy = 2 THEN Buttons(ix, 11).c = GREEN
        IF iy = 3 THEN Buttons(ix, 11).c = BLUE
        IF iy = 4 THEN Buttons(ix, 11).c = YELLOW
        IF iy = 5 THEN Buttons(ix, 11).c = MAGENTA
        IF iy = 6 THEN Buttons(ix, 11).c = CYAN
    NEXT ix

 END SUB
'------------------------------------------------------------------------------
SUB CheckGuess
    'look for matches and near misses

    DIM AS _UNSIGNED LONG Code(1 TO 4)
    DIM AS _UNSIGNED LONG Guess(1 TO 4)
    DIM AS _UNSIGNED LONG Wipeout 'used to provide a unique number for each wipeout
    DIM AS INTEGER ix, iy
    DIM AS INTEGER Match, Almost
    Match = 0: Almost = 0
    GameWon = FALSE: GameOver = FALSE

    'make temporary copies of the code and guess that we can wipe out
    FOR ix = 1 TO 4
        Code(ix) = Buttons(ix, 11).c
        Guess(ix) = Buttons(ix, 12).c
    NEXT ix
    Wipeout = 0

    'check exact matches first
    FOR ix = 1 TO 4
        IF Code(ix) = Guess(ix) THEN
            Match = Match + 1
            Code(ix) = Wipeout: Wipeout = Wipeout + 1
            Guess(ix) = Wipeout: Wipeout = Wipeout + 1
        END IF
    NEXT ix

    'now check right color, wrong position
    FOR ix = 1 TO 4
        FOR iy = 1 TO 4
            IF Code(ix) = Guess(iy) THEN
                Almost = Almost + 1
                Code(ix) = Wipeout: Wipeout = Wipeout + 1
                Guess(iy) = Wipeout: Wipeout = Wipeout + 1
            END IF
        NEXT iy
    NEXT ix

    'now set responses
    IF Match > 0 THEN
        FOR ix = 1 TO Match
            Buttons(ix + 4, NumGuesses).c = BLACK
        NEXT ix
    END IF

    IF Almost > 0 THEN
        IF Match > 0 THEN iy = Match + 1 ELSE iy = 1
        FOR ix = iy TO Match + Almost
            Buttons(ix + 4, NumGuesses).c = WHITE
        NEXT ix
    END IF

    'Show the guess and responses
    FOR ix = 1 TO 4
        Buttons(ix, NumGuesses).c = Buttons(ix, 12).c
    NEXT ix

    FOR ix = 1 TO 8
        ShowButton ix, NumGuesses
    NEXT ix

    FOR ix = 1 TO 4
        Buttons(ix, 12).c = GRAY
        ShowButton ix, 12
    NEXT ix

    'final decisions and cleanup
    IF Match = 4 THEN GameWon = TRUE
    NumGuesses = NumGuesses + 1: IF NumGuesses = 11 THEN GameOver = TRUE

END SUB
It's not the having, it's the doing.
Reply
#2
You might want to compare: https://qb64phoenix.com/forum/showthread...62#pid3162
b = b + ...
Reply
#3
(01-24-2023, 02:57 AM)bplus Wrote: You might want to compare: https://qb64phoenix.com/forum/showthread...62#pid3162

Interesting, nice rendition.

My version more closely mimics the game board I played growing up.

[Image: 2399932549-e9f1ce36ec-b.jpg]
It's not the having, it's the doing.
Reply
#4
Yeah I mixed mine up with Bulls and Cows played with number digits which I had done first. Don't think I ever played on Master Mind Board Game.

Your game took me a moment to figure out where to click the colors into. I started out trying to click them up top ("Why isn't anything working", LOL!)
b = b + ...
Reply
#5
Nice, clear implementation of a classic game. What more could you ask for? Thanks for sharing
RokCoder - dabbling in QB64pe for fun
Reply




Users browsing this thread: 1 Guest(s)