OUTPUT BUFFER:
# 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 0.3 # 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 Our OpenGL Window togl .fr.toglwin -width $::winWidth -height $::winHeight \ -double true -accum true \ -createproc CreateCallback \ -reshapeproc ReshapeCallback \ -displayproc 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 .