OUTPUT BUFFER:
# tcl3dDouble.tcl # # A Tcl3D widget demo with two windows, one single buffered and the # other double buffered. # # This is a version of the original Togl double demo written entirely in Tcl # with the help of the Tcl3D package. # # Copyright (C) 1996 Brian Paul and Ben Bederson (Original C/Tcl version) # Copyright (C) 2005 Paul Obermeier (Tcl3D version) # See the LICENSE file for copyright details. # # Original sources available at: http://sourceforge.net/projects/togl/ package require tcl3d 0.2 # Show errors occuring in the Togl callbacks. proc bgerror { msg } { tk_messageBox -icon error -type ok -message "Error: $msg\n\n$::errorInfo" 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 CreateCallback { toglwin } { set ::FontBase [$toglwin loadbitmapfont "fixed"] } proc ReshapeCallback { toglwin { w -1 } { h -1 } } { set w [$toglwin width] set h [$toglwin height] set aspect [expr double ($w) / double ($h)] glViewport 0 0 $w $h glMatrixMode GL_PROJECTION glLoadIdentity glFrustum [expr -1.0 * $aspect] $aspect -1.0 1.0 1.0 10.0 set ::CornerX [expr -1.0 * $aspect] set ::CornerY -1.0 set ::CornerZ -1.1 glMatrixMode GL_MODELVIEW } proc PrintString {s} { glListBase $::FontBase set len [string length $s] set sa [tcl3dVectorFromString GLubyte $s] glCallLists $len GL_UNSIGNED_BYTE $sa $sa delete } proc DisplayCallback { toglwin } { global FontBase 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 0.0 0.0 -3.0 glRotatef $::xAngle 1.0 0.0 0.0 glRotatef $::yAngle 0.0 1.0 0.0 glRotatef $::zAngle 0.0 0.0 1.0 glEnable GL_DEPTH_TEST if { ! [info exists ::cubeList] } { set ::cubeList [glGenLists 1] glNewList $::cubeList GL_COMPILE glBegin GL_QUADS glColor3f 0.0 0.7 0.1 glVertex3f -1.0 1.0 1.0 glVertex3f 1.0 1.0 1.0 glVertex3f 1.0 -1.0 1.0 glVertex3f -1.0 -1.0 1.0 glColor3f 0.9 1.0 0.0 glVertex3f -1.0 1.0 -1.0 glVertex3f 1.0 1.0 -1.0 glVertex3f 1.0 -1.0 -1.0 glVertex3f -1.0 -1.0 -1.0 glColor3f 0.2 0.2 1.0 glVertex3f -1.0 1.0 1.0 glVertex3f 1.0 1.0 1.0 glVertex3f 1.0 1.0 -1.0 glVertex3f -1.0 1.0 -1.0 glColor3f 0.7 0.0 0.1 glVertex3f -1.0 -1.0 1.0 glVertex3f 1.0 -1.0 1.0 glVertex3f 1.0 -1.0 -1.0 glVertex3f -1.0 -1.0 -1.0 glEnd glEndList } glCallList $::cubeList glDisable GL_DEPTH_TEST glLoadIdentity glColor3f 1.0 1.0 1.0 glRasterPos3f $::CornerX $::CornerY $::CornerZ set ident [lindex [$toglwin configure -ident] end] if { [string compare $ident "Single"] == 0 } { PrintString "Single buffered" } else { PrintString "Double buffered" } $toglwin swapbuffers } proc SetRotX { wid val } { set ::xAngle $val if { $::xAngle < 0.0 } { set ::xAngle [expr $::xAngle + 360.0] } elseif { $::xAngle > 360.0 } { set ::xAngle [expr $::xAngle - 360.0] } $wid postredisplay } proc SetRotY { wid val } { set ::yAngle $val if { $::yAngle < 0.0 } { set ::yAngle [expr $::yAngle + 360.0] } elseif { $::yAngle > 360.0 } { set ::yAngle [expr $::yAngle - 360.0] } $wid postredisplay } proc Cleanup {} { # Destroy the display list and it's associated variable. # Needed when running the demo in the presentation framework. if { [info exists ::cubeList] } { glDeleteLists $::cubeList 1 unset ::cubeList } } proc CreateWindows {} { wm title . "Tcl3D demo: Single vs Double Buffering" # Master frame. Needed to integrate demo into Tcl3D Starpack presentation. frame .fr pack .fr -expand 1 -fill both frame .fr.f1 # create first Togl widget togl .fr.f1.o1 -width 200 -height 200 -rgba true \ -double false -depth true -ident Single \ -createproc CreateCallback \ -displayproc DisplayCallback \ -reshapeproc ReshapeCallback # create second Togl widget, share display lists with first widget togl .fr.f1.o2 -width 200 -height 200 -rgba true \ -double true -depth true -ident Double -sharelist Single \ -createproc CreateCallback \ -displayproc DisplayCallback \ -reshapeproc ReshapeCallback frame .fr.x label .fr.x.l -text "X Axis" scale .fr.x.s -from 0 -to 360 -command {SetAngle x} -orient horizontal frame .fr.y label .fr.y.l -text "Y Axis" scale .fr.y.s -from 0 -to 360 -command {SetAngle y} -orient horizontal label .fr.info bind .fr.f1.o1