set about "MasterMind - (c) 1993 Invicta Toys and Games Ltd.
  simulated in Tcl/Tk by R.Suchenwirth 2003

  Guess colors of 4 pegs.
  multicolor: maybe >1 of a color.
  holecolor: black possible.
  Tap on color at right, then on hole to place peg.
  Double-tap to clear hole.
  Judgement (small pins):
  red: color & place ok
  white: color ok, wrong place"

package require Tk
proc main {} {
    global g
    pack [canvas .c -bg grey30]
    set y0 5 ; set y1 10
    for {set i 0} {$i<12} {incr i} {
        .c create rect 10 $y0 15 $y1 -tag "pin $i,0"
        .c create rect 20 $y0 25 $y1 -tag "pin $i,1"
        incr y0 10; incr y1 10
        .c create rect 10 $y0 15 $y1 -tag "pin $i,2"
        .c create rect 20 $y0 25 $y1 -tag "pin $i,3"
       set h0 [expr {$y0-9}]
       set h1 [expr {$h0+14}]
       foreach j {1 2 3 4} {
           set x [expr {20*$j+20}]
           set x1 [expr {$x+14}]
           oval .c $x $h0 $x1 $h1 -tag "hole $i:$j"
       }
       incr y0 8
       .c create line 5 $y0 120 $y0
       incr y0 4; incr y1 12
    }
    #-- choosers
    set g(colors) {white yellow orange red magenta purple blue green}
    set y0 15 ; set y1 [expr $y0+14]
    foreach color $g(colors) {
        oval .c 125 $y0 139 $y1 -tag chooser -fill $color
        incr y0 20 ; incr y1 20
    }
    .c bind chooser <1> {set g(color) [%W itemcget current -fill]}
    .c bind hole <1> {%W itemconfig current -fill $g(color)}
    .c bind hole <Double-1> {%W itemconfig current -fill black}
    set x0 150 ; set x1 164
    foreach i {1 2 3 4} {
        oval .c $x0 20 $x1 34 -tag "hole t$i"
        incr x0 20 ; incr x1 20
    }
    .c create rect 145 10 230 40 -fill darkgreen -tag cover
    .c bind cover <1> {toggleCover %W}
    cbutton .c.j 190 90 Judge {judge .c}
    ccbutton .c.mc 190 150 multicolor g(multicolor)
    ccbutton .c.ec 190 175 holecolor g(holecolor)
    cbutton .c.r 190 200 New {reset .c}  
    cbutton .c.a 190 225 About {tk_messageBox -message $about}
    cbutton .c.q 190 250 Quit exit
    reset .c
}

proc toggleCover w {
    if {[$w find below cover]==""} {
        $w raise cover
    } else {
        $w lower cover
    }
}

proc cbutton {w x y text cmd} {
    button $w -text $text -command $cmd -width 8 -bg gray30 -fg green
    [winfo parent $w] create window $x $y -window $w
}

proc ccbutton {w x y text var } {
    checkbutton $w -text $text -variable $var -bg gray30 -fg green
    [winfo parent $w] create window $x $y -window $w
}

proc reset w {
    global g
    set g(row) 0
    set colors $g(colors)
    if $g(holecolor) {lappend colors black}
    $w itemconfig pin -fill black
    $w itemconfig hole -fill black
    foreach i {1 2 3 4} {
        set color [? $colors]
        if !$g(multicolor) {lremove colors $color}
        $w itemconfig t$i -fill $color
    }
    $w raise cover
}
proc ? L {
    lindex $L [expr {int(rand()*[llength $L])}]
}
proc judge w {
    global g
    set target {}
    foreach i {1 2 3 4} {
        lappend target [$w itemcget t$i -fill]
    }
    set guess {}
    foreach i {1 2 3 4} {
        lappend guess [$w itemcget $g(row):$i -fill]
    }
    set res {}
    foreach gs $guess t $target {
        if {$gs == $t} {
            lappend res red
            lremove guess $gs
            lremove target $t
        }
    }
    foreach gs $guess {
        if {[lsearch $target $gs]>=0} {
            lappend res white
            lremove target $gs
        }
    }
    foreach i {0 1 2 3} pin $res {
        $w itemconfig $g(row),$i -fill $pin
    }
    incr g(row)
    if {$g(row)>12 || $res=="red red red red"} {
        $w lower cover
    }
}
proc lremove {listName elem} {
    upvar 1 $listName list
    set pos [lsearch $list $elem]
    set list [lreplace $list $pos $pos]
}
# Workaround for circles
proc rp {x0 y0 x1 y1 {n 0} } {
    set xm [expr {($x0+$x1)/2.}]
    set ym [expr {($y0+$y1)/2.}]
    set rx [expr {$xm-$x0}]
    set ry [expr {$ym-$y0}]
    if {$n==0} {
        set n [expr {round(($rx+$ry))}]
    }
    set step [expr {atan(1)*8/$n}]
    set res ""
    set th [expr {atan(1)*6}]
    for {set i 0} {$i<$n} {incr i} {
        lappend res \
            [expr {$xm+$rx*cos($th)}] \
            [expr {$ym+$ry*sin($th)}]
        set th [expr {$th+$step}]
    }
    set res
}
proc oval {w x0 y0 x1 y1 args} {
    eval $w create poly [rp $x0 $y0 $x1 $y1] $args
}
#--------------
main
wm geometry . 236x268+0+0