Acht Königinnen
Auf dem Schachbrett darf die Dame längs und schräg schlagen.
Ziel des Spiels: verteile acht Damen, so dass sich keine bedroht fühlt. Sonst schmollt sie nämlich.
#!/usr/bin/wish
package require Tcl 8.5
package require Tk
bind [winfo class .] <Destroy> exit
wm resizable . no no
wm title . "Set 8 Queens, splendid safe, please!"
proc blink {widget args} {
lassign [info level 0] blink
if {$widget eq "info"} then {
#
# info
#
set result {}
foreach event [after info] {
set info [after info $event]
if {[lindex $info end] eq "timer" &&
[lindex $info 0 0] eq $blink} then {
lassign $info cmd
lassign $cmd blink widget
if {[winfo exists $widget]} then {
set line [list $blink $widget]
set opts [lrange $cmd 2 end]
if {[winfo class $widget] in {Text Canvas}} then {
lappend line -tag [dict get $opts -tag]
}
lappend line -att [dict get $opts -att]
lappend result $line
}
}
}
lsort $result
} elseif {$widget eq "stop"} then {
#
# stop all after-events
#
foreach event [after info] {
set info [after info $event]
if {[lindex $info end] eq "timer" &&
[lindex $info 0 0] eq $blink} then {
after cancel $event
}
}
} elseif {[winfo exists $widget]} then {
if {$args eq "stop"} then {
$blink $widget -action stop
} else {
set class [winfo class $widget]
#
# prepare
#
set item {
-step 0
-red0 0
-green0 0
-blue0 0
-tag blink
-red1 65535
-green1 65535
-blue1 65535
-interval 25
-action continue
}
#
# set default target attributes
#
switch -exact -- $class {
Text {
dict set item -att -foreground
}
Canvas {
dict set item -att -fill
}
default {
dict set item -att -fg
}
}
#
# customize by command line
#
dict for {key val} $args {
dict set item $key $val
}
#
# translate named colors if given
#
if {[dict exists $item -color0]} then {
lassign [winfo rgb . [dict get $item -color0]] r g b
dict set item -red0 $r
dict set item -green0 $g
dict set item -blue0 $b
dict unset item -color0
}
if {[dict exists $item -color1]} then {
lassign [winfo rgb . [dict get $item -color1]] r g b
dict set item -red1 $r
dict set item -green1 $g
dict set item -blue1 $b
dict unset item -color1
}
#
if {[dict get $item -action] eq "continue"} then {
#
# calculate increasement of color
#
dict incr item -step
if {[dict get $item -step] >= 100} then {
dict set item -step 0
}
set pi [expr {
atan2(0,-1)
}]
set factor [expr {
(cos($pi * 2 * [dict get $item -step] / 100) + 1) / 2
}]
#
# generate hexadecimal color string
#
set rrrrggggbbbb #
#
set red0 [dict get $item -red0]
set red1 [dict get $item -red1]
set red [expr {$red0+int(($red1-$red0)*$factor)}]
append rrrrggggbbbb [format %04x $red]
#
set green0 [dict get $item -green0]
set green1 [dict get $item -green1]
set green [expr {$green0+int(($green1-$green0)*$factor)}]
append rrrrggggbbbb [format %04x $green]
#
set blue0 [dict get $item -blue0]
set blue1 [dict get $item -blue1]
set blue [expr {$blue0+int(($blue1-$blue0)*$factor)}]
append rrrrggggbbbb [format %04x $blue]
#
set tag [dict get $item -tag]
set att [dict get $item -att]
switch -exact -- $class {
Canvas {
$widget itemconfigure $tag $att $rrrrggggbbbb
}
Text {
$widget tag configure $tag $att $rrrrggggbbbb
}
default {
$widget configure $att $rrrrggggbbbb
}
}
#
# repeat
#
set interval [dict get $item -interval]
after $interval [list blink $widget {*}$item]
#
} else {
#
# stop blinking of $widget
#
foreach event [after info] {
set info [after info $event]
set line [lindex $info 0]
lassign $line proc arg
if {$proc eq $blink && $arg eq $widget} then {
after cancel $event
}
}
}
}
}
}
apply {canvas {
destroy $canvas
pack [canvas $canvas -width 320 -height 320]
foreach i {0 1 2 3 4 5 6 7} {
foreach j {0 1 2 3 4 5 6 7} {
set o [expr {($i+$j)%2 ? "odd" : "even"}]
set coords [list [* $i 40] [* $j 40]\
[* [+ $i 1] 40] [* [+ $j 1] 40]]
$canvas create rectangle $coords\
-tags [list f $o r$j c$i]
$canvas create text\
[+ [* $i 40] 20] [+ [* $j 40] 20]\
-tags [list q r$j c$i]
$canvas bind r$j&&c$i <1> "check $j $i"
}
}
foreach c {-8 -7 -6 -5 -4 -3 -2 -1 0 1 2 3 4 5 6 7} {
set col $c
foreach row {0 1 2 3 4 5 6 7} {
$canvas addtag d[+ $c 7] withtag r$row&&c$col
incr col
}
}
foreach c {0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15} {
set col $c
foreach row {0 1 2 3 4 5 6 7} {
$canvas addtag e$c withtag r$row&&c$col
incr col -1
}
}
$canvas itemconfigure odd\
-fill #cccccc\
-outline ""
$canvas itemconfigure even\
-fill #ffffcc\
-outline ""
$canvas itemconfigure q\
-fill navy\
-font {Times 32}
bind $canvas <ButtonRelease>\
"$canvas itemconfigure q -fill navy"
} ::tcl::mathop} .c
proc check {row col} {
set txt [.c itemcget q&&r$row&&c$col -text]
if {$txt ne ""} then {
.c itemconfigure q&&r$row&&c$col -text ""
} else {
setQueen $row $col
}
set missing [missingOfQueens]
switch -exact -- $missing {
0 {
wm title . Congratulations!
}
1 {
wm title . "Set 1 Queen, splendid safe!"
}
default {
wm title .\
"Set $missing Queens, splendid safe!"
}
}
}
proc setQueen {row col} {
foreach tag [.c gettags q&&r$row&&c$col] {
regexp d(.+) $tag - d
regexp e(.+) $tag - e
}
set pat q&&(r$row||c$col||d$d||e$e)
set success true
set els [.c find withtag $pat]
foreach el $els {
if {[.c itemcget $el -text] ne ""} then {
set success false
}
}
if {$success} then {
.c itemconfigure q&&r$row&&c$col -text \u2655
} else {
# .c itemconfigure $pat -fill red
blink .c -tag $pat -color0 white -color1 navy -interval 10
}
}
bind .c <ButtonRelease> {
blink stop
.c itemconfigure q -fill navy
}
proc missingOfQueens {} {
set result 8
foreach item [.c find all] {
if {[.c type $item] eq "text" &&
[.c itemcget $item -text] ne ""} then {
incr result -1
}
}
set result
}
11.3.2022
<< | Heimatseite | Verzeichnis | Stichworte | Autor | >>