# 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]
