Demo 59 of 68 in category RedBook
 |
# texgen.c
#
# 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 draws a texture mapped teapot with
# automatically generated texture coordinates. The
# texture is rendered as stripes on the teapot.
# Initially, the object is drawn with texture coordinates
# based upon the object coordinates of the vertex
# and distance from the plane x = 0. Pressing the 'e'
# key changes the coordinate generation to eye coordinates
# of the vertex. Pressing the 'o' key switches it back
# to the object coordinates. Pressing the 's' key
# changes the plane to a slanted one (x + y + z = 0).
# Pressing the 'x' key switches it back to x = 0.
package require tcl3d
set stripeImageWidth 32
set stripeImage [tcl3dVector GLubyte [expr 4*$stripeImageWidth]]
# 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 makeStripeImage {} {
for { set j 0 } { $j < $::stripeImageWidth } { incr j } {
set r [expr ($j<=4) ? 255 : 0]
set g [expr ($j>4) ? 255 : 0]
$::stripeImage set [expr 4*$j+0] $r
$::stripeImage set [expr 4*$j+1] $g
$::stripeImage set [expr 4*$j+2] 0
$::stripeImage set [expr 4*$j+3] 255
}
}
# planes for texture coordinate generation
set xequalzero {1.0 0.0 0.0 0.0}
set slanted {1.0 1.0 1.0 0.0}
proc CreateCallback { toglwin } {
glClearColor 0.0 0.0 0.0 0.0
glEnable GL_DEPTH_TEST
glShadeModel GL_SMOOTH
makeStripeImage
glPixelStorei GL_UNPACK_ALIGNMENT 1
set ::texName [tcl3dVector GLuint 1]
glGenTextures 1 $::texName
glBindTexture GL_TEXTURE_1D [$::texName get 0]
glTexParameteri GL_TEXTURE_1D GL_TEXTURE_WRAP_S $::GL_REPEAT
glTexParameteri GL_TEXTURE_1D GL_TEXTURE_MAG_FILTER $::GL_LINEAR
glTexParameteri GL_TEXTURE_1D GL_TEXTURE_MIN_FILTER $::GL_LINEAR
glTexImage1D GL_TEXTURE_1D 0 $::GL_RGBA $::stripeImageWidth 0 \
GL_RGBA GL_UNSIGNED_BYTE $::stripeImage
glTexEnvf GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE $::GL_MODULATE
set ::currentCoeff $::xequalzero
set ::currentGenMode $::GL_OBJECT_LINEAR
set ::currentPlane $::GL_OBJECT_PLANE
glTexGeni GL_S GL_TEXTURE_GEN_MODE $::currentGenMode
glTexGenfv GL_S $::currentPlane $::currentCoeff
glEnable GL_TEXTURE_GEN_S
glEnable GL_TEXTURE_1D
glEnable GL_CULL_FACE
glEnable GL_LIGHTING
glEnable GL_LIGHT0
glEnable GL_AUTO_NORMAL
glEnable GL_NORMALIZE
glFrontFace GL_CW
glCullFace GL_BACK
glMaterialf GL_FRONT GL_SHININESS 64.0
}
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
glRotatef 45.0 0.0 0.0 1.0
glBindTexture GL_TEXTURE_1D [$::texName get 0]
glutSolidTeapot 2.0
glPopMatrix
glFlush
$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
if { $w <= $h } {
glOrtho -3.5 3.5 [expr -3.5*double($h)/double($w)] \
[expr 3.5*double($h)/double($w)] -3.5 3.5
} else {
glOrtho [expr -3.5*double($w)/double($h)] \
[expr 3.5*double($w)/double($h)] -3.5 3.5 -3.5 3.5
}
glMatrixMode GL_MODELVIEW
glLoadIdentity
}
proc SetEyeLinear {} {
set ::currentGenMode $::GL_EYE_LINEAR
set ::currentPlane $::GL_EYE_PLANE
glTexGeni GL_S GL_TEXTURE_GEN_MODE $::currentGenMode
glTexGenfv GL_S $::currentPlane $::currentCoeff
.fr.toglwin postredisplay
}
proc SetObjLinear {} {
set ::currentGenMode $::GL_OBJECT_LINEAR
set ::currentPlane $::GL_OBJECT_PLANE
glTexGeni GL_S GL_TEXTURE_GEN_MODE $::currentGenMode
glTexGenfv GL_S $::currentPlane $::currentCoeff
.fr.toglwin postredisplay
}
proc SetSlanted {} {
set ::currentCoeff $::slanted
glTexGenfv GL_S $::currentPlane $::currentCoeff
.fr.toglwin postredisplay
}
proc SetZero {} {
set ::currentCoeff $::xequalzero
glTexGenfv GL_S $::currentPlane $::currentCoeff
.fr.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 5
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 texgen"
bind . <Key-e> "SetEyeLinear"
bind . <Key-O> "SetEyeLinear"
bind . <Key-o> "SetObjLinear"
bind . <Key-O> "SetObjLinear"
bind . <Key-s> "SetSlanted"
bind . <Key-S> "SetSlanted"
bind . <Key-x> "SetZero"
bind . <Key-X> "SetZero"
bind . <Key-Escape> "exit"
.fr.usage insert end "Key-e SetEyeLinear"
.fr.usage insert end "Key-o SetObjLinear"
.fr.usage insert end "Key-s SetSlanted"
.fr.usage insert end "Key-x SetZero"
.fr.usage insert end "Key-Escape Exit"
.fr.usage configure -state disabled
PrintInfo [tcl3dOglGetInfoString]
|
