OUTPUT BUFFER:
# 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 object # forward and backward. package require tcl3d 0.3.3 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 # Font to be used in the Tk listbox. set listFont {-family {Courier} -size 10} # 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 } } 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 CreateCallback { 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 DisplayCallback { toglwin } { 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] glPushMatrix glTranslatef 0.0 0.0 $::ztrans glutSolidSphere 5.0 20 10 glPopMatrix $toglwin swapbuffers } proc ReshapeCallback { toglwin { w -1 } { h -1 } } { set w [$toglwin width] set h [$toglwin height] 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 moveObject { 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 CreateCallback \ -reshapeproc ReshapeCallback \ -displayproc DisplayCallback listbox .fr.usage -font $::listFont -height 3 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: OpenGL Red Book example cubemap" bind .