OUTPUT BUFFER:
# 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 0.3.3 # 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 {} { 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 \ -createproc CreateCallback \ -reshapeproc ReshapeCallback \ -displayproc 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 .