Version 9 of Dithering

Updated 2006-07-23 01:57:58

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. [L1 ]

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
    }
 }
 proc OrderedDither {numShades srcImg dstImg} {
    set iw [image width $srcImg]
    set ih [image height $srcImg]

    set omatrix {
        {1  9  3 11}
        {13  5 15  7}
        {4 12  2 10}
        {16  8 14  6}}

    # We're scanning row by row instead of 4x4 chunks because
    # speed is not important here and this way has no corner cases
    for {set y 0} {$y < $ih} {incr y} {
        set mrow [expr {$y % 4}]                ;# Row in ordering matrix
        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 pxl [expr {round ($pxl * 16 / 255.0)}]
            set threshold [lindex $omatrix $mrow [expr {$x % 4}]]
            set dst [expr {$pxl < $threshold ? 0 : 255}]
            lappend ddata [format "\#%02X%02X%02X" $dst $dst $dst]
        }
        $dstImg put [list $ddata] -to 0 $y $iw $y2
        update
    }
 }
 proc RandomDither {numShades srcImg dstImg} {
    set iw [image width $srcImg]
    set ih [image height $srcImg]

    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 {$pxl > (rand()*255) ? 255 : 0}]
            lappend ddata [format "\#%02X%02X%02X" $dst $dst $dst]
        }
        $dstImg put [list $ddata] -to 0 $y $iw $y2
        update
    }
 }

 # DEMO CODE

Category Graphics | Category Image Processing | Category Algorithm