#------------------------------------------------------------------------------
#           Name: ogl_frame_buffer_object.cpp
#         Author: Kevin Harris  (kevin@codesampler.com)
#  Last Modified: 07/06/05
#    Description: This sample demonstrates how to create dynamic textures 
#                 through off-screen rendering. The off-screen rendering step 
#                 is accomplished using a frame-buffer and render-buffer 
#                 object, which is created using OpenGL's 
#                 EXT_framebuffer_object extension.
#
#                 As a demonstration, a spinning textured cube is rendered 
#                 to a frame-buffer object, which is in turn, used to create a 
#                 dynamic texture. The dynamic texture is then used to texture 
#                 a second spinning cube, which will be rendered to the 
#                 application's window.
#
#   Control Keys: Left Mouse Button  - Spin the large, black cube.
#                 Right Mouse Button - Spin the textured cube being rendered 
#                                      into the p-buffer.
#
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
# Note: The EXT_framebuffer_object extension is an excellent replacement for 
#       the WGL_ARB_pbuffer and WGL_ARB_render_texture combo which is normally 
#       used to create dynamic textures. An example of this older technique 
#       can be found here:
#
#       http://www.codesampler.com/oglsrc/oglsrc_7.htm#ogl_offscreen_rendering
#------------------------------------------------------------------------------
#
# Original C++ code by Kevin Harris (kevin@codesampler.com)
# See www.codesampler.com for the original files
# OpenGL samples page 14: Off-screen Rendering Using Frame-Buffer Objects
#
# Modified for Tcl3D by Paul Obermeier 2007/02/25
# See www.tcl3d.org for the Tcl3D extension.

package require Tk
package require Img
package require tcl3d

# Font to be used in the Tk listbox.
set g_listFont {-family {Courier} -size 10}

set g_WinWidth  640
set g_WinHeight 480

set RENDERBUFFER_WIDTH  256
set RENDERBUFFER_HEIGHT 256

set g_LastMousePosX(1) 0
set g_LastMousePosY(1) 0
set g_LastMousePosX(2) 0
set g_LastMousePosY(2) 0

set g_fSpinX(1) -30.0
set g_fSpinY(1) -30.0
set g_fSpinX(2)   0.0
set g_fSpinY(2)   0.0

# Array of texture coordinates and vertices (GL_T2F_V3F) for glInterleavedArrays call.
set g_cubeVertices [tcl3dVectorFromArgs GLfloat \
    0.0 0.0  -1.0 -1.0  1.0 \
    1.0 0.0   1.0 -1.0  1.0 \
    1.0 1.0   1.0  1.0  1.0 \
    0.0 1.0  -1.0  1.0  1.0 \
\
    1.0 0.0  -1.0 -1.0 -1.0 \
    1.0 1.0  -1.0  1.0 -1.0 \
    0.0 1.0   1.0  1.0 -1.0 \
    0.0 0.0   1.0 -1.0 -1.0 \
\
    0.0 1.0  -1.0  1.0 -1.0 \
    0.0 0.0  -1.0  1.0  1.0 \
    1.0 0.0   1.0  1.0  1.0 \
    1.0 1.0   1.0  1.0 -1.0 \
\
    1.0 1.0  -1.0 -1.0 -1.0 \
    0.0 1.0   1.0 -1.0 -1.0 \
    0.0 0.0   1.0 -1.0  1.0 \
    1.0 0.0  -1.0 -1.0  1.0 \
\
    1.0 0.0   1.0 -1.0 -1.0 \
    1.0 1.0   1.0  1.0 -1.0 \
    0.0 1.0   1.0  1.0  1.0 \
    0.0 0.0   1.0 -1.0  1.0 \
\
    0.0 0.0  -1.0 -1.0 -1.0 \
    1.0 0.0  -1.0 -1.0  1.0 \
    1.0 1.0  -1.0  1.0  1.0 \
    0.0 1.0  -1.0  1.0 -1.0 \
]

# Determine the directory of this script.
set g_scriptDir [file dirname [info script]]

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

proc LoadTexture {} {
    set texName [file join $::g_scriptDir "test.bmp"]
    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 n [tcl3dPhotoChans $phImg]
        set pTextureImage [tcl3dVectorFromPhoto $phImg]
        image delete $phImg
    }

    set ::g_testTextureID [tcl3dVector GLuint 1]
    glGenTextures 1 $::g_testTextureID

    glBindTexture GL_TEXTURE_2D [$::g_testTextureID get 0]

    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_LINEAR
    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_LINEAR

    if { $n == 3 } {
        set type $::GL_RGB
    } else {
       set type $::GL_RGBA
    }
    glTexImage2D GL_TEXTURE_2D 0 $n $w $h 0 $type GL_UNSIGNED_BYTE $pTextureImage
    $pTextureImage delete
}

proc checkExtProc { extProc } {
    if { ![tcl3dOglHaveFunc $extProc] } {
        error "Extension proc $extProc not available"
    }
}

proc CreateCallback { toglwin } {
    glClearColor 0.0 0.0 1.0 1.0
    glEnable GL_TEXTURE_2D
    glEnable GL_DEPTH_TEST

    glMatrixMode GL_PROJECTION
    glLoadIdentity
    gluPerspective 45.0 [expr double($::g_WinWidth)/double($::g_WinHeight)] \
                   0.1 100.0

    # Check for EXT_framebuffer_object extension.
    if { ![tcl3dOglHaveExtension $toglwin "GL_EXT_framebuffer_object"] } {
        error "Extension GL_EXT_framebuffer_object missing"
    }

    checkExtProc "glIsRenderbufferEXT"
    checkExtProc "glBindRenderbufferEXT"
    checkExtProc "glDeleteRenderbuffersEXT"
    checkExtProc "glGenRenderbuffersEXT"
    checkExtProc "glRenderbufferStorageEXT"
    checkExtProc "glGetRenderbufferParameterivEXT"
    checkExtProc "glIsFramebufferEXT"
    checkExtProc "glBindFramebufferEXT"
    checkExtProc "glDeleteFramebuffersEXT"
    checkExtProc "glGenFramebuffersEXT"
    checkExtProc "glCheckFramebufferStatusEXT"
    checkExtProc "glFramebufferTexture1DEXT"
    checkExtProc "glFramebufferTexture2DEXT"
    checkExtProc "glFramebufferTexture3DEXT"
    checkExtProc "glFramebufferRenderbufferEXT"
    checkExtProc "glGetFramebufferAttachmentParameterivEXT"
    checkExtProc "glGenerateMipmapEXT"

    # Create a frame-buffer object and a render-buffer object...
    set ::g_frameBuffer       [tcl3dVector GLuint 1]
    set ::g_depthRenderBuffer [tcl3dVector GLuint 1]

    glGenFramebuffersEXT  1 $::g_frameBuffer
    glGenRenderbuffersEXT 1 $::g_depthRenderBuffer

    # Initialize the render-buffer for usage as a depth buffer.
    # We don't really need this to render things into the frame-buffer object,
    # but without it the geometry will not be sorted properly.
    glBindRenderbufferEXT GL_RENDERBUFFER_EXT [$::g_depthRenderBuffer get 0]
    glRenderbufferStorageEXT GL_RENDERBUFFER_EXT GL_DEPTH_COMPONENT24 \
                             $::RENDERBUFFER_WIDTH $::RENDERBUFFER_HEIGHT

    # Check for errors...
    set status [glCheckFramebufferStatusEXT GL_FRAMEBUFFER_EXT]
    if { $status == $::GL_FRAMEBUFFER_UNSUPPORTED_EXT } {
        error "GL_FRAMEBUFFER_UNSUPPORTED_EXT!"
    }

    # Now, create our dynamic texture. It doesn't actually get loaded with any 
    # pixel data, but its texture ID becomes associated with the pixel data
    # contained in the frame-buffer object. This allows us to bind to this data
    # like we would any regular texture.
    set ::g_dynamicTextureID [tcl3dVector GLuint 1]
    glGenTextures 1 $::g_dynamicTextureID

    glBindTexture GL_TEXTURE_2D [$::g_dynamicTextureID get 0]

    glTexImage2D GL_TEXTURE_2D 0 $::GL_RGB $::RENDERBUFFER_WIDTH $::RENDERBUFFER_HEIGHT \
                               0 $::GL_RGB GL_UNSIGNED_BYTE NULL

    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_LINEAR
    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_LINEAR

    # Load a regular texture
    LoadTexture
}

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 DisplayCallback { toglwin } {
    # Bind the frame-buffer object and attach to it a render-buffer object 
    # set up as a depth-buffer.
    glBindFramebufferEXT GL_FRAMEBUFFER_EXT [$::g_frameBuffer get 0]
    glFramebufferTexture2DEXT GL_FRAMEBUFFER_EXT GL_COLOR_ATTACHMENT0_EXT \
                              GL_TEXTURE_2D [$::g_dynamicTextureID get 0] 0
    glFramebufferRenderbufferEXT GL_FRAMEBUFFER_EXT GL_DEPTH_ATTACHMENT_EXT \
                                 GL_RENDERBUFFER_EXT [$::g_depthRenderBuffer get 0]

    # Set up the frame-buffer object just like you would set up a window.
    glViewport 0 0 $::RENDERBUFFER_WIDTH $::RENDERBUFFER_HEIGHT
    glClearColor 0.0 0.0 0.0 1.0

    glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT]

    # Let the user spin the cube about with the right mouse button, so our 
    # dynamic texture will show motion.
    glMatrixMode GL_MODELVIEW
    glLoadIdentity
    glTranslatef 0.0 0.0 -5.0
    glRotatef [expr -1.0 * $::g_fSpinY(2)] 1.0 0.0 0.0
    glRotatef [expr -1.0 * $::g_fSpinX(2)] 0.0 1.0 0.0

    # Now, render the cube to the frame-buffer object just like you we would
    # have done with a regular window.
    glBindTexture GL_TEXTURE_2D [$::g_testTextureID get 0]
    glInterleavedArrays GL_T2F_V3F 0 $::g_cubeVertices
    glDrawArrays GL_QUADS 0 24

    # Unbind the frame-buffer and render-buffer objects.
    glBindFramebufferEXT GL_FRAMEBUFFER_EXT 0

    # Now, set up the regular window for rendering...
    glViewport 0 0 [$toglwin width] [$toglwin height]
    glClearColor 0.0 0.0 1.0 1.0

    glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT]
    
    # Let the user spin the cube about with the left mouse button.
    glMatrixMode GL_MODELVIEW
    glLoadIdentity
    glTranslatef 0.0 0.0 -5.0
    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

    # Finally, we'll use the dynamic texture like a regular static texture.
    glBindTexture GL_TEXTURE_2D [$::g_dynamicTextureID get 0]
    glInterleavedArrays GL_T2F_V3F 0 $::g_cubeVertices
    glDrawArrays GL_QUADS 0 24

    $toglwin swapbuffers
}

proc Cleanup {} {
    if { [info exists ::g_testTextureID] } {
        glDeleteTextures 1 [$::g_testTextureID get 0]
        $::g_testTextureID delete
    }
    if { [info exists ::g_dynamicTextureID] } {
        glDeleteTextures 1 [$::g_dynamicTextureID get 0]
        $::g_dynamicTextureID delete
    }

    if { [info exists ::g_frameBuffer] } {
        glDeleteFramebuffersEXT  1 [$::g_frameBuffer get 0]
        $::g_frameBuffer delete
    }
    if { [info exists ::g_depthRenderBuffer] } {
        glDeleteRenderbuffersEXT 1 [$::g_depthRenderBuffer get 0]
        $::g_depthRenderBuffer delete
    }
    $::g_cubeVertices delete

    foreach var [info globals g_*] {
        uplevel #0 unset $var
    }
}

proc ExitProg {} {
    exit
}

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

set appTitle "Tcl3D demo: CodeSampler's Off-Screen Rendering Using Frame Buffer Objects"
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"
bind .fr.toglwin <2>         "SetMouseInput 2 %x %y"
bind .fr.toglwin <B2-Motion> "GetMouseInput 2 %x %y"
bind .fr.toglwin <3>         "SetMouseInput 2 %x %y"
bind .fr.toglwin <B3-Motion> "GetMouseInput 2 %x %y"

.fr.usage insert end "Key-Escape Exit"
.fr.usage insert end "Mouse-L    Rotate outer cube"
.fr.usage insert end "Mouse-MR   Rotate inner cube"
.fr.usage configure -state disabled

PrintInfo [tcl3dOglGetInfoString]
