#-----------------------------------------------------------------------------
#           Name: ogl_glslang_simple_vs2ps.cpp
#         Author: Kevin Harris (kevin@codesampler.com)
#  Last Modified: 04/21/05
#    Description: This sample demonstrates how to write vertex and fragment 
#                 shaders using OpenGL's new high-level shading language 
#                 GLslang.
#
#   Control Keys: F1 - Toggle usage of vertex and fragment shaders.
#
# Note: The fragment shader has been changed slightly from what the 
#       fixed-function pipeline does by default so you can see a noticeable 
#       change when toggling the shaders on and off. Instead of modulating 
#       the vertex color with the texture's texel, the fragment shader adds 
#       the two together, which causes the fragment shader to produce a 
#       brighter, washed-out image. This modification can be switched back in 
#       the fragment shader file.
#-----------------------------------------------------------------------------
#
# Original C++ code by Kevin Harris (kevin@codesampler.com)
# See www.codesampler.com for the original files
# OpenGL samples page 10: Simple Vertex & Fragment Shader (GLslang)
#
# Modified for Tcl3D by Paul Obermeier 2005/11/05
# 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_bUseShaders 0

#       GL_T2F_C3F_V3F
#       tu  tv   r   g   b     x    y    z 
set g_quadVertices [tcl3dVectorFromArgs GLfloat \
        0.0 0.0  1.0 1.0 0.0  -1.0 -1.0  0.0 \
        1.0 0.0  1.0 0.0 0.0   1.0 -1.0  0.0 \
        1.0 1.0  0.0 1.0 0.0   1.0  1.0  0.0 \
        0.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 ToggleShaders {} {
    set ::g_bUseShaders [expr 1 - $::g_bUseShaders]
    .fr.toglwin postredisplay
}

proc SetMouseInput { x y } {
    set ::g_LastMousePosX(1) $x
    set ::g_LastMousePosY(1) $y
}

proc GetMouseInput { x y } {
    set nXDiff [expr ($x - $::g_LastMousePosX(1))]
    set nYDiff [expr ($y - $::g_LastMousePosY(1))]
        
    set ::g_fSpinX(1) [expr $::g_fSpinX(1) - $nXDiff]
    set ::g_fSpinY(1) [expr $::g_fSpinY(1) - $nYDiff]

    set ::g_LastMousePosX(1) $x
    set ::g_LastMousePosY(1) $y
    .fr.toglwin postredisplay
}

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 InitShader { toglwin } {
    if { ![tcl3dOglHaveExtension $toglwin "GL_ARB_shading_language_100"] } {
        error "Extension GL_ARB_shading_language_100 missing"
    }
    if { ![tcl3dOglHaveExtension $toglwin "GL_ARB_shader_objects"] } {
        error "Extension GL_ARB_shader_objects missing"
    }

    set bLinked       [tcl3dVector GLint 1]
    set bVertCompiled [tcl3dVector GLint 1]
    set bFragCompiled [tcl3dVector GLint 1]

    # Create the vertex shader...

    set ::g_vertexShader [glCreateShaderObjectARB GL_VERTEX_SHADER_ARB]

    set vertexShaderAssembly [ReadShaderFile "vertex_shader.vert"]
    tcl3dOglShaderSource $::g_vertexShader $vertexShaderAssembly
    glCompileShaderARB $::g_vertexShader

    glGetObjectParameterivARB $::g_vertexShader GL_OBJECT_COMPILE_STATUS_ARB \
                              $bVertCompiled
    if { [$bVertCompiled get 0] == 0 } {
        set msg [tcl3dOglGetInfoLogARB $::g_vertexShader]
        error "Vertex Shader Compile Error: $msg"
    }

    # Create the fragment shader...

    set ::g_fragmentShader [glCreateShaderObjectARB GL_FRAGMENT_SHADER_ARB]

    set fragmentShaderAssembly [ReadShaderFile "fragment_shader.frag"]
    set fragmentShaderStrings [list $fragmentShaderAssembly]
    set lenList [list [string length $fragmentShaderAssembly]]
    glShaderSourceARB $::g_fragmentShader 1 $fragmentShaderStrings $lenList
    glCompileShaderARB $::g_fragmentShader

    glGetObjectParameterivARB $::g_fragmentShader GL_OBJECT_COMPILE_STATUS_ARB \
                              $bFragCompiled
    if { [$bFragCompiled get 0] == 0 } {
        set msg [tcl3dOglGetInfoLogARB $::g_fragmentShader]
        error "Fragment Shader Compile Error: $msg"
    }

    # Create a program object and attach the two compiled shaders...

    set ::g_programObj [glCreateProgramObjectARB]
    glAttachObjectARB $::g_programObj $::g_vertexShader
    glAttachObjectARB $::g_programObj $::g_fragmentShader

    # Link the program object and print out the info log...

    glLinkProgramARB $::g_programObj

    glGetObjectParameterivARB $::g_programObj GL_OBJECT_LINK_STATUS_ARB $bLinked
    if { [$bLinked get 0] == 0 } {
        set msg [tcl3dOglGetInfoLogARB $::g_programObj]
        error "Linking Error: $msg"
    }

    # Locate some parameters by name so we can set them later...

    set ::g_location_testTexture [glGetUniformLocationARB $::g_programObj "testTexture"]

    # Cleanup memory for temporary variables.
    $bLinked       delete
    $bVertCompiled delete
    $bFragCompiled delete
}

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

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

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

    InitShader $toglwin
}

proc ReadShaderFile { fileName } {
    set pathName [file join $::g_scriptDir $fileName]
    set realPath [tcl3dGetExtFile $pathName]
    set retVal [catch {open $realPath r} fp]
    if { $retVal == 0 } {
        set buffer [read $fp]
        close $fp
    } else {
        error "Cannot open shader file $realPath"
    }
    return $buffer
}

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

    if { [info exists ::g_vertexShader] } {
        glDeleteObjectARB $::g_vertexShader
    }
    if { [info exists ::g_fragmentShader] } {
        glDeleteObjectARB $::g_fragmentShader
    }
    if { [info exists ::g_programObj] } {
        glDeleteObjectARB $::g_programObj
    }

    $::g_quadVertices delete

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

proc ExitProg {} {
    exit
}

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

    if { $::g_bUseShaders } {
        # Use vertex and fragment shaders...
        glUseProgramObjectARB $::g_programObj

        # Identify the texture to use and bind it to texture unit 0
        if { $::g_location_testTexture != -1 } {
            glUniform1iARB $::g_location_testTexture 0
        }

        glInterleavedArrays GL_T2F_C3F_V3F 0 $::g_quadVertices
        glDrawArrays GL_QUADS 0 4

        glUseProgramObjectARB 0
    } else {
        # Render the normal way...
        glBindTexture GL_TEXTURE_2D [$::g_textureID get 0]
        glInterleavedArrays GL_T2F_C3F_V3F 0 $::g_quadVertices
        glDrawArrays GL_QUADS 0 4
    }
    $toglwin swapbuffers
}

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 2
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
wm title . "Tcl3D demo: CodeSampler's Simple vertex & fragment shader with GLSL"

# Watch For ESC Key And Quit Messages
wm protocol . WM_DELETE_WINDOW "ExitProg"
bind . <Key-Escape> "ExitProg"
bind . <Key-F1>     "ToggleShaders"
bind .fr.toglwin <1>         "SetMouseInput %x %y"
bind .fr.toglwin <B1-Motion> "GetMouseInput %x %y"

.fr.usage insert end "Key-Escape Exit"
.fr.usage insert end "Key-F1     Toggle shaders"
.fr.usage configure -state disabled

PrintInfo [tcl3dOglGetInfoString]
