Version 1 of Exploding Balls

Updated 2007-05-19 06:17:29 by argent

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