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

A starkit version of this program is on sdarchive.

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, https://wiki.tcl-lang.org/8709 # Based on Colliding Balls by David Easton, https://wiki.tcl-lang.org/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 lassign [$::canvas coords $coin] x1 y1 x2 y2 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 lassign $State($coin1,pos) x1 y1 lassign $State($coin2,pos) x2 y2 lassign $State($coin1,vel) u1 v1 lassign $State($coin2,vel) u2 v2 # 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 { lassign $State($coin,vel) u v lassign $State($coin,pos) x y set newPos [list [expr {$x+$u}] [expr {$y+$v}]] # bounce off the edges $::canvas move $coin $u $v lassign [$::canvas coords $coin] x1 y1 x2 y2 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] # 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 bind $canvas <Map> { animate $numOfCoins } pack $canvas -fill both -expand true

uniquename 2014jan27

For those who do not have the facilities or time to implement the code above, here is an image of the 'colliding coins' as they are bouncing off of the 4 walls --- AND bouncing off of each other.

A few of the balls look fragmented because the screenshot caught them just as they were being erased or redrawn.

It appears that LH has done away with the outlines around the colored disks in Easton's Colliding Balls.