OUTPUT BUFFER:
# shadowmap.tcl # # An example of the OpenGL red book modified to work with Tcl3D. # The original C sources are Copyright (c) 1993-2003, Silicon Graphics, Inc. # The Tcl3D sources are Copyright (c) 2005, Paul Obermeier. # See file LICENSE for complete license information. package require tcl3d 0.5.0 set SHADOW_MAP_WIDTH 256 set SHADOW_MAP_HEIGHT 256 set PI 3.14159265359 set fovy 60.0 set nearPlane 10.0 set farPlane 100.0 set angle 0.0 set torusAngle 0.0 set lightPos { 25.0 25.0 25.0 1.0 } set lookat { 0.0 0.0 0.0 } set up { 0.0 0.0 1.0 } set depthImage [tcl3dVector GLfloat [expr $::SHADOW_MAP_WIDTH*$::SHADOW_MAP_HEIGHT]] set showShadow 0 set textureOn 1 set compareMode 1 set funcMode 1 set animate 1 # Font to be used in the Tk listbox. set listFont {-family {Courier} -size 10} # Show errors occuring in the Togl callbacks. proc bgerror { msg } { tk_messageBox -icon error -type ok -message "Error: $msg\n\n$::errorInfo" exit } # 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 UpdateMsg { msgStr } { .fr.usage configure -state normal .fr.usage delete end .fr.usage insert end $msgStr .fr.usage configure -state disabled } proc CreateCallback { toglwin } { set white { 1.0 1.0 1.0 1.0 } if { [tcl3dOglHaveExtension "GL_ARB_shadow"] } { set ::GL_TEXTURE_COMPARE_MODE $::GL_TEXTURE_COMPARE_MODE_ARB set ::GL_TEXTURE_COMPARE_FUNC $::GL_TEXTURE_COMPARE_FUNC_ARB set ::GL_DEPTH_TEXTURE_MODE $::GL_DEPTH_TEXTURE_MODE_ARB set ::GL_COMPARE_R_TO_TEXTURE $::GL_COMPARE_R_TO_TEXTURE_ARB } glTexImage2D GL_TEXTURE_2D 0 $::GL_DEPTH_COMPONENT \ $::SHADOW_MAP_WIDTH $::SHADOW_MAP_HEIGHT 0 \ GL_DEPTH_COMPONENT GL_UNSIGNED_BYTE NULL glLightfv GL_LIGHT0 GL_POSITION $::lightPos glLightfv GL_LIGHT0 GL_SPECULAR $white glLightfv GL_LIGHT0 GL_DIFFUSE $white glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S $::GL_CLAMP_TO_EDGE glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T $::GL_CLAMP_TO_EDGE glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_LINEAR glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_LINEAR glTexParameteri GL_TEXTURE_2D $::GL_TEXTURE_COMPARE_FUNC $::GL_LEQUAL glTexParameteri GL_TEXTURE_2D $::GL_DEPTH_TEXTURE_MODE $::GL_LUMINANCE glTexParameteri GL_TEXTURE_2D $::GL_TEXTURE_COMPARE_MODE \ $::GL_COMPARE_R_TO_TEXTURE glTexGeni GL_S GL_TEXTURE_GEN_MODE $::GL_OBJECT_LINEAR glTexGeni GL_T GL_TEXTURE_GEN_MODE $::GL_OBJECT_LINEAR glTexGeni GL_R GL_TEXTURE_GEN_MODE $::GL_OBJECT_LINEAR glTexGeni GL_Q GL_TEXTURE_GEN_MODE $::GL_OBJECT_LINEAR glColorMaterial GL_FRONT_AND_BACK GL_AMBIENT_AND_DIFFUSE glCullFace GL_BACK glEnable GL_DEPTH_TEST glEnable GL_LIGHT0 glEnable GL_LIGHTING glEnable GL_TEXTURE_2D glEnable GL_TEXTURE_GEN_S glEnable GL_TEXTURE_GEN_T glEnable GL_TEXTURE_GEN_R glEnable GL_TEXTURE_GEN_Q glEnable GL_COLOR_MATERIAL glEnable GL_CULL_FACE } proc ReshapeCallback { toglwin { w -1 } { h -1 } } { set w [$toglwin width] set h [$toglwin height] glViewport 0 0 $w $h glMatrixMode GL_PROJECTION glLoadIdentity gluPerspective $::fovy [expr double($w)/double($h)] \ $::nearPlane $::farPlane glMatrixMode GL_MODELVIEW } proc StartAnimation {} { set ::angle [expr $::angle + $::PI / 10000] set ::torusAngle [expr $::torusAngle + 0.1] .fr.toglwin postredisplay set ::spinId [tcl3dAfterIdle StartAnimation] } proc StopAnimation {} { if { [info exists ::spinId] } { after cancel $::spinId } } proc ToggleTexture { toglwin } { set ::textureOn [expr 1 - $::textureOn] if { $::textureOn } { UpdateMsg "Texture on" glEnable GL_TEXTURE_2D } else { UpdateMsg "Texture off" glDisable GL_TEXTURE_2D } $toglwin postredisplay } proc ToggleCompareMode { toglwin } { set ::compareMode [expr 1 - $::compareMode] if { $::compareMode } { UpdateMsg "Compare mode on" glTexParameteri GL_TEXTURE_2D $::GL_TEXTURE_COMPARE_MODE \ $::GL_COMPARE_R_TO_TEXTURE } else { UpdateMsg "Compare mode off" glTexParameteri GL_TEXTURE_2D $::GL_TEXTURE_COMPARE_MODE $::GL_NONE } $toglwin postredisplay } proc ToggleFuncMode { toglwin } { set ::funcMode [expr 1 - $::funcMode] if { $::funcMode } { UpdateMsg "Operator GL_LEQUAL" glTexParameteri GL_TEXTURE_2D $::GL_TEXTURE_COMPARE_FUNC $::GL_LEQUAL } else { UpdateMsg "Operator GL_GEQUAL" glTexParameteri GL_TEXTURE_2D $::GL_TEXTURE_COMPARE_FUNC $::GL_GEQUAL } $toglwin postredisplay } proc ToggleShowShadow { toglwin } { set ::showShadow [expr 1 - $::showShadow] $toglwin postredisplay } proc ToggleAnimation { toglwin } { set ::animate [expr 1 - $::animate] if { $::animate } { StartAnimation } else { StopAnimation } } proc drawObjects { shadowRender } { global lightPos set ::textureOn [glIsEnabled GL_TEXTURE_2D] if { $shadowRender } { glDisable GL_TEXTURE_2D } if { ! $shadowRender } { glNormal3f 0 0 1 glColor3f 1 1 1 glRectf -20.0 -20.0 20.0 20.0 } glPushMatrix glTranslatef 11 11 11 glRotatef 54.73 -5 5 0 glRotatef $::torusAngle 1 0 0 glColor3f 1 0 0 glutSolidTorus 1 4 8 36 glPopMatrix glPushMatrix glTranslatef 2 2 2 glColor3f 0 0 1 glutSolidCube 4 glPopMatrix glPushMatrix glTranslatef [lindex $::lightPos 0] [lindex $::lightPos 1] [lindex $::lightPos 2] glColor3f 1 1 1 glutWireSphere 0.5 6 6 glPopMatrix if { $shadowRender && $::textureOn } { glEnable GL_TEXTURE_2D } } proc generateShadowMap { toglwin } { set litePos [tcl3dVector GLfloat 4] glGetLightfv GL_LIGHT0 GL_POSITION $litePos set viewport [tcl3dOglGetViewport] glViewport 0 0 $::SHADOW_MAP_WIDTH $::SHADOW_MAP_HEIGHT glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT] glMatrixMode GL_PROJECTION glPushMatrix glLoadIdentity gluPerspective 80.0 1.0 10.0 1000.0 glMatrixMode GL_MODELVIEW glPushMatrix glLoadIdentity gluLookAt [$litePos get 0] [$litePos get 1] [$litePos get 2] \ [lindex $::lookat 0] [lindex $::lookat 1] [lindex $::lookat 2] \ [lindex $::up 0] [lindex $::up 1] [lindex $::up 2] drawObjects 1 glPopMatrix glMatrixMode GL_PROJECTION glPopMatrix glMatrixMode GL_MODELVIEW glCopyTexImage2D GL_TEXTURE_2D 0 GL_DEPTH_COMPONENT 0 0 \ $::SHADOW_MAP_WIDTH $::SHADOW_MAP_HEIGHT 0 glViewport [lindex $viewport 0] [lindex $viewport 1] \ [lindex $viewport 2] [lindex $viewport 3] if { $::showShadow } { glReadPixels 0 0 $::SHADOW_MAP_WIDTH $::SHADOW_MAP_HEIGHT \ GL_DEPTH_COMPONENT GL_FLOAT $::depthImage glWindowPos2f [expr 0.5 * [lindex $viewport 2]] 0 glDrawPixels $::SHADOW_MAP_WIDTH $::SHADOW_MAP_HEIGHT GL_LUMINANCE \ GL_FLOAT $::depthImage $toglwin swapbuffers } $litePos delete } proc generateTextureMatrix {} { set tmptcl3dVector { 0.0 0.0 0.0 0.0 } set tmpMatrix [tcl3dVector GLfloat 16] set transposeMat [tcl3dVector GLfloat 16] # # Set up projective texture matrix. We use the GL_MODELVIEW matrix # stack and OpenGL matrix commands to make the matrix. # glPushMatrix glLoadIdentity glTranslatef 0.5 0.5 0.0 glScalef 0.5 0.5 1.0 gluPerspective 60.0 1.0 1.0 1000.0 gluLookAt [lindex $::lightPos 0] [lindex $::lightPos 1] [lindex $::lightPos 2] \ [lindex $::lookat 0] [lindex $::lookat 1] [lindex $::lookat 2] \ [lindex $::up 0] [lindex $::up 1] [lindex $::up 2] glGetFloatv GL_MODELVIEW_MATRIX $tmpMatrix glPopMatrix tcl3dMatfTranspose $tmpMatrix $transposeMat set j 0 for { set i 0 } { $i < 4 } { incr i } { lset tmptcl3dVector $j [$transposeMat get $i] incr j } glTexGenfv GL_S GL_OBJECT_PLANE $tmptcl3dVector set j 0 for { set i 4 } { $i < 8 } { incr i } { lset tmptcl3dVector $j [$transposeMat get $i] incr j } glTexGenfv GL_T GL_OBJECT_PLANE $tmptcl3dVector set j 0 for { set i 8 } { $i < 12 } { incr i } { lset tmptcl3dVector $j [$transposeMat get $i] incr j } glTexGenfv GL_R GL_OBJECT_PLANE $tmptcl3dVector set j 0 for { set i 12 } { $i < 16 } { incr i } { lset tmptcl3dVector $j [$transposeMat get $i] incr j } glTexGenfv GL_Q GL_OBJECT_PLANE $tmptcl3dVector $tmpMatrix delete $transposeMat delete } proc DisplayCallback { toglwin } { set radius 30.0 # 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] generateShadowMap $toglwin generateTextureMatrix if { $::showShadow } { return } glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT] glPushMatrix gluLookAt [expr $radius*cos($::angle)] [expr $radius*sin($::angle)] 30 \ [lindex $::lookat 0] [lindex $::lookat 1] [lindex $::lookat 2] \ [lindex $::up 0] [lindex $::up 1] [lindex $::up 2] drawObjects 0 glPopMatrix $toglwin swapbuffers } frame .fr pack .fr -expand 1 -fill both togl .fr.toglwin -width 512 -height 512 -double true -depth true \ -createproc CreateCallback \ -reshapeproc ReshapeCallback \ -displayproc DisplayCallback 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: OpenGL Red Book example shadowmap" bind .