** Description ** [Keith Vetter] 2003-05-04 : a simple little whizzlet simulating rain drops on a window. Much like the old unix game rain. [http://tcl.tk/starkits/rainstorm.jpg] A [starkit] version of this code is available on [sdarchive]. ** Changes ** ---- [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.) [PWQ]: Can you elaborate, I found that using -fill {} and -outline {} when changing the effect to exacerbate the problem. The major leak seems to be tags. On my machine I get major pauses which I suspect are hash resizing for the tags. BTW I have another version here [Rain Storm - Take 2] [DKF]: Yeah, what I did was I basically removed all use of tags and implemented a mechanism for reusing items. And then I coupled that with limiting the number of events going on (i.e. common code for animating all raindrops instead of each drop evolving independently) to get things really motoring. Having everything evolving independently is all very well when you've only got small numbers of items (e.g. a score or so :^) but you get a lot more redraws if you do, and that can hit very heavily (the drawing code - whose running is usually concealed within the Tk event model - is not all that fast.) ---- Hmm - I wonder if sound effects (sound of drops hitting glass and occasional thunder) will appear next ... ====== ##+########################################################################## # # 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 # 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] [list after idle 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) [list after idle Drops] } # Helper proc proc box {x y r} { return [list [expr {$x-$r}] [expr {$y-$r}] [expr {$x+$r}] [expr {$y+$r}]] } # 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 {console show} # Set the creator and animator loops going Rain Drops ====== <> Application | Graphics | Whizzlet | Animation