#-----------------------------------------------------------------------------
#           Name: ogl_multitexture_blending.cpp
#         Author: Kevin Harris (kevin@codesampler.com)
#  Last Modified: 02/08/05
#    Description: This sample demonstrates how to use the OpenGL extensions 
#                 GL_ARB_multitexture and GL_ARB_texture_env_combine in
#                 conjunction with specially encoded vertex colors to blend 
#                 three textures together.
#
#                 This technique is very popular in terrain rendering engines 
#                 which use it to blend dramatically different textures such  
#                 as rock and grass together with out creating a noticeable 
#                 edge. For example, with three textures consisting of stone,
#                 grass, and sand you can render a mountain that blends in 
#                 patches of grass and sand at its base.
#
#                 Of course, while this technique remains popular as a 
#                 fall-back for older hardware, shaders make this task a lot 
#                 easier and are quickly becoming the preferred method for 
#                 terrain texture blending.
#
# The technique basically consists of the following steps:
#
# Step 1: Take the desired contribution of the three textures and encode them
#         into the vertex's color such that the RGB portion of the color 
#         controls the interpolation between texture stages 0 and 1, and the 
#         color's ALPHA controls the interpolation between texture stages 
#         1 and 2.
# 
# Step 2: Use GL_ARB_multitexture to apply three textures simultaneously to 
#         our geometry.
# 
# Step 3: Set the first texture on texture stage 0.
# 
# Step 4: During texture stage 1, use GL_INTERPOLATE_ARB to linearly 
#         interpolate between the output of stage 0 and the texture of stage 1
#         with GL_SRC_COLOR (i.e. the RGB part of the color).
#         
# Step 4: During texture stage 2, use GL_INTERPOLATE_ARB to linearly 
#         interpolate between the output of stage 1 and the texture of stage 2 
#         with GL_SRC_ALPHA (i.e. the ALPHA part of the color).
#
#   Control Keys: F1   - Increase contribution of texture 0
#                 F2   - Decrease contribution of texture 0
#                 F3   - Increase contribution of texture 2
#                 F4   - Decrease contribution of texture 2
#                 F5   - Toggle wire-frame mode.
#                 Up   - View moves forward
#                 Down - View moves backward
#
# Note: I tried to create an intuitive way to set the contribution of each 
#       texture at run-time using the function keys, but this system is still
#       a little confusing since I only allow the contribution of texture 0 
#       and texture 2 to be adjusted. This is due to the fact that the
#       equation for encoding the blending info into the vertex color simply 
#       infers the contribution value of texture 1 based on the values for 
#       textures 0 and 2. Therefore, the contribution value of texture 1 must
#       be indirectly set by adjusting the contributions of textures 0 and 2.
#-----------------------------------------------------------------------------
#
# Original C++ code by Kevin Harris (kevin@codesampler.com)
# See www.codesampler.com for the original files
# OpenGL samples page 4: Multi-Texture Blending
#
# Modified for Tcl3D by Paul Obermeier 2007/03/10
# 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_LastMousePosX(1) 0
set g_LastMousePosY(1) 0
set g_fSpinX(1) 0.0
set g_fSpinY(1) 0.0

set g_fDistance -4.0

set g_bWireFrameMode false

set g_fContributionOfTex0 0.33
set g_fContributionOfTex1 0.33
set g_fContributionOfTex2 0.33

# 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 SetContributionOfTex0 { val } {
    global g_fContributionOfTex0 g_fContributionOfTex2

    set g_fContributionOfTex0 [expr { $g_fContributionOfTex0 + $val }]
    if { $g_fContributionOfTex0 > 1.0 } {
        set g_fContributionOfTex0 1.0
    } elseif { $g_fContributionOfTex0 < 0.0 } {
        set g_fContributionOfTex0 0.0
    }
    # If the total contribution of textures 0 and 2 is
    # greater than 1.0f after we increased the 
    # contribution of texture 0, we need to reduce the 
    # contribution from texture 2 to balance it out.
    while { ($g_fContributionOfTex0 + $g_fContributionOfTex2) > 1.0 } {
        set g_fContributionOfTex2 [expr { $g_fContributionOfTex2 - 0.01 }]
    }
    if { $g_fContributionOfTex2 < 0.0 } {
        set g_fContributionOfTex2 0.0
    }

    .fr.toglwin postredisplay
}

proc SetContributionOfTex2 { val } {
    global g_fContributionOfTex0 g_fContributionOfTex2

    set g_fContributionOfTex2 [expr { $g_fContributionOfTex2 + $val }]
    if { $g_fContributionOfTex2 > 1.0 } {
        set g_fContributionOfTex2 1.0
    } elseif { $g_fContributionOfTex2 < 0.0 } {
        set g_fContributionOfTex2 0.0
    }
    # If the total contribution of textures 0 and 2 is
    # greater than 1.0f after we increased the 
    # contribution of texture 2, we need to reduce the 
    # contribution from texture 0 to balance it out.
    while { ($g_fContributionOfTex0 + $g_fContributionOfTex2) > 1.0 } {
        set g_fContributionOfTex0 [expr { $g_fContributionOfTex0 - 0.01 }]
    }
    if { $g_fContributionOfTex0 < 0.0 } {
        set g_fContributionOfTex0 0.0
    }

    .fr.toglwin postredisplay
}

proc ToggleWireFrameMode {} {
    set ::g_bWireFrameMode [expr ! $::g_bWireFrameMode]
    .fr.toglwin postredisplay
}

proc SetDistance { val } {
    set ::g_fDistance [expr $::g_fDistance + $val]
    .fr.toglwin postredisplay
}

proc LoadTexture { name index } {
    set texName [file join $::g_scriptDir $name]
    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($index) [tcl3dVector GLuint 1]
    glGenTextures 1 $::g_textureID($index)

    glBindTexture GL_TEXTURE_2D [$::g_textureID($index) get 0]

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

    glTexImage2D GL_TEXTURE_2D 0 3 $w $h 0 $::GL_RGBA 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 checkExtProc { extProc } {
    if { ![tcl3dOglHaveFunc $extProc] } {
        error "Extension proc $extProc not available"
    }
}

proc CreateCallback { toglwin } {
    if { 1 } {
        LoadTexture "texture0.bmp" 0
        LoadTexture "texture1.bmp" 1
        LoadTexture "texture2.bmp" 2
    } else {
        LoadTexture "test_texture0.bmp" 0
        LoadTexture "test_texture1.bmp" 1
        LoadTexture "test_texture2.bmp" 2
    }

    glClearColor 0.0 0.0 0.0 1.0
    glEnable GL_TEXTURE_2D

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

    # Check for GL_ARB_multitexture extension.
    if { ![tcl3dOglHaveExtension $toglwin "GL_ARB_multitexture"] } {
        error "Extension GL_ARB_multitexture missing"
    }
    checkExtProc "glActiveTextureARB"
    checkExtProc "glMultiTexCoord2fARB"
    checkExtProc "glClientActiveTextureARB"
}

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 } {
    global g_fContributionOfTex0 g_fContributionOfTex1 g_fContributionOfTex2

    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

    if { $::g_bWireFrameMode } {
        glPolygonMode GL_FRONT_AND_BACK GL_LINE
    } else {
        glPolygonMode GL_FRONT_AND_BACK GL_FILL
    }

    # Texture Stage 0
    # Simply output texture0 for stage 0.

    glActiveTextureARB GL_TEXTURE0_ARB
    glEnable GL_TEXTURE_2D
    glBindTexture GL_TEXTURE_2D [$::g_textureID(0) get 0]

    glTexEnvi GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE $::GL_REPLACE

    # Texture Stage 1
    # Perform a linear interpolation between the output of stage 0 
    # (i.e texture0) and texture1 and use the RGB portion of the vertex's 
    # color to mix the two. 

    glActiveTextureARB GL_TEXTURE1_ARB
    glEnable GL_TEXTURE_2D
    glBindTexture GL_TEXTURE_2D [$::g_textureID(1) get 0]

    glTexEnvi GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE $::GL_COMBINE_ARB
    glTexEnvi GL_TEXTURE_ENV GL_COMBINE_RGB_ARB  $::GL_INTERPOLATE_ARB

    glTexEnvi GL_TEXTURE_ENV GL_SOURCE0_RGB_ARB  $::GL_PREVIOUS_ARB
    glTexEnvi GL_TEXTURE_ENV GL_OPERAND0_RGB_ARB $::GL_SRC_COLOR

    glTexEnvi GL_TEXTURE_ENV GL_SOURCE1_RGB_ARB  $::GL_TEXTURE
    glTexEnvi GL_TEXTURE_ENV GL_OPERAND1_RGB_ARB $::GL_SRC_COLOR

    glTexEnvi GL_TEXTURE_ENV GL_SOURCE2_RGB_ARB  $::GL_PRIMARY_COLOR_ARB
    glTexEnvi GL_TEXTURE_ENV GL_OPERAND2_RGB_ARB $::GL_SRC_COLOR

    # Texture Stage 2
    # Perform a linear interpolation between the output of stage 1 
    # (i.e texture0 mixed with texture1) and texture2 and use the ALPHA 
    # portion of the vertex's color to mix the two. 

    glActiveTextureARB GL_TEXTURE2_ARB
    glEnable GL_TEXTURE_2D
    glBindTexture GL_TEXTURE_2D [$::g_textureID(2) get 0]

    glTexEnvi GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE $::GL_COMBINE_ARB
    glTexEnvi GL_TEXTURE_ENV GL_COMBINE_RGB_ARB  $::GL_INTERPOLATE_ARB

    glTexEnvi GL_TEXTURE_ENV GL_SOURCE0_RGB_ARB  $::GL_PREVIOUS_ARB
    glTexEnvi GL_TEXTURE_ENV GL_OPERAND0_RGB_ARB $::GL_SRC_COLOR

    glTexEnvi GL_TEXTURE_ENV GL_SOURCE1_RGB_ARB  $::GL_TEXTURE
    glTexEnvi GL_TEXTURE_ENV GL_OPERAND1_RGB_ARB $::GL_SRC_COLOR

    glTexEnvi GL_TEXTURE_ENV GL_SOURCE2_RGB_ARB  $::GL_PRIMARY_COLOR_ARB
    glTexEnvi GL_TEXTURE_ENV GL_OPERAND2_RGB_ARB $::GL_SRC_ALPHA

    # Based on the contributions of texture 0 and texture 2 what is the
    # contribution of texture 1? We don't really need this for the encoding
    # process below. I'm simply calculating it so I can output its value later.

    set g_fContributionOfTex1 [expr {1.0 - \
                              ($g_fContributionOfTex0 + $g_fContributionOfTex2) }]

    # Do some bounds checking...
    if { $g_fContributionOfTex1 < 0.0 } {
        set g_fContributionOfTex1 0.0
    } elseif { $g_fContributionOfTex1 > 1.0 } {
        set g_fContributionOfTex1 1.0
    }

    # Now, lets encode the blending information into the vertex color.
    # The value set into the RGB part of the color controls the blending
    # between texture 0 and texture 1, and the alpha part of the color
    # controls the blending between textures1 and textures 2.
    #
    # Note: We use the contribution of texture 0 and 2 to infer or deduce 
    # the contribution of texture 1. We can do this because we know that the
    # total contribution of our three textures must add up to 1.0f.

    set rgbValue   [expr { $g_fContributionOfTex0 / (1.0 - $g_fContributionOfTex2) }]
    set alphaValue [expr { 1.0 - $g_fContributionOfTex2 }]

    # Do some bounds checking...
    if { $rgbValue < 0.0 } {
        set rgbValue 0.0
    } elseif { $rgbValue > 1.0 } {
        set rgbValue 1.0
    }
    if { $alphaValue < 0.0 } {
        set alphaValue 0.0
    } elseif { $alphaValue > 1.0 } {
        set alphaValue 1.0
    }

    glColor4f $rgbValue $rgbValue $rgbValue $alphaValue
    
    # Render our quad with three sets of texture coordinates...
    glBegin GL_QUADS
        glMultiTexCoord2fARB GL_TEXTURE0_ARB 0.0 0.0
        glMultiTexCoord2fARB GL_TEXTURE1_ARB 0.0 0.0
        glMultiTexCoord2fARB GL_TEXTURE2_ARB 0.0 0.0
        glVertex3f -1.0 -1.0 0.0

        glMultiTexCoord2fARB GL_TEXTURE0_ARB 0.0 1.0
        glMultiTexCoord2fARB GL_TEXTURE1_ARB 0.0 1.0
        glMultiTexCoord2fARB GL_TEXTURE2_ARB 0.0 1.0
        glVertex3f -1.0 1.0 0.0

        glMultiTexCoord2fARB GL_TEXTURE0_ARB 1.0 1.0
        glMultiTexCoord2fARB GL_TEXTURE1_ARB 1.0 1.0
        glMultiTexCoord2fARB GL_TEXTURE2_ARB 1.0 1.0
        glVertex3f 1.0 1.0 0.0

        glMultiTexCoord2fARB GL_TEXTURE0_ARB 1.0 0.0
        glMultiTexCoord2fARB GL_TEXTURE1_ARB 1.0 0.0
        glMultiTexCoord2fARB GL_TEXTURE2_ARB 1.0 0.0
        glVertex3f 1.0 -1.0 0.0
    glEnd

    # Output some info...
    glActiveTextureARB GL_TEXTURE0_ARB
    glDisable GL_TEXTURE_2D
    glActiveTextureARB GL_TEXTURE1_ARB
    glDisable GL_TEXTURE_2D
    glActiveTextureARB GL_TEXTURE2_ARB
    glDisable GL_TEXTURE_2D

    set strTex0 [format "Contribution of Tex 0 = %.3f" $g_fContributionOfTex0]
    set strTex1 [format "Contribution of Tex 1 = %.3f (Inferred by the values of Tex 0 & Tex 2)" $g_fContributionOfTex1]
    set strTex2 [format "Contribution of Tex 2 = %.3f" $g_fContributionOfTex2]

    set strRedValue   [format "Red   = %.3f" $rgbValue]
    set strGreenValue [format "Green = %.3f" $rgbValue]
    set strBlueValue  [format "Blue  = %.3f" $rgbValue]
    set strAlphaValue [format "Alpha = %.3f" $alphaValue]

    BeginRenderText $toglwin $::g_WinWidth $::g_WinHeight
        glColor3f 1.0 1.0 0.0
        RenderText 5 15 "Contribution of each texture for blending:"
        glColor3f 1.0 1.0 1.0
        RenderText 5 30 $strTex0
        RenderText 5 45 $strTex1
        RenderText 5 60 $strTex2

        glColor3f 1.0 1.0 0.0
        RenderText 5 355 "RGB values passed for interpolation of texture stage 1"
        glColor3f 1.0 1.0 1.0
        RenderText 5 370 $strRedValue
        RenderText 5 385 $strGreenValue
        RenderText 5 400 $strBlueValue

        glColor3f 1.0 1.0 0.0
        RenderText 5 415 "ALPHA value passed for interpolation of texture stage 2"
        glColor3f 1.0 1.0 1.0
        RenderText 5 430 $strAlphaValue
    EndRenderText $toglwin

    $toglwin swapbuffers
}

proc Cleanup {} {
    if { [info exists ::g_textureID(0)] } {
        glDeleteTextures 1 [$::g_textureID(0) get 0]
        $::g_textureID(0) delete
    }
    if { [info exists ::g_textureID(1)] } {
        glDeleteTextures 1 [$::g_textureID(1) get 0]
        $::g_textureID(1) delete
    }
    if { [info exists ::g_textureID(2)] } {
        glDeleteTextures 1 [$::g_textureID(2) get 0]
        $::g_textureID(2) 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 5
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 Multi-Texture Blending"
wm title . $appTitle

# Watch For ESC Key And Quit Messages
wm protocol . WM_DELETE_WINDOW "ExitProg"
bind . <Key-Escape> "ExitProg"
bind . <Key-F1>     "SetContributionOfTex0  0.01"
bind . <Key-F2>     "SetContributionOfTex0 -0.01"
bind . <Key-F3>     "SetContributionOfTex2  0.01"
bind . <Key-F4>     "SetContributionOfTex2 -0.01"
bind . <Key-F5>     "ToggleWireFrameMode"
bind . <Key-Up>     "SetDistance  0.5"
bind . <Key-Down>   "SetDistance -0.5"

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 contribution of texture 0"
.fr.usage insert end "Key-F3|F4   Increment|Decrement contribution of texture 2"
.fr.usage insert end "Key-F5      Toggle wireframe mode"
.fr.usage insert end "Key-Up|Down Decrease|Increase distance"
.fr.usage configure -state disabled

PrintInfo [tcl3dOglGetInfoString]
