Demo 20 of 68 in category RedBook
 |
# 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-2022, 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
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 \
-createcommand CreateCallback \
-reshapecommand ReshapeCallback \
-displaycommand 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 . <Key-f> "moveObject .fr.toglwin -0.2"
bind . <Key-b> "moveObject .fr.toglwin 0.2"
bind . <Key-Escape> "exit"
.fr.usage insert end "Key-f Move object forward"
.fr.usage insert end "Key-b Move object backward"
.fr.usage insert end "Key-Escape Exit"
.fr.usage configure -state disabled
PrintInfo [tcl3dOglGetInfoString]
if { ! [tcl3dOglHaveVersion 1 3] } {
tk_messageBox -icon warning -type ok -title "Invalid OpenGL version" \
-message [format "Feature needs OpenGL >= 1.3. Only have %s" \
[glGetString GL_VERSION]]
}
|
