# 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-2026, 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]]
}
