News:

Welcome to RetroCoders Community

Main Menu

Mastermind

Started by johnno56, Apr 10, 2023, 01:30 AM

Previous topic - Next topic

johnno56

Converted Mr. Ahl's Mastermind to BAM - Actually, not a lot of conversion was needed... lol

This version only gives you 10 attempts to guess the code...

Locate , 24: Print "MASTERMIND"
Locate , 20: Print "CREATIVE COMPUTING"
Locate , 18: Print "MORRISTOWN, NEW JERSEY"
Print: Print: Print
Print "THE GAME OF MASTERMIND"
Print
Print "COLOR CODES:"
Print "               R=RED     O=ORANGE     Y=YELLOW"
Print "               G=GREEN   B=BLUE       P=PURPLE"
Print

Dim B$(10), Y(10), Z(10), C(4), G(4), R(4)

C(0) = 4

Randomize Timer

label190:

For N = 1 To 4
    C(N) = Int(6 * Rnd(1) + 1)
Next N
For N = 1 To 4
    X = C(N)
    GoSub label730
    C(N) = X
Next N
P$ = ""
For X1 = 1 To 4
    P$ = P$ + Chr$(C(X1))
Next X1

' PRINT P$  - THIS IS THE CODE!  SHHH!!!

For P = 1 To 10

    label290:

    Print
    Print "MOVE NUMBER "; P;
    Input G$: G$ = UCase$(G$)
    If G$ = "BOARD" Then GoTo label910
    If G$ = "QUIT" Then GoTo label440
    B$(P) = G$
    GoSub label520
    If B = 4 Then GoTo label1010
    GoSub label600
    Print B; " BLACK PEGS"
    Y(P) = B
    Print W; " WHITE PEGS"
    Z(P) = W
Next P

Print: Print "SORRY, YOU LOSE"

label440:

Print: Print "THE CORRECT CODE WAS: "; P$

label450:

Print: Print "WANT TO PLAY AGAIN ";
Input A$: A$ = UCase$(A$)
If A$ = "YES" Or A$ = "Y" Then
	Cls
	Print "COLOR CODES:"
	Print "               R=RED     O=ORANGE     Y=YELLOW"
	Print "               G=GREEN   B=BLUE       P=PURPLE"
	Print
	GoTo label190
End If
Print
End

Rem COMPUTE BLACK PEGS

label520:

For X1 = 1 To 4
    G(X1) = Asc(Mid$(G$, X1, 1))
Next X1
B = 0
For K = 1 To 4
    If G(K) <> C(K) Then GoTo label570
    B = B + 1

    label570:
Next K
Return

Rem COMPUTE WHITE PEGS

label600:

For X1 = 1 To 4
    R(X1) = Asc(Mid$(P$, X1, 1))
Next X1
W = 0
For I = 1 To 4
    For J = 1 To 4
        If G(I) <> R(J) Then GoTo label680
        W = W + 1
        R(J) = 0
        GoTo label690

        label680:

    Next J

    label690:

Next I
W = W - B
Return

Rem TRANSLATE COLOR CODES TO NUMERICS

label730:

If X <> 1 Then GoTo label760
X = 89
Return

label760:

If X <> 2 Then GoTo label790
X = 82
780 Return

label790:

If X <> 3 Then GoTo label820
X = 80
Return

label820:

If X <> 4 Then GoTo label850
X = 79
Return

label850:

If X <> 5 Then GoTo label880
X = 71
Return

label880:

X = 66
Return

Rem PRINT BOARD SUMMARY

label910:

V = P - 1
Print "GUESS", "BLACKS", "WHITES"
Print "-----", "------", "------"
For I = 1 To V
    Print B$(I), Y(I), Z(I)
Next I
GoTo label290

label1010:

Print: Print "YOU WIN!!": Print
If P < 2 Then
	Print "YOU ARE ALMOST AS SMART AS I AM..."
	_DELAY 3: PRINT" .... or you cheated!"
End If
If P > 1 And P < 5 Then Print "VERY GOOD SCORE!"
If P > 4 And P < 8 Then Print "NOT TOO BAD."
If P > 7 And P < 11 Then Print "ROOM FOR IMPROVEMENT."
Print
GoTo label450
End

Added a "rating" if you win... Could use a little colour... lol
May your journey be free of incident.  Live long and prosper.

CharlieJV

No way !


I"m 2 minutes from hitting the hay, but I'll be giving that a spin tomorrow.

johnno56

No promises... but there maybe an extreme outside chance that I can convert some kind of graphics/mouse version... The only problem with a graphical version is that the text is rendered at the graphics cursor... Going to have to think this one out... Maybe do it in reverse?... Position the graphics at the text cursor... This could be fun!
May your journey be free of incident.  Live long and prosper.

johnno56

Update:

About 2016, I converted a graphical version written with smallbasic (not the windows small basic) to sdlBasic.

Today, I converted that version to QB64, which ran ok. Somehow the colours were a little, let's just say, not quite right... and leave it with that... lol But the program ran as coded...

Ok. BAM's turn... Just finished the the conversion, a few tweaks here and there, but overall, it ran just fine. I still need to place text on the screen in the right places, but the controls of selecting colours, placing colours, guessing and quit all seem to work ok. There is no "Play Again" at the moment. I will have to give that one some extra grey matter... lol

The layout is not 'efficient' (too spread out) and a lot on the 'ugly' side... lol

As soon as I get some kind of text displaying on the screen, I will post it... On the required 800x600x32 screen, the text is quite small and at times difficult to read... I will tinker with 640x480 and see if I can make it easier to read...

Had a thought... Ok, stop laughing! BAM runs via a web page, right? Is it possible some how to access/use html font/text attributes? My initial guess would be no... but I still need to ask... lol
May your journey be free of incident.  Live long and prosper.

CharlieJV

Quote from: johnno56 on Apr 10, 2023, 01:30 AMConverted Mr. Ahl's Mastermind to BAM - Actually, not a lot of conversion was needed... lol

This version only gives you 10 attempts to guess the code...

(SNIP!)

Added a "rating" if you win... Could use a little colour... lol

Man that's fun.  Kind of embarrassing: it has been so long since I've played, I had to lookup game play.

CharlieJV

Quote from: CharlieJV on Apr 11, 2023, 12:03 AM
Quote from: johnno56 on Apr 10, 2023, 01:30 AMConverted Mr. Ahl's Mastermind to BAM - Actually, not a lot of conversion was needed... lol

This version only gives you 10 attempts to guess the code...

(SNIP!)

Added a "rating" if you win... Could use a little colour... lol

Man that's fun.  Kind of embarrassing: it has been so long since I've played, I had to lookup game play.

If you don't mind: published here.

johnno56

I have almost finished the simplified graphics version. I only need to add instructions and end of game messages. Oh man... The amount of tinkering to get text to kind of line up with the graphics... I just realised that the amount of struggle is caused by the low levels of caffeine in the system...

If everything goes to plan the entire game will be mouse driven... I hope... lol
May your journey be free of incident.  Live long and prosper.

johnno56

Here is the preliminary graphics version. Slight difficulty with the winner/loser events. The program just ends when either the player wins or loses... Never the less, it seems to run ok.

If you find and "random features" or have any suggestion for improvement, as Spock would say... "I am all ears, Captain."

Screen _NewImage(350, 480, 32)

Dim Shared bl, r, g, b, y, o, p, w, gy, cy
Dim shared curcolr, lc, clr$
Dim shared ccs(6), ccg(6), gues$(4)
'	cc= color counts, so  ccs= color counts in secret$,  ccg= color counts in guess$

curcolr = 0
clr$ = ""
lc = 0

bl = _RGB(0, 0, 0)
r = _RGB(255, 0, 0)
g = _RGB(0, 255, 0)
b = _RGB(0, 0, 250)
y = _RGB(255, 255, 0)
o = _RGB(255, 128, 0)
p = _RGB(255, 0, 255)
w = _RGB(255, 255, 255)
gy = _RGB(128, 128, 128)
cy = _RGB(0, 255, 255)

deck$ = "RGBYOP" 'here are 6 color initials Red Green Blue Yellow Orange Purple

'	Initialise the guess colours
For i = 1 To 4
	gues$(i) = ""
Next

Randomize Timer

' Make the secret code
secret$ = ""
For i = 1 To 4
	secret$ = secret$ + Mid$(deck$, Int(Rnd * 6) + 1, 1)
Next

'	Count 4 colors in secret$
For i = 1 To 4
    For j = 1 To 6
        If Mid$(secret$, i, 1) = Mid$(deck$, j, 1) Then ccs(j) = ccs(j) + 1
    Next
Next

'	Set the current colour
curcolr = r
clr$ = "R"

gosub drawcontrols

'
'   Insert instruction here  <<====-----
'

do
	color y, bl
	locate 2, 28: Print "MASTERMIND"
	
	color y, bl
	locate 8, 3: Print"Select 4 colours."
	
	color g, bl
	locate 10, 3: Print"Guess when ready."
	
	color o, bl
	locate 12, 3: Print"'B' right colour"
	locate 13, 3: Print"    in the right spot."
	
	color p, bl
	locate 15, 3: Print"'C' right colour"
	locate 16, 3: Print"    in the wrong spot."
	
	color r, bl
	locate 18, 3: Print"'X' not so lucky."

	color w, bl
	locate 21, 3: Print"Press ENTER to play"
loop until inkey$=chr$(13)
for i = 8 to 21
	locate i, 3: Print"                      "
next
_delay 1

guesses = 0: lc = 0

gosub drawFrame

'
'   Main Game Loop
'

While guesses < 16 ' The game begins....
	mb = _MouseButton(1)
	mx = _MouseX
	my = _MouseY

	Locate 5, 28: Print secret$

	If mb Then
  	If mx > 220 And  mx < 320 and my > 50 and my <450 Then ' mouse within control panel
    	If mx > 220 And mx < 320 And my > 50 And my < 100 Then '   GUESS button
      	ok = 1: guess$ = ""
        For i = 1 To 4
        	If gues$(i) = "" Then
          	ok = 0
          Else
          	guess$ = guess$ + gues$(i)
          End If
        Next
        If ok Then ' handle the guess$
          guesses = guesses + 1
          If guess$ = secret$ Then ' do we have a winner?
          	' Display winning message
						for i = 1 to 10
							if i/2 = int(i/2) then
								color bl, bl
								locate 5, 20: Print "                   "
								_delay 0.8
							else
								color g, bl
								locate 5, 20: Print "We have a WINNER!!!"
								_delay 0.8
							end if
						next
						_Delay 3
						End
          End If
          If guesses = 12 Then ' Oh dear! Out of guesses!
          	'   Display lose message
						goto Loser
          End If
          '===================counting cattle how many color counts are right
          For i = 1 To 6: ccg(i) = 0: Next 'clear old
          	cattle = 0: bulls = 0
            For i = 1 To 4 'load ccg with cooresponding color counts from guess$, how many R, how many G...
            	For j = 1 To 6
              	If Mid$(guess$, i, 1) = Mid$(deck$, j, 1) Then ccg(j) = ccg(j) + 1
              Next
            Next
            For j = 1 To 6 'now compare color counts in secret$ with those in guess$ for total cattle
            	If ccs(j) And ccg(j) Then
              	If ccg(j) >= ccs(j) Then
                	cattle = cattle + ccs(j)
                Else
                	cattle = cattle + ccg(j)
                End If
              End If
            Next
            For i = 1 To 4 'how many are right on! so much easier to count!!!
            	If Mid$(guess$, i, 1) = Mid$(secret$, i, 1) Then bulls = bulls + 1
            Next
            cows = cattle - bulls
            Color w, bl
            If bulls Or cows Then
							locate (lc + 2)+(lc*3), 20
							print string$(bulls, "B") + string$(cows, "C")
            Else
							locate (lc + 2)+(lc*3), 20
							print "X"
            End If
            lc = lc + 1
            gosub drawFrame
            For i = 1 To 4: gues$(i) = "": Next
          End If 'guess OK ends handling guess$
        ElseIf mx > 270 And mx < 320 And my > 100 And my < 150 Then ' clicked a colour update in control panel or quit
        	curcolr = r: clr$ = "R": gosub updatecolor
        ElseIf mx > 270 And mx < 320 And my > 150 And my < 200 Then
        	curcolr = g: clr$ = "G": gosub updatecolor
        ElseIf mx > 270 And mx < 320 And my > 200 And my < 250 Then
        	curcolr = b: clr$ = "B": gosub updatecolor
        ElseIf mx > 270 And mx < 320 And my > 250 And my < 300 Then
        	curcolr = y: clr$ = "Y": gosub updatecolor
        ElseIf mx > 270 And mx < 320 And my > 300 And my < 350 Then
        	curcolr = o: clr$ = "O": gosub updatecolor
        ElseIf mx > 270 And mx < 320 And my > 350 And my < 400 Then
        	curcolr = p: clr$ = "P": gosub updatecolor
        Else
        	End
        End If ' Mouse in control box
      ElseIf mx < 130 And my > lc * 32 And my < lc * 32 + 32 Then 'mouse click in the guess boxes 
'																																	just update colors and gues$ array
      	If mx < 32 Then
        	gues$(1) = clr$
          Circle (16, lc * 32 + 16), 15, curcolr
          Paint (16, lc * 32 + 16), curcolr
        ElseIf mx < 64 Then
        	gues$(2) = clr$
          Circle (48, lc * 32 + 16), 15, curcolr
          Paint (48, lc * 32 + 16), curcolr
        ElseIf mx < 96 Then
        	gues$(3) = clr$
          Circle (80, lc * 32 + 16), 15, curcolr
          Paint (80, lc * 32 + 16), curcolr
        Else
        	gues$(4) = clr$
          Circle (112, lc * 32 + 16), 15, curcolr
          Paint (112, lc * 32 + 16), curcolr
        End If 'mouse in guess frame
      End If ' mouse positions when clicked
    End If ' mousebutton
    gosub checkguess
    If InKey$ = Chr$(27) Then End
    _Display
    _Limit 60
Wend

goto Loser

Loser:
for i = 1 to 10
	if i/2 = int(i/2) then
		color bl, bl
		locate 5, 20: Print "                   "
		_delay 0.8
	else
		color o, bl
		locate 5, 20: Print "Ran out of guesses!"
		_delay 0.8
	end if
next
_Delay 3
End

checkguess:
    OK = 1
    For i = 1 To 4
        If gues$(i) = "" Then OK = 0
    Next
    If OK = 1 Then
        Line (220, 50)-(320, 100), gy, BF
				line (220, 50)-(320, 100), w, B
        Color bl, gy
				locate 10, 32: Print"GUESS"
				line (220, 50)-(320, 100), w, B
    Else
        Line (220, 50)-(320, 100), w, B
    End If
return

drawFrame:
    Circle (16, lc * 32 + 16), 16, w
    Circle (48, lc * 32 + 16), 16, w
    Circle (80, lc * 32 + 16), 16, w
    Circle (112, lc * 32 + 16), 16, w
return

updatecolor:
    Line (220, 100)-(270, 400), curcolr, BF
    line (220, 100)-(270, 400), w, B
return

drawcontrols:
		line (220, 50)-(320, 100), w, B
    Line (270,100)-(320, 150), r, BF
    Line (270,150)-(320, 200), g, BF
    Line (270,200)-(320, 250), b, BF
    Line (270,250)-(320, 300), y, BF
    Line (270,300)-(320, 350), o, BF
    Line (270,350)-(320, 400), p, BF
    Line (220,400)-(320, 450), gy, BF
    Color bl, gy
		locate 54, 33: Print "QUIT"

    Line (220, 50)-(320, 100), w, B ' Guess box
    Line (220, 400)-(320, 450), w, B ' Quit box
    For i = 100 To 350 Step 50
        Line (270, i)-(320, i), w, B
    Next
		line (270, 100)-(320, 400), w, B
    gosub updatecolor
		Line (220, 100)-(270, 400), w, B ' Current colour box
return

Winner:
for i = 1 to 10
	if i/2 = int(i/2) then
		color bl, bl
		locate 5, 20: Print "                   "
		_delay 0.8
	else
		color g, bl
		locate 5, 20: Print "We have a WINNER!!!"
		_delay 0.8
	end if
next
_Delay 3
End
return
'   -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
May your journey be free of incident.  Live long and prosper.

CharlieJV

Quote from: johnno56 on Apr 11, 2023, 02:49 AMHere is the preliminary graphics version. Slight difficulty with the winner/loser events. The program just ends when either the player wins or loses... Never the less, it seems to run ok.

If you find and "random features" or have any suggestion for improvement, as Spock would say... "I am all ears, Captain."

...

I'll have to take a look at this Thursday if not tomorrow night.

Tonight, I attended (as in viewer) World Drum Club's weekly Tuesday Museday, and was otherwise preoccupied today with a toy I got to amplify (with "Echo") my Native American flute.

Something to make the exercise of learning to play way more fun.

My "kit", if you are interested in that kind of stuff.

CharlieJV

Hey, that's really good. 

I've just played it a couple of times, and I'm having a great time.

Bravo !

johnno56

... I am currently working on a little game using get/put sprites ... nothing to write home about ... just to see if I can.
May your journey be free of incident.  Live long and prosper.