package require Tcl 8.5
package require Tk

bind Tk <Destroy> 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 <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
  }
}

if false {
  # the "aggressive" variant:
  proc setQueen {row col} {
    foreach tag [.c gettags q&&r$row&&c$col] {
      regexp d(.+) $tag - d
      regexp e(.+) $tag - e
    }
    .c itemconfigure q&&(r$row||c$col||d$d||e$e) -text ""
    .c itemconfigure q&&r$row&&c$col -text Q
  }
}

proc r {l} {
        global solutions
        if {[llength $l]==8} {lappend solutions $l; return $l}
        foreach g [remove $l] {
                set n [concat $l $g]
                if {[valid $n]} {
                        r $n
                }
        }
}

proc valid {l} {
        set len [llength $l]
        for {set j 0} {$j<$len} {incr j} {
                set n [lindex $l $j]
                for {set i 0} {$i<$len} {incr i} {
                        if {$i==$j} {continue}        
                        set t [lindex $l $i]
                        
                        if {[expr ($t-$n) - ($i-$j)]==0} {return 0}
                        if {[expr ($n-$t) - ($i-$j)]==0} {return 0}
                }
        }
        return 1
}

proc remove {l} {
        set ret [list]
        foreach n [list 0 1 2 3 4 5 6 7] {
                if {[lsearch $l $n]==-1} {lappend ret $n}
        }
        return $ret
} 

set solutions [list]

proc go {} {
        global solutions
        set solutions [list]
        foreach h [list 0 1 2 3 4 5 6 7] {
                r $h
        }

        #puts [join $solutions \n]
        #puts "[llength $solutions] Solutions..."
}
set index -1
proc forward {} {
        global index
        if {$index>90} {return}
        incr index
        display
}
proc back {} {
        global index
        if {$index<1} {return}
        incr index -1
        display
}
proc display {} {
        global solutions display index
        set sol [lindex $solutions $index]
        set r ""
        #set e "================\n"
        set e ""
        foreach l $sol {
                if {$l==0} {append r "Q| | | | | | | \n$e"}
                if {$l==1} {append r " |Q| | | | | | \n$e"}
                if {$l==2} {append r " | |Q| | | | | \n$e"}
                if {$l==3} {append r " | | |Q| | | | \n$e"}
                if {$l==4} {append r " | | | |Q| | | \n$e"}
                if {$l==5} {append r " | | | | |Q| | \n$e"}
                if {$l==6} {append r " | | | | | |Q| \n$e"}
                if {$l==7} {append r " | | | | | | |Q\n$e"}
        }
        set display $r
}

pack [label .l -textvariable display -width 16 -height 10 -font {Courier 12 bold}]
frame .b
button .b.b -text < -command back
button .b.f -text > -command forward
pack .b.b .b.f -in .b -side left
pack .b

set display "Searching\nfor\nsolutions"

go

forward