ulis, 06-12-2004. Ah, la valse des flocons !
(http://www.its.caltech.edu/~atomic/snowcrystals/photos/photos.htm)
Pourquoi ?
Paske j'ai pas pu m'empêcher <;^)
Comment ?
Les flocons hésitent entre la gauche, la droite et le milieu. Ils s'arrêtent sur le sol ou si la place est déjà prise.
Le code
# flocons
package require Tk
set width 256
set height 256
wm title . Snow
wm protocol . WM_DELETE_WINDOW exit
canvas .c -width $width -height $height -bg gray
pack .c
set flakes [list]
set ID 0
while 1 \
{
update
after 10
set fl [list]
foreach f $flakes \
{
foreach {x1 y1 x2 y2} [.c coords $f] break
set r [expr {rand()}]
set dx [expr {$r < 0.333 ? -1 : $r > 0.666 ? 1 : 0}]
set x1 [expr {$x1 + $dx}]
set x2 [expr {$x2 + $dx}]
set y1 [expr {$y1 + 1}]
set y2 [expr {$y2 + 1}]
set stop 0
if {$y2 >= $height} { set stop 1 } \
else \
{
foreach ff [.c find overlapping $x1 $y1 $x2 $y2] \
{
if {[.c gettags $ff] == "stop" && [.c coords $ff] == [list $x1 $y1 $x2 $y2]} \
{ set stop 1; break }
}
}
if {$stop} { .c itemconfig $f -tags stop } \
else { .c move $f $dx 1; lappend fl $f }
}
set flakes $fl
set x [expr {round(rand() * $width)}]
.c create oval [expr {$x - 1}] 0 [expr {$x + 1}] 2 \
-tag f[incr ID] -fill white -outline ""
lappend flakes $ID
}Voir aussi
Discussion
Merci ulis, pour tes mathématiques poétiques... et en plus c'est de saison!!!
dc 24/12/05 grâce à ulis il neige sur le bureau (linux + import d'ImageMagick). À associer éventuellement à Économiseur d'écran
package require Tk
# récupération de l'apparence du bureau
set com {import -window root /tmp/ecran.gif}
eval exec $com
# plein écran
wm overrideredirect . 1
set l [winfo screenwidth .]
set h [winfo screenheight .]
wm geometry . ${l}x${h}+0+0
# zone de dessin
pack [canvas .c -bg white -highlightt 0 -cursor pirate] -expand 1 -fill both
bind .c <1> exit
# affichage de l'image bureau
image create photo fond -file /tmp/ecran.gif
.c create image 0 0 -image fond -anchor nw
# neige de Maurice
set width $l
set height $h
set flakes [list]
set ID 1
while 1 {
update
after 10
set fl [list]
foreach f $flakes {
foreach {x1 y1 x2 y2} [.c coords $f] break
set r [expr {rand()}]
set dx [expr {$r < 0.333 ? -1 : $r > 0.666 ? 1 : 0}]
set x1 [expr {$x1 + $dx}]
set x2 [expr {$x2 + $dx}]
set y1 [expr {$y1 + 1}]
set y2 [expr {$y2 + 1}]
set stop 0
if {$y2 >= $height} {
set stop 1
} else {
foreach ff [.c find overlapping $x1 $y1 $x2 $y2] {
if {[.c gettags $ff] == "stop" && [.c coords $ff] == [list $x1 $y1 $x2 $y2]} \
{ set stop 1; break }
}
}
if {$stop} { .c itemconfig $f -tags stop } \
else { .c move $f $dx 1; lappend fl $f }
}
set flakes $fl
set x [expr {round(rand() * $width)}]
.c create oval [expr {$x - 1}] 0 [expr {$x + 1}] 2 \
-tag f[incr ID] -fill white -outline ""
lappend flakes $ID
}