home *** CD-ROM | disk | FTP | other *** search
/ ARM Club 3 / TheARMClub_PDCD3.iso / hensa / programming / tcl / tcl_1 / !oxo_oxo < prev    next >
Encoding:
Text File  |  1994-09-07  |  3.1 KB  |  148 lines
  1. # test file for tcl
  2.  
  3. source {<tcl$Dir>.!Choices}
  4.  
  5. proc beep {} {puts -nonewline \a}
  6.  
  7. w_init oxo
  8.  
  9. source {<tcl$Dir>.library.debug}
  10.  
  11. w_box progInfo create "About this program"\
  12.  { vlist {info Name OXO}
  13.          {info Purpose "Game"}
  14.          {info "Author" C.T.Stretch}
  15.          {info Version 0.00}
  16.  }
  17.  
  18. w_bar -menu { OXO {Info -dbox progInfo}
  19.                   {Quit -click exit}
  20.             }\
  21.       -click {w_draw mainwin open}
  22.  
  23. proc restart {}\
  24.  { global board game winner player game free finished mainwin wait
  25.    set game(X) ""
  26.    set game(O) ""
  27.    set free 012345678
  28.    set player $winner
  29.    set finished 0
  30.    swap
  31.    set stuff [array names board]
  32.    set ii ""
  33.    foreach i $stuff\
  34.    { lappend ii $board($i)
  35.      unset board($i)
  36.    }
  37.    eval w_draw  mainwin delete $ii
  38.    if {!$wait&&($player=="X")} findmove
  39.  }
  40.  
  41. proc swap {}\
  42.  { global player opponent
  43.    set opponent $player
  44.    if {$player == "X"} {set player O} else {set player X}
  45.  }
  46.  
  47. proc square { x y}\
  48.  {
  49.    set x [expr int($x)-1]
  50.    if {$x<0} {set x 0}
  51.    if {$x>2} {set x 2}
  52.    set y [expr int($y)-1]
  53.    if {$y<0} {set y 0}
  54.    if {$y>2} {set y 2}
  55.    set z [expr $x+3*$y]
  56.  }
  57.  
  58. proc point {z}\
  59.  { set x [expr $z%3+1.5]
  60.    set y [expr $z/3+1.5]
  61.    set p ($x,$y)
  62.  }
  63.  
  64. proc makemove {z}\
  65.  { global player opponent free board mainwin game lines winner finished
  66.    set game($player) $game($player)$z 
  67.    regsub -all \[a$game(X)$game(O)\] 012345678 "" free
  68.    set board($z) [w_draw mainwin text [point $z] $player -fn@50p -ocm ]
  69.    foreach line $lines\
  70.    { if {![regexp \[$line\] $game($opponent)$free]}\
  71.      { set winner $player
  72.        set finished 1
  73.        set board($line)\
  74.          [w_draw mainwin above -1 path\
  75.            [point [string index $line 0]]-[point [string index $line 2]]\
  76.            -t.05i -c255:0:0\
  77.          ]
  78.      }
  79.    }
  80.    if {[string length $free]==0}\
  81.    { set finished 1
  82.      set winner $player
  83.    }
  84.    swap
  85.  }
  86.  
  87. proc findmove {}\
  88.  { global free rand lines scores game
  89.    set opt -1
  90.    set f [split $free ""]
  91.    foreach s $f \
  92.    { set score 0
  93.      foreach l $lines \
  94.      { if {[string match *$s* $l]} \
  95.        { regsub -all \[^$game(X).\] $l "" mine
  96.          regsub -all \[^$game(O).\] $l "" yours
  97.          incr score $scores([string length $mine][string length $yours])
  98.        }
  99.      }
  100.      if {$score>$opt} {set opt $score;set n $s}
  101.    }
  102.    makemove $n
  103.  }
  104.  
  105. proc getmove {z}\
  106.  { global free
  107.    if {[string match *$z* $free]} {makemove $z}\
  108.    else beep
  109.  }
  110.  
  111. proc clickproc { x y }\
  112.  { global player game finished wait
  113.    if { $finished } { beep; return}
  114.    set z [square $x $y]
  115.    if {$player=="X"} findmove\
  116.    else {getmove $z;if {!$wait&&!$finished} findmove} 
  117.  }
  118.  
  119. set winner X
  120. set wait 1
  121. set board(1) x
  122. unset board(1)
  123. set lines {012 345 678 036 147 258 048 246}
  124. set scores(00) 40
  125. set scores(01) 70
  126. set scores(10) 100
  127. set scores(02) 10000
  128. set scores(11)  0
  129. set scores(20) 100000
  130.  
  131. w_draw mainwin create  -page 5ix5i  -click {clickproc %x %y}\
  132.    -close {list 2}\
  133.    -menu  {OXO  {Info }
  134.                 {Wait -tick wait}
  135.                 {Clear -click restart}
  136.                 {Quit -click exit}
  137.           }
  138.  
  139. w_draw mainwin \
  140.           path (2,1)-(2,4)(3,1)-(3,4)(1,2)-(4,2)(1,3)-(4,3) -t.1i -r
  141.  
  142. w_draw mainwin open
  143.  
  144. restart
  145.  
  146.  
  147.  
  148.