ulis, 2003-12-07. A proc to blur an image.
David Easton, 2003-12-08. Speeded up 25%
(this page replace the Blurring one)
(Original photo:
[to fill
])
How it works edit
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 edit
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" }
# 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} [$image get $x $y] break
foreach c {r g b} { lappend $c:row [set $c] }
}
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 edit
# 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
bind .$n.c <Destroy> exit
update
incr n
}
Minor alterations edit
The code above...
foreach v {c00 c01 c02 c10 c12 c20 c21 c22} { if {[set $v] == ""} { set $v 0.0 } }checks to see if any of the pixels are blank, and sets them to black. This has an overall darkening effect on the image. Corrected it is:
foreach v {c00 c01 c02 c10 c12 c20 c21 c22} {
if {[set $v] == ""} { set $v [lindex [set $c:data] $y $x] }
}I also speed this process up significantly (approximately 40% speed increase)
proc Blur { data 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}]
if {[catch {set width [image width $data]} blah ]} {return 0;}
set height [image height $data]
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} [$data get $x $y] break
foreach c {r g b} {lappend $c:row [set $c];}
}
foreach c {r g b} {lappend $c:data [set $c:row];}
set row {}
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 [lindex [set $c:data] $y $x] }
}
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 row [format #%02x%02x%02x $r $g $b]
}
lappend data2 $row
}
set blurred [image create photo]
$blurred put $data2
return $blurred
}* modified by: Barry Skidmore
More performance
DKF: After playing around and knowing what's really expensive and what isn't, I get
much better performance with this:
proc Blur { image 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}]
set coef1 [expr {1.0 - $coef}]
if {[catch {
set width [image width $image]
set height [image height $image]
}]} {
return 0
}
set data {}
for {set y 0} {$y < $height} {incr y} {
set row {}
for {set x 0} {$x < $width} {incr x} {
set pixel [$image get $x $y]
if {![llength $row]} {
lappend row $pixel $pixel
}
lappend row $pixel
}
lappend row $pixel $pixel
if {![llength $data]} {
lappend data $row $row
}
lappend data $row
}
lappend data $row $row
# blurring
for {set y0 0;set y1 1;set y2 2;set y3 3;set y4 4} {$y0 < $height} {incr y0;incr y1;incr y2;incr y3;incr y4} {
set row2 {}
for {set x0 0;set x1 1;set x2 2;set x3 3;set x4 4} {$x0 < $width} {incr x0;incr x1;incr x2;incr x3;incr x4} {
set cc [expr {
int($coef1 * ([lindex $data $y2 $x2 0]) +
$coef2 * ([lindex $data $y0 $x0 0] +
[lindex $data $y1 $x2 0] +
[lindex $data $y0 $x4 0] +
[lindex $data $y2 $x1 0] +
[lindex $data $y2 $x3 0] +
[lindex $data $y4 $x0 0] +
[lindex $data $y3 $x2 0] +
[lindex $data $y4 $x4 0]))
}]
set r [expr {$cc<0?0:$cc>255?255:$cc}]
set cc [expr {
int($coef1 * ([lindex $data $y2 $x2 1]) +
$coef2 * ([lindex $data $y0 $x0 1] +
[lindex $data $y1 $x2 1] +
[lindex $data $y0 $x4 1] +
[lindex $data $y2 $x1 1] +
[lindex $data $y2 $x3 1] +
[lindex $data $y4 $x0 1] +
[lindex $data $y3 $x2 1] +
[lindex $data $y4 $x4 1]))
}]
set g [expr {$cc<0?0:$cc>255?255:$cc}]
set cc [expr {
int($coef1 * ([lindex $data $y2 $x2 2]) +
$coef2 * ([lindex $data $y0 $x0 2] +
[lindex $data $y1 $x2 2] +
[lindex $data $y0 $x4 2] +
[lindex $data $y2 $x1 2] +
[lindex $data $y2 $x3 2] +
[lindex $data $y4 $x0 2] +
[lindex $data $y3 $x2 2] +
[lindex $data $y4 $x4 2]))
}]
set b [expr {$cc<0?0:$cc>255?255:$cc}]
lappend row2 [format #%02x%02x%02x $r $g $b]
}
lappend data2 $row2
}
set blurred [image create photo]
$blurred put $data2
return $blurred
}This goes at least twice as fast as the other versions.
See also edit
