## 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

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