#! /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