OUTPUT BUFFER:
# oglmodes.tcl # # Tcl3D demo showing 3 possible modes of OpenGL execution: # # Normal mode: Use the OpenGL functions as wrapped by SWIG. # This is the fastest mode. If using an # OpenGL function not available in the used driver # implementation, this mode will dump core. # Safe mode: In this mode every OpenGL function is checked for # availability in the driver before execution. # If it's not available, a message is printed out. # Debug mode: This mode checks the availability of an OpenGL function # like the safe mode, and additionally prints out each # OpenGL function before execution. # # The program allows to insert an unavailable command in the display # callback to see the impact on execution. Currently this command is # set to "glFinishTextureSUNX", which is an old, not widely used extension # and therefore should not be available in most driver implementations # currently in the wild. # # Author: Paul Obermeier # Date: 2009-01-10 package require tcl3d 0.5.0 # Font to be used in the Tk text widget for debugging output. set gDemo(listFont) {-family {Courier} -size 10} # Window size. set gDemo(winWidth) 400 set gDemo(winHeight) 300 # Start rotation angles for the triangle and the quad. set gDemo(triAngle) 0.0 set gDemo(quadAngle) 0.0 # Rotation increments for the triangle and the quad. set gDemo(triIncr) 0.50 set gDemo(quadIncr) -0.25 # OpenGL execution mode at startup. set gDemo(mode) "safe" # Flag indicating usage of the "bad" unavailable command. set gDemo(useBadCmd) 0 # The name of the "bad" unavailable command. set gDemo(badCmd) "glFinishTextureSUNX" set gDemo(animStarted) 0 # Show errors occuring in the Togl callbacks. proc bgerror { msg } { tk_messageBox -icon error -type ok -message "Error: $msg\n\n$::errorInfo" ExitProg } # Print info message into label widget at the bottom of the window. proc PrintInfo { msg } { if { [winfo exists .fr.info] } { .fr.info configure -text $msg } } # Print debug message into text widget at the bottom of the window. proc PrintDebug { msg } { global gDemo if { [winfo exists $gDemo(out)] } { $gDemo(out) insert end "$msg\n" $gDemo(out) see end } } # Print body of OpenGL command glBegin. proc PrintProcBody {} { global gDemo if { [winfo exists $gDemo(out)] } { $gDemo(out) insert end "Body of procedure glBegin in $gDemo(mode) mode:\n" set retVal [catch {info body glBegin}] if { $retVal == 0 } { $gDemo(out) insert end [info body glBegin] } else { $gDemo(out) insert end "$::errorInfo" } $gDemo(out) insert end "\n" $gDemo(out) see end } } # Clear contents of the debug text widget. proc ClearDebug {} { global gDemo if { [winfo exists $gDemo(out)] } { $gDemo(out) delete 1.0 end } } proc CreateCallback { toglwin } { glShadeModel GL_SMOOTH glClearColor 0.0 0.0 0.0 0.5 glClearDepth 1.0 glEnable GL_DEPTH_TEST glDepthFunc GL_LEQUAL } proc ReshapeCallback { toglwin { w -1 } { h -1 } } { global gDemo 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 glMatrixMode GL_MODELVIEW glLoadIdentity } proc DisplayCallback { toglwin } { global gDemo 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] glLoadIdentity glTranslatef -1.5 0.0 -6.0 glRotatef $gDemo(triAngle) 0.0 1.0 0.0 glBegin GL_TRIANGLES glColor3f 1.0 0.0 0.0 glVertex3f 0.0 1.0 0.0 glColor3f 0.0 1.0 0.0 glVertex3f -1.0 -1.0 0.0 glColor3f 0.0 0.0 1.0 glVertex3f 1.0 -1.0 0.0 glEnd glLoadIdentity glTranslatef 1.5 0.0 -6.0 glRotatef $gDemo(quadAngle) 1.0 0.0 0.0 glColor3f 0.5 0.5 1.0 glBegin GL_QUADS glVertex3f -1.0 1.0 0.0 glVertex3f 1.0 1.0 0.0 glVertex3f 1.0 -1.0 0.0 glVertex3f -1.0 -1.0 0.0 glEnd set gDemo(triAngle) [expr $gDemo(triAngle) + $gDemo(triIncr)] set gDemo(quadAngle) [expr $gDemo(quadAngle) + $gDemo(quadIncr)] if { $gDemo(useBadCmd) } { # Call the unavailable command. eval $gDemo(badCmd) } $toglwin swapbuffers } proc NextStep {} { PrintDebug "Next Step" .fr.toglwin postredisplay } proc Animate {} { global gDemo if { $gDemo(animStarted) == 0 } { return } .fr.toglwin postredisplay set ::animateId [tcl3dAfterIdle Animate] } proc StartAnimation {} { global gDemo set gDemo(animStarted) 1 if { ! [info exists ::animateId] } { Animate } } proc StopAnimation {} { global gDemo if { [info exists ::animateId] } { after cancel $::animateId unset ::animateId set gDemo(animStarted) 0 } } proc Cleanup {} { uplevel #0 unset gDemo # Restore output command to standard puts. # Needed, if run from the presentation framework. SetSafeMode puts } proc ExitProg {} { exit } # OpenGL function "glFunc" is renamed to create either a debug version # or a safe version. proc CreateSafeOrDebugFunc { glFunc debugFlag normalFlag { cmd puts } } { if { [info commands ${glFunc}Standard] eq "${glFunc}Standard" } { rename ::${glFunc} {} rename ::${glFunc}Standard $glFunc } if { $normalFlag } { return } set code \ [format " if { \[__%sAvail\] } { if { %d } { %s \"%s \$args\" } eval %sStandard \$args } else { %s \">>> %s \$args (N/A in driver)\" }" \ $glFunc $debugFlag $cmd $glFunc $glFunc $cmd $glFunc] uplevel "proc ${glFunc}Safe args { $code }" rename ::$glFunc ::${glFunc}Standard rename ::${glFunc}Safe ::$glFunc } # Note: The check for glGetStringi in the next 3 procedures # is only needed because of a little bug in the wrapping code # of Tcl3D 0.4.0. This bug will be removed in the next Tcl3D release. # Rename all OpenGL functions to use the debug mode. proc SetDebugMode { { printCmd PrintDebug } } { foreach glFunc [tcl3dOglGetFuncList] { if { $glFunc ne "glGetStringi" } { CreateSafeOrDebugFunc $glFunc 1 0 $printCmd } } } # Rename all OpenGL functions to use the safe mode. proc SetSafeMode { { printCmd PrintDebug } } { foreach glFunc [tcl3dOglGetFuncList] { if { $glFunc ne "glGetStringi" } { CreateSafeOrDebugFunc $glFunc 0 0 $printCmd } } } # Rename all OpenGL functions to use the normal mode. proc SetNormalMode { { printCmd PrintDebug } } { foreach glFunc [tcl3dOglGetFuncList] { if { $glFunc ne "glGetStringi" } { CreateSafeOrDebugFunc $glFunc 0 1 $printCmd } } } # Create the widgets and bindings. proc CreateWindow {} { global gDemo frame .fr pack .fr -expand 1 -fill both # Create the OpenGL widget. togl .fr.toglwin -width $gDemo(winWidth) -height $gDemo(winHeight) \ -swapinterval 0 \ -double true -depth true \ -createproc CreateCallback \ -reshapeproc ReshapeCallback \ -displayproc DisplayCallback frame .fr.frBtns frame .fr.frDebug label .fr.info grid .fr.toglwin -row 0 -column 0 -sticky news grid .fr.frBtns -row 1 -column 0 -sticky news grid .fr.frDebug -row 2 -column 0 -sticky news grid .fr.info -row 3 -column 0 -sticky news grid rowconfigure .fr 0 -weight 1 grid columnconfigure .fr 0 -weight 1 wm title . "Tcl3D demo: OpenGL execution modes" labelframe .fr.frBtns.frModes -text "Execution modes" pack .fr.frBtns.frModes -side left -padx 2 radiobutton .fr.frBtns.frModes.normal -text "Normal" \ -variable gDemo(mode) -value "normal" -command SetNormalMode radiobutton .fr.frBtns.frModes.safe -text "Safe" \ -variable gDemo(mode) -value "safe" -command SetSafeMode radiobutton .fr.frBtns.frModes.debug -text "Debug" \ -variable gDemo(mode) -value "debug" -command SetDebugMode eval pack [winfo children .fr.frBtns.frModes] -side left \ -anchor w -expand 1 -fill x labelframe .fr.frBtns.frMisc -text "Settings" pack .fr.frBtns.frMisc -side left -padx 2 checkbutton .fr.frBtns.frMisc.bad -text "Call $gDemo(badCmd)" \ -variable gDemo(useBadCmd) \ -indicatoron [tcl3dShowIndicator] tcl3dToolhelpAddBinding .fr.frBtns.frMisc.bad \ "Switching on this flag and the normal mode will dump core." eval pack [winfo children .fr.frBtns.frMisc] -side left \ -anchor w -expand 1 -fill x labelframe .fr.frBtns.frCmds -text "Commands" pack .fr.frBtns.frCmds -side left -padx 2 button .fr.frBtns.frCmds.clear -text "Clear" -command ClearDebug button .fr.frBtns.frCmds.body -text "Show" -command PrintProcBody button .fr.frBtns.frCmds.step -text "Step" -command NextStep checkbutton .fr.frBtns.frCmds.pause -text "Animate" \ -variable gDemo(animStarted) -command Animate \ -indicatoron [tcl3dShowIndicator] tcl3dToolhelpAddBinding .fr.frBtns.frCmds.clear \ "Clear debug log window" tcl3dToolhelpAddBinding .fr.frBtns.frCmds.body \ "Show body of OpenGL function glBegin in current mode" tcl3dToolhelpAddBinding .fr.frBtns.frCmds.step \ "Advance one rotation step" tcl3dToolhelpAddBinding .fr.frBtns.frCmds.pause \ "Startt/Stop animation" eval pack [winfo children .fr.frBtns.frCmds] -side left \ -anchor w -expand 1 -fill x -padx 1 set gDemo(out) [tcl3dCreateScrolledText .fr.frDebug "" \ -height 11 -borderwidth 1 -font $gDemo(listFont)] wm protocol . WM_DELETE_WINDOW "ExitProg" bind .