[WDB]: ====== package require Tcl 8.5 package require Tk bind Tk exit wm resizable . no no apply {canvas { destroy $canvas pack [canvas $canvas -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 \ "$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 } } ====== ---- See also: [Eight Queens Problem] <>Category Toys