Mastermind - Printable Version

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