| 1 | # |
| 2 | # Eight Queens in Tcl |
| 3 | # |
| 4 | # by Karl Lehenbauer, 23 Nov 1990 |
| 5 | # |
| 6 | #----------------------------------------------------------------------------- |
| 7 | # $Id: 8queens.tcl,v 2.0 1992/10/16 04:51:36 markd Rel $ |
| 8 | #----------------------------------------------------------------------------- |
| 9 | # |
| 10 | proc none_attacking {rank position} { |
| 11 | global queens |
| 12 | loop i 1 $rank { |
| 13 | set j $queens([expr {$rank - $i}]) |
| 14 | if {($j==$position-$i) || ($j==$position) || ($j==$position+$i)} { |
| 15 | return 0 |
| 16 | } |
| 17 | } |
| 18 | return 1 |
| 19 | } |
| 20 | |
| 21 | proc solution {} { |
| 22 | global queens |
| 23 | echo $queens(1) $queens(2) $queens(3) $queens(4) $queens(5) $queens(6) $queens(7) $queens(8) |
| 24 | } |
| 25 | |
| 26 | proc x8queens {rank} { |
| 27 | global queens |
| 28 | set queens($rank) 1 |
| 29 | loop i 1 9 { |
| 30 | if [none_attacking $rank $i] { |
| 31 | set queens($rank) $i |
| 32 | if {$rank != 8} { |
| 33 | x8queens [expr $rank+1] |
| 34 | } else { |
| 35 | solution |
| 36 | return |
| 37 | } |
| 38 | } |
| 39 | } |
| 40 | } |
| 41 | |
| 42 | proc 8queens {} { |
| 43 | x8queens 1 |
| 44 | } |
| 45 | |
| 46 | global interactiveSession |
| 47 | if !$interactiveSession 8queens |