OUTPUT BUFFER:
# Lesson26.tcl # # Banu Octavian & NeHe's Stencil & Reflection Tutorial # # This code has been created by Banu Octavian aka Choko - 20 may 2000 # and uses NeHe tutorials as a starting point (window initialization, # texture loading, GL initialization and code for keypresses) - very good # tutorials, Jeff. If anyone is interested about the presented algorithm # please e-mail me at boct@romwest.ro # # Code Commmenting And Clean Up By Jeff Molofee ( NeHe ) # 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/16 # See www.tcl3d.org for the Tcl3D extension. package require Img package require tcl3d 0.3.2 # Font to be used in the Tk listbox. set listFont {-family {Courier} -size 10} # Determine the directory of this script. set gDemo(scriptDir) [file dirname [info script]] # Display mode. set fullScreen false # Window size. set gDemo(winWidth) 640 set gDemo(winHeight) 480 set xrot 0.0 ; # X Rotation set yrot 0.0 ; # Y Rotation set xrotspeed 0.0 ; # X Rotation Speed set yrotspeed 0.5 ; # Y Rotation Speed set zoom -7.0 ; # Depth Into The Screen set height 2.0 ; # Height Of Ball From Floor set LightAmb { 0.7 0.7 0.7 1.0 } ; # Ambient Light set LightDif { 1.0 1.0 1.0 1.0 } ; # Diffuse Light set LightPos { 4.0 4.0 6.0 1.0 } ; # Light Position set texture [tcl3dVector GLuint 3] ; # Storage For 3 Textures # 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 SetXRotSpeed { val } { set ::xrotspeed [expr $::xrotspeed + $val] } proc SetYRotSpeed { val } { set ::yrotspeed [expr $::yrotspeed + $val] } proc SetZoom { val } { set ::zoom [expr $::zoom + $val] .fr.toglwin postredisplay } proc SetHeight { val } { set ::height [expr $::height + $val] .fr.toglwin postredisplay } proc LoadImage { imgName numChans } { if { $numChans != 3 && $numChans != 4 } { error "Error: Only 3 or 4 channels allowed ($numChans supplied)" } set texName [file join $::gDemo(scriptDir) "Data" $imgName] 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 texImg [tcl3dVectorFromPhoto $phImg $numChans] image delete $phImg } return [list $texImg $w $h] } # Load Bitmaps And Convert To Textures proc LoadGLTextures {} { # Load The Floor Texture set imgInfo [LoadImage "Envwall.bmp" 3] set imgData(0) [lindex $imgInfo 0] set imgWidth(0) [lindex $imgInfo 1] set imgHeight(0) [lindex $imgInfo 2] # Load The Light Texture set imgInfo [LoadImage "Ball.bmp" 3] set imgData(1) [lindex $imgInfo 0] set imgWidth(1) [lindex $imgInfo 1] set imgHeight(1) [lindex $imgInfo 2] # Load The Wall Texture set imgInfo [LoadImage "Envroll.bmp" 3] set imgData(2) [lindex $imgInfo 0] set imgWidth(2) [lindex $imgInfo 1] set imgHeight(2) [lindex $imgInfo 2] glGenTextures 3 $::texture ; # Create Three Textures for { set i 0 } { $i < 3 } { incr i } { glBindTexture GL_TEXTURE_2D [$::texture get $i] glTexImage2D GL_TEXTURE_2D 0 3 $imgWidth($i) $imgHeight($i) \ 0 GL_RGB GL_UNSIGNED_BYTE $imgData($i) glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_LINEAR glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_LINEAR } # Delete the image data vectors. for { set i 0 } { $i < 3 } { incr i } { $imgData($i) delete } } # Draw Our Ball proc DrawObject {} { glColor3f 1.0 1.0 1.0 ; # Set Color To White glBindTexture GL_TEXTURE_2D [$::texture get 1] ; # Select Texture 2 (1) gluSphere $::quadric 0.35 32 16 ; # Draw First Sphere glBindTexture GL_TEXTURE_2D [$::texture get 2] ; # Select Texture 3 (2) glColor4f 1.0 1.0 1.0 0.4 ; # Set Color To White With 40% Alpha glEnable GL_BLEND ; # Enable Blending glBlendFunc GL_SRC_ALPHA GL_ONE ; # Set Blending Mode To Mix Based On SRC Alpha glEnable GL_TEXTURE_GEN_S ; # Enable Sphere Mapping glEnable GL_TEXTURE_GEN_T ; # Enable Sphere Mapping gluSphere $::quadric 0.35 32 16 ; # Draw Another Sphere Using New Texture # Textures Will Mix Creating A MultiTexture Effect (Reflection) glDisable GL_TEXTURE_GEN_S ; # Disable Sphere Mapping glDisable GL_TEXTURE_GEN_T ; # Disable Sphere Mapping glDisable GL_BLEND ; # Disable Blending } # Draw The Floor proc DrawFloor {} { glBindTexture GL_TEXTURE_2D [$::texture get 0] ; # Select Texture 1 (0) glBegin GL_QUADS ; # Begin Drawing A Quad glNormal3f 0.0 1.0 0.0 ; # Normal Pointing Up glTexCoord2f 0.0 1.0 ; # Bottom Left Of Texture glVertex3f -2.0 0.0 2.0 ; # Bottom Left Corner Of Floor glTexCoord2f 0.0 0.0 ; # Top Left Of Texture glVertex3f -2.0 0.0 -2.0 ; # Top Left Corner Of Floor glTexCoord2f 1.0 0.0 ; # Top Right Of Texture glVertex3f 2.0 0.0 -2.0 ; # Top Right Corner Of Floor glTexCoord2f 1.0 1.0 ; # Bottom Right Of Texture glVertex3f 2.0 0.0 2.0 ; # Bottom Right Corner Of Floor glEnd ; # Done Drawing The Quad } # Resize And Initialize The GL Window proc tclReshapeFunc { toglwin w h } { # Prevent A Divide By Zero By if { $h == 0 } { set h 1 } 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 100.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 tclCreateFunc { toglwin } { LoadGLTextures ; # Jump To Texture Loading Routine glShadeModel GL_SMOOTH ; # Enable Smooth Shading glClearColor 0.2 0.5 1.0 1.0 ; # Background glClearDepth 1.0 ; # Depth Buffer Setup glClearStencil 0 ; # Clear The Stencil Buffer To 0 glEnable GL_DEPTH_TEST ; # Enables Depth Testing glDepthFunc GL_LEQUAL ; # The Type Of Depth Testing To Do glHint GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST ; # Really Nice Perspective Calculations glEnable GL_TEXTURE_2D ; # Enable 2D Texture Mapping glLightfv GL_LIGHT0 GL_AMBIENT $::LightAmb ; # Set The Ambient Lighting For Light0 glLightfv GL_LIGHT0 GL_DIFFUSE $::LightDif ; # Set The Diffuse Lighting For Light0 glLightfv GL_LIGHT0 GL_POSITION $::LightPos ; # Set The Position For Light0 glEnable GL_LIGHT0 ; # Enable Light 0 glEnable GL_LIGHTING ; # Enable Lighting set ::quadric [gluNewQuadric] ; # Create A New Quadratic gluQuadricNormals $::quadric GL_SMOOTH ; # Generate Smooth Normals For The Quad gluQuadricTexture $::quadric GL_TRUE ; # Enable Texture Coords For The Quad glTexGeni GL_S GL_TEXTURE_GEN_MODE $::GL_SPHERE_MAP ; # Set Up Sphere Mapping glTexGeni GL_T GL_TEXTURE_GEN_MODE $::GL_SPHERE_MAP ; # Set Up Sphere Mapping } # Here's Where We Do All The Drawing proc tclDisplayFunc { toglwin } { glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT | $::GL_STENCIL_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 $::gDemo(winWidth) $::gDemo(winHeight) # Clip Plane Equations set eqr { 0.0 -1.0 0.0 0.0 } ; # Plane Equation To Use For The Reflected Objects glLoadIdentity ; # Reset The Modelview Matrix glTranslatef 0.0 -0.6 $::zoom ; # Zoom And Raise Camera Above The Floor (Up 0.6 Units) glColorMask 0 0 0 0 ; # Set Color Mask glEnable GL_STENCIL_TEST ; # Enable Stencil Buffer For "marking" The Floor glStencilFunc GL_ALWAYS 1 1 ; # Always Passes, 1 Bit Plane, 1 As Mask glStencilOp GL_KEEP GL_KEEP GL_REPLACE ; # We Set The Stencil Buffer To 1 Where We Draw Any Polygon # Keep If Test Fails, Keep If Test Passes But Buffer Test Fails # Replace If Test Passes glDisable GL_DEPTH_TEST ; # Disable Depth Testing DrawFloor ; # Draw The Floor (Draws To The Stencil Buffer) # We Only Want To Mark It In The Stencil Buffer glEnable GL_DEPTH_TEST ; # Enable Depth Testing glColorMask 1 1 1 1 ; # Set Color Mask to TRUE, TRUE, TRUE, TRUE glStencilFunc GL_EQUAL 1 1 ; # We Draw Only Where The Stencil Is 1 # (I.E. Where The Floor Was Drawn) glStencilOp GL_KEEP GL_KEEP GL_KEEP ; # Don't Change The Stencil Buffer glEnable GL_CLIP_PLANE0 ; # Enable Clip Plane For Removing Artifacts # (When The Object Crosses The Floor) glClipPlane GL_CLIP_PLANE0 $eqr ; # Equation For Reflected Objects glPushMatrix ; # Push The Matrix Onto The Stack glScalef 1.0 -1.0 1.0 ; # Mirror Y Axis glLightfv GL_LIGHT0 GL_POSITION $::LightPos ; # Set Up Light0 glTranslatef 0.0 $::height 0.0 ; # Position The Object glRotatef $::xrot 1.0 0.0 0.0 ; # Rotate Local Coordinate System On X Axis glRotatef $::yrot 0.0 1.0 0.0 ; # Rotate Local Coordinate System On Y Axis DrawObject ; # Draw The Sphere (Reflection) glPopMatrix ; # Pop The Matrix Off The Stack glDisable GL_CLIP_PLANE0 ; # Disable Clip Plane For Drawing The Floor glDisable GL_STENCIL_TEST ; # We Don't Need The Stencil Buffer Any More (Disable) glLightfv GL_LIGHT0 GL_POSITION $::LightPos ; # Set Up Light0 Position glEnable GL_BLEND ; # Enable Blending (Otherwise The Reflected Object Wont Show) glDisable GL_LIGHTING ; # Since We Use Blending, We Disable Lighting glColor4f 1.0 1.0 1.0 0.8 ; # Set Color To White With 80% Alpha glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA ; # Blending Based On Source Alpha And 1 Minus Dest Alpha DrawFloor ; # Draw The Floor To The Screen glEnable GL_LIGHTING ; # Enable Lighting glDisable GL_BLEND ; # Disable Blending glTranslatef 0.0 $::height 0.0 ; # Position The Ball At Proper Height glRotatef $::xrot 1.0 0.0 0.0 ; # Rotate On The X Axis glRotatef $::yrot 0.0 1.0 0.0 ; # Rotate On The Y Axis DrawObject ; # Draw The Ball if { [info exists ::animateId] } { set ::xrot [expr $::xrot + $::xrotspeed] ; # Update X Rotation Angle By xrotspeed set ::yrot [expr $::yrot + $::yrotspeed] ; # Update Y Rotation Angle By Yrotspeed } glFlush ; # Flush The GL Pipeline $toglwin swapbuffers } proc Animate {} { .fr.toglwin postredisplay set ::animateId [after idle Animate] } proc StartAnimation {} { if { ! [info exists ::animateId] } { Animate } } proc StopAnimation {} { if { [info exists ::animateId] } { after cancel $::animateId unset ::animateId } } proc Cleanup {} { if { [info exists ::quadric] } { gluDeleteQuadric $::quadric } } # 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) \ -swapinterval 1 \ -double true -depth true -alpha true -stencil true \ -createproc tclCreateFunc \ -reshapeproc tclReshapeFunc \ -displayproc tclDisplayFunc listbox .fr.usage -font $::listFont -height 7 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: Banu Octavian & NeHe's Stencil & Reflection Tutorial (Lesson 26)" # Watch For ESC Key And Quit Messages wm protocol . WM_DELETE_WINDOW "ExitProg" bind .