package require Tcl 8.5
package require Tk

bind Tk <Destroy> exit
wm resizable . no no

apply {canvas {
  destroy $canvas
  pack canvas .c -width 320 -height 320 
  foreach i {0 1 2 3 4 5 6 7} {
      foreach j {0 1 2 3 4 5 6 7} {
        set o expr {($i+$j)%2 ? "odd" : "even"}
        set coords list [* $i 40 * $j 40\
                      * [+ $i 1 40] * [+ $j 1 40]
        $canvas create rectangle $coords\
          -tags list f $o r$j c$i
        $canvas create text\
          + [* $i 40 20] + [* $j 40 20]\
          -tags list q r$j c$i
        $canvas bind r$j&&c$i <1> "check $j $i"
      }
    }
  foreach c {-8 -7 -6 -5 -4 -3 -2 -1 0 1 2 3 4 5 6 7} {
      set col $c
      foreach row {0 1 2 3 4 5 6 7} {
        $canvas addtag d+ $c 7 withtag r$row&&c$col
        incr col
      }
    }
  foreach c {0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15} {
      set col $c
      foreach row {0 1 2 3 4 5 6 7} {
        $canvas addtag e$c withtag r$row&&c$col
        incr col -1
      }
    }
  $canvas itemconfigure odd\
    -fill grey\
    -outline ""
  $canvas itemconfigure even\
    -fill #ffffcc\
    -outline ""
  $canvas itemconfigure q\
    -fill navy\
    -font {Times 20 bold italic}
  bind $canvas <ButtonRelease>\
    "$canvas itemconfigure q -fill navy"
} ::tcl::mathop} .c

proc check {row col} {
  set txt .c itemcget q&&r$row&&c$col -text
  if {$txt ne ""} then {
    .c itemconfigure q&&r$row&&c$col -text ""
  } else {
    setQueen $row $col
  }
}

proc setQueen {row col} {
  foreach tag .c gettags q&&r$row&&c$col {
    regexp d(.+) $tag - d
    regexp e(.+) $tag - e
  }
  set pat q&&(r$row||c$col||d$d||e$e)
  set success true
  set els .c find withtag $pat
  foreach el $els {
    if {.c itemcget $el -text ne ""} then {
      set success false
    }
  }
  if {$success} then {
    .c itemconfigure q&&r$row&&c$col -text Q
  } else {
    .c itemconfigure $pat -fill white
  }
}