# imgproc.c - by David Blythe, SGI
#
# Examples of various image processing operations coded as OpenGL
# accumulation buffer operations.  This allows extremely fast   
# image processing on machines with hardware accumulation buffers
# (RealityEngine, InfiniteReality, VGX).
#
# This demo is part of the advanced glut demos.
# See http://www.opengl.org/resources/code/samples/glut_examples/advanced/advanced.html
#
# Modified for Tcl3D by Paul Obermeier 2007/07/28
# See www.tcl3d.org for the Tcl3D extension.

package require Tk
package require Img
package require tcl3d

# Font to be used in the Tk listbox.
set listFont {-family {Courier} -size 10}

# Determine the directory of this script.
set gDemo(scriptDir) [file dirname [info script]]

# Window size.
set winWidth  512
set winHeight 512

# Global variables for image processing.
set alpha 1.0
set luma  0.5
set reset 1
set glFmt $GL_RGB
set glFmtNumChans 3

# 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 widget a the bottom of the window.
proc PrintInfo { msg } {
    if { [winfo exists .fr.info] } {
        .fr.info configure -text $msg
    }
}

proc LoadImage { imgName numChans } {
    if { $numChans != 3 && $numChans != 4 } {
        error "Error: Only 3 or 4 channels allowed ($numChans supplied)"
    }
    set texName [file join $::gDemo(scriptDir) $imgName]
    set retVal [catch {set phImg [image create photo -file $texName]} err1]
    if { $retVal != 0 } {
        error "Error reading image $texName ($err1)"
    } else {
        set w [image width  $phImg]
        set h [image height $phImg]
        set texImg [tcl3dVectorFromPhoto $phImg $numChans]
        image delete $phImg
    }
    return [list $texImg $w $h]
}

proc DoAccum {} {
    global nullVec imgVec
    global width height glFmt alpha

    glDrawPixels $width $height $glFmt GL_UNSIGNED_BYTE $imgVec
    glAccum GL_LOAD [expr $alpha / 2.0]
    glDrawPixels $width $height $glFmt GL_UNSIGNED_BYTE $nullVec
    glAccum GL_ACCUM [expr (1 - $alpha) / 2.0]
    glAccum GL_RETURN 2.0
}

proc Brighten {} {
    global reset nullVec
    global width height glFmtNumChans

    if { $reset } {
        $nullVec setvec 0  0 [expr $width * $height * $glFmtNumChans]
        set reset 0
    }
    DoAccum
}

proc Saturate {} {
    global reset nullVec
    global width height glFmtNumChans

    if { $reset } {
        $nullVec setvec 0xFF  0 [expr $width * $height * $glFmtNumChans]
        set reset 0
    }
    DoAccum
}

proc Contrast {} {
    global reset nullVec
    global width height glFmtNumChans
    global luma

    if { $reset } {
        $nullVec setvec [expr int($luma*255)] \
                        0 [expr $width * $height * $glFmtNumChans]
        set reset 0
    }
    DoAccum
}

proc Sharpen {} {
    global reset nullVec imgVec
    global width height glFmt glFmtNumChans

    if { $reset } {
        gluScaleImage $glFmt $width $height GL_UNSIGNED_BYTE $imgVec \
                      [expr $width / 4] [expr $height / 4] \
                      GL_UNSIGNED_BYTE $nullVec
        gluScaleImage $glFmt [expr $width / 4] [expr $height / 4] \
                      GL_UNSIGNED_BYTE $nullVec $width $height \
                      GL_UNSIGNED_BYTE $nullVec
        set reset 0
    }
    DoAccum
}

proc Redraw {} {
    .fr.toglwin postredisplay
}

proc SetAlpha { offset } {
    global alpha

    set alpha [expr $alpha + $offset]
    Redraw
}

proc SetBrighten {} {
    global func reset

    set func "Brighten"
    set reset 1
    Redraw
}

proc SetSaturate {} {
    global func reset

    set func "Saturate"
    set reset 1
    Redraw
}

proc SetContrast {} {
    global func reset

    set func "Contrast"
    set reset 1
    Redraw
}

proc SetSharpen {} {
    global func reset

    set func "Sharpen"
    set reset 1
    Redraw
}

proc CreateCallback { toglwin } {
    global reset nullVec imgVec
    global width height glFmt glFmtNumChans alpha
    global func luma

    set func "Brighten"

    set imgInfo [LoadImage "Paul.jpg" 3]
    set imgVec  [lindex $imgInfo 0]
    set width   [lindex $imgInfo 1]
    set height  [lindex $imgInfo 2] 
    set nullVec [tcl3dVector GLubyte [expr $width * $height * $glFmtNumChans]]

    glPixelStorei GL_UNPACK_ALIGNMENT 1

    glClearColor 0.25 0.25 0.25 0.25

    # compute luminance
    set l 0.0
    set len [expr {$width * $height}]
    for { set i 0 } { $i < $len } { incr i } {
        set ind [expr {$i*$glFmtNumChans}]
        # We are using the low-level tcl3dVector access functions
        # here for speed issues.
        set r [expr {[GLubyte_getitem $imgVec $ind] / 255.0}]
        incr ind
        set g [expr {[GLubyte_getitem $imgVec $ind] / 255.0}]
        incr ind
        set b [expr {[GLubyte_getitem $imgVec $ind] / 255.0}]
        set l [expr {$l + $r * 0.3086 + $g * 0.0820 + $b * 0.114}]
    }
    set luma [expr {$l / ($width * $height)}]
    puts [format "Average luminance: %.2f" $luma]
}

proc DisplayCallback { toglwin } {
    global func

    glClear GL_COLOR_BUFFER_BIT
    $func
    $toglwin swapbuffers
}

proc ReshapeCallback { toglwin { w -1 } { h -1 } } {
    set w [$toglwin width]
    set h [$toglwin height]

    glViewport 0 0 $w $h
    glMatrixMode GL_PROJECTION
    glLoadIdentity

    glOrtho 0.0 $w 0.0 $h -1.0 1.0
    glMatrixMode GL_MODELVIEW
    glLoadIdentity
}

proc Cleanup {} {
    global nullVec imgVec

    if { [info exists nullVec] } {
         $nullVec delete
         unset nullVec
    }
    if { [info exists imgVec] } {
         $imgVec delete
         unset imgVec
    }
}

# Put all exit related code here.
proc ExitProg {} {
    exit
}

# Create the OpenGL window and some Tk helper widgets.
proc CreateWindow {} {
    global alpha func

    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 $::winWidth -height $::winHeight \
        -double 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

    frame .fr.btns
    label .fr.info
    grid .fr.toglwin -row 0 -column 0 -sticky news
    grid .fr.btns    -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: Image processing with the accumulation buffer"

    # Watch For ESC Key And Quit Messages
    wm protocol . WM_DELETE_WINDOW "ExitProg"
    bind . <Key-Escape> "ExitProg"
    bind . <Key-b>      "SetBrighten"
    bind . <Key-s>      "SetSaturate"
    bind . <Key-z>      "SetSharpen"
    bind . <Key-c>      "SetContrast"
    bind . <Key-Up>     "SetAlpha  0.1"
    bind . <Key-Down>   "SetAlpha -0.1"

    labelframe .fr.btns.fr1
    pack .fr.btns.fr1 -side left -padx 1 -pady 1
    foreach cmd [list "Brighten" "Saturate" "Sharpen" "Contrast"] {
        radiobutton .fr.btns.fr1.cb_$cmd -command Set$cmd -text $cmd \
                     -value $cmd -variable func
        pack .fr.btns.fr1.cb_$cmd -side left
    }

    labelframe .fr.btns.fr2
    pack .fr.btns.fr2 -side left -padx 1 -pady 1 -ipady 2
    label .fr.btns.fr2.l_alpha -text "Alpha:"
    spinbox .fr.btns.fr2.s_alpha -command Redraw \
             -from -3.0 -to 3.0 -increment 0.1 -width 4 -textvariable alpha
    pack .fr.btns.fr2.l_alpha .fr.btns.fr2.s_alpha -side left
}

CreateWindow
PrintInfo [tcl3dOglGetInfoString]
