Based on [Colliding Balls], with gravity and zits.

(well, not really, but...)
======
#
# Exploding Balls
# Based on Colliding Balls by David Easton.
# Author: David Easton
#   mods by Jeff Hobbs just to brace expr's (improve speed)
#     and clean up some foreach usage
#   mods by Peter da Silva: fix collision logic, add gravity, friction,
#     elasticity, make FPS a constant, and smooth refresh.
#   more mods by Peter da Silva: Incorporate some of LH's changes.
#     Add a bunch of parameters. And make balls fade away if
#     ignored, or swell and burst when poked.
#   and post-wiki mods: make mass a function of r^3. Little balls SHOULD
#     shoot up high!
#

package require Tk

#### Settings
# Set frames per second (if much less than 20, it's not very smooth)
set State(fps) 20.0

# Set gravity - 9.8 pixels per second per second
set State(gravity) 9.8

# Set friction - 10% of velocity per second
set State(friction) 0.1

# Set elasticity - 95%
set State(bounce) 0.95
#set State(bounce,walls) 0.80
set State(bounce,balls) 1.05

# How much do balls expand when they hit
set State(grow) 1.01

# How much do balls shrink when left alone, per second
set State(shrink) 0.025

# Size of balls
set State(minSize) 20
set State(maxSize) 50

# # balls
set State(balls) 8

# Color palette for balls
# set State(colours) {
#     red yellow darkgreen green blue lightblue orange pink purple white
# }
for {set r 63} {$r < 256} {incr r 16} {
  for {set g 63} {$g < 256} {incr g 16} {
    for {set b 63} {$b < 256} {incr b 16} {
      lappend State(colours) [format #%02X%02X%02X $r $g $b]
    }
  }
}

#
# Fade color as fraction
#
proc fade {colour level {target white}} {
    global rgb
    global divideColors
    if ![info exists rgb($colour)] {
        set rgb($colour) [winfo rgb . $colour]
    }
    if ![info exists rgb($target)] {
        set rgb($target) [winfo rgb . $target]
    }
    if ![info exists divideColors] {
        if ![info exists rgb(white)] {
            set rgb(white) [winfo rgb . white]
        }
        set divideColors [expr {[lindex $rgb(white)] > 255}]
    }
    if {$level > 1.0} {
        set level 1.0
    } elseif {$level < 0.0} {
        set level 0.0
    }
    set new "#"
    foreach c $rgb($colour) t $rgb($target) {
        if {$divideColors} {
            set c [expr {$c / 256}]
            set t [expr {$t / 256}]
        }
        append new [format %02X [expr {int($c * $level + $t * (1 - $level))}]]
    }
    return $new
}

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

#
# Given the initial velocities and radii
# calculates velocities following a collision
#
proc postColVels {u1 u2 r1 r2} {
   set m1 [expr {$r1*$r1*$r1}]
   set m2 [expr {$r2*$r2*$r2}]
   set u [expr {2*($m1*$u1+$m2*$u2)/($m1+$m2)}]
   list [expr {$u-$u1}] [expr {$u-$u2}]
}



proc createBall { tag {init 1}} {
    global State

    set radius [expr {int(($State(sizeRange) * rand()) + $State(minSize))}]
    set diam   [expr {2 * $radius}]

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

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

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

    # Random colour
    set colour [randFromList $State(colours)]
    set border [randFromList $State(colours)]
    set width [expr {(rand() + 0.5) * (($radius * 4.0) / $State(minSize))}]

    # Now create or configure ball
    if {$init} {
        set id [$State(canvas) create oval $x1 $y1 $x2 $y2 \
                -outline $border -fill $colour -width $width \
                -tags [list $tag ball]]

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

        set xvel [expr {(rand() * 8.0) -2}]
        set yvel [expr {(rand() * 8.0) -2}]
    } else {
         set id $State(tag2id,$tag)
         $State(canvas) coords $id $x1 $y1 $x2 $y2
         $State(canvas) itemconfigure $id \
                -fill $colour -outline $border -width $width

        set xvel [expr {(rand() * 8.0) -4}]
        set yvel [expr {(rand() * 4.0)}]
    }

    set State(vel,$tag) [list $xvel $yvel]
    set State(rad,$tag) $radius
    set State(col,$tag) $colour
    set State(bdr,$tag) $border
    set State(wid,$tag) $width
}

#
# 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 c $State(canvas)
    set r $State(rad,$tag)

    foreach { x1 y1 x2 y2 } [$c coords $tag] break
    set x [expr {($x1+$x2)/2.0}]
    set y [expr {($y1+$y2)/2.0}]

    set overlapList [list]
    set id [set ourId [$c find withtag $tag]]
    $c raise $tag ;# not sure whether really needed
    while { [set id [$c find closest $x $y $r $id]] != $ourId } {
        lappend overlapList $id
    }

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

    return 0
}

proc moveBalls { } {

    global State
    global hot

    # Cancel any "lost" frames
    if [info exists State(id)] {
        after cancel $State(id)
    }

    # Reschedule at the beginning to keep updates smooth
    set State(id) [after $State(delay) moveBalls]

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

    foreach ball $State(ballList) {

        foreach {xvel yvel} $State(vel,$ball) {}

        if {[info exists State(gravity)]} {
          set yvel [expr {$yvel + $State(gravity)}]
        }

        if {[info exists State(friction)]} {
            set yvel [expr {$yvel * (1.0 - $State(friction))}]
            set xvel [expr {$xvel * (1.0 - $State(friction))}]
        }

        $State(canvas) move $ball $xvel $yvel

        # Bounce off the edges
        foreach {x1 y1 x2 y2} [$State(canvas) bbox $ball] {}

        # Has something moved us through the wall?
        if {$x2 < 0 || $x1 > $canvasWidth || $y2 < 0 || $y1 > $canvasHeight} {
            lappend reanimate $ball
        }

        # Left edge
        if { $x1 < 0 && $xvel < 0} {
            set xvel [expr {-$State(bounce,walls) * $xvel}]
        }
       # Right edge
        if { $x2 > $canvasWidth && $xvel > 0} {
            set xvel [expr {-$State(bounce,walls) * $xvel}]
        }
       # Top edge
        if { $y1 < 0 && $yvel < 0} {
            set yvel [expr {-$State(bounce,walls) * $yvel}]
        }
        # Bottom edge
        if { $y2 > $canvasHeight && $yvel > 0} {
            if {[info exists State(gravity)]} {
               if {
                    $State(shrink) == 1.0 &&
                    $yvel < $State(gravity) &&
                    abs($xvel) < $State(gravity)
                } {
                    lappend reanimate $ball
                }

               # Make the bottom border a bit tougher if we have gravity, OK?
               $State(canvas) move $ball 0 [expr {$canvasHeight - $y2}]
           }
            set yvel [expr {-$State(bounce,walls) * $yvel}]

        }


        # Update for new velocity
        set State(vel,$ball) [list $xvel $yvel]

        # If haven't collided with anyone, shrink
        if {![checkForCollision $ball] && [info exists State(shrink)]} {
            set r [expr {$State(rad,$ball) * $State(shrink)}]
            set State(rad,$ball) $r
            if {$r < $State(minSize)} {
                set fade [expr {$r / $State(minSize)}]
                if {$fade < 0.5} {
                    lappend reanimate $ball
                } else {
                    set fade [expr {2.0 * $fade - 1.0}]
                    $State(canvas) itemconfigure $ball \
                        -fill [fade $State(col,$ball) $fade] \
                        -outline [fade $State(bdr,$ball) $fade] \
                        -width [expr {$State(wid,$ball) * $fade}]
                }
            }
            set xpos [expr {($x1 + $x2) / 2}]
            set ypos [expr {($y1 + $y2) / 2}]
            $State(canvas) scale $ball $xpos $ypos $State(shrink) $State(shrink)
       } else {
            set r $State(rad,$ball)
        }
        if {$r > $State(maxSize)} {
            set hot($ball) 1
        } elseif {[info exists hot($ball)]} {
            set hot($ball) 0
        }
        if {[info exists hot($ball)]} {
            if {!$hot($ball)} {
                unset hot($ball)
            }
            set fade [expr {$r / $State(maxSize)}]
            if {$fade > 2.0} {
                lappend reanimate $ball
            } else {
                set fade [expr {2.0 - $fade}]
                $State(canvas) itemconfigure $ball \
                        -fill [fade $State(col,$ball) $fade red] \
                        -outline [fade $State(bdr,$ball) $fade red] \
                        -width [expr {$State(wid,$ball) * (2.0 - $fade)}]
            }
        }
    }

    # Reanimate one ball per frame
    if [info exists reanimate] {
        createBall [lindex $reanimate 0] 0
    }
}

proc collide { tag1 tag2 } {
    global State

    # Calculate position of balls (don't track them because of rounding error)
    foreach {bx1 by1 bx2 by2} [$State(canvas) coords $tag1] break
    set x1 [expr {($bx1 + $bx2) / 2}]
    set y1 [expr {($by1 + $by2) / 2}]

    foreach {bx1 by1 bx2 by2} [$State(canvas) coords $tag2] break
    set x2 [expr {($bx1 + $bx2) / 2}]
    set y2 [expr {($by1 + $by2) / 2}]

    # 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

    if { $x1 != $x2 } {
        set phi [expr {atan(double($y2-$y1)/double($x2-$x1))}]
    } else {
        set phi [expr {asin(1)}] ;# 90 degrees
    }

    # Now work out the velocity parallel and perpendicular

    set uparr1 [
        expr {(($ux1 * cos($phi)) + ($uy1 * sin($phi))) * $State(bounce,balls)}
    ]
    set uperp1 [expr {($ux1 * sin($phi)) - ($uy1 * cos($phi))}]

    set uparr2 [
        expr {(($ux2 * cos($phi)) + ($uy2 * sin($phi))) * $State(bounce,balls)}
    ]
    set uperp2 [expr {($ux2 * sin($phi)) - ($uy2 * cos($phi))}]

    # If they are not going towards each other, then they will not collide
    if { $x1 != $x2 } {
        if { $x1<$x2 && $uparr2>$uparr1 || $x1>$x2 && $uparr2<$uparr1 } return
    } else {
        if { $y1<$y2 && $uparr2>$uparr1 || $y1>$y2 && $uparr2<$uparr1 } return
    }

    foreach {vparr1 vparr2} [
        postColVels $uparr1 $uparr2 $State(rad,$tag1) $State(rad,$tag2)
    ] break

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

    # If growing, grow
    if [info exists State(grow)] {
        set State(rad,$tag1) [expr {$State(rad,$tag1) * $State(grow)}]
        $State(canvas) scale $tag1 $x1 $y1 $State(grow) $State(grow)
        set State(rad,$tag2) [expr {$State(rad,$tag2) * $State(grow)}]
        $State(canvas) scale $tag2 $x2 $y2 $State(grow) $State(grow)
    }
}

# 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]
pack $State(canvas) -fill both -expand true

#### check settings!
# Set delay to 1000, will be scaled by fps
set State(delay) 1000

# Some variables scale by frame rate
foreach v {gravity friction delay shrink} {
  if [info exists State($v)] {
    set State($v) [expr {$State($v) / $State(fps)}]
  }
}

# If FPS is real low, increase grow rate.
if {[info exists $State(grow)] && $State(fps) < 20.0} {
  set State(grow) [expr {1 + ($State(grow) - 1.0) * 20.0 / $State(fps)}]
}

# delay is an integer
set State(delay) [expr {int($State(delay))}]

# Convert shrink to ratio
if [info exists State(shrink)] {
  set State(shrink) [expr {1 - $State(shrink)}]
}

# Calculate size range
set State(sizeRange) [expr {$State(maxSize) - $State(minSize)}]

# Set missing elasticity values
foreach object {balls walls} {
  if ![info exists State(bounce,$object)] {
    if [info exists State(bounce)] {
      set State(bounce,$object) $State(bounce)
    } else {
      set State(bounce,$object) 1.0
    }
  }
}

update

# Create balls
for {set i 0} {$i < $State(balls)} {incr i} {
  lappend State(ballList) ball$i
  createBall ball$i
}

moveBalls
======

------

[uniquename] 2014jan27

For those who do not have the facilities or time to implement the code above,
here is an image that shows the balls that are bouncing off of the walls
and off of each other.

[explodingBalls_wiki18107_505x424.jpg]

After a lot of collisions, some of the balls will get larger and larger
and turn red. The big red ball in the image is about to explode.

The fragmented ball is a result of the screen capture occurring during
the redraw of the ball.

<<categories>>Games