goclient.pli

net plug source code

      } elseif {[string match "1 ?" $str]} {
	set sz [string length $gocli($n,board,00)];
	set id $gocli($n,board,gid)
	set wg .goban$n-$id;
	if {[winfo exists $wg]} {
	  $wg.g delete stones;
	} else {
	  toplevel $wg
	  wm title $wg "Game $id (C$n)";
	  label $wg.l ;
          goban $wg.g $sz;
	  pack $wg.l ;
          pack $wg.g -fill both -expand 1;
	  bind $wg.g <1> "goplayxy $n %W %x %y";
	}
	$wg.l configure -text $gocli($n,board,label);
	set i 1;
	foreach line [lsort [array names gocli "$n,board,??"]] {
	  set j $sz;
	  foreach pos [split $gocli($line) ""] {
	    switch -- $pos {
	      "0" {go_stone $wg.g stones $i $j black}
	      "1" {go_stone $wg.g stones $i $j white}
	      "4" {go_mark  $wg.g stones $i $j white white}
	      "5" {go_mark  $wg.g stones $i $j black black}
	    }
	    incr j -1;
	  }
	  incr i;
	  if {$i>$sz} break;
	}
        if {[info exists gocli($n,last,color)]} {
	  switch -- $gocli($n,last,color) {
           "B" {
	     eval go_mark $wg.g stones \
		 [gocoord2ij $gocli($n,last,pos)] white
           }
           "W" {
	     eval go_mark $wg.g stones \
		 [gocoord2ij $gocli($n,last,pos)] black 
           }
          }
        }
	set  gocli($n,state) normal;
	unset gocli($n,board,gid);
	return [gocli_parse $n $str];
      }
    }
    normal {
      if {[regexp {^([0-9]+) (.*)} $str all num1 rest]} {
        switch $num1 {
	  2 {
	    bell
	  }
	  25 -
          8 -
          9 {
	    if {[cequal $rest "File"]} {
	      set gocli($n,state) file;
	    } else {
	      defOut $n 0 "$rest\n" info;
	    }
	  }
	  1 {
	    switch -- $rest {
	      "5" {set gocli($n,srv) ready}
	      "8" {set gocli($n,srv) observing}
	      "6" {set gocli($n,srv) playing}
	      "7" {set gocli($n,srv) "remove dead groups"}
	      default {set gocli($n,srv) "unknown ($rest)"}
	    }
	    if {![cequal "" $gocli($n,task)]} {
	      set tsk $gocli($n,task);
	      set gocli($n,task) "";
	      uplevel #0 $tsk;
	    }
	  }
          24 {
	    defOut $n 0 "$rest\n" private;
	  }
          7 -
          21 -
	  27 -
          39 {
	    defOut $n 0 "$rest\n" normal;
	  }
          5 { # error
	    defOut $n 0 "%%% $rest\n" error;
          }
	  32 {
	    regexp {^([^:]+):([^:]+):(.*)$} $rest all where who what;
	    defOut $n 0 "<$who:$where> $what\n" message; 
	  }
	  40 {
	    # ignore 
	    puts ". = $rest";
	  }
	  23 -
          20 -
          19 -
          28 -
	  26 -
          11 {
	    defOut $n 0 "$rest\n" play;
          }
	  15 {
	    if {[regexp {^Game ([0-9]+) .: (.*)$} $rest all gid infos]} {
	      set gocli($n,board,label) $infos;
	      go_query_status $n $gid;
              catch {unset gocli($n,last,color)}
	    } else {
              regexp {\(([BW])\): ([A-Z][0-9]+)$} $rest all \
		      gocli($n,last,color) gocli($n,last,pos) ;
	      defOut $n 0 "Game $gocli($n,board,gid) : $rest\n" play;
	    }
	  }
          22 {
	    if {[info exist gocli($n,board,gid)]} {
	      set gocli($n,state) drawing;
	      return [gocli_parse $n $str];
	    } else {
	      defOut $n 0 "unexpected $str\n" error;
	    }
          }
          default {defOut $n 0 "? $str\n" unknown}
        }
      } else {
        if {![cequal "" $str]} {defOut $n 0 "+ $str\n"}
      }
    }
    login {
      defOut $n 0 "$str\n" login;
    }
    default {
      defOut $n 0 "! $str\n";
    }
  }
  update idletasks;
}


set tcl_precision 17;

proc rescale {path width height} {
  global _go;
  set nsz [expr ($width<$height) ? $width : $height ];
  puts "rescale $width x $height : $nsz";
  set oscale $_go($path,scale);
  set nscale [expr int(($nsz-$_go($path,plus))/($_go($path,size)+1))]
  set mult [expr 1.*$nscale/$oscale];
  puts "scale change for $path : $oscale -> $nscale ($mult)";
  if {$nscale==$oscale} return;
  set _go($path,scale) $nscale;
  $path scale all 0 0 $mult $mult;
}

# 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 -width $width -height $width;  # -background $color

  set gm1 [expr int($scale/2)];
  set gm2 [expr int($size*$scale+$gm1)];
  set gm3 [expr $gm2+2];
  $path create rectangle $gm1 $gm1 $gm2 $gm2 \
	  -fill $color -outline $color -tag goban;

  # go ban lines
  set max [expr $size*$scale];
  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 $gm3 $p -tag coord \
	      -text "[format %2d [expr $size+1-$i]]" -anchor w;
      $path create text $p $gm2 -tag coord \
          -text [format %c [expr 64+$i+($i>=9)]] -anchor n;
    }
  }
  if {$coord} {
    $path lower coord goban;
    set cl [$path bbox coord];
    set _go($path,plus) [expr 1+[lindex $cl 2]-$width];
    set width  [expr ($size+1)*$scale+$_go($path,plus)];
    $path configure -width $width -height $width;
  } else {
    set _go($path,plus) 1;
  }
  puts "plus= $_go($path,plus)";
  # 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;
  }
  bind $path <Configure> "rescale %W %w %h";
  return $path
}


# place a stone
proc go_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;
}


# place a mark 
proc go_mark {path tag posx posy color {fillcolor ""}} {
  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 rectangle [expr ($posx-.15)*$scale] [expr ($posy-.15)*$scale] \
                         [expr ($posx+.15)*$scale] [expr ($posy+.15)*$scale] \
               -tag $tag -fill $fillcolor -outline $color;

}


#

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 goplayxy {n path x y} {
  set where [eval goij2coord [goxy2ij $path $x $y]];
puts "called n=($n), x=($x), y=($y), where=($where)";
  defOut $n 0 "Playing on $where\n" play;
  go_send $n $where;
}


list "Go game ..." GoCliInit;