Version 1 of Blurring an image
Updated 2003-12-07 14:20:01ulis, 2003-12-07. A proc to blur an image.
(this page replace the Blurring one)
'''How it works'''
It works by adding some neighbor pixels:
0 1 2 3 4
.--.--.--.--.--.
0 |//| | | |//|
.--.--.--.--.--.
1 | | |//| | |
.--.--.--.--.--.
2 | |//|XX|//| |
.--.--.--.--.--.
3 | | |//| | |
.--.--.--.--.--.
4 |//| | | |//|
.--.--.--.--.--.
The color of the central pixel is computed from all marked pixels:
p22 = (1 - coef) * p22
+ coef/8 * (p00 + p04 + p12 + p21 + p23 + p32 + p40 + p44) The proc
namespace eval ::blur \
{
namespace export blur
package require Tk
proc blur {image coef} \
{
# check coef
if {$coef < 0.0 || $coef > 1.0} \
{ error "bad coef \"$coef\": should be in the range 0.0, 1.0" }
if {$coef < 1.e-5} { return $image }
set coef2 [expr {$coef / 8.0}]
# get the old image content
set width [image width $image]
set height [image height $image]
if {$width * $height == 0} { error "bad image" }
set data [$image data]
# create corresponding planes
for {set y 0} {$y < $height} {incr y} \
{
set r:row {}
set g:row {}
set b:row {}
for {set x 0} {$x < $width} {incr x} \
{
foreach {r g b} [winfo rgb . [lindex $data $y $x]] break
foreach c {r g b} { lappend $c:row [expr [set $c] / 256] }
}
foreach c {r g b} { lappend $c:data [set $c:row] }
}
# blurring
for {set y 0} {$y < $height} {incr y} \
{
set row2 {}
for {set x 0} {$x < $width} {incr x} \
{
foreach c {r g b} \
{
set c00 [lindex [set $c:data] [expr {$y - 2}] [expr {$x - 2}]]
set c01 [lindex [set $c:data] [expr {$y - 1}] [expr {$x - 0}]]
set c02 [lindex [set $c:data] [expr {$y - 2}] [expr {$x + 2}]]
set c10 [lindex [set $c:data] [expr {$y + 0}] [expr {$x - 1}]]
set c11 [lindex [set $c:data] [expr {$y + 0}] [expr {$x - 0}]]
set c12 [lindex [set $c:data] [expr {$y + 0}] [expr {$x + 1}]]
set c20 [lindex [set $c:data] [expr {$y + 2}] [expr {$x - 2}]]
set c21 [lindex [set $c:data] [expr {$y + 1}] [expr {$x - 0}]]
set c22 [lindex [set $c:data] [expr {$y + 2}] [expr {$x + 2}]]
foreach v {c00 c01 c02 c10 c12 c20 c21 c22} { if {[set $v] == ""} { set $v 0.0 } }
set cc [expr {int((1.0 - $coef) * $c11 + $coef2 * ($c00 + $c01 + $c02 + $c10 + $c12 + $c20 + $c21 + $c22))}]
if {$cc < 0} { set cc 0 }
if {$cc > 255} { set cc 255 }
set $c $cc
}
lappend row2 [format #%02x%02x%02x $r $g $b]
}
lappend data2 $row2
}
# create the new image
set image2 [image create photo]
# fill the new image
$image2 put $data2
# return the new image
return $image2
}
}The demo
# to download the image:
# http://perso.wanadoo.fr/maurice.ulis/tcl/image3.png
package require Img
image create photo Photo -file image3.png
namespace import ::blur::blur
wm withdraw .
set n 0
foreach coef {0.0 0.5 1.0} \
{
set image [blur Photo $coef]
toplevel .$n
wm title .$n "blur $coef"
canvas .$n.c -bd 0 -highlightt 0
.$n.c create image 0 0 -anchor nw -image $image
foreach {- - width height} [.$n.c bbox all] break
.$n.c config -width $width -height $height
pack .$n.c
update
incr n
}See also