Crisping an image
ulis, 2003-12-07. A proc to crisp an image.
David Easton, 2003-12-08 25% Speedup by using "<photo> get"
(Original photo: to fill)
How it works
It works by subtracting neighbor pixels:
0 1 2
.--.--.--.
0 |//|//|//|
.--.--.--.
1 |//|XX|//|
.--.--.--.
2 |//|//|//|
.--.--.--.
The color of the central pixel is computed from all marked pixels:
p11 = coef * p11
- (1 - coef)/8 * (p00 + p01 + p02 + p11 + p12 + p20 + p21 + p22) The proc
namespace eval ::crisp \
{
namespace export crisp
package require Tk
proc crisp {image coef} \
{
# check coef
if {$coef < 1.0} \
{ error "bad coef \"$coef\": should not be less than 1.0" }
if {abs($coef - 1.0) < 1.e-4} { return $image }
set coef2 [expr {($coef - 1.0) / 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] }
}
# crisping
for {set y 0} {$y < $height} {incr y} \
{
set row {}
for {set x 0} {$x < $width} {incr x} \
{
if {$x == 0 || $x == $width - 1 || $y == 0 || $y == $height - 1} \
{
foreach c {r g b} { set $c [lindex [set $c:data] $y $x] }
} \
else \
{
foreach c {r g b} \
{
set c00 [lindex [set $c:data] [expr {$y - 1}] [expr {$x - 1}]]
set c01 [lindex [set $c:data] [expr {$y - 1}] [expr {$x - 0}]]
set c02 [lindex [set $c:data] [expr {$y - 1}] [expr {$x + 1}]]
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 + 1}] [expr {$x - 1}]]
set c21 [lindex [set $c:data] [expr {$y + 1}] [expr {$x - 0}]]
set c22 [lindex [set $c:data] [expr {$y + 1}] [expr {$x + 1}]]
set cc [expr {int($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
}
# 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/image4.png
package require Img
image create photo Photo -file image4.png
namespace import ::crisp::crisp
wm withdraw .
set n 0
foreach coef {1.0 1.4 1.8} \
{
set image [crisp Photo $coef]
toplevel .$n
wm title .$n "crisp $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
I noticed that this process was running fairly slow, considering its function, and consolidated the code some. I then noticed that for some reason the image was getting slightly brighter on each pass of crisping. I then added a corrective check to the value of the cc variable to correct this.
Here are my changes (note roughly 40% speed increase)
proc Crisp { data coef } {
if {$coef < 1.0} { error "bad coef \"$coef\": should not be less than 1.0" }
if {abs($coef - 1.0) < 1.e-4} { return $image }
set coef2 [expr {($coef - 1.0) / 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} {
update
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} {
if {$x == 0 || $x == $width - 1 || $y == 0 || $y == $height - 1} {
foreach c {r g b} { set $c [lindex [set $c:data] $y $x] }
} else {
foreach c {r g b} {
set c00 [lindex [set $c:data] [expr {$y - 1}] [expr {$x - 1}]]
set c01 [lindex [set $c:data] [expr {$y - 1}] [expr {$x - 0}]]
set c02 [lindex [set $c:data] [expr {$y - 1}] [expr {$x + 1}]]
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 + 1}] [expr {$x - 1}]]
set c21 [lindex [set $c:data] [expr {$y + 1}] [expr {$x - 0}]]
set c22 [lindex [set $c:data] [expr {$y + 1}] [expr {$x + 1}]]
if {[catch {set cc [expr {int($coef * $c11 - $coef2 * ($c00 + $c01 + $c02 + $c10 + $c12 + $c20 + $c21 + $c22))}]} blah]} {set cc [lindex [set $c:data] $y [expr $x]];}
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 crisped [image create photo]
$crisped put $data2
return $crisped
}* modified by: Barry Skidmore
See also
- Blurring an image
- Embossing an image
- Expanding an image
- Image Processing with HSV
- Photo image rotation
- Shrinking an image
- TkPhotoLab