frame .board -class TicTacToeBoard
pack .board -fill both -expand 1 -padx 1m -pady 1m
foreach square { 1 2 3 4 5 6 7 8 9 } {
button .board.sq$square -command [list tttButton $square]
}
grid .board.sq1 .board.sq2 .board.sq3 -sticky nsew -padx 1 -pady 1
grid .board.sq4 .board.sq5 .board.sq6 -sticky nsew -padx 1 -pady 1
grid .board.sq7 .board.sq8 .board.sq9 -sticky nsew -padx 1 -pady 1
button .board.sq0 -text x
set w [expr {[winfo reqwidth .board.sq0] + 2}]
destroy .board.sq0
foreach n {0 1 2} {
grid column .board $n -weight 1 -minsize $w
grid row .board $n -weight 1
}
switch $tcl_platform(platform) {
unix {
array set cursor {
x {X_cursor red}
o {circle green}
illegal pirate
}
}
default {
array set cursor {
x X_cursor
o circle
illegal pirate
}
}
}
proc newGame { } {
global board turn
set turn x
.board configure -cursor $::cursor(x)
if {[info exists board] } {
unset board
}
foreach sq { 1 2 3 4 5 6 7 8 9 } {
set w .board.sq$sq
# Normally filled with spaces
$w configure -text $sq -cursor {} -fg black -state normal
bindtags $w [list $w Button . all]
}
}
proc tttButton { sq } {
global board turn
set w .board.sq$sq
if { [info exists board($sq) ] } {
# Error
return
}
set board($sq) $turn
array set cols {x red o green}
$w configure -text $turn -cursor $::cursor(illegal) \
-fg $cols($turn) -state normal
bindtags $w [list $w . all]
if { $turn == "x" } {
set turn o
} else {
set turn x
}
.board configure -cursor $::cursor($turn)
update idletasks
if {[checkwin]} {newGame}
}
proc checkwin {} {
set x {}
set o {}
foreach sq {1 2 3 4 5 6 7 8 9} {
if {[info exists ::board($sq)]} {
append $::board($sq) $sq
}
}
# winning patterns (glob-style matches)
set winpats {
123* *456* *789 1*4*7* 1*5*9 *2*5*8* *3*6*9 *3*5*7*
}
foreach pattern $winpats {
if {[string match $pattern $x]} {
tk_messageBox -message "X has won"
return 1
} elseif {[string match $pattern $o]} {
tk_messageBox -message "O has won"
return 2
}
}
if {[string length $x$o] == 9} {
tk_messageBox -message "A draw"
return 3
}
return 0
}
button .new -text "New Game" -command newGame
button .exit -text "Exit" -command exit
pack .new .exit -fill x
newGame