if 0 {
From comp.lang.tcl:
Anyone got a pure tcl firework display? I'm putting together a little program to drill my kids on their math facts (add/sub/mult/div), and I want a "reward" for getting x in a row right kind of thing. My wife is insisting on a firework display as one of the rewards. However, my life is insisting that I continue to do all those other things like work, shovel snow, blah blah blah. Consequently I don't have the time to climb the animation learning curve.
I've looked at the particles thing on the wiki http://wiki.tcl.tk/3252 but I don't see a "quick" way to adjust it to a firework burst and decay.
If I get a good solution I'll post it on the wiki.
Thanks, Eric Amundsen Rochester MN
-- My own reply a few days later
OK, so y'all decided to leave it as an exercise for the writer to do this one. I looked over the Particle system some more (http://wiki.tcl.tk/3252 ), read the helpful canvas tutorial from captaincrumb (http://www.captaincrumb.com/docs/computing/tcl/tk/canvas/ ), reviewed the canvas man page, let it all stew over the weekend, and came up with this while waiting through my kids' piano lessons yesterday.
I realize this "pure" tcl solution uses itcl - I like itcl and consider it part of my core tcl distribution - I'm not going to argue this point.
}
package require Tk
package require Itcl
set ::_pi [expr {2 * acos(0)}]
set ::_2_pi [expr {$::_pi * 2}]
# this little proc nukes everything already in existance and redifines my classes,
# thus allowing me to simply resource into a console while developing
proc redef {} {
# nuke everything
catch {.fd stop} {}
catch {itcl::delete class FireworkDisplay} {}
catch {itcl::delete class Spark} {}
catch {destroy .c} {}
# the main animation class - keeps a list of sparks and traces to draw and update
itcl::class FireworkDisplay {
constructor {c args} {}
public {
# creates new sparks and traces
method explode {}
# updates existing sparks and traces
method moveSparks {}
# start/stops the animation
method start {} {
set moveAfterId [after 25 [itcl::code $this moveSparks]]
set explodeAfterId [after [eval randInt $explosionInterval] [itcl::code $this explode]]
}
method stop {} {after cancel $explodeAfterId;after cancel $moveAfterId}
# various parameters to adjust the look of the display - should be self explanatory
variable lifespanRange {40 80}
variable velocityRange {2 4}
variable explosionInterval {500 800}
variable numSparksRange {10 22}
}
private {
method randInt {{lower 0} {upper 1}} {return [expr {int(rand() * ($upper - $lower + 1) + $lower)}]}
variable canvas ""
variable sparks [list]
variable explodeAfterId
variable moveAfterId
}
}
# could probably just be taken care of with arrays, but I like classes
# anyway, this is a spark
# this should probably be split into two classes, an explosion class,
# which hold the lifespan, age and velocity,
# and then a spark class which hold the angle of the spark
itcl::class Spark {
public {
variable vel ""
variable sparkId ""
variable trailId ""
variable angle ""
variable lifespan 30
variable age 0
}
}
}
redef
# animation update, called about 40 times per second
# (minus processing time in here and explosion creation)
itcl::body FireworkDisplay::moveSparks {} {
# sparks might get deleted, so keep a list of sparks that don't die
set tempSparkList [list]
foreach spark $sparks {
# a spark has died
if {[$spark cget -age] > [$spark cget -lifespan]} {
# remove it and it's trail from the canvas and destroy the object
$canvas delete [$spark cget -sparkId]
$canvas delete [$spark cget -trailId]
itcl::delete object $spark
} else {
# spark still kicking, so compute next position
set xDelta [expr {[$spark cget -vel] * cos([$spark cget -angle])}]
set yDelta [expr {[$spark cget -vel] * sin([$spark cget -angle])}]
$canvas move [$spark cget -sparkId] $xDelta $yDelta
# and extend its trail
foreach {x1 y1 x2 y2} [$canvas coords [$spark cget -trailId]] {}
$canvas coords [$spark cget -trailId] $x1 $y1 [expr {$x2 + $xDelta}] [expr {$y2 + $yDelta}]
$spark configure -age [expr {[$spark cget -age] + 1}]
# and keep it alive
lappend tempSparkList $spark
}
}
set sparks $tempSparkList
set moveAfterId [after 25 [itcl::code $this moveSparks]]
}
itcl::body FireworkDisplay::constructor {c args} {
set canvas $c
$c configure -background black
start
}
# create a new explosion
itcl::body FireworkDisplay::explode {} {
# create is somewhere in the middle 80% of the canvas
set centerx [randInt [expr {int([$canvas cget -width] * 0.1)}] [expr {int([$canvas cget -width] * 0.9)}]]
set centery [randInt [expr {int([$canvas cget -height] * 0.1)}] [expr {int([$canvas cget -height] * 0.9)}]]
# randomize the look of the sparks and trail
set numSparks [eval randInt $numSparksRange]
set vel [eval randInt $velocityRange]
set lifespan [eval randInt $lifespanRange]
set sparkColor #[format %X%X [randInt 0 15] [randInt 0 15]][format %X%X [randInt 0 15] [randInt 0 15]][format %X%X [randInt 0 15] [randInt 0 15]]
set trailColor #[format %X%X [randInt 0 15] [randInt 0 15]][format %X%X [randInt 0 15] [randInt 0 15]][format %X%X [randInt 0 15] [randInt 0 15]]
# without this all explosions have a spark going directly to the right - boring!
set angleOffset [expr {$::_2_pi / ([randInt 1 100] * double($numSparks))}]
# craete the sparks and trails
for {set j 0} {$j < $numSparks} {incr j} {
lappend sparks [Spark #auto]
# place trail first so the spark is on top of the trail
set trailId [$canvas create line $centerx $centery $centerx $centery -fill $trailColor -width 3]
set sparkId [$canvas create oval [expr {$centerx - 4}] [expr {$centery - 4}] [expr {$centerx + 4}] [expr {$centery + 4}] -fill $sparkColor -outline $sparkColor]
[lindex $sparks end] configure \
-lifespan $lifespan \
-sparkId $sparkId \
-trailId $trailId \
-vel $vel \
-angle [expr {$j * $::_2_pi / double($numSparks) + $angleOffset}]
}
set explodeAfterId [after [eval randInt $explosionInterval] [itcl::code $this explode]]
}
canvas .c
foreach {w h} [wm maxsize .] {}
wm geometry . [set w]x[set h]+0+0
grid .c -column 0 -row 0 -sticky news
grid columnconfigure . 0 -weight 1
grid rowconfigure . 0 -weight 1
FireworkDisplay .fd .c
.c configure -height $h -width $w