Version 16 of Image Processing with HSV

Updated 2017-12-06 19:23:07 by gold

ulis, 2003-12-07. A proc to manipulate HSV components.

David Easton, 2003-12-08. Speedup using "<photo> get"

http://perso.wanadoo.fr/maurice.ulis/tcl/hsv1.png http://perso.wanadoo.fr/maurice.ulis/tcl/hsv2.png http://perso.wanadoo.fr/maurice.ulis/tcl/hsv3.png http://perso.wanadoo.fr/maurice.ulis/tcl/hsv4.png http://perso.wanadoo.fr/maurice.ulis/tcl/hsv5.png

(Original photo: to fill)


What it does

  The -s option manipulates the saturation:
  • a value less than 1.0 reduces the saturation,
  • a value greater than 1.0 increases the saturation.
  The -v option manipulates the brightness:
  • a value less than 1.0 reduces the brightness,
  • a value greater than 1.0 increases the brightness.

How it works

It works by computing and manipulating the HSV components then coming back to RGB.

KPV For further information, check out Adventures in HSV Space


The proc

package require Tk

namespace eval ::hsv {
    namespace export hsv

    proc hsv args {
        # check args
        if {[llength $args] < 1 || [llength $args] % 2 == 0} {
            return -code error {wrong # args: should be "hsv ?-s saturation? ?-v value?" image}
        }
        set image [lindex $args end]
        foreach {key value} [lrange $args 0 end-1] {
            switch -glob -- $key {
                -s* {
                    if {abs($value - 1.0) > 1.e-5} {
                        set options(saturation) $value
                    }
                }
                -v* {
                    if {abs($value - 1.0) > 1.e-5} {
                        set options(value) $value
                    }
                }
                default {
                    return -code error [format {unknown option "%s": should be -s or -v} $key]
                }
            }
        }
        if {![info exists options(saturation)] && ![info exists options(value)]} {
            return $image
        }
        # get the old image content
        set width [image width $image]
        set height [image height $image]
        if {$width * $height == 0} {
            return -code error "bad image"
        }
        # create corresponding planes
        for {set y 0} {$y < $height} {incr y} {
            set row2 {}
            for {set x 0} {$x < $width} {incr x} {
                foreach {rgb(r) rgb(g) rgb(b)} [$image get $x $y] break
                # convert to HSV
                set min [expr {min($rgb(r), $rgb(g), $rgb(b))}]
                set max [expr {max($rgb(r), $rgb(g), $rgb(b))}]
                set v $max
                set delta [expr {$max - $min}]
                if {$max == 0 || $delta == 0} {
                    set s 0
                    set h -1
                } else {
                    set s [expr {$delta / double($max)}]
                    if {$rgb(r) == $max} {
                        set h [expr {0.0   + ($rgb(g) - $rgb(b)) * 60.0 / $delta}]
                    } elseif {$rgb(g) == $max} {
                        set h [expr {120.0 + ($rgb(b) - $rgb(r)) * 60.0 / $delta}]
                    } else {
                        set h [expr {240.0 + ($rgb(r) - $rgb(g)) * 60.0 / $delta}]
                    }
                }
                if {$h < 0.0} {
                    set h [expr {$h + 360.0}]
                }
                # manipulate HSV components
                if {[info exists options(saturation)]} {
                    set s [expr {$s * $options(saturation)}]
                }
                if {[info exists options(value)]} {
                    set v [expr {$v * $options(value)}]
                }
                # convert to RGB
                if {$s == 0} {
                    foreach c {r g b} {
                        set rgb($c) [expr {int($v)}]
                    }
                } else {
                    set f [expr {$h / 60.0}]
                    set i [expr {int($f)}]
                    set f [expr {$f - $i}]
                    set p [expr {$v * (1 - $s)}]
                    set q [expr {$v * (1 - $s * $f)}]
                    set t [expr {$v * (1 - $s * (1 - $f))}]
                    set vals [subst [lindex {
                        {$v $t $p}
                        {$q $v $p}
                        {$p $v $t}
                        {$p $q $v}
                        {$t $p $v}
                        {$v $p $q}
                    } $i]]
                    foreach c {r g b} v $vals { 
                        set v [expr {int($v)}] 
                        if {$v < 0} {
                            set rgb($c) 0
                        } elseif {$v > 255} {
                            set rgb($c) 255
                        } else {
                            set rgb($c) $v
                        }
                    }
                }
                lappend row2 [format #%02x%02x%02x $rgb(r) $rgb(g) $rgb(b)]
            }
            lappend data2 $row2
        }
        # create the new image
        set image2 [image create photo]'''The demo'''
(Original image `http://perso.wanadoo.fr/maurice.ulis/tcl/image5.png` is missing.)

package require Img image create photo Photo -file wmpnss_color120.png namespace import ::hsv::hsv wm withdraw . toplevel .t wm title .t hsv canvas .t.c -bd 0 -highlightt 0 set h image height Photo set w image width Photo set x() 0 set y() 0 set x(-v) $w set y(-v) 0 set x(-s) expr {2 * $w} set y(-s) 0 foreach args {{} {-v 0.5} {-v 1.5} {-s 0.5} {-s 1.5}} {

    set image [hsv {*}$args Photo]
    set k [lindex $args 0]
    .t.c create text $x($k) $y($k) -anchor nw -text "Options: $args"
    .t.c create image $x($k) [incr y($k) 20] -anchor nw -image $image
    incr y($k) $h

} lassign .t.c bbox all - - width height .t.c config -width $width -height $height pack .t.c bind .t.c <Destroy> exit

----

'''Minor Addition'''

I made a modified version of this code to allow a quick and easy greyscale conversion.  THe process is quite fast and simple.  Just grab the HSV and never go back to RGB.
        proc BW { data } {
            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 row {}
                set r:row {}; set g:row {}; set b:row {};
                for {set x 0} {$x < $width} {incr x} {
                    foreach {r g b} [$data get $x $y] break
                    set min [expr {$r < $g ? $r : $g}]
                    set min [expr {$b < $min ? $b : $min}]
                    set max [expr {$r > $g ? $r : $g}]
                    set max [expr {$b > $max ? $b : $max}]
        # fill the new image
        $image2 put $data2
        # return the new image
        return $image2
    }

}

----


                    set v $max
                    foreach c {r g b} {set $c [expr {int($v)}]}
                    lappend row [format #%02x%02x%02x $r $g $b]
                }
                lappend data2 $row
            }
            set bw [image create photo]
            $bw put $data2
            return $bw
        }

* modified by Barry Skidmore


See also


gold test of inline images

Image Processing with HSV hav1 png Image Processing with HSV hav2 png Image Processing with HSV hav3 x3 png Image Processing with HSV hav4 png Image Processing with HSV hav5 png