#!/bin/sh
# the next line restarts using wish4.1 \
exec wish4.1 "$0" $@

#
# $Id: tkgoban,v 1.1.1.1 2008/10/12 04:05:34 alamos Exp $
#
# A Tcl/Tk Goban [Go game board]
#
# (c)1996 by Laurent Demailly - dl@hplyot.obspm.fr
#            http://hplyot.obspm.fr/~dl/
#
# Latest version shall always be available from 
# http://hplyot.obspm.fr/~dl/wwwtools.html
#
# This is an unfinshed ALPHA release - you should not disseminate. 
# Please mail me.
#
# (please send me feed back, comments, and tell me if you made changes,...)
#
# ``Artistic'' license see LICENSE - Author: Laurent Demailly
#
# This program is free software; you can redistribute it and/or modify
# it under the terms and CONDITIONS of the included LICENSE
#
# If you don't have the LICENSE or need to clarify anything please 
# contact the author
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
#
# $Log: tkgoban,v $
# Revision 1.1.1.1  2008/10/12 04:05:34  alamos
# Initial import
#
# Revision 1.1  2005/01/26 04:14:00  rychlik
# *** empty log message ***
#
#

# utility proc (replacement of some tclX usefull procs)
proc lassign {list args} {
  set i 0;
  foreach vname $args {
    uplevel [list set $vname [lindex $list $i]];
    incr i;
  }
  lrange $list $i end
}

# create a goban (in a canvas)
proc goban {path {size 19} {scale 20} {coord 1} {color burlywood}} {
  global _go
  set _go($path,size)  $size;
  set _go($path,scale) $scale;

  set width [expr ($size+1)*$scale+1];
  canvas $path -background $color -width $width -height $width;

  # go ban lines
  set max [expr $size*$scale+1];
  for {set i 0} {$i<$size} {} {
    incr i;
    set p [expr $i*$scale];
    $path create line $p     $scale  $p   $max ;
    $path create line $scale $p      $max $p   ;
    if {$coord} {
      $path create text $width $p -text [expr $size+1-$i] -anchor e;
      $path create text $p [expr $width+2] \
          -text [format %c [expr 64+$i+($i>=9)]] -anchor s;
    }
  }

  # intersections
  if {$size%2} {
    set a [expr (($size/2)+ .9)*$scale]
    set b [expr (($size/2)+1.1)*$scale]
    $path create oval $a $a $b $b -fill black;
  }
  set flag19 [expr $size==19];
  if {$size==9 || $flag19} {
    set a [expr (2.9+$flag19)*$scale];
    set b [expr (3.1+$flag19)*$scale];
    set s [expr (1+$flag19)*10*$scale];
    set c [expr $s-$a];
    set d [expr $s-$b];
    $path create oval $a $a $b $b -fill black;
    $path create oval $c $a $d $b -fill black;
    $path create oval $a $c $b $d -fill black;
    $path create oval $c $c $d $d -fill black;
  }
  if {$flag19} {
    set e [expr (6*$scale)+$a];
    set f [expr (6*$scale)+$b];
    $path create oval $a $e $b $f -fill black;
    $path create oval $c $e $d $f -fill black;
    $path create oval $e $a $f $b -fill black;
    $path create oval $e $c $f $d -fill black;
  }
  return $path
}

# place a stone
proc stone {path tag posx posy color {shade grey}} {
  global _go;
  set scale $_go($path,scale);

#  puts "adding $tag : ($posx , $posy) on $path : $color";

  # Y axis is inverted
  set posy [expr $_go($path,size)+1-$posy];

  $path create oval [expr ($posx-.5)*$scale] [expr ($posy-.5)*$scale] \
                    [expr ($posx+.5)*$scale] [expr ($posy+.5)*$scale] \
               -tag $tag -fill $color -outline $shade;

  # shadow / semi 3d effect
  # -fill for tk3.6 and -outline for 4.x
  $path create arc [expr ($posx-.3)*$scale] [expr ($posy-.3)*$scale] \
                   [expr ($posx+.3)*$scale] [expr ($posy+.3)*$scale] \
        -tag $tag -start 270 -extent 90 \
        -style arc -fill $shade -outline $shade;
}

proc goxy2ij {path x y} {
  global _go;
# puts "$x $y";
  set scale $_go($path,scale);
  list [expr ($x+$scale/2)/$scale] \
       [expr $_go($path,size)+1-(($y+$scale/2)/$scale)] ;
}

proc gocoord2ij {coord} {
  scan $coord %c%s i j
  set i [expr $i-64];
  if {$i>32} {incr i -32}
  if {$i>9} {incr i -1}
  list $i $j
}

proc goij2coord {i j} {
  format %c%d [expr 64+$i+($i>=9)] $j;
}

proc stonexy {path x y color} {
  eval stone \$path tag [goxy2ij $path $x $y] \$color;
}

proc bindgoban {path} {
  bind $path <1> "stonexy %W %x %y black";
  bind $path <2> "stonexy %W %x %y white";
  bind $path <Motion> "motion %W %x %y";
}

set _go(moving) 0;

# update only when it stops moving...
proc motion {path x y} {
  global _go
  set _go(x) $x;
  set _go(y) $y;
  if {$_go(moving)} return;
#  puts "first move...";
  set _go(moving) 1;
  more_motion 50 -1 -1;
  vwait _go(moving);
#  puts "end of move";
  set _go(where) [eval goij2coord [goxy2ij $path $_go(x) $_go(y)]];
}

proc more_motion {delay x y} {
#puts "more_mo $x $y";
 global _go;
 if {$_go(moving)==0} return;
 update idletasks;
 if {$x!=$_go(x) || $y!=$_go(y)} {
   after $delay "more_motion $delay $_go(x) $_go(y)";
 } else {
   set _go(moving) 0;
 }
}

proc testbans {} {
goban .go9 9 30
pack .go9
#goban .go19 19
#pack .go19
goban .go7 7
pack .go7
goban .go8 8
pack .go8
}

goban .go19 19
label .where -textvariable _go(where);
bindgoban .go19
pack .go19 .where

#testbans