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