# combiner.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 renders a variety of quads showing different
# effects of texture combiner functions.
#
# The first row renders an untextured polygon (so you can
# compare the fragment colors) and then the 2 textures.
# The second row shows several different combiner functions
# on a single texture: replace, modulate, add, add-signed,
# and subtract.
# The third row shows the interpolate combiner function
# on a single texture with a constant color/alpha value,
# varying the amount of interpolation.
# The fourth row uses multitexturing with two textures
# and different combiner functions.
# The fifth row are some combiner experiments: using the
# scaling factor and reversing the order of subtraction
# for a combination function.
package require tcl3d
set imageWidth 8
set imageHeight 8
# arrays for two textures
set image0 [tcl3dVector GLubyte [expr $imageHeight*$imageWidth*4]]
set image1 [tcl3dVector GLubyte [expr $imageHeight*$imageWidth*4]]
# 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 < $::imageHeight } { incr i } {
for { set j 0 } { $j < $::imageWidth } { incr j } {
set c [expr (($i&2)==0)*255] ; # horiz b & w stripes
$::image0 set [expr ($i*$::imageHeight + $j)*4 + 0] $c
$::image0 set [expr ($i*$::imageHeight + $j)*4 + 1] $c
$::image0 set [expr ($i*$::imageHeight + $j)*4 + 2] $c
$::image0 set [expr ($i*$::imageHeight + $j)*4 + 3] 255
set c [expr (($j&4)!=0)*128] ; # wider vertical 50% cyan and black stripes
$::image1 set [expr ($i*$::imageHeight + $j)*4 + 0] 0
$::image1 set [expr ($i*$::imageHeight + $j)*4 + 1] $c
$::image1 set [expr ($i*$::imageHeight + $j)*4 + 2] $c
$::image1 set [expr ($i*$::imageHeight + $j)*4 + 3] 255
}
}
}
proc CreateCallback { toglwin } {
glClearColor 0.0 0.0 0.0 0.0
glShadeModel GL_SMOOTH
makeImages
glPixelStorei GL_UNPACK_ALIGNMENT 1
set ::texName [tcl3dVector GLuint 4]
glGenTextures 4 $::texName
glBindTexture GL_TEXTURE_2D [$::texName get 0]
glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S $::GL_REPEAT
glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T $::GL_REPEAT
glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_NEAREST
glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_NEAREST
glTexImage2D GL_TEXTURE_2D 0 $::GL_RGBA $::imageWidth $::imageHeight \
0 GL_RGBA GL_UNSIGNED_BYTE $::image0
glBindTexture GL_TEXTURE_2D [$::texName get 1]
glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S $::GL_REPEAT
glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T $::GL_REPEAT
glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_NEAREST
glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_NEAREST
glTexImage2D GL_TEXTURE_2D 0 $::GL_RGBA $::imageWidth $::imageHeight \
0 GL_RGBA GL_UNSIGNED_BYTE $::image1
# smooth-shaded polygon with multiple texture coordinates
glNewList 1 GL_COMPILE
glBegin GL_QUADS
glMultiTexCoord2f GL_TEXTURE0 0.0 0.0
glMultiTexCoord2f GL_TEXTURE1 0.0 0.0
glColor3f 0.5 1.0 0.25
glVertex3f 0.0 0.0 0.0
glMultiTexCoord2f GL_TEXTURE0 0.0 2.0
glMultiTexCoord2f GL_TEXTURE1 0.0 2.0
glColor3f 1.0 1.0 1.0
glVertex3f 0.0 1.0 0.0
glMultiTexCoord2f GL_TEXTURE0 2.0 2.0
glMultiTexCoord2f GL_TEXTURE1 2.0 2.0
glColor3f 1.0 1.0 1.0
glVertex3f 1.0 1.0 0.0
glMultiTexCoord2f GL_TEXTURE0 2.0 0.0
glMultiTexCoord2f GL_TEXTURE1 2.0 0.0
glColor3f 1.0 0.5 0.25
glVertex3f 1.0 0.0 0.0
glEnd
glEndList
}
proc DisplayCallback { toglwin } {
set constColor {0.0 0.0 0.0 0.0} ; # for use as constant texture color
glClear GL_COLOR_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]
glDisable GL_TEXTURE_2D ; # untextured polygon--see the "fragment" colors
glPushMatrix
glTranslatef 0.0 5.0 0.0
glCallList 1
glPopMatrix
glEnable GL_TEXTURE_2D
# draw ordinary textured polys; 1 texture unit; combine mode disabled
glTexEnvf GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE $::GL_MODULATE
glPushMatrix
glBindTexture GL_TEXTURE_2D [$::texName get 0]
glTranslatef 1.0 5.0 0.0
glCallList 1
glPopMatrix
glPushMatrix
glBindTexture GL_TEXTURE_2D [$::texName get 1]
glTranslatef 2.0 5.0 0.0
glCallList 1
glPopMatrix
# different combine modes enabled; 1 texture unit
# defaults are:
# glTexEnvf(GL_TEXTURE_ENV, GL_SOURCE0_RGB, GL_TEXTURE);
# glTexEnvf(GL_TEXTURE_ENV, GL_OPERAND0_RGB, GL_SRC_COLOR);
# glTexEnvf(GL_TEXTURE_ENV, GL_SOURCE1_RGB, GL_PREVIOUS);
# glTexEnvf(GL_TEXTURE_ENV, GL_OPERAND1_RGB, GL_SRC_COLOR);
glBindTexture GL_TEXTURE_2D [$::texName get 0]
glTexEnvf GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE $::GL_COMBINE
glTexEnvf GL_TEXTURE_ENV GL_COMBINE_RGB $::GL_REPLACE
glTexEnvf GL_TEXTURE_ENV GL_SOURCE0_RGB $::GL_TEXTURE
glTexEnvf GL_TEXTURE_ENV GL_OPERAND0_RGB $::GL_SRC_COLOR
glPushMatrix
glTranslatef 1.0 4.0 0.0
glCallList 1
glPopMatrix
glTexEnvf GL_TEXTURE_ENV GL_COMBINE_RGB $::GL_MODULATE
glTexEnvf GL_TEXTURE_ENV GL_SOURCE1_RGB $::GL_PREVIOUS
glTexEnvf GL_TEXTURE_ENV GL_OPERAND1_RGB $::GL_SRC_COLOR
glPushMatrix
glTranslatef 2.0 4.0 0.0
glCallList 1
glPopMatrix
glTexEnvf GL_TEXTURE_ENV GL_COMBINE_RGB $::GL_ADD
glPushMatrix
glTranslatef 3.0 4.0 0.0
glCallList 1
glPopMatrix
glTexEnvf GL_TEXTURE_ENV GL_COMBINE_RGB $::GL_ADD_SIGNED
glPushMatrix
glTranslatef 4.0 4.0 0.0
glCallList 1
glPopMatrix
glTexEnvf GL_TEXTURE_ENV GL_COMBINE_RGB $::GL_SUBTRACT
glPushMatrix
glTranslatef 5.0 4.0 0.0
glCallList 1
glPopMatrix
# interpolate combine with constant color; 1 texture unit
# use different alpha values for constant color
# defaults are:
# glTexEnvf(GL_TEXTURE_ENV, GL_SOURCE0_RGB, GL_TEXTURE);
# glTexEnvf(GL_TEXTURE_ENV, GL_OPERAND0_RGB, GL_SRC_COLOR);
# glTexEnvf(GL_TEXTURE_ENV, GL_SOURCE1_RGB, GL_PREVIOUS);
# glTexEnvf(GL_TEXTURE_ENV, GL_OPERAND1_RGB, GL_SRC_COLOR);
# glTexEnvf(GL_TEXTURE_ENV, GL_SOURCE2_RGB, GL_CONSTANT);
# glTexEnvf(GL_TEXTURE_ENV, GL_OPERAND2_RGB, GL_SRC_ALPHA);
lset constColor 3 0.2
glTexEnvfv GL_TEXTURE_ENV GL_TEXTURE_ENV_COLOR $constColor
glBindTexture GL_TEXTURE_2D [$::texName get 0]
glTexEnvf GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE $::GL_COMBINE
glTexEnvf GL_TEXTURE_ENV GL_COMBINE_RGB $::GL_INTERPOLATE
glTexEnvf GL_TEXTURE_ENV GL_SOURCE0_RGB $::GL_TEXTURE
glTexEnvf GL_TEXTURE_ENV GL_OPERAND0_RGB $::GL_SRC_COLOR
glTexEnvf GL_TEXTURE_ENV GL_SOURCE1_RGB $::GL_PREVIOUS
glTexEnvf GL_TEXTURE_ENV GL_OPERAND1_RGB $::GL_SRC_COLOR
glTexEnvf GL_TEXTURE_ENV GL_SOURCE2_RGB $::GL_CONSTANT
glTexEnvf GL_TEXTURE_ENV GL_OPERAND2_RGB $::GL_SRC_ALPHA
glPushMatrix
glTranslatef 1.0 3.0 0.0
glCallList 1
glPopMatrix
lset constColor 3 0.4
glTexEnvfv GL_TEXTURE_ENV GL_TEXTURE_ENV_COLOR $constColor
glPushMatrix
glTranslatef 2.0 3.0 0.0
glCallList 1
glPopMatrix
lset constColor 3 0.6
glTexEnvfv GL_TEXTURE_ENV GL_TEXTURE_ENV_COLOR $constColor
glPushMatrix
glTranslatef 3.0 3.0 0.0
glCallList 1
glPopMatrix
lset constColor 3 0.8
glTexEnvfv GL_TEXTURE_ENV GL_TEXTURE_ENV_COLOR $constColor
glPushMatrix
glTranslatef 4.0 3.0 0.0
glCallList 1
glPopMatrix
# combine textures 0 & 1
# defaults are:
# glTexEnvf(GL_TEXTURE_ENV, GL_SOURCE0_RGB, GL_TEXTURE);
# glTexEnvf(GL_TEXTURE_ENV, GL_OPERAND0_RGB, GL_SRC_COLOR);
# glTexEnvf(GL_TEXTURE_ENV, GL_SOURCE1_RGB, GL_PREVIOUS);
# glTexEnvf(GL_TEXTURE_ENV, GL_OPERAND1_RGB, GL_SRC_COLOR);
glActiveTexture GL_TEXTURE0
glEnable GL_TEXTURE_2D
glBindTexture GL_TEXTURE_2D [$::texName get 0]
glTexEnvf GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE $::GL_MODULATE
glActiveTexture GL_TEXTURE1
glEnable GL_TEXTURE_2D
glBindTexture GL_TEXTURE_2D [$::texName get 1]
glTexEnvf GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE $::GL_COMBINE
glTexEnvf GL_TEXTURE_ENV GL_COMBINE_RGB $::GL_REPLACE
glPushMatrix
glTranslatef 1.0 2.0 0.0
glCallList 1
glPopMatrix
# try different combiner modes of texture unit 1
glTexEnvf GL_TEXTURE_ENV GL_COMBINE_RGB $::GL_MODULATE
glPushMatrix
glTranslatef 2.0 2.0 0.0
glCallList 1
glPopMatrix
glTexEnvf GL_TEXTURE_ENV GL_COMBINE_RGB $::GL_ADD
glPushMatrix
glTranslatef 3.0 2.0 0.0
glCallList 1
glPopMatrix
glTexEnvf GL_TEXTURE_ENV GL_COMBINE_RGB $::GL_ADD_SIGNED
glPushMatrix
glTranslatef 4.0 2.0 0.0
glCallList 1
glPopMatrix
glTexEnvf GL_TEXTURE_ENV GL_COMBINE_RGB $::GL_SUBTRACT
glPushMatrix
glTranslatef 5.0 2.0 0.0
glCallList 1
glPopMatrix
# some experiments
# see the effect of RGB_SCALE
glTexEnvf GL_TEXTURE_ENV GL_RGB_SCALE 2.0
glTexEnvf GL_TEXTURE_ENV GL_COMBINE_RGB $::GL_REPLACE
glPushMatrix
glTranslatef 1.0 1.0 0.0
glCallList 1
glPopMatrix
glTexEnvf GL_TEXTURE_ENV GL_COMBINE_RGB $::GL_MODULATE
glPushMatrix
glTranslatef 2.0 1.0 0.0
glCallList 1
glPopMatrix
glTexEnvf GL_TEXTURE_ENV GL_RGB_SCALE 1.0
# using SOURCE0 and SOURCE1, reverse the order of subtraction Arg1-Arg0
glTexEnvf GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE $::GL_COMBINE
glTexEnvf GL_TEXTURE_ENV GL_COMBINE_RGB $::GL_SUBTRACT
glTexEnvf GL_TEXTURE_ENV GL_SOURCE0_RGB $::GL_PREVIOUS
glTexEnvf GL_TEXTURE_ENV GL_OPERAND0_RGB $::GL_SRC_COLOR
glTexEnvf GL_TEXTURE_ENV GL_SOURCE1_RGB $::GL_TEXTURE
glTexEnvf GL_TEXTURE_ENV GL_OPERAND1_RGB $::GL_SRC_COLOR
glPushMatrix
glTranslatef 5.0 1.0 0.0
glCallList 1
glPopMatrix
glActiveTexture GL_TEXTURE1 ; # deactivate multitexturing
glDisable GL_TEXTURE_2D
glActiveTexture GL_TEXTURE0 ; # activate single texture unit
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
gluOrtho2D 0 7 0 7
glMatrixMode GL_MODELVIEW
glLoadIdentity
}
frame .fr
pack .fr -expand 1 -fill both
togl .fr.toglwin -width 400 -height 400 \
-double true \
-createcommand CreateCallback \
-reshapecommand ReshapeCallback \
-displaycommand DisplayCallback
listbox .fr.usage -font $::listFont -height 1
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 combiner"
bind . <Key-Escape> "exit"
.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]]
}
|
