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