[Richard Suchenwirth] 2003-07-05 - I found this (physical) game in my cupboard and remembered how it thrilled me years ago. Guess what my next thought was... And here it is, runnable on [PocketPC] and hopefully elsewhere;) For single players, a random color combination is generated on every Reset. A second player can also manually put a combination under the green cover at top right. [WikiDbImage mastermind.jpg] The [Mastermind] page has an earlier implementation I wasn't aware of. ---- [Jeff Smith] 2021-07-0 : Below is an online demo using [CloudTk]. This demo runs "MasterMind 2" in an Alpine Linux Docker Container. It is a 27.4MB image which is made up of Alpine Linux + tclkit + MasterMind-2.kit + libx11 + libxft + fontconfig + ttf-linux-libertine. It is run under a user account in the Container. The Container is restrictive with permissions for "Other" removed for "execute" and "read" for certain directories. <> <> ---- ====== 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 {%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 ====== <> Games