#! /bin/env tclsh

package require Tk 

wm protocol . WM_DELETE_WINDOW {exit}

proc animate {} {
    # --- crank it as fast as we can...
    if {$::emitter(alive)} {
        nextFrame
        after idle animate
    }
}

proc defineVar {key val args} {
    set ::emitter($key) $val
    set ::gui($key) $val
    switch [llength $args] {
        0 {
            # no GUI needed
            return
        }
        2 - 3 - 4 {
            foreach {min max desc conv} $args {break}
        }
        1 - default {
            error "Invalid \# args"
        }
    }
    
    if {$desc eq {}} {set desc $key}
    set num 0
    while {[winfo exists .f1.l$num]} {incr num}
    # the -label option of sliders puts the name above the slider
    # which ends up taking up a lot of room - so put our own label
    # to the left
    label .f1.l$num -text $desc
    scale .f1.s$num -from $min -to $max -label {} -length 100 \
           -showvalue 1 -orient horizontal -width 8 -sliderlength 15
    if {[string is int $val] && [string is int $min] && [string is int $max]} {
        .f1.s$num config -resolution 1
    } else {
        .f1.s$num config -resolution .1
    }
    grid .f1.l$num .f1.s$num -row $num -sticky w
    if {$conv ne {}} {
        .f1.s$num config -variable ::gui($key) -command "guiMod $key $conv"
        set ::emitter($key) [eval $conv $val]
    } else {
        .f1.s$num config -variable ::emitter($key)
    }
}

proc guiMod {key conv val} {
    if {$conv eq  {}} {
        set ::emitter($key) $val
    } else {
        set ::emitter($key) [eval $conv $val]
    }
}

proc initVars {} {

    # --- Particle Emitter...
    defineVar alive             1                                           ; # still running?
    defineVar pos.x           300                                           ; # x position of emitter
    defineVar pos.y           370                                           ; # y position of emitter
    defineVar pos.z             0                                           ; # z position of emitter
    defineVar yaw               0    0   360 {Initial Yaw}     degreeToRad  ; # initial yaw angle
    defineVar yawVar          360    0   360 {Yaw Variation}   degreeToRad  ; # random variation range on yaw
    defineVar pitch           -90  -180  180 {Initial Pitch}   degreeToRad  ; # initial pitch (up
    defineVar pitchVar         40    0   360 {Pitch Variation} degreeToRad  ; # random variation range
    defineVar speed            12    5   50  {Initial Velocity}             ; # particle speed
    defineVar speedVar          2    1   10  {Velocity Variation}           ; # random variation range
    defineVar totalParticles   50    1   500 {Max Particles}                ; # total particles in system
    defineVar particleCount     0                                           ; # current particle count
    defineVar emitsPerFrame     5    1   10  {Emission Rate}                ; # number of particles/frame
    defineVar emitVar           2                                           ; # random variation range
    defineVar life             60   10   250 Lifespan                     ; # particle life (frames)
    defineVar lifeVar          15                                           ; # random variation
    defineVar startColor.r    150    0   255 {Start Color (red)}            ; # start color (red component)
    defineVar startColor.g    150    0   255 {Start Color (green)}          ; # start color (green component)
    defineVar startColor.b    200    0   255 {Start Color (blue)}           ; # start color (blue component)
    defineVar startColorVar.r  25                                           ; # random variation - red
    defineVar startColorVar.g  25                                           ; # random variation - green
    defineVar startColorVar.b  25                                           ; # random variation - blue
    defineVar endColor.r        0    0   255 {End Color (red)}              ; # end color (red component
    defineVar endColor.g        0    0   255 {End Color (green)}            ; # end color (green component
    defineVar endColor.b      200    0   255 {End Color (blue)}             ; # end color (blue component
    defineVar endColorVar.r    25                                           ; # random variation - red
    defineVar endColorVar.g    25                                           ; # random variation - green
    defineVar endColorVar.b    50                                           ; # random variation - blue
    defineVar force.x         0.0  -5.0  5.0 Wind                         ; # x force factor (wind)
    defineVar force.y         0.3  -5.0  5.0 Gravity                      ; # y force factor (gravity)
    defineVar force.z         0.0                                           ; # z force factor (?)
}


proc nextFrame {} {

    # --- update all living particles
    foreach me [.c1 find withtag alive] {
        updateParticle $me
    }

    # --- Add up to "emitsPerFrame" more particles to the scene without
    #     exceeding "totalParticles"
    for {set i 1} {$i <= $::emitter(emitsPerFrame)} {incr i} {
        if {![addNewParticle]} {
            break
        }
    }
}

proc addNewParticle {} {
    # --- if we've reached our population cap, just return
    if {$::emitter(particleCount) >= $::emitter(totalParticles)} {
        return 0

    } else {

        # --- throw another particle on the pile
        incr ::emitter(particleCount)

        # --- see if we can recycle any dead particles
        set me [lindex [.c1 find withtag dead] 0]
        if {[string length $me]} {
            .c1 itemconfigure $me -tag alive
        } else {
            #jcw - fixed for 8.4.2, original
            #was: set me [ .c1 create line -tag alive]

            set me [.c1 create line -10 -10 -10 -10 -tag alive]
        }

        # --- starting particle position (delta from the emitter)
        set ::particle($me,pos.x)     0
        set ::particle($me,pos.y)     0
        set ::particle($me,pos.z)     0
        set ::particle($me,prevPos.x) 0
        set ::particle($me,prevPos.y) 0
        set ::particle($me,prevPos.z) 0

        # --- calculate the starting direction vector
        set yaw   [expr {$::emitter(yaw) + ($::emitter(yawVar) * [randomNum])}]
        set pitch [expr {$::emitter(pitch) + ($::emitter(pitchVar) * [
            randomNum])}]

        # --- determine vector information
        set vectorInfo [rotationToDirection $pitch $yaw]
        set x [lindex $vectorInfo 0]
        set y [lindex $vectorInfo 1]
        set z [lindex $vectorInfo 2]

        # --- account for the speed factor
        set speed [expr {
            $::emitter(speed) + ($::emitter(speedVar) * [randomNum])}]
        set x [expr {$x * $speed}]
        set y [expr {$y * $speed}]
        set z [expr {$z * $speed}]

        # --- we are done with these, so store them with the particle
        set ::particle($me,dir.x) $x
        set ::particle($me,dir.y) $y
        set ::particle($me,dir.z) $z

        # --- calculate the colors for this particle
        set start_r [expr {$::emitter(startColor.r) + 
                                 ($::emitter(startColorVar.r) * [randomNum])}]
        set start_g [expr {$::emitter(startColor.g) + 
                                 ($::emitter(startColorVar.g) * [randomNum])}]
        set start_b [expr {$::emitter(startColor.b) + 
                                 ($::emitter(startColorVar.b) * [randomNum])}]
        set end_r   [expr {$::emitter(endColor.r) + 
                                 ($::emitter(endColorVar.r) * [randomNum])}]
        set end_g   [expr {$::emitter(endColor.g) + 
                                 ($::emitter(endColorVar.g) * [randomNum])}]
        set end_b   [expr {$::emitter(endColor.b) + 
                                 ($::emitter(endColorVar.b) * [randomNum])}]
        set ::particle($me,color.r) $start_r
        set ::particle($me,color.g) $start_g
        set ::particle($me,color.b) $start_b

        # --- calculate the lifespan of this particle
        #     we know *exactly* how long it will live, even before it's born...
        set life [expr {
            $::emitter(life) + int($::emitter(lifeVar) * [randomNum])}]
        if {$life <= 0} {set life 10}
        set ::particle($me,life) $life

        # --- calculate the color delta using the lifespan of this particle
        set ::particle($me,deltaColor.r) [expr {($end_r - $start_r) / $life}]
        set ::particle($me,deltaColor.g) [expr {($end_g - $start_g) / $life}]
        set ::particle($me,deltaColor.b) [expr {($end_b - $start_b) / $life}]

        # --- A new particle is born - it's a beautiful thing...
        return 1
    }
}

proc updateParticle {me} {

    # --- if this particle has died, prepare it for resurrection...
    if {$::particle($me,life) <= 0} {
        incr ::emitter(particleCount) -1
        .c1 itemconfigure $me -tag dead
        .c1 coords $me -10 -10 -10 -10
        return 0

    } else {

        # --- save it's old position as the next start coord
        set ::particle($me,prevPos.x) $::particle($me,pos.x)
        set ::particle($me,prevPos.y) $::particle($me,pos.y)
        set ::particle($me,prevPos.z) $::particle($me,pos.z)

        # --- update the new end coordinates by the particles motion vectors
        set ::particle($me,pos.x) [expr {$::particle($me,pos.x) + 
                                               $::particle($me,dir.x)}]
        set ::particle($me,pos.y) [expr {$::particle($me,pos.y) + 
                                               $::particle($me,dir.y)}]
        set ::particle($me,pos.z) [expr {$::particle($me,pos.z) + 
                                               $::particle($me,dir.z)}]

        # --- apply global forces to the particle
        set ::particle($me,dir.x) [expr {$::particle($me,dir.x) + 
                                               $::emitter(force.x)}]
        set ::particle($me,dir.y) [expr {$::particle($me,dir.y) + 
                                               $::emitter(force.y)}]
        set ::particle($me,dir.z) [expr {$::particle($me,dir.z) + 
                                               $::emitter(force.z)}]

        # --- update the particle color
        set ::particle($me,color.r) [expr {$::particle($me,color.r) + 
                                                 $::particle($me,deltaColor.r)}]
        set ::particle($me,color.g) [expr {$::particle($me,color.g) + 
                                                 $::particle($me,deltaColor.g)}]
        set ::particle($me,color.b) [expr {$::particle($me,color.b) + 
                                                 $::particle($me,deltaColor.b)}]

        # --- Age the particle...
        #     In the immortal words of Pink Floyd...
        #     "The sun is the same in a relative way, but you're older"
        #     "Shorter of breath and one day closer to death"
        incr ::particle($me,life) -1
        set x_org $::emitter(pos.x)
        set y_org $::emitter(pos.y)
        set xStart [expr {$x_org + $::particle($me,prevPos.x)}]
        set yStart [expr {$y_org + $::particle($me,prevPos.y)}]
        set xEnd   [expr {$x_org + $::particle($me,pos.x)}]
        set yEnd   [expr {$y_org + $::particle($me,pos.y)}]
        .c1 coords $me $xStart $yStart $xEnd $yEnd
        .c1 itemconfigure $me -fill [createColor $::particle($me,color.r) \
            $::particle($me,color.g) $::particle($me,color.b)]
        return 1
    }
}

proc createColor {r g b} {
    # --- convert all passed vals to ints
    set r [expr {int($r)}]
    set g [expr {int($g)}]
    set b [expr {int($b)}]

    # --- push colors within valid range
    if {$r > 255} {set r 255}
    if {$g > 255} {set g 255}
    if {$b > 255} {set b 255}
    if {$r < 0}   {set r 0}
    if {$g < 0}   {set g 0}
    if {$b < 0}   {set b 0}

    # --- return a TK acceptable color string
    return [format "#%02x%02x%02x" $r $g $b]
}

# --- this lacks *a lot*.  It should allow GUI access to a total of
#     26 emitter variables, not just 3 - maybe someday...
proc buildUI {} {
    wm title . {Particle System Editor}
    canvas .c1 -bg black -width 600 -height 400 -highlightthickness 0 -borderwidth 0
    bind .c1 <Configure> {
        initVars
        animate
        bind .c1 <Configure> {}
    }
    bind .c1 <B1-Motion> {updateEmitterLoc %x %y}
    bind .c1 <ButtonPress-1> {updateEmitterLoc %x %y}
    frame .f1
    button .f1.btnExit -text "Exit" -width 10 -command {set ::emitter(alive) 0}

    pack .c1 -side left -fill both -expand 1
    pack .f1 -side left -fill y
    grid .f1.btnExit -  -row 999 -sticky s -padx 10
    grid rowconfig .f1 999 -weight 1
}

# --- generate a random in the range of "-1 to < 1"
proc randomNum {} {
    return [expr {(-.5 + rand()) * 2.0}]
}

proc degreeToRad degrees {
    return [expr {$degrees / 57.2957795786}]
}

# --- move the emitter to the specific location
proc updateEmitterLoc {x y} {
    set ::emitter(pos.x) $x
    set ::emitter(pos.y) $y
}

proc rotationToDirection {pitch yaw} {
    set x [expr {-sin($yaw) * cos($pitch)}]
    set y [expr {sin($pitch)}]
    set z [expr {cos($pitch) * cos($yaw)}]
    return [list $x $y $z]
}

buildUI