A little checker game

Richard Suchenwirth 2000-08-04 -- Anne Lavergne wrote in news:comp.lang.tcl :

 > I am looking for a spreadsheet-like Tk widget i.e. 2D array of canvases
 > (cells) to implement a chessboard.

Couldn't resist - here is a one-canvas solution, with movable checkers [BE: draughts] pieces:

  set dx 50
  set dy 50
 #set colors {black white red blue}
  set colors {white black red blue}

  pack [canvas .c -width [expr $dx*8] -height [expr $dy*8]] -fill both -expand 1

 .c bind all <1> {set c(X) [.c canvasx %x]; set c(Y) [.c canvasy %y]}
 .c bind mv <B1-Motion> {mv %x %y}

 proc mv {x y} {
    global c
    set x  [.c canvasx $x]
    set y  [.c canvasy $y]
    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
 }

 set color 0
 proc makepiece {x y color args} {
    global dx dy
    .c create oval [expr {$x+2}] [expr {$y+2}] [expr {$x+$dx-3}] [expr {$y+$dy-3}] \
             -fill $color -tags [concat $args mv]
 }
 proc makecheck {x y color args} {
    global dx dy
    .c create rectangle $x $y [expr {$x+$dx}] [expr {$y+$dy}] \
            -fill $color -tags $args
 }
 for {set i 0; set y 0} {$i<8} {incr i; incr y $dy} {
    for {set j 0; set x 0} {$j<8} {incr j; incr x $dx} {
       makecheck $x $y [lindex $colors $color]
       if {$i<3 && $color} {
          makepiece $x $y [lindex $colors 2] player2
       }
       if {$i>4 && $color} {
          makepiece $x $y [lindex $colors 3] player1
       }
       set color [expr {1-$color}]
    }
    set color [expr {1-$color}]
 }

In C/Motif, I'd not even have thought of writing something like this.. With Tcl, I come home after a real long working day and think "Wouldn't it be nice to also have a Nine Men Morris? A little Go board?" and after a long evening, here they are!

Bryan Oakley writes...

I updated the above to draw the checkers a little bit inside the borders.

Also, the following binding will make the checkers snap to a particular square. I'm sure somebody can improve on the efficiency of the solution.

 .c bind mv <ButtonRelease-1> {drop [.c find withtag current]}
 proc drop {id} {
    global c dx dy
    set cx0 [expr {int($c(X) / $dx) * $dx + 2}]
    set cy0 [expr {int($c(Y) / $dy) * $dy + 2}]
    set cx1 [expr {$cx0 + $dx - 3}]
    set cy1 [expr {$cy0 + $dy - 3}]
    .c coords $id $cx0 $cy0 $cx1 $cy1        
 }

DKF - I've improved the efficiency slightly, but there really isn't much point in doing much better, as it only has to deal with responses to bindings.

HJG I changed this checkerboard-layout to look more like I know this game... But how do you actually play this thing, e.g. how are stones removed or promoted to queen/king ?

MG It looks like you can't, right now. This seems to just implement the board and the pieces (which can be moved) with no rules at all. It probably wouldn't take a heck of a lot to develop on it, though.

uniquename 2013aug01

Here is an image so that readers can easily see what the code above creates.

Category Application

Category Games