#-----------------------------------------------------------------------------
#           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]
