OUTPUT BUFFER:
# Lesson36.tcl # # Dario Corno's Radial Blur & Rendering To A Texture Tutorial # # 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/08/23 # 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 listFont {-family {Courier} -size 10} # Display mode. set fullScreen false # Window size. set gDemo(winWidth) 640 set gDemo(winHeight) 480 set stopwatch [tcl3dNewSwatch] set angle 0.0 ; # Used To Rotate The Helix set BlurTexture [tcl3dVector GLuint 1] ; # Storage For One Texture # 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 { $::fullScreen } { SetFullScreenMode . set ::fullScreen false } else { SetWindowMode . $::gDemo(winWidth) $::gDemo(winHeight) set ::fullScreen true } } proc GetElapsedSeconds {} { set currentTime [tcl3dLookupSwatch $::stopwatch] set sec [expr $currentTime - $::elapsedLastTime] set ::elapsedLastTime $currentTime return $sec } # Create An Empty Texture proc EmptyTexture {} { # Create Storage Space For Texture Data (128x128x4) set data [tcl3dVector GLubyte [expr 128 * 128 * 4]] # ZeroMemory(data,((128 * 128)* 4 * sizeof(unsigned int))); // Clear Storage Memory glGenTextures 1 $::BlurTexture ; # Create 1 Texture glBindTexture GL_TEXTURE_2D [$::BlurTexture get 0] ; # Bind The Texture glTexImage2D GL_TEXTURE_2D 0 4 128 128 0 GL_RGBA GL_UNSIGNED_BYTE $data glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_LINEAR glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_LINEAR $data delete ; # Release data } # Draws A Helix proc ProcessHelix {} { set r 1.5 ; # Radius Of Twist set twists 5 ; # 5 Twists set glfMaterialColor {0.4 0.2 0.8 1.0} ; # Set The Material Color set specular {1.0 1.0 1.0 1.0} ; # Sets Up Specular Lighting glLoadIdentity ; # Reset The Modelview Matrix gluLookAt 0 5 50 0 0 0 0 1 0 ; # Eye Position (0,5,50) Center Of Scene (0,0,0), Up On Y Axis glPushMatrix ; # Push The Modelview Matrix glTranslatef 0 0 -50 ; # Translate 50 Units Into The Screen glRotatef [expr {$::angle/2.0}] 1 0 0 ; # Rotate By angle/2 On The X-Axis glRotatef [expr {$::angle/3.0}] 0 1 0 ; # Rotate By angle/3 On The Y-Axis glMaterialfv GL_FRONT_AND_BACK GL_AMBIENT_AND_DIFFUSE $glfMaterialColor glMaterialfv GL_FRONT_AND_BACK GL_SPECULAR $specular tcl3dHelix 0.0 0.0 0.0 $r $twists glPopMatrix ; # Pop The Matrix } # Set Up An Ortho View proc ViewOrtho {} { glMatrixMode GL_PROJECTION ; # Select Projection glPushMatrix ; # Push The Matrix glLoadIdentity ; # Reset The Matrix glOrtho 0 $::gDemo(winWidth) $::gDemo(winHeight) 0 -1 1 ; # Select Ortho Mode glMatrixMode GL_MODELVIEW ; # Select Modelview Matrix glPushMatrix ; # Push The Matrix glLoadIdentity ; # Reset The Matrix } # Set Up A Perspective View proc ViewPerspective {} { glMatrixMode GL_PROJECTION ; # Select Projection glPopMatrix ; # Pop The Matrix glMatrixMode GL_MODELVIEW ; # Select Modelview glPopMatrix ; # Pop The Matrix } # Renders To A Texture proc RenderToTexture {} { glViewport 0 0 128 128 ; # Set Our Viewport (Match Texture Size) ProcessHelix ; # Render The Helix glBindTexture GL_TEXTURE_2D [$::BlurTexture get 0] ; # Bind To The Blur Texture # Copy Our ViewPort To The Blur Texture (From 0,0 To 128,128... No Border) glCopyTexImage2D GL_TEXTURE_2D 0 GL_LUMINANCE 0 0 128 128 0 glClearColor 0.0 0.0 0.5 0.5 ; # Set The Clear Color To Medium Blue glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT] glViewport 0 0 $::gDemo(winWidth) $::gDemo(winHeight) ; # Set Viewport } # Draw The Blurred Image proc DrawBlur { times inc } { set spost 0.0 ; # Starting Texture Coordinate Offset set alphainc [expr {0.9 / $times}] ; # Fade Speed For Alpha Blending set alpha 0.2 ; # Starting Alpha Value # Disable AutoTexture Coordinates glDisable GL_TEXTURE_GEN_S glDisable GL_TEXTURE_GEN_T glEnable GL_TEXTURE_2D ; # Enable 2D Texture Mapping glDisable GL_DEPTH_TEST ; # Disable Depth Testing glBlendFunc GL_SRC_ALPHA GL_ONE ; # Set Blending Mode glEnable GL_BLEND ; # Enable Blending glBindTexture GL_TEXTURE_2D [$::BlurTexture get 0] ViewOrtho ; # Switch To An Ortho View set alphainc [expr {$alpha / $times}] ; # alphainc=0.2f / Times To Render Blur glBegin GL_QUADS ; # Begin Drawing Quads # Number Of Times To Render Blur for { set num 0 } { $num < $times } {incr num } { glColor4f 1.0 1.0 1.0 $alpha ; # Set The Alpha Value (Starts At 0.2) glTexCoord2f [expr {0+$spost}] [expr {1-$spost}] ; # Texture Coordinate ( 0, 1 ) glVertex2f 0 0 ; # First Vertex glTexCoord2f [expr {0+$spost}] [expr {0+$spost}] ; # Texture Coordinate ( 0, 0 ) glVertex2f 0 $::gDemo(winHeight) ; # Second Vertex glTexCoord2f [expr {1-$spost}] [expr {0+$spost}] ; # Texture Coordinate ( 1, 0 ) glVertex2f $::gDemo(winWidth) $::gDemo(winHeight) ; # Third Vertex glTexCoord2f [expr {1-$spost}] [expr {1-$spost}] ; # Texture Coordinate ( 1, 1 ) glVertex2f $::gDemo(winWidth) 0 ; # Fourth Vertex set spost [expr {$spost + $inc}] ; # Gradually Increase spost (Zooming Closer To Texture Center) set alpha [expr {$alpha - $alphainc}] ; # Gradually Decrease alpha (Gradually Fading Image Out) } glEnd ; # Done Drawing Quads ViewPerspective ; # Switch To A Perspective View glEnable GL_DEPTH_TEST ; # Enable Depth Testing glDisable GL_TEXTURE_2D ; # Disable 2D Texture Mapping glDisable GL_BLEND ; # Disable Blending glBindTexture GL_TEXTURE_2D 0 ; # Unbind The Blur Texture } # 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 50 [expr double($w)/double($h)] 5 2000 ; # Set Our Perspective 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 } { global gDemo EmptyTexture ; # Create Our Empty Texture glViewport 0 0 $gDemo(winWidth) $gDemo(winHeight) ; # Set Up A Viewport glMatrixMode GL_PROJECTION ; # Select The Projection Matrix glLoadIdentity ; # Reset The Projection Matrix # Set Our Perspective gluPerspective 50 [expr double($gDemo(winWidth))/double($gDemo(winHeight))] 5 2000 glMatrixMode GL_MODELVIEW ; # Select The Modelview Matrix glLoadIdentity ; # Reset The Modelview Matrix glEnable GL_DEPTH_TEST ; # Enable Depth Testing set global_ambient {0.2 0.2 0.2 1.0} ; # Set Ambient Lighting To Fairly Dark Light (No Color) set light0pos {0.0 5.0 10.0 1.0} ; # Set The Light Position set light0ambient {0.2 0.2 0.2 1.0} ; # More Ambient Light set light0diffuse {0.3 0.3 0.3 1.0} ; # Set The Diffuse Light A Bit Brighter set light0specular {0.8 0.8 0.8 1.0} ; # Fairly Bright Specular Lighting set lmodel_ambient {0.2 0.2 0.2 1.0} ; # And More Ambient Light glLightModelfv GL_LIGHT_MODEL_AMBIENT $lmodel_ambient ; # Set The Ambient Light Model glLightModelfv GL_LIGHT_MODEL_AMBIENT $global_ambient ; # Set The Global Ambient Light Model glLightfv GL_LIGHT0 GL_POSITION $light0pos ; # Set The Lights Position glLightfv GL_LIGHT0 GL_AMBIENT $light0ambient ; # Set The Ambient Light glLightfv GL_LIGHT0 GL_DIFFUSE $light0diffuse ; # Set The Diffuse Light glLightfv GL_LIGHT0 GL_SPECULAR $light0specular ; # Set Up Specular Lighting glEnable GL_LIGHTING ; # Enable Lighting glEnable GL_LIGHT0 ; # Enable Light0 glShadeModel GL_SMOOTH ; # Select Smooth Shading glMateriali GL_FRONT GL_SHININESS 128 glClearColor 0.0 0.0 0.0 0.5 ; # Set The Clear Color To Black tcl3dResetSwatch $::stopwatch set ::elapsedLastTime [tcl3dLookupSwatch $::stopwatch] } # Here's Where We Do All The Drawing proc DisplayCallback { toglwin } { # Update Angle Based On The Clock set ::angle [expr $::angle + [GetElapsedSeconds] * 200.0] glClearColor 0.0 0.0 0.0 0.5 ; # Set The Clear Color To Black glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT] ; # Clear Screen And Depth Buffer # 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 View RenderToTexture ; # Render To A Texture ProcessHelix ; # Draw Our Helix DrawBlur 25 0.02 ; # Draw The Blur Effect glFlush ; # Flush The GL Rendering Pipeline $toglwin swapbuffers } proc Animate {} { .fr.toglwin postredisplay set ::animateId [tcl3dAfterIdle Animate] } proc StartAnimation {} { tcl3dStartSwatch $::stopwatch if { ! [info exists ::animateId] } { Animate } } proc StopAnimation {} { tcl3dStopSwatch $::stopwatch if { [info exists ::animateId] } { after cancel $::animateId unset ::animateId } } proc Cleanup {} { if { [info exists ::BlurTexture] } { glDeleteTextures 1 [$::BlurTexture get 0] ; # Delete The Shader Texture $::BlurTexture delete } } # 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 $::listFont -height 3 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: rIO And NeHe's RadialBlur Tutorial (Lesson 36)" # Watch For ESC Key And Quit Messages wm protocol . WM_DELETE_WINDOW "ExitProg" bind .