During a hard disk cleanup I found an old (Tcl 7.6 / Tk 4.2) weekend fun program, MasterMind. I massaged it a bit to work with Tcl/Tk 8.4. A starkit (along with other starkits) can be found on my sons download page [L1 ]. It's a german version, but I plan to internationalize it eventually (and remove the verbose random number generation). Have fun.
See also MasterMind 2 (I didn't know this page when I wrote that- RS).
#!/usr/local/bin/wish8.4
package require Tk
set color_tab(0) chocolate3
set color_tab(1) white
set color_tab(2) yellow
set color_tab(3) orange
set color_tab(4) red
set color_tab(5) green
set color_tab(6) blue
set color_tab(7) tan4
set color_tab(8) black
set act_color 1
set act_row 0
set spiel 1
set pkt 0
set total_pkt 0
set helptxt "
Mastermind ( Superhirn ):
Setzen und Löschen von Farbpins:
Mit der linken Maustaste auf das Feld klicken, auf
das der Farbpin gesetzt werden soll.
Mit der rechten Maustaste wird der Farbpin wieder
entfernt.
Beides funktioniert nur in Zeilen, die noch nicht
bewertet wurden.
Farbauswahl:
Mit der linken Maustaste im Feld \"Farbauswahl\" auf
die gewünschte Farbe klicken. Das angewählte Feld
erscheint eingesunken.
Bewertung:
Mit der linken Maustaste auf den Knopf mit der
Zeilennummer klicken. Der Knopf bleibt eingesunken.
Rechts erscheint die Bewertung, erst die schwarzen,
dann die weißen Bewertungspins.
Weiß bedeutet, daß die Farbe eines Pins des Geheim-
codes richtig erraten wurde.
Schwarz bedeutet, daß Farbe und Position eines Pins
des Geheimcodes richtig erraten wurde.
Spielende:
Wenn alle Pins richtig gesetzt wurden (fünf schwarze
Bewertungspins) oder in der zwölften Reihe der
Geheimcode nicht erraten wurde, ist das Spiel zu Ende.
Im oberen Anzeigefeld wird der Geheimcode aufgedeckt
und die neue Gesamtpunktzahl angezeigt.
Die Punktzahl ist die Anzahl Reihen, die benötigt
wurden, um den Geheimcode zu entschlüsseln. Wurde
der Geheimcode nicht erraten, werden 15 Punkte
gezählt.
Hilfe/Weiter/Ende:
Beim Anklicken des grauen Hilfe-Knopfes erscheint
diese Hilfe.
Beim Anklicken des grünen Weiter-Knopfes wird das
Spielfeld in den Anfangszustand versetzt, die Spiel-
nummer um 1 erhöht und die Punktzahl auf 0 gesetzt.
Beim Anklicken des roten Ende-Knopfes wird das Spiel
abgebrochen.
"
frame .dsp -bg $color_tab(0) -bd 3 -relief groove
frame .field -bg $color_tab(0) -bd 3 -relief groove
frame .panel -bg $color_tab(0) -bd 3 -relief groove
pack .dsp .field .panel -fill x -padx 1m -pady 1m
frame .dsp.ft -bg $color_tab(0)
frame .dsp.fc -bg $color_tab(0)
pack .dsp.ft .dsp.fc -pady 1m -fill x
label .dsp.ft.spl -text "Spiel:" -bg $color_tab(0)
label .dsp.ft.spn -textvariable spiel -bg $color_tab(0) -width 2
label .dsp.ft.pktl -text "Punkte:" -bg $color_tab(0)
label .dsp.ft.pktn -textvariable pkt -bg $color_tab(0) -width 3
label .dsp.ft.tpl -text "Gesamt:" -bg $color_tab(0)
label .dsp.ft.tpn -textvariable total_pkt -bg $color_tab(0) -width 4
pack .dsp.ft.spl .dsp.ft.spn .dsp.ft.pktl .dsp.ft.pktn .dsp.ft.tpl .dsp.ft.tpn \
-side left -padx 1m -fill x
label .dsp.fc.lbl -relief flat -width 2 -bg $color_tab(0)
pack .dsp.fc.lbl -side left -padx 2m
for {set n 0} {$n < 5} {incr n} {
frame .dsp.fc.n$n -bg $color_tab(0) \
-relief sunken -bd 3 -width 6m -height 6m
pack .dsp.fc.n$n -side left -padx 1m
}
. configure -bg $color_tab(0)
wm title . "Superhirn"
wm resizable . 0 0
proc init_array {} {
global pin_array aim_array
for {set col 0} {$col < 5} {incr col} {
set aim_arry($col) 0
for {set row 1} {$row < 13} {incr row} {
set pin_array($row,$col) 0
}
}
}
proc choose_combination {} {
global aim_array
for {set n 0} {$n < 5} {incr n} {
set aim_array($n) 0
}
set seed [expr [clock clicks] % 107520]
set ptr 0
while {$ptr < 5} {
set seed [expr (24298 * $seed + 99991) % 199017]
set rand [expr int($seed * 8 / 199017) + 1]
set coll 0
for {set n 0} {$n < $ptr} {incr n} {
if {$rand == $aim_array($n)} {
set coll 1
break
}
}
if {$coll} {continue}
set aim_array($ptr) $rand
#set_color_pin 12 $ptr $aim_array($ptr)
incr ptr
}
}
proc next_game {} {
global color_tab act_row spiel pkt
for {set n 0} {$n < 5} {incr n} {
.dsp.fc.n$n configure -bg $color_tab(0) -relief sunken
}
for {set row 1} {$row < 13} {incr row} {
.field.fr$row.nr$row configure -relief raised
for {set col 0} {$col < 5} {incr col} {
.field.fr$row.fc$row.colbut${row}x$col configure \
-bg $color_tab(0) -relief sunken
.field.fr$row.fa$row.colans${row}x$col configure \
-bg $color_tab(0) -relief sunken
}
}
set act_row 0
incr spiel
set pkt 0
choose_combination
}
proc calc_result {row} {
global pkt total_pkt aim_array color_tab
incr pkt $row
incr total_pkt $row
for {set n 0} {$n < 5} {incr n} {
.dsp.fc.n$n configure -bg $color_tab($aim_array($n)) -relief raised
}
}
proc set_color_pin {row col clr} {
global color_tab act_row pin_array
if {$row > $act_row} {
.field.fr$row.fc$row.colbut${row}x$col configure -relief raised \
-bg $color_tab($clr)
set pin_array($row,$col) $clr
}
}
proc reset_color_pin {row col} {
global color_tab act_row pin_array
if {$row > $act_row} {
.field.fr$row.fc$row.colbut${row}x$col configure -relief sunken \
-bg $color_tab(0)
set pin_array($row,$col) 0
}
}
proc set_answer_pin {row col clr} {
if {$clr == 1} {
.field.fr$row.fa$row.colans${row}x$col configure -relief raised \
-bg white
} else {
.field.fr$row.fa$row.colans${row}x$col configure -relief raised \
-bg black
}
}
proc answer {row} {
global act_row pin_array aim_array
if {[expr $row - $act_row] == 1} {
.field.fr$row.nr$row configure -relief sunken
incr act_row
}
set whities 0
set blackies 0
for {set n 0} {$n < 5} {incr n} {
set hit 0
for {set i 0} {$i < 5} {incr i} {
if {$pin_array($row,$i) == $aim_array($n)} {
set hit 1
if {$n == $i} {
set hit 2
break
}
}
}
if {$hit == 1} {
incr whities
} elseif {$hit == 2} {
incr blackies
}
}
set col 0
for {set n 0} {$n < $blackies} {incr n} {
set_answer_pin $row $col 2
incr col
}
for {set n 0} {$n < $whities} {incr n} {
set_answer_pin $row $col 1
incr col
}
if {$blackies == 5} {
calc_result $act_row
set act_row 15
} elseif {$act_row == 12} {
set act_row 15
calc_result $act_row
}
}
proc create_colors_row {row} {
global color_tab
frame .field.fr$row.fc$row -bg $color_tab(0)
pack .field.fr$row.fc$row -side left -padx 1m
for {set n 0} {$n < 5} {incr n} {
frame .field.fr$row.fc$row.colbut${row}x$n -bg $color_tab(0) \
-relief sunken -bd 3 -width 6m -height 6m
pack .field.fr$row.fc$row.colbut${row}x$n -side left -padx 1m
bind .field.fr$row.fc$row.colbut${row}x$n <Button-1> "
set_color_pin $row $n \$act_color"
bind .field.fr$row.fc$row.colbut${row}x$n <Button-3> "
reset_color_pin $row $n"
}
}
proc create_answer_row {row} {
global color_tab
frame .field.fr$row.fa$row -bg $color_tab(0)
pack .field.fr$row.fa$row -side left -padx 1m
for {set n 0} {$n < 5} {incr n} {
frame .field.fr$row.fa$row.colans${row}x$n -bg $color_tab(0) \
-relief sunken -bd 3 -width 4m -height 4m
pack .field.fr$row.fa$row.colans${row}x$n -side left -padx 1m -pady 1m
}
}
proc create_row {row} {
global color_tab
frame .field.fr$row -bg $color_tab(0)
pack .field.fr$row -side bottom -fill x -padx 1m -pady 1m
label .field.fr$row.nr$row -bg $color_tab(0) -text $row \
-relief raised -width 2 -bd 2
pack .field.fr$row.nr$row -side left -padx 1m
bind .field.fr$row.nr$row <Button-1> "answer $row"
create_colors_row $row
create_answer_row $row
}
#
# read help text
#
proc readhelp {} {
global helptxt
# set ht [open [file join $::starkit::topdir help help.txt] r]
# while { ! [eof $ht] } {
# .help.f.help insert end [gets $ht]
# .help.f.help insert end "\n"
# }
.help.f.help insert end $helptxt
}
#
# show help window
#
proc help {} {
toplevel .help
wm title .help "Mastermind Hilfe"
frame .help.f
text .help.f.help -width 62 -setgrid 1 -wrap word \
-yscrollcommand {.help.f.scr set} \
-highlightthickness 0
scrollbar .help.f.scr -command {.help.f.help yview} \
-highlightthickness 0
button .help.dis -text "Hilfe beenden" -command {destroy .help} \
-highlightthickness 0
pack .help.f
pack .help.dis -fill x
pack .help.f.help -side left
pack .help.f.scr -side left -fill y
readhelp
.help.f.help configure -state disabled
}
proc create_color_choice {} {
global color_tab act_color
label .panel.lbl -text "Farbauswahl:" -bg $color_tab(0) -anchor w
frame .panel.colors -bg $color_tab(0)
pack .panel.lbl .panel.colors -padx 2m -pady 1m
for {set n 1} {$n < 9} {incr n} {
frame .panel.colors.c$n -bg $color_tab($n) -bd 3 \
-width 8m -height 8m
bind .panel.colors.c$n <Button-1> "
.panel.colors.c\$act_color configure -relief flat
.panel.colors.c$n configure -relief sunken
set act_color $n"
pack .panel.colors.c$n -side left -padx 1m
}
frame .panel.but -bg $color_tab(0) -bd 3 -relief groove
pack .panel.but -fill x -expand 1 -padx 1m -pady 1m
button .panel.but.help -text "Hilfe" -command help \
-bg gray80 -activebackground gray85 -bd 2 \
-highlightthickness 0
button .panel.but.next -text "Weiter" -command next_game \
-bg green2 -activebackground green -bd 2 \
-highlightthickness 0
button .panel.but.exit -text "Ende" -command {destroy .} \
-bg red2 -activebackground red -bd 2 \
-highlightthickness 0
pack .panel.but.help .panel.but.next .panel.but.exit \
-side left -padx 1m -pady 1m -fill x -expand 1
}
for {set n 1} {$n <= 12} {incr n} {
create_row $n
}
create_color_choice
.panel.colors.c1 configure -relief sunken
init_array
choose_combination