Demo 16 of 17 in category tcl3dOgl
 |
# 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]
|
