package require Tk

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