## 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
David Easton: See Colliding balls for a similar example in which the balls collide with each other.Ed Suominen: David's example is well worth a look. It uses some pretty advanced calculations to create a very realistic simulation.
