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