#-----------------------------------------------------------------------------
#           Name: ogl_polygon_offset.cpp
#         Author: Kevin Harris (kevin@codesampler.com)
#  Last Modified: 02/01/05
#    Description: This sample demonstrates how to eliminate z-fighting when
#                 rendering polygons directly on top of other polygons.
#
#   Control Keys: Left Mouse Button - Spin the view
#                 F1 - Increase Offset Factor
#                 F2 - Decrease Offset Factor
#                 F3 - Increase Offset Unit
#                 F4 - Decrease Offset Unit
#-----------------------------------------------------------------------------
#
# Original C++ code by Kevin Harris (kevin@codesampler.com)
# See www.codesampler.com for the original files
# OpenGL samples page 5: Polygon Offset
#
# Modified for Tcl3D by Paul Obermeier 2007/03/05
# See www.tcl3d.org for the Tcl3D extension.
#
# See http://www.opengl.org/sdk/docs/man/xhtml/glPolygonOffset.xml
# for the glPolygonOffset command.

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 g_OffsetFactor  0.04
set g_OffsetUnit   -1.0

set g_LastMousePosX(1) 0
set g_LastMousePosY(1) 0
set g_fSpinX(1) 0.0
set g_fSpinY(1) 5.0

# Array of texture coordinates and vertices (GL_T2F_V3F) for glInterleavedArrays call.
set g_quadVertices [tcl3dVectorFromArgs GLfloat \
    0.0 0.0  -1.0 -1.0 0.0 \
    1.0 0.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 \
]

# 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 SetOffsetFactor { toglwin val } {
    set ::g_OffsetFactor [expr {$::g_OffsetFactor + $val}]
    $toglwin postredisplay
}

proc SetOffsetUnit { toglwin val } {
    set ::g_OffsetUnit [expr {$::g_OffsetUnit + $val}]
    $toglwin postredisplay
}

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 "checker.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_textureID [tcl3dVector GLuint 1]
    glGenTextures 1 $::g_textureID

    glBindTexture GL_TEXTURE_2D [$::g_textureID 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
}

#-----------------------------------------------------------------------------
# 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 CreateCallback { toglwin } {
    LoadTexture

    glClearColor 0.0 0.0 0.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
}

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 } {
    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]

    # Set up the model-view matrix for spinning the quads about and render the 
    # larger textured quad first.

    glMatrixMode GL_MODELVIEW
    glLoadIdentity
    glTranslatef 0.0 0.0 -4.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

    glBindTexture GL_TEXTURE_2D [$::g_textureID get 0]
    glInterleavedArrays GL_T2F_V3F 0 $::g_quadVertices
    glDrawArrays GL_QUADS 0 4

    # Now, for the second quad, scale it down a bit but use the same  
    # translation and rotation matrices so we render it right on top of the 
    # first quad. This will, of course, cause some z-fighting issues, which
    # we will fix via glPolygonOffset and GL_POLYGON_OFFSET_FILL.

    # Use polygon offset
    glEnable GL_POLYGON_OFFSET_FILL
    glPolygonOffset $::g_OffsetFactor $::g_OffsetUnit

    glScalef 0.5 0.5 0.0

    glDisable GL_TEXTURE_2D
    glInterleavedArrays GL_T2F_V3F 0 $::g_quadVertices
    glDrawArrays GL_QUADS 0 4
    glEnable GL_TEXTURE_2D

    # Turn off polygon offset
    glPolygonOffset 0.0 0.0
    glDisable GL_POLYGON_OFFSET_FILL

    # Output the current settings...
    set strOffsetFactor [format "Offset Factor = %1.2f" $::g_OffsetFactor]
    set strOffsetunit   [format "Offset Unit   = %1.2f" $::g_OffsetUnit]

    BeginRenderText $toglwin $::g_WinWidth $::g_WinHeight
        glColor3f 1.0 1.0 1.0
        RenderText 5 15 $strOffsetFactor
        RenderText 5 30 $strOffsetunit
    EndRenderText $toglwin

    $toglwin swapbuffers
}

proc Cleanup {} {
    if { [info exists ::g_textureID] } {
        glDeleteTextures 1 [$::g_textureID get 0]
        $::g_textureID delete
    }
    $::g_quadVertices 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 Polygon Offset"
wm title . $appTitle

# Watch For ESC Key And Quit Messages
wm protocol . WM_DELETE_WINDOW "ExitProg"
bind . <Key-Escape> "ExitProg"
bind . <Key-F1>     "SetOffsetFactor .fr.toglwin  0.005"
bind . <Key-F2>     "SetOffsetFactor .fr.toglwin -0.005"
bind . <Key-F3>     "SetOffsetUnit   .fr.toglwin  0.05"
bind . <Key-F4>     "SetOffsetUnit   .fr.toglwin -0.05"

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 insert end "Key-F1|F2  Increment|Decrement offset factor"
.fr.usage insert end "Key-F3|F4  Increment|Decrement offset unit"
.fr.usage configure -state disabled

PrintInfo [tcl3dOglGetInfoString]
