Rain Storm

Description

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

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 <smile>...

##+##########################################################################
#
# 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 <Alt-c> {console show}


# Set the creator and animator loops going
Rain
Drops