git.zerfleddert.de Git - micropolis/blob - src/tclx/tcllib/8queens.tcl

   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