# blur package
namespace eval ::blur \
{
    namespace export blur
    # blur image proc
    proc blur {image {blur 0.1}} \
    {
        variable {}
        # get coef
        if {$blur < 0.0 || $blur > 1.0} \
        { error "blur should be between 0.0 and 1.0" }
        set neighbur [expr {int($blur * 4.0)}]
        # 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
                set pixel [pixel $x $y $width $height $blur $neighbur]
                lappend row [eval format #%02x%02x%02x $pixel]
            }
            lappend data $row
        }
        unset (data)
        set image [image create photo]
        $image put $data
        return $image
    }
    # blur pixel proc
    proc pixel {x y maxx maxy blur neighbur} \
    {
        variable {}
        # get pixel & neighbour
        if {$neighbur == 0} { set rgb0 [rgb $x $y] } \
        else { set rgb0 [pixel $x $y $maxx $maxy $blur [expr {$neighbur - 1}]] }
        set rgb [list 0 0 0]
        set list1 [list 0]
        incr neighbur
        for {set i 1} {$i <= $neighbur} {incr i} \
        { lappend list1 $i -$i }
        set list1 [lrange $list1 0 end-1]
        set list2 [list $neighbur -$neighbur]
        set n 0
        foreach i $list1 \
        {
            foreach j $list2 \
            {
                set x1 [expr {$x + $i}]
                set y1 [expr {$y + $j}]
                if {$x1 < 0 || $x1 >= $maxx || $y1 < 0 || $y1 >= $maxy} { continue }
                ladd rgb [rgb $x1 $y1]
                incr n
            }
        }
        foreach j $list1 \
        {
            foreach i $list2 \
            {
                set x1 [expr {$x + $i}]
                set y1 [expr {$y + $j}]
                if {$x1 < 0 || $x1 >= $maxx || $y1 < 0 || $y1 >= $maxy} { continue }
                ladd rgb [rgb $x1 $y1]
                incr n
            }
        }
        lmultiply rgb $blur
        ldivide rgb $n
        lmultiply rgb0 [expr {1.0 - $blur}]
        ladd rgb $rgb0
        lround rgb
        return $rgb
    }
    # add components
    proc ladd {rgb1_name rgb2} \
    {
        upvar $rgb1_name rgb1
        foreach i {0 1 2} \
        { lset rgb1 $i [expr [lindex $rgb1 $i] + [lindex $rgb2 $i]] }
    }
    # multiply components
    proc lmultiply {rgb_name factor} \
    {
        upvar $rgb_name rgb
        foreach i {0 1 2} \
        { lset rgb $i [expr [lindex $rgb $i] * $factor] }
    }
    # divide components
    proc ldivide {rgb_name factor} \
    {
        upvar $rgb_name rgb
        foreach i {0 1 2} \
        { lset rgb $i [expr [lindex $rgb $i] / $factor] }
    }
    # round components
    proc lround {rgb_name} \
    {
        upvar $rgb_name rgb
        foreach i {0 1 2} \
        { lset rgb $i [expr round([lindex $rgb $i])] }
    }
    # get a rgb list
    proc rgb {x y} \
    {
        variable {}
        set pixel [lindex [lindex $(data) $y] $x]
        scan $pixel #%2x%2x%2x r g b
        return [list $r $g $b]
    }
}

# =============
#   demo
# =============

set blur1 0.2
set blur2 0.4
wm title . "blur $blur1 - $blur2"
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 [blur _img_ $blur1]
.c create image $width 0 -anchor nw -image [blur _img_ $blur2]