Updated 2014-06-15 00:28:11 by pooryorick

## Description  edit

A little application to depicting bals bouncing off each other and the edges of the canvas.

Written by David Easton around 2003-03-17

## Changes  edit

pyk 2012-11-23: fixed a bug where the loop in [checkForCollision] became infinite if the velocity was set too high.

## Discussion  edit

Ed Suominen: 25 Mar 2003 This is great! There are some pretty advanced calculations going on here.

David Easton: 26 Mar 2003 Thanks! The calculations used by postColVels come from conservation of energy and momentum. colide resolves velocities parallel and perpendicular to the collision. Thus, this should be a fairly accurate simulation.

## Code  edit

```#! /bin/env tclsh

# Colliding Balls
# Author: David Easton
#   mods by Jeff Hobbs just to brace expr's (improve speed)
#   and clean up some foreach usage
#

package require Tk

#velocity limit
set velocity 8

#
# Return an entry from the list at random
#
proc randFromList {inputList} {
return [lindex \$inputList [expr {int(rand() * [llength \$inputList])}]]
}

#
# Given the initial velocities and masses
# calculates velocities following a collision
#
proc postColVels { u1 u2 m1 m2 } {

# No collision if u2 > u1
if { \$u2 > \$u1 } {
return [list \$u1 \$u2]
}

set u1 [expr {1.0 * \$u1}]
set u2 [expr {1.0 * \$u2}]
set m1 [expr {1.0 * \$m1}]
set m2 [expr {1.0 * \$m2}]

set M [expr {\$m1 / \$m2}]

set b [expr {(\$M * \$u1) + \$u2}]
set c [expr {(\$M * \$u1 * \$u1) + (\$u2 * \$u2)}]

set q [expr {2 * \$M * \$b}]
set p [expr {4 * \$M * \$M * \$b * \$b}]
set r [expr {4 * (\$M + (\$M * \$M)) * ((\$b * \$b) - \$c)}]
set s [expr {2 * (\$M + (\$M * \$M))}]

if { \$r > \$p } {
"No solution"
} else {

set root [expr {sqrt(\$p -\$r)}]

#set v1(1) [expr {(\$q + \$root) / \$s}]
set v1(2) [expr {(\$q - \$root) / \$s}]

#set v2(1) [expr {\$b - (\$M * \$v1(1))}]
set v2(2) [expr {\$b - (\$M * \$v1(2))}]

# v2 should always be greater than v1
# which means the answer is always v1(2) and v2(2)

return [list \$v1(2) \$v2(2)]
}
}

proc createBall { tag } {
variable velocity
global State

set radius [expr {int((30 * rand()) + 20)}]
set diam   [expr {2 * \$radius}]
# Mass is proportional to area

set canvasHeight [winfo height \$State(canvas)]
set canvasWidth  [winfo width \$State(canvas)]

set xpos [expr {\$radius + int((\$canvasWidth - \$diam) * rand())}]
set ypos [expr {\$radius + int((\$canvasHeight - \$diam) * rand())}]

set x1 [expr {\$xpos - \$radius}]
set x2 [expr {\$xpos + \$radius}]
set y1 [expr {\$ypos - \$radius}]
set y2 [expr {\$ypos + \$radius}]

# Random colour
set colList [list red yellow darkgreen green blue lightblue orange pink purple white]
set colour [randFromList \$colList]

# Now create ball
set id [\$State(canvas) create oval \$x1 \$y1 \$x2 \$y2 \
-outline black -fill \$colour -tags [list \$tag ball]]

set State(id2tag,\$id) \$tag

set xvel [expr {(rand() * \$velocity) -2}]
set yvel [expr {(rand() * \$velocity) -2}]

set State(pos,\$tag) [list \$xpos \$ypos]
set State(vel,\$tag) [list \$xvel \$yvel]
set State(mass,\$tag) \$mass
}

#
# Check if we have collided with another ball
#
# Returns: 1 - If there was a collision
#          0 - If no collision
#
proc checkForCollision { tag } {
global State
set didCollide 0
set overlapList {}
foreach {ourX ourY} \$State(pos,\$tag) {}
set ourId [\$State(canvas) find withtag \$tag]
set id [\$State(canvas) find closest \$ourX \$ourY \$State(rad,\$tag) \$ourId]
set seen [list]
#if the velocity is higher than the radius of the smallest ball, the
#[canvas find] command above might cause an endess loop here, so use the
#extra check for membership in \$seen
while { \$id ne \$ourId && \$id ni \$seen} {
if { [lsearch -glob [\$State(canvas) gettags \$id] "ball*"] > -1 } {
set didCollide 1
lappend overlapList \$id
}
lappend seen [set id [\$State(canvas) find closest \$ourX \$ourY \$State(rad,\$tag) \$id]]
}

if { [llength \$overlapList] > 0 } {
foreach id \$overlapList {
collide \$tag \$State(id2tag,\$id)
}
}

return \$didCollide
}

proc moveBalls { } {
global State

set canvasHeight [winfo height \$State(canvas)]
set canvasWidth  [winfo width \$State(canvas)]

foreach ball \$State(ballList) {

foreach {xpos ypos} \$State(pos,\$ball) {xvel yvel} \$State(vel,\$ball) {}

set xpos [expr {\$xpos + \$xvel}]
set ypos [expr {\$ypos + \$yvel}]
\$State(canvas) move \$ball \$xvel \$yvel

# Bounce off the edges

foreach {x1 y1 x2 y2} [\$State(canvas) bbox \$ball] {}

# Left edge
if { \$x1 < 0 && \$xvel < 0} {
set xvel [expr {-1.0 * \$xvel}]
}
if { \$x2 > \$canvasWidth && \$xvel > 0} {
set xvel [expr {-1.0 * \$xvel}]
}
if { \$y1 < 0 && \$yvel < 0} {
set yvel [expr {-1.0 * \$yvel}]
}
if { \$y2 > \$canvasHeight && \$yvel > 0} {
set yvel [expr {-1.0 * \$yvel}]
}

if {[checkForCollision \$ball]} {

# Collided
set State(pos,\$ball) [list \$xpos \$ypos]

} else {

# Update for new position and velocity

set State(pos,\$ball) [list \$xpos \$ypos]
set State(vel,\$ball) [list \$xvel \$yvel]
}
}
after 50 moveBalls
}

proc collide { tag1 tag2 } {

global State

# Get position of each ball

foreach {x1 y1} \$State(pos,\$tag1) {x2 y2} \$State(pos,\$tag2) {}

# Always call the ball on the right (2) and the one on the left (1)

if { \$x1 > \$x2 } {
set temp \$tag2
set tag2 \$tag1
set tag1 \$temp

# Get position of each ball

foreach {x1 y1} \$State(pos,\$tag1) {x2 y2} \$State(pos,\$tag2) {}
}

# Get velocity of each ball

foreach {ux1 uy1} \$State(vel,\$tag1) {ux2 uy2} \$State(vel,\$tag2) {}

# Work out the angle along the axis of collision

set diffX [expr {1.0 * (\$x2 - \$x1)}]
set diffY [expr {1.0 * (\$y2 - \$y1)}]

set phi [expr {atan(\$diffY / \$diffX)}]

# Now work out the velocity parallel and perpendicular

set uparr1 [expr {(\$ux1 * cos(\$phi)) + (\$uy1 * sin(\$phi))}]
set uperp1 [expr {(\$ux1 * sin(\$phi)) - (\$uy1 * cos(\$phi))}]

set uparr2 [expr {(\$ux2 * cos(\$phi)) + (\$uy2 * sin(\$phi))}]
set uperp2 [expr {(\$ux2 * sin(\$phi)) - (\$uy2 * cos(\$phi))}]

# If they are not going towards each other, then they will not collide
if { \$uparr2 > \$uparr1 } {
return
}

set mass1 \$State(mass,\$tag1)
set mass2 \$State(mass,\$tag2)

foreach {vparr1 vparr2} [postColVels \$uparr1 \$uparr2 \$mass1 \$mass2] {}

# Perpendicular velocites are unchanged

set vperp1 \$uperp1
set vperp2 \$uperp2

# Now convert back into x and y movements
set vx1 [expr {(\$vparr1 * cos(\$phi)) + (\$vperp1 * sin(\$phi))}]
set vy1 [expr {(\$vparr1 * sin(\$phi)) - (\$vperp1 * cos(\$phi))}]

set vx2 [expr {(\$vparr2 * cos(\$phi)) + (\$vperp2 * sin(\$phi))}]
set vy2 [expr {(\$vparr2 * sin(\$phi)) - (\$vperp2 * cos(\$phi))}]

# Update for new velocities

set State(vel,\$tag1) [list \$vx1 \$vy1]
set State(vel,\$tag2) [list \$vx2 \$vy2]
}

# Seed random number generator
expr {srand([clock clicks])}

# Window things
wm title . "Bouncing balls"

# Create canvas
set State(canvas) [canvas .c -width 500 -height 400]

# Create balls
set State(ballList) [list ball1 ball2 ball3 ball4 ball5 ball6 ball7 ball8]
bind .c <Map> {
foreach ball \$State(ballList) {
createBall \$ball
}
moveBalls
}
pack \$State(canvas) -fill both -expand true
```

uniquename 2013jul29

This code deserves an image to show what the Tk GUI looks like: (Thanks to 'gnome-screenshot', 'mtpaint', and ImageMagick 'convert' on Linux for, respectively, capturing the screen in a PNG file, cropping the image, and converting the resulting PNG file to a JPEG file about one-tenth the size of the PNG file. Thanks to FOSS developers everywhere --- including Linux kernel and Gnu developers. I used the 'mv' command and the ImageMagick 'identify' command in a shell script to easily rename the cropped image file to contain the image dimensions in pixels.)

When the Tk GUI first pops up the balls are in motion --- bouncing off the walls (the canvas borders) and off of each other. I captured this image when the balls were in motion --- hence the occurrence of some partial filled-circles in the image.