# LightingModels.tcl
#
# Demo to show the effects of different lighting models.
#
# Copyright (C) 2021-2024 Paul Obermeier
# See www.tcl3d.org for the Tcl3D extension.

package require Tk
package require Img
package require tcl3d

# Define virtual events for OS independent mouse handling.
tcl3dAddEvents

# Create output console.
tcl3dConsoleCreate .tcl3dOutputConsole "# " "Output messages"

# Default diffuse and specular shader program identifier.
set g_Demo(Diffuse,Uniform)  1  ; # Lambert
set g_Demo(Specular,Uniform) 1  ; # BlinnPhong

# Shader identifiers for diffuse reflections.
set g_UniformMap(Diffuse,_None)     0
set g_UniformMap(Diffuse,Lambert)   1
set g_UniformMap(Diffuse,OrenNayar) 2
set g_UniformMap(Diffuse,Schlick)   3
set g_UniformMap(Diffuse,Sandford)  4

# Shader identifiers for specular reflections.
set g_UniformMap(Specular,_None)                0
set g_UniformMap(Specular,BlinnPhong)           1
set g_UniformMap(Specular,BlinnPhongNormalized) 2
set g_UniformMap(Specular,CookTorrance)         3
set g_UniformMap(Specular,Ward)                 4
set g_UniformMap(Specular,Sandford)             5

# Default shape.
set g_Demo(Shape) "Torus" 

# Available shapes and the command and arguments to create the shape.
set g_Shape(Plane)  { glusCreatePlane  { horizontalExtend 1.0 verticalExtend 1.0 } }
set g_Shape(Cube)   { glusCreateCube   { halfExtend 1.0 } }
set g_Shape(Sphere) { glusCreateSphere { radius 1.0 numSlices 32 } }
set g_Shape(Torus)  { glusCreateTorus  { innerRadius 0.5 outerRadius 1.0 numSides 32 numFaces 32 } }

# Default material.
set g_Demo(Material) "Gold" 

# Available materials: Emission, Ambient, Diffuse, Specular, Shininess, Roughness
set g_MatProp(Emerald) {
    { 0.0 0.0 0.0 } { 0.0215 0.1745 0.0215 } { 0.07568 0.61424 0.07568 } { 0.633 0.727811 0.633 } { 0.6 } { 0.1 }
}
set g_MatProp(Jade) {
    { 0.0 0.0 0.0 } { 0.135 0.2225 0.1575 } { 0.54 0.89 0.63 } { 0.316228 0.316228 0.316228 } { 0.1 } { 0.1 } 
}
set g_MatProp(Obsidian) {
    { 0.0 0.0 0.0 } { 0.05375 0.05 0.06625 } { 0.18275 0.17 0.22525 } { 0.332741 0.328634 0.346435 } { 0.3 } { 0.1 }
}
set g_MatProp(Pearl) {
    { 0.0 0.0 0.0 } { 0.25 0.20725 0.20725 } { 1 0.829 0.829 } { 0.296648 0.296648 0.296648 } { 0.088 } { 0.1 }
}
set g_MatProp(Ruby) {
    { 0.0 0.0 0.0 } { 0.1745 0.01175 0.01175 } { 0.61424 0.04136 0.04136 } { 0.727811 0.626959 0.626959 } { 0.6 } { 0.1 } 
}
set g_MatProp(Turquoise) {
    { 0.0 0.0 0.0 } { 0.1 0.18725 0.1745 } { 0.396 0.74151 0.69102 } { 0.297254 0.30829 0.306678 } { 0.1 } { 0.1 }
}
set g_MatProp(Brass) {
    { 0.0 0.0 0.0 } { 0.329412 0.223529 0.027451 } { 0.780392 0.568627 0.113725 } { 0.992157 0.941176 0.807843 } { 0.21794872 } { 0.1 }
}
set g_MatProp(Bronze) {
    { 0.0 0.0 0.0 } { 0.2125 0.1275 0.054 } { 0.714 0.4284 0.18144 } { 0.393548 0.271906 0.166721 } { 0.2 } { 0.1 }
}
set g_MatProp(Chrome) {
    { 0.0 0.0 0.0 } { 0.25 0.25 0.25 } { 0.4 0.4 0.4 } { 0.774597 0.774597 0.774597 } { 0.6 } { 0.1 }
}
set g_MatProp(Copper) {
    { 0.0 0.0 0.0 } { 0.19125 0.0735 0.0225 } { 0.7038 0.27048 0.0828 } { 0.256777 0.137622 0.086014 } { 0.1 } { 0.1 }
}
set g_MatProp(Gold) {
    { 0.0 0.0 0.0 } { 0.24725 0.1995 0.0745 } { 0.75164 0.60648 0.22648 } { 0.628281 0.555802 0.366065 } { 0.4 } { 0.1 }
}
set g_MatProp(Silver) {
    { 0.0 0.0 0.0 } { 0.19225 0.19225 0.19225 } { 0.50754 0.50754 0.50754 } { 0.508273 0.508273 0.508273 } { 0.4 } { 0.1 }
}
set g_MatProp(PlasticBlack) {
    { 0.0 0.0 0.0 } { 0.0 0.0 0.0 } { 0.01 0.01 0.01 } { 0.50 0.50 0.50 } { 0.25 } { 0.1 }
}
set g_MatProp(PlasticCyan) {
    { 0.0 0.0 0.0 } { 0.0 0.1 0.06 } { 0.0 0.50980392 0.50980392 } { 0.50196078 0.50196078 0.50196078 } { 0.25 } { 0.1 }
}
set g_MatProp(PlasticGreen) {
    { 0.0 0.0 0.0 } { 0.0 0.0 0.0 } { 0.1 0.35 0.1 } { 0.45 0.55 0.45 } { 0.25 } { 0.1 }
}
set g_MatProp(PlasticRed) {
    { 0.0 0.0 0.0 } { 0.0 0.0 0.0 } { 0.5 0.0 0.0 } { 0.7 0.6 0.6 } { 0.25 } { 0.1 }
}
set g_MatProp(PlasticWhite) {
    { 0.0 0.0 0.0 } { 0.0 0.0 0.0 } { 0.55 0.55 0.55 } { 0.70 0.70 0.70 } { 0.25 } { 0.1 }
}
set g_MatProp(PlasticYellow) {
    { 0.0 0.0 0.0 } { 0.0 0.0 0.0 } { 0.5 0.5 0.0 } { 0.60 0.60 0.50 } { 0.25 } { 0.1 }
}
set g_MatProp(RubberBlack) {
    { 0.0 0.0 0.0 } { 0.02 0.02 0.02 } { 0.01 0.01 0.01 } { 0.4 0.4 0.4 } { 0.078125 } { 0.1 }
}
set g_MatProp(RubberCyan) {
    { 0.0 0.0 0.0 } { 0.0 0.05 0.05 } { 0.4 0.5 0.5 } { 0.04 0.7 0.7 } { 0.078125 } { 0.1 }
}
set g_MatProp(RubberGreen) {
    { 0.0 0.0 0.0 } { 0.0 0.05 0.0 } { 0.4 0.5 0.4 } { 0.04 0.7 0.04 } { 0.078125 } { 0.1 }
}
set g_MatProp(RubberRed) {
    { 0.0 0.0 0.0 } { 0.05 0.0 0.0 } { 0.5 0.4 0.4 } { 0.7 0.04 0.04 } { 0.078125 } { 0.1 }
}
set g_MatProp(RubberWhite) {
    { 0.0 0.0 0.0 } { 0.05 0.05 0.05 } { 0.5 0.5 0.5 } { 0.7 0.7 0.7 } { 0.078125 } { 0.1 }
}
set g_MatProp(RubberYellow) {
    { 0.0 0.0 0.0 } { 0.05 0.05 0.0 } { 0.5 0.5 0.4 } { 0.7 0.7 0.04 } { 0.078125 } { 0.1 }
}

# Default light source properties.
set g_Lgt(Position,r) 3.0
set g_Lgt(Position,g) 1.0
set g_Lgt(Position,b) 7.0
set g_Lgt(Ambient,r)  1.0
set g_Lgt(Ambient,g)  1.0
set g_Lgt(Ambient,b)  1.0
set g_Lgt(Diffuse,r)  1.0
set g_Lgt(Diffuse,g)  1.0
set g_Lgt(Diffuse,b)  1.0
set g_Lgt(Specular,r) 1.0
set g_Lgt(Specular,g) 1.0
set g_Lgt(Specular,b) 1.0

# Default transformation values.
set g_Tfm(rot,x)   0.0
set g_Tfm(rot,y)   0.0
set g_Tfm(rot,z)   0.0
set g_Tfm(trans,x) 0.0
set g_Tfm(trans,y) 0.0
set g_Tfm(trans,z) 0.0

# Font to be used in the Tk listbox.
set g_Demo(listFont) {-family {Courier} -size 10}

# Obtain the name of this script file.
set g_Demo(scriptDir) [file dirname [info script]]

# Window size.
set g_Demo(winWidth)  800
set g_Demo(winHeight) 800

# Projection matrix. 
set g_Demo(projectionMat) [tcl3dVector GLfloat 16]

# ModelView matrix.
set g_Demo(modelViewMat) [tcl3dVector GLfloat 16]

# Stop watch and frame counter for FPS measurement.
set g_Demo(frameCount)  0
set g_Demo(stopwatch)   [tcl3dNewSwatch]

# Show errors occuring in the Togl callbacks.
proc bgerror { msg } {
    tk_messageBox -icon error -type ok -message "Error: $msg\n\n$::errorInfo"
    ExitProg
}

# Print info message into widget at the bottom of the window.
proc PrintInfo { msg } {
    if { [winfo exists .fr.info] } {
        .fr.info configure -text $msg
    }
}

proc SetMousePos { x y } {
    global g_Demo

    set g_Demo(mouse,x) $x
    set g_Demo(mouse,y) $y
}

proc HandleRot { togl x y } {
    global g_Demo
    global g_Tfm

    set w [winfo width  $togl]
    set h [winfo height $togl]
    set xDelta [expr { 180 * (double($x - $g_Demo(mouse,x)) / $w) }]
    set yDelta [expr { 180 * (double($y - $g_Demo(mouse,y)) / $h) }]
    set g_Tfm(rot,x) [expr { $g_Tfm(rot,x) + $yDelta }]
    set g_Tfm(rot,y) [expr { $g_Tfm(rot,y) + $xDelta }]

    set g_Demo(mouse,x) $x
    set g_Demo(mouse,y) $y

    $togl postredisplay
}

proc HandleTrans { axis togl x y } {
    global g_Demo
    global g_Tfm

    if { $axis eq "Z" } {
        set g_Tfm(trans,z) [expr { $g_Tfm(trans,z) + 0.1 * double($g_Demo(mouse,y) - $y) }]
    } else {
        set g_Tfm(trans,x) [expr { $g_Tfm(trans,x) + 0.1 * double($x - $g_Demo(mouse,x)) }]
        set g_Tfm(trans,y) [expr { $g_Tfm(trans,y) - 0.1 * double($y - $g_Demo(mouse,y)) }]
    }

    set g_Demo(mouse,x) $x
    set g_Demo(mouse,y) $y

    $togl postredisplay
}

# Get the currently active diffuse and specular shader names as a list.
proc GetShaderCombination {} {
    global g_Demo
    global g_UniformMap

    foreach key [array names g_UniformMap "Diffuse,*"] {
        if { $g_UniformMap($key) == $g_Demo(Diffuse,Uniform) } {
            set diffuseShader [lindex [split $key ","] 1]
            break
        }
    }
    foreach key [array names g_UniformMap "Specular,*"] {
        if { $g_UniformMap($key) == $g_Demo(Specular,Uniform) } {
            set specularShader [lindex [split $key ","] 1]
            break
        }
    }
    return [list $diffuseShader $specularShader]
}

# Assign the properties of a material to the global variables
# attached to spinboxes.
proc AssignMaterial { matName } {
    global g_Mat
    global g_MatProp

    set emission  [lindex $g_MatProp($matName) 0]
    set ambient   [lindex $g_MatProp($matName) 1]
    set diffuse   [lindex $g_MatProp($matName) 2]
    set specular  [lindex $g_MatProp($matName) 3]
    set shininess [lindex $g_MatProp($matName) 4]
    set roughness [lindex $g_MatProp($matName) 5]
    set g_Mat(Emission,r) [lindex $emission 0] 
    set g_Mat(Emission,g) [lindex $emission 1]
    set g_Mat(Emission,b) [lindex $emission 2]
    set g_Mat(Emission,a) [expr { [llength $emission] == 3? 1.0: [lindex $emission 3] }]
    set g_Mat(Ambient,r)  [lindex $ambient 0]
    set g_Mat(Ambient,g)  [lindex $ambient 1]
    set g_Mat(Ambient,b)  [lindex $ambient 2]
    set g_Mat(Ambient,a)  [expr { [llength $ambient] == 3? 1.0: [lindex $ambient 3] }]
    set g_Mat(Diffuse,r)  [lindex $diffuse 0]
    set g_Mat(Diffuse,g)  [lindex $diffuse 1]
    set g_Mat(Diffuse,b)  [lindex $diffuse 2]
    set g_Mat(Diffuse,a)  [expr { [llength $diffuse] == 3? 1.0: [lindex $diffuse 3] }]
    set g_Mat(Specular,r) [lindex $specular 0]
    set g_Mat(Specular,g) [lindex $specular 1]
    set g_Mat(Specular,b) [lindex $specular 2]
    set g_Mat(Specular,a) [expr { [llength $specular] == 3? 1.0: [lindex $specular 3] }]
    set g_Mat(Shininess)  [lindex $shininess 0]
    set g_Mat(Roughness)  [lindex $roughness 0]
}

# Display the render speed as frames per second in the window
# title and print it to stdout.
proc DisplayFPS {} {
    global g_Demo
    global g_Tfm

    incr g_Demo(frameCount)
    if { $g_Demo(frameCount) == 2000 } {
        set currentTime [tcl3dLookupSwatch $g_Demo(stopwatch)]
        set fps [expr { $g_Demo(frameCount) / $currentTime }]
        set msg [format "Tcl3D demo: Lighting models (%.0f fps)" $fps]
        wm title . $msg
        lassign [GetShaderCombination] diffuseShader specularShader
        set w $g_Demo(toglWidth)
        set h $g_Demo(toglHeight)
        puts [format "%d,%d,%s,%s,%.0f" $w $h $diffuseShader $specularShader $fps]
        set g_Demo(frameCount) 0
        if { [info exists g_Demo(animateId)] } {
            after cancel $g_Demo(animateId)
            unset g_Demo(animateId)
            set g_Tfm(rot,y) $g_Demo(savedAngle)
        }
    }
}

proc StartAnimation {} {
    global g_Demo
    global g_Tfm

    set g_Demo(savedAngle) $g_Tfm(rot,y)
    tcl3dResetSwatch $g_Demo(stopwatch)
    tcl3dStartSwatch $g_Demo(stopwatch)

    Animate .fr.toglwin
}

proc Animate { w } {
    global g_Demo
    global g_Tfm

    set g_Tfm(rot,y) [format "%.1f" [expr { $g_Tfm(rot,y) + 0.1 }]]
    $w postredisplay
    set g_Demo(animateId) [tcl3dAfterIdle Animate $w]
}

proc SaveImage {} {
    global g_Demo

    Update

    lassign [GetShaderCombination] diffuseShader specularShader
    set fileName [format "Img_%s-%s.png" $diffuseShader $specularShader]
    puts "Image stored in $fileName"

    set w $g_Demo(toglWidth)
    set h $g_Demo(toglHeight)
    set numChans 4
    set vec [tcl3dVector GLubyte [expr $w * $h * $numChans]]
    glReadPixels 0 0 $w $h GL_RGBA GL_UNSIGNED_BYTE $vec
    set ph [image create photo -width $w -height $h]
    tcl3dVectorToPhoto $vec $ph $w $h $numChans
    $ph write $fileName -format PNG
    $vec delete
    image delete $ph
}

proc LoadShape {} {
    global g_Demo
    global g_Shape

    set shape  $g_Demo(Shape)
    set cmd    [lindex $g_Shape($shape) 0]
    set params [lindex $g_Shape($shape) 1]
    foreach { name value } $params {
        lappend cmdArgs $value
    }
    set shapeDict [$cmd {*}$cmdArgs]
    set g_Demo(numIndices) [dict get $shapeDict numIndices]

    set g_Demo(vertices) [tcl3dVector GLuint 1]
    glGenBuffers 1 $g_Demo(vertices)
    glBindBuffer GL_ARRAY_BUFFER [$g_Demo(vertices) get 0]
    set vertexVec [dict get $shapeDict vertexVec]
    glBufferData GL_ARRAY_BUFFER \
                 [expr [dict get $shapeDict numVertices]*4*[$vertexVec elemsize]] \
                 $vertexVec GL_STATIC_DRAW

    set g_Demo(normals) [tcl3dVector GLuint 1]
    glGenBuffers 1 $g_Demo(normals)
    glBindBuffer GL_ARRAY_BUFFER [$g_Demo(normals) get 0]
    set normalVec [dict get $shapeDict normalVec]
    glBufferData GL_ARRAY_BUFFER \
                 [expr [dict get $shapeDict numVertices]*3*[$normalVec elemsize]] \
                 $normalVec GL_STATIC_DRAW

    set g_Demo(indices) [tcl3dVector GLuint 1]
    glGenBuffers 1 $g_Demo(indices)
    glBindBuffer GL_ELEMENT_ARRAY_BUFFER [$g_Demo(indices) get 0]
    set indexVec [dict get $shapeDict indexVec]
    glBufferData GL_ELEMENT_ARRAY_BUFFER \
                 [expr [dict get $shapeDict numIndices]*[$indexVec elemsize]] \
                 $indexVec GL_STATIC_DRAW

    glusDestroyShape $shapeDict
}

proc Transform {} {
    global g_Demo
    global g_Tfm

    set model [tcl3dVector GLfloat 16]
    set trans [tcl3dVector GLfloat 16]
    set rot1  [tcl3dVector GLfloat 16]
    set rot2  [tcl3dVector GLfloat 16]
    set rot3  [tcl3dVector GLfloat 16]

    # Calculate the model matrix.
    tcl3dMatfIdentity $model

    tcl3dMatfTranslate $g_Tfm(trans,x) $g_Tfm(trans,y) [expr { -1.0 * $g_Tfm(trans,z) }] $trans
    tcl3dMatfRotateX $g_Tfm(rot,x) $rot1
    tcl3dMatfRotateY $g_Tfm(rot,y) $rot2
    tcl3dMatfRotateZ $g_Tfm(rot,z) $rot3
    tcl3dMatfMult $model $trans $model
    tcl3dMatfMult $model $rot1 $model
    tcl3dMatfMult $model $rot2 $model
    tcl3dMatfMult $model $rot3 $model

    # Calculate the view matrix.
    tcl3dLookAt 0.0 0.0 5.0  0.0 0.0 0.0  0.0 1.0 0.0  $g_Demo(modelViewMat)

    # Final model view matrix.
    tcl3dMatfMult $g_Demo(modelViewMat) $model $g_Demo(modelViewMat)

    $model delete
    $trans delete
    $rot1  delete
    $rot2  delete
    $rot3  delete

    set modelViewAsList [tcl3dVectorToList $g_Demo(modelViewMat) 16]
    glUniformMatrix4fv $g_Demo(uniModelViewMatrix) 1 GL_FALSE $modelViewAsList
}

# Function for initialization.
proc Init {} {
    global g_Demo

    CleanupProgram

    # Load the source of the vertex shader.
    set vertexSource [tcl3dOglReadShaderFile [file join $g_Demo(scriptDir) "LightingModels.vs"]]

    # Load the source of the fragment shader.
    set fragmentSource [tcl3dOglReadShaderFile [file join $g_Demo(scriptDir) "LightingModels.fs"]]

    set g_Demo(Program) [tcl3dOglBuildProgram $vertexSource "" "" "" $fragmentSource]
    set program [dict get $g_Demo(Program) program]

    # Vertex Array Object for the vertices.
    set g_Demo(VAO) [tcl3dVector GLuint 1]
    glGenVertexArrays 1 $g_Demo(VAO)
    glBindVertexArray [$g_Demo(VAO) get 0]

    LoadShape

    # Location of the projection matrix in the shader program.
    set g_Demo(uniProjectionMatrix) [glGetUniformLocation $program "uniProjectionMatrix"]

    # Location of the model view matrix in the shader program.
    set g_Demo(uniModelViewMatrix) [glGetUniformLocation $program "uniModelViewMatrix"]

    # Location of the diffuse and specular shader identifiers in the shader program.
    set g_Demo(uniDiffuseShader)  [glGetUniformLocation $program "uniDiffuseShader"]
    set g_Demo(uniSpecularShader) [glGetUniformLocation $program "uniSpecularShader"]

    # Location of the vertices in the shader program.
    set vertexLocation [glGetAttribLocation $program "vertexObj"]
    set retVal [tcl3dOglGetError]
    if { $retVal ne "" } {
        error "Error creating vertexLocation: $retVal"
    }

    # Location of the normals in the shader program.
    set normalLocation [glGetAttribLocation $program "normalObj"]
    set retVal [tcl3dOglGetError]
    if { $retVal ne "" } {
        error "Error creating normalLocation: $retVal"
    }

    # The location of the material property uniforms.
    set g_Demo(uniMaterialEmission)  [glGetUniformLocation $program "uniMaterialEmission"]
    set g_Demo(uniMaterialAmbient)   [glGetUniformLocation $program "uniMaterialAmbient"]
    set g_Demo(uniMaterialDiffuse)   [glGetUniformLocation $program "uniMaterialDiffuse"]
    set g_Demo(uniMaterialSpecular)  [glGetUniformLocation $program "uniMaterialSpecular"]
    set g_Demo(uniMaterialShininess) [glGetUniformLocation $program "uniMaterialShininess"]
    set g_Demo(uniMaterialRoughness) [glGetUniformLocation $program "uniMaterialRoughness"]

    # The location of the light source property uniforms.
    set g_Demo(uniLightSourcePosition) [glGetUniformLocation $program "uniLightSourcePosition"]
    set g_Demo(uniLightSourceAmbient)  [glGetUniformLocation $program "uniLightSourceAmbient"]
    set g_Demo(uniLightSourceDiffuse)  [glGetUniformLocation $program "uniLightSourceDiffuse"]
    set g_Demo(uniLightSourceSpecular) [glGetUniformLocation $program "uniLightSourceSpecular"]
    
    glUseProgram $program

    Transform

    glBindBuffer GL_ARRAY_BUFFER [$g_Demo(vertices) get 0]
    glVertexAttribPointer $vertexLocation 4 GL_FLOAT GL_FALSE 0 "NULL"
    glEnableVertexAttribArray $vertexLocation

    glBindBuffer GL_ARRAY_BUFFER [$g_Demo(normals) get 0]
    glVertexAttribPointer $normalLocation 3 GL_FLOAT GL_FALSE 0 "NULL"
    glEnableVertexAttribArray $normalLocation
}

proc CreateCallback { toglwin } {
    global g_Demo

    glClearColor 0.0 0.0 0.0 0.0
    glClearDepth 1.0
    glEnable GL_DEPTH_TEST
    glEnable GL_CULL_FACE
}

proc ReshapeCallback { toglwin { w -1 } { h -1 } } {
    global g_Demo

    set w [$toglwin width]
    set h [$toglwin height]

    set g_Demo(toglWidth)  $w
    set g_Demo(toglHeight) $h

    glViewport 0 0 $w $h

    if { ! $g_Demo(haveNeededVersion) } {
        return
    }
    # Calculate the projection matrix and set it as uniform.
    tcl3dPerspective 40.0 [expr {double($w)/double($h) }] \
                     1.0 100.0 $g_Demo(projectionMat)
    set projectionAsList [tcl3dVectorToList $g_Demo(projectionMat) 16]
    glUniformMatrix4fv $g_Demo(uniProjectionMatrix) 1 GL_FALSE $projectionAsList
}

proc DisplayCallback { toglwin } {
    global g_Demo
    global g_Mat g_Lgt
    global g_UniformMap

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

    if { ! $g_Demo(haveNeededVersion) } {
        $toglwin swapbuffer
        return
    }

    # Set uniform values for diffuse and specular shader identifier.
    glUniform1i $g_Demo(uniDiffuseShader)  $g_Demo(Diffuse,Uniform)
    glUniform1i $g_Demo(uniSpecularShader) $g_Demo(Specular,Uniform)
  
    # Set uniform values for material properties.
    glUniform4f $g_Demo(uniMaterialEmission)  $g_Mat(Emission,r) $g_Mat(Emission,g) $g_Mat(Emission,b)  1.0
    glUniform4f $g_Demo(uniMaterialAmbient)   $g_Mat(Ambient,r)  $g_Mat(Ambient,g)  $g_Mat(Ambient,b)   1.0
    glUniform4f $g_Demo(uniMaterialDiffuse)   $g_Mat(Diffuse,r)  $g_Mat(Diffuse,g)  $g_Mat(Diffuse,b)   1.0
    glUniform4f $g_Demo(uniMaterialSpecular)  $g_Mat(Specular,r) $g_Mat(Specular,g) $g_Mat(Specular,b)  1.0
    if { $g_Demo(Specular,Uniform) == $g_UniformMap(Specular,Sandford) } {
        glUniform1f $g_Demo(uniMaterialShininess) $g_Mat(Shininess)
    } else {
        glUniform1f $g_Demo(uniMaterialShininess) [expr $g_Mat(Shininess) * 128.0]
    }
    glUniform1f $g_Demo(uniMaterialRoughness) $g_Mat(Roughness)

    # Set uniform values for light source.
    glUniform4f $g_Demo(uniLightSourcePosition) $g_Lgt(Position,r) $g_Lgt(Position,g) $g_Lgt(Position,b) 1.0
    glUniform4f $g_Demo(uniLightSourceAmbient)  $g_Lgt(Ambient,r)  $g_Lgt(Ambient,g)  $g_Lgt(Ambient,b)  1.0
    glUniform4f $g_Demo(uniLightSourceDiffuse)  $g_Lgt(Diffuse,r)  $g_Lgt(Diffuse,g)  $g_Lgt(Diffuse,b)  1.0
    glUniform4f $g_Demo(uniLightSourceSpecular) $g_Lgt(Specular,r) $g_Lgt(Specular,g) $g_Lgt(Specular,b) 1.0

    Transform

    glDrawElements GL_TRIANGLES $g_Demo(numIndices) GL_UNSIGNED_INT "NULL"

    if { [info exists g_Demo(animateId)] } {
        DisplayFPS
    }

    $toglwin swapbuffer
}

proc CleanupProgram {} {
    global g_Demo

    if { [info exists g_Demo(vertices)] } {
        glDeleteBuffers 1 [$g_Demo(vertices) get 0]
        $g_Demo(vertices) delete
        unset g_Demo(vertices)
    }

    if { [info exists g_Demo(normals)] } {
        glDeleteBuffers 1 [$g_Demo(normals) get 0]
        $g_Demo(normals) delete
        unset g_Demo(normals)
    }

    if { [info exists g_Demo(indices)] } {
        glDeleteBuffers 1 [$g_Demo(indices) get 0]
        $g_Demo(indices) delete
        unset g_Demo(indices)
    }

    if { [info exists g_Demo(VAO)] } {
        glDeleteVertexArrays 1 [$g_Demo(VAO) get 0]
        $g_Demo(VAO) delete
        unset g_Demo(VAO)
    }

    if { [info exists g_Demo(Program)] } {
        tcl3dOglDestroyProgram $g_Demo(Program)
        unset g_Demo(Program)
    }
}

proc Cleanup {} {
    global g_Demo

    CleanupProgram

    # Unset all global variables. 
    # Needed when running the demo in the Tcl3D presentation framework.
    foreach var [info globals g_*] {
        uplevel #0 unset $var
    }
}

# Put all exit related code here.
proc ExitProg {} {
    exit
}

proc Update { { mode "" } } {
    global g_Demo

    if { $mode eq "shape" } {
        Init
        ReshapeCallback .fr.toglwin
    }
    if { $mode eq "material" } {
        AssignMaterial $g_Demo(Material)
    }

    DisplayCallback .fr.toglwin
}

# Create the OpenGL window and some Tk helper widgets.
proc CreateWindow {} {
    global g_Demo
    global g_UniformMap
    global g_Mat g_Lgt
    global g_Shape
    global g_MatProp

    frame .fr
    pack .fr -expand 1 -fill both

    # Create a Togl window with an OpenGL core profile using version 3.3.
    # Reshape and Display callbacks are configured later after knowing if
    # the needed OpenGL profile version is available.
    togl .fr.toglwin -width $g_Demo(winWidth) -height $g_Demo(winHeight) \
                     -double true -depth true \
                     -createcommand CreateCallback \
                     -coreprofile true -major 3 -minor 3

    set g_Demo(haveNeededVersion) true
    set numRows 1
    set haveGL3 [tcl3dOglHaveVersion 3]
    if { ! $haveGL3 } {
        set msgStr [format \
            "Demo needs core profile 3.3. Only have GL version %s" \
            [tcl3dOglGetVersion]]
        set g_Demo(haveNeededVersion) false
        incr numRows
    } else {
        set profile [tcl3dOglGetProfile .fr.toglwin]
        if { [dict get $profile "coreprofile"] != true } {
            set msgStr [format \
                "Demo needs core profile 3.3. Only have compatibility profile %d.%d" \
                [dict get $profile "major"] \
                [dict get $profile "minor"]]
            incr numRows
        }
    }
    if { $g_Demo(haveNeededVersion) } {
        # If OpenGL 3.3 or higher is available, initialize the buffers.
        Init
    }

    # Now attach the Reshape and Display callbacks to the Togl window.
    .fr.toglwin configure \
        -reshapecommand ReshapeCallback \
        -displaycommand DisplayCallback 

    AssignMaterial $g_Demo(Material)

    ttk::frame .fr.guiFr
    listbox    .fr.usage  -font $g_Demo(listFont) -height $numRows
    ttk::label .fr.info
    grid .fr.toglwin -row 0 -column 0 -sticky news
    grid .fr.guiFr   -row 0 -column 1 -sticky news
    grid .fr.usage   -row 1 -column 0 -sticky news -columnspan 2
    grid .fr.info    -row 2 -column 0 -sticky news -columnspan 2
    grid rowconfigure .fr 0 -weight 1
    grid columnconfigure .fr 0 -weight 1
    wm title . "Tcl3D demo: Lighting models"

    set diffuseFr  .fr.guiFr.diffuseFr
    set specularFr .fr.guiFr.specularFr
    set matFr      .fr.guiFr.materialFr
    set lgtFr      .fr.guiFr.lightSourceFr
    set modelFr    .fr.guiFr.modelFr
    set settFr     .fr.guiFr.settingFr
    set btnFr      .fr.guiFr.buttonFr

    ttk::labelframe $diffuseFr  -text "Diffuse shader"
    ttk::labelframe $specularFr -text "Specular shader"
    ttk::labelframe $matFr      -text "Material properties"
    ttk::labelframe $lgtFr      -text "Lightsource properties"
    ttk::labelframe $modelFr    -text "Model transformations"
    ttk::labelframe $settFr     -text "Settings"
    ttk::labelframe $btnFr      -text "Commands"
    pack {*}[winfo children .fr.guiFr] -side top -anchor w -fill x

    # Frame "Diffuse shader"
    foreach key [lsort -dictionary [array names g_UniformMap "Diffuse,*"]] {
        set diffuse [lindex [split $key ","] 1]
        ttk::radiobutton $diffuseFr.[string tolower $diffuse] -text $diffuse \
                         -value $g_UniformMap($key) -variable g_Demo(Diffuse,Uniform) \
                         -command Update
    }
    pack {*}[winfo children $diffuseFr] -side top -anchor w

    # Frame "Specular shader"
    foreach key [lsort -dictionary [array names g_UniformMap "Specular,*"]] {
        set specular [lindex [split $key ","] 1]
        ttk::radiobutton $specularFr.[string tolower $specular] -text $specular \
                         -value $g_UniformMap($key) -variable g_Demo(Specular,Uniform) \
                         -command Update
    }
    pack {*}[winfo children $specularFr] -side top -anchor w

    # Frame "Material properties"
    set row 0
    foreach matProp { "Emission" "Ambient" "Diffuse" "Specular" } {
        ttk::label   $matFr.l_$row -text "${matProp}:"
        ttk::spinbox $matFr.r_$row -from 0.0 -to 1.0 -increment 0.1 -width 5 \
                     -textvariable g_Mat($matProp,r) -command Update
        ttk::spinbox $matFr.g_$row -from 0.0 -to 1.0 -increment 0.1 -width 5 \
                     -textvariable g_Mat($matProp,g) -command Update
        ttk::spinbox $matFr.b_$row -from 0.0 -to 1.0 -increment 0.1 -width 5 \
                     -textvariable g_Mat($matProp,b) -command Update
        ttk::spinbox $matFr.a_$row -from 0.0 -to 1.0 -increment 0.1 -width 5 \
                     -textvariable g_Mat($matProp,a) -command Update
        bind $matFr.r_$row <Key-Return> Update
        bind $matFr.g_$row <Key-Return> Update
        bind $matFr.b_$row <Key-Return> Update
        bind $matFr.a_$row <Key-Return> Update
        grid $matFr.l_$row -row $row -column 0 -sticky news
        grid $matFr.r_$row -row $row -column 1 -sticky news
        grid $matFr.g_$row -row $row -column 2 -sticky news
        grid $matFr.b_$row -row $row -column 3 -sticky news
        grid $matFr.a_$row -row $row -column 4 -sticky news
        incr row
    }

    set matProp "Shininess"
    ttk::label   $matFr.l_$row -text "${matProp}:"
    tcl3dToolhelpAddBinding $matFr.l_$row "Sandford: Specular lobe with"
    ttk::spinbox $matFr.r_$row -from 0 -to 1.0 -increment 0.05 -width 5 \
                 -textvariable g_Mat($matProp) -command Update
    bind $matFr.r_$row <Key-Return> Update
    grid $matFr.l_$row -row $row -column 0 -sticky news
    grid $matFr.r_$row -row $row -column 1 -sticky news
    incr row

    set matProp "Roughness"
    ttk::label   $matFr.l_$row -text "${matProp}:"
    tcl3dToolhelpAddBinding $matFr.l_$row "Sandford: Grazing angle reflectivity"
    ttk::spinbox $matFr.r_$row -from 0.0 -to 1.0 -increment 0.05 -width 5 \
                 -textvariable g_Mat($matProp) -command Update
    bind $matFr.r_$row <Key-Return> Update
    grid $matFr.l_$row -row $row -column 0 -sticky news
    grid $matFr.r_$row -row $row -column 1 -sticky news

    # Frame "Lightsource properties"
    set row 0
    foreach lgtProp { "Ambient" "Diffuse" "Specular" } {
        ttk::label   $lgtFr.l_$row -text "${lgtProp}:"
        ttk::spinbox $lgtFr.r_$row -from 0.0 -to 1.0 -increment 0.05 -width 5 \
                     -textvariable g_Lgt($lgtProp,r) -command Update
        ttk::spinbox $lgtFr.g_$row -from 0.0 -to 1.0 -increment 0.05 -width 5 \
                     -textvariable g_Lgt($lgtProp,g) -command Update
        ttk::spinbox $lgtFr.b_$row -from 0.0 -to 1.0 -increment 0.05 -width 5 \
                     -textvariable g_Lgt($lgtProp,b) -command Update
        bind $lgtFr.r_$row <Key-Return> Update
        bind $lgtFr.g_$row <Key-Return> Update
        bind $lgtFr.b_$row <Key-Return> Update
        grid $lgtFr.l_$row -row $row -column 0 -sticky news
        grid $lgtFr.r_$row -row $row -column 1 -sticky news
        grid $lgtFr.g_$row -row $row -column 2 -sticky news
        grid $lgtFr.b_$row -row $row -column 3 -sticky news
        incr row
    }
    set lgtProp "Position"
    ttk::label   $lgtFr.l_$row -text "${lgtProp}:"
    ttk::spinbox $lgtFr.r_$row -from -50 -to 50 -increment 1 -width 5 \
                 -textvariable g_Lgt($lgtProp,r) -command Update
    ttk::spinbox $lgtFr.g_$row -from -50 -to 50 -increment 1 -width 5 \
                 -textvariable g_Lgt($lgtProp,g) -command Update
    ttk::spinbox $lgtFr.b_$row -from -50 -to 50 -increment 1 -width 5 \
                 -textvariable g_Lgt($lgtProp,b) -command Update
    bind $lgtFr.r_$row <Key-Return> Update
    bind $lgtFr.g_$row <Key-Return> Update
    bind $lgtFr.b_$row <Key-Return> Update
    grid $lgtFr.l_$row -row $row -column 0 -sticky news
    grid $lgtFr.r_$row -row $row -column 1 -sticky news
    grid $lgtFr.g_$row -row $row -column 2 -sticky news
    grid $lgtFr.b_$row -row $row -column 3 -sticky news

    # Frame "Model transformations"
    ttk::label   $modelFr.tl -text "Translation:"
    ttk::spinbox $modelFr.tx -from -1 -to 1 -increment 0.1 -width 5 \
                 -textvariable g_Tfm(trans,x) -command Update
    ttk::spinbox $modelFr.ty -from -1 -to 1 -increment 0.1 -width 5 \
                 -textvariable g_Tfm(trans,y) -command Update
    ttk::spinbox $modelFr.tz -from -10 -to 50 -increment 2 -width 5 \
                 -textvariable g_Tfm(trans,z) -command Update
    bind $modelFr.tx <Key-Return> Update
    bind $modelFr.ty <Key-Return> Update
    bind $modelFr.tz <Key-Return> Update
    grid $modelFr.tl -row 0 -column 0 -sticky news
    grid $modelFr.tx -row 0 -column 1 -sticky news
    grid $modelFr.ty -row 0 -column 2 -sticky news
    grid $modelFr.tz -row 0 -column 3 -sticky news

    ttk::label   $modelFr.rl -text "Rotation:"
    ttk::spinbox $modelFr.rx -from -180 -to 180 -increment 5 -width 5 \
                 -textvariable g_Tfm(rot,x) -command Update
    ttk::spinbox $modelFr.ry -from -180 -to 180 -increment 5 -width 5 \
                 -textvariable g_Tfm(rot,y) -command Update
    ttk::spinbox $modelFr.rz -from -180 -to 180 -increment 5 -width 5 \
                 -textvariable g_Tfm(rot,z) -command Update
    bind $modelFr.rx <Key-Return> Update
    bind $modelFr.ry <Key-Return> Update
    bind $modelFr.rz <Key-Return> Update
    grid $modelFr.rl -row 1 -column 0 -sticky news
    grid $modelFr.rx -row 1 -column 1 -sticky news
    grid $modelFr.ry -row 1 -column 2 -sticky news
    grid $modelFr.rz -row 1 -column 3 -sticky news

    # Frame "Settings"
    ttk::label    $settFr.lshape -text "Shape:"
    ttk::combobox $settFr.cbshape -state readonly -textvariable g_Demo(Shape) \
                  -values [lsort -dictionary [array names g_Shape "*"]]
    grid $settFr.lshape  -row 0 -column 0 -sticky news
    grid $settFr.cbshape -row 0 -column 1 -sticky news
    bind $settFr.cbshape <<ComboboxSelected>> "Update shape"

    ttk::label    $settFr.lmat -text "Material:"
    ttk::combobox $settFr.cbmat -state readonly -textvariable g_Demo(Material) \
                  -values [lsort -dictionary [array names g_MatProp "*"]]
    grid $settFr.lmat  -row 1 -column 0 -sticky news
    grid $settFr.cbmat -row 1 -column 1 -sticky news
    bind $settFr.cbmat <<ComboboxSelected>> "Update material"

    # Frame "Commands"
    ttk::button $btnFr.anim -text "Measure FPS" -command "StartAnimation"
    ttk::button $btnFr.save -text "Save image" -command SaveImage
    pack {*}[winfo children $btnFr] -side left -fill x -expand true

    # Watch for Esc key and Quit messages
    wm protocol . WM_DELETE_WINDOW "ExitProg"
    bind . <Key-Escape> "ExitProg"

    .fr.usage insert end "Key-Escape Exit"
    if { [info exists msgStr] } {
        .fr.usage insert end $msgStr
        .fr.usage itemconfigure end -background red
    } else {
        .fr.usage configure -state disabled
    }

    bind .fr.toglwin <<LeftMousePress>>    "SetMousePos %x %y"
    bind .fr.toglwin <<MiddleMousePress>>  "SetMousePos %x %y"
    bind .fr.toglwin <<RightMousePress>>   "SetMousePos %x %y"
    bind .fr.toglwin <<LeftMouseMotion>>   "HandleRot   %W %x %y"
    bind .fr.toglwin <<MiddleMouseMotion>> "HandleTrans X %W %x %y"
    bind .fr.toglwin <<RightMouseMotion>>  "HandleTrans Z %W %x %y"
}

CreateWindow
ReshapeCallback .fr.toglwin

PrintInfo [tcl3dOglGetInfoString]
