OUTPUT BUFFER:
# 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 0.4.0 # 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]] # 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 {} { 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 "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 [glCheckFramebufferStatusEXT GL_FRAMEBUFFER_EXT] if { ! $stat || $stat == $::GL_FRAMEBUFFER_COMPLETE_EXT } { return } error [format "FBO status: %04X" $stat] } # Initialize Framebuffers proc InitFBO {} { glGenTextures 1 $::idTexture glGenFramebuffersEXT 1 $::idFrameBuffer glGenRenderbuffersEXT 1 $::idRenderBuffer glBindFramebufferEXT 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 glFramebufferTexture2DEXT GL_FRAMEBUFFER_EXT GL_COLOR_ATTACHMENT0_EXT \ GL_TEXTURE_2D [$::idTexture get 0] 0 glBindRenderbufferEXT GL_RENDERBUFFER_EXT [$::idRenderBuffer get 0] glRenderbufferStorageEXT GL_RENDERBUFFER_EXT GL_DEPTH_COMPONENT24 \ $::g_TexWidth $::g_TexHeight glFramebufferRenderbufferEXT GL_FRAMEBUFFER_EXT GL_DEPTH_ATTACHMENT_EXT \ GL_RENDERBUFFER_EXT [$::idRenderBuffer get 0] StatusFBO } # FBO texture renderer proc RenderFBO { doBench } { glBindFramebufferEXT 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 glBindFramebufferEXT GL_FRAMEBUFFER_EXT 0 } # Terminate FBO objects proc TermFBO {} { glBindRenderbufferEXT GL_RENDERBUFFER_EXT 0 glBindFramebufferEXT GL_FRAMEBUFFER_EXT 0 glBindTexture GL_TEXTURE_2D 0 glDeleteRenderbuffersEXT 1 [$::idRenderBuffer get 0] glDeleteFramebuffersEXT 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 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 \ -createproc CreateCallback \ -reshapeproc ReshapeCallback \ -displayproc 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 .