Demo 19 of 19 in category CodeSampler
 |
# This program demonstrates how one would go about doing a projected texture.
# The sample here shows how a projected texture technique can be used to produce a light map.
# The point is that even though you have very few vertices available for the fixed function
# pipeline lighting solution, you can achieve nice per pixel lighting even though the surface
# has only a handful of vertices.
# This sample draws a cube, only allowing the inside being visible via culling front facing polys,
# and then projects the light map texture on the second texture stage all through the fixed
# function pipeline.
# The left mouse button will move the cube around and the right mouse button will move the
# projected # light map around.
# Original C++ code by Steve Butrimas 06/06/26
# See www.codesampler.com for the original files
# User Submitted Source page 6: Texture Projection
# http://www.codesampler.com/usersrc/usersrc_6.htm#oglu_projtexture
#
# Modified for Tcl3D by Paul Obermeier 2007/03/01
# 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_listFont {-family {Courier} -size 10}
# Determine the directory of this script.
set g_scriptDir [file dirname [info script]]
set g_WinWidth 640
set g_WinHeight 480
set g_rotateObjectX 0.0
set g_rotateObjectY 0.0
set g_rotateTextureX 0.0
set g_rotateTextureY 0.0
set g_objectMove 0
set g_textureTransform [tcl3dVector GLfloat 16]
set g_objectTransform [tcl3dVector GLfloat 16]
tcl3dMatfIdentity $g_textureTransform
tcl3dMatfIdentity $g_objectTransform
set g_CubeData [tcl3dVectorFromArgs GLfloat \
1.0 0.0 1.0 1.0 1.0 1.0 0.0 0.0 1.0 -0.5 -0.5 0.5 \
0.0 0.0 1.0 1.0 1.0 1.0 0.0 0.0 1.0 0.5 -0.5 0.5 \
0.0 1.0 1.0 1.0 1.0 1.0 0.0 0.0 1.0 0.5 0.5 0.5 \
1.0 1.0 1.0 1.0 1.0 1.0 0.0 0.0 1.0 -0.5 0.5 0.5 \
\
1.0 0.0 1.0 1.0 1.0 1.0 1.0 0.0 0.0 0.5 -0.5 0.5 \
0.0 0.0 1.0 1.0 1.0 1.0 1.0 0.0 0.0 0.5 -0.5 -0.5 \
0.0 1.0 1.0 1.0 1.0 1.0 1.0 0.0 0.0 0.5 0.5 -0.5 \
1.0 1.0 1.0 1.0 1.0 1.0 1.0 0.0 0.0 0.5 0.5 0.5 \
\
0.0 0.0 1.0 1.0 1.0 1.0 0.0 0.0 -1.0 -0.5 -0.5 -0.5 \
0.0 1.0 1.0 1.0 1.0 1.0 0.0 0.0 -1.0 -0.5 0.5 -0.5 \
1.0 1.0 1.0 1.0 1.0 1.0 0.0 0.0 -1.0 0.5 0.5 -0.5 \
1.0 0.0 1.0 1.0 1.0 1.0 0.0 0.0 -1.0 0.5 -0.5 -0.5 \
\
1.0 0.0 1.0 1.0 1.0 1.0 -1.0 0.0 0.0 -0.5 -0.5 -0.5 \
0.0 0.0 1.0 1.0 1.0 1.0 -1.0 0.0 0.0 -0.5 -0.5 0.5 \
0.0 1.0 1.0 1.0 1.0 1.0 -1.0 0.0 0.0 -0.5 0.5 0.5 \
1.0 1.0 1.0 1.0 1.0 1.0 -1.0 0.0 0.0 -0.5 0.5 -0.5 \
\
0.0 1.0 1.0 1.0 1.0 1.0 0.0 -1.0 0.0 -0.5 -0.5 -0.5 \
1.0 1.0 1.0 1.0 1.0 1.0 0.0 -1.0 0.0 0.5 -0.5 -0.5 \
1.0 0.0 1.0 1.0 1.0 1.0 0.0 -1.0 0.0 0.5 -0.5 0.5 \
0.0 0.0 1.0 1.0 1.0 1.0 0.0 -1.0 0.0 -0.5 -0.5 0.5 \
\
0.0 0.0 1.0 1.0 1.0 1.0 0.0 1.0 0.0 -0.5 0.5 -0.5 \
0.0 1.0 1.0 1.0 1.0 1.0 0.0 1.0 0.0 -0.5 0.5 0.5 \
1.0 1.0 1.0 1.0 1.0 1.0 0.0 1.0 0.0 0.5 0.5 0.5 \
1.0 0.0 1.0 1.0 1.0 1.0 0.0 1.0 0.0 0.5 0.5 -0.5 \
]
# All procs and variables prefixed with TexProj are originally located in a separate class.
# They have been inserted here, so the demo consists of a single file only.
set TexProj_texObject [tcl3dVector GLuint 1]
set TexProj_projTexture [tcl3dVector GLuint 1]
proc TexProj_Cleanup {} {
if { [info exists ::TexProj_texObject] } {
glDeleteTextures 1 [$::TexProj_texObject get 0]
$::TexProj_texObject delete
}
if { [info exists ::TexProj_projTexture] } {
glDeleteTextures 1 [$::TexProj_projTexture get 0]
$::TexProj_projTexture delete
}
}
proc TexProj_LoadImage { imgName } {
set texName [file join $::g_scriptDir $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 numChans [tcl3dPhotoChans $phImg]
set texImg [tcl3dVectorFromPhoto $phImg $numChans]
image delete $phImg
}
if { $numChans == 3 } {
set type $::GL_RGB
} else {
set type $::GL_RGBA
}
return [list $texImg $w $h $type]
}
proc TexProj_LoadTexture { name } {
global TexProj_texObject
set imgInfo [TexProj_LoadImage $name]
set imgData [lindex $imgInfo 0]
set imgWidth [lindex $imgInfo 1]
set imgHeight [lindex $imgInfo 2]
set imgType [lindex $imgInfo 3]
glGenTextures 1 $TexProj_texObject
TexProj_BindProjectiveTexture false
glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_LINEAR_MIPMAP_LINEAR
glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_LINEAR
gluBuild2DMipmaps GL_TEXTURE_2D $imgType $imgWidth $imgHeight \
$imgType GL_UNSIGNED_BYTE $imgData
# Delete the image data vector.
$imgData delete
}
proc TexProj_LoadLightMapTexture { name } {
global TexProj_projTexture
set eyePlaneS {1.0 0.0 0.0 0.0 }
set eyePlaneT {0.0 1.0 0.0 0.0 }
set eyePlaneR {0.0 0.0 1.0 0.0 }
set eyePlaneQ {0.0 0.0 0.0 1.0 }
set borderColor {0.6 0.6 0.6 1.0 }
glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S $::GL_CLAMP
glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T $::GL_CLAMP
glTexEnvi GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE $::GL_MODULATE
# set up texture generation mode and set the corresponding planes
glTexGeni GL_S GL_TEXTURE_GEN_MODE $::GL_EYE_LINEAR
glTexGenfv GL_S GL_EYE_PLANE $eyePlaneS
glTexGeni GL_T GL_TEXTURE_GEN_MODE $::GL_EYE_LINEAR
glTexGenfv GL_T GL_EYE_PLANE $eyePlaneT
glTexGeni GL_R GL_TEXTURE_GEN_MODE $::GL_EYE_LINEAR
glTexGenfv GL_R GL_EYE_PLANE $eyePlaneR
glTexGeni GL_Q GL_TEXTURE_GEN_MODE $::GL_EYE_LINEAR
glTexGenfv GL_Q GL_EYE_PLANE $eyePlaneQ
glEnable GL_TEXTURE_GEN_S
glEnable GL_TEXTURE_GEN_T
glEnable GL_TEXTURE_GEN_R
glEnable GL_TEXTURE_GEN_Q
set imgInfo [TexProj_LoadImage $name]
set imgData [lindex $imgInfo 0]
set imgWidth [lindex $imgInfo 1]
set imgHeight [lindex $imgInfo 2]
set imgType [lindex $imgInfo 3]
glGenTextures 1 $TexProj_projTexture
glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_LINEAR_MIPMAP_LINEAR
glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_LINEAR
glTexParameterfv GL_TEXTURE_2D GL_TEXTURE_BORDER_COLOR $borderColor
gluBuild2DMipmaps GL_TEXTURE_2D $imgType $imgWidth $imgHeight \
$imgType GL_UNSIGNED_BYTE $imgData
# Delete the image data vector.
$imgData delete
}
proc TexProj_TextureProjection { mv } {
set inverseMV [tcl3dVector GLfloat 16]
tcl3dMatfInvert $mv $inverseMV
# here is where we do the transformations on the texture matrix for the lightmap
# the basic equation here is M = Bias * Scale * ModelView for light map * Inverse Modelview
glMatrixMode GL_TEXTURE
glLoadIdentity
glTranslatef 0.5 0.5 0.0 ; # Bias
glScalef 0.5 0.5 1.0 ; # Scale
glFrustum -0.035 0.035 -0.035 0.035 0.1 1.9 ; # MV for light map
glTranslatef 0.0 0.0 -1.0
set matrixAsList [tcl3dVectorToList $inverseMV 16]
glMultMatrixf $matrixAsList ; # Inverse ModelView
glMatrixMode GL_MODELVIEW
$inverseMV delete
}
proc TexProj_BindProjectiveTexture { exp } {
global TexProj_projTexture
global TexProj_texObject
if { $exp } {
glBindTexture GL_TEXTURE_2D [$TexProj_projTexture get 0]
} else {
glBindTexture GL_TEXTURE_2D [$TexProj_texObject get 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 SetMouseInput { btn x y } {
set ::g_LastMousePosX(1) $x
set ::g_LastMousePosY(1) $y
if { $btn == 1 } {
set ::g_objectMove 1
} else {
set ::g_objectMove 0
}
}
proc GetMouseInput { btn x y } {
set nXDiff [expr ($x - $::g_LastMousePosX(1))]
set nYDiff [expr ($y - $::g_LastMousePosY(1))]
if { $btn == 1 } {
set ::g_rotateObjectY [expr $::g_rotateObjectY - $nXDiff]
set ::g_rotateObjectX [expr $::g_rotateObjectX - $nYDiff]
} else {
set ::g_rotateTextureY [expr $::g_rotateTextureY - $nXDiff]
set ::g_rotateTextureX [expr $::g_rotateTextureX - $nYDiff]
}
set ::g_LastMousePosX(1) $x
set ::g_LastMousePosY(1) $y
.fr.toglwin postredisplay
}
proc checkExtProc { extProc } {
if { ![tcl3dOglHaveFunc $extProc] } {
error "Extension proc $extProc not available"
}
}
proc CreateCallback { toglwin } {
set light0Pos {0.0 0.0 0.2 1.0}
set matAmb {0.2 0.2 0.2 1.0}
set matDiff {0.85 0.85 0.85 1.0}
set matSpec {0.30 0.30 0.30 1.0}
set matShine 35.0
# Check for needed ARB functions.
checkExtProc "glMultiTexCoord2fARB"
checkExtProc "glActiveTextureARB"
# Enable front face culling so we can see into the box
glEnable GL_CULL_FACE
glCullFace GL_FRONT
glEnable GL_LIGHTING
glEnable GL_LIGHT0
glEnable GL_COLOR_MATERIAL
glEnable GL_DEPTH_TEST
glDepthFunc GL_LEQUAL
glHint GL_POLYGON_SMOOTH_HINT GL_NICEST
glHint GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST
glClearColor 0.0 0.0 0.0 1.0
# apply color tracking for material properties
glColorMaterial GL_FRONT_AND_BACK GL_AMBIENT_AND_DIFFUSE
glMaterialfv GL_FRONT_AND_BACK GL_SPECULAR $matSpec
glMaterialf GL_FRONT_AND_BACK GL_SHININESS $matShine
# set up lighting so we have a dark scene
glLightfv GL_LIGHT0 GL_POSITION $light0Pos
glLightfv GL_LIGHT0 GL_AMBIENT $matAmb
glLightfv GL_LIGHT0 GL_DIFFUSE $matDiff
glLightfv GL_LIGHT0 GL_SPECULAR $matSpec
glLightModeli GL_LIGHT_MODEL_TWO_SIDE $::GL_TRUE
glMatrixMode GL_PROJECTION
glLoadIdentity
glFrustum -0.5 0.5 -0.5 0.5 1.0 15.0
glMatrixMode GL_MODELVIEW
glLoadIdentity
gluLookAt 0.0 0.0 2.0 0.0 0.0 0.0 0.0 1.0 0.0
# activate and load base texture on stage_0
glActiveTextureARB GL_TEXTURE0_ARB
glEnable GL_TEXTURE_2D
TexProj_LoadTexture "stone_wall.bmp"
# activate and load lightmap on stage_1
glActiveTextureARB GL_TEXTURE1_ARB
glEnable GL_TEXTURE_2D
TexProj_LoadLightMapTexture "lightmap.bmp"
}
proc ReshapeCallback { toglwin { w -1 } { h -1 } } {
set w [$toglwin width]
set h [$toglwin height]
glViewport 0 0 $w $h
glMatrixMode GL_PROJECTION
glLoadIdentity
gluPerspective 45.0 [expr double($w)/double($h)] 0.1 100.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]
# control the movement of the projected texture
glPushMatrix
glLoadIdentity
glRotatef [expr {$::g_rotateTextureX - $::g_rotateObjectX}] 1.0 0.0 0.0
glRotatef [expr {$::g_rotateTextureY - $::g_rotateObjectY}] 0.0 1.0 0.0
glGetFloatv GL_MODELVIEW_MATRIX $::g_textureTransform
glPopMatrix
TexProj_TextureProjection $::g_textureTransform
if { $::g_objectMove } {
# move the box itself
glPushMatrix
glLoadIdentity
glRotatef $::g_rotateObjectX -1.0 0.0 0.0
glRotatef $::g_rotateObjectY 0.0 -1.0 0.0
glGetFloatv GL_MODELVIEW_MATRIX $::g_objectTransform
glPopMatrix
}
# apply transformation on box and draw it
glPushMatrix
set matrixAsList [tcl3dVectorToList $::g_objectTransform 16]
glMultMatrixf $matrixAsList
glInterleavedArrays GL_T2F_C4F_N3F_V3F 0 $::g_CubeData
glDrawArrays GL_QUADS 0 24
glPopMatrix
glFlush
$toglwin swapbuffers
}
proc Cleanup {} {
TexProj_Cleanup
$::g_textureTransform delete
$::g_objectTransform delete
$::g_CubeData 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_WinWidth -height $g_WinHeight \
-double true -depth true \
-createcommand CreateCallback \
-reshapecommand ReshapeCallback \
-displaycommand DisplayCallback
listbox .fr.usage -font $::g_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: CodeSampler's Projected Texture"
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 cube"
.fr.usage insert end "Mouse-MR Rotate light"
.fr.usage configure -state disabled
PrintInfo [tcl3dOglGetInfoString]
DisplayCallback .fr.toglwin
|
