# Copyright (C) 2008 Pat Thoyts <[email protected]>
#
# Do a knight's tour of a chessboard.
package require Tk 8.5
# Return a list of accessible squares from a given square
proc ValidMoves {square} {
set moves {}
foreach pair {{-1 -2} {-2 -1} {-2 1} {-1 2} {1 2} {2 1} {2 -1} {1 -2}} {
set col [expr {($square % 8) + [lindex $pair 0]}]
set row [expr {($square / 8) + [lindex $pair 1]}]
if {$row > -1 && $row < 8 && $col > -1 && $col < 8} {
lappend moves [expr {$row * 8 + $col}]
}
}
return $moves
}
# Return the number of available moves for this square
proc CheckSquare {square} {
variable visited
set moves 0
foreach test [ValidMoves $square] {
if {[lsearch -exact -integer $visited $test] == -1} {
incr moves
}
}
return $moves
}
# Select the next square to move to. Returns -1 if there are no available
# squares remaining that we can move to.
proc Next {square} {
variable visited
set minimum 9
set nextSquare -1
foreach testSquare [ValidMoves $square] {
if {[lsearch -exact -integer $visited $testSquare] == -1} {
set count [CheckSquare $testSquare]
if {$count < $minimum} {
set minimum $count
set nextSquare $testSquare
}
}
}
return $nextSquare
}
# Display a square number as a standard chess square notation.
proc N {square} {
return [format %c%d [expr {97 + $square % 8}] \
[expr {$square / 8 + 1}]]
}
# Move the knight
proc MovePiece {last square} {
variable visited
variable delay
.f.txt insert end "[llength $visited]. [N $last] .. [N $square]\n" {}
.f.txt see end
.f.c itemconfigure [expr {1+$last}] -state normal -outline black
after [expr {$delay/2}] [list .f.c itemconfigure \
[expr {1+$square}] -state normal -outline red]
.f.c itemconfigure [expr {1+$square}] -outline red
.f.c coords knight [lrange [.f.c coords [expr {1+$square}]] 0 1]
lappend visited $square
set next [Next $square]
if {$next ne -1} {
after $delay [list MovePiece $square $next]
} else {
.b1 configure -state normal
if {[llength $visited] == 64} {
.f.txt insert end "Success\n" {}
} else {
.f.txt insert end "FAILED!\n" {}
}
}
}
proc Tour {} {
variable visited {}
.f.txt delete 1.0 end
.b1 configure -state disabled
for {set n 0} {$n < 64} {incr n} {
.f.c itemconfigure $n -state disabled -outline black
}
# Failures: d6 (43)
set initial [expr {int(rand() * 64)}]
after idle [list MovePiece $initial $initial]
}
proc SetDelay {new} {
variable delay [expr {int($new)}]
}
proc CreateGUI {} {
wm title . "Knights tour"
wm withdraw .
set f [ttk::frame .f]
set c [canvas $f.c -width 240 -height 240]
text $f.txt -width 10 -height 1 -background white \
-yscrollcommand [list $f.vs set] -font {Arial 8}
ttk::scrollbar $f.vs -command [list $f.txt yview]
variable delay 1000
ttk::label .ls -text Speed
ttk::scale .sc -from 2 -to 2000 -command [list SetDelay] \
-variable [namespace which -variable delay]
ttk::button .b1 -text Start -command Tour
ttk::button .b2 -text Exit -command {destroy .}
set square 0
for {set row 7} {$row != -1} {incr row -1} {
for {set col 0} {$col < 8} {incr col} {
if {(($col & 1) ^ ($row & 1))} {
set fill "#906010" ; set dfill "#533200"
} else {
set fill "#f0e0a0" ; set dfill "#c0c090"
}
set coords [list [expr {$col * 30 + 3}] [expr {$row * 30 + 3}] \
[expr {$col * 30 + 29}] [expr {$row * 30 + 29}]]
$c create rectangle $coords -fill $fill -disabledfill $dfill \
-width 2 -state disabled
}
}
catch {eval font create KnightFont -size 18}
$c create text -80 -80 -font KnightFont -text "\u265e" \
-anchor nw -tags knight
grid $c $f.txt $f.vs -sticky news
grid rowconfigure $f 0 -weight 1
grid columnconfigure $f 1 -weight 1
grid $f - - - -sticky news
grid .ls .sc .b1 .b2 -sticky e
grid rowconfigure . 0 -weight 1
grid columnconfigure . 0 -weight 1
bind . <Control-F2> {console show}
bind . <Return> {.b1 invoke}
bind . <Escape> {.b2 invoke}
wm deiconify .
tkwait window .
}
if {!$tcl_interactive} {
set r [catch [linsert $argv 0 CreateGUI] err]
if {$r} {
tk_messageBox -icon error -title "Error" -message $err
}
exit $r
}