OUTPUT BUFFER:
# Lesson19.tcl # # NeHe's Particle Tutorial # # This Code Was Created By Jeff Molofee 2000 # If You've Found This Code Useful, Please Let Me Know. # Visit My Site At nehe.gamedev.net # # Modified for Tcl3D by Paul Obermeier 2006/03/14 # See www.tcl3d.org for the Tcl3D extension. package require Img package require tcl3d 0.5.0 # Font to be used in the Tk listbox. set gDemo(listFont) {-family {Courier} -size 10} # Determine the directory of this script. set gDemo(scriptDir) [file dirname [info script]] set MAX_PARTICLES 100 ; # Number Of Particles To Create # Window size. set gDemo(winWidth) 640 set gDemo(winHeight) 480 # Display mode. set gDemo(fullScreen) 0 set gDemo(rainbow) 1 set gDemo(slowdown) 2.0 ; # Slow Down Particles set gDemo(xspeed) 0.0 ; # Base X Speed (To Allow Keyboard Direction Of Tail) set gDemo(yspeed) 0.0 ; # Base Y Speed (To Allow Keyboard Direction Of Tail) set gDemo(zoom) -20.0 ; # Used To Zoom Out set gDemo(col) 0 ; # Current Color Selection set gDemo(delay) 0 ; # Rainbow Effect Delay set gDemo(texture) [tcl3dVector GLuint 1] ; # Storage For One Texture # Particles are stored in a Tcl array # bool active; // Active (Yes/No) # float life; // Particle Life # float fade; // Fade Speed # float r; // Red Value # float g; // Green Value # float b; // Blue Value # float x; // X Position # float y; // Y Position # float z; // Z Position # float xi; // X Direction # float yi; // Y Direction # float zi; // Z Direction # float xg; // X Gravity # float yg; // Y Gravity # float zg; // Z Gravity # Rainbow Of Colors array set colors { 0 {1.0 0.5 0.5} 1 {1.0 0.75 0.5} 2 {1.0 1.0 0.5} 3 {0.75 1.0 0.5} 4 {0.5 1.0 0.5} 5 {0.5 1.0 0.75} 6 {0.5 1.0 1.0} 7 {0.5 0.75 1.0} 8 {0.5 0.5 1.0} 9 {0.75 0.5 1.0} 10 {1.0 0.5 1.0} 11 {1.0 0.5 0.75} } # Show errors occuring in the Togl callbacks. proc bgerror { msg } { tk_messageBox -icon error -type ok -message "Error: $msg\n\n$::errorInfo" ExitProg } # Print info message into widget a the bottom of the window. proc PrintInfo { msg } { if { [winfo exists .fr.info] } { .fr.info configure -text $msg } } proc SetFullScreenMode { win } { set sh [winfo screenheight $win] set sw [winfo screenwidth $win] wm minsize $win $sw $sh wm maxsize $win $sw $sh set fmtStr [format "%dx%d+0+0" $sw $sh] wm geometry $win $fmtStr wm overrideredirect $win 1 focus -force $win } proc SetWindowMode { win w h } { set sh [winfo screenheight $win] set sw [winfo screenwidth $win] wm minsize $win 10 10 wm maxsize $win $sw $sh set fmtStr [format "%dx%d+0+25" $w $h] wm geometry $win $fmtStr wm overrideredirect $win 0 focus -force $win } # Toggle between windowing and fullscreen mode. proc ToggleWindowMode {} { if { $::gDemo(fullScreen) } { SetFullScreenMode . set ::gDemo(fullScreen) false set ::gDemo(slowdown) 2.0 } else { SetWindowMode . $::gDemo(winWidth) $::gDemo(winHeight) set ::gDemo(fullScreen) true set ::gDemo(slowdown) 1.0 } } proc myRand {} { return [expr int (rand() * 32767.0)] } proc LoadGLTextures {} { # Load texture image. set texName [file join $::gDemo(scriptDir) "Data" "Particle.bmp"] set retVal [catch {set phImg [image create photo -file $texName]} err1] if { $retVal != 0 } { error "Error reading image $texName ($err1)" } else { set w [image width $phImg] set h [image height $phImg] set n [tcl3dPhotoChans $phImg] set TextureImage [tcl3dVectorFromPhoto $phImg] image delete $phImg } if { $n == 3 } { set type $::GL_RGB } else { set type $::GL_RGBA } glGenTextures 1 $::gDemo(texture) ; # Create One Texture glBindTexture GL_TEXTURE_2D [$::gDemo(texture) get 0] glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_LINEAR glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_LINEAR glTexImage2D GL_TEXTURE_2D 0 $n $w $h 0 $type GL_UNSIGNED_BYTE $TextureImage $TextureImage delete ; # Free The Texture Image Memory } # Resize And Initialize The GL Window proc ReshapeCallback { toglwin { w -1 } { h -1 } } { set w [$toglwin width] set h [$toglwin height] glViewport 0 0 $w $h ; # Reset The Current Viewport glMatrixMode GL_PROJECTION ; # Select The Projection Matrix glLoadIdentity ; # Reset The Projection Matrix # Calculate The Aspect Ratio Of The Window gluPerspective 45.0 [expr double($w)/double($h)] 0.1 200.0 glMatrixMode GL_MODELVIEW ; # Select The Modelview Matrix glLoadIdentity ; # Reset The Modelview Matrix set ::gDemo(winWidth) $w set ::gDemo(winHeight) $h } # All Setup For OpenGL Goes Here proc CreateCallback { toglwin } { LoadGLTextures ; # Jump To Texture Loading Routine glShadeModel GL_SMOOTH ; # Enable Smooth Shading glClearColor 0.0 0.0 0.0 0.0 ; # Black Background glClearDepth 1.0 ; # Depth Buffer Setup glDisable GL_DEPTH_TEST ; # Disable Depth Testing glEnable GL_BLEND ; # Enable Blending glBlendFunc GL_SRC_ALPHA GL_ONE ; # Type Of Blending To Perform glHint GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST ; # Really Nice Perspective Calculations glHint GL_POINT_SMOOTH_HINT GL_NICEST ; # Really Nice Point Smoothing glEnable GL_TEXTURE_2D ; # Enable Texture Mapping glBindTexture GL_TEXTURE_2D [$::gDemo(texture) get 0] ; # Select Our Texture for { set loop 0 } { $loop < $::MAX_PARTICLES } {incr loop } { # Initials All The Textures set ::particle($loop,active) 1 ; # Make All The Particles Active set ::particle($loop,life) 1.0 ; # Give All The Particles Full Life set ::particle($loop,fade) [expr ([myRand]%100)/1000.0+0.003] ; # Random Fade Speed set ind [expr $loop*(12/$::MAX_PARTICLES)] set ::particle($loop,r) [lindex $::colors($ind) 0] ; # Select Rainbow Color set ::particle($loop,g) [lindex $::colors($ind) 1] ; # Select Rainbow Color set ::particle($loop,b) [lindex $::colors($ind) 2] ; # Select Rainbow Color set ::particle($loop,xi) [expr (([myRand]%50)-26.0)*10.0] ; # Random Speed On X Axis set ::particle($loop,yi) [expr (([myRand]%50)-25.0)*10.0] ; # Random Speed On Y Axis set ::particle($loop,zi) [expr (([myRand]%50)-25.0)*10.0] ; # Random Speed On Z Axis set ::particle($loop,xg) 0.0 ; # Set Horizontal Pull To Zero set ::particle($loop,yg) -0.8 ; # Set Vertical Pull Downward set ::particle($loop,zg) 0.0 ; # Set Pull On Z Axis To Zero set ::particle($loop,x) 0.0 set ::particle($loop,y) 0.0 set ::particle($loop,z) 0.0 } } proc PullUp { toglwin } { # If Y Gravity Is Less Than 1.5 Increase Pull Upwards for { set loop 0 } { $loop < $::MAX_PARTICLES } {incr loop } { if { $::particle($loop,active) } { if { $::particle($loop,yg) < 1.5 } { set ::particle($loop,yg) [expr $::particle($loop,yg) + 0.01] } } } #$toglwin postredisplay } proc PullDown { toglwin } { # If Y Gravity Is Greater Than -1.5 Increase Pull Downwards for { set loop 0 } { $loop < $::MAX_PARTICLES } {incr loop } { if { $::particle($loop,active) } { if { $::particle($loop,yg) > -1.5 } { set ::particle($loop,yg) [expr $::particle($loop,yg) - 0.01] } } } #$toglwin postredisplay } proc PullRight { toglwin } { # If X Gravity Is Less Than 1.5 Increase Pull Right for { set loop 0 } { $loop < $::MAX_PARTICLES } {incr loop } { if { $::particle($loop,active) } { if { $::particle($loop,xg) < 1.5 } { set ::particle($loop,xg) [expr $::particle($loop,xg) + 0.01] } } } #$toglwin postredisplay } proc PullLeft { toglwin } { # If X Gravity Is Greater Than -1.5 Increase Pull Left for { set loop 0 } { $loop < $::MAX_PARTICLES } {incr loop } { if { $::particle($loop,active) } { if { $::particle($loop,xg) > -1.5 } { set ::particle($loop,xg) [expr $::particle($loop,xg) - 0.01] } } } #$toglwin postredisplay } proc Burst { toglwin } { for { set loop 0 } { $loop < $::MAX_PARTICLES } {incr loop } { if { $::particle($loop,active) } { set ::particle($loop,x) 0.0 ; # Center On X Axis set ::particle($loop,y) 0.0 ; # Center On Y Axis set ::particle($loop,z) 0.0 ; # Center On Z Axis set ::particle($loop,xi) [expr (([myRand]%50)-26.0)*10.0] ; # Random Speed On X Axis set ::particle($loop,yi) [expr (([myRand]%50)-25.0)*10.0] ; # Random Speed On Y Axis set ::particle($loop,zi) [expr (([myRand]%50)-25.0)*10.0] ; # Random Speed On Z Axis } } $toglwin postredisplay } proc IncreaseUpwardSpeed {} { if { $::gDemo(yspeed) < 200.0 } { set ::gDemo(yspeed) [expr $::gDemo(yspeed) + 1.0] } } # Increment zoom factor. proc IncrZoom { val } { set ::gDemo(zoom) [expr {$::gDemo(zoom) + $val}] } proc IncreaseDownwardSpeed {} { if { $::gDemo(yspeed) > -200.0 } { set ::gDemo(yspeed) [expr $::gDemo(yspeed) - 1.0] } } proc IncreaseRightSpeed {} { if { $::gDemo(xspeed) < 200.0 } { set ::gDemo(xspeed) [expr $::gDemo(xspeed) + 1.0] } } proc IncreaseLeftSpeed {} { if { $::gDemo(xspeed) > -200.0 } { set ::gDemo(xspeed) [expr $::gDemo(xspeed) - 1.0] } } proc SpeedUp {} { if { $::gDemo(slowdown) > 1.0 } { set ::gDemo(slowdown) [expr $::gDemo(slowdown) - 0.01] } } proc SlowDown {} { if { $::gDemo(slowdown) < 4.0 } { set ::gDemo(slowdown) [expr $::gDemo(slowdown) + 0.01] } } proc ToggleRainbow {} { set ::gDemo(rainbow) [expr 1 - $::gDemo(rainbow)] } proc ToggleColors {} { if { $::gDemo(rainbow) && ($::gDemo(delay) > 25) } { # Space Or Rainbow Mode #set ::gDemo(rainbow) 0 ; # If Spacebar Is Pressed Disable Rainbow Mode set gDemo(delay) 0 ; # Reset The Rainbow Color Cycling Delay incr ::gDemo(col) ; # Change The Particle Color if { $::gDemo(col) > 11 } { set ::gDemo(col) 0 ; # If Color Is To High Reset It } } } proc Animate {} { .fr.toglwin postredisplay set ::animateId [tcl3dAfterIdle Animate] } proc StartAnimation {} { if { ! [info exists ::animateId] } { Animate } } proc StopAnimation {} { if { [info exists ::animateId] } { after cancel $::animateId unset ::animateId } } # Here's Where We Do All The Drawing proc DisplayCallback { toglwin } { # Clear Screen And Depth Buffer glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT] # Viewport command is not really needed, but has been inserted for # Mac OSX. Presentation framework (Tk) does not send a reshape event, # when switching from one demo to another. glViewport 0 0 [$toglwin width] [$toglwin height] glLoadIdentity ; # Reset The Current Modelview Matrix set factor [expr { 1.0 / ($::gDemo(slowdown) * 1000)}] for { set loop 0 } { $loop < $::MAX_PARTICLES } {incr loop } { if { $::particle($loop,active) } { # If The Particle Is Active set x $::particle($loop,x) ; # Grab Our Particle X Position set y $::particle($loop,y) ; # Grab Our Particle Y Position set z [expr $::particle($loop,z) + $::gDemo(zoom)] ; # Particle Z Pos + Zoom # Draw The Particle Using Our RGB Values, Fade The Particle Based On It's Life glColor4f $::particle($loop,r) $::particle($loop,g) $::particle($loop,b) $::particle($loop,life) set x1 [expr {$x - 0.5}] set x2 [expr {$x + 0.5}] set y1 [expr {$y - 0.5}] set y2 [expr {$y + 0.5}] glBegin GL_TRIANGLE_STRIP ; # Build Quad From A Triangle Strip glTexCoord2d 1 1 ; glVertex3f $x2 $y2 $z ; # Top Right glTexCoord2d 0 1 ; glVertex3f $x1 $y2 $z ; # Top Left glTexCoord2d 1 0 ; glVertex3f $x2 $y1 $z ; # Bottom Right glTexCoord2d 0 0 ; glVertex3f $x1 $y1 $z ; # Bottom Left glEnd set ::particle($loop,x) [expr {$::particle($loop,x) + $::particle($loop,xi) * $factor}] set ::particle($loop,y) [expr {$::particle($loop,y) + $::particle($loop,yi) * $factor}] set ::particle($loop,z) [expr {$::particle($loop,z) + $::particle($loop,zi) * $factor}] set ::particle($loop,xi) [expr {$::particle($loop,xi) + $::particle($loop,xg)}] set ::particle($loop,yi) [expr {$::particle($loop,yi) + $::particle($loop,yg)}] set ::particle($loop,zi) [expr {$::particle($loop,zi) + $::particle($loop,zg)}] set ::particle($loop,life) [expr {$::particle($loop,life) - $::particle($loop,fade)}] if { $::particle($loop,life) < 0.0 } { # If Particle Is Burned Out set ::particle($loop,life) 1.0 ; # Give It New Life set ::particle($loop,fade) [expr ([myRand]%100)/1000.0+0.003] ; # Random Fade Value set ::particle($loop,x) 0.0 ; # Center On X Axis set ::particle($loop,y) 0.0 ; # Center On Y Axis set ::particle($loop,z) 0.0 ; # Center On Z Axis set ::particle($loop,xi) [expr $::gDemo(xspeed)+([myRand]%60)-32.0] ; # X Axis Speed And Direction set ::particle($loop,yi) [expr $::gDemo(yspeed)+([myRand]%60)-30.0] ; # Y Axis Speed And Direction set ::particle($loop,zi) [expr ([myRand]%60)-30.0] ; # Z Axis Speed And Direction set ::particle($loop,r) [lindex $::colors($::gDemo(col)) 0] ; # Select Red From Color Table set ::particle($loop,g) [lindex $::colors($::gDemo(col)) 1] ; # Select Green From Color Table set ::particle($loop,b) [lindex $::colors($::gDemo(col)) 2] ; # Select Blue From Color Table } } } $toglwin swapbuffers incr ::gDemo(delay) if { $::gDemo(rainbow) && ($::gDemo(delay) > 25) } { set gDemo(delay) 0 ; # Reset The Rainbow Color Cycling Delay incr ::gDemo(col) ; # Change The Particle Color if { $::gDemo(col) > 11 } { set ::gDemo(col) 0 ; # If Color Is To High Reset It } } } proc Cleanup {} { unset ::colors } # Put all exit related code here. proc ExitProg {} { exit } # Create the OpenGL window and some Tk helper widgets. proc CreateWindow {} { frame .fr pack .fr -expand 1 -fill both # Create Our OpenGL Window togl .fr.toglwin -width $::gDemo(winWidth) -height $::gDemo(winHeight) \ -double true -depth true \ -createproc CreateCallback \ -reshapeproc ReshapeCallback \ -displayproc DisplayCallback listbox .fr.usage -font $::gDemo(listFont) -height 11 label .fr.info grid .fr.toglwin -row 0 -column 0 -sticky news grid .fr.usage -row 1 -column 0 -sticky news grid .fr.info -row 2 -column 0 -sticky news grid rowconfigure .fr 0 -weight 1 grid columnconfigure .fr 0 -weight 1 wm title . "Tcl3D demo: NeHe's Particle Tutorial (Lesson 19)" # Watch For ESC Key And Quit Messages wm protocol . WM_DELETE_WINDOW "ExitProg" bind .