OUTPUT BUFFER:
# 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 0.5.0 # 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 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 } { # 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 tcl3dStartSwatch $::stopwatch set ::startTime [tcl3dLookupSwatch $::stopwatch] set ::s_lastTime $::startTime set ::elapsedLastTime $::startTime } proc ReshapeCallback { toglwin { w -1 } { h -1 } } { 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 {} { if { ! [InitializeExtensions] } { error "InitializeExtensions: $::msgStr" } 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 } 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 {} { if { ![tcl3dOglHaveExtension "GL_ARB_multitexture"] } { set ::msgStr "GL_ARB_multitexture missing" return 0 } if { ![tcl3dOglHaveExtension "GL_EXT_point_parameters"] } { set ::msgStr "GL_EXT_point_parameters missing" return 0 } set ::g_useTextureCompression [tcl3dOglHaveExtension "GL_ARB_texture_compression"] set ::g_useEdgeClamp [tcl3dOglHaveExtension "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 1 } 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 \ -createproc CreateCallback \ -reshapeproc ReshapeCallback \ -displayproc 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 .