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. 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).
#
# 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