Updated 2010-06-23 19:11:04 by dkf ▲

ulis, 2003-12-07. A proc to blur an image.

David Easton, 2003-12-08. Speeded up 25%

(this page replace the Blurring one)

(Original photo: [to fill])

How it works

It works by adding some neighbor pixels:
     0  1  2  3  4
    .--.--.--.--.--.
  0 |//|  |  |  |//|
    .--.--.--.--.--.
  1 |  |  |//|  |  |
    .--.--.--.--.--.
  2 |  |//|XX|//|  |
    .--.--.--.--.--.
  3 |  |  |//|  |  |
    .--.--.--.--.--.
  4 |//|  |  |  |//|
    .--.--.--.--.--.

The color of the central pixel is computed from all marked pixels:
  p22 = (1 - coef) * p22
        + coef/8 * (p00 + p04 + p12 + p21 + p23 + p32 + p40 + p44)

The proc
  namespace eval ::blur \
  {
    namespace export blur

    package require Tk

    proc blur {image coef} \
    {
      # check coef
      if {$coef < 0.0 || $coef > 1.0} \
      { error "bad coef \"$coef\": should be in the range 0.0, 1.0" }
      if {$coef < 1.e-5} { return $image }
      set coef2 [expr {$coef / 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] }
      }
      # blurring
      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 - 2}] [expr {$x - 2}]]
            set c01 [lindex [set $c:data] [expr {$y - 1}] [expr {$x - 0}]]
            set c02 [lindex [set $c:data] [expr {$y - 2}] [expr {$x + 2}]]
            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 + 2}] [expr {$x - 2}]]
            set c21 [lindex [set $c:data] [expr {$y + 1}] [expr {$x - 0}]]
            set c22 [lindex [set $c:data] [expr {$y + 2}] [expr {$x + 2}]]
            foreach v {c00 c01 c02 c10 c12 c20 c21 c22} { if {[set $v] == ""} { set $v 0.0 } }
            set cc [expr {int((1.0 - $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 row2 [format #%02x%02x%02x $r $g $b]
        }
        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/image3.png

  package require Img
  image create photo Photo -file image3.png
  namespace import ::blur::blur
  wm withdraw .
  set n 0
  foreach coef {0.0 0.5 1.0} \
  {
    set image [blur Photo $coef]
    toplevel .$n
    wm title .$n "blur $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

The code above...
     foreach v {c00 c01 c02 c10 c12 c20 c21 c22} { if {[set $v] == ""} { set $v 0.0 } }

checks to see if any of the pixels are blank, and sets them to black. This has an overall darkening effect on the image. Corrected it is:
     foreach v {c00 c01 c02 c10 c12 c20 c21 c22} {
          if {[set $v] == ""} { set $v [lindex [set $c:data] $y $x] }
     }

I also speed this process up significantly (approximately 40% speed increase)
        proc Blur { data coef } {
            if {$coef < 0.0 || $coef > 1.0} { error "bad coef \"$coef\": should be in the range 0.0, 1.0" }
            if {$coef < 1.e-5} { return $image }
            set coef2 [expr {$coef / 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} {
                    update
                    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} {
                    update
                    foreach c {r g b} {
                        set c00 [lindex [set $c:data] [expr {$y - 2}] [expr {$x - 2}]]
                        set c01 [lindex [set $c:data] [expr {$y - 1}] [expr {$x - 0}]]
                        set c02 [lindex [set $c:data] [expr {$y - 2}] [expr {$x + 2}]]
                        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 + 2}] [expr {$x - 2}]]
                        set c21 [lindex [set $c:data] [expr {$y + 1}] [expr {$x - 0}]]
                        set c22 [lindex [set $c:data] [expr {$y + 2}] [expr {$x + 2}]]
                        foreach v {c00 c01 c02 c10 c12 c20 c21 c22} {
                            if {[set $v] == ""} { set $v [lindex [set $c:data] $y $x] }
                        }
                        set cc [expr {int((1.0 - $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
            }
            set blurred [image create photo]
            $blurred put $data2
            return $blurred
        }

* modified by: Barry Skidmore

See also

Category GraphicsCategory Image ProcessingCategory Example