Version 24 of Colliding balls

Updated 2003-04-12 20:12:12

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, and two bug fixes.


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
 #   mods by Jeff Hobbs just to brace expr's (improve speed)
 #   and clean up some foreach usage
 #

 package require Tk

 #
 # Return an entry from the list at random
 #
 proc randFromList {inputList} {
     return [lindex $inputList [expr {int(rand() * [llength $inputList])}]]
 }

 #
 # 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) {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) {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) {x2 y2} $State(pos,$tag2) {}
     }

     # 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

     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 ]