[ulis], 2003-09-29.
----
[http://perso.wanadoo.fr/maurice.ulis/tcl/bluring.gif]
----
Please, dowload the file before running the script:
  http://perso.wanadoo.fr/maurice.ulis/tcl/flower1.gif
----
  # blur package
  namespace eval ::blur \
  {
    namespace export blur
    # blur image proc
    proc blur {image {coef 0.8}} \
    {
      variable {}
      # get coef
      if {$coef < 0.0 || $coef > 1.0} \
      { error "coeficient should be between 0.0 and 1.0" }
      set (coef2) [expr {$coef / 8.0}]
      set (coef1) [expr {1.0 - $coef}]
      # get image size
      set (height) [image height $image]
      set (width) [image width $image]
      # get pixels
      set (data) [$image data]
      set data {}
      for {set y 0} {$y < $(height)} {incr y} \
      {
        set row {}
        for {set x 0} {$x < $(width)} {incr x} \
        {
          # blur pixel
          lappend row [pixel $x $y]
        }
        lappend data $row
      }
      set image [image create photo]
      $image put $data
      return $image
    }
    # blur pixel proc
    proc pixel {x y} \
    {
      variable {}
      # get pixel & neighbour
      set pix0 [rgb $x $y]
      set pix1 [rgb $x $y n $pix0]
      set pix2 [rgb $x $y s $pix0]
      set pix3 [rgb $x $y e $pix0]
      set pix4 [rgb $x $y w $pix0]
      set pix5 [rgb $x $y nw $pix0]
      set pix6 [rgb $x $y ne $pix0]
      set pix7 [rgb $x $y sw $pix0]
      set pix8 [rgb $x $y se $pix0]
      # combine them
      foreach i {0 1 2} \
      {
        set c0 [lindex $pix0 $i]
        foreach j {1 2 3 4 5 6 7 8} { set c$j [lindex [set pix$j] $i] }
        set c_$i [expr {round($c0 * $(coef1) + ($c1 + $c2 + $c3 + $c4 + $c5 + $c6 + $c7 + $c8) * $(coef2))}]
      }
      return [format #%02x%02x%02x $c_0 $c_1 $c_2]
    }
    # get a neighbour rgb list
    proc rgb {x y {position ""} {rgb ""}} \
    {
      variable {}
      switch $position \
      {
        w   { incr x -1 }
        n   { incr y -1 }
        e   { incr x +1 }
        s   { incr x +1 }
        nw  { incr x -1; incr y -1 }
        ne  { incr x +1; incr y -1 }
        sw  { incr x -1; incr y +1 }
        se  { incr x +1; incr y +1 }
      }
      if {$x < 0 || $x == $(width) || $y < 0 || $y == $(height)} { return $rgb }
      set pixel [lindex [lindex $(data) $y] $x]
      scan $pixel #%2x%2x%2x r g b
      return [list $r $g $b]
    }
  }
  
  # =============
  #   demo
  # =============
  
  package require Tk
  namespace import ::blur::blur
  image create photo _img_ -file flower1.gif
  set width [image width _img_]
  set height [image height _img_]
  set width2 [expr {$width * 2}]
  pack [canvas .c -height $height -width $width2]
  .c create image 0 0 -anchor nw -image _img_
  .c create image $width 0 -anchor nw -image [blur _img_ 1.0]
----
[Category Example]