Demo 7 of 17 in category tcl3dOgl
 |
# 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]
|
