Embossing an image
ulis, 2003-12-10. A proc to emboss an image.
How it works
It works by adding and subtracting the neighbor pixels:
0 1 2
.--.--.--.
0 |-1|-1|+1|
.--.--.--.
1 |-1|-1|+1|
.--.--.--.
2 |+1|+1|+1|
.--.--.--.
The central pixel is computed from all pixels:
p11 = -p00 - p01 + p02 - p10 - p11 + p12 + p20 + p21 + p22 The proc
namespace eval ::emboss \
{
namespace export emboss
package require Tk
proc emboss {image} \
{
# 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} \
{
lassign [$image get $x $y] r g b
foreach c {r g b} { lappend $c:row [set $c] }
}
foreach c {r g b} { lappend $c:data [set $c:row] }
}
# embossing
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 - 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}]]
foreach v {c00 c01 c02 c10 c12 c20 c21 c22} { if {[set $v] == ""} { set $v 0.0 } }
set c0 [expr {128 + (-$c00 - $c01 + $c02 - $c10 - $c11 + $c12 + $c20 + $c21 + $c22)}]
if {$c0 < 0} { set c0 0 }
if {$c0 > 255} { set c0 255 }
set $c $c0
}
set c [expr {int(($r + $g + $b) / 3.0)}]
lappend row2 [format #%02x%02x%02x $c $c $c]
}
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/image5.png package require Img image create photo Photo -file image5.png namespace import ::emboss::emboss set image [emboss Photo] wm title . "emboss" canvas .c -bd 0 -highlightt 0 .c create image 0 0 -anchor nw -image $image lassign [.c bbox all] - - width height .c config -width $width -height $height pack .c
Minor Alteration
Removed the second for y loop, improved speed by roughly 40%. fixed line...
foreach v {c00 c01 c02 c10 c12 c20 c21 c22} { if {[set $v] == ""} { set $v 0.0 } }to...
foreach v {c00 c01 c02 c10 c12 c20 c21 c22} {
if {[set $v] == ""} { set $v [lindex [set $c:data] $y $x] }
}This correct a problem with the image getting darker through the effect.
proc Emboss { data } {
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 {};
update
for {set x 0} {$x < $width} {incr x} {
lassign [$data get $x $y] r g b
foreach c {r g b} { lappend $c:row [set $c] }
}
foreach c {r g b} { lappend $c:data [set $c:row] }
set row2 {}
update
for {set x 0} {$x < $width} {incr x} {
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}]]
foreach v {c00 c01 c02 c10 c12 c20 c21 c22} {
if {[set $v] == ""} { set $v [lindex [set $c:data] $y $x] }
}
set c0 [expr {128 + (-$c00 - $c01 + $c02 - $c10 - $c11 + $c12 + $c20 + $c21 + $c22)}]
if {$c0 < 0} { set c0 0 }
if {$c0 > 255} { set c0 255 }
set $c $c0
}
set c [expr {int(($r + $g + $b) / 3.0)}]
lappend row2 [format #%02x%02x%02x $c $c $c]
}
lappend data2 $row2
}
set embossed [image create photo]
$embossed put $data2
unset data data2 c row2 r g b c00 c01 c02 c10 c11 c12 c20 c21 c22 v height width
return $embossed
}* modified by: Barry Skidmore
---
See also