TicTacToe for two players
----
 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

----
[Category Games]