Demo 7 of 13 in category Nopper
 |
#
# OpenGL 3.3 with GLEW - Example 07
#
# @author Norbert Nopper norbert@nopper.tv
# @version 1.0
#
# Homepage: https://github.com/McNopper/OpenGL
#
# Copyright Norbert Nopper
#
# Modified for Tcl3D by Paul Obermeier 2010/09/01
# 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) 640
set g_Demo(winHeight) 480
# Projection matrix.
set g_Demo(projection) [tcl3dVector GLfloat 16]
# ModelView matrix.
set g_Demo(modelView) [tcl3dVector GLfloat 16]
# Current angle of rotation.
set g_Demo(angle) 0.0
# A stop watch to get current time.
set g_Demo(stopWatch) [tcl3dNewSwatch]
tcl3dStartSwatch $g_Demo(stopWatch)
set g_Demo(lastTime) [tcl3dLookupSwatch $g_Demo(stopWatch)]
# 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 a the bottom of the window.
proc PrintInfo { msg } {
if { [winfo exists .fr.info] } {
.fr.info configure -text $msg
}
}
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)
}
}
# Function for initialization.
proc Init {} {
global g_Demo g_Program
# Points of a cube.
set pointList [list \
-0.5 -0.5 -0.5 1.0 \
-0.5 -0.5 +0.5 1.0 \
+0.5 -0.5 +0.5 1.0 \
+0.5 -0.5 -0.5 1.0 \
-0.5 +0.5 -0.5 1.0 \
-0.5 +0.5 +0.5 1.0 \
+0.5 +0.5 +0.5 1.0 \
+0.5 +0.5 -0.5 1.0 \
-0.5 -0.5 -0.5 1.0 \
-0.5 +0.5 -0.5 1.0 \
+0.5 +0.5 -0.5 1.0 \
+0.5 -0.5 -0.5 1.0 \
-0.5 -0.5 +0.5 1.0 \
-0.5 +0.5 +0.5 1.0 \
+0.5 +0.5 +0.5 1.0 \
+0.5 -0.5 +0.5 1.0 \
-0.5 -0.5 -0.5 1.0 \
-0.5 -0.5 +0.5 1.0 \
-0.5 +0.5 +0.5 1.0 \
-0.5 +0.5 -0.5 1.0 \
+0.5 -0.5 -0.5 1.0 \
+0.5 -0.5 +0.5 1.0 \
+0.5 +0.5 +0.5 1.0 \
+0.5 +0.5 -0.5 1.0 \
]
set pointVec [tcl3dVectorFromList GLfloat $pointList]
set pointVecSize [expr [llength $pointList] * [$pointVec elemsize]]
# Normals of a cube.
set normalList [list \
+0.0 -1.0 +0.0 \
+0.0 -1.0 +0.0 \
+0.0 -1.0 +0.0 \
+0.0 -1.0 +0.0 \
+0.0 +1.0 +0.0 \
+0.0 +1.0 +0.0 \
+0.0 +1.0 +0.0 \
+0.0 +1.0 +0.0 \
+0.0 +0.0 -1.0 \
+0.0 +0.0 -1.0 \
+0.0 +0.0 -1.0 \
+0.0 +0.0 -1.0 \
+0.0 +0.0 +1.0 \
+0.0 +0.0 +1.0 \
+0.0 +0.0 +1.0 \
+0.0 +0.0 +1.0 \
-1.0 +0.0 +0.0 \
-1.0 +0.0 +0.0 \
-1.0 +0.0 +0.0 \
-1.0 +0.0 +0.0 \
+1.0 +0.0 +0.0 \
+1.0 +0.0 +0.0 \
+1.0 +0.0 +0.0 \
+1.0 +0.0 +0.0 \
]
set normalVec [tcl3dVectorFromList GLfloat $normalList]
set normalVecSize [expr [llength $normalList] * [$normalVec elemsize]]
# The associated indices.
set indexList [list \
0 2 1 \
0 3 2 \
4 5 6 \
4 6 7 \
8 9 10 \
8 10 11 \
12 15 14 \
12 14 13 \
16 17 18 \
16 18 19 \
20 23 22 \
20 22 21 \
]
set indexVec [tcl3dVectorFromList GLuint $indexList]
set indexVecSize [expr [llength $indexList] * [$indexVec elemsize]]
set g_Demo(numIndices) [llength $indexList]
# Load the source of the vertex shader.
set vertexSource [tcl3dOglReadShaderFile [file join $g_Demo(scriptDir) "Vertex.vs"]]
# Load the source of the fragment shader.
set fragmentSource [tcl3dOglReadShaderFile [file join $g_Demo(scriptDir) "Fragment.fs"]]
set g_Program [tcl3dOglBuildProgram $vertexSource "" "" "" $fragmentSource]
set program [dict get $g_Program program]
# The VAO for the vertices etc.
set g_Demo(vao) [tcl3dVector GLuint 1]
glGenVertexArrays 1 $g_Demo(vao)
glBindVertexArray [$g_Demo(vao) get 0]
# Location of different uniforms in the shader program.
set g_Demo(projectionLocation) [glGetUniformLocation $program "projectionMatrix"]
set g_Demo(modelViewLocation) [glGetUniformLocation $program "modelViewMatrix"]
set cubemapLocation [glGetUniformLocation $program "cubemap"]
# Location of different attributes in the shader program.
set vertexLocation [glGetAttribLocation $program "vertex"]
set normalLocation [glGetAttribLocation $program "normal"]
# The VBO for the vertices.
set g_Demo(vertices) [tcl3dVector GLuint 1]
glGenBuffers 1 $g_Demo(vertices)
glBindBuffer GL_ARRAY_BUFFER [$g_Demo(vertices) get 0]
glBufferData GL_ARRAY_BUFFER $pointVecSize $pointVec GL_STATIC_DRAW
# The VBO for the normals.
set g_Demo(normals) [tcl3dVector GLuint 1]
glGenBuffers 1 $g_Demo(normals)
glBindBuffer GL_ARRAY_BUFFER [$g_Demo(normals) get 0]
glBufferData GL_ARRAY_BUFFER $normalVecSize $normalVec GL_STATIC_DRAW
# The VBO for the indices.
set g_Demo(indices) [tcl3dVector GLuint 1]
glGenBuffers 1 $g_Demo(indices)
glBindBuffer GL_ELEMENT_ARRAY_BUFFER [$g_Demo(indices) get 0]
glBufferData GL_ELEMENT_ARRAY_BUFFER $indexVecSize $indexVec GL_STATIC_DRAW
# Read images and use them as a cubemap.
set g_Demo(cubemapId) [tcl3dVector GLuint 1]
glGenTextures 1 $g_Demo(cubemapId)
glBindTexture GL_TEXTURE_CUBE_MAP [$g_Demo(cubemapId) get 0]
set img [tcl3dReadImg [file join $g_Demo(scriptDir) "cm_right.tga"]]
glTexImage2D GL_TEXTURE_CUBE_MAP_POSITIVE_X 0 [dict get $img format] \
[dict get $img width] [dict get $img height] 0 \
[dict get $img format] GL_UNSIGNED_BYTE [dict get $img data]
[dict get $img data] delete
set img [tcl3dReadImg [file join $g_Demo(scriptDir) "cm_left.tga"]]
glTexImage2D GL_TEXTURE_CUBE_MAP_NEGATIVE_X 0 [dict get $img format] \
[dict get $img width] [dict get $img height] 0 \
[dict get $img format] GL_UNSIGNED_BYTE [dict get $img data]
[dict get $img data] delete
set img [tcl3dReadImg [file join $g_Demo(scriptDir) "cm_top.tga"]]
glTexImage2D GL_TEXTURE_CUBE_MAP_POSITIVE_Y 0 [dict get $img format] \
[dict get $img width] [dict get $img height] 0 \
[dict get $img format] GL_UNSIGNED_BYTE [dict get $img data]
[dict get $img data] delete
set img [tcl3dReadImg [file join $g_Demo(scriptDir) "cm_bottom.tga"]]
glTexImage2D GL_TEXTURE_CUBE_MAP_NEGATIVE_Y 0 [dict get $img format] \
[dict get $img width] [dict get $img height] 0 \
[dict get $img format] GL_UNSIGNED_BYTE [dict get $img data]
[dict get $img data] delete
set img [tcl3dReadImg [file join $g_Demo(scriptDir) "cm_front.tga"]]
glTexImage2D GL_TEXTURE_CUBE_MAP_POSITIVE_Z 0 [dict get $img format] \
[dict get $img width] [dict get $img height] 0 \
[dict get $img format] GL_UNSIGNED_BYTE [dict get $img data]
[dict get $img data] delete
set img [tcl3dReadImg [file join $g_Demo(scriptDir) "cm_back.tga"]]
glTexImage2D GL_TEXTURE_CUBE_MAP_NEGATIVE_Z 0 [dict get $img format] \
[dict get $img width] [dict get $img height] 0 \
[dict get $img format] GL_UNSIGNED_BYTE [dict get $img data]
[dict get $img data] delete
glTexParameteri GL_TEXTURE_CUBE_MAP GL_TEXTURE_MIN_FILTER $::GL_LINEAR
glTexParameteri GL_TEXTURE_CUBE_MAP GL_TEXTURE_MAG_FILTER $::GL_LINEAR
glTexParameteri GL_TEXTURE_CUBE_MAP GL_TEXTURE_WRAP_S $::GL_REPEAT
glTexParameteri GL_TEXTURE_CUBE_MAP GL_TEXTURE_WRAP_T $::GL_REPEAT
glUseProgram $program
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
glUniform1i $cubemapLocation 0
}
proc CreateCallback { toglwin } {
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]
glViewport 0 0 $w $h
if { ! $g_Demo(haveNeededVersion) } {
return
}
# Calculate the projection matrix and set it
tcl3dPerspective 40.0 [expr {double($w)/double($h) }] \
1.0 100.0 $g_Demo(projection)
set projectionAsList [tcl3dVectorToList $g_Demo(projection) 16]
glUniformMatrix4fv $g_Demo(projectionLocation) 1 GL_FALSE $projectionAsList
}
proc DisplayCallback { toglwin } {
global g_Demo
glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT]
if { ! $g_Demo(haveNeededVersion) } {
$toglwin swapbuffer
return
}
set curTime [tcl3dLookupSwatch $g_Demo(stopWatch)]
set elapsedTime [expr $curTime - $g_Demo(lastTime)]
set g_Demo(lastTime) $curTime
# Matrix for the model
set model [tcl3dVector GLfloat 16]
set rot1 [tcl3dVector GLfloat 16]
set rot2 [tcl3dVector GLfloat 16]
# Calculate the model matrix ...
tcl3dMatfIdentity $model
tcl3dMatfRotateY $g_Demo(angle) $rot1
tcl3dMatfRotateX 45 $rot2
tcl3dMatfMult $rot1 $rot2 $model
# ... and the view matrix ...
tcl3dLookAt 0.0 0.0 5.0 0.0 0.0 0.0 0.0 1.0 0.0 $g_Demo(modelView)
# ... to get the final model view matrix
tcl3dMatfMult $g_Demo(modelView) $model $g_Demo(modelView)
$model delete
$rot1 delete
$rot2 delete
set modelViewAsList [tcl3dVectorToList $g_Demo(modelView) 16]
glUniformMatrix4fv $g_Demo(modelViewLocation) 1 GL_FALSE $modelViewAsList
set g_Demo(angle) [expr $g_Demo(angle) + 20.0 * $elapsedTime]
glDrawElements GL_TRIANGLES $g_Demo(numIndices) GL_UNSIGNED_INT "NULL"
$toglwin swapbuffer
}
proc Cleanup {} {
global g_Demo g_Program
if { [info exists g_Demo(vertices)] } {
glDeleteBuffers 1 [$g_Demo(vertices) get 0]
$g_Demo(vertices) delete
}
if { [info exists g_Demo(normals)] } {
glDeleteBuffers 1 [$g_Demo(normals) get 0]
$g_Demo(normals) delete
}
if { [info exists g_Demo(indices)] } {
glDeleteBuffers 1 [$g_Demo(indices) get 0]
$g_Demo(indices) delete
}
if { [info exists g_Demo(cubemapId)] } {
glDeleteTextures 1 [$g_Demo(cubemapId) get 0]
$g_Demo(cubemapId) delete
}
if { [info exists g_Demo(vao)] } {
glDeleteVertexArrays 1 [$g_Demo(vao) get 0]
$g_Demo(vao) delete
}
if { [info exists g_Program] } {
tcl3dOglDestroyProgram $g_Program
}
tcl3dDeleteSwatch $g_Demo(stopWatch)
# 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
}
# Create the OpenGL window and some Tk helper widgets.
proc CreateWindow {} {
global g_Demo
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 -alpha true \
-createcommand CreateCallback \
-coreprofile true -major 3 -minor 3
set g_Demo(haveNeededVersion) true
set numRows 2
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
listbox .fr.usage -font $g_Demo(listFont) -height $numRows
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: Nopper's core profile tutorials (Example 07 - Environment/cube mapping)"
# Watch for Esc key and Quit messages
wm protocol . WM_DELETE_WINDOW "ExitProg"
bind . <Key-Escape> "ExitProg"
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 "Mouse-L|MR Start|Stop animation"
if { [info exists msgStr] } {
.fr.usage insert end $msgStr
.fr.usage itemconfigure end -background red
} else {
.fr.usage configure -state disabled
}
}
CreateWindow
ReshapeCallback .fr.toglwin
PrintInfo [tcl3dOglGetInfoString]
if { [file tail [info script]] eq [file tail $::argv0] } {
# If started directly from tclsh or wish, then start animation.
update
StartAnimation
}
|
