''[LH] 3 Apr 2003'' - This is a minor improvement of [Colliding Balls] by David Easton. Devoting a separate page for this material is not meant to suggest any special importance of what follows. The real reason is not to breake ''reapability'' of the original code (see [wish-reaper] or [wiki-reaper] for an explanation). ---- The calculations in ''postColVels'' can be simplified as follows: proc postColVels {u1 u2 m1 m2} { set u [expr {2*($m1*$u1+$m2*$u2)/($m1+$m2)}] list [expr {$u-$u1}] [expr {$u-$u2}] } In ''collide'', one can do without the fragment # Always call the ball on the right (2) and the one on the left (1) ... by changing # If they are not going towards each other, then they will not collide if { $uparr2 > $uparr1 } { return } to # 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 } In ''collide'', the angle of the collision axis is computed by set diffX [expr 1.0 * ($x2 - $x1)] set diffY [expr 1.0 * ($y2 - $y1)] set phi [expr atan ($diffY / $diffX)] Unfortunately, ''phi'' is undefined if ''diffX'' is zero. A correct version: if { $x1 != $x2 } { set phi [expr {atan(double($y2-$y1)/double($x2-$x1))}] } else { set phi [expr {asin(1)}] ;# 90 degrees } In ''checkForCollision'', an infinite loop is possible. This is quite a subtle bug that manifests rather rarely. Details below. The following code is used to find other balls that overlap with the given ''tag'' ball: 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 } { ... set id [$State(canvas) find closest $ourX $ourY $State(rad,$tag) $id] } Unfortunately, the loop does not always terminate. This is caused by the line foreach {ourX ourY} $State(pos,$tag) {} that is supposed to compute the center point of the ''tag'' ball. The problem is that the ''tag'' ball has been moved on canvas by its velocity vector (in ''moveBalls'') without updating the ''State(pos,$tag)'', so its real center is somewhere else. Delaying the update of ''State(pos,$tag)'' is done on purpose, so we cannot simply correct ''moveBalls''. We should rather compute the real center point. For example, foreach {x1 y1 x2 y2} [$State(canvas) coords $tag] break set ourX' [expr {($x1+$x2)/2.0}] set ourY' [expr {($y1+$y2)/2.0}] In most circumstances the points (''ourX'',''ourY'') and (''ourX''',''ourY''') are very close and the difference has no visible effects during animation. However, if (''ourX'',''ourY'') happens to be outside the ''tag'' ball and close to another ball, say B, then ''find closest'' statement will constantly return B. As a consequence, the loop's guard will stay true forever (or rather till we kill Colliding Balls). The following version of ''checkForCollision'' seems to be correct: 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 } Also, it is easy to add some configurable parameters that control the number of balls, their sizes, colours and velocities. For details, have a look at [Colliding Coins].