From: shmdgljd@rchland.vnet.ibm.com (Jay Schmidgall)
Newsgroups: comp.lang.tcl
Subject: Re: Announcing tkreversi!!!
Keywords: game reversi
Date: 15 Nov 92 20:51:46 GMT
Reply-To: jay@vnet.ibm.com
Organization: IBM Rochester, MN
Disclaimer: This posting represents the poster's views, not necessarily those of IBM

As it happens, I was mucking with a tk reversi as well as an exercise in
learning how canvas did things.  It handles resizing and provides a nice
flash for illegal moves and hints, plus no reliance on bitmaps.

Anyways, it was relatively straightforward to plug my canvas code into
Joel's reversi code, so here's a patch that'll let you check it out.

*** reversi.tcl.old	Sun Nov 15 12:45:10 1992
--- reversi.tcl	Sun Nov 15 14:49:24 1992
***************
*** 1,10 ****
  proc makeBoard {f width height} {
    global $f.white.IsRobot $f.black.IsRobot
    frame $f.menu
    frame $f.msg
    frame $f.board
    frame $f.stat -bd 10
!   pack append $f $f.menu {top frame w} $f.msg top $f.stat top $f.board top
  
    menubutton $f.menu.mb -text "Options" -menu $f.menu.m -relief raised
    pack append $f.menu $f.menu.mb left
--- 1,12 ----
  proc makeBoard {f width height} {
    global $f.white.IsRobot $f.black.IsRobot
+   wm maxsize $f 1280 1024
    frame $f.menu
    frame $f.msg
    frame $f.board
    frame $f.stat -bd 10
!   pack append $f $f.menu {top frame w} $f.msg top $f.stat top \
!       $f.board { top expand fill }
  
    menubutton $f.menu.mb -text "Options" -menu $f.menu.m -relief raised
    pack append $f.menu $f.menu.mb left
***************
*** 18,28 ****
    $f.menu.m add command -label "Quit..." -command "quit Reversi"
  
    label $f.msg.l1
!   label $f.msg.l2
    label $f.stat.l1
    label $f.stat.l2
    label $f.stat.l3
!   pack append $f.msg $f.msg.l1 left $f.msg.l2 left
    pack append $f.stat $f.stat.l1 top $f.stat.l2 top $f.stat.l3 top
    makeButtons $f $width $height
    set $f.white.IsRobot 0
--- 20,30 ----
    $f.menu.m add command -label "Quit..." -command "quit Reversi"
  
    label $f.msg.l1
!   canvas $f.msg.c -width 43 -height 43
    label $f.stat.l1
    label $f.stat.l2
    label $f.stat.l3
!   pack append $f.msg $f.msg.l1 left $f.msg.c left
    pack append $f.stat $f.stat.l1 top $f.stat.l2 top $f.stat.l3 top
    makeButtons $f $width $height
    set $f.white.IsRobot 0
***************
*** 31,47 ****
  }
  
  proc makeButtons {f width height} {
!   global $f.width $f.height $f.maxMoves $f.moveCount
    set $f.maxMoves [expr {$width * $height}]
    set $f.moveCount 0
    set $f.width $width
    set $f.height $height
    for {set i 0} {$i < $height} {incr i} {
-     frame $f.board.$i
-     pack append $f.board $f.board.$i top
      for {set j 0} {$j < $width} {incr j} {
!       button $f.board.$i.$j -command "after 10 move $f $i $j"
!       pack append $f.board.$i $f.board.$i.$j left
        global $f.$i.$j.white.nbr
        set $f.$i.$j.white.nbr 0
        global $f.$i.$j.black.nbr
--- 33,63 ----
  }
  
  proc makeButtons {f width height} {
!   global $f.width $f.height $f.maxMoves $f.moveCount board
! 
    set $f.maxMoves [expr {$width * $height}]
    set $f.moveCount 0
    set $f.width $width
    set $f.height $height
+   set board(height) [expr 328+($height-8)*40]
+   set board(width)  [expr 328+($width-8)*40]
+   canvas $f.board.c -background {black} \
+ 	-confine {true} \
+ 	-width $board(width) \
+ 	-height $board(height)
+   bind $f.board.c <Configure> {
+ 	set scalex [expr { "%w.0" / "$board(width).0" }]
+ 	set scaley [expr { "%h.0" / "$board(height).0" }]
+ 	%W scale all 0 0 $scalex $scaley
+ 	set board(width) %w
+ 	set board(height) %h
+   }
+   pack append $f.board $f.board.c { top expand fillx filly }
    for {set i 0} {$i < $height} {incr i} {
      for {set j 0} {$j < $width} {incr j} {
!       $f.board.c create rect [expr $j*40+4] [expr $i*40+4] \
! 	[expr $j*40+43] [expr $i*40+43] -tags "$i,$j" -fill limegreen
!       $f.board.c bind $i,$j <1> " move $f $i $j "
        global $f.$i.$j.white.nbr
        set $f.$i.$j.white.nbr 0
        global $f.$i.$j.black.nbr
***************
*** 101,118 ****
    setBoard $f
  }
  
! proc flashSquare {f row col} {
!   #set orig [get $f $row $col]
!   #makeBlack $f $row $col; update
!   #makeWhite $f $row $col; update
!   #makeBlack $f $row $col; update
!   #makeWhite $f $row $col; update
!   #makeColor $f $row $col $orig; update
!   #$f.board.$row.$col config -rel sunken
!   #after 1000 $f.board.$row.$col config -rel raised
!   $f.board.$row.$col flash
!   $f.board.$row.$col activate
!   after 4000 $f.board.$row.$col deactivate
  }
  
  proc setBoard {f} {
--- 117,133 ----
    setBoard $f
  }
  
! proc flashSquare { {f} {row} {col} {color red}} {
!   set bound [$f.board.c bbox $row,$col]
!   set x1 [expr [lindex $bound 0]+2]
!   set y1 [expr [lindex $bound 1]+2]
!   set x2 [expr [lindex $bound 2]-2]
!   set y2 [expr [lindex $bound 3]-2]
! 	
!   set warn1 [$f.board.c create rect $x1 $y1 $x2 $y2 \
!      -fill $color -width 3 -tag warning]
!   update
!   after 100 $f.board.c delete $warn1
  }
  
  proc setBoard {f} {
***************
*** 124,129 ****
--- 139,145 ----
    set centerY [expr {$width / 2}]
    set $f.white.count 0
    set $f.black.count 0
+   $f.board.c delete piece
    makeBlack $f [expr {$centerX - 1}] $centerY
    makeBlack $f $centerX [expr {$centerY - 1}]
    makeWhite $f [expr {$centerX - 1}] [expr {$centerY - 1}]
***************
*** 162,167 ****
--- 178,196 ----
    globIncr $f.[expr {$row - 1}].[expr {$col + 1}].$color.nbr $inc
  }
  
+ proc drawPiece { {f} {color} {row} {col} } {
+   set bound [$f.board.c coords $row,$col]
+   set x1 [expr [lindex $bound 0]+3]
+   set y1 [expr [lindex $bound 1]+3]
+   set x2 [expr [lindex $bound 2]-3]
+   set y2 [expr [lindex $bound 3]-3]
+   $f.board.c delete "o,$row,$col"
+   $f.board.c create oval $x1 $y1 $x2 $y2 -tags "piece o,$row,$col" \
+     -fill $color
+   $f.board.c bind <1> "o,$row,$col" "flashSquare $f $row $col"  
+   update  
+ }
+ 
  proc makeWhite {f row col} {
    global sourceDir
    global $f.white.count $f.black.count
***************
*** 169,175 ****
    if {[get $f $row $col] == "black"} {doIncr $f $row $col black -1; doIncr $f $row $col white}
    if {[get $f $row $col] == "empty"} {doIncr $f $row $col white}
    set $f.board.$row.$col.color white
!   $f.board.$row.$col config -bitmap "@$sourceDir/bitmaps/white.bm"
  }
  
  proc makeBlack {f row col} {
--- 198,204 ----
    if {[get $f $row $col] == "black"} {doIncr $f $row $col black -1; doIncr $f $row $col white}
    if {[get $f $row $col] == "empty"} {doIncr $f $row $col white}
    set $f.board.$row.$col.color white
!   drawPiece $f white $row $col
  }
  
  proc makeBlack {f row col} {
***************
*** 179,185 ****
    if {[get $f $row $col] == "white"} {doIncr $f $row $col white -1; doIncr $f $row $col black}
    if {[get $f $row $col] == "empty"} {doIncr $f $row $col black}
    set $f.board.$row.$col.color black
!   $f.board.$row.$col config -bitmap "@$sourceDir/bitmaps/black.bm"
  }
  
  proc makeEmpty {f row col} {
--- 208,214 ----
    if {[get $f $row $col] == "white"} {doIncr $f $row $col white -1; doIncr $f $row $col black}
    if {[get $f $row $col] == "empty"} {doIncr $f $row $col black}
    set $f.board.$row.$col.color black
!   drawPiece $f black $row $col
  }
  
  proc makeEmpty {f row col} {
***************
*** 189,195 ****
    if {[get $f $row $col] == "black"} {incr $f.black.count -1}
    if {[get $f $row $col] == "white"} {incr $f.white.count -1}
    set $f.board.$row.$col.color empty
-   $f.board.$row.$col config -bitmap "@$sourceDir/bitmaps/empty.bm"
  }
  
  proc makeColor {f row col color} {
--- 218,223 ----
***************
*** 388,394 ****
      $f.stat.l1 config -text "No moves available!"
      return
    }
!   flashSquare $f [lindex $move 0] [lindex $move 1]
  }
  
  proc distToEdge {f row col} {
--- 416,422 ----
      $f.stat.l1 config -text "No moves available!"
      return
    }
!   flashSquare $f [lindex $move 0] [lindex $move 1] yellow
  }
  
  proc distToEdge {f row col} {
***************
*** 475,481 ****
      } else {
        makeBlack $f $row $col
      }
!     flashSquare $f $row $col
      flipList $f $flips
      lappend $f.moveList [list $row $col] $flips $turn
      #echo [set $f.moveList]
--- 503,509 ----
      } else {
        makeBlack $f $row $col
      }
!     flashSquare $f $row $col yellow
      flipList $f $flips
      lappend $f.moveList [list $row $col] $flips $turn
      #echo [set $f.moveList]
***************
*** 483,490 ****
      set turn [opposite $turn]
      set $f.turn $turn
      $f.stat.l1 config -text ""
!   } else {
      $f.stat.l1 config -text "Illegal move!"
      return
    }
    setStatLines $f
--- 511,519 ----
      set turn [opposite $turn]
      set $f.turn $turn
      $f.stat.l1 config -text ""
!   } else {  
      $f.stat.l1 config -text "Illegal move!"
+     flashSquare $f $row $col
      return
    }
    setStatLines $f
***************
*** 528,534 ****
    set turn [set $f.turn]
    $f.stat.l2 config -text "White: [set $f.white.count]"
    $f.stat.l3 config -text "Black: [set $f.black.count]"
!   $f.msg.l2 config -bitmap "@$sourceDir/bitmaps/$turn.bm"
    $f.msg.l1 config -text "$turn's turn"
    update
  }
--- 557,564 ----
    set turn [set $f.turn]
    $f.stat.l2 config -text "White: [set $f.white.count]"
    $f.stat.l3 config -text "Black: [set $f.black.count]"
!   $f.msg.c dtag all
!   $f.msg.c create oval 3 3 40 40 -fill $turn -tag ind
    $f.msg.l1 config -text "$turn's turn"
    update
  }

-- 
: jay          jay@vnet.ibm.com    My opinions and ideas, not my employer's.
: shmdgljd@rchland.vnet.ibm.com    (c) Copyright 1992.  All rights reserved.