Demo ogl_texture_addressing
Demo 18 of 19 in category CodeSampler
 |
#-----------------------------------------------------------------------------
# Name: ogl_texture_addressing.cpp
# Author: Kevin Harris (kevin@codesampler.com)
# Last Modified: 02/01/05
# Description: This sample demonstrates the two methods of texture
# addressing that are available under OpenGL:
#
# GL_REPEAT
# GL_CLAMP
# GL_MIRRORED_REPEAT_ARB ( GL_ARB_texture_mirrored_repeat )
# GL_CLAMP_TO_BORDER_ARB ( GL_ARB_texture_border_clamp )
# GL_CLAMP_TO_EDGE ( GL_SGIS_texture_edge_clamp )
#
# Control Keys: F1 - Changes addressing method for the S coordinates
# F2 - Changes addressing method for the T coordinates
#-----------------------------------------------------------------------------
#
# Original C++ code by Kevin Harris (kevin@codesampler.com)
# See www.codesampler.com for the original files
# OpenGL samples page 3: Texture Addressing
#
# Modified for Tcl3D by Paul Obermeier 2007/03/06
# 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}
set g_WinWidth 640
set g_WinHeight 480
# Set the border color to purple.
set g_borderColor { 1.0 0.0 1.0 1.0}
set g_LastMousePosX(1) 0
set g_LastMousePosY(1) 0
set g_fSpinX(1) 0.0
set g_fSpinY(1) 0.0
# Array of texture coordinates and vertices (GL_T2F_V3F) for glInterleavedArrays call.
set g_quadVertices [tcl3dVectorFromArgs GLfloat \
0.0 0.0 -1.0 -1.0 0.0 \
3.0 0.0 1.0 -1.0 0.0 \
3.0 3.0 1.0 1.0 0.0 \
0.0 3.0 -1.0 1.0 0.0 \
]
set ADDRESSING_METHOD_REPEAT 0
set ADDRESSING_METHOD_CLAMP 1
set ADDRESSING_METHOD_MIRRORED_REPEAT_ARB 2
set ADDRESSING_METHOD_CLAMP_TO_BORDER_ARB 3
set ADDRESSING_METHOD_CLAMP_TO_EDGE 4
set g_addressingMethod(S) $ADDRESSING_METHOD_REPEAT
set g_addressingMethod(T) $ADDRESSING_METHOD_REPEAT
set g_bChangeAddressingMethod true
# Determine the directory of this script.
set g_scriptDir [file dirname [info script]]
# 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 NextAddressingMethod { toglwin type } {
global g_addressingMethod
incr g_addressingMethod($type)
if { $g_addressingMethod($type) > 4 } {
set g_addressingMethod($type) 0
}
set ::g_bChangeAddressingMethod true
$toglwin postredisplay
}
proc SetAddressing { type } {
global g_addressingMethod
if { $type == "S" } {
set texWrap $::GL_TEXTURE_WRAP_S
} else {
set texWrap $::GL_TEXTURE_WRAP_T
}
if { $g_addressingMethod($type) == $::ADDRESSING_METHOD_REPEAT } {
glTexParameteri GL_TEXTURE_2D $texWrap $::GL_REPEAT
} elseif { $g_addressingMethod($type) == $::ADDRESSING_METHOD_CLAMP } {
glTexParameteri GL_TEXTURE_2D $texWrap $::GL_CLAMP
} elseif { $g_addressingMethod($type) == $::ADDRESSING_METHOD_MIRRORED_REPEAT_ARB } {
glTexParameteri GL_TEXTURE_2D $texWrap $::GL_MIRRORED_REPEAT_ARB
} elseif { $g_addressingMethod($type) == $::ADDRESSING_METHOD_CLAMP_TO_BORDER_ARB } {
glTexParameteri GL_TEXTURE_2D $texWrap $::GL_CLAMP_TO_BORDER_ARB
} elseif { $g_addressingMethod($type) == $::ADDRESSING_METHOD_CLAMP_TO_EDGE } {
glTexParameteri GL_TEXTURE_2D $texWrap $::GL_CLAMP_TO_EDGE
}
}
proc LoadTexture {} {
set texName [file join $::g_scriptDir "five.bmp"]
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 n [tcl3dPhotoChans $phImg]
set pTextureImage [tcl3dVectorFromPhoto $phImg]
image delete $phImg
}
set ::g_textureID [tcl3dVector GLuint 1]
glGenTextures 1 $::g_textureID
glBindTexture GL_TEXTURE_2D [$::g_textureID get 0]
glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_LINEAR
glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_LINEAR
if { $n == 3 } {
set type $::GL_RGB
} else {
set type $::GL_RGBA
}
glTexImage2D GL_TEXTURE_2D 0 $n $w $h 0 $type GL_UNSIGNED_BYTE $pTextureImage
$pTextureImage delete
}
#-----------------------------------------------------------------------------
# Name: BeginRenderText
# Desc: Utility function for using the bitmap-based character fonts defined
# above. Call this function to begin rendering text. Call the function
# EndRenderText to stop.
#-----------------------------------------------------------------------------
proc BeginRenderText { toglwin nWindowWidth nWindowHeight } {
set ::FontBase [$toglwin loadbitmapfont]
# Push back and cache the current state of pixel alignment.
glPushClientAttrib GL_CLIENT_PIXEL_STORE_BIT
glPixelStorei GL_UNPACK_SWAP_BYTES $::GL_FALSE
glPixelStorei GL_UNPACK_LSB_FIRST $::GL_FALSE
glPixelStorei GL_UNPACK_ROW_LENGTH 0
glPixelStorei GL_UNPACK_SKIP_ROWS 0
glPixelStorei GL_UNPACK_SKIP_PIXELS 0
glPixelStorei GL_UNPACK_ALIGNMENT 1
# Push back and cache the current state of depth testing and lighting
# and then disable them.
glPushAttrib [expr $::GL_TEXTURE_BIT | $::GL_DEPTH_TEST | $::GL_LIGHTING]
glDisable GL_TEXTURE_2D
glDisable GL_DEPTH_TEST
glDisable GL_LIGHTING
# Push back the current matrices and go orthographic for text rendering.
glMatrixMode GL_PROJECTION
glPushMatrix
glLoadIdentity
glOrtho 0 $nWindowWidth $nWindowHeight 0 -1 1
glMatrixMode GL_MODELVIEW
glPushMatrix
glLoadIdentity
}
#-----------------------------------------------------------------------------
# Name: EndRenderText
# Desc: Utility function for using the bitmap-based character fonts defined
# above. Call this function to stop rendering text. The call to
# BeginRenderText should come first and be paired with this function.
#-----------------------------------------------------------------------------
proc EndRenderText { toglwin } {
$toglwin unloadbitmapfont $::FontBase
unset ::FontBase
# Pop everything back to what ever it was set to before we started
# rendering text to the screen.
glMatrixMode GL_PROJECTION
glPopMatrix
glMatrixMode GL_MODELVIEW
glPopMatrix
glPopClientAttrib
glPopAttrib
}
#-----------------------------------------------------------------------------
# Name: RenderText
# Desc: Utility function for using the bitmap-based character fonts defined
# above. This function must be called in between a call to
# BeginRenderText and EndRenderText. See the example below:
#
# BeginRenderText $toglwin $nWindowWidth $nWindowHeight
# RenderText 5 10 "This is a test!"
# EndRenderText $toglwin
#
#-----------------------------------------------------------------------------
proc RenderText { x y str } {
set len [string length $str]
if { $len > 0 } {
glRasterPos2f $x $y
glListBase $::FontBase
set sa [tcl3dVectorFromString GLubyte $str]
glCallLists $len GL_UNSIGNED_BYTE $sa
$sa delete
}
}
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 CreateCallback { toglwin } {
LoadTexture
glClearColor 0.0 0.0 0.0 1.0
glEnable GL_TEXTURE_2D
glMatrixMode GL_PROJECTION
glLoadIdentity
gluPerspective 45.0 [expr double($::g_WinWidth)/double($::g_WinHeight)] \
0.1 100.0
}
proc DisplayCallback { toglwin } {
global g_addressingMethod
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]
glMatrixMode GL_MODELVIEW
glLoadIdentity
glTranslatef 0.0 0.0 -4.0
if { $::g_bChangeAddressingMethod == true } {
SetAddressing "S"
SetAddressing "T"
# Set the border color. This is used by GL_CLAMP_TO_BORDER_ARB.
glTexParameterfv GL_TEXTURE_2D GL_TEXTURE_BORDER_COLOR $::g_borderColor
set ::g_bChangeAddressingMethod false
}
glBindTexture GL_TEXTURE_2D [$::g_textureID get 0]
glInterleavedArrays GL_T2F_V3F 0 $::g_quadVertices
glDrawArrays GL_QUADS 0 4
# Output the current settings...
if { $g_addressingMethod(S) == $::ADDRESSING_METHOD_REPEAT } {
set strS "GL_TEXTURE_WRAP_S = GL_REPEAT"
} elseif { $g_addressingMethod(S) == $::ADDRESSING_METHOD_CLAMP } {
set strS "GL_TEXTURE_WRAP_S = GL_CLAMP"
} elseif { $g_addressingMethod(S) == $::ADDRESSING_METHOD_MIRRORED_REPEAT_ARB } {
set strS "GL_TEXTURE_WRAP_S = GL_MIRRORED_REPEAT_ARB"
} elseif { $g_addressingMethod(S) == $::ADDRESSING_METHOD_CLAMP_TO_BORDER_ARB } {
set strS "GL_TEXTURE_WRAP_S = GL_CLAMP_TO_BORDER_ARB"
} elseif { $g_addressingMethod(S) == $::ADDRESSING_METHOD_CLAMP_TO_EDGE } {
set strS "GL_TEXTURE_WRAP_S = GL_CLAMP_TO_EDGE"
}
if { $g_addressingMethod(T) == $::ADDRESSING_METHOD_REPEAT } {
set strT "GL_TEXTURE_WRAP_T = GL_REPEAT"
} elseif { $g_addressingMethod(T) == $::ADDRESSING_METHOD_CLAMP } {
set strT "GL_TEXTURE_WRAP_T = GL_CLAMP"
} elseif { $g_addressingMethod(T) == $::ADDRESSING_METHOD_MIRRORED_REPEAT_ARB } {
set strT "GL_TEXTURE_WRAP_T = GL_MIRRORED_REPEAT_ARB"
} elseif { $g_addressingMethod(T) == $::ADDRESSING_METHOD_CLAMP_TO_BORDER_ARB } {
set strT "GL_TEXTURE_WRAP_T = GL_CLAMP_TO_BORDER_ARB"
} elseif { $g_addressingMethod(T) == $::ADDRESSING_METHOD_CLAMP_TO_EDGE } {
set strT "GL_TEXTURE_WRAP_T = GL_CLAMP_TO_EDGE"
}
BeginRenderText $toglwin $::g_WinWidth $::g_WinHeight
glColor3f 1.0 1.0 1.0
RenderText 5 15 $strS
RenderText 5 30 $strT
EndRenderText $toglwin
$toglwin swapbuffers
}
proc Cleanup {} {
if { [info exists ::g_textureID] } {
glDeleteTextures 1 [$::g_textureID get 0]
$::g_textureID delete
}
$::g_quadVertices 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 Texture Addressing"
wm title . $appTitle
# Watch For ESC Key And Quit Messages
wm protocol . WM_DELETE_WINDOW "ExitProg"
bind . <Key-Escape> "ExitProg"
bind . <Key-F1> "NextAddressingMethod .fr.toglwin S"
bind . <Key-F2> "NextAddressingMethod .fr.toglwin T"
.fr.usage insert end "Key-Escape Exit"
.fr.usage insert end "Key-F1 Next S texture addressing method"
.fr.usage insert end "Key-F2 Next T texture addressing method"
.fr.usage configure -state disabled
PrintInfo [tcl3dOglGetInfoString]
|
