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.
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.
![[Image: 2399932549-e9f1ce36ec-b.jpg]](https://i.ibb.co/VHnNFWg/2399932549-e9f1ce36ec-b.jpg)
