Updated 2014-04-24 06:04:31 by pooryorick

2005, Jan 27 Eric Amundsen - cross posting from news:comp.lang.tcl (c.l.t)

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 (Particle System) 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

RA2 Move South, Eric! This way you won't have to shovel snow and you'll have all the time in the world to study TCL animation. :-) Seriously, ULIS knows quite a lot on the subject (TCL animation; not snow removal! :-) Please post this question on his home page and I'm sure he'll be glad to help...

I hope I did not hurt your feelings by suggesting to move South since you seem to have a famous explorer of the Northern boundary in your ancestry. Any relationship with Amundsen, the Arctic explorer?

Eric Amundsen - I did solve this myself then with Firework Display. Should have updated this page. Animation was actually very easy, and I've essentially been doing it along with this type of thing - Keep a GUI alive during a long calculation.

No hurt feelings. While the lineage hasn't ever been determined with certainty, there does seem to be some affinity to cold weather in my blood (or at least my heritage) [1]

-- 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, read the helpful canvas tutorial from captaincrumb [2], 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.
#! /bin/env tclsh

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 idle [itcl::code $this moveSparks]]
                set explodeAfterId [after [randInt {*}$explosionInterval] [
                    list after idle [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 [list after idle [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 [randInt {*}$numSparksRange]
    set vel [randInt {*}$velocityRange]
    set lifespan [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 [randInt {*}$explosionInterval] [
        list after idle [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
bind .c <Configure> {FireworkDisplay .fd .c}
.c configure -height $h -width $w