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 [http://mitglied.lycos.de/diaboloking2002/clemens/down.htm]. 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

----
[AMG]: My, what an interesting indentation style!  Anyway, I cleaned up some Unicode breakage.

----
[Category Games]