''[LH] 3 Apr 2003'' - The saga continues: first [Bouncing Balls], then [Colliding Balls], and now [Colliding Coins].

This is a minor improvement of [Colliding Balls] by David Easton. Simpler calculations to find post-collision velocities, and two bugs corrected. Details at [An Improvement to Colliding Balls]. All credit goes to David, but blame ''me'' for all remaining bugs.

Why the name Colliding Coins? First, I had to ''coin'' some new title :) Second, the balls in David's version seem to be rather flat (their mass is proportional to area and not volume).

''David Easton 12 Sept 2003'' Merging with the [Spheres] code gives [Colliding Spheres].

 #
 # Colliding Coins by Leszek Holenderski, http://wiki.tcl.tk/8709
 # Based on Colliding Balls by David Easton, http://wiki.tcl.tk/8573
 #
 package require Tk
 
 # configurable parameters
 #
 set canvasWidth  600 ;# in pixels
 set canvasHeight 500 ;# in pixels
 set numOfCoins    20
 set minRadius     10 ;# in pixels
 set maxRadius     40 ;# in pixels
 set maxVelocity    5 ;# in pixels, per one animation step
 set delay         20 ;# in milliseconds, per one animation step
 
 set colours [list red yellow green blue white gray50 darkgreen black]
 
 # coins are identified by their canvas id, and not special tags
 #
 proc createCoin {} {
   # pick random radius and colour
   set r [expr {$::minRadius+int(rand()*($::maxRadius-$::minRadius))}]
   set c [lindex $::colours [expr {int(rand()*[llength $::colours])}]]
 
   # to simulate Big Bang, all coins are created in the canvas' center
   set x [expr {$::canvasWidth/2.0}]
   set y [expr {$::canvasHeight/2.0}]
   set coin [$::canvas create oval \
                       [expr $x-$r] [expr $y-$r] [expr $x+$r] [expr $y+$r] \
                       -outline "" -fill $c]
 
   # pick random velocity
   set u [expr {$::maxVelocity*(2*rand()-1)}]
   set v [expr {$::maxVelocity*(2*rand()-1)}]
 
   # store coin's attributes
   global State
   set State($coin,pos)  [list $x $y]
   set State($coin,vel)  [list $u $v]
   set State($coin,mass) [expr {double($r*$r)}] ;# mass ~ area
 
   return [list $coin $r]
 }
 
 # collide a given coin with all other coins that overlap with it
 #
 proc collide {coin radius} {
   # find coin's center
   foreach {x1 y1 x2 y2} [$::canvas coords $coin] break
   set x [expr {($x1+$x2)/2.0}]
   set y [expr {($y1+$y2)/2.0}]
 
   # find other coins that overlap with the given coin
   set overlap [list]
   $::canvas raise $coin ;# not sure if really needed
   set next $coin
   while {[set next [$::canvas find closest $x $y $radius $next]] != $coin} {
     lappend overlap $next
   }
 
   # collide the given coin with other coins
   foreach other $overlap { collideCoins $coin $other }
 }
 
 # recalculate velocities after collision
 #
 proc collideCoins {coin1 coin2} {
   global State
 
   # get positions and velocities of each coin
   foreach {x1 y1} $State($coin1,pos) break
   foreach {x2 y2} $State($coin2,pos) break
   foreach {u1 v1} $State($coin1,vel) break
   foreach {u2 v2} $State($coin2,vel) break
 
   # compute the angle of the collision axis
   if { $x1 != $x2 } {
     set phi [expr {atan(double($y2-$y1)/double($x2-$x1))}]
   } else {
     set phi [expr {asin(1)}] ;# 90 degrees
   }
   set sin [expr {sin($phi)}]
   set cos [expr {cos($phi)}]
 
   # project velocities on the axis of collision
   # (i.e., get the parallel and perpendicular components)
   set par1 [expr {$u1*$cos + $v1*$sin}]
   set per1 [expr {$u1*$sin - $v1*$cos}]
   set par2 [expr {$u2*$cos + $v2*$sin}]
   set per2 [expr {$u2*$sin - $v2*$cos}]
 
   # return if the coins are not going towards each other
   if { $x1 != $x2 } {
     if { $x1<$x2 && $par2>$par1 || $x1>$x2 && $par2<$par1 } return
   } else {
     if { $y1<$y2 && $par2>$par1 || $y1>$y2 && $par2<$par1 } return
   }
 
   # compute parallel velocities after collision
   # (note that perpendicular velocities do not change)
   set m1 $State($coin1,mass)
   set m2 $State($coin2,mass)
   set v [expr {2*($m1*$par1+$m2*$par2)/($m1+$m2)}]
   set par1 [expr {$v-$par1}]
   set par2 [expr {$v-$par2}]
 
   # convert new velocities back to x and y coordinates
   set u1 [expr {$par1*$cos + $per1*$sin}]
   set v1 [expr {$par1*$sin - $per1*$cos}]
   set u2 [expr {$par2*$cos + $per2*$sin}]
   set v2 [expr {$par2*$sin - $per2*$cos}]
 
   # update velocities
   set State($coin1,vel) [list $u1 $v1]
   set State($coin2,vel) [list $u2 $v2]
 }
 
 # perform one animation step
 # (no collisions during first $BigBang steps)
 #
 proc animate {BigBang} {
   global State
 
   foreach {coin radius} $::coins {
     foreach {u v} $State($coin,vel) break
     foreach {x y} $State($coin,pos) break
     set newPos [list [expr {$x+$u}] [expr {$y+$v}]]
 
     # bounce off the edges
     $::canvas move $coin $u $v
     foreach {x1 y1 x2 y2} [$::canvas coords $coin] break
 
     if { $x1<=0 && $u<0 || $x2>=$::canvasWidth && $u>0} {
       set u [expr {-$u}]
     }
     if { $y1<=0 && $v<0 || $y2>=$::canvasHeight && $v>0} {
       set v [expr {-$v}]
     }
     set State($coin,vel) [list $u $v]
 
     # collide with other coins
     if {!$BigBang} { collide $coin $radius }
 
     # update position
     set State($coin,pos) $newPos
   }
 
   if {$BigBang > 0} {
     after $::delay "animate [incr BigBang -1]"
   } else {
     after $::delay "animate 0"
   }
 }
 
 # create canvas
 wm title . "Colliding Coins"
 set canvas [canvas .c -width $canvasWidth -height $canvasHeight]
 pack $canvas -fill both -expand true
 
 # get new canvas size whenever canvas is resized
 bind $canvas <Configure> {
   set canvasWidth  [winfo width  %W]
   set canvasHeight [winfo height %W]
 }
 
 # create coins
 for {set i 0} {$i < $numOfCoins} {incr i} {
   eval lappend coins [createCoin]
 }
 
 # start animation: first Big Bang then collisions
 update
 animate $numOfCoins

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