''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. ---- [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 ---- ''[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. It would be more natural to include the material directly on this page but this would breake ''reapability'' of the original code (see [wish-reaper] or [wiki-reaper] for details). ---- [[ [Category Graphics] | [Category Animation] ]]