Demo 15 of 17 in category tcl3dOgl
 |
# texanim.tcl
#
# Tcl3D demo showing the usage of a 3D texture for animation.
# In the upper part of the window, a quad is drawn, which shows the
# actual texture animation.
# In the lower half of the window, the 3D texture is visualized as a
# stack of quads. The sampling of the 3D texture is shown by a quad
# moving through the texture stack.
# Either 4 predefined images can be used as textures or 4 choosable colors.
#
# Author: Paul Obermeier
# Date: 2009-01-16
package require tcl3d
# Font to be used in the Tk listbox.
set gDemo(listFont) {-family {Courier} -size 10}
# The size of the Togl window.
set gDemo(winWidth) 400
set gDemo(winHeight) 400
# The dimensions of the texture stack.
# Note that all 3 dimensions must be a power of two, unless
# the GL_ARB_texture_non_power_of_two extension is available.
set gDemo(texWidth) 32 ; # s texture coordinate
set gDemo(texHeight) 32 ; # t texture coordinate
set gDemo(texLayer) 4 ; # r texture coordinate
# The start, end and current layer (r) coordinates.
set gDemo(layStartCoord) [expr {0.5 / $gDemo(texLayer)}]
set gDemo(layEndCoord) [expr {1.0 - 0.5 / $gDemo(texLayer)}]
set gDemo(curLayCoord) [expr {2.0 * $gDemo(layStartCoord)}]
set gDemo(curLayCoordDisp) [format "%.4f" $gDemo(curLayCoord)]
# The incement to move through the texture stack.
set gDemo(layCoordIncr) 0.01
# The initial rotation angles of the texture stack.
set gDemo(rotStackX) -170.0
set gDemo(rotStackY) 25.0
# The initial color values for animation.
set gDemo(layerColors) [list "red" "green" "blue" "white"]
# The tcl3dVector holding the 3D texture stack.
# We only use RGB values, no alpha.
set gDemo(texVec) [tcl3dVector GLubyte [expr $gDemo(texLayer) * \
$gDemo(texHeight) * \
$gDemo(texWidth) * 3]]
# Don't use the images at startup, but color animation.
set gDemo(useImages) 1
# 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
}
}
# The Tcl feather as uuencoded GIF file. Size 32x32.
proc img0 {} {
return {
R0lGODlhIAAgAPcAAAQCBGRmnAQChKSipAQCzAQyzISChMTCxAQC/CAAFgAA
EgAAWwANFQAAABUAAAAAABCixwABAQAQAAAeAACDNQICOQCFDwALWwAXKAMA
QQAANAAAADQBnukAAxIAHgAAANEZGOUAQYEANHwAAAAR2wAAGgEADwAAW1YB
DAAA9wAAEgAAADwHwOgAXRIARgAAAHMIAAAAAAAAAAAAAFwJnukAAxIAHgAA
AACghOnrAJESAHwAAEC6AADcAJI6AHx3AP82x/8NAf8Bpf8qAD0MBADqAJIS
AHwAAG0G5OfEBIEQAHxbAAAQAQBCwhU0NwAAfljHAAMBAAAAAAAAAFilAWAA
ABsAAAAAAJjMAW/qABUSAAAAAAADAADWAAAQAABbAH4QAQBCwgA0N8AAfgAF
BQAAAAAAAAAAAP+eOP8D6/8eEv8AAP8Ysf9Bwv80EP8AWwCEewAAwwAAEAAA
WwAAAAAAAAABAAAAAAABAAAAABUCAAAAAFug8GQAngAAgAAAfGwfAOkAABIA
AAAAAIcRAOsAAIEAAHwAADMEB+MAAIEAAHwAAEADALkAAFAAAAAAAJgAAG8A
YAEAGwAAAGsAAAAAAAAAAAAAAKhbAOhkABIAAAAAADSEAADqAAASAMAAAAid
APwrABKDAAB8AAAA+OkAnpEAgHwAfEAA/wAA/5IA/3wA//8A8P8Anv8AgP8A
fD0AOgABAJIAAHwAANoBOvQsAICDAHx8AACoWADq8RUSEgAAAADc/wAr/wCD
/wB8/5gAAG8AABUAAAAAAAAYsAEA6wAAEgAAAABMRgBkgwCDTAB8AOcAkPQA
64AAEnwAAJSsd+rrUBISTwAAAJiFxG9k6xWDEgB8AATUTABsZABPgwAAfALg
fgB37QBPEgAAAAAAxAAB/wAA/wAAfwCoRADq7QASEgAAAAAAAAABAAAAAAAA
AACgTABkZACDgwB8fAEBAAAAAAAAAAAAABoAWwAwZAAAAAAAAAAZ2AAAZQAA
GwAAAAARAQAALQAASAAAACH5BAEAAAAALAAAAAAgACAABwjqAAEIHEiwoMGC
BBISOMiwIQCFCAogWNjQQEEDFgkmjFhAYsKKBDEiJMCx48SPBzMKVDmQZMeX
JwkISBlyZEmTCikaVMny4U2cCmfuHNiTgMSXQBUy7NnyaMmYCYU61Igg4tOc
KKe2rOq0QACsMrVurWq1gAGwUsW6JIvgLFixY7kiGAA2LFyfbOmivYuXrN6c
adWyRXCgwF6+JMkWrht4auKqixkjVmxYck2HiQ+4PUzUcdUBB+ra7ewZdGWs
aUVqbQvgdNDGpJcC2KzUIdOaBk7DDnmb4AG+qrX25juUuFbNxoUnn4p8+cGA
ADs=}
}
# The wish lamp as uuencoded GIF file. Size 32x32.
proc img1 {} {
return {
R0lGODlhIAAgAPcAAAQCBISCBMzOBGRmBISChPz+nDQyBJyaBPz+BCEAFgAA
EgAAWwANFQAAABUAAAAAABD2xAATAQAQAABLAACDNQICOQCFDwALWwAXKAEA
QQAANAAAADQBSOkAAxIAFwAAANEZGOUAQYEANHwAAAAR2wAAGgEADwAAW1YB
DAAA9wAAEgAAADwHwOgAXRIARgAAAHMIAAAAAAAAAAAAAFwJSOkAAxIAFwAA
AAAUhOkDAJEaAHwAAEASAAAAAJIAAHwCAP8BxP8AAf8Amv8AAD0MBADqAJIS
AHwAAG0G5OfEBIEQAHxbAAAQAQBCwhU0NwAAfljEAAMBAAAAAAAAAFiaAWAA
ABsAAAAAAJjMAW/qABUSAAAAAAADAADWAAAQAABbAH4QAQBCwgA0N8AAfgAF
BQAAAAAAAAAAAP9IOP8D6/8XEv8AAP8Ysf9Bwv80EP8AWwCEewAAwwAAEAAA
WwAAAAAAAAABAAAAAAABAAAAABUCAAAAAHmg8CQAngAAgAAAfGwfAOkAABIA
AAAAAIcRAOsAAIEAAHwAADMEB+MAAIEAAHwAAEADALkAAFAAAAAAAJgAAG8A
YAEAGwAAAGsAAAAAAAAAAAAAAKh5AOgkABIAAAAAADSEAADqAAASAMAAAAid
APwrABKDAAB8AAAA+OkAnpEAgHwAfEAA/wAA/5IA/3wA//8A8P8Anv8AgP8A
fD0AOQABAJIAAHwAANoBOfQsAICDAHx8AACoWADq8RUSEgAAAADc/wAr/wCD
/wB8/5gAAG8AABUAAAAAAAAYsAEA6wAAEgAAAABMRgBkgwCDTAB8AOcAkPQA
64AAEnwAAJSsd+rrUBISTwAAAJiFxG9k6xWDEgB8AATUTABsZABPgwAAfALg
fQB37QBPEgAAAAAAxQAB/wAA/wAAfwCoRADq7QASEgAAAAAAAAABAAAAAAAA
AACgTABkZACDgwB8fAEBAAAAAAAAAAAAABoAeQAwJAAAAAAAAAAZWAAAYwAA
GwAAAAARAQAALQAASAAAACH5BAEAAAAALAAAAAAgACAABwj1AAEIHCiQgEGD
BBMqXFgQIUGHDCMCgLiQgESGFi9O1PhQIcWCHAdmbAiyI0EBEUduTHlSokqV
CVWidGnSY8iaE0cevChgJs6GMBf2ZMmzAAKfGoMuDBDg5kqnUCUaMBCxJ1KN
AawKaKpRAAIES3uCBfD16NaLB74SzFq2gFujZY9yZZh27ACmXuPqPXpggMS6
ZbcGOHBAqwDCeOOeTcg2rtuBb+EGBmAgK8Oseb9G3itXoOWImDkrPhBg6meJ
g8Xq7Uk6wACrIe+mttradVSBA2QzZZr7dsKpwKn6Tqjb9vCBqb8enus7uHPh
Ue8SzsyX9/GoAQEAOw==}
}
# The Tk logo as uuencoded GIF file. Size 32x32.
proc img2 {} {
return {
R0lGODlhIAAgAPcAAAQCBNQyFHwaBLQmDPRKJEQOBOw+HNQmDJwmDKQeBOw6
FCQGBGQSBJQiDMQuFOQyFIwaBNwuDMQmDPxWLOxGJDwOBOQyHFwWBOw+JNwq
FDQKBGwaBBQCBIQaDPRSLFQSBKQeDIweDMQqFLQqDOQmDKwmDCQKBGQWBOQ2
FNQuFMQqDPxeNKwiDNw2FHweBPRKLEwSBPRCHNQqDOQ6HIweBPxWNOQ2HOxC
JBQGBJwiDOQuFAwCBNwyFIQaBLwmDEwOBPQ+HNwmDKQmDCwGBGwSBMwuFOwy
FMwmDPRGJOQqFDwKBHQaBIQeDPxSLFwSBJQeDLwqDKwqDCwKBGwWBOw2FNwu
FMwqDPROLOw6HJQeBPxaNOw2HPRCJBwGBKQiDAAAP34WAAAAAAAAAMAAAABd
OAAA6wAAEgAAAP8CiP8A6/8AEv8AAP93AP8AAP8AAP8AAAAXAAAAAAAAAAAA
AAAA8AAAngAAgAAAfABYkQA9nhUWgAAAfIAA8JgAngAAgAAAfGwAAOkAABIA
AAAAAIcTAOsAAIEAAHwAADMNB+MAAIEAAHwAAEA9ALkAAFCSAAB8ANgAAG8A
gAEAFgAAAGukAADqAAASAAAAAKiAAOiYABIAAAAAADSEAADqAAASAMAAAAid
APwrABKDAAB8AAAA+OkAnpEAgHwAfEAA/wAA/5IA/3wA//8A8P8Anv8AgP8A
fD0AOwABAJIAAHwAANoBO/QsAICDAHx8AACoWADq8RUSEgAAAADc/wAr/wCD
/wB8/9gAAG8AABUAAAAAAAAYsAEA6wAAEgAAAABMRgBkgwCDTAB8AOcAkPQA
64AAEnwAAJSsd+rrUBISTwAAANiFxG9k6xWDEgB8AD3UTBVsZA9Pg1sAfLzg
fz937TRPEgAAAKgAwz8B/zQA/wAAf6yoROnq7RISEgAAAF0AACIBAA8AAFsA
AHGgTCJkZA+Dg1t8fLwBAD8AADQAAAAAALwAgD8wmDQAAAAAANAAyOkAiBKA
FgA/AB4AASIALQ+ASFs/ACH5BAEAAAAALAAAAAAgACAABwj/AAEIHEiwoMGD
CBMqXMiwocOHEKVMyaEiAI8WCqjwGLEAIoAeARTEuEGgJAEPJwnEQGEC4Q4I
TgaGoELyyoQJWnBq2bmzCRIrBzWg2KJD4AADBHTqrDGBaY2dKzwAOVFQgwIK
GHwAUBHDZo0mTa68IIAkBpcYSE5qaRLDC0ElM14gacFBAJArHq6UNYACihAX
J358mNKAiwcPBmgMLKDgxRUsSgBE4HKFwAwhJ3AkbEEhRoCBC2xcuWJgisAI
BpBgqcCwChYFHQHs4OH4hmKBFaxgMZIkQeyDU4xQ+TDQARK9CQxKSSCDRPKD
O3Q8yDEwh2EkKhTuSOjDSJWBHwzo/43gcWAWI0YuCOSAQiyKLgA40BhguiED
KliyCyxyHEXkHyhQoBoDDAmFBRVSCPTEDS9gQQQARGDhwU5IuKUQBzwYAEQJ
uGHxggEQACCADS9osYIWNwiw0AA3cDGDZgDwgMQNWjGQgQ43PHUFChwo1AEQ
KmUhkBckffdDEhlUIKEHCkSW0BAKkIXFdhxI+IIXPdiAgQop3PAYcQoFcFwM
QggEARJa1EDBCx7U4NhjBCqURVcEGAAfAD5cscKJJu6pxZUAdHHAEUE1ptcI
Aw2g54mHmagFEifscEAScRaUQAwlYXEnABDckJdnRcSgIxY6JBHiQQlsEQMW
SxC0wAMGPCMQEwBZeNlgBD8ktIMVD3Bo0BAFqfBABC6UZ+yxyCarbEIBAQA7}
}
# The Img logo as uuencoded GIF file. Size 32x32.
proc img3 {} {
return {
R0lGODlhIAAgAPcAAAQCBASCBASChIQCBPz+BAT+/PwCBAAAABkNiCAAFgAA
EgAAWwANFQAAABUAAAAAABA7wQANAQAQAACMAACDNQICOQCFDwALWwAXKAMA
QQAANAAAADQB+OkAAxIAKwAAANEZGOUAQYEANHwAAAAR2wAAGgEADwAAW1YB
DAAA9wAAEgAAADwHwOgAXRIARgAAAHMIAAAAAAAAAAAAAFwJ+OkAAxIAKwAA
AACchOkDAJEeAHwAAEASAAAAAJIAAHwCAP8Bwf8AAf8AnP8AAD0MBADqAJIS
AHwAAG0G5OfEBIEQAHxbAAAQAQBCwhU0NwAAfljBAAMBAAAAAAAAAFicAWAA
ABsAAAAAAJjMAW/qABUSAAAAAAADAADWAAAQAABbAH4QAQBCwgA0N8AAfgAF
BQAAAAAAAAAAAP/4OP8D6/8rEv8AAP8Ysf9Bwv80EP8AWwCEewAAwwAAEAAA
WwAAAAAAAAABAAAAAAABAAAAABUCAAAAAIGg8KMAngAAgAAAfGwfAOkAABIA
AAAAAIcRAOsAAIEAAHwAADMEB+MAAIEAAHwAAEADALkAAFAAAAAAAJgAAG8A
YAEAGwAAAGsAAAAAAAAAAAAAAKiBAOijABIAAAAAADSEAADqAAASAMAAAAid
APwrABKDAAB8AAAA+OkAnpEAgHwAfEAA/wAA/5IA/3wA//8A8P8Anv8AgP8A
fD0AOAABAJIAAHwAANoBOPQsAICDAHx8AACoWADq8RUSEgAAAADc/wAr/wCD
/wB8/5gAAG8AABUAAAAAAAAYsAEA6wAAEgAAAABMRgBkgwCDTAB8AOcAkPQA
64AAEnwAAJSsd+rrUBISTwAAAJiFxG9k6xWDEgB8AATUTABsZABPgwAAfALg
fAB37QBPEgAAAAAAxgAB/wAA/wAAfwCoRADq7QASEgAAAAAAAAABAAAAAAAA
AACgTABkZACDgwB8fAEBAAAAAAAAAAAAABoAgQAwowAAAAAAAAAZCAAAYwAA
GwAAAAARAQAALQAASAAAACH5BAEAAAAALAAAAAAgACAABwjGAAEIHEiwoMGD
CBMeNGBAocOFDAE0fPhQAMOGESk6vCjQgACNCS9izAgS4siJJQ1y5JgSokSS
LQtGhEmxgM2bNzMyxMmzwMGeNlcaAIrzp00CBHJOHEr0ptECSJW+bOrUINCV
VKsW7Ck0q82nUiXyHDAAKNigHZnaJEu259mZaguwZcvz7dSbc+cWtYpzJM68
dLUS5NmwJ+C2ggfWBXq4bGKBiw0f3lswgGXLAC5r3sw5wMHOoEN7Nii6tOaY
qFOrXs26tcKAADs=}
}
# Create the 3-dimensional texture.
proc MakeTextures { useImages } {
global gDemo
if { ! $useImages } {
# Create the 3D texture from the selected color values.
for { set r 0 } { $r < $gDemo(texLayer) } { incr r } {
set layerColor [tcl3dName2rgb [lindex $gDemo(layerColors) $r]]
catch { unset imgRow }
catch { unset img }
for { set s 0 } { $s < $gDemo(texWidth) } { incr s } {
append imgRow [binary format ccc [lindex $layerColor 0] \
[lindex $layerColor 1] \
[lindex $layerColor 2]]
}
for { set t 0 } { $t < $gDemo(texHeight) } { incr t } {
append img $imgRow
}
set off [expr {$r * $gDemo(texWidth) * $gDemo(texHeight) * 3}]
tcl3dByteArray2Vector $img $gDemo(texVec) [string length $img] 0 $off
}
} else {
# Create the 3D texture from the specified images.
for { set r 0 } { $r < $gDemo(texLayer) } { incr r } {
set phImg [image create photo -data [img$r]]
set img [tcl3dVectorFromPhoto $phImg 3]
set len [expr {$gDemo(texWidth) * $gDemo(texHeight) * 3}]
set off [expr {$r * $len}]
tcl3dVectorCopy $img [tcl3dVectorInd $gDemo(texVec) GLubyte $off] \
[image width $phImg] [image height $phImg] 3
image delete $phImg
$img delete
}
}
}
# Create new textures and send them to OpenGL.
proc UpdateTextures {} {
global gDemo
MakeTextures $gDemo(useImages)
glTexImage3D GL_TEXTURE_3D 0 $::GL_RGB $gDemo(texWidth) $gDemo(texHeight) \
$gDemo(texLayer) 0 GL_RGB GL_UNSIGNED_BYTE $gDemo(texVec)
.fr.toglwin postredisplay
}
# Toggle bewtween usage of colors or images for the 3D texture.
proc ToggleImages {} {
global gDemo
set gDemo(useImages) [expr ! $gDemo(useImages)]
UpdateTextures
}
# Choose a new color and update the 3D texture.
proc SelectColor { frInd } {
global gDemo
set newColor [tk_chooseColor -initialcolor [lindex $gDemo(layerColors) $frInd]]
if { $newColor ne "" } {
lset gDemo(layerColors) $frInd $newColor
$gDemo(col,$frInd) configure -bg $newColor
UpdateTextures
}
}
# Increment the texture layer coordinate (r).
proc UpdateLayCoord { { dir 1.0 } } {
global gDemo
set gDemo(curLayCoord) [expr $gDemo(curLayCoord) + $dir * $gDemo(layCoordIncr)]
if { $gDemo(curLayCoord) >= $gDemo(layEndCoord) } {
set gDemo(curLayCoord) $gDemo(layStartCoord)
} elseif { $gDemo(curLayCoord) < $gDemo(layStartCoord) } {
set gDemo(curLayCoord) $gDemo(layEndCoord)
}
set gDemo(curLayCoordDisp) [format "%.4f" $gDemo(curLayCoord)]
}
# Increment the x rotation angle of the texture stack.
proc RotStackX { dir } {
global gDemo
set gDemo(rotStackX) [expr $gDemo(rotStackX) + $dir]
.fr.toglwin postredisplay
}
# Increment the y rotation angle of the texture stack.
proc RotStackY { dir } {
global gDemo
set gDemo(rotStackY) [expr $gDemo(rotStackY) + $dir]
.fr.toglwin postredisplay
}
# Step through the texture stack.
# If dir is 1, move forward, if dir is -1 move backward.
proc NextStep { dir } {
UpdateLayCoord $dir
.fr.toglwin postredisplay
}
# Togl callback function called at widget creation.
proc CreateCallback { toglwin } {
global gDemo
glClearColor 0.0 0.0 0.0 0.0
glShadeModel GL_FLAT
glEnable GL_DEPTH_TEST
MakeTextures $gDemo(useImages)
glPixelStorei GL_UNPACK_ALIGNMENT 1
set gDemo(texId) [tcl3dVector GLuint 1]
glGenTextures 1 $gDemo(texId)
glBindTexture GL_TEXTURE_3D [$gDemo(texId) get 0]
glTexParameteri GL_TEXTURE_3D GL_TEXTURE_WRAP_S $::GL_CLAMP
glTexParameteri GL_TEXTURE_3D GL_TEXTURE_WRAP_T $::GL_CLAMP
glTexParameteri GL_TEXTURE_3D GL_TEXTURE_WRAP_R $::GL_CLAMP
glTexParameteri GL_TEXTURE_3D GL_TEXTURE_MAG_FILTER $::GL_LINEAR
glTexParameteri GL_TEXTURE_3D GL_TEXTURE_MIN_FILTER $::GL_LINEAR
glTexImage3D GL_TEXTURE_3D 0 $::GL_RGB $gDemo(texWidth) $gDemo(texHeight) \
$gDemo(texLayer) 0 GL_RGB GL_UNSIGNED_BYTE $gDemo(texVec)
glEnable GL_TEXTURE_3D
# Switch from default modulate to decal to avoid
glTexEnvi GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE $::GL_DECAL
}
# Togl callback function called at widget resize.
proc ReshapeCallback { toglwin { w -1 } { h -1 } } {
global gDemo
set w [$toglwin width]
set h [$toglwin height]
glViewport 0 0 $w $h
glMatrixMode GL_PROJECTION
glLoadIdentity
gluPerspective 60.0 [expr double($w)/double($h)] 1.0 30.0
glMatrixMode GL_MODELVIEW
glLoadIdentity
glTranslatef 0.0 0.0 -5.0
}
# The actual Togl callback for drawing.
proc DisplayCallback { toglwin } {
global gDemo
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]
# First draw the quad displaying the texture animation.
# Sample the 3D texture at the current texture layer coordinate.
set s1 [expr 0.5 / $gDemo(texWidth)]
set t1 [expr 0.5 / $gDemo(texHeight)]
set s2 [expr 1.0 - $s1]
set t2 [expr 1.0 - $t1]
glBegin GL_QUADS
glTexCoord3f $s1 $t1 $gDemo(curLayCoord) ; glVertex3f -1.0 1.0 0.0
glTexCoord3f $s1 $t2 $gDemo(curLayCoord) ; glVertex3f -1.0 3.0 0.0
glTexCoord3f $s2 $t2 $gDemo(curLayCoord) ; glVertex3f 1.0 3.0 0.0
glTexCoord3f $s2 $t1 $gDemo(curLayCoord) ; glVertex3f 1.0 1.0 0.0
glEnd
# Draw the 3D texture stack.
# For each texture definition layer, 1 quad is drawn.
glPushMatrix
glTranslatef 0 -1 0
glRotatef $gDemo(rotStackY) 0 1 0
glRotatef $gDemo(rotStackX) 1 0 0
set y -1.0
set ys $y
set curLayCoord $gDemo(layStartCoord)
foreach color $gDemo(layerColors) {
glBegin GL_QUADS
glTexCoord3f $s1 $t1 $curLayCoord ; glVertex3f -1.0 $y -1.0
glTexCoord3f $s1 $t2 $curLayCoord ; glVertex3f -1.0 $y 1.0
glTexCoord3f $s2 $t2 $curLayCoord ; glVertex3f 1.0 $y 1.0
glTexCoord3f $s2 $t1 $curLayCoord ; glVertex3f 1.0 $y -1.0
glEnd
set y [expr $y + 2.0 / [llength $gDemo(layerColors)]]
set curLayCoord [expr $curLayCoord + 1.0 / $gDemo(texLayer)]
}
# Additionally draw a quad at the position in the texture stack,
# where the 3D texture is currently sampled.
set ye [expr $y - 2.0 / [llength $gDemo(layerColors)]]
set m [expr ($ye - $ys) / ($gDemo(layEndCoord) - $gDemo(layStartCoord))]
set t [expr $ys - $m * $gDemo(layStartCoord)]
set y [expr $m * $gDemo(curLayCoord) + $t]
glBegin GL_QUADS
glTexCoord3f $s1 $t1 $gDemo(curLayCoord) ; glVertex3f -1.0 $y -1.0
glTexCoord3f $s1 $t2 $gDemo(curLayCoord) ; glVertex3f -1.0 $y 1.0
glTexCoord3f $s2 $t2 $gDemo(curLayCoord) ; glVertex3f 1.0 $y 1.0
glTexCoord3f $s2 $t1 $gDemo(curLayCoord) ; glVertex3f 1.0 $y -1.0
glEnd
glDisable GL_TEXTURE_3D
# Mark above quad with a surrounding green line.
glColor3f 0 1 0
glLineWidth 2
glBegin GL_LINE_LOOP
glVertex3f -1.0 $y -1.0
glVertex3f -1.0 $y 1.0
glVertex3f 1.0 $y 1.0
glVertex3f 1.0 $y -1.0
glEnd
# Draw a white bounding box around the texture stack in line mode.
set ll [list -1.0 $ys -1.0]
set ur [list 1.0 $ye 1.0]
glColor3f 1 1 1
glLineWidth 1
tcl3dBox $ll $ur $::GL_LINE_LOOP
glEnable GL_TEXTURE_3D
glPopMatrix
$toglwin swapbuffers
}
# Cleanup procedure needed only, when this script is used from
# the presentation framework.
proc Cleanup {} {
glDeleteTextures 1 [$::gDemo(texId) get 0]
$::gDemo(texId) delete
$::gDemo(texVec) delete
uplevel #0 unset gDemo
}
proc ExitProg {} {
Cleanup
exit
}
# Create the widgets and bindings.
proc CreateWindow {} {
global gDemo
frame .fr
pack .fr -expand 1 -fill both
togl .fr.toglwin -width $gDemo(winWidth) -height $gDemo(winHeight) \
-double true -depth true \
-createcommand CreateCallback \
-reshapecommand ReshapeCallback \
-displaycommand DisplayCallback
frame .fr.frBtns
frame .fr.frOut
listbox .fr.usage -height 4 -font $gDemo(listFont)
label .fr.info
grid .fr.toglwin -row 0 -column 0 -sticky news
grid .fr.frBtns -row 1 -column 0 -sticky nws
grid .fr.frOut -row 2 -column 0 -sticky news
grid .fr.usage -row 3 -column 0 -sticky news
grid .fr.info -row 4 -column 0 -sticky news
grid rowconfigure .fr 0 -weight 1
grid columnconfigure .fr 0 -weight 1
wm title . "Tcl3D demo: Texture animation with 3D textures."
labelframe .fr.frBtns.frColor -text "Color selection"
pack .fr.frBtns.frColor -side left -padx 2 -pady 1 -expand 1 -fill both
set ind 0
foreach color $gDemo(layerColors) {
set gDemo(col,$ind) .fr.frBtns.frColor.fr_$ind
set btnId .fr.frBtns.frColor.fr_$ind.l
labelframe $gDemo(col,$ind) -bg $color
pack $gDemo(col,$ind) -side left -ipadx 2 -ipady 2
button $btnId -relief flat -text "..." \
-command "SelectColor $ind"
tcl3dToolhelpAddBinding $btnId "Click to select another color"
eval pack [winfo children $gDemo(col,$ind)] -side left
incr ind
}
labelframe .fr.frBtns.frCmds -text "Options"
pack .fr.frBtns.frCmds -side left -padx 2 -pady 1 -expand 1 -fill y
checkbutton .fr.frBtns.frCmds.tex -text "Use:" \
-variable gDemo(useImages) -command UpdateTextures
set ind 0
foreach color $gDemo(layerColors) {
label .fr.frBtns.frCmds.l$ind
set phImg [image create photo -data [img$ind]]
.fr.frBtns.frCmds.l$ind configure -image $phImg
incr ind
}
eval pack [winfo children .fr.frBtns.frCmds] -side left \
-anchor w -expand 1 -fill x -padx 2
labelframe .fr.frBtns.frInfo -text "Texture coord (r)"
pack .fr.frBtns.frInfo -side left -padx 2 -pady 1 -expand 1 -fill y
label .fr.frBtns.frInfo.texCoords -textvariable gDemo(curLayCoordDisp)
eval pack [winfo children .fr.frBtns.frInfo] -side left \
-anchor w -expand 1 -fill x -padx 2
wm protocol . WM_DELETE_WINDOW "ExitProg"
bind . <Key-Escape> "ExitProg"
bind . <Key-n> "NextStep 1"
bind . <Key-b> "NextStep -1"
bind . <Key-Down> "RotStackX 1"
bind . <Key-Up> "RotStackX -1"
bind . <Key-Right> "RotStackY 1"
bind . <Key-Left> "RotStackY -1"
bind . <Key-t> "ToggleImages"
.fr.usage insert end "Key-n|b Move through texture stack"
.fr.usage insert end "Key-Up|Down Rotate the texture stack around x"
.fr.usage insert end "Key-Left|Right Rotate the texture stack around y"
.fr.usage insert end "Key-t Toggle color or image usage"
}
CreateWindow
PrintInfo [tcl3dOglGetInfoString]
|
