Demo 21 of 68 in category RedBook
 |
# dof.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 accumulation buffer to
# create an out-of-focus depth-of-field effect. The teapots
# are drawn several times into the accumulation buffer. The
# viewing volume is jittered, except at the focal point, where
# the viewing volume is at the same position, each time. In
# this case, the gold teapot remains in focus.
package require tcl3d
source [file join [file dirname [info script]] "jitter.tclinc"]
# 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
}
}
# The first 6 arguments are identical to the glFrustum() call.
#
# pixdx and pixdy are anti-alias jitter in pixels.
# Set both equal to 0.0 for no anti-alias jitter.
# eyedx and eyedy are depth-of field jitter in pixels.
# Set both equal to 0.0 for no depth of field effects.
#
# focus is distance from eye to plane in focus.
# focus must be greater than, but not equal to 0.0.
#
# Note that accFrustum() calls glTranslatef(). You will
# probably want to insure that your ModelView matrix has been
# initialized to identity before calling accFrustum().
#
proc accFrustum { left right bottom top near far \
pixdx pixdy eyedx eyedy focus } {
set viewport [tcl3dOglGetViewport]
set xwsize [expr $right - $left]
set ywsize [expr $top - $bottom]
set dx [expr -($pixdx*$xwsize/double([lindex $viewport 2]) + \
$eyedx*$near/$focus)]
set dy [expr -($pixdy*$ywsize/double([lindex $viewport 3]) + \
$eyedy*$near/$focus)]
glMatrixMode GL_PROJECTION
glLoadIdentity
glFrustum [expr $left + $dx] [expr $right + $dx] \
[expr $bottom + $dy] [expr $top + $dy] $near $far
glMatrixMode GL_MODELVIEW
glLoadIdentity
glTranslatef [expr -1.0 * $eyedx] [expr -1.0 * $eyedy] 0.0
}
# The first 4 arguments are identical to the gluPerspective() call.
# pixdx and pixdy are anti-alias jitter in pixels.
# Set both equal to 0.0 for no anti-alias jitter.
# eyedx and eyedy are depth-of field jitter in pixels.
# Set both equal to 0.0 for no depth of field effects.
#
# focus is distance from eye to plane in focus.
# focus must be greater than, but not equal to 0.0.
#
# Note that accPerspective() calls accFrustum().
#
proc accPerspective { fovy aspect near far pixdx pixdy \
eyedx eyedy focus } {
set PI_ 3.14159265358979323846
set fov2 [expr (($fovy*$PI_) / 180.0) / 2.0]
set top [expr $near / (cos($fov2) / sin($fov2))]
set bottom [expr -1 * $top]
set right [expr $top * $aspect]
set left [expr -1 * $right]
accFrustum $left $right $bottom $top $near $far \
$pixdx $pixdy $eyedx $eyedy $focus
}
proc CreateCallback { toglwin } {
global teapotList
set ambient { 0.0 0.0 0.0 1.0 }
set diffuse { 1.0 1.0 1.0 1.0 }
set specular { 1.0 1.0 1.0 1.0 }
set position { 0.0 3.0 3.0 0.0 }
set lmodel_ambient { 0.2 0.2 0.2 1.0 }
set local_view { 0.0 }
glLightfv GL_LIGHT0 GL_AMBIENT $ambient
glLightfv GL_LIGHT0 GL_DIFFUSE $diffuse
glLightfv GL_LIGHT0 GL_POSITION $position
glLightModelfv GL_LIGHT_MODEL_AMBIENT $lmodel_ambient
glLightModelfv GL_LIGHT_MODEL_LOCAL_VIEWER $local_view
glFrontFace GL_CW
glEnable GL_LIGHTING
glEnable GL_LIGHT0
glEnable GL_AUTO_NORMAL
glEnable GL_NORMALIZE
glEnable GL_DEPTH_TEST
glClearColor 0.0 0.0 0.0 0.0
glClearAccum 0.0 0.0 0.0 0.0
# make teapot display list
set teapotList [glGenLists 1]
glNewList $teapotList GL_COMPILE
glutSolidTeapot 0.5
glEndList
}
proc renderTeapot { x y z ambr ambg ambb difr difg difb \
specr specg specb shine } {
global teapotList
glPushMatrix
glTranslatef $x $y $z
set mat [list $ambr $ambg $ambb 1.0]
glMaterialfv GL_FRONT GL_AMBIENT $mat
set mat [list $difr $difg $difb 1.0]
glMaterialfv GL_FRONT GL_DIFFUSE $mat
set mat [list $specr $specg $specb 1.0]
glMaterialfv GL_FRONT GL_SPECULAR $mat
glMaterialf GL_FRONT GL_SHININESS [expr $shine * 128.0]
glCallList $teapotList
glPopMatrix
}
# display() draws 5 teapots into the accumulation buffer
# several times; each time with a jittered perspective.
# The focal point is at z = 5.0, so the gold teapot will
# stay in focus. The amount of jitter is adjusted by the
# magnitude of the accPerspective() jitter; in this example, 0.33.
# In this example, the teapots are drawn 8 times. See jitter.h
#
proc DisplayCallback { toglwin } {
# 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]
set viewport [tcl3dOglGetViewport]
glClear GL_ACCUM_BUFFER_BIT
set jitList $::j($::numJits)
for { set jitter 0 } { $jitter < $::numJits } { incr jitter } {
glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT]
set jitPnt [lindex $jitList $jitter]
accPerspective 45.0 \
double([lindex $viewport 2])/double([lindex $viewport 3]) \
1.0 15.0 0.0 0.0 \
[expr 0.33 * [lindex $jitPnt 0]] \
[expr 0.33 * [lindex $jitPnt 1]] \
5.0
# ruby, gold, silver, emerald, and cyan teapots
renderTeapot -1.1 -0.5 -4.5 0.1745 0.01175 \
0.01175 0.61424 0.04136 0.04136 \
0.727811 0.626959 0.626959 0.6
renderTeapot -0.5 -0.5 -5.0 0.24725 0.1995 \
0.0745 0.75164 0.60648 0.22648 \
0.628281 0.555802 0.366065 0.4
renderTeapot 0.2 -0.5 -5.5 0.19225 0.19225 \
0.19225 0.50754 0.50754 0.50754 \
0.508273 0.508273 0.508273 0.4
renderTeapot 1.0 -0.5 -6.0 0.0215 0.1745 0.0215 \
0.07568 0.61424 0.07568 0.633 \
0.727811 0.633 0.6
renderTeapot 1.8 -0.5 -6.5 0.0 0.1 0.06 0.0 \
0.50980392 0.50980392 0.50196078 \
0.50196078 0.50196078 .25
glAccum GL_ACCUM [expr 1.0 / $::numJits]
}
glAccum GL_RETURN 1.0
glFlush
$toglwin swapbuffers
}
proc ReshapeCallback { toglwin { w -1 } { h -1 } } {
set w [$toglwin width]
set h [$toglwin height]
glViewport 0 0 $w $h
}
proc SetJitterSample { num } {
set ::numJits $num
.fr.toglwin postredisplay
}
set ::numJits 8
frame .fr
pack .fr -expand 1 -fill both
# Create a Togl window using an accumulation buffer.
# Reshape and Display callbacks are configured later after knowing if
# the needed accumulation buffer is available.
set retVal [catch { togl .fr.toglwin \
-width 400 -height 400 -double true -depth true -accum true \
-createcommand CreateCallback } errMsg]
if { $retVal != 0 } {
tk_messageBox -icon error -type ok -title "Missing Togl feature" \
-message "Demo needs accumulation buffer: $errMsg"
proc ::Cleanup {} {}
exit 1
return
}
.fr.toglwin configure \
-reshapecommand ReshapeCallback \
-displaycommand DisplayCallback
listbox .fr.usage -font $::listFont -height 8
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 dof"
bind . <Key-1> "SetJitterSample 2"
bind . <Key-2> "SetJitterSample 3"
bind . <Key-3> "SetJitterSample 4"
bind . <Key-4> "SetJitterSample 8"
bind . <Key-5> "SetJitterSample 15"
bind . <Key-6> "SetJitterSample 24"
bind . <Key-7> "SetJitterSample 66"
bind . <Key-Escape> "exit"
.fr.usage insert end "Key-1 Set jitter sample to 2"
.fr.usage insert end "Key-2 Set jitter sample to 3"
.fr.usage insert end "Key-3 Set jitter sample to 4"
.fr.usage insert end "Key-4 Set jitter sample to 8"
.fr.usage insert end "Key-5 Set jitter sample to 15"
.fr.usage insert end "Key-6 Set jitter sample to 24"
.fr.usage insert end "Key-7 Set jitter sample to 66"
.fr.usage insert end "Key-Escape Exit"
.fr.usage configure -state disabled
PrintInfo [tcl3dOglGetInfoString]
|
