Demo 2 of 6 in category tcl3dOglExt
 |
# extensions.tcl
#
# Program to demonstrate the use of extensions.
# Extensions used:
# GL_ARB_multitexture
# GL_EXT_point_parameters
# GL_ARB_texture_compression
# GL_EXT_texture_edge_clamp
#
# Original C++ code by Dave Astle 2/1/2002
# Original files from: http://www.gamedev.net/reference/programming/features/oglext/demo.zip
#
# Modified for Tcl3D by Paul Obermeier 2005/09/05
# 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 listFont {-family {Courier} -size 10}
set stopwatch [tcl3dNewSwatch]
set SCREEN_WIDTH 800
set SCREEN_HEIGHT 600
set USE_FULLSCREEN false
set APP_TITLE "OpenGL Extensions Demo"
set WND_CLASS_NAME "My Window Class"
set FPS_UPDATE_FREQUENCY 200
set FOV 45.0
set PI 3.14159265359
set PI2 [expr 2.0 * $PI]
set ROTATION_SPEED [expr $PI / 2]
set FLOOR_SIZE 3.0
set msgStr "Uninitialized"
set g_isActive 1
set g_lightPos { 0.0 0.0 1.0 }
set g_useTextureCompression 0
set g_useEdgeClamp 0
set g_haveNeededExtensions true
set rads 0.0
# Determine the directory of this script.
set g_scriptDir [file dirname [info script]]
proc bgerror { msg } {
tk_messageBox -icon error -type ok -message "Error: $msg\n\n$::errorInfo"
exit
}
proc GetElapsedSeconds {} {
set currentTime [tcl3dLookupSwatch $::stopwatch]
set sec [expr $currentTime - $::elapsedLastTime]
set ::elapsedLastTime $currentTime
return $sec
}
proc DisplayCallback { toglwin } {
if { $::g_haveNeededExtensions == false } {
return
}
# don't update the scene if the app is minimized
if { $::g_isActive } {
# update the scene every time through the loop
GameMain [GetElapsedSeconds]
DisplayFPS
glFlush
# switch the front and back buffers to display the updated scene
$toglwin swapbuffers
} else {
GetElapsedSeconds
}
}
proc Animate {} {
.fr.toglwin postredisplay
set ::animateId [tcl3dAfterIdle Animate]
}
proc StartAnimation {} {
tcl3dStartSwatch $::stopwatch
if { ! [info exists ::animateId] } {
Animate
}
}
proc StopAnimation {} {
tcl3dStopSwatch $::stopwatch
if { [info exists ::animateId] } {
after cancel $::animateId
unset ::animateId
}
}
proc CreateCallback { toglwin } {
# do one-time initialization
GameInit $toglwin
if { $::g_haveNeededExtensions == false } {
tk_messageBox -icon error -type ok -title "Missing OpenGL extension" \
-message "Demo needs the $::msgStr extension."
proc ::Cleanup {} {}
exit 1
return
}
tcl3dStartSwatch $::stopwatch
set ::startTime [tcl3dLookupSwatch $::stopwatch]
set ::s_lastTime $::startTime
set ::elapsedLastTime $::startTime
}
proc ReshapeCallback { toglwin { w -1 } { h -1 } } {
if { $::g_haveNeededExtensions == false } {
return
}
set w [$toglwin width]
set h [$toglwin height]
# set the viewport to the new dimensions
glViewport 0 0 $w $h
# select the projection matrix and clear it out
glMatrixMode GL_PROJECTION
glLoadIdentity
# set the perspective with the appropriate aspect ratio
gluPerspective $::FOV [expr double($w)/double($h)] 0.1 1000.0
# select modelview matrix
glMatrixMode GL_MODELVIEW
}
set frameCount 0
set totalFrames 0
proc GetFPS { { elapsedFrames 1 } } {
set ::totalFrames [expr $::totalFrames + $elapsedFrames]
set currentTime [tcl3dLookupSwatch $::stopwatch]
set fps [expr $elapsedFrames / ($currentTime - $::s_lastTime)]
set ::s_lastTime $currentTime
return $fps
}
proc DisplayFPS {} {
global frameCount
incr frameCount
if { $frameCount == $::FPS_UPDATE_FREQUENCY } {
set msg [format "Tcl3D demo: Extensions (%.0f fps)" \
[GetFPS $frameCount]]
wm title . $msg
set frameCount 0
}
}
proc GameInit { toglwin } {
InitializeExtensions $toglwin
if { $::g_haveNeededExtensions == false } {
return
}
glEnable GL_DEPTH_TEST
set ::g_floorTexture [LoadTGATexture "floor.tga" $::GL_REPEAT]
if { $::g_useEdgeClamp } {
set ::g_lightmap [LoadTGATexture "lightmap.tga" $::GL_CLAMP_TO_EDGE]
} else {
set ::g_lightmap [LoadTGATexture "lightmap.tga" $::GL_CLAMP]
}
# set up the settings needed to render the light as a point
glPointSize 12.0
glEnable GL_POINT_SMOOTH
glHint GL_POINT_SMOOTH GL_NICEST
glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
# vary the light point size by the distance from the camera if possible
set attenuation { 0.0 0.5 0.0 }
glPointParameterfvEXT GL_DISTANCE_ATTENUATION_EXT $attenuation
return
}
proc GameMain { elapsedTime } {
glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT]
glLoadIdentity
gluLookAt 2.0 1.0 2.0 0.0 0.0 0.0 0.0 1.0 0.0
DrawLight $elapsedTime
DrawFloor $elapsedTime
}
proc Cleanup {} {
if { [info exists ::g_floorTexture] } {
glDeleteTextures 0 [$::g_floorTexture get 0]
$::g_floorTexture delete
}
if { [info exists ::g_lightmap] } {
glDeleteTextures 0 [$::g_lightmap get 0]
$::g_lightmap delete
}
}
proc InitializeExtensions { toglwin } {
if { ! [tcl3dOglHaveExtension $toglwin "GL_ARB_multitexture"] } {
set ::msgStr "GL_ARB_multitexture"
set ::g_haveNeededExtensions false
return
}
if { ! [tcl3dOglHaveExtension $toglwin "GL_EXT_point_parameters"] } {
set ::msgStr "GL_EXT_point_parameters"
set ::g_haveNeededExtensions false
return
}
set ::g_useTextureCompression [tcl3dOglHaveExtension $toglwin "GL_ARB_texture_compression"]
set ::g_useEdgeClamp [tcl3dOglHaveExtension $toglwin "GL_EXT_texture_edge_clamp"]
set ::msgStr "ARB_multitexture EXT_point_parameters"
if { $::g_useTextureCompression } {
append ::msgStr " ARB_texture_compression"
}
if { $::g_useEdgeClamp } {
append ::msgStr " EXT_texture_edge_clamp"
}
return
}
proc DrawFloor { elapsedTime } {
set FS_P2 [expr { 1.0 * $::FLOOR_SIZE / 2}]
set FS_N2 [expr {-1.0 * $::FLOOR_SIZE / 2}]
# determine the corner of the lightmap's position
set texOriginU [expr {-1.0 * [lindex $::g_lightPos 0] + 0.5 - $FS_P2}]
set texOriginV [expr { 1.0 * [lindex $::g_lightPos 2] + 0.5 - $FS_P2}]
# enable the second texture unit for the lightmap
glActiveTexture GL_TEXTURE1_ARB
glEnable GL_TEXTURE_2D
glBindTexture GL_TEXTURE_2D [$::g_lightmap get 0]
glTexEnvf GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE $::GL_MODULATE
# enable the first texture unit for the brick texture
glActiveTexture GL_TEXTURE0_ARB
glEnable GL_TEXTURE_2D
glBindTexture GL_TEXTURE_2D [$::g_floorTexture get 0]
glTexEnvf GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE $::GL_REPLACE
glColor3f 0.0 0.0 0.0
glBegin GL_QUADS
glMultiTexCoord2f GL_TEXTURE0_ARB 0.0 0.0
glMultiTexCoord2f GL_TEXTURE1_ARB $texOriginU $texOriginV
glVertex3f $FS_N2 0.0 $FS_P2
glMultiTexCoord2f GL_TEXTURE0_ARB $::FLOOR_SIZE 0.0
glMultiTexCoord2f GL_TEXTURE1_ARB [expr {$texOriginU + $::FLOOR_SIZE}] $texOriginV
glVertex3f $FS_P2 0.0 $FS_P2
glMultiTexCoord2f GL_TEXTURE0_ARB $::FLOOR_SIZE $::FLOOR_SIZE
glMultiTexCoord2f GL_TEXTURE1_ARB [expr {$texOriginU + $::FLOOR_SIZE}] \
[expr {$texOriginV + $::FLOOR_SIZE}]
glVertex3f $FS_P2 0.0 $FS_N2
glMultiTexCoord2f GL_TEXTURE0_ARB 0.0 $::FLOOR_SIZE
glMultiTexCoord2f GL_TEXTURE1_ARB $texOriginU [expr {$texOriginV + $::FLOOR_SIZE}]
glVertex3f $FS_N2 0.0 $FS_N2
glEnd
glActiveTexture GL_TEXTURE1_ARB
glDisable GL_TEXTURE_2D
glActiveTexture GL_TEXTURE0_ARB
glDisable GL_TEXTURE_2D
}
proc DrawLight { elapsedTime } {
# update the light's position
set ::rads [expr {$::rads + $::ROTATION_SPEED * $elapsedTime}]
while { $::rads > $::PI2 } {
set ::rads [expr $::rads - $::PI2]
}
set ::g_lightPos [list [expr {sin($::rads)}] 0.2 [expr {cos($::rads)}] ]
glColor3f 1.0 1.0 0.8
glEnable GL_BLEND
glBegin GL_POINTS
glVertex3fv $::g_lightPos
glEnd
glDisable GL_BLEND
}
# LoadTGATexture
#
# Loads a Targa, extracts the data from it, and places it in a texture
# object associated with textureID.
proc LoadTGATexture { filename wrapMode } {
set texName [file join $::g_scriptDir $filename]
set phImg [image create photo -file $texName -format "TGA"]
set colorMode [tcl3dPhotoChans $phImg]
set width [image width $phImg]
set height [image height $phImg]
# choose the proper data formats depending on whether or not there's an
# alpha channel.
if { $colorMode == 3 } {
set dataFormat $::GL_RGB
if { $::g_useTextureCompression } {
set internalFormat $::GL_COMPRESSED_RGB_ARB
} else {
set internalFormat $::GL_RGB
}
} else {
set dataFormat $::GL_RGBA
if { $::g_useTextureCompression } {
set internalFormat $::GL_COMPRESSED_RGBA_ARB
} else {
set internalFormat $::GL_RGBA
}
}
set imgData [tcl3dVectorFromPhoto $phImg $colorMode]
image delete $phImg
set textureID [tcl3dVector GLuint 1]
glGenTextures 1 $textureID
glBindTexture GL_TEXTURE_2D [$textureID get 0]
glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S $wrapMode
glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T $wrapMode
glTexParameterf GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_LINEAR
glTexParameterf GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_LINEAR_MIPMAP_LINEAR
gluBuild2DMipmaps GL_TEXTURE_2D $internalFormat $width $height $dataFormat \
GL_UNSIGNED_BYTE $imgData
return $textureID
}
# Master frame. Needed to integrate demo into Tcl3D Starpack presentation.
frame .fr
pack .fr -expand 1 -fill both
togl .fr.toglwin -width $SCREEN_WIDTH -height $SCREEN_HEIGHT \
-double true -depth true \
-createcommand CreateCallback
.fr.toglwin configure \
-reshapecommand ReshapeCallback \
-displaycommand DisplayCallback
listbox .fr.usage -font $::listFont -height 4
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
bind . <Key-Escape> "exit"
bind . <Activate> { set ::g_isActive 1 }
bind . <Deactivate> { set ::g_isActive 0 }
bind .fr.toglwin <1> "StartAnimation"
bind .fr.toglwin <2> "StopAnimation"
bind .fr.toglwin <3> "StopAnimation"
bind .fr.toglwin <Control-Button-1> "StopAnimation"
.fr.usage insert end "Mouse-L StartAnimation"
.fr.usage insert end "Mouse-MR StopAnimation"
.fr.usage insert end "Key-Escape Exit"
.fr.usage insert end $::msgStr
.fr.usage configure -state disabled
.fr.info configure -text [tcl3dOglGetInfoString]
if { [file tail [info script]] eq [file tail $::argv0] } {
# If started directly from tclsh or wish, then start animation.
update
StartAnimation
}
|
