Version 4 of A little Go board

Updated 2006-06-23 23:53:28

<u style="display: none;">... no changes ... no changes ... no changes ... no changes ... no changes ... no changes ... no changes ... no changes ... no changes ... no changes ... no changes ... <a href='car'>http://www.insurance-top.com'>car insurance</a> : [L1 ] - HTTP://www.insurance-top.com auto insurance : [Insurance car|http://www.insurance-top.com ] - Insurance car|HTTP://www.insurance-top.com : http://www.insurance-top.com/auto/ : [http://www.insurance-top.com insurance quote] : [http://www.insurance-top.com | home insurance] : "cars insurance" http://www.insurance-top.com : [L2 ] </u>----

Richard Suchenwirth -- From the Popular Board Game series, here's a Go set in Tk. Playing must be done by humans, of course. See also A little checker game, Nine Men Morris. Enjoy!

---

 # GoBoard.tcl

 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
 }

 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]"
 }

 proc reset {w} {
    global grid size colors title
    wm title . $title
    $w delete mv
    set xm1 [expr $grid-$size]
    set xm2 [expr $grid*19]
    set ym  [expr $grid*20+$size/2]
    set c2  [lindex $colors 2]
    set c3  [lindex $colors 3]
    for {set i 0} {$i<180} {incr i} {  ;# create stones:
      $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; incr xm2 -1
    }
 }

 proc board {grid colors linewidth} {
   set y  [set x  [set y0 [set x0 $grid]]]
   set y1 [set x1 [expr $grid*19]]
   set fill [lindex $colors 1]
   set dot 3
   for {set i 0} {$i<19} {incr i} {  ;# create playfield:
      .c create line $x  $y0 $x  $y1 -fill $fill -width $linewidth
      .c create line $x0 $y  $x1 $y  -fill $fill -width $linewidth
      if {$i==3 || $i==9 || $i==15} {
        foreach j {3 9 15} {
          set xx [expr $x0 + $j * $grid]
          .c create oval [expr $xx-$dot] [expr $y-$dot] [expr $xx+$dot] [expr $y+$dot] -fill $fill
       }
     }
     .c create text [expr $x0-10]  $y  -text [expr 19-$i]   ;# Labels 1..19
     incr x $grid; incr y $grid
   }
   set  x $x0
   incr y  -8
   for {set i 0} {$i<19} {incr i} {  ;# Labels A..T:
    .c create text $x $y  -text [string index "ABCDEFGHJKLMNOPQRSTx" $i]
    incr x $grid;
   }
   reset .c
 }

 set title "Go"
 set size 18   ;# this determines all other scaling
 set colors {beige brown white black} ;# 2 for board, 2 for men
 set linewidth 2
 set grid [expr int($size*1.2)]
 canvas .c -width [expr $grid*20] -height [expr $grid*20+2*$size]
 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}
 .c bind mv <ButtonRelease-1> {drop %x %y}

 button .c.b -text X -command {reset .c} -padx 0 -pady 0
 .c create rect 0 0 [expr $grid*20] [expr $grid*20] -fill [lindex $colors 0]
 .c create window   [expr $grid*10] [expr $grid*21-$size] -window .c.b -anchor n
 board $grid $colors $linewidth

---

Notice that quite some amount of code is shared with the other games. With some packaging, these could make a nifty board game chest ;-)

HJG Added labels and dots.

---

Category Games