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:
The -v option manipulates the brightness:
How it works
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?)