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 ====== <>Games