home *** CD-ROM | disk | FTP | other *** search
/ ARM Club 3 / TheARMClub_PDCD3.iso / hensa / programming / tcl / tcl_1 / !Wally_GoBoard < prev    next >
Encoding:
Text File  |  1994-09-07  |  3.6 KB  |  140 lines
  1. # Wally
  2.  
  3. set even 0
  4. set size 9x9
  5. set edge 0.4
  6.  
  7. source {<tcl$Dir>.!Choices}
  8.  
  9. w_init Wally
  10.  
  11. source {<tcl$Dir>.library.debug}
  12.  
  13. set made 0
  14. set rest ""
  15.  
  16. w_box progInfo create "About this program"\
  17.  { vlist {info Name Wally}
  18.          {info Purpose "Play Go"}
  19.          {info Author W.H.Newman}
  20.          {info "Front End" C.T.Stretch}
  21.          {info Version 0.00}
  22.  }
  23.  
  24. w_box setup create "Set up board"\
  25.  { vlist {option Even even}
  26.          {hlist {radio 9x9 size} {radio 11x11 size} {radio 13x13 size}}
  27.          {hlist {radio 15x15 size} {radio 17x17 size} {radio 19x19 size}}
  28.          {hlist {action Cancel} {default Set {set x 0}}} 
  29.  }
  30.  
  31. w_text show create -title "Wally Output" -width 6i -close {list 2}
  32. w_text show open
  33.  
  34. proc play {}\
  35.  { global size n edge made even stones grid
  36.    set made 1
  37.    set n [string first x $size]
  38.    set n [string range $size 0 [expr $n-1]]
  39.    w_draw board create\
  40.         -page "[expr ($n+1)*$edge]ix[expr ($n+1)*$edge]i"\
  41.         -xscale ${edge}i -yscale ${edge}i\
  42.         -bg 255:200:0\
  43.         -click {clickproc %x %y}\
  44.         -close closeboard\
  45.         -menu {Wally {Pass -click {w_task prog send pass\n}}
  46.                      {Resign -click {w_task prog send .\n}}
  47.                      {List   -click {w_text show open}}
  48.               }
  49.    set grid ""
  50.    set empty [string range "....................." 0 [expr $n-1]]
  51.    for {set i 1} {$i<=$n} {incr i}\
  52.    { append grid (1,$i)-($n,$i)($i,1)-($i,$n)
  53.      set stones($i) $empty
  54.      w_draw board text  ($n.5,$i) [expr $n+1-$i] -oml -fn@10p
  55.      w_draw board text  ($i,.3) \
  56.       [string index "?abcdefghjklmnopqrstuvwxyz" $i] -oc -fn@10p
  57.    }   
  58.    set grid [w_draw board path $grid -t0.02i]
  59.    w_draw board open
  60.    set e ""
  61.    if {$even==1} {set e -even}
  62.    w_task prog create -receive "out {%o}"\
  63.      -command "\"<Wally\$Dir>.Wally $n $e\""
  64.  }
  65.  
  66.  
  67. proc closeboard {}\
  68.  { global stones made
  69.    unset stones
  70.    w_task prog kill
  71.    set made 0
  72.  }
  73.  
  74. proc out {o}\
  75.  { global rest
  76.    if {$o==""} {w_error "null string";return}
  77.    set o [split $rest$o \n]
  78.    set n [expr [llength $o]-1]
  79.    set rest [lindex $o $n]
  80.    set o [lrange $o 0 [expr $n-1]]
  81.    foreach i $o {use $i}
  82.  }
  83.  
  84. proc use {q}\
  85.  { global stones n
  86.    regsub -all " " $q "" p
  87.    if {[regexp {(^[0-9]+)([.O#]+)} $p a m s]}\
  88.    { if { $s!=$stones($m) }\
  89.      { set a $stones($m)
  90.        for {set x 0} {$x<$n} {incr x} \
  91.        { set b [string index $s $x]
  92.          if {$b!=[string index $a $x]} {change [expr $x+1] $m $b}
  93.        }
  94.        set stones($m) $s
  95.      }
  96.      return
  97.    }
  98.    w_text show print $q
  99.  }
  100.  
  101. proc showboard {}\
  102.  { global made
  103.    if {$made==1} {w_draw board open}\
  104.    else play
  105.  }
  106.  
  107. proc change { x y c }\
  108.  { global n objects
  109.    set y [expr $n+1-$y]
  110.    if {$c=="."} {w_draw board delete $objects($x:$y);return}
  111.    set r 0.45
  112.    set k [expr .552285*$r]
  113.    if {$c=="O"} {set h 255:255:255 ; set e 0:0:0} \
  114.    else {set e 255:255:255 ; set h 0:0:0}
  115.    set objects($x:$y) [ w_draw board above grid path \
  116.  "([expr $x+$r],$y)<([expr $x+$r],[expr $y+$k])([expr $x+$k],[expr $y+$r])>($x,[expr $y+$r])<([expr $x-$k],[expr $y+$r])([expr $x-$r],[expr $y+$k])>([expr $x-$r],$y)<([expr $x-$r],[expr $y-$k])([expr $x-$k],[expr $y-$r])>($x,[expr $y-$r])<([expr $x+$k],[expr $y-$r])([expr $x+$r],[expr $y-$k])>([expr $x+$r],$y)."\
  117.  -i$h -c$e -t.5m ]
  118.  }
  119.  
  120. proc clickproc {x y}\
  121.  { global n
  122.    set x [expr int($x+0.5)]
  123.    if {$x<1} {set x 1}
  124.    if {$x>$n} {set x $n}
  125.    set y [expr $n+1-int($y+0.5)]
  126.    if {$y<1} {set y 1}
  127.    if {$y>$n} {set y $n}
  128.    w_task prog send [string index "?abcdefghjklmnopqrstuvwxyz" $x]$y\n
  129.  }
  130.  
  131. w_bar -menu { Wally {Info -dbox progInfo}
  132.                     {SetUp -dbox setup}
  133.                     {Quit -click exit}
  134.             }\
  135.       -click showboard
  136.  
  137.  
  138.  
  139.  
  140.