Demo 6 of 6 in category tcl3dOglExt
 |
# Testbed for GLSL procedural noise functions.
#
# Shaders are loaded from two external files:
# SimplexNoiseGLSL.vert and SimplexNoiseGLSL.frag.
# The program itself draws a spinning sphere
# with a noise-generated fragment color.
#
# Author: Stefan Gustavson (stegu@itn.liu.se) 2004, 2005, 2010, 2011
#
# Modified and extended for Tcl3D by Paul Obermeier 2011/03/20
# See www.tcl3d.org for the Tcl3D extension.
package require Tk
package require tcl3d
# 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) 512
set g_Demo(winHeight) 512
# Will be set to true in LoadExtensions,
# if all needed OpenGL extensions are available.
set g_Demo(haveOglExtensions) false
# Create a stop watch for time measurement.
set g_Demo(stopWatch) [tcl3dNewSwatch]
set g_Demo(frameCount) 0
set g_Demo(appName) "Tcl3D demo: GLSL simplex noise"
# Variables for toggling time update and object animation.
set g_Demo(updateTime) 1
set g_Demo(animateObject) 1
# Toggle between full-screen quad and sphere.
set g_Demo(drawSphere) 1
# Select noise algorithm: 2D, 3D or 4D noise.
set g_Demo(noiseAlgo) 3
# 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 at the bottom of the window.
proc PrintInfo { msg } {
if { [winfo exists .fr.info] } {
.fr.info configure -text $msg
}
}
# Print status message into widget at the bottom of the window.
proc PrintStatus {} {
global g_Demo
if { [winfo exists .fr.status] } {
set updateTime "Off"
set animateObject "Off"
if { $g_Demo(updateTime) } {
set updateTime "On"
}
if { $g_Demo(animateObject) } {
set animateObject "On"
}
set msg [format "Time update: %s Object animation: %s Noise algorithm: %dD" \
$updateTime $animateObject $g_Demo(noiseAlgo)]
.fr.status configure -text $msg
}
}
proc ShowFPS {} {
global g_Demo
set currentTime [tcl3dLookupSwatch $g_Demo(stopWatch)]
# If one second has passed, or if this is the very first frame.
set dt [expr {$currentTime - $g_Demo(lastTime)}]
if { $dt > 1.0 || $g_Demo(frameCount) == 0 } {
set fps [expr {double($g_Demo(frameCount)) / $dt}]
wm title . [format "%s (%.0f fps)" $g_Demo(appName) $fps]
set g_Demo(lastTime) $currentTime
set g_Demo(frameCount) 0
}
incr g_Demo(frameCount)
}
proc Animate {} {
global g_Demo
.fr.toglwin postredisplay
set g_Demo(animateId) [tcl3dAfterIdle Animate]
}
proc StartAnimation {} {
global g_Demo
if { ! [info exists g_Demo(animateId)] } {
Animate
tcl3dStartSwatch $g_Demo(stopWatch)
}
}
proc StopAnimation {} {
global g_Demo
if { [info exists g_Demo(animateId)] } {
after cancel $g_Demo(animateId)
unset g_Demo(animateId)
tcl3dStopSwatch $g_Demo(stopWatch)
}
}
proc ToggleUpdateTime {} {
global g_Demo
set g_Demo(updateTime) [expr ! $g_Demo(updateTime)]
PrintStatus
if { $g_Demo(updateTime) } {
tcl3dStartSwatch $g_Demo(stopWatch)
} else {
tcl3dStopSwatch $g_Demo(stopWatch)
}
}
proc ToggleAnimateObject {} {
global g_Demo
set g_Demo(animateObject) [expr ! $g_Demo(animateObject)]
PrintStatus
}
proc ToggleObjects {} {
global g_Demo
set g_Demo(drawSphere) [expr ! $g_Demo(drawSphere)]
}
proc SetNoiseAlgo { algoNum } {
global g_Demo
set g_Demo(noiseAlgo) $algoNum
PrintStatus
}
proc CheckExtProc { extProc } {
if { ![tcl3dOglHaveFunc $extProc] } {
puts "Extension procedure $extProc not available"
return false
}
return true
}
proc CheckExtensions { toglwin } {
global g_Demo
set g_Demo(haveOglExtensions) true
# These extension strings indicate that the OpenGL Shading Language
# and GLSL shader objects are supported.
if { ![tcl3dOglHaveExtension $toglwin "GL_ARB_shading_language_100"] } {
puts "Extension GL_ARB_shading_language_100 missing"
set g_Demo(haveOglExtensions) false
}
if { ![tcl3dOglHaveExtension $toglwin "GL_ARB_shader_objects"] } {
puts "Extension GL_ARB_shader_objects missing"
set g_Demo(haveOglExtensions) false
}
if { ! [CheckExtProc "glActiveTexture"] || \
! [CheckExtProc "glCreateProgram"] || \
! [CheckExtProc "glCreateProgram"] || \
! [CheckExtProc "glDeleteProgram"] || \
! [CheckExtProc "glUseProgram"] || \
! [CheckExtProc "glCreateShader"] || \
! [CheckExtProc "glDeleteShader"] || \
! [CheckExtProc "glShaderSource"] || \
! [CheckExtProc "glCompileShader"] || \
! [CheckExtProc "glGetShaderiv"] || \
! [CheckExtProc "glGetShaderInfoLog"] || \
! [CheckExtProc "glAttachShader"] || \
! [CheckExtProc "glLinkProgram"] || \
! [CheckExtProc "glGetUniformLocation"] || \
! [CheckExtProc "glUniform1f"] || \
! [CheckExtProc "glUniform1i"] } {
set g_Demo(haveOglExtensions) false
}
}
proc CreateShader { vertexShaderFile fragmentShaderFile } {
global g_Demo g_ProgramDict
# Load the source of the vertex shader.
set vertexSource [tcl3dOglReadShaderFile [file join $g_Demo(scriptDir) $vertexShaderFile]]
# Load the source of the fragment shader.
set fragmentSource [tcl3dOglReadShaderFile [file join $g_Demo(scriptDir) $fragmentShaderFile]]
set g_ProgramDict [tcl3dOglBuildProgram $vertexSource "" "" "" $fragmentSource]
set program [dict get $g_ProgramDict program]
return $program
}
proc SetupCamera { toglwin } {
global g_Demo
set w [$toglwin width]
set h [$toglwin height]
# Set viewport. This is the pixel rectangle we want to draw into.
glViewport 0 0 $w $h
# Select and setup the projection matrix.
glMatrixMode GL_PROJECTION
glLoadIdentity
gluPerspective 45.0 [expr {double($w)/double($h)}] 1.0 100.0
# Select and setup the modelview matrix.
glMatrixMode GL_MODELVIEW
glLoadIdentity
if { $g_Demo(drawSphere) } {
gluLookAt 0.0 -4.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0
} else {
glTranslatef 0.0 0.0 -1.0
}
}
proc InitSphereList { scale } {
set listId [glGenLists 1]
glNewList $listId GL_COMPILE
tcl3dSphere 0.0 0.0 0.0 $scale 30
glEndList
return $listId
}
proc DrawScene { t listId } {
glRotatef 30.0 1.0 0.0 0.0
glEnable GL_LIGHTING
glEnable GL_LIGHT0
glPushMatrix
glRotatef [expr {30.0*$t}] 0.0 0.0 1.0
glTranslatef 5.0 0.0 0.0
set lightpos0 { 0.0 0.0 0.0 1.0 }
glLightfv GL_LIGHT0 GL_POSITION $lightpos0
glPopMatrix
glPushMatrix
glRotatef [expr {45.0*$t}] 0.0 0.0 1.0
glColor3f 1.0 1.0 1.0
glCallList $listId
glPopMatrix
# Disable lighting again, to play nice
glDisable GL_LIGHTING
glDisable GL_LIGHT0
}
proc RenderScene { listId programObject updateTime animateObject } {
global g_Demo
set location_time -1
if { $animateObject } {
set g_Demo(t) [tcl3dLookupSwatch $g_Demo(stopWatch)]
}
# Use vertex and fragment shaders.
glUseProgram $programObject
# Select noise algorithm: 2D, 3D or 4D noise.
set noiseAlgo [glGetUniformLocation $programObject "algorithm"]
glUniform1i $noiseAlgo [expr int($g_Demo(noiseAlgo))]
# Update the uniform time variable.
if { $updateTime } {
set location_time [glGetUniformLocation $programObject "time"]
if { $location_time != -1 } {
glUniform1f $location_time [tcl3dLookupSwatch $g_Demo(stopWatch)]
}
}
# Render with the shaders active.
if { $g_Demo(drawSphere) } {
DrawScene $g_Demo(t) $listId
} else {
glBegin GL_QUADS
glTexCoord2f 0.0 0.0 ; glVertex3f -1.0 -1.0 0.0
glTexCoord2f 0.0 1.0 ; glVertex3f -1.0 1.0 0.0
glTexCoord2f 1.0 1.0 ; glVertex3f 1.0 1.0 0.0
glTexCoord2f 1.0 0.0 ; glVertex3f 1.0 -1.0 0.0
glEnd
}
# Deactivate the shaders.
glUseProgram 0
}
proc CreateCallback { toglwin } {
global g_Demo
CheckExtensions $toglwin
# Create the shader object from two external GLSL source files
set g_Demo(program) [CreateShader "SimplexNoiseGLSL.vert" "SimplexNoiseGLSL.frag"]
glEnable GL_DEPTH_TEST
glClearColor 0.0 0.1 0.3 1.0
set g_Demo(sphereList) [InitSphereList 1.0]
tcl3dResetSwatch $g_Demo(stopWatch)
tcl3dStartSwatch $g_Demo(stopWatch)
set g_Demo(lastTime) [tcl3dLookupSwatch $g_Demo(stopWatch)]
}
proc ReshapeCallback { toglwin { w -1 } { h -1 } } {
global g_Demo
SetupCamera $toglwin
}
proc DisplayCallback { toglwin } {
global g_Demo
glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT]
SetupCamera $toglwin
RenderScene $g_Demo(sphereList) $g_Demo(program) \
$g_Demo(updateTime) $g_Demo(animateObject)
if { [info exists g_Demo(animateId)] } {
ShowFPS
}
$toglwin swapbuffer
}
proc Cleanup {} {
global g_Demo g_ProgramDict
if { [info exists g_Program] } {
tcl3dOglDestroyProgram $g_Program
}
tcl3dDeleteSwatch $g_Demo(stopWatch)
foreach var [info globals g_*] {
uplevel #0 unset $var
}
}
# Put all exit related code here.
proc ExitProg {} {
exit
}
# Create the OpenGL window and some Tk helper widgets.
proc CreateWindow {} {
global g_Demo
frame .fr
pack .fr -expand 1 -fill both
togl .fr.toglwin -width $g_Demo(winWidth) -height $g_Demo(winHeight) \
-double true -depth true \
-createcommand CreateCallback \
-reshapecommand ReshapeCallback \
-displaycommand DisplayCallback
listbox .fr.usage -font $g_Demo(listFont) -height 7
label .fr.status
label .fr.info
grid .fr.toglwin -row 0 -column 0 -sticky news
grid .fr.usage -row 1 -column 0 -sticky news
grid .fr.status -row 2 -column 0 -sticky news
grid .fr.info -row 3 -column 0 -sticky news
grid rowconfigure .fr 0 -weight 1
grid columnconfigure .fr 0 -weight 1
wm title . $g_Demo(appName)
# Watch for Esc key and Quit messages
wm protocol . WM_DELETE_WINDOW "ExitProg"
bind . <Key-Escape> "ExitProg"
bind . <Key-o> "ToggleObjects"
bind . <Key-t> "ToggleUpdateTime"
bind . <Key-a> "ToggleAnimateObject"
bind . <Key-1> "SetNoiseAlgo 1"
bind . <Key-2> "SetNoiseAlgo 2"
bind . <Key-3> "SetNoiseAlgo 3"
bind . <Key-4> "SetNoiseAlgo 4"
bind .fr.toglwin <1> "StartAnimation"
bind .fr.toglwin <2> "StopAnimation"
bind .fr.toglwin <3> "StopAnimation"
bind .fr.toglwin <Control-Button-1> "StopAnimation"
.fr.usage insert end "Key-Escape Exit"
.fr.usage insert end "Key-o Toggle objects"
.fr.usage insert end "Key-t Toggle time update"
.fr.usage insert end "Key-a Toggle object animation"
.fr.usage insert end "Key-1 Switch off noise"
.fr.usage insert end "Key-2|3|4 Select 2D|3D|4D noise"
.fr.usage insert end "Mouse-L|MR Start|Stop animation"
}
CreateWindow
PrintStatus
PrintInfo [tcl3dOglGetInfoString]
if { [file tail [info script]] eq [file tail $::argv0] } {
# If started directly from tclsh or wish, then start animation.
update
StartAnimation
}
|
