[Keith Vetter] 2003-05-04 : a simple little whizzlet simulating
rain drops on a window. Much like the old unix game rain.

[http://mini.net/sdarchive/rainstorm.jpg]

----
[Jacob Levy] 05/05/2003 I keep getting error messages (in "deluge" mode mostly) about ::R(somenumber) not being there when incr is applied. The problem is probably collisions due to the ID computation based on rand(), in proc RainDrop. If ::R($id,x) already exists then we should probably go back and compute another ID.

[KPV] 05/06/2003 : thanks for the fix. I took the liberty of 
merging the code.

[Jacob Levy] 05/06/2003 Urk... the version below is (again) missing my fix...

[KPV] 05/06/2003 : true, but it contains a simpler fix

[etdxc] Sep 08 2003 : I received an error when in deluge mode. ''([escargo] put an [if 0 {] around it
to make the file reapable again.)''
 if 0 {
        Wish84 has caused an error in DIBENG.DLL
 }

It's probably something to do with my 'Windows Me' and not your code but I thought I'd let your know. Btw, can I use this code in a project I'm working on?

[KPV] of course, everything I put on Wiki is for all to use freely.

[DKF]: Is it necessary to create and delete all those ovals?  Couldn't you use [[$w coords]] to resize them instead?  (You also leak tags; better to not set a tag and just store the id in a variable.)

[PWQ] 16 Sep 2003, On my machine this eats memory. I would have to say that this seems to be a leak in Tk, that would be nice to have fixed.

[DKF]: It's a leak in the program, yes, but not necessarily a leak in Tk.  Except that it is a leak in Tk, and a stinking nasty one that is going to be really hard to fix (and which results from one of the early visionary things not working out quite as well as the author hoped...)

[DKF]: I've reworked this code for better performance.  It no longer leaks, and it goes ''much'' faster on the Deluge setting (over 440 drops at once on screen, sustained, and with trickery that can be pushed to over 750.)  And it's not much less clear either!  (See [Tk Performance] for other tips and tricks.)

----
 ##+##########################################################################
 #
 # RainStorm.tcl - Simulates rain drops on a window
 # by Keith Vetter, May 2, 2003
 # reworked for performance by Donal K. Fellows, Sept 16, 2003
 #
 ##+##########################################################################
 #############################################################################

 package require Tk

 # Initial configuration
 array set S {
     delay 80
     rain 3
     id 0
 }
 array set R {saved {}}
 array set SIZES {0 1  1 2  2 4  3 6  4 8  5 10  6 12  7 14  8 16}
 array set DROPS {
     0 {Mist		500}
     1 {Sprinkles	200}
     2 {Shower		100}
     3 {Rain		50}
     4 {Storm		25}
     5 {Down\ Pour	10}
     6 {Deluge		1}
 }

 # Create the GUI itself...
 wm title . "Rain Storm"
 canvas .c -relief raised -borderwidth 0 -height 500 -width 500
 scale .rain -orient h -variable S(rain) -command Rain -showvalue 0 -from 0 -to 6
 image create photo ::img::blank -width 1 -height 1
 button .about -image ::img::blank -highlightthickness 0 -command [list \
	 tk_messageBox -message "Rain Storm\nby Keith Vetter, May 2003"]
 pack .c -side top -fill both -expand 1
 place .rain -in .c -relx 1 -rely 1 -anchor se
 place .about -in .c -relx 1 -rely 1 -anchor se
 bind all <Alt-c> {console show}

 # Raindrop creation loop
 proc Rain {args} {
     global DROPS S R
     after cancel Rain
     .rain config -label [lindex $DROPS($S(rain)) 0]

     # Set a new raindrop in motion
     # Note that we reuse old raindrops to save memory
     set id [lindex $R(saved) 0]
     set R(saved) [lrange $R(saved) 1 end]
     if {$id eq ""} {
	 # All currently allocated raindrops on the canvas already, so
	 # make a new one
	 set id [incr S(id)]
	 set R($id,item) [.c create oval -1 -1 -2 -2]
     }

     set R($id,x) [expr {round([winfo width .c] * rand())}]
     set R($id,y) [expr {round([winfo height .c] * rand())}]
     set R($id,step) -1
     lappend R(ids) $id

     after [lindex $DROPS($S(rain)) 1] Rain
 }

 # Raindrop animation loop (much faster than having individually animated
 # drops since this encourages a single redraw-per-loop)
 proc Drops {} {
     global R S SIZES
     set newids {}
     foreach id $R(ids) {
	 set n [incr R($id,step)]
	 if {! [info exists SIZES($n)]} {
             # We're done with this drop; make invisible and save for reuse
	     .c coords $R($id,item) {-1 -1 -2 -2}
	     lappend R(saved) $id
	 } else {
	     .c coords $R($id,item) [box $R($id,x) $R($id,y) $SIZES($n)]
             # Add to list of ids to animate next time round
	     lappend newids $id
	 }
     }
     set R(ids) $newids
     after $S(delay) Drops
 }

 # Helper proc
 proc box {x y r} {
     return [list [expr {$x-$r}] [expr {$y-$r}] [expr {$x+$r}] [expr {$y+$r}]]
 }

 # Set the creator and animator loops going
 Rain;Drops
----
[Category Application] | [Category Graphics] | [Category Whizzlet] | [Category Animation]