Updated 2017-12-07 13:12:55 by foo

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

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

(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]
        # fill the new image
        $image2 put $data2
        # return the new image
        return $image2
    }
}

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}]
                    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 (from above) Image Processing with HSV , headliner photos

Image Processing with HSV, image 5 listed in middle page (Original photo?)