''[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, 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]

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

[collidingCoins_wiki8709_605x527.jpg]

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].


<<categories>> Graphics | Animation