# 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-2026, 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]
