Demo 54 of 68 in category RedBook
 |
# stencil.tcl
#
# An example of the OpenGL red book modified to work with Tcl3D.
# The original C sources are Copyright (c) 1993-2003, Silicon Graphics, Inc.
# The Tcl3D sources are Copyright (c) 2005-2022, Paul Obermeier.
# See file LICENSE for complete license information.
#
# This program demonstrates use of the stencil buffer for
# masking nonrectangular regions.
# Whenever the window is redrawn, a value of 1 is drawn
# into a diamond-shaped region in the stencil buffer.
# Elsewhere in the stencil buffer, the value is 0.
# Then a blue sphere is drawn where the stencil value is 1,
# and yellow torii are drawn where the stencil value is not 1.
package require tcl3d
set YELLOWMAT 1
set BLUEMAT 2
# Font to be used in the Tk listbox.
set listFont {-family {Courier} -size 10}
# 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 yellow_diffuse { 0.7 0.7 0.0 1.0 }
set yellow_specular { 1.0 1.0 1.0 1.0 }
set blue_diffuse { 0.1 0.1 0.7 1.0 }
set blue_specular { 0.1 1.0 1.0 1.0 }
set position_one { 1.0 1.0 1.0 0.0 }
glNewList $::YELLOWMAT GL_COMPILE
glMaterialfv GL_FRONT GL_DIFFUSE $yellow_diffuse
glMaterialfv GL_FRONT GL_SPECULAR $yellow_specular
glMaterialf GL_FRONT GL_SHININESS 64.0
glEndList
glNewList $::BLUEMAT GL_COMPILE
glMaterialfv GL_FRONT GL_DIFFUSE $blue_diffuse
glMaterialfv GL_FRONT GL_SPECULAR $blue_specular
glMaterialf GL_FRONT GL_SHININESS 45.0
glEndList
glLightfv GL_LIGHT0 GL_POSITION $position_one
glEnable GL_LIGHT0
glEnable GL_LIGHTING
glEnable GL_DEPTH_TEST
glClearStencil 0x0
glEnable GL_STENCIL_TEST
}
# Draw a sphere in a diamond-shaped section in the
# middle of a window with 2 torii.
proc DisplayCallback { toglwin } {
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]
# draw blue sphere where the stencil is 1
glStencilFunc GL_EQUAL 0x1 0x1
glStencilOp GL_KEEP GL_KEEP GL_KEEP
glCallList $::BLUEMAT
glutSolidSphere 0.5 15 15
# draw the tori where the stencil is not 1
glStencilFunc GL_NOTEQUAL 0x1 0x1
glPushMatrix
glRotatef 45.0 0.0 0.0 1.0
glRotatef 45.0 0.0 1.0 0.0
glCallList $::YELLOWMAT
glutSolidTorus 0.275 0.85 15 15
glPushMatrix
glRotatef 90.0 1.0 0.0 0.0
glutSolidTorus 0.275 0.85 15 15
glPopMatrix
glPopMatrix
glFlush
$toglwin swapbuffers
}
# Whenever the window is reshaped, redefine the
# coordinate system and redraw the stencil area.
proc ReshapeCallback { toglwin { w -1 } { h -1 } } {
set w [$toglwin width]
set h [$toglwin height]
glViewport 0 0 $w $h
# create a diamond shaped stencil area
glMatrixMode GL_PROJECTION
glLoadIdentity
if { $w <= $h } {
gluOrtho2D -3.0 3.0 [expr -3.0*double($h)/double($w)] \
[expr 3.0*double($h)/double($w)]
} else {
gluOrtho2D [expr -3.0*double($w)/double($h)] \
[expr 3.0*double($w)/double($h)] -3.0 3.0
}
glMatrixMode GL_MODELVIEW
glLoadIdentity
glClear GL_STENCIL_BUFFER_BIT
glStencilFunc GL_ALWAYS 0x1 0x1
glStencilOp GL_REPLACE GL_REPLACE GL_REPLACE
glBegin GL_QUADS
glVertex2f -1.0 0.0
glVertex2f 0.0 1.0
glVertex2f 1.0 0.0
glVertex2f 0.0 -1.0
glEnd
glMatrixMode GL_PROJECTION
glLoadIdentity
gluPerspective 45.0 [expr double($w)/double($h)] 3.0 7.0
glMatrixMode GL_MODELVIEW
glLoadIdentity
glTranslatef 0.0 0.0 -5.0
}
# Be certain to request stencil bits.
frame .fr
pack .fr -expand 1 -fill both
togl .fr.toglwin -width 400 -height 400 \
-double true -depth true -stencil true \
-createcommand CreateCallback \
-reshapecommand ReshapeCallback \
-displaycommand DisplayCallback
listbox .fr.usage -font $::listFont -height 1
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: OpenGL Red Book example stencil"
bind . <Key-Escape> "exit"
.fr.usage insert end "Key-Escape Exit"
.fr.usage configure -state disabled
PrintInfo [tcl3dOglGetInfoString]
|
