[David Easton] ''12 Sept 2003'' - The saga continues: first [Bouncing Balls], then [Colliding Balls], then [Colliding Coins] and now [Colliding Spheres].

This merges [Colliding Coins] by Leszek Holenderski (based on [Colliding Balls] by David Easton) with [Spheres] from Ulis.

Note: The spheres still have a mass proportional to area because the small spheres were found to travel very fast with mass proportional to volume.
----
[MPJ] ~ I likes this on the desktop so I decided to try it out on my [PocketPC].  I changed the maxsize and numbers and scaled the screen to full size.  Below is a screen shot of the results and my updates for the PocketPC [http://mywebpages.comcast.net/jakeforce/iSpheres.tcl]
.  ''(Note: that that some of the sphere images are messed up this is a problem with the current port to the PocketPC)''

[http://mywebpages.comcast.net/jakeforce/ColSpheres.jpg]
----

This is cool. I think it should be part of the tk  widget demo to show how interesting animations can be done with the canvas.

----
 #
 # Colliding Spheres by David Easton, http://wiki.tcl.tk/9860
 # Based on: Colliding Coins by Leszek Holenderski, http://wiki.tcl.tk/8709
 #           Spheres by Ulis, http://wiki.tcl.tk/9847
 #
 package require Tk 8.4
 # 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 1,1,1 1,1,0 1,0,1 0,1,1 1,0,0 0,1,0 0,0,1 0,0.5,0]
 set light 1.0
 set source 0.0

 # Gradient proc from Ulis, http://wiki.tcl.tk/9847
 #
 proc gradient {image relief light source red green blue} {
   set sunken [string match sun* $relief]
   set light [expr {$light * 96 + 32}]
   set source [expr {0.5 + $source / 2.0}]
   set D [image width $image]
   set R [expr {$D / 2}]
   set R2 [expr {$R * $R}]
   for {set y 0} {$y < $D} {incr y} \
   {
     set Dy2 [expr {($y - $R) * ($y - $R)}]
     set dy [expr {($y * $source - $R)}]
     set dy2 [expr {$dy * $dy}]
     for {set x 0} {$x < $D} {incr x} \
     {
       set Dx2 [expr {($x - $R) * ($x - $R)}]
       set Dxy [expr {$Dx2 + $Dy2}]
       if {$Dxy <= $R2} \
       {
         set dx [expr {($x * $source - $R)}]
         set dx2 [expr {$dx * $dx}]
         set dxy [expr {$dx2 + $dy2}]
         set color [expr {int(127 + $light * (1.0 - ($dxy / $R2 / 1.5)))}]
         if {$sunken} { set color [expr {int(127 + $light * 2 - $color)}] }
         set color [format "#%02x%02x%02x" [expr {int($color*$red)}] \
                                           [expr {int($color*$green)}] \
                                           [expr {int($color*$blue)}]]
         $image put $color -to [expr {$D - $x}]  [expr {$D - $y}]
       }
     }
   }
 }

 # 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 d [expr {2*$r}]
   # 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 c [lindex $::colours [expr {int(rand()*[llength $::colours])}]]
   foreach {red green blue} [split $c ,] {break}
   set image [image create photo -width $d -height $d]
   gradient $image raised $::light $::source $red $green $blue
   set coin [$::canvas create image $x $y -anchor c -image $image]
   # 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 {x y} [$::canvas coords $coin] break
   # 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} {
     # Check that centres are within collision range (i.e. not just bbox of image)
     foreach {x2 y2} [$::canvas coords $next] break
     if {[expr {hypot($x2-$x,$y2-$y) - $radius - $::coinToRad($next)}] < 0} {
         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 bbox $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 Spheres"
 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]
 }
 array set coinToRad $coins
 # start animation: first Big Bang then collisions
 update
 animate $numOfCoins


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