As a weekend project, I decided to play with a particle system. This system is not an original - it is a tcl adaptation of a system originally presented by Jeff Landers in an article in 1998. As far as particle systems go, it's pretty basic, but still fun to play with.
The GUI needs much more work, since of the 26 variables that can be set to effect (affect? - I *always* confuse those two...) the system, only 3 are presented. These include start and end colors, pitch angles, lifespan, speed, and a whole bunch of random factors. Check the "initVars" proc and adjust them as desired. Maybe someday I'll get around to adding more to the GUI.
More particles tend to be more interesting, but my sorry old 300MHz PII can't handle too many in tcl. The code desparately needs to be speeded up (and I'm sure it can be), but I haven't gotten there yet - I just got it working correctly.
I hope to do more work on it soon, but we all know how that goes. I though I'd place it here in case I never get back to it...
Enjoy.
proc main {} {
initVars
buildUI
animate}
proc animate {} {
# --- crank it as fast as we can...
while {$::emitter(alive)} {
nextFrame
update
}
exit}
proc initVars {} {
# --- Particle Emitter...
set ::emitter(alive) 1 ; # still running?
set ::emitter(pos.x) 300 ; # x position of emitter
set ::emitter(pos.y) 370 ; # y position of emitter
set ::emitter(pos.z) 0 ; # z position of emitter
set ::emitter(yaw) [degreeToRad 0] ; # initial yaw angle
set ::emitter(yawVar) [degreeToRad 360] ; # random variation range on yaw
set ::emitter(pitch) [degreeToRad -90] ; # initial pitch (up)
set ::emitter(pitchVar) [degreeToRad 40] ; # random variation range
set ::emitter(speed) 12 ; # particle speed
set ::emitter(speedVar) 2 ; # random variation range
set ::emitter(totalParticles) 50 ; # total particles in system
set ::emitter(particleCount) 0 ; # current particle count
set ::emitter(emitsPerFrame) 5 ; # number of particles/frame
set ::emitter(emitVar) 2 ; # random variation range
set ::emitter(life) 60 ; # particle life (frames)
set ::emitter(lifeVar) 15 ; # random variation
set ::emitter(startColor.r) 150 ; # start color (red component)
set ::emitter(startColor.g) 150 ; # start color (green component)
set ::emitter(startColor.b) 200 ; # start color (blue component)
set ::emitter(startColorVar.r) 25 ; # random variation - red
set ::emitter(startColorVar.g) 25 ; # random variation - green
set ::emitter(startColorVar.b) 25 ; # random variation - blue
set ::emitter(endColor.r) 0 ; # end color (red component)
set ::emitter(endColor.g) 0 ; # end color (green component)
set ::emitter(endColor.b) 200 ; # end color (blue component)
set ::emitter(endColorVar.r) 25 ; # random variation - red
set ::emitter(endColorVar.g) 25 ; # random variation - green
set ::emitter(endColorVar.b) 50 ; # random variation - blue
set ::emitter(force.x) 0.0 ; # x force factor (wind)
set ::emitter(force.y) 0.3 ; # y force factor (gravity)
set ::emitter(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 {
set me [.c1 create line -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])}]
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 for 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 {} {
canvas .c1 -bg black -width 600 -height 400 -highlightthickness 0 -borderwidth 0
frame .f1
pack .c1 -side left -fill both -expand 1
pack .f1 -side left -fill y -expand 1
scale .f1.s1 -from 1 -to 500 -label "Max Particles" -length 100 -showvalue 1 \
-orient horizontal -width 8 -sliderlength 15 -variable ::emitter(totalParticles)
scale .f1.s2 -from -5 -to 5 -label "Wind" -length 100 -showvalue 1 \
-orient horizontal -width 8 -sliderlength 15 -variable ::emitter(force.x) -resolution .1
scale .f1.s3 -from -5 -to 5 -label "Gravity" -length 100 -showvalue 1 \
-orient horizontal -width 8 -sliderlength 15 -variable ::emitter(force.y) -resolution .1
button .f1.btnExit -text "Exit" -width 10 -command {set ::emitter(alive) 0}
pack .f1.s1 .f1.s2 .f1.s3
pack .f1.btnExit -side bottom
bind .c1 <B1-Motion> {updateEmitterLoc %x %y}
bind .c1 <ButtonPress-1> {updateEmitterLoc %x %y}
wm title . "Particle System Editor"}
# --- 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 specifiec 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]}
main