package require Tk

proc start {} {
    .c delete all
    foreach a [after info] {after cancel $a}
    after idle Rain
}

proc Rain {} {
    .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 [list after idle [list 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)] \
            [list after idle [list RainDrop $id]]
    }
}

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

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 start ;#\ } -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}
pack [checkbutton .mode -variable MODE -command {start}] -anc nw