Version 3 of Nine Men Morris

Updated 2003-06-10 06:40:41

Richard Suchenwirth 2002-08-04 -- From the Popular Board Game series, here's Nine Men Morris [DE:Mühle] in Tk. See also A little checker game, A little Go board. Enjoy!

 set title "9 Men Morris"
 set size 22 ;#this determines all other scaling
 set colors {beige brown white black} ;# 2 for board, 2 for men

 set linewidth [expr $size/5]
 set grid [expr int($size*1.2)]
 canvas .c -width [expr $grid*8] -height [expr $grid*9+$size/2]
 pack .c
 wm resizable . 0 0
 .c bind mv <1> {set c(X) [.c canvasx %x]; set c(Y) [.c canvasy %y]}
 .c bind mv <B1-Motion> {mv %x %y}
 proc mv {ax ay} {
    global c
    set x [.c canvasx $ax]; set y [.c canvasy $ay]
    set id [.c find withtag current]
    .c move $id [expr $x-$c(X)] [expr $y-$c(Y)]
    .c raise $id
    set c(X) $x; set c(Y) $y
 }
 .c bind mv <ButtonRelease-1> {drop %x %y}
 proc drop {ax ay} {
    global c grid size title
    set s2 [expr $size/2]
    set id [.c find withtag current]
    set x [.c canvasx $ax]; set y [.c canvasy $ay]
    set x1 [expr (int($x+$s2)/$grid)*$grid]
    set y1 [expr (int($y+$s2)/$grid)*$grid]
    .c coords $id [expr $x1-$s2] [expr $y1-$s2] \
            [expr $x1+$s2] [expr $y1+$s2]
    wm title . "$title - last: [.c itemcget $id -fill]"
 }
 .c create rect 0 0 [expr $grid*8] [expr $grid*8] -fill [lindex $colors 0]
 button .c.b -text Reset -command {reset .c} -padx 0
 .c create window [expr $grid*4] [expr $grid*9-$size] -window .c.b -anchor n
 proc reset {w} {
    global grid size colors title
    wm title . $title
    $w delete mv
    set xm1 [expr $grid-$size]
    set xm2 [expr $grid*7]
    set ym [expr $grid*8+$size/2]
    set c2 [lindex $colors 2]
    set c3 [lindex $colors 3]
    foreach i {1 2 3 4 5 6 7 8 9} {
        $w create oval $xm1 $ym [expr $xm1+$size] [expr $ym+$size] \
                -fill $c2 -outline $c3 -tags {mv player1}
        $w create oval $xm2 $ym [expr $xm2+$size] [expr $ym+$size] \
                -fill $c3 -outline $c2 -tags {mv player2}
        incr xm1 5; incr xm2 -5
    }
 }
 set y0 [set x0 $grid]
 set y1 [set x1 [expr $grid*7]]
 set m [expr $grid*4]
 set m3 [expr $grid*3]
 set m5 [expr $grid*5]
 set fill [lindex $colors 1]
 .c create line $m $y0 $m $m3 -fill $fill -width $linewidth
 .c create line $m $m5 $m $y1 -fill $fill -width $linewidth
 .c create line $x0 $m $m3 $m -fill $fill -width $linewidth
 .c create line $m5 $m $y1 $m -fill $fill -width $linewidth
 foreach i {9 m m} {
    .c create line $x0 $y0 $x1 $y0 -fill $fill -width $linewidth
    .c create line $x0 $y0 $x0 $y1 -fill $fill -width $linewidth
    .c create line $x1 $y0 $x1 $y1 -fill $fill -width $linewidth
    .c create line $x0 $y1 $x1 $y1 -fill $fill -width $linewidth
    set y0 [incr x0 $grid]
    set y1 [incr x1 -$grid]
 }
 reset .c

---

Category Games