40.5.4 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'):

                              
% 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).
% 8-queens.pl
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'):

                             
# 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 } } }
# 8-queens.tcl
# 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 } }
# 8-queens.tcl
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] } }
# 8-queens.tcl
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

images/tcltk8queens.png
8-Queens Solution, Attacked Squares Highlighted