=== package require Tcl 8.5 package require Tk bind Tk 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 \ "$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