# Demonstration of texture gen
# Copyright (C) 2005 Julien Guertault
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#
# Original sources available at:
# http://zavie.free.fr/opengl/#texturegen
#
# Modified for Tcl3D by Paul Obermeier 2010/11/21
# See www.tcl3d.org for the Tcl3D extension.

package require Tk
package require Img
package require tcl3d

# Font to be used in the Tk listbox.
set g_Demo(listFont) {-family {Courier} -size 10}

# Determine the directory of this script.
set g_Demo(scriptDir) [file dirname [info script]]

set g_Demo(texNameList) [list \
      "marble.jpg" "chess.jpg"   "chrome.jpg" "mercedes.jpg" \
      "satin.jpg"  "outline.jpg" "gold.jpg"   "glass.jpg"]

set g_Demo(texTypeList) [list \
      $::GL_RGB $::GL_LUMINANCE $::GL_RGB $::GL_RGB \
      $::GL_RGB $::GL_LUMINANCE $::GL_RGB $::GL_ALPHA]

set g_Demo(winWidth)  500
set g_Demo(winHeight) 500

set g_Demo(textures) [tcl3dVector GLuint [llength $g_Demo(texNameList)]]

set g_Demo(rx) 30.0
set g_Demo(ry) 15.0
set g_Demo(tx) 0.0
set g_Demo(ty) 0.0
set g_Demo(plane_xy) { 1.0 0.0 0.0 }
set g_Demo(plane_yz) { 0.0 0.0 1.0 }

# 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 LoadTexture { imgName type } {
    global g_Demo

    if { $type == $::GL_RGB } {
        set numChans 3
    } else {
        set numChans 1
    }

    set texName [file join $g_Demo(scriptDir) "Data" $imgName]
    set retVal [catch {set phImg [image create photo -file $texName]} err1]
    if { $retVal != 0 } {
        error "Error reading image $texName ($err1)"
    } else {
        set w [image width  $phImg]
        set h [image height $phImg]
        set texImg [tcl3dVectorFromPhoto $phImg $numChans]
        image delete $phImg
    }
    return [list $texImg $w $h]
}

proc SetMouseInput { btn x y } {
    set ::g_LastMousePosX(1) $x
    set ::g_LastMousePosY(1) $y
}

proc GetMouseInput { btn x y } {
    global g_Demo

    set nXDiff [expr ($x - $::g_LastMousePosX(1))]
    set nYDiff [expr ($y - $::g_LastMousePosY(1))]
        
    if { $btn == 1 } {
        set g_Demo(rx) [expr $g_Demo(rx) + $nXDiff / 5.0]
        set g_Demo(ry) [expr $g_Demo(ry) + $nYDiff / 5.0]
        if { $g_Demo(ry) > 90.0 } {
            set g_Demo(ry) 90.0
        }
        if { $g_Demo(ry) < -90.0 } {
            set g_Demo(ry) -90.0
        }
    } else {
        set g_Demo(tx) [expr $g_Demo(tx) + $nXDiff / 100.0]
        set g_Demo(ty) [expr $g_Demo(ty) + $nYDiff / 100.0]
    }
    set ::g_LastMousePosX(1) $x
    set ::g_LastMousePosY(1) $y
    .fr.toglwin postredisplay
}

proc Teapot {} {
    global g_Demo

    glTranslatef $g_Demo(tx) 0 $g_Demo(ty)
    glRotatef -60 0 1 0
    glutSolidTeapot 0.4
}

proc CreateCallback { toglwin } {
    global g_Demo

    glClearColor 0 0 0 0
    glEnable GL_DEPTH_TEST
    glEnable GL_CULL_FACE
    glCullFace GL_FRONT
    glEnable GL_BLEND
    glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
    glPolygonMode GL_FRONT_AND_BACK GL_FILL
    glHint GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST
    glEnable GL_TEXTURE_2D

    # Texture loading
    glGenTextures [llength $g_Demo(texNameList)] $g_Demo(textures)
    for { set i 0 } { $i < [llength $g_Demo(texNameList)] } { incr i } {
        set imgInfo [LoadTexture [lindex $g_Demo(texNameList) $i] \
                                 [lindex $g_Demo(texTypeList) $i]]
        set imgData   [lindex $imgInfo 0]
        set imgWidth  [lindex $imgInfo 1]
        set imgHeight [lindex $imgInfo 2]

        glBindTexture GL_TEXTURE_2D [$g_Demo(textures) get $i]
        gluBuild2DMipmaps GL_TEXTURE_2D [lindex $g_Demo(texTypeList) $i] \
             $imgWidth $imgHeight \
             [lindex $g_Demo(texTypeList) $i] \
             GL_UNSIGNED_BYTE $imgData

        glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_LINEAR
        glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_LINEAR
        glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S $::GL_REPEAT
        glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T $::GL_REPEAT

        $imgData delete
    }
}

proc ReshapeCallback { toglwin { w -1 } { h -1 } } {
    set w [$toglwin width]
    set h [$toglwin height]

    glMatrixMode GL_PROJECTION

    glLoadIdentity
    gluPerspective 20.0 [expr double($w)/double($h)] 5 15
    glViewport 0 0 $w $h

    glMatrixMode GL_MODELVIEW
}

proc DisplayCallback { toglwin } {
    global g_Demo

    glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT]

    glMatrixMode GL_MODELVIEW
    glLoadIdentity
    glTranslatef 0 0 -10

    glRotatef $g_Demo(ry) 1 0 0
    glRotatef $g_Demo(rx) 0 1 0

    glEnable  GL_TEXTURE_GEN_S
    glEnable  GL_TEXTURE_GEN_T
    glTexEnvi GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE $::GL_REPLACE

    # Marble teapot
    glBindTexture GL_TEXTURE_2D [$g_Demo(textures) get 0]
    glTexGeni  GL_S GL_TEXTURE_GEN_MODE $::GL_OBJECT_LINEAR
    glTexGeni  GL_T GL_TEXTURE_GEN_MODE $::GL_OBJECT_LINEAR
    glTexGenfv GL_S GL_EYE_PLANE $g_Demo(plane_xy)
    glTexGenfv GL_T GL_EYE_PLANE $g_Demo(plane_yz)
    glPushMatrix
    glTranslatef -1 -1 0
    Teapot
    glPopMatrix
  
    # Chess teapot, texture funny projection
    glBindTexture GL_TEXTURE_2D [$g_Demo(textures) get 1]
    glPushMatrix
    glLoadIdentity
    glTexGeni  GL_S GL_TEXTURE_GEN_MODE $::GL_EYE_LINEAR
    glTexGeni  GL_T GL_TEXTURE_GEN_MODE $::GL_EYE_LINEAR
    glTexGenfv GL_S GL_EYE_PLANE $g_Demo(plane_yz)
    glTexGenfv GL_T GL_EYE_PLANE $g_Demo(plane_yz)
    glPopMatrix
    glPushMatrix
    glTranslatef 0 -1 0
    Teapot
    glPopMatrix
  
    # Chess teapot, texture projected vertically
    glBindTexture GL_TEXTURE_2D [$g_Demo(textures) get 1]
    glTexGenfv GL_S GL_EYE_PLANE $g_Demo(plane_xy)
    glTexGenfv GL_T GL_EYE_PLANE $g_Demo(plane_yz)
    glPushMatrix
    glTranslatef 1 -1 0
    Teapot
    glPopMatrix
  
    # Chrome teapot
    glBindTexture GL_TEXTURE_2D [$g_Demo(textures) get 2]
    glTexGeni GL_S GL_TEXTURE_GEN_MODE $::GL_SPHERE_MAP
    glTexGeni GL_T GL_TEXTURE_GEN_MODE $::GL_SPHERE_MAP
    glPushMatrix
    glTranslatef -1 0 0
    Teapot
    glPopMatrix
  
    # Mercedes teapot
    glBindTexture GL_TEXTURE_2D [$g_Demo(textures) get 3]
    glPushMatrix
    glTranslatef 0 0 0
    Teapot
    glPopMatrix
  
    # Satin teapot
    glBindTexture GL_TEXTURE_2D [$g_Demo(textures) get 4]
    glPushMatrix
    glTranslatef 1 0 0
    Teapot
    glPopMatrix
  
    # Outlined teapot
    glBindTexture GL_TEXTURE_2D [$g_Demo(textures) get 5]
    glPushMatrix
    glTranslatef 0 1 0
    Teapot
    glPopMatrix
  
    # Golden teapot
    glBindTexture GL_TEXTURE_2D [$g_Demo(textures) get 6]
    glPushMatrix
    glTranslatef -1 1 0
    Teapot
    glPopMatrix
  
    # Final Fantasy ghost teapot
    glBindTexture GL_TEXTURE_2D [$g_Demo(textures) get 7]
    glColor3f 1 0.7 0
    glPushMatrix
    glTranslatef 1 1 0
    Teapot
    glPopMatrix
  
    glFlush
    $toglwin swapbuffers
}

proc Cleanup {} {
    global g_Demo

    glDeleteTextures [llength $g_Demo(texNameList)] [$g_Demo(textures) get 0]
    $g_Demo(textures) delete

    foreach var [info globals g_*] {
        uplevel #0 unset $var
    }
}

proc ExitProg {} {
    exit
}

frame .fr
pack .fr -expand 1 -fill both
togl .fr.toglwin -width $g_Demo(winWidth) -height $g_Demo(winHeight) \
                 -double true -depth true \
                 -createcommand  CreateCallback \
                 -reshapecommand ReshapeCallback \
                 -displaycommand DisplayCallback
listbox .fr.usage -font $g_Demo(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

set appTitle "Tcl3D demo: Texture Generation by Julien Guertault"
wm title . $appTitle

# Watch For ESC Key And Quit Messages
wm protocol . WM_DELETE_WINDOW "ExitProg"
bind . <Key-Escape> "ExitProg"

bind .fr.toglwin <1>         "SetMouseInput 1 %x %y"
bind .fr.toglwin <B1-Motion> "GetMouseInput 1 %x %y"
bind .fr.toglwin <2>         "SetMouseInput 2 %x %y"
bind .fr.toglwin <B2-Motion> "GetMouseInput 2 %x %y"
bind .fr.toglwin <3>         "SetMouseInput 2 %x %y"
bind .fr.toglwin <B3-Motion> "GetMouseInput 2 %x %y"

.fr.usage insert end "Key-Escape Exit"
.fr.usage insert end "Mouse-L    Rotate teapots"
.fr.usage insert end "Mouse-MR   Move teapots"
.fr.usage configure -state disabled

PrintInfo [tcl3dOglGetInfoString]