## Bouncing Balls
## Ed Suominen -- dedicated to the public domain
package require Tk

## Procs
proc rcolor { colorList } {
    return [lindex $colorList \
                [expr { int(rand()*[llength $colorList]) }] ]
}

wm withdraw .

## Configuration
set width 600
set height 500
set radius 20
set colorList {red blue yellow white orange green}

## CANVAS SETUP
destroy .canvas
set w [toplevel .canvas]
set m [label $w.m]
set c [canvas $w.c -bg gray -width $width -height $height]
pack $m $c -side top
$m configure -text "Bouncing Balls"

bind $c left { puts left }

## Item Setup
catch {unset itemList}
for { set itemCount 0 } { $itemCount < 10 } { incr itemCount } {
    set handle [$c create oval \
                    [expr {$width/2-$radius}] \
                    [expr {$height/2-$radius}] \
                    [expr {$width/2+$radius}] \
                    [expr {$height/2+$radius}] \
                    -fill [rcolor $colorList] \
                    -outline black]
    set DX($handle) [expr { (rand()-0.5)*10 }]
    set DY($handle) [expr { (rand()-0.5)*10 }]
    lappend itemList $handle
}

set script {
    foreach oval $itemList {
        $c move $oval $DX($oval) $DY($oval)
        foreach i {xmin ymin xmax ymax} j [$c coords $oval] {
            set $i $j
        }
        if { $xmax > $width || $xmin < 0 } {
            set DX($oval) [expr { -$DX($oval) }]
        }
        if { $ymax > $height || $ymin < 0 } {
            set DY($oval) [expr { -$DY($oval) }]
        }
    }
    after 25 { eval $script }
}

eval $script