'''K L Prasad: ''' As one of my initial attempts at TCL/TK programming, I have created the following code to solve the well known eight queens problem of chess visually. Just in case somebody wants to know, the problem is to place eight queens on a chess board, so that no queen attacks others, but together they cover the entire board. It uses a simple back tracking algorithm and can compute all the solutions.

Suggestions and comments are welcome.

--------
 #!/bin/sh
 # the next restarts using wish \
 exec wish "$0" "$@"

 # Search Procedure
 proc search {} {
   global board col lbltxt 
   set TRUE 1; set FALSE 0
   while 1 {
     if {$board($col) != 0} {
       set row [expr {9 - $board($col)}]
       .f2.btn$row$col configure -image empty
       # after 100; update <--- this is slow and unnecessary
     }
     incr board($col); 
     if {$board($col) > 8} {
       set board($col) 0; 
       if {$col > 1} {incr col -1; continue}
     }
     set row [expr {9 - $board($col)}]
     .f2.btn$row$col configure -image queen
     # after 100; update <-- see above
     set place $TRUE 
     for {set j 1} {$j < $col} {incr j} {
       if {$board($j) == $board($col)} {
         set row [expr {9 - $board($j)}]
         .f2.btn$row$j flash
         set place $FALSE
         break
       }
       set x [expr {$col - $j}]
       set y [expr {$board($col) - $board($j)}]
       if { ($x == $y) || ($x == -1*$y) } {
         set row [expr {9 - $board($j)}]
         .f2.btn$row$j flash  
         set place $FALSE
         break
       }
     }
     if {$place == $TRUE} {
       incr col
       if {$col > 8} { 
         incr col -1; 
         set lbltxt "Solution Found"; update
         set ans [tk_messageBox -message "Solution found.\nSearch for another?" \
                                -type yesno -icon question]
         switch -- $ans {
           yes {}
           no  exit
         }
       }
     }
     set lbltxt "Searching for Solution"
     update ;# this update  (1 per loop) is enough, as the loop is short
   }
 }

 # Quit Procedure
 proc quit {} {
   set ans [tk_messageBox -message "Really Quit?" -type yesno \
                          -default "no" -icon question]
   switch -- $ans {
     yes exit
     no  {}
   }
 }
      
 # Main Procedure  
 set queendata "R0lGODlhKAAoAKEAAP8AAAAAAP///wAAACH5BAEAA
                AAALAAAAAAoACgAAALghI+py+0YwpsUxFgzw5pKxS
                VfZ1zgeJikFaZo2XYvvMyaHZere/Y7K1LxHjkaRCB
                4FTnCICqAfC6Zy+TRmsI6hyKtJXqc5cbJEVQb8Roh
                sbMZXIK7xGp3Fi1nqb8t98eu5wVFJohklVb2JZeGM
                /gGdgZp+GijyDSJGJX5BwgyGYdpWCYqsbmBqahJGn
                lIeorJKioL61ojmzmbi7sHk+v7u9oQC0yc5/l7kTx
                cu+GojAj9zFg5t1uWPKvsoXx70Z1cwQ0rrtnkIO39
                LR1eXEzd1Q787hIvP8+Cnp//w9+/UwAAOw=="
 for {set i 1} {$i < 9} {incr i} {set board($i) 0}
 set col 1
 wm title . "Eight Queens Problem"
 wm protocol . WM_DELETE_WINDOW {quit}
 wm resizable . 0 0
 image create photo queen -format GIF -data $queendata 
 image create photo empty -format GIF -data $queendata
 empty blank
 set ht [image height queen]; set ht [expr {1.5 * $ht}]
 set wd [image width queen];  set wd [expr {1.5 * $wd}]
 set bgcolor(0) "green3"; set bgcolor(1) "yellow3"
 set l 0
 frame .f1 -relief groove -bd 3; pack .f1 -fill x
 label .f1.lbl -textvariable lbltxt; pack .f1.lbl 
 set lbltxt "Searching for Solution"
 frame .f2 -relief groove -bd 3; pack .f2
 for {set i 1} {$i < 9} {incr i} {
   for {set j 1} {$j < 9} {incr j} {
     button .f2.btn$i$j -image empty -height $ht -width $wd \
                        -bg $bgcolor($l) -activebackground "red" 
     grid .f2.btn$i$j -row $i -column $j
     set l [expr {1 - $l}]
   }
   set l [expr {1 - $l}] ;# could be done as [expr {!$l}]
 }
 frame .f3 -relief groove -bd 3; pack .f3
 button .f3.start -text "Start" -command {search}
 button .f3.stop -text "Stop" -command {quit}
 pack .f3.start -side left; pack .f3.stop -after .f3.start

----
[Michael Schlenker] Nice toy. I added some comments, {} for the expr's and removed two unnecessary updates.