Demo 9 of 15 in category Tcl3DSpecificDemos
 |
# 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
# 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
# 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 {} {
global gDemo
# Restore mode. Needed, if run from the presentation framework.
tcl3dOglSetMode $gDemo(initmode)
uplevel #0 unset gDemo
}
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
}
# 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 \
-createcommand CreateCallback \
-reshapecommand ReshapeCallback \
-displaycommand 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 "tcl3dOglSetNormalMode PrintDebug"
radiobutton .fr.frBtns.frModes.safe -text "Safe" \
-variable gDemo(mode) -value "Safe" -command "tcl3dOglSetSafeMode PrintDebug"
radiobutton .fr.frBtns.frModes.debug -text "Debug" \
-variable gDemo(mode) -value "Debug" -command "tcl3dOglSetDebugMode PrintDebug"
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 . <Key-Escape> "ExitProg"
}
# Get OpenGL execution mode at startup.
set gDemo(mode) [tcl3dOglGetMode]
set gDemo(initmode) $gDemo(mode)
CreateWindow
PrintInfo [tcl3dOglGetInfoString]
if { [file tail [info script]] eq [file tail $::argv0] } {
# If started directly from tclsh or wish, then start animation.
update
StartAnimation
}
|
