#
# Exploding Balls
# Based on Colliding Balls by David Easton.
# Author: David Easton
# mods by Jeff Hobbs just to brace expr's (improve speed)
# and clean up some foreach usage
# mods by Peter da Silva: fix collision logic, add gravity, friction,
# elasticity, make FPS a constant, and smooth refresh.
# more mods by Peter da Silva: Incorporate some of LH's changes.
# Add a bunch of parameters. And make balls fade away if
# ignored, or swell and burst when poked.
# and post-wiki mods: make mass a function of r^3. Little balls SHOULD
# shoot up high!
#
package require Tk
# Set frames per second (if much less than 20, it's not very smooth)
set State(fps) 20.0
# Set gravity - 9.8 pixels per second per second
set State(gravity) 9.8
# Set friction - 10% of velocity per second
set State(friction) 0.1
# Set elasticity - 95%
set State(bounce) 0.95
#set State(bounce,walls) 0.80
set State(bounce,balls) 1.05
# How much do balls expand when they hit
set State(grow) 1.01
# How much do balls shrink when left alone, per second
set State(shrink) 0.025
# Size of balls
set State(minSize) 20
set State(maxSize) 50
# # balls
set State(balls) 8
# Color palette for balls
# set State(colours) {
# red yellow darkgreen green blue lightblue orange pink purple white
# }
for {set r 63} {$r < 256} {incr r 16} {
for {set g 63} {$g < 256} {incr g 16} {
for {set b 63} {$b < 256} {incr b 16} {
lappend State(colours) [format #%02X%02X%02X $r $g $b]
}
}
}
#
# Fade color as fraction
#
proc fade {colour level {target white}} {
global rgb
global divideColors
if ![info exists rgb($colour)] {
set rgb($colour) [winfo rgb . $colour]
}
if ![info exists rgb($target)] {
set rgb($target) [winfo rgb . $target]
}
if ![info exists divideColors] {
if ![info exists rgb(white)] {
set rgb(white) [winfo rgb . white]
}
set divideColors [expr {[lindex $rgb(white)] > 255}]
}
if {$level > 1.0} {
set level 1.0
} elseif {$level < 0.0} {
set level 0.0
}
set new "#"
foreach c $rgb($colour) t $rgb($target) {
if {$divideColors} {
set c [expr {$c / 256}]
set t [expr {$t / 256}]
}
append new [format %02X [expr {int($c * $level + $t * (1 - $level))}]]
}
return $new
}
#
# Return an entry from the list at random
#
proc randFromList {inputList} {
return [lindex $inputList [expr {int(rand() * [llength $inputList])}]]
}
#
# Given the initial velocities and radii
# calculates velocities following a collision
#
proc postColVels {u1 u2 r1 r2} {
set m1 [expr {$r1*$r1*$r1}]
set m2 [expr {$r2*$r2*$r2}]
set u [expr {2*($m1*$u1+$m2*$u2)/($m1+$m2)}]
list [expr {$u-$u1}] [expr {$u-$u2}]
}
proc createBall { tag {init 1}} {
global State
set radius [expr {int(($State(sizeRange) * rand()) + $State(minSize))}]
set diam [expr {2 * $radius}]
set canvasHeight [winfo height $State(canvas)]
set canvasWidth [winfo width $State(canvas)]
set xpos [expr {$radius + int(($canvasWidth - $diam) * rand())}]
if {$init} {
set ypos [expr {$radius + int(($canvasHeight - $diam) * rand())}]
} else {
set ypos $diam
}
set x1 [expr {$xpos - $radius}]
set x2 [expr {$xpos + $radius}]
set y1 [expr {$ypos - $radius}]
set y2 [expr {$ypos + $radius}]
# Random colour
set colour [randFromList $State(colours)]
set border [randFromList $State(colours)]
set width [expr {(rand() + 0.5) * (($radius * 4.0) / $State(minSize))}]
# Now create or configure ball
if {$init} {
set id [$State(canvas) create oval $x1 $y1 $x2 $y2 \
-outline $border -fill $colour -width $width \
-tags [list $tag ball]]
set State(id2tag,$id) $tag
set State(tag2id,$tag) $id
set xvel [expr {(rand() * 8.0) -2}]
set yvel [expr {(rand() * 8.0) -2}]
} else {
set id $State(tag2id,$tag)
$State(canvas) coords $id $x1 $y1 $x2 $y2
$State(canvas) itemconfigure $id \
-fill $colour -outline $border -width $width
set xvel [expr {(rand() * 8.0) -4}]
set yvel [expr {(rand() * 4.0)}]
}
set State(vel,$tag) [list $xvel $yvel]
set State(rad,$tag) $radius
set State(col,$tag) $colour
set State(bdr,$tag) $border
set State(wid,$tag) $width
}
#
# Check if we have collided with another ball
#
# Returns: 1 - If there was a collision
# 0 - If no collision
#
proc checkForCollision { tag } {
global State
set c $State(canvas)
set r $State(rad,$tag)
foreach { x1 y1 x2 y2 } [$c coords $tag] break
set x [expr {($x1+$x2)/2.0}]
set y [expr {($y1+$y2)/2.0}]
set overlapList [list]
set id [set ourId [$c find withtag $tag]]
$c raise $tag ;# not sure whether really needed
while { [set id [$c find closest $x $y $r $id]] != $ourId } {
lappend overlapList $id
}
if { [llength $overlapList] > 0 } {
foreach id $overlapList {
collide $tag $State(id2tag,$id)
}
return 1
}
return 0
}
proc moveBalls { } {
global State
global hot
# Cancel any "lost" frames
if [info exists State(id)] {
after cancel $State(id)
}
# Reschedule at the beginning to keep updates smooth
set State(id) [after $State(delay) moveBalls]
set canvasHeight [winfo height $State(canvas)]
set canvasWidth [winfo width $State(canvas)]
foreach ball $State(ballList) {
foreach {xvel yvel} $State(vel,$ball) {}
if {[info exists State(gravity)]} {
set yvel [expr {$yvel + $State(gravity)}]
}
if {[info exists State(friction)]} {
set yvel [expr {$yvel * (1.0 - $State(friction))}]
set xvel [expr {$xvel * (1.0 - $State(friction))}]
}
$State(canvas) move $ball $xvel $yvel
# Bounce off the edges
foreach {x1 y1 x2 y2} [$State(canvas) bbox $ball] {}
# Has something moved us through the wall?
if {$x2 < 0 || $x1 > $canvasWidth || $y2 < 0 || $y1 > $canvasHeight} {
lappend reanimate $ball
}
# Left edge
if { $x1 < 0 && $xvel < 0} {
set xvel [expr {-$State(bounce,walls) * $xvel}]
}
# Right edge
if { $x2 > $canvasWidth && $xvel > 0} {
set xvel [expr {-$State(bounce,walls) * $xvel}]
}
# Top edge
if { $y1 < 0 && $yvel < 0} {
set yvel [expr {-$State(bounce,walls) * $yvel}]
}
# Bottom edge
if { $y2 > $canvasHeight && $yvel > 0} {
if {[info exists State(gravity)]} {
if {
$State(shrink) == 1.0 &&
$yvel < $State(gravity) &&
abs($xvel) < $State(gravity)
} {
lappend reanimate $ball
}
# Make the bottom border a bit tougher if we have gravity, OK?
$State(canvas) move $ball 0 [expr {$canvasHeight - $y2}]
}
set yvel [expr {-$State(bounce,walls) * $yvel}]
}
# Update for new velocity
set State(vel,$ball) [list $xvel $yvel]
# If haven't collided with anyone, shrink
if {![checkForCollision $ball] && [info exists State(shrink)]} {
set r [expr {$State(rad,$ball) * $State(shrink)}]
set State(rad,$ball) $r
if {$r < $State(minSize)} {
set fade [expr {$r / $State(minSize)}]
if {$fade < 0.5} {
lappend reanimate $ball
} else {
set fade [expr {2.0 * $fade - 1.0}]
$State(canvas) itemconfigure $ball \
-fill [fade $State(col,$ball) $fade] \
-outline [fade $State(bdr,$ball) $fade] \
-width [expr {$State(wid,$ball) * $fade}]
}
}
set xpos [expr {($x1 + $x2) / 2}]
set ypos [expr {($y1 + $y2) / 2}]
$State(canvas) scale $ball $xpos $ypos $State(shrink) $State(shrink)
} else {
set r $State(rad,$ball)
}
if {$r > $State(maxSize)} {
set hot($ball) 1
} elseif {[info exists hot($ball)]} {
set hot($ball) 0
}
if {[info exists hot($ball)]} {
if {!$hot($ball)} {
unset hot($ball)
}
set fade [expr {$r / $State(maxSize)}]
if {$fade > 2.0} {
lappend reanimate $ball
} else {
set fade [expr {2.0 - $fade}]
$State(canvas) itemconfigure $ball \
-fill [fade $State(col,$ball) $fade red] \
-outline [fade $State(bdr,$ball) $fade red] \
-width [expr {$State(wid,$ball) * (2.0 - $fade)}]
}
}
}
# Reanimate one ball per frame
if [info exists reanimate] {
createBall [lindex $reanimate 0] 0
}
}
proc collide { tag1 tag2 } {
global State
# Calculate position of balls (don't track them because of rounding error)
foreach {bx1 by1 bx2 by2} [$State(canvas) coords $tag1] break
set x1 [expr {($bx1 + $bx2) / 2}]
set y1 [expr {($by1 + $by2) / 2}]
foreach {bx1 by1 bx2 by2} [$State(canvas) coords $tag2] break
set x2 [expr {($bx1 + $bx2) / 2}]
set y2 [expr {($by1 + $by2) / 2}]
# Get velocity of each ball
foreach {ux1 uy1} $State(vel,$tag1) {ux2 uy2} $State(vel,$tag2) {}
# Work out the angle along the axis of collision
if { $x1 != $x2 } {
set phi [expr {atan(double($y2-$y1)/double($x2-$x1))}]
} else {
set phi [expr {asin(1)}] ;# 90 degrees
}
# Now work out the velocity parallel and perpendicular
set uparr1 [
expr {(($ux1 * cos($phi)) + ($uy1 * sin($phi))) * $State(bounce,balls)}
]
set uperp1 [expr {($ux1 * sin($phi)) - ($uy1 * cos($phi))}]
set uparr2 [
expr {(($ux2 * cos($phi)) + ($uy2 * sin($phi))) * $State(bounce,balls)}
]
set uperp2 [expr {($ux2 * sin($phi)) - ($uy2 * cos($phi))}]
# If they are not going towards each other, then they will not collide
if { $x1 != $x2 } {
if { $x1<$x2 && $uparr2>$uparr1 || $x1>$x2 && $uparr2<$uparr1 } return
} else {
if { $y1<$y2 && $uparr2>$uparr1 || $y1>$y2 && $uparr2<$uparr1 } return
}
foreach {vparr1 vparr2} [
postColVels $uparr1 $uparr2 $State(rad,$tag1) $State(rad,$tag2)
] break
# Perpendicular velocites are unchanged
set vperp1 $uperp1
set vperp2 $uperp2
# Now convert back into x and y movements
set vx1 [expr {($vparr1 * cos($phi)) + ($vperp1 * sin($phi))}]
set vy1 [expr {($vparr1 * sin($phi)) - ($vperp1 * cos($phi))}]
set vx2 [expr {($vparr2 * cos($phi)) + ($vperp2 * sin($phi))}]
set vy2 [expr {($vparr2 * sin($phi)) - ($vperp2 * cos($phi))}]
# Update for new velocities
set State(vel,$tag1) [list $vx1 $vy1]
set State(vel,$tag2) [list $vx2 $vy2]
# If growing, grow
if [info exists State(grow)] {
set State(rad,$tag1) [expr {$State(rad,$tag1) * $State(grow)}]
$State(canvas) scale $tag1 $x1 $y1 $State(grow) $State(grow)
set State(rad,$tag2) [expr {$State(rad,$tag2) * $State(grow)}]
$State(canvas) scale $tag2 $x2 $y2 $State(grow) $State(grow)
}
}
# Seed random number generator
expr {srand([clock clicks])}
# Window things
wm title . "Bouncing balls"
# Create canvas
set State(canvas) [canvas .c -width 500 -height 400]
pack $State(canvas) -fill both -expand true
# Set delay to 1000, will be scaled by fps
set State(delay) 1000
# Some variables scale by frame rate
foreach v {gravity friction delay shrink} {
if [info exists State($v)] {
set State($v) [expr {$State($v) / $State(fps)}]
}
}
# If FPS is real low, increase grow rate.
if {[info exists $State(grow)] && $State(fps) < 20.0} {
set State(grow) [expr {1 + ($State(grow) - 1.0) * 20.0 / $State(fps)}]
}
# delay is an integer
set State(delay) [expr {int($State(delay))}]
# Convert shrink to ratio
if [info exists State(shrink)] {
set State(shrink) [expr {1 - $State(shrink)}]
}
# Calculate size range
set State(sizeRange) [expr {$State(maxSize) - $State(minSize)}]
# Set missing elasticity values
foreach object {balls walls} {
if ![info exists State(bounce,$object)] {
if [info exists State(bounce)] {
set State(bounce,$object) $State(bounce)
} else {
set State(bounce,$object) 1.0
}
}
}
update
# Create balls
for {set i 0} {$i < $State(balls)} {incr i} {
lappend State(ballList) ball$i
createBall ball$i
}
moveBallsuniquename 2014jan27For those who do not have the facilities or time to implement the code above, here is an image that shows the balls that are bouncing off of the walls and off of each other.
