[Keith Vetter] 2006-07-22 : is a technique used in 
computer graphics to create the illusion of color 
depth in images with a limited color palette (color 
quantization). In a dithered image, colors not 
available in the palette are approximated by a 
diffusion of colored pixels from within the 
available palette. [http://en.wikipedia.org/wiki/Dither]

Here some code that implemenents some dithering 
algorithms, along with the requisite demo code.
The code here is only for gray-scaled images
but could easily be extended to color images. 
Also, another improvement would be to use
an optimized paletter before dithering
(see [Reduce Colour Depth - Median Cut]).

This was a really fun project. To save space
in the wiki, I didn't include a sample image
in the demo. Instead, I tried linking to 
tcl demo images and images from the web
(I included some famous image processing images
such as Lena).

For fun, try out some of the various web images I 
included links for and see a) how many colors are
needed by the various algorithms to look good, and
b) how badly some algorithms are with certain images
at different color depths.

For example, try the tcl demo code image of the teapot
at just 2 colors and then 3 colors.

----

 ##+##########################################################################
 #
 # dither.tcl -- Plays with various types of dithering
 # by Keith Vetter, May 2006
 #
 # image source: http://sipi.usc.edu/database/database.cgi?volume=misc
 # dithering overview: http://www.visgraf.impa.br/Courses/ip00/proj/Dithering1/algoritmos_desenvolvidos.htm
 #
 
 package require Tk
 package require http
 package require Img
 if {! [catch {package require tile 0.7.2}]} {   ;# Use tile if present
    namespace import -force ::ttk::button
 }

 set S(title) "Dithering"
 set S(numShades) 2
 set S(status) blank
 
 set lenaURL http://www.visgraf.impa.br/Courses/ip00/proj/Dithering1/image/lena.gif
 set teapotImg [file join $tk_library demos images teapot.ppm]
 
 set images {}
 lappend images [list Lena $lenaURL]
 lappend images [list "Lena (full size)" http://sipi.usc.edu/services/database/misc/4.2.04.tiff]
 lappend images [list "Mandrill" http://sipi.usc.edu/services/database/misc/4.2.03.tiff]
 lappend images [list "Sailboat on lake" http://sipi.usc.edu/services/database/misc/4.2.06.tiff]
 lappend images [list "Elaine" http://sipi.usc.edu/services/database/misc/elaine.512.tiff]
 lappend images [list "Gray Scale" http://www.sput.nl/images/grey2.gif]
 lappend images [list "Gray Scale 2" http://support.sas.com/techsup/technote/ts688/gray.gif]
 
 lappend images {- -}
 lappend images [list Teapot $teapotImg]
 lappend images [list Earth [file join $tk_library demos images earth.gif]]
 lappend images [list "Active Tcl Splash" [file join $tk_library images activetclsplash.gif]]
 lappend images [list "Bliss Wallpaper" [file join $env(windir) Web/Wallpaper/Bliss.bmp]]
 
 proc Floyd-Steinberg {numShades srcImg dstImg} {
    set iw [image width $srcImg]
    set ih [image height $srcImg]
    set factor [expr {($numShades - 1) / 255.0}];# For computing output color
 
    # Error matrix, be lazy and over allocate
    for {set x -1} {$x <= $iw} {incr x} {       ;# NB. extend beyond boundary
        for {set y -1} {$y <= $ih} {incr y} {
            set cerror($x,$y) 0
        }
    }
    for {set y 0} {$y < $ih} {incr y} {
        set y2 [expr {$y + 1}]
        set data [$srcImg data -from 0 $y $iw $y2] ;# Read whole row of image
 
        set FSData {}
        set direction [expr {($y & 1) ? -1 : 1}];# Serpentine scan-line access
        for {set idx 0} {$idx < $iw} {incr idx} {
            set x [expr {$direction ? $idx : $iw-1-$idx}]
            set x2 [expr {$x + $direction}]
            set x0 [expr {$x - $direction}]
            
            set pxl "0x[string range [lindex $data 0 $x] 1 2]" ;# Pixel color
            set src [expr {$pxl + $cerror($x,$y)}] ;# With error added in
            set dst [expr {round(floor($src * $factor + .5) / $factor)}]
            set dst [expr {$dst < 0 ? 0 : $dst > 255 ? 255 : $dst}]
            
            lappend FSData [format "\#%02X%02X%02X" $dst $dst $dst]
 
            set err [expr {$src - $dst}]
            set cerror($x2,$y) [expr {$cerror($x2,$y) + $err*7/16.0}]
            set cerror($x2,$y2) [expr {$cerror($x2,$y2) + $err*1/16.0}]
            set cerror($x,$y2) [expr {$cerror($x,$y2) + $err*5/16.0}]
            set cerror($x0,$y2) [expr {$cerror($x0,$y2) + $err*3/16.0}]
        }
        $dstImg put [list $FSData] -to 0 $y $iw $y2
        update
    }
 }
 proc AverageDither {numShades srcImg dstImg} {
    set iw [image width $srcImg]
    set ih [image height $srcImg]
    set factor [expr {($numShades - 1) / 255.0}];# For computing output color
 
    for {set y 0} {$y < $ih} {incr y} {
        set y2 [expr {$y + 1}]
        set data [$srcImg data -from 0 $y $iw $y2]
 
        set ddata {}
        for {set x 0} {$x < $iw} {incr x} {
            set pxl "0x[string range [lindex $data 0 $x] 1 2]" ;# Pixel color
            set dst [expr {round(floor($pxl * $factor + .5) / $factor)}]
            set dst [expr {$dst < 0 ? 0 : $dst > 255 ? 255 : $dst}]
            lappend ddata [format "\#%02X%02X%02X" $dst $dst $dst]
        }
        $dstImg put [list $ddata] -to 0 $y $iw $y2
        update
    }
 }


----

[Category Graphics] |
[Category Image Processing] |
[Category Algorithm]