# ogl_bench v1.0 - Copyright 2007 - Graphcomp
# Bob Free bfree@graphcomp.com
# http://graphcomp.com/opengl
# This program is freely distributable without licensing fees
# and is provided without guarantee or warrantee expressed or
# implied. This program is -not- in the public domain.
#
# Modified for Tcl3D by Paul Obermeier 2008/10/01
# See www.tcl3d.org for the Tcl3D extension.
package require Tk
package require tcl3d
# Console window for benchmark output.
tcl3dConsoleCreate .tcl3dOutputConsole "# " "Benchmark Results"
# Font to be used in the Tk listbox.
set g_listFont {-family {Courier} -size 10}
# Set up constants
set PROGRAM "Bob Free's OpenGL Benchmark - Tcl Binding"
set CYCLES 1000
# Set up globals
set g_Frames 0
set g_StopBenchmark false
set g_WinWidth 512
set g_WinHeight 512
set g_TexWidth 128
set g_TexHeight 128
set g_LastMousePosX(1) 0
set g_LastMousePosY(1) 0
set g_LastMousePosX(2) 0
set g_LastMousePosY(2) 0
set g_fSpinX(1) 0.0
set g_fSpinY(1) 0.0
set g_fSpinX(2) 0.0
set g_fSpinY(2) 0.0
set g_IncrY 0.5
set idTexture [tcl3dVector GLuint 1]
set idFrameBuffer [tcl3dVector GLuint 1]
set idRenderBuffer [tcl3dVector GLuint 1]
set idVertexProg [tcl3dVector GLuint 1]
set idFragProg [tcl3dVector GLuint 1]
set g_StopWatch [tcl3dNewSwatch]
# Determine the directory of this script.
set g_scriptDir [file dirname [info script]]
proc CheckGLErrors { msg } {
set errMsg [tcl3dOglGetError]
if { $errMsg eq "" } {
return
}
puts "$msg: $errMsg"
}
# Show errors occuring in the Togl callbacks.
proc bgerror { msg } {
tk_messageBox -icon error -type ok -message "Error: $msg"
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($btn) $x
set ::g_LastMousePosY($btn) $y
}
proc GetMouseInput { btn x y } {
set nXDiff [expr ($x - $::g_LastMousePosX($btn))]
set nYDiff [expr ($y - $::g_LastMousePosY($btn))]
set ::g_fSpinX($btn) [expr $::g_fSpinX($btn) - $nXDiff]
set ::g_fSpinY($btn) [expr $::g_fSpinY($btn) - $nYDiff]
set ::g_LastMousePosX($btn) $x
set ::g_LastMousePosY($btn) $y
.fr.toglwin postredisplay
}
proc Reset {} {
set ::g_StopBenchmark false
set ::g_Frames 0
set ::g_fSpinX(2) 0.0
set ::g_fSpinY(2) 0.0
set ::g_fSpinX(1) 0.0
set ::g_fSpinY(1) 0.0
set ::g_Benches(appBench,secs) 0.0
set ::g_Benches(frameBench,secs) 0.0
set ::g_Benches(textureBench,secs) 0.0
set ::g_Benches(teapotBench,secs) 0.0
tcl3dResetSwatch $::g_StopWatch
tcl3dStartSwatch $::g_StopWatch
}
# Start benchmark
proc StartBench { bench } {
global g_Benches g_StopWatch
set g_Benches($bench,start) [tcl3dLookupSwatch $g_StopWatch]
}
# Accumulate benchmark
proc EndBench { bench } {
global g_Benches g_StopWatch
set now [tcl3dLookupSwatch $g_StopWatch]
set g_Benches($bench,secs) [expr { $g_Benches($bench,secs) +
($now - $g_Benches($bench,start)) }]
}
# Print benchmark
proc PrintBench {} {
global g_Frames g_Benches
if { ! $g_Frames || \
! [info exists g_Benches(appBench,secs)] || \
! [info exists g_Benches(frameBench,secs)] || \
! [info exists g_Benches(textureBench,secs)] || \
! [info exists g_Benches(teapotBench,secs)] } {
puts "No measurable time has elapsed."
return
}
puts "Number of frames rendered: $g_Frames"
puts "Image size: $::g_WinWidth x $::g_WinHeight"
puts [format "FBO Texture Rendering FPS: %.1f" \
[expr $g_Frames / $g_Benches(textureBench,secs)]]
puts [format "Teapot Shader FPS: %.1f" \
[expr $g_Frames / $g_Benches(teapotBench,secs)]]
set overhead [expr $g_Benches(frameBench,secs) - \
($g_Benches(textureBench,secs) + $g_Benches(teapotBench,secs))]
puts [format "Frame overhead secs/frame: %f" [expr $overhead / $g_Frames]]
set overhead [expr $g_Benches(appBench,secs) - $g_Benches(frameBench,secs)]
puts [format "OS/GLUT overhead secs/frame: %f" [expr $overhead / $g_Frames]]
puts [format "Overall FPS: %.1f" [expr $g_Frames / $g_Benches(appBench,secs)]]
puts ""
}
# Check OpenGL Version
proc CheckVersion { toglwin } {
set version [glGetString GL_VERSION]
set vendor [glGetString GL_VENDOR]
set renderer [glGetString GL_RENDERER]
puts "$::PROGRAM\n"
puts "OpenGL : $version"
puts "Vendor : $vendor"
puts "Renderer: $renderer"
puts ""
if { ![tcl3dOglHaveExtension $toglwin "GL_EXT_framebuffer_object"] } {
error "Extension GL_EXT_framebuffer_object missing"
}
}
proc CheckExtProc { extProc } {
if { ! [tcl3dOglHaveFunc $extProc] } {
error "Extension proc $extProc not available"
}
}
# Check availability of extensions
proc InitExtensions {} {
CheckExtProc "glIsRenderbufferEXT"
CheckExtProc "glBindRenderbufferEXT"
CheckExtProc "glDeleteRenderbuffersEXT"
CheckExtProc "glGenRenderbuffersEXT"
CheckExtProc "glRenderbufferStorageEXT"
CheckExtProc "glGetRenderbufferParameterivEXT"
CheckExtProc "glIsFramebufferEXT"
CheckExtProc "glBindFramebufferEXT"
CheckExtProc "glDeleteFramebuffersEXT"
CheckExtProc "glGenFramebuffersEXT"
CheckExtProc "glCheckFramebufferStatusEXT"
CheckExtProc "glFramebufferTexture1DEXT"
CheckExtProc "glFramebufferTexture2DEXT"
CheckExtProc "glFramebufferTexture3DEXT"
CheckExtProc "glFramebufferRenderbufferEXT"
CheckExtProc "glGetFramebufferAttachmentParameterivEXT"
CheckExtProc "glGenerateMipmapEXT"
CheckExtProc "glGenProgramsARB"
CheckExtProc "glBindProgramARB"
CheckExtProc "glProgramStringARB"
CheckExtProc "glDeleteProgramsARB"
}
# Initialize Vertex/Fragment Programs
proc InitProgs {} {
# NOP Vertex shader
set vertexProgStr {!!ARBvp1.0 \
TEMP vertexClip; \
DP4 vertexClip.x, state.matrix.mvp.row[0], vertex.position; \
DP4 vertexClip.y, state.matrix.mvp.row[1], vertex.position; \
DP4 vertexClip.z, state.matrix.mvp.row[2], vertex.position; \
DP4 vertexClip.w, state.matrix.mvp.row[3], vertex.position; \
MOV result.position, vertexClip; \
MOV result.color, vertex.color; \
MOV result.texcoord[0], vertex.texcoord; \
MOV result.texcoord[1], vertex.normal; \
END \
}
# Black Light Fragment shader
set fragProgStr {!!ARBfp1.0 \
TEMP decal,color; \
TEX decal, fragment.texcoord[0], texture[0], 2D; \
MUL result.color, decal, fragment.texcoord[1]; \
END \
}
# Convert the program strings into a tcl3dVector, as the glProgramStringARB function
# expects the string as a "const void *" pointer.
set vertexProg [tcl3dVectorFromByteArray GLubyte $vertexProgStr]
set fragProg [tcl3dVectorFromByteArray GLubyte $fragProgStr]
glGenProgramsARB 1 $::idVertexProg
glGenProgramsARB 1 $::idFragProg
glBindProgramARB GL_VERTEX_PROGRAM_ARB [$::idVertexProg get 0]
glProgramStringARB GL_VERTEX_PROGRAM_ARB GL_PROGRAM_FORMAT_ASCII_ARB \
[string length $vertexProgStr] $vertexProg
glBindProgramARB GL_FRAGMENT_PROGRAM_ARB [$::idFragProg get 0]
glProgramStringARB GL_FRAGMENT_PROGRAM_ARB GL_PROGRAM_FORMAT_ASCII_ARB \
[string length $fragProgStr] $fragProg
$vertexProg delete
$fragProg delete
}
# Terminate Vertex/Fragment Programs
proc TermProgs {} {
glBindProgramARB GL_VERTEX_PROGRAM_ARB 0
glBindProgramARB GL_FRAGMENT_PROGRAM_ARB 0
glDeleteProgramsARB 1 [list [$::idVertexProg get 0]]
glDeleteProgramsARB 1 [list [$::idFragProg get 0]]
$::idVertexProg delete
$::idFragProg delete
}
# FBO Status handler
proc StatusFBO {} {
set stat [glCheckFramebufferStatus GL_FRAMEBUFFER_EXT]
if { ! $stat || $stat == $::GL_FRAMEBUFFER_COMPLETE_EXT } {
return
}
error [format "FBO status: %04X" $stat]
}
# Initialize Framebuffers
proc InitFBO {} {
glGenTextures 1 $::idTexture
glGenFramebuffers 1 $::idFrameBuffer
glGenRenderbuffers 1 $::idRenderBuffer
glBindFramebuffer GL_FRAMEBUFFER_EXT [$::idFrameBuffer get 0]
glBindTexture GL_TEXTURE_2D [$::idTexture get 0]
glTexImage2D GL_TEXTURE_2D 0 $::GL_RGBA8 $::g_TexWidth $::g_TexHeight \
0 $::GL_RGBA GL_UNSIGNED_BYTE NULL
glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_LINEAR
glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_LINEAR
glFramebufferTexture2D GL_FRAMEBUFFER_EXT GL_COLOR_ATTACHMENT0_EXT \
GL_TEXTURE_2D [$::idTexture get 0] 0
glBindRenderbuffer GL_RENDERBUFFER_EXT [$::idRenderBuffer get 0]
glRenderbufferStorage GL_RENDERBUFFER_EXT GL_DEPTH_COMPONENT24 \
$::g_TexWidth $::g_TexHeight
glFramebufferRenderbuffer GL_FRAMEBUFFER_EXT GL_DEPTH_ATTACHMENT_EXT \
GL_RENDERBUFFER_EXT [$::idRenderBuffer get 0]
StatusFBO
}
# FBO texture renderer
proc RenderFBO { doBench } {
glBindFramebuffer GL_FRAMEBUFFER_EXT [$::idFrameBuffer get 0]
glViewport 0 0 512 512
glLoadIdentity
glTranslated -0.75 -0.85 -2.5
glRotated [expr {-1.0 * $::g_fSpinY(2) }] 1.0 0.0 0.0
if { $doBench } {
set ::g_fSpinX(2) [expr { $::g_fSpinX(2) + 0.5 }]
}
glRotated [expr {-1.0 * $::g_fSpinX(2) }] 0.0 1.0 0.0
if { $doBench } {
set ::g_fSpinY(2) [expr { $::g_fSpinY(2) + 1.0 }]
}
glClearColor 0 0 0 0
glClear [expr { $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT }]
glColor3d 1.0 1.0 1.0
glutWireTeapot 0.125
glBindFramebuffer GL_FRAMEBUFFER_EXT 0
}
# Terminate FBO objects
proc TermFBO {} {
glBindRenderbuffer GL_RENDERBUFFER_EXT 0
glBindFramebuffer GL_FRAMEBUFFER_EXT 0
glBindTexture GL_TEXTURE_2D 0
glDeleteRenderbuffers 1 [$::idRenderBuffer get 0]
glDeleteFramebuffers 1 [$::idFrameBuffer get 0]
glDeleteTextures 1 [$::idTexture get 0]
$::idRenderBuffer delete
$::idFrameBuffer delete
$::idTexture delete
}
# Resize Window
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)/$h}] 0.1 100.0
glMatrixMode GL_MODELVIEW
set ::g_WinWidth $w
set ::g_WinHeight $h
}
# Initialize OpenGL Environment
proc CreateCallback { toglwin } {
CheckVersion $toglwin
InitExtensions
ReshapeCallback $toglwin
InitFBO
InitProgs
}
# Frame handler
proc DoBenchmark { toglwin } {
global g_Frames g_StopBenchmark
Reset
StartBench appBench
# Run benchmark CYCLES times
while { $g_Frames < $::CYCLES && $g_StopBenchmark == false } {
StartBench frameBench
# Render animated texture
StartBench textureBench
RenderFBO true
EndBench textureBench
# Set up ModelView
glViewport 0 0 $::g_WinWidth $::g_WinHeight
glMatrixMode GL_MODELVIEW
glLoadIdentity
glTranslatef 0.0 0.0 -5.0
glRotated $::g_fSpinY(1) 0.0 1.0 0.0
set ::g_fSpinY(1) [expr {$::g_fSpinY(1) + $::g_IncrY}]
# Set attributes
glEnable GL_TEXTURE_2D
glEnable GL_DEPTH_TEST
glTexEnvi GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE $::GL_DECAL
# Clear render buffer and set teapot color
glClearColor 0.2 0.2 0.2 1.0
glClear [expr {$::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT}]
glColor3d 0.9 0.45 0.0
# Render the teapot using our shader
StartBench teapotBench
glEnable GL_VERTEX_PROGRAM_ARB
glEnable GL_FRAGMENT_PROGRAM_ARB
# Take care, which GLUT implementation you are using.
# Freeglut uses 7 as the grid parameter to the teapot routine.
# Mark Kilgards original GLUT implementation uses 14 for the same parameter.
glutSolidTeapot 1.0 7
glDisable GL_FRAGMENT_PROGRAM_ARB
glDisable GL_VERTEX_PROGRAM_ARB
EndBench teapotBench
# Double-buffer and done
$toglwin swapbuffers
EndBench frameBench
update
incr g_Frames
}
EndBench appBench
PrintBench
}
proc Render { toglwin } {
# Render animated texture
RenderFBO false
# Set up ModelView
glViewport 0 0 $::g_WinWidth $::g_WinHeight
glMatrixMode GL_MODELVIEW
glLoadIdentity
glTranslatef 0.0 0.0 -5.0
glRotated [expr {-1.0 * $::g_fSpinY(1) }] 1.0 0.0 0.0
glRotated [expr {-1.0 * $::g_fSpinX(1) }] 0.0 1.0 0.0
# Set attributes
glEnable GL_TEXTURE_2D
glEnable GL_DEPTH_TEST
glTexEnvi GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE $::GL_DECAL
# Clear render buffer and set teapot color
glClearColor 0.2 0.2 0.2 1.0
glClear [expr {$::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT}]
glColor3d 0.9 0.45 0.0
# Render the teapot using our shader
glEnable GL_VERTEX_PROGRAM_ARB
glEnable GL_FRAGMENT_PROGRAM_ARB
# Take care, which GLUT implementation you are using.
# Freeglut uses 7 as the grid parameter to the teapot routine.
# Mark Kilgards original GLUT implementation uses 14 for the same parameter.
glutSolidTeapot 1.0 7
glDisable GL_FRAGMENT_PROGRAM_ARB
glDisable GL_VERTEX_PROGRAM_ARB
# Double-buffer and done
$toglwin swapbuffers
}
proc DisplayCallback { toglwin } {
Render $toglwin
}
proc StartBenchmark {} {
DoBenchmark .fr.toglwin
}
proc StopBenchmark {} {
set ::g_StopBenchmark true
}
proc Cleanup {} {
# Release Framebuffers
TermProgs
TermFBO
tcl3dDeleteSwatch $::g_StopWatch
foreach var [info globals g_*] {
uplevel #0 unset $var
}
}
proc ExitProg {} {
exit
}
Reset
frame .fr
pack .fr -expand 1 -fill both
togl .fr.toglwin -width $g_WinWidth -height $g_WinHeight \
-double true -depth true -alpha true \
-createcommand CreateCallback \
-reshapecommand ReshapeCallback \
-displaycommand DisplayCallback
listbox .fr.usage -font $::g_listFont -height 5
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
wm title . "Tcl3D demo: $PROGRAM"
# Watch For ESC Key And Quit Messages
wm protocol . WM_DELETE_WINDOW "ExitProg"
bind . <Key-Escape> "ExitProg"
bind . <Key-F6> "StartBenchmark"
bind . <Key-space> "StopBenchmark"
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"
.fr.usage insert end "Key-Escape Exit"
.fr.usage insert end "Key-F6 Start benchmark"
.fr.usage insert end "Key-Space Stop running benchmark"
.fr.usage insert end "Mouse-1 Rotate teapot"
.fr.usage insert end "Mouse-2 Rotate textured teapots"
.fr.usage configure -state disabled
PrintInfo [tcl3dOglGetInfoString]
|
