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 }