''David Easton: 17 Mar 2003'' [Bouncing Balls] inspired me to post a little application I wrote to show balls that bounce off each other as well as the edges of the canvas.

''Ed Suominen: 25 Mar 2003'' This is great! There are some pretty advanced calculations going on here.

''David Easton: 26 Mar 2003'' Thanks! The calculations used by ''postColVels'' come from  conservation of energy and momentum. ''colide'' resolves velocities parallel and perpendicular to the collision.  Thus, this should be a fairly accurate simulation.

''[LH]: 3 Apr 2003'' - Consult [An Improvement to Colliding Balls] if interested in simpler calculations to find post-collision velocities. Also, two bugs are corrected there.

----
[NEM] - I have been inspired by this, and a conversation in the chatroom, to create the start of a small pool/snooker/billiards game, which I have called [TkPool].

----
 #
 # Colliding Balls
 # Author: David Easton
 #

 package require Tk

 #
 # Return an entry from the list at random
 #
 proc randFromList { inputList } {

     set index [expr int(rand() * [llength $inputList])]
     return [lindex $inputList $index]
 }

 #
 # Given the initial velocities and masses
 # calculates velocities following a collision
 #
 proc postColVels { u1 u2 m1 m2 } {

     # No collision if u2 > u1
     if { $u2 > $u1 } {
         return [list $u1 $u2]
     }

     set u1 [expr 1.0 * $u1]
     set u2 [expr 1.0 * $u2]
     set m1 [expr 1.0 * $m1]
     set m2 [expr 1.0 * $m2]

     set M [expr $m1 / $m2]

     set b [expr ($M * $u1) + $u2]
     set c [expr ($M * $u1 * $u1) + ($u2 * $u2)]

     set q [expr 2 * $M * $b]
     set p [expr 4 * $M * $M * $b * $b]
     set r [expr 4 * ($M + ($M * $M)) * (($b * $b) - $c)]
     set s [expr 2 * ($M + ($M * $M))]

     if { $r > $p } {
         "No solution"
     } else {

         set root [expr sqrt($p -$r)]

 #        set v1(1) [expr ($q + $root) / $s]
         set v1(2) [expr ($q - $root) / $s]

 #        set v2(1) [expr $b - ($M * $v1(1))]
         set v2(2) [expr $b - ($M * $v1(2))]

         # v2 should always be greater than v1
         # which means the answer is always v1(2) and v2(2)

         return [list $v1(2) $v2(2)]
     }
 }

 proc createBall { tag } {

     global State

     set radius [expr int((30 * rand()) + 20)]
     set diam   [expr 2 * $radius]
     # Mass is proportional to area
     set mass   [expr $radius * $radius]

     set canvasHeight [winfo height $State(canvas)]
     set canvasWidth  [winfo width $State(canvas)]

     set xpos [expr $radius + int(($canvasWidth - $diam) * rand())]
     set ypos [expr $radius + int(($canvasHeight - $diam) * rand())]

     set x1 [expr $xpos - $radius]
     set x2 [expr $xpos + $radius]
     set y1 [expr $ypos - $radius]
     set y2 [expr $ypos + $radius]

     # Random colour
     set colList [list red yellow darkgreen green blue lightblue orange pink purple white]
     set colour [randFromList $colList]

     # Now create ball
     set id [$State(canvas) create oval $x1 $y1 $x2 $y2 -outline black -fill $colour -tags [list $tag ball]]

     set State(id2tag,$id) $tag

     set xvel [expr (rand() * 8.0) -2]
     set yvel [expr (rand() * 8.0) -2]

     set State(pos,$tag) [list $xpos $ypos]
     set State(vel,$tag) [list $xvel $yvel]
     set State(rad,$tag) $radius
     set State(mass,$tag) $mass
 }

 #
 # 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 didCollide 0

     set overlapList {}

     foreach {ourX ourY} $State(pos,$tag) {}

     set ourId [$State(canvas) find withtag $tag]

     set id [$State(canvas) find closest $ourX $ourY $State(rad,$tag) $ourId]

     while { $id != $ourId } {

         if { [lsearch -glob [$State(canvas) gettags $id] "ball*"] > -1 } {

             set didCollide 1
             lappend overlapList $id
         }
         set id [$State(canvas) find closest $ourX $ourY $State(rad,$tag) $id]
     }

     if { [llength $overlapList] > 0 } {

         foreach id $overlapList {

             collide $tag $State(id2tag,$id)
         }
     }

     return $didCollide
 }

 proc moveBalls { } {

     global State

     set canvasHeight [winfo height $State(canvas)]
     set canvasWidth  [winfo width $State(canvas)]

     foreach ball $State(ballList) {

         foreach {xpos ypos} $State(pos,$ball) {}
         foreach {xvel yvel} $State(vel,$ball) {}

         set xpos [expr $xpos + $xvel]
         set ypos [expr $ypos + $yvel]

         $State(canvas) move $ball $xvel $yvel

         # Bounce off the edges

         foreach {x1 y1 x2 y2} [$State(canvas) bbox $ball] {}

         # Left edge
         if { $x1 < 0 && $xvel < 0} {
             set xvel [expr -1.0 * $xvel]
         }
         if { $x2 > $canvasWidth && $xvel > 0} {
             set xvel [expr -1.0 * $xvel]
         }
         if { $y1 < 0 && $yvel < 0} {
             set yvel [expr -1.0 * $yvel]
         }
         if { $y2 > $canvasHeight && $yvel > 0} {
             set yvel [expr -1.0 * $yvel]
         }

         if {[checkForCollision $ball]} {

             # Collided
             set State(pos,$ball) [list $xpos $ypos]

         } else {

             # Update for new position and velocity

             set State(pos,$ball) [list $xpos $ypos]
             set State(vel,$ball) [list $xvel $yvel]
         }
     }

     after 50 moveBalls
 }

 proc collide { tag1 tag2 } {

     global State

     # Get position of each ball

     foreach {x1 y1} $State(pos,$tag1) {}
     foreach {x2 y2} $State(pos,$tag2) {}

     # Always call the ball on the right (2) and the one on the left (1)

     if { $x1 > $x2 } {

         set temp $tag2
         set tag2 $tag1
         set tag1 $temp

         # Get position of each ball

         foreach {x1 y1} $State(pos,$tag1) {}
         foreach {x2 y2} $State(pos,$tag2) {}
     }

     # Get velocity of each ball
    
     foreach {ux1 uy1} $State(vel,$tag1) {}
     foreach {ux2 uy2} $State(vel,$tag2) {}

     # Work out the angle along the axis of collision
    
     set diffX [expr 1.0 * ($x2 - $x1)]
     set diffY [expr 1.0 * ($y2 - $y1)]

     set phi [expr atan ($diffY / $diffX)]

     # Now work out the velocity parallel and perpendicular
    
     set uparr1 [expr ($ux1 * cos($phi)) + ($uy1 * sin($phi))]
     set uperp1 [expr ($ux1 * sin($phi)) - ($uy1 * cos($phi))]

     set uparr2 [expr ($ux2 * cos($phi)) + ($uy2 * sin($phi))]
     set uperp2 [expr ($ux2 * sin($phi)) - ($uy2 * cos($phi))]

     # If they are not going towards each other, then they will not collide
     if { $uparr2 > $uparr1 } {
         return
     }

     set mass1 $State(mass,$tag1)
     set mass2 $State(mass,$tag2)

     foreach {vparr1 vparr2} [postColVels $uparr1 $uparr2 $mass1 $mass2] {}

     # 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]
 }

 # 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

 update

 # Create balls
 set State(ballList) [list ball1 ball2 ball3 ball4 ball5 ball6 ball7 ball8]

 foreach ball $State(ballList) {

     createBall $ball
 }

 moveBalls

----
[[
[Category Graphics]
|
[Category Animation]
]]