(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.
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> exitMinor AdditionI 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 SkidmoreSee also
gold test of inline images (from above) Image Processing with HSV , headliner photos
