Keith Vetter 2004-09-10 : Here's another version of the children's game Tic-Tac-Toe. My 5-year old daughter has just discovered this game and so I threw this together this morning. There's another tic-tac-toe page--A little Tic Tac Toe game--but I wanted a sexier interface.
##+##########################################################################
#
# tictactoe.tcl - plays tic tac toe
# by Keith Vetter Sept 10, 2004
#
package require Tk
array set S {title "Tic Tac Toe" who,1 "X" who,0 "" who,-1 "O"}
array set C {bars red X blue O green win yellow}
proc DoDisplay {} {
wm title . $::S(title)
frame .ctrl -relief ridge -bd 2 -padx 5 -pady 5
canvas .c -relief raised -bd 2 -height 500 -width 500 -highlightthickness 0
pack .ctrl -side bottom -fill both
pack .c -side top -fill both -expand 1
bind all <Key-F2> {console show}
bind .c <Configure> {ReCenter %W %h %w}
DoCtrlFrame
}
proc DrawBoard {{redraw 0}} {
global S B GAME C
if {$redraw} { ;# Must redraw everything
.c delete all
set w2 [expr {$B(w2) - 15}] ;# Make a little margins
set h2 [expr {$B(h2) - 15}]
set hbar [expr {$h2 / 3.0}]
set vbar [expr {$w2 / 3.0}]
set B(0) [list -$w2 -$h2 -$vbar -$hbar] ;# All 9 cells
set B(1) [list -$vbar -$h2 $vbar -$hbar]
set B(2) [list $vbar -$h2 $w2 -$hbar]
set B(3) [list -$w2 -$hbar -$vbar $hbar]
set B(4) [list -$vbar -$hbar $vbar $hbar]
set B(5) [list $vbar -$hbar $w2 $hbar]
set B(6) [list -$w2 $hbar -$vbar $h2]
set B(7) [list -$vbar $hbar $vbar $h2]
set B(8) [list $vbar $hbar $w2 $h2]
for {set i 0} {$i < 9} {incr i} { ;# Rectangle for each cell
.c create rect $B($i) -tag b$i -fill {} -outline {}
.c bind b$i <Button-1> [list DoClick $i]
set B($i) [ShrinkBox $B($i) 25]
}
.c create line -$w2 $hbar $w2 $hbar -tag bar ;# Draw the cross bars
.c create line -$w2 -$hbar $w2 -$hbar -tag bar
.c create line $vbar -$h2 $vbar $h2 -tag bar
.c create line -$vbar -$h2 -$vbar $h2 -tag bar
.c itemconfig bar -width 20 -fill $::C(bars) -capstyle round
}
.new config -state [expr {$GAME(tcnt) == 0 ? "disabled" : "normal"}]
for {set i 0} {$i < 9} {incr i} {
.c itemconfig b$i -fill {} ;# Erase any win lines
DrawXO $GAME(board,$i) $i
}
foreach i $GAME(win) { ;# Do we have a winner???
.c itemconfig b$i -fill $C(win)
}
}
proc DoCtrlFrame {} {
button .new -text "New Game" -command NewGame -bd 4
.new configure -font "[font actual [.new cget -font]] -weight bold"
option add *Button.font [.new cget -font]
label .status -textvariable S(msg) -font {Times 36 bold} -bg white \
-bd 5 -relief ridge
button .about -text About -command \
[list tk_messageBox -message "$::S(title)\nby Keith Vetter, Sept 2004"]
pack .status -in .ctrl -side right -fill both -expand 1
pack .new .about -in .ctrl -side top -fill x -pady 2 -padx {0 5}
}
proc ShrinkBox {xy d} {
foreach {x y x1 y1} $xy break
return [list [expr {$x+$d}] [expr {$y+$d}] [expr {$x1-$d}] [expr {$y1-$d}]]
}
##+##########################################################################
#
# Recenter -- keeps 0,0 at the center of the canvas during resizing
#
proc ReCenter {W h w} { ;# Called by configure event
set ::B(h2) [expr {$h / 2}]
set ::B(w2) [expr {$w / 2}]
$W config -scrollregion [list -$::B(w2) -$::B(h2) $::B(w2) $::B(h2)]
DrawBoard 1
}
##+##########################################################################
#
# DrawXO -- draws appropriate mark in a given cell
#
proc DrawXO {who where} {
global S B C
if {$S(who,$who) eq "X"} {
foreach {x0 y0 x1 y1} $B($where) break
.c create line $x0 $y0 $x1 $y1 -width 20 -fill $C(X) -capstyle round \
-tag xo$where
.c create line $x0 $y1 $x1 $y0 -width 20 -fill $C(X) -capstyle round \
-tag xo$where
} elseif {$S(who,$who) eq "O"} {
.c create oval $B($where) -width 20 -outline $C(O) -tag xo$where
} else {
.c delete xo$where
}
}
##+##########################################################################
#
# InitGame -- resets all variables to start a new game
#
proc InitGame {} {
global GAME S
set GAME(state) play
set GAME(turn) 1
set GAME(tcnt) 0
set GAME(win) {}
for {set i 0} {$i < 9} {incr i} {
set GAME(board,$i) 0
}
set S(msg) "X goes first"
}
##+##########################################################################
#
# NewGame -- starts a new game
#
proc NewGame {} {
InitGame
DrawBoard
}
##+##########################################################################
#
# DoClick -- handles button click in a cell
#
proc DoClick {where} {
global GAME S
if {$GAME(state) ne "play"} return ;# Game over
if {$GAME(board,$where) != 0} return ;# Not empty
set GAME(board,$where) $GAME(turn)
set GAME(turn) [expr {- $GAME(turn)}]
incr GAME(tcnt)
set S(msg) "$S(who,$GAME(turn))'s turn"
set n [WhoWon] ;# Do we have a winner???
if {$n != 0} {
set GAME(state) finished
set GAME(win) [lrange $n 1 end]
set S(msg) "$S(who,[lindex $n 0]) Wins!"
} elseif {$GAME(tcnt) == 9} { ;# Is the game a draw???
set GAME(state) finished
set S(msg) "Draw"
}
DrawBoard
}
##+##########################################################################
#
# WhoWon -- determines if anyone has won the game
#
proc WhoWon {} {
foreach {a b c} {0 1 2 3 4 5 6 7 8 0 3 6 1 4 7 2 5 8 0 4 8 2 4 6} {
set who $::GAME(board,$a)
if {$who == 0} continue
if {$who != $::GAME(board,$b) || $who != $::GAME(board,$c)} continue
return [list $who $a $b $c]
}
return 0
}
InitGame
DoDisplay
NewGame