OUTPUT BUFFER:
#!/usr/local/bin/wish # cubemap.tcl # # An example of the OpenGL red book modified to work with Tcl3D. # The original C sources are Copyright (c) 1993-2003, Silicon Graphics, Inc. # The Tcl3D sources are Copyright (c) 2005, Paul Obermeier. # See file LICENSE for complete license information. # # This program demonstrates cube map textures. # Six different colored checker board textures are # created and applied to a lit sphere. # # Pressing the 'f' and 'b' keys translate the viewer # forward and backward. package require tcl3d set imageSize 4 set image1 [tcl3dVector GLubyte [expr $imageSize*$imageSize*4]] set image2 [tcl3dVector GLubyte [expr $imageSize*$imageSize*4]] set image3 [tcl3dVector GLubyte [expr $imageSize*$imageSize*4]] set image4 [tcl3dVector GLubyte [expr $imageSize*$imageSize*4]] set image5 [tcl3dVector GLubyte [expr $imageSize*$imageSize*4]] set image6 [tcl3dVector GLubyte [expr $imageSize*$imageSize*4]] set ztrans 0.0 proc makeImages {} { for { set i 0 } { $i < $::imageSize } { incr i } { for { set j 0 } { $j < $::imageSize } { incr j } { set c [expr (((($i&0x1)==0)^(($j&0x1))==0))*255] $::image1 set [expr ($i*$::imageSize + $j)*4 + 0] $c $::image1 set [expr ($i*$::imageSize + $j)*4 + 1] $c $::image1 set [expr ($i*$::imageSize + $j)*4 + 2] $c $::image1 set [expr ($i*$::imageSize + $j)*4 + 3] 255 $::image2 set [expr ($i*$::imageSize + $j)*4 + 0] $c $::image2 set [expr ($i*$::imageSize + $j)*4 + 1] $c $::image2 set [expr ($i*$::imageSize + $j)*4 + 2] 0 $::image2 set [expr ($i*$::imageSize + $j)*4 + 3] 255 $::image3 set [expr ($i*$::imageSize + $j)*4 + 0] $c $::image3 set [expr ($i*$::imageSize + $j)*4 + 1] 0 $::image3 set [expr ($i*$::imageSize + $j)*4 + 2] $c $::image3 set [expr ($i*$::imageSize + $j)*4 + 3] 255 $::image4 set [expr ($i*$::imageSize + $j)*4 + 0] 0 $::image4 set [expr ($i*$::imageSize + $j)*4 + 1] $c $::image4 set [expr ($i*$::imageSize + $j)*4 + 2] $c $::image4 set [expr ($i*$::imageSize + $j)*4 + 3] 255 $::image5 set [expr ($i*$::imageSize + $j)*4 + 0] 255 $::image5 set [expr ($i*$::imageSize + $j)*4 + 1] $c $::image5 set [expr ($i*$::imageSize + $j)*4 + 2] $c $::image5 set [expr ($i*$::imageSize + $j)*4 + 3] 255 $::image6 set [expr ($i*$::imageSize + $j)*4 + 0] $c $::image6 set [expr ($i*$::imageSize + $j)*4 + 1] $c $::image6 set [expr ($i*$::imageSize + $j)*4 + 2] 255 $::image6 set [expr ($i*$::imageSize + $j)*4 + 3] 255 } } } proc tclCreateFunc { toglwin } { set diffuse {1.0 1.0 1.0 1.0} glClearColor 0.0 0.0 0.0 0.0 glEnable GL_DEPTH_TEST glShadeModel GL_SMOOTH makeImages glPixelStorei GL_UNPACK_ALIGNMENT 1 glTexParameteri GL_TEXTURE_CUBE_MAP GL_TEXTURE_WRAP_S $::GL_REPEAT glTexParameteri GL_TEXTURE_CUBE_MAP GL_TEXTURE_WRAP_T $::GL_REPEAT glTexParameteri GL_TEXTURE_CUBE_MAP GL_TEXTURE_WRAP_R $::GL_REPEAT glTexParameteri GL_TEXTURE_CUBE_MAP GL_TEXTURE_MAG_FILTER $::GL_NEAREST glTexParameteri GL_TEXTURE_CUBE_MAP GL_TEXTURE_MIN_FILTER $::GL_NEAREST glTexImage2D GL_TEXTURE_CUBE_MAP_POSITIVE_X 0 $::GL_RGBA $::imageSize \ $::imageSize 0 GL_RGBA GL_UNSIGNED_BYTE $::image1 glTexImage2D GL_TEXTURE_CUBE_MAP_NEGATIVE_X 0 $::GL_RGBA $::imageSize \ $::imageSize 0 GL_RGBA GL_UNSIGNED_BYTE $::image4 glTexImage2D GL_TEXTURE_CUBE_MAP_POSITIVE_Y 0 $::GL_RGBA $::imageSize \ $::imageSize 0 GL_RGBA GL_UNSIGNED_BYTE $::image2 glTexImage2D GL_TEXTURE_CUBE_MAP_NEGATIVE_Y 0 $::GL_RGBA $::imageSize \ $::imageSize 0 GL_RGBA GL_UNSIGNED_BYTE $::image5 glTexImage2D GL_TEXTURE_CUBE_MAP_POSITIVE_Z 0 $::GL_RGBA $::imageSize \ $::imageSize 0 GL_RGBA GL_UNSIGNED_BYTE $::image3 glTexImage2D GL_TEXTURE_CUBE_MAP_NEGATIVE_Z 0 $::GL_RGBA $::imageSize \ $::imageSize 0 GL_RGBA GL_UNSIGNED_BYTE $::image6 glTexGeni GL_S GL_TEXTURE_GEN_MODE $::GL_NORMAL_MAP glTexGeni GL_T GL_TEXTURE_GEN_MODE $::GL_NORMAL_MAP glTexGeni GL_R GL_TEXTURE_GEN_MODE $::GL_NORMAL_MAP glEnable GL_TEXTURE_GEN_S glEnable GL_TEXTURE_GEN_T glEnable GL_TEXTURE_GEN_R glTexEnvf GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE $::GL_MODULATE glEnable GL_TEXTURE_CUBE_MAP glEnable GL_LIGHTING glEnable GL_LIGHT0 glEnable GL_AUTO_NORMAL glEnable GL_NORMALIZE glMaterialfv GL_FRONT GL_DIFFUSE $diffuse } proc tclDisplayFunc { toglwin } { glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT] glPushMatrix glTranslatef 0.0 0.0 $::ztrans glutSolidSphere 5.0 20 10 glPopMatrix $toglwin swapbuffers } proc tclReshapeFunc { toglwin w h } { glViewport 0 0 $w $h glMatrixMode GL_PROJECTION glLoadIdentity gluPerspective 40.0 [expr double ($w)/double ($h)] 1.0 300.0 glMatrixMode GL_MODELVIEW glLoadIdentity glTranslatef 0.0 0.0 -20.0 } proc moveViewer { toglwin dz } { set ::ztrans [expr $::ztrans + $dz] $toglwin postredisplay } frame .fr pack .fr -expand 1 -fill both togl .fr.toglwin -width 400 -height 400 -double true -depth true \ -createproc tclCreateFunc \ -reshapeproc tclReshapeFunc \ -displayproc tclDisplayFunc listbox .fr.usage -height 3 grid .fr.toglwin -row 0 -column 0 -sticky news grid .fr.usage -row 1 -column 0 -sticky news grid rowconfigure .fr 0 -weight 1 grid columnconfigure .fr 0 -weight 1 bind .