#-----------------------------------------------------------------------------
#           Name: ogl_alpha_blending_texture.cpp
#         Author: Kevin Harris (kevin@codesampler.com)
#  Last Modified: 03/25/05
#    Description: This sample demonstrates how to perform alpha blending using
#                 the alpha channel of a standard .tga texture. For proper
#                 alpha blending, the sample uses a cull-mode sorting trick
#                 to ensure the sides of the textured cube get rendered in
#                 back-to-front order.
#
#   Control Keys: b - Toggle blending
#                 s - Toggle usage of cull-mode sorting trick
#                 Up Arrow - Move the test cube closer
#                 Down Arrow - Move the test cube away
#-----------------------------------------------------------------------------
#
# Original C++ code by Kevin Harris (kevin@codesampler.com)
# See www.codesampler.com for the original files
# OpenGL samples page 3: Alpha Texture Blending
# http://www.codesampler.com/oglsrc/oglsrc_3.htm#ogl_alpha_blending_texture
#
# Modified for Tcl3D by Paul Obermeier 2008/05/01
# 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 g_bBlending true
set g_bSortUsingCullModeTrick true

set g_fDistance -4.5
set g_fSpinX(1) 0.0
set g_fSpinY(1) 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 ToggleBlending {} {
    set ::g_bBlending [expr ! $::g_bBlending]
    .fr.toglwin postredisplay
}

proc ToggleCullModeTrick {} {
    set ::g_bSortUsingCullModeTrick [expr ! $::g_bSortUsingCullModeTrick]
    .fr.toglwin postredisplay
}

proc MoveCam { zoff } {
    set ::g_fDistance [expr $::g_fDistance + $zoff]
    .fr.toglwin postredisplay
}

proc LoadTexture {} {
    set texName [file join $::g_scriptDir "radiation_box.tga"]
    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
}

proc CreateCallback { toglwin } {
    LoadTexture

    glClearColor 0.35 0.53 0.7 1.0
    glEnable GL_TEXTURE_2D

    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]

    glMatrixMode GL_MODELVIEW
    glLoadIdentity
    glTranslatef 0.0 0.0 $::g_fDistance
    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

    # Transparency sorting for our cube...
    #
    # If you have a single transparent object, or multiple transparent objects 
    # which do not overlap in screen space (i.e., each screen pixel is touched 
    # by at most one of the transparent objects), there's a sorting short-cut 
    # which can be used under certain conditions.
    #
    # If your transparent objects are closed, convex, and viewed from the 
    # outside, culling may be used to draw the back-facing polygons prior to 
    # the front-facing polygons. This will accomplish the same thing
    # as sorting your objects or polygons into back-to-front order.
    # Fortunately for us, our cube is a perfect candidate for this sorting 
    # trick.
    # 
    # On the other hand, If we can't use the cull-mode sorting trick, we would 
    # need to sort our objects manually, which would require us to transform 
    # the geometry into eye-space so we could compare their final position 
    # along the z axis. Only then, could we could render them in the proper 
    # back-to-front order for alpha blending.
    #
    # Also, if transparent objects intersect in any way, the individual 
    # triangles of the objects touching will have to be sorted and drawn 
    # individually from back-to-front. And is some rare cases, triangles that 
    # intersect each other may have to be broken into smaller triangles so they
    # no longer intersect or blending artifacts will persist regardless of our
    # sorting efforts.
    #
    # Its plain to see, transparency sorting can become a big, hairy mess
    # real quick.
    #
    # http://www.opengl.org/resources/tutorials/sig99/advanced99/notes/node204.html
    #

    if { $::g_bBlending } {
        # Use the texture's alpha channel to blend it with whatevers already 
        # in the frame-buffer.

        glDisable GL_DEPTH_TEST

        glEnable GL_BLEND
        glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA

        glBindTexture GL_TEXTURE_2D [$::g_textureID get 0]

        if { $::g_bSortUsingCullModeTrick } {
            # Use the cull-mode sorting trick for convex non-overlapping 
            # geometry.

            glEnable GL_CULL_FACE

            # Render the cube but only render the back-facing polygons.

            glCullFace GL_FRONT

            glInterleavedArrays GL_T2F_V3F 0 $::g_cubeVertices
            glDrawArrays GL_QUADS 0 24

            # Render the cube again, but this time we only render the 
            # front-facing polygons.

            glCullFace GL_BACK

            glInterleavedArrays GL_T2F_V3F 0 $::g_cubeVertices
            glDrawArrays GL_QUADS 0 24

            glDisable GL_CULL_FACE
        } else {
            # Do no sorting and hope for the best. From certain viewing 
            # positions the cube's sides will appear sorted correctly, but this
            # is typically rare and the cube will not look right most of the 
            # time.

            glInterleavedArrays GL_T2F_V3F 0 $::g_cubeVertices
            glDrawArrays GL_QUADS 0 24
        }
    } else {
        # Render the cube, but do no blending...

        glDisable GL_BLEND
        glEnable GL_DEPTH_TEST

        glBindTexture GL_TEXTURE_2D [$::g_textureID get 0]
        glInterleavedArrays GL_T2F_V3F 0 $::g_cubeVertices
        glDrawArrays GL_QUADS 0 24
    }

    $toglwin swapbuffers
}

proc Cleanup {} {
    if { [info exists ::g_textureID] } {
        glDeleteTextures 1 [$::g_textureID get 0]
        $::g_textureID 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 6
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 Texture Alpha Blending"
wm title . $appTitle

# Watch For ESC Key And Quit Messages
wm protocol . WM_DELETE_WINDOW "ExitProg"
bind . <Key-Escape> "ExitProg"
bind . <Key-b>      "ToggleBlending"
bind . <Key-s>      "ToggleCullModeTrick"
bind . <Key-Up>     "MoveCam -0.1"
bind . <Key-Down>   "MoveCam  0.1"

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-b      Toggle blending"
.fr.usage insert end "Key-s      Toggle cull mode trick"
.fr.usage insert end "Key-Up     Increase distance"
.fr.usage insert end "Key-Down   Decrease distance"
.fr.usage insert end "Mouse-L    Rotate cube"
.fr.usage configure -state disabled

PrintInfo [tcl3dOglGetInfoString]
