The Whole 8-queens Example

To finish off, we our complete 8-queens program.

Here is the Prolog part, which we have covered in previous sections. The code is in library('tcltk/examples/8-queens.pl'):

     :- use_module(library(tcltk)).
     :- use_module(library(lists)).
     
     setup :-
         tk_new([name('SICStus+Tcl/Tk - Queens')], Tcl),
         tcl_eval(Tcl, 'source 8-queens.tcl', _),
         tk_next_event(Tcl, Event),
         (   Event = next -> go(Tcl)
         ;   closedown(Tcl)
         ).
     
     closedown(Tcl) :-
         tcl_delete(Tcl).
     
     go(Tcl) :-
         tcl_eval(Tcl, 'clear_board', _),
         queens(8, Qs),
         show_solution(Tcl,Qs),
         tk_next_event(Tcl, Event),
         (   Event = next -> fail
         ;   closedown(Tcl)
         ).
     go(Tcl) :-
         tcl_eval(Tcl, 'disable_next', _),
         tcl_eval(Tcl, 'clear_board', _),
         tk_next_event(Tcl, _Event),
         closedown(Tcl).
     
     queens(N, Qs) :-
         range(1, N, Ns),
         queens(Ns, [], Qs).
     
     queens(UnplacedQs, SafeQs, Qs) :-
         select(Q, UnplacedQs, UnplacedQs1),
         \+ attack(Q, SafeQs),
         queens(UnplacedQs1, [Q|SafeQs], Qs).
         queens([], Qs, Qs).
     
     attack(X, Xs) :- attack(X, 1, Xs).
     
     attack(X, N, [Y|_Ys]) :- X is Y + N.
     attack(X, N, [Y|_Ys]) :- X is Y - N.
     attack(X, N, [_Y|Ys]) :-
         N1 is N + 1,
         attack(X, N1, Ys).
     
     range(M, N, [M|Ns]) :-
         M < N,
         M1 is M + 1,
         range(M1, N, Ns).
     range(N, N, [N]).
     
     show_solution(Tcl, L) :-
         reverse(L, LR),
         tcl_eval(Tcl, [show_solution, br(LR)], _),
         tk_do_all_events.
     
     tk_do_all_events :-
         tk_do_one_event, !,
         tk_do_all_events.
     tk_do_all_events.
     
     :- setup.
     

And here is the Tcl/Tk part which we have covered in bits and pieces but here is the whole thing. We have added an enhancement where when the mouse is moved over one of the queens, the squares that the queen attacks are highlighted. Move the mouse away and the board reverts to normal. This is an illustration of how the Tcl/Tk bind feature can be used. The code is in library('tcltk/examples/8-queens.tcl'):

     #! /usr/bin/wish
     
     # create an 8x8 grid of labels
     proc setup_display { } {
         frame .queens -background black
         pack .queens
     
         for {set y 1} {$y <= 8} {incr y} {
             for {set x 1} {$x <= 8} {incr x} {
     
                 # create a label and display a queen in it
                 label .queens.$x-$y -bitmap @bitmaps/q64s.bm -relief flat
     
                 # color alternate squares with different colors
                 # to create the chessboard pattern
                 if { [expr ($x + $y) % 2] } {
                     .queens.$x-$y config -background #ffff99
                 } else {
                     .queens.$x-$y config -background #66ff99
                 }
     
                 # set foreground to the background color to
                 # make queen image invisible
                 .queens.$x-$y config -foreground [.queens.$x-$y cget -background]
     
                 # bind the mouse to highlight the squares attacked by a
                 # queen on this square
                 bind .queens.$x-$y <Enter> "highlight_attack on $x $y"
                 bind .queens.$x-$y <Leave> "highlight_attack off $x $y"
     
                 # arrange the queens in a grid
                 grid .queens.$x-$y -row $y -column $x -padx 1 -pady 1
     
                 }
            }
     }
     
     # clear a whole column
     proc reset_column { column } {
         for {set y 1 } { $y <= 8 } {incr y} {
             set_queens $column $y ""
         }
     }
     
     # place or unplace a queen
     proc set_queens { x y v } {
         if { $v == "Q" } {
             .queens.$x-$y config -foreground black
         } else {
             .queens.$x-$y config -foreground [.queens.$x-$y cget -background]
         }
     }
     
     # place a queen on a column
     proc place_queen { x y } {
         reset_column $x
         set_queens $x $y Q
     }
     
     # clear the whole board by clearing each column in turn
     proc clear_board { } {
         for { set x 1 } {$x <= 8} {incr x} {
             reset_column $x
         }
     }
     
     # given a solution as a list of queens in column positions
     # place each queen on the board
     proc show_solution { solution } {
         clear_board
         set x 1
         foreach y $solution {
             place_queen $x $y
             incr x
         }
     }
     
     proc highlight_square { mode x y } {
         # check if the square we want to highlight is on the board
         if { $x < 1 || $y < 1 || $x > 8 || $y > 8 } { return };
     
         # if turning the square on make it red,
         # otherwise determine what color it should be and set it to that
         if { $mode == "on" } { set color red } else {
             if { [expr ($x + $y) % 2] } { set color "#ffff99" } else {
                 set color "#66ff99" }
             }
     
             # get the current settings
             set bg [ .queens.$x-$y cget -bg ]
             set fg [ .queens.$x-$y cget -fg ]
     
             # if the current foreground and background are the same
             # there is no queen there
             if { $bg == $fg } {
                 # no queens
                 .queens.$x-$y config -bg $color -fg $color
              } else {
                  .queens.$x-$y config -bg $color
         }
     }
     
     proc highlight_attack { mode x y } {
         # get current colors of square at x y
         set bg [ .queens.$x-$y cget -bg ]
         set fg [ .queens.$x-$y cget -fg ]
     
         # no queen there, give up
         if { $bg == $fg } { return };
     
         # highlight the sqaure the queen is on
         highlight_square $mode $x $y
     
         # highlight vertical and horizontal
         for { set i 1 } {$i <= 8} {incr i} {
             highlight_square $mode $x $i
             highlight_square $mode $i $y
         }
     
         # highlight diagonals
         for { set i 1} { $i <= 8} {incr i} {
             highlight_square $mode [expr $x+$i] [expr $y+$i]
             highlight_square $mode [expr $x-$i] [expr $y-$i]
             highlight_square $mode [expr $x+$i] [expr $y-$i]
             highlight_square $mode [expr $x-$i] [expr $y+$i]
         }
     }
     
     proc disable_next {} {
         .next config -state disabled
     }
     
     setup_display
     
     # button for sending a 'next' message
     button .next -text next -command {prolog_event next}
     pack .next
     
     # button for sending a 'stop' message
     button .stop -text stop -command {prolog_event stop}
     pack .stop