Setok You wouldn't be interested in implementing something like this with Oil per chance? ;-)
A starkit version of this code is available on sdarchive.
Changes edit
BBH: I took the liberty of updating the GUI a bit to expose more of the elements, hope you don't mind ;^)
Part of the reason I didn't expose more vars in the GUI is: 1) I was out of weekend; and more importantly 2) I didn't have a good idea for cleanly creating 26 sliders (without just plain old brute force). Anyway, it looks like you solved both. Nicely done - Thanks Jeff Godfrey
Tom Krehbiel: Fixed a divide by zero error caused by the "life" variable.
Tom, good catch. This is really related to the fact that we've allowed the lower end of the "life" range to be 10, and the random variation to be the range of "-15 to 15". If the life setting - the random setting == 0, boom!. We probably shouldn't allow the random variation to equal or exceed the lower bounds of the life var, but it's a good check anyway. Also, allowing a particle to be born with a negative lifespan seems kind of cruel, so I changed your check to be "if {$life <= 0} {set life 10}". That way, every particle has a chance... ;) Jeff Godfrey
PYK 2012-12-09: eliminated update
Code edit
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
jcw 2003-02-2: There was a bad .c1 create line ... in the above code, I've edited it (look for "jcw" comment line). This just happened to be let through by 8.4.1, but 8.4.2 is stricter and complains about missing coordinates.
FW: I added a line to keep the program from producing an error when you close it. Also, just for the record, # signs never need to be escaped unless they're the first character of a line of code. KBK 2003-06-01 - Many of us prefer to escape most # characters, not because Tcl requires it, but because syntax-coloring editors are easy to confuse.
