Neige

 

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

Miko

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
 }

Catégorie Exemple