set logo \
{R0lGODlhRABkAPf/AP//////zP//mf//Zv//M///AP/M///MzP/Mmf/MZv/MM//MAP+Z//+Z
zP+Zmf+ZZv+ZM/+ZAP9m//9mzP9mmf9mZv9mM/9mAP8z//8zzP8zmf8zZv8zM/8zAP8A//8A
zP8Amf8AZv8AM/8AAMz//8z/zMz/mcz/Zsz/M8z/AMzM/8zMzMzMmczMZszMM8zMAMyZ/8yZ
zMyZmcyZZsyZM8yZAMxm/8xmzMxmmcxmZsxmM8xmAMwz/8wzzMwzmcwzZswzM8wzAMwA/8wA
zMwAmcwAZswAM8wAAJn//5n/zJn/mZn/Zpn/M5n/AJnM/5nMzJnMmZnMZpnMM5nMAJmZ/5mZ
zJmZmZmZZpmZM5mZAJlm/5lmzJlmmZlmZplmM5lmAJkz/5kzzJkzmZkzZpkzM5kzAJkA/5kA
zJkAmZkAZpkAM5kAAGb//2b/zGb/mWb/Zmb/M2b/AGbM/2bMzGbMmWbMZmbMM2bMAGaZ/2aZ
zGaZmWaZZmaZM2aZAGZm/2ZmzGZmmWZmZmZmM2ZmAGYz/2YzzGYzmWYzZmYzM2YzAGYA/2YA
zGYAmWYAZmYAM2YAADP//zP/zDP/mTP/ZjP/MzP/ADPM/zPMzDPMmTPMZjPMMzPMADOZ/zOZ
zDOZmTOZZjOZMzOZADNm/zNmzDNmmTNmZjNmMzNmADMz/zMzzDMzmTMzZjMzMzMzADMA/zMA
zDMAmTMAZjMAMzMAAAD//wD/zAD/mQD/ZgD/MwD/AADM/wDMzADMmQDMZgDMMwDMAACZ/wCZ
zACZmQCZZgCZMwCZAABm/wBmzABmmQBmZgBmMwBmAAAz/wAzzAAzmQAzZgAzMwAzAAAA/wAA
zAAAmQAAZgAAM+4AAN0AALsAAKoAAIgAAHcAAFUAAEQAACIAABEAAADuAADdAAC7AACqAACI
AAB3AABVAABEAAAiAAARAAAA7gAA3QAAuwAAqgAAiAAAdwAAVQAARAAAIgAAEe7u7t3d3bu7
u6qqqoiIiHd3d1VVVURERCIiIhEREQAAACwAAAAARABkAAAI/wABCBxIsKDBgwgTKlzIsKHA
evYOSHRAUYaMGTky5nDgsOPAevUkHkBA0YFFjBl1AFm5MojLlzBjAplxwGNCByxbxtzJs6fP
IBvrMQQZcWJNADJ+Kl2qFMjGixpzqMwZU4ZAB0yzat26kyMArFzDivWJ4OrYs2iDHAWbtq3W
owfcyl0KRCiAuG2PHJnrE8hAvFr37tyxg29PvwIBMz2yY8EOwUciFCjw2HBMHQPtcV2w4CXj
yREKW4aZ4yOQrJ8r7+X8WPBol6Ufnl4cobPLyAWCuH7tcgbB2UsjR3BdoMbunXr1trU6EPjS
0HuP1LDdc+9GnMfDehXoXCl0lwuMV/8HchSAPSDZt24H0N2n9Ns7cqc/osMegHpPqtRzkP4t
QR2oiRYEZ9XpIFQVyDijoBXtbVUeADlwtRdl2R1RVz2kKKghMl2gZd9AEW71mW4xWXiAPQlq
qCEZZ9VFUIiB1cbTEQiokKKKzpCBTYsFwaiVY8cd8QCGODqDzCE7wpRciT1h9mJYQCpZWoZF
rsLTDqHBF+VOsQ00g4gD8nRAHkUqyOJONRRA3YBrklZQUoE1VmIO9pTpDJLIBaGmZzLy1KVA
cAYYwU4IkFmkKrMpd5uew91WQ6M7MTcQW4th6ZqFKJapYxBOwZiaazWQ2FVBlAZH2KUPGIrj
IZzKYJcO0cX/p9V6X4l4KkwOUInjKqog42seEEZXW387PVgrWkCscKOdzgQCwAyCbbmUsQig
RV8VzKrYRbCrbfXhX9bmoGq2peWg16PEymQXuGcdkYOuzK7CEXpBDJouTIgRpFhY7sJr5yES
kQgpU/myO5a7y9o5Rj0y6HVrVk4SdF67OSRcZg710CtgVn/KhuyyyPi7Ckn3+tQxd8jiSErC
+hxAr1iS/paWKhoekk/CVjxQsk8xN5fWKitaAXKgY9GKsljYHaIhENiqqE+DW5VlEIBiSQTE
PgquIq6KVrZlrEBUh1WTPVQeMsO4uu3809cQjnWACisriIgDnazIQUbIrvtk1U+o/0jGPbqu
AkhEyCLkY9SqrpKsv/fwx+NBh2tVqIaKZ6qiPRWozVPB/4l1hAOJ17UsKfXA+vjUnjtghYb7
1LcsIBnnfRDUSgm5upGI0LmsFQHQTrDePvObgwwKIpO7jSpasa9Y38rMrw7EG0lGBSrgKMPy
Ys8+FhAyAI0MGTk4gaMO2HP1dexiAeEA0Dk+ID7lQCDgO1Pnz//TA4GYOcP7WavfltGaOVgF
9KE//t3pAY5Di9HKtxgL5EN6+1PRGOSnuZ4sEFkP/F74VJSDl6GlZ3dJSw7kRifKwcZ+SgEh
AxejgwTlznLTswf6zuKbgqyQYBk6RA6QZyUg4COAaDlZqf8kFIRVHAljCVoF0EhxQ6YI8WAZ
OcIhkKG4eoxuiGF5oucwcwBAOKOKy6pCAs+iRbflIUVAIJuKVmCutERsUhRTFRkOoCsmorAp
BiEazKiEiMkpKB86awvnkGItINwjQYcAnYZkcEc8FuRLhcQHFR3QNEBkzi2DhGQh80GKHPTN
GR2Si4v2lpYjkGEfOVBW1+bSvLbNJY2HONNcjBW5reiAIjBx2b2A8AAEtHFaPUKO5soCHF8G
6Tjl2hktd+IU1DgAfZ+DVkykIqVgMUVqAwnbbebFpO58DpozGKOFvnKpcnFKJxYsiDZN9JWX
ucsBGwHONxO1kZg84C6eKlf8HlD/y5fQqj3cvI1fIoQUyDwTOPG7zLFuU64caNIn/yxRQHVj
ldN00DMHhYn8POMXcZbmABm7V8+8OS+DskdR25zh5345To9+JYTpGqlEAVBNWDUzpUqagTR1
09FyQqg0WIRJDT2mJKvAE1c4mYHpgkC+enjqlvgKyQxmo7521gQnJiPIDEkTOR2oBF8swRdW
X+IU5+QkrFnNTHUqxFYuOQelnonrT/7UxO0Z5o115Y0t9aVXvhQsr30lGF8Di0mCBJWwXBnl
QhHrITgyNi3lOexjsxLZ7a1kKmdtpIMGokeyrkQjMqCIRGSYEKKIRCQlKclJUBIVr2Y2shkJ
rQNGCzybCtj2trjNrW4HEhAAOw==}

image create photo tcllogo -data $logo

proc makefield {n} {
  global out

  .c delete all
  set out(fsize) [expr $out(maxsize)/$n]
  set csize [expr $out(fsize)*$n]
  .c configure -width $csize -height $csize
  for {set i 0} {$i < $n} {incr i} {
    for {set j 0} {$j < $n} {incr j} {
      set fid [.c create rectangle [expr $out(fsize)*$i] [expr $out(fsize)*$j] \
        [expr $out(fsize)*($i+1)] [expr $out(fsize)*($j+1)] \
        -outline {}]
      if {($i+$j)%2} {
        .c itemconfigure $fid -fill black
      } else {
        .c itemconfigure $fid -fill white
      }
    }
  }
  set out(wait) 1
  after 500 {set out(wait) 0}
}

proc ausgabe {n rescnt} {
  global f out

  if {$out(wait)} {
    tkwait variable out(wait)
  }
  .c delete damen
  for {set i 1} {$i <= $n} {incr i} {
    .c create oval [expr ($i-1)*$out(fsize)+1] [expr ($f($i)-1)*$out(fsize)+1] \
      [expr $i*$out(fsize)-1] [expr $f($i)*$out(fsize)-1] \
        -fill red -outline {} -tag damen
  }
  set out(cnt) $rescnt
  update
  set out(wait) 1
  after 500 {set out(wait) 0}
}

proc schlagtest {x} {
  global f
  
  for {set i 1} {$i < $x} {incr i} {
    if {$f($x) == $f($i) || abs($f($x)-$f($i)) == $x-$i} {
      return 0
    }
  }
  return 1
}

proc damen {n} {
  global f

  set x 1
  set f(1) 1
  set rescnt 0
  while {1} {
    while {$f($x) > $n} {
      if {$x == 1} {
        return $rescnt
      }
      incr x -1
      incr f($x)
    }
    if {[schlagtest $x]} {
      if {$x == $n} {
        incr rescnt
        ausgabe $n $rescnt
        incr x -1
        incr f($x)
      } else {
        incr x
        set f($x) 1
      }
    } else {
      incr f($x)
    }
  }
}

set out(maxsize) 300
frame .f -width 600 -height 310
label .logo -image tcllogo
label .lcnt -textvariable out(cnt) -font {Helvetica 24 bold}
canvas .c -width 300 -height 300
text .t -width 20
grid .logo -row 0 -column 0 -in .f -sticky n
grid .lcnt -row 1 -column 0 -in .f -sticky s
grid .c -row 0 -column 1 -rowspan 2 -in .f
grid .t -row 0 -column 2 -rowspan 2 -in .f -sticky nsew
pack .f
.t insert end "n-Damen-Problem\n"
.t insert end "===============\n"
set n 2
while 1 {
  makefield $n
  .t insert end "$n: "
  update
  .t insert end "[damen $n] Lsg.\n"
  .t yview end
  if {$out(wait)} {
    tkwait variable out(wait)
  }
  incr n
}