home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #27 / NN_1992_27.iso / spool / comp / lang / tcl / 1836 next >
Encoding:
Internet Message Format  |  1992-11-15  |  9.8 KB
  1. Path: sparky!uunet!know!cass.ma02.bull.com!think.com!rpi!zaphod.mps.ohio-state.edu!malgudi.oar.net!news.ans.net!newsgate.watson.ibm.com!yktnews!admin!ghostwind!shmdgljd
  2. From: shmdgljd@rchland.vnet.ibm.com (Jay Schmidgall)
  3. Newsgroups: comp.lang.tcl
  4. Subject: Re: Announcing tkreversi!!!
  5. Keywords: game reversi
  6. Message-ID: <1992Nov15.205146.25235@rchland.ibm.com>
  7. Date: 15 Nov 92 20:51:46 GMT
  8. References: <1e1jvlINNd8a@agate.berkeley.edu>
  9. Sender: news@rchland.ibm.com
  10. Reply-To: jay@vnet.ibm.com
  11. Organization: IBM Rochester, MN
  12. Lines: 300
  13. Disclaimer: This posting represents the poster's views, not necessarily those of IBM
  14. Nntp-Posting-Host: ghostwind.rchland.ibm.com
  15.  
  16. As it happens, I was mucking with a tk reversi as well as an exercise in
  17. learning how canvas did things.  It handles resizing and provides a nice
  18. flash for illegal moves and hints, plus no reliance on bitmaps.
  19.  
  20. Anyways, it was relatively straightforward to plug my canvas code into
  21. Joel's reversi code, so here's a patch that'll let you check it out.
  22.  
  23. *** reversi.tcl.old    Sun Nov 15 12:45:10 1992
  24. --- reversi.tcl    Sun Nov 15 14:49:24 1992
  25. ***************
  26. *** 1,10 ****
  27.   proc makeBoard {f width height} {
  28.     global $f.white.IsRobot $f.black.IsRobot
  29.     frame $f.menu
  30.     frame $f.msg
  31.     frame $f.board
  32.     frame $f.stat -bd 10
  33. !   pack append $f $f.menu {top frame w} $f.msg top $f.stat top $f.board top
  34.   
  35.     menubutton $f.menu.mb -text "Options" -menu $f.menu.m -relief raised
  36.     pack append $f.menu $f.menu.mb left
  37. --- 1,12 ----
  38.   proc makeBoard {f width height} {
  39.     global $f.white.IsRobot $f.black.IsRobot
  40. +   wm maxsize $f 1280 1024
  41.     frame $f.menu
  42.     frame $f.msg
  43.     frame $f.board
  44.     frame $f.stat -bd 10
  45. !   pack append $f $f.menu {top frame w} $f.msg top $f.stat top \
  46. !       $f.board { top expand fill }
  47.   
  48.     menubutton $f.menu.mb -text "Options" -menu $f.menu.m -relief raised
  49.     pack append $f.menu $f.menu.mb left
  50. ***************
  51. *** 18,28 ****
  52.     $f.menu.m add command -label "Quit..." -command "quit Reversi"
  53.   
  54.     label $f.msg.l1
  55. !   label $f.msg.l2
  56.     label $f.stat.l1
  57.     label $f.stat.l2
  58.     label $f.stat.l3
  59. !   pack append $f.msg $f.msg.l1 left $f.msg.l2 left
  60.     pack append $f.stat $f.stat.l1 top $f.stat.l2 top $f.stat.l3 top
  61.     makeButtons $f $width $height
  62.     set $f.white.IsRobot 0
  63. --- 20,30 ----
  64.     $f.menu.m add command -label "Quit..." -command "quit Reversi"
  65.   
  66.     label $f.msg.l1
  67. !   canvas $f.msg.c -width 43 -height 43
  68.     label $f.stat.l1
  69.     label $f.stat.l2
  70.     label $f.stat.l3
  71. !   pack append $f.msg $f.msg.l1 left $f.msg.c left
  72.     pack append $f.stat $f.stat.l1 top $f.stat.l2 top $f.stat.l3 top
  73.     makeButtons $f $width $height
  74.     set $f.white.IsRobot 0
  75. ***************
  76. *** 31,47 ****
  77.   }
  78.   
  79.   proc makeButtons {f width height} {
  80. !   global $f.width $f.height $f.maxMoves $f.moveCount
  81.     set $f.maxMoves [expr {$width * $height}]
  82.     set $f.moveCount 0
  83.     set $f.width $width
  84.     set $f.height $height
  85.     for {set i 0} {$i < $height} {incr i} {
  86. -     frame $f.board.$i
  87. -     pack append $f.board $f.board.$i top
  88.       for {set j 0} {$j < $width} {incr j} {
  89. !       button $f.board.$i.$j -command "after 10 move $f $i $j"
  90. !       pack append $f.board.$i $f.board.$i.$j left
  91.         global $f.$i.$j.white.nbr
  92.         set $f.$i.$j.white.nbr 0
  93.         global $f.$i.$j.black.nbr
  94. --- 33,63 ----
  95.   }
  96.   
  97.   proc makeButtons {f width height} {
  98. !   global $f.width $f.height $f.maxMoves $f.moveCount board
  99. ! 
  100.     set $f.maxMoves [expr {$width * $height}]
  101.     set $f.moveCount 0
  102.     set $f.width $width
  103.     set $f.height $height
  104. +   set board(height) [expr 328+($height-8)*40]
  105. +   set board(width)  [expr 328+($width-8)*40]
  106. +   canvas $f.board.c -background {black} \
  107. +     -confine {true} \
  108. +     -width $board(width) \
  109. +     -height $board(height)
  110. +   bind $f.board.c <Configure> {
  111. +     set scalex [expr { "%w.0" / "$board(width).0" }]
  112. +     set scaley [expr { "%h.0" / "$board(height).0" }]
  113. +     %W scale all 0 0 $scalex $scaley
  114. +     set board(width) %w
  115. +     set board(height) %h
  116. +   }
  117. +   pack append $f.board $f.board.c { top expand fillx filly }
  118.     for {set i 0} {$i < $height} {incr i} {
  119.       for {set j 0} {$j < $width} {incr j} {
  120. !       $f.board.c create rect [expr $j*40+4] [expr $i*40+4] \
  121. !     [expr $j*40+43] [expr $i*40+43] -tags "$i,$j" -fill limegreen
  122. !       $f.board.c bind $i,$j <1> " move $f $i $j "
  123.         global $f.$i.$j.white.nbr
  124.         set $f.$i.$j.white.nbr 0
  125.         global $f.$i.$j.black.nbr
  126. ***************
  127. *** 101,118 ****
  128.     setBoard $f
  129.   }
  130.   
  131. ! proc flashSquare {f row col} {
  132. !   #set orig [get $f $row $col]
  133. !   #makeBlack $f $row $col; update
  134. !   #makeWhite $f $row $col; update
  135. !   #makeBlack $f $row $col; update
  136. !   #makeWhite $f $row $col; update
  137. !   #makeColor $f $row $col $orig; update
  138. !   #$f.board.$row.$col config -rel sunken
  139. !   #after 1000 $f.board.$row.$col config -rel raised
  140. !   $f.board.$row.$col flash
  141. !   $f.board.$row.$col activate
  142. !   after 4000 $f.board.$row.$col deactivate
  143.   }
  144.   
  145.   proc setBoard {f} {
  146. --- 117,133 ----
  147.     setBoard $f
  148.   }
  149.   
  150. ! proc flashSquare { {f} {row} {col} {color red}} {
  151. !   set bound [$f.board.c bbox $row,$col]
  152. !   set x1 [expr [lindex $bound 0]+2]
  153. !   set y1 [expr [lindex $bound 1]+2]
  154. !   set x2 [expr [lindex $bound 2]-2]
  155. !   set y2 [expr [lindex $bound 3]-2]
  156. !     
  157. !   set warn1 [$f.board.c create rect $x1 $y1 $x2 $y2 \
  158. !      -fill $color -width 3 -tag warning]
  159. !   update
  160. !   after 100 $f.board.c delete $warn1
  161.   }
  162.   
  163.   proc setBoard {f} {
  164. ***************
  165. *** 124,129 ****
  166. --- 139,145 ----
  167.     set centerY [expr {$width / 2}]
  168.     set $f.white.count 0
  169.     set $f.black.count 0
  170. +   $f.board.c delete piece
  171.     makeBlack $f [expr {$centerX - 1}] $centerY
  172.     makeBlack $f $centerX [expr {$centerY - 1}]
  173.     makeWhite $f [expr {$centerX - 1}] [expr {$centerY - 1}]
  174. ***************
  175. *** 162,167 ****
  176. --- 178,196 ----
  177.     globIncr $f.[expr {$row - 1}].[expr {$col + 1}].$color.nbr $inc
  178.   }
  179.   
  180. + proc drawPiece { {f} {color} {row} {col} } {
  181. +   set bound [$f.board.c coords $row,$col]
  182. +   set x1 [expr [lindex $bound 0]+3]
  183. +   set y1 [expr [lindex $bound 1]+3]
  184. +   set x2 [expr [lindex $bound 2]-3]
  185. +   set y2 [expr [lindex $bound 3]-3]
  186. +   $f.board.c delete "o,$row,$col"
  187. +   $f.board.c create oval $x1 $y1 $x2 $y2 -tags "piece o,$row,$col" \
  188. +     -fill $color
  189. +   $f.board.c bind <1> "o,$row,$col" "flashSquare $f $row $col"  
  190. +   update  
  191. + }
  192. + 
  193.   proc makeWhite {f row col} {
  194.     global sourceDir
  195.     global $f.white.count $f.black.count
  196. ***************
  197. *** 169,175 ****
  198.     if {[get $f $row $col] == "black"} {doIncr $f $row $col black -1; doIncr $f $row $col white}
  199.     if {[get $f $row $col] == "empty"} {doIncr $f $row $col white}
  200.     set $f.board.$row.$col.color white
  201. !   $f.board.$row.$col config -bitmap "@$sourceDir/bitmaps/white.bm"
  202.   }
  203.   
  204.   proc makeBlack {f row col} {
  205. --- 198,204 ----
  206.     if {[get $f $row $col] == "black"} {doIncr $f $row $col black -1; doIncr $f $row $col white}
  207.     if {[get $f $row $col] == "empty"} {doIncr $f $row $col white}
  208.     set $f.board.$row.$col.color white
  209. !   drawPiece $f white $row $col
  210.   }
  211.   
  212.   proc makeBlack {f row col} {
  213. ***************
  214. *** 179,185 ****
  215.     if {[get $f $row $col] == "white"} {doIncr $f $row $col white -1; doIncr $f $row $col black}
  216.     if {[get $f $row $col] == "empty"} {doIncr $f $row $col black}
  217.     set $f.board.$row.$col.color black
  218. !   $f.board.$row.$col config -bitmap "@$sourceDir/bitmaps/black.bm"
  219.   }
  220.   
  221.   proc makeEmpty {f row col} {
  222. --- 208,214 ----
  223.     if {[get $f $row $col] == "white"} {doIncr $f $row $col white -1; doIncr $f $row $col black}
  224.     if {[get $f $row $col] == "empty"} {doIncr $f $row $col black}
  225.     set $f.board.$row.$col.color black
  226. !   drawPiece $f black $row $col
  227.   }
  228.   
  229.   proc makeEmpty {f row col} {
  230. ***************
  231. *** 189,195 ****
  232.     if {[get $f $row $col] == "black"} {incr $f.black.count -1}
  233.     if {[get $f $row $col] == "white"} {incr $f.white.count -1}
  234.     set $f.board.$row.$col.color empty
  235. -   $f.board.$row.$col config -bitmap "@$sourceDir/bitmaps/empty.bm"
  236.   }
  237.   
  238.   proc makeColor {f row col color} {
  239. --- 218,223 ----
  240. ***************
  241. *** 388,394 ****
  242.       $f.stat.l1 config -text "No moves available!"
  243.       return
  244.     }
  245. !   flashSquare $f [lindex $move 0] [lindex $move 1]
  246.   }
  247.   
  248.   proc distToEdge {f row col} {
  249. --- 416,422 ----
  250.       $f.stat.l1 config -text "No moves available!"
  251.       return
  252.     }
  253. !   flashSquare $f [lindex $move 0] [lindex $move 1] yellow
  254.   }
  255.   
  256.   proc distToEdge {f row col} {
  257. ***************
  258. *** 475,481 ****
  259.       } else {
  260.         makeBlack $f $row $col
  261.       }
  262. !     flashSquare $f $row $col
  263.       flipList $f $flips
  264.       lappend $f.moveList [list $row $col] $flips $turn
  265.       #echo [set $f.moveList]
  266. --- 503,509 ----
  267.       } else {
  268.         makeBlack $f $row $col
  269.       }
  270. !     flashSquare $f $row $col yellow
  271.       flipList $f $flips
  272.       lappend $f.moveList [list $row $col] $flips $turn
  273.       #echo [set $f.moveList]
  274. ***************
  275. *** 483,490 ****
  276.       set turn [opposite $turn]
  277.       set $f.turn $turn
  278.       $f.stat.l1 config -text ""
  279. !   } else {
  280.       $f.stat.l1 config -text "Illegal move!"
  281.       return
  282.     }
  283.     setStatLines $f
  284. --- 511,519 ----
  285.       set turn [opposite $turn]
  286.       set $f.turn $turn
  287.       $f.stat.l1 config -text ""
  288. !   } else {  
  289.       $f.stat.l1 config -text "Illegal move!"
  290. +     flashSquare $f $row $col
  291.       return
  292.     }
  293.     setStatLines $f
  294. ***************
  295. *** 528,534 ****
  296.     set turn [set $f.turn]
  297.     $f.stat.l2 config -text "White: [set $f.white.count]"
  298.     $f.stat.l3 config -text "Black: [set $f.black.count]"
  299. !   $f.msg.l2 config -bitmap "@$sourceDir/bitmaps/$turn.bm"
  300.     $f.msg.l1 config -text "$turn's turn"
  301.     update
  302.   }
  303. --- 557,564 ----
  304.     set turn [set $f.turn]
  305.     $f.stat.l2 config -text "White: [set $f.white.count]"
  306.     $f.stat.l3 config -text "Black: [set $f.black.count]"
  307. !   $f.msg.c dtag all
  308. !   $f.msg.c create oval 3 3 40 40 -fill $turn -tag ind
  309.     $f.msg.l1 config -text "$turn's turn"
  310.     update
  311.   }
  312.  
  313. -- 
  314. : jay          jay@vnet.ibm.com    My opinions and ideas, not my employer's.
  315. : shmdgljd@rchland.vnet.ibm.com    (c) Copyright 1992.  All rights reserved.
  316.