Demo 13 of 19 in category CodeSampler
 |
#-----------------------------------------------------------------------------
# Name: ogl_occlusion_query_arb.cpp
# Author: Kevin Harris (kevin@codesampler.com)
# Last Modified: 02/01/05
# Description: This sample demonstrates how to use OpenGL's new extension,
# ARB_occlusion_query and NV_occlusion_query.
#
# Control Keys: Left Mouse Button - Spin the view
#-----------------------------------------------------------------------------
#
# Original C++ code by Kevin Harris (kevin@codesampler.com)
# See www.codesampler.com for the original files
# OpenGL samples page 7: Occlusion Query
#
# Modified for Tcl3D by Paul Obermeier 2007/03/10
# See www.tcl3d.org for the Tcl3D extension.
#
# This sample integrates ARB_occlusion_query and NV_occlusion_qeury code into one file.
# If called with no command line arguments, it uses the ARB_occlusion_query extension.
# Use "nv" as parameter to use the NV_occlusion_query extension.
package require Tk
package require tcl3d
# Font to be used in the Tk listbox.
set g_listFont {-family {Courier} -size 10}
set g_bUseArbExtension 1 ; # Use the ARB extension by default
set g_WinWidth 640
set g_WinHeight 480
set g_planeQuery [tcl3dVector GLuint 1]
set g_sphereQuery [tcl3dVector GLuint 1]
set g_LastMousePosX(1) 0
set g_LastMousePosY(1) 0
set g_fSpinX(1) 0.0
set g_fSpinY(1) 90.0
# 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 SetMouseInput { btn x y } {
set ::g_LastMousePosX($btn) $x
set ::g_LastMousePosY($btn) $y
}
proc GetMouseInput { btn x y } {
set nXDiff [expr ($x - $::g_LastMousePosX($btn))]
set nYDiff [expr ($y - $::g_LastMousePosY($btn))]
set ::g_fSpinX($btn) [expr $::g_fSpinX($btn) - $nXDiff]
set ::g_fSpinY($btn) [expr $::g_fSpinY($btn) - $nYDiff]
set ::g_LastMousePosX($btn) $x
set ::g_LastMousePosY($btn) $y
.fr.toglwin postredisplay
}
#-----------------------------------------------------------------------------
# Name: BeginRenderText
# Desc: Utility function for using the bitmap-based character fonts defined
# above. Call this function to begin rendering text. Call the function
# EndRenderText to stop.
#-----------------------------------------------------------------------------
proc BeginRenderText { toglwin nWindowWidth nWindowHeight } {
set ::FontBase [$toglwin loadbitmapfont]
# Push back and cache the current state of pixel alignment.
glPushClientAttrib GL_CLIENT_PIXEL_STORE_BIT
glPixelStorei GL_UNPACK_SWAP_BYTES $::GL_FALSE
glPixelStorei GL_UNPACK_LSB_FIRST $::GL_FALSE
glPixelStorei GL_UNPACK_ROW_LENGTH 0
glPixelStorei GL_UNPACK_SKIP_ROWS 0
glPixelStorei GL_UNPACK_SKIP_PIXELS 0
glPixelStorei GL_UNPACK_ALIGNMENT 1
# Push back and cache the current state of depth testing and lighting
# and then disable them.
glPushAttrib [expr $::GL_TEXTURE_BIT | $::GL_DEPTH_TEST | $::GL_LIGHTING]
glDisable GL_TEXTURE_2D
glDisable GL_DEPTH_TEST
glDisable GL_LIGHTING
# Push back the current matrices and go orthographic for text rendering.
glMatrixMode GL_PROJECTION
glPushMatrix
glLoadIdentity
glOrtho 0 $nWindowWidth $nWindowHeight 0 -1 1
glMatrixMode GL_MODELVIEW
glPushMatrix
glLoadIdentity
}
#-----------------------------------------------------------------------------
# Name: EndRenderText
# Desc: Utility function for using the bitmap-based character fonts defined
# above. Call this function to stop rendering text. The call to
# BeginRenderText should come first and be paired with this function.
#-----------------------------------------------------------------------------
proc EndRenderText { toglwin } {
$toglwin unloadbitmapfont $::FontBase
unset ::FontBase
# Pop everything back to what ever it was set to before we started
# rendering text to the screen.
glMatrixMode GL_PROJECTION
glPopMatrix
glMatrixMode GL_MODELVIEW
glPopMatrix
glPopClientAttrib
glPopAttrib
}
#-----------------------------------------------------------------------------
# Name: RenderText
# Desc: Utility function for using the bitmap-based character fonts defined
# above. This function must be called in between a call to
# BeginRenderText and EndRenderText. See the example below:
#
# BeginRenderText $toglwin $nWindowWidth $nWindowHeight
# RenderText 5 10 "This is a test!"
# EndRenderText $toglwin
#
#-----------------------------------------------------------------------------
proc RenderText { x y str } {
set len [string length $str]
if { $len > 0 } {
glRasterPos2f $x $y
glListBase $::FontBase
set sa [tcl3dVectorFromString GLubyte $str]
glCallLists $len GL_UNSIGNED_BYTE $sa
$sa delete
}
}
proc checkExtProc { extProc } {
if { ![tcl3dOglHaveFunc $extProc] } {
error "Extension proc $extProc not available"
}
}
proc CreateCallback { toglwin } {
glClearColor 0.35 0.53 0.7 1.0
glEnable GL_DEPTH_TEST
glDepthFunc GL_LEQUAL
glMatrixMode GL_PROJECTION
glLoadIdentity
gluPerspective 45.0 [expr double($::g_WinWidth)/double($::g_WinHeight)] \
0.1 100.0
if { $::g_bUseArbExtension } {
# Check for ARB_occlusion_query extension.
if { ![tcl3dOglHaveExtension $toglwin "GL_ARB_occlusion_query"] } {
error "Extension GL_ARB_occlusion_query missing"
}
checkExtProc "glGenQueriesARB"
checkExtProc "glDeleteQueriesARB"
checkExtProc "glIsQueryARB"
checkExtProc "glBeginQueryARB"
checkExtProc "glEndQueryARB"
checkExtProc "glGetQueryivARB"
checkExtProc "glGetQueryObjectivARB"
checkExtProc "glGetQueryObjectuivARB"
} else {
# Check for NV_occlusion_query extension.
if { ![tcl3dOglHaveExtension "GL_NV_occlusion_query"] } {
error "Extension GL_NV_occlusion_query missing"
}
checkExtProc "glGenOcclusionQueriesNV"
checkExtProc "glDeleteOcclusionQueriesNV"
checkExtProc "glGetOcclusionQueryuivNV"
checkExtProc "glBeginOcclusionQueryNV"
checkExtProc "glEndOcclusionQueryNV"
}
# Create query objects for our sphere and plane
if { $::g_bUseArbExtension } {
glGenQueriesARB 1 $::g_sphereQuery
glGenQueriesARB 1 $::g_planeQuery
} else {
glGenOcclusionQueriesNV 1 $::g_sphereQuery
glGenOcclusionQueriesNV 1 $::g_planeQuery
}
}
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 45.0 [expr double($w)/double($h)] 0.1 100.0
}
proc RenderScene_toInitDepthBuffer {} {
# Render the plane first...
glPushMatrix
glTranslatef 0.0 -0.025 0.0
glScalef 1.0 0.05 1.0
glColor3f 1.0 1.0 0.0
glutSolidCube 0.435
glPopMatrix
# Render the sphere second...
glPushMatrix
glTranslatef 0.0 0.25 0.0
glColor3f 1.0 0.0 0.0
glutSolidSphere 0.25 20 20
glPopMatrix
}
proc RenderScene_toQuery {} {
# Render the plane first and wrap it with an occlusion query
glPushMatrix
glTranslatef 0.0 -0.025 0.0
glScalef 1.0 0.05 1.0
if { $::g_bUseArbExtension } {
glBeginQueryARB GL_SAMPLES_PASSED_ARB [$::g_planeQuery get 0]
} else {
glBeginOcclusionQueryNV [$::g_planeQuery get 0]
}
glColor3f 1.0 1.0 0.0
glutSolidCube 0.435
if { $::g_bUseArbExtension } {
glEndQueryARB GL_SAMPLES_PASSED_ARB
} else {
glEndOcclusionQueryNV
}
glPopMatrix
# Render the sphere second and wrap it with an occlusion query
glPushMatrix
glTranslatef 0.0 0.25 0.0
if { $::g_bUseArbExtension } {
glBeginQueryARB GL_SAMPLES_PASSED_ARB [$::g_sphereQuery get 0]
} else {
glBeginOcclusionQueryNV [$::g_sphereQuery get 0]
}
glColor3f 1.0 0.0 0.0
glutSolidSphere 0.25 20 20
if { $::g_bUseArbExtension } {
glEndQueryARB GL_SAMPLES_PASSED_ARB
} else {
glEndOcclusionQueryNV
}
glPopMatrix
}
proc DisplayCallback { toglwin } {
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]
glMatrixMode GL_MODELVIEW
glLoadIdentity
glTranslatef 0.0 0.0 -1.5
glRotatef [expr -1.0 * $::g_fSpinY(1)] 1.0 0.0 0.0
glRotatef [expr -1.0 * $::g_fSpinX(1)] 0.0 1.0 0.0
# The first time we render the scene is to initialize the depth buffer.
# If we don't do this, an object, which is rendered first, may generate a
# pixel count which is greater than 0 even when that object is later
# occluded completely by another object, which is closer to the view point.
#
# You can actually skip this step if you know for certain that you'll
# be rendering and querying your scene's objects in back-to-front order.
RenderScene_toInitDepthBuffer
# The second time is for getting accurate visible fragment counts
RenderScene_toQuery
# Now, we collect the fragment counts from our two 3D objects to see
# whether or not either of them would have contributed anything to the
# frame buffer if they were rendered.
set planeFragmentCount [tcl3dVector GLuint 1]
set sphereFragmentCount [tcl3dVector GLuint 1]
if { $::g_bUseArbExtension } {
glGetQueryObjectuivARB [$::g_planeQuery get 0] GL_QUERY_RESULT_ARB $planeFragmentCount
glGetQueryObjectuivARB [$::g_sphereQuery get 0] GL_QUERY_RESULT_ARB $sphereFragmentCount
} else {
glGetOcclusionQueryuivNV [$::g_planeQuery get 0] GL_PIXEL_COUNT_NV $planeFragmentCount
glGetOcclusionQueryuivNV [$::g_sphereQuery get 0] GL_PIXEL_COUNT_NV $sphereFragmentCount
}
set planeString "Plane Fragments = [$planeFragmentCount get 0]"
set sphereString "Sphere Fragments = [$sphereFragmentCount get 0]"
BeginRenderText $toglwin $::g_WinWidth $::g_WinHeight
glColor3f 1.0 1.0 1.0
RenderText 5 15 $planeString
RenderText 5 30 $sphereString
EndRenderText $toglwin
$toglwin swapbuffers
$planeFragmentCount delete
$sphereFragmentCount delete
}
proc Cleanup {} {
# Make sure to clean up after our queries...
if { [info exists ::g_sphereQuery] } {
if { $::g_bUseArbExtension } {
glDeleteQueriesARB 1 [$::g_sphereQuery get 0]
} else {
glDeleteOcclusionQueriesNV 1 [$::g_sphereQuery get 0]
}
}
if { [info exists ::g_planeQuery] } {
if { $::g_bUseArbExtension } {
glDeleteQueriesARB 1 [$::g_planeQuery get 0]
} else {
glDeleteOcclusionQueriesNV 1 [$::g_planeQuery get 0]
}
}
foreach var [info globals g_*] {
uplevel #0 unset $var
}
}
proc ExitProg {} {
exit
}
if { $argc >= 1 } {
if { [string compare -nocase [lindex $argv 0] "arb"] == 0 } {
set ::g_bUseArbExtension 1
} elseif { [string compare -nocase [lindex $argv 0] "nv"] == 0 } {
set ::g_bUseArbExtension 0
}
}
frame .fr
pack .fr -expand 1 -fill both
togl .fr.toglwin -width $g_WinWidth -height $g_WinHeight \
-double true -depth true \
-createcommand CreateCallback \
-reshapecommand ReshapeCallback \
-displaycommand DisplayCallback
listbox .fr.usage -font $::g_listFont -height 1
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
set extType "NV"
if { $::g_bUseArbExtension } {
set extType "ARB"
}
set appTitle "Tcl3D demo: CodeSampler's Occlusion Query using the $extType extension"
wm title . $appTitle
# Watch For ESC Key And Quit Messages
wm protocol . WM_DELETE_WINDOW "ExitProg"
bind . <Key-Escape> "ExitProg"
bind .fr.toglwin <1> "SetMouseInput 1 %x %y"
bind .fr.toglwin <B1-Motion> "GetMouseInput 1 %x %y"
.fr.usage insert end "Key-Escape Exit"
.fr.usage configure -state disabled
PrintInfo [tcl3dOglGetInfoString]
|
