[PWQ] 17 Sep 2003, My version of [Rain Storm] which I coded up to see why the original version leaked memory (big time!) ---- package require Tk set S(delay) 80 set S(rain) 3 set S(id) 0 set MODE 1 array set SIZES {0 1 1 2 2 4 3 6 4 8 5 10 6 12 7 14 8 20} set COUNT {10 20 30 60 100 230 400} foreach {i x} [array get SIZES] { lappend new $i [expr $x * 1.5] } for {set i 5} {$i < 20 } {incr i 1} { lappend new $i [expr $i * 1.5 ] } array set SIZES $new set n [llength [array names SIZES]] for { set i 0 } {$i < $n } {incr i} { set x E[format %1x [expr {15 * $i / $n}]] set COLOUR([expr $n - $i -1]) #$x$x$x } 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}} wm protocol . WM_DELETE_WINDOW exit wm title . "Rain Storm" canvas .c -relief raised -borderwidth 0 -height 500 -width 500 -bg #E0E0E0 scale .rain -orient h -variable S(rain) -command {after idle 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} pack [checkbutton .mode -variable MODE -command {Rain 0}] -anc nw proc Rain {num} { .c delete all foreach a [after info] {after cancel $a} update .rain config -label [lindex $::DROPS($::S(rain)) 0] set max [lindex $::COUNT $::S(rain)] set ::S(rand) 0.6 if { $max > 50 } {set ::S(rand) 0.75} if { $max > 100 } {set ::S(rand) 0.8} if { $max > 200 } {set ::S(rand) 0.9} if { $max > 300 } {set ::S(rand) 0.95} for {set i 0} {$i < $max } {incr i} { #update set x [expr {round([winfo width .c] * rand())}] set y [expr {round([winfo height .c] * rand())}] if { $::MODE } { set id [.c create oval [box $x $y 0] -fill #e0e0e0 -outline {}] } else { set id [.c create oval [box $x $y 0] -outline #e0e0e0 -fill {} ] #set id [.c create oval [box $x $y 0] -fill red -outline {}] } SetDrop $id } } proc SetDrop {id} { set x [expr {round([winfo width .c] * rand())}] set y [expr {round([winfo height .c] * rand())}] .c raise $id .c coords $id $x $y $x $y #.c itemconfig $id -tag [expr $::S(rain) -1] .c itemconfig $id -tag -1 set d [lindex $::DROPS($::S(rain)) 1] set d [expr {int(rand() * 100 + $d)}] after $d RainDrop $id } proc RainDrop {id} { set t1 [clock clicks -milli] set n [lindex [.c gettags $id] 0] ;# Trash current if {$n == ""} {return} ; # I've been deleted incr n #puts "$id -> $n" if {! [info exists ::SIZES($n)] || rand() > $::S(rand)} { after idle SetDrop $id } else { set x1 "" foreach {x1 y1 x2 y2} [.c coords $id] {} if {$x1 == "" } {return} set x [expr {($x2 + $x1) / 2}] set y [expr {($y2 + $y1) / 2}] .c coords $id [box $x $y $::SIZES($n)] if {$::MODE} { .c itemconfig $id -fill $::COLOUR($n) } else { .c itemconfig $id -outline $::COLOUR($n) -width [expr $n / 3] } .c itemconfig $id -tag $n set time [expr {([clock clicks -milli] - $t1)}] after [expr int(($time > $::S(delay) ? $time : $::S(delay)) + rand() * 3)] RainDrop $id if { $::S(rain) > 3 } { update idletasks } } } proc box {x y r} { list [expr {$x-$r}] [expr {$y-$r}] [expr {$x+$r}] [expr {$y+$r}] } ---- [Category Application] | [Category Graphics] | [Category Whizzlet] | [Category Animation]