# Copyright (C) 2008 Pat Thoyts # # 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 . {console show} bind . {.b1 invoke} bind . {.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 } ---- !!!!!! %| enter categories here |% !!!!!!