[ulis], 2003-12-10. A proc to emboss an image. [http://perso.wanadoo.fr/maurice.ulis/tcl/emboss.png] ---- '''How it works''' It works by adding and substracting 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} \ { 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] } } # 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 foreach {- - width height} [.c bbox all] break .c config -width $width -height $height pack .c ---- '''See also''' * [Blurring an image] * [Crisping an image] * [Expanding an image] * [Shrinking an image] ---- [Category Graphics] | [Category Image processing] | [Category Art & Craft] | [Category Example]