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