Version 6 of Embossing an image

Updated 2022-04-06 12:40:12 by APE

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