OUTPUT BUFFER:
# 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 \ -createproc CreateCallback \ -reshapeproc ReshapeCallback \ -displayproc 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 .