[ulis], 2003-12-07. A proc to manipulate HSV components. [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. ---- '''The proc''' namespace eval ::hsv \ { namespace export hsv package require Tk proc hsv {image args} \ { # check args if {[llength $args] % 2 != 0} \ { error "wrong # args: should be \"hsv image ?-s scoef? ?-v vcoef?\"" } set vflag 0 set sflag 0 foreach {key value} $args \ { switch -glob -- $key \ { -s* \ { if {abs($value - 1.0) > 1.e-5} \ { set scoef $value; set sflag 1 } } -v* \ { if {abs($value - 1.0) > 1.e-5} \ { set vcoef $value; set vflag 1 } } default \ { error "unknown option \"$key\": should be -s or -v" } } } if {!$sflag && !$vflag} { return $image } # get the old image content set width [image width $image] set height [image height $image] if {$width * $height == 0} { error "bad image" } set data [$image data] # create corresponding planes for {set y 0} {$y < $height} {incr y} \ { set row2 {} for {set x 0} {$x < $width} {incr x} \ { foreach {r g b} [winfo rgb . [lindex $data $y $x]] break foreach c {r g b} { set $c [expr int([set $c] / 256.0)]; set _$c [set $c] } # convert to HSV 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 set delta [expr {$max - $min}] if {$max == 0 || $delta == 0} \ { set s 0 set h -1 } \ else \ { set s [expr {$delta / double($max)}] if {$r == $max} \ { set h [expr {0.0 + ($g - $b) * 60.0 / $delta}] } \ elseif {$g == $max} \ { set h [expr {120.0 + ($b - $r) * 60.0 / $delta}] } \ else \ { set h [expr {240.0 + ($r - $g) * 60.0 / $delta}] } } if {$h < 0.0} { set h [expr {$h + 360.0}] } # manipulate HSV components if {$sflag} { set s [expr {$s * $scoef}] } if {$vflag} { set v [expr {$v * $vcoef}] } # convert to RGB if {$s == 0} \ { foreach c {r g b} { set $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 list \ { {v t p} {q v p} {p v t} {p q v} {t p v} {v p q} } foreach c {r g b} u [lindex $list $i] \ { set $c [expr {int([set $u])}] if {[set $c] < 0} { set $c 0 } if {[set $c] > 255} { set $c 255 } } } lappend row2 [format #%02x%02x%02x $r $g $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''' # to download the image: # http://perso.wanadoo.fr/maurice.ulis/tcl/image5.png package require Img image create photo Photo -file image5.png namespace import ::hsv::hsv wm withdraw . set n 0 foreach args {{} {-v 0.5} {-v 1.5} {-s 0.5} {-s 1.5}} \ { set image [eval hsv Photo $args] toplevel .$n wm title .$n "hsv $args" canvas .$n.c -bd 0 -highlightt 0 .$n.c create image 0 0 -anchor nw -image $image foreach {- - width height} [.$n.c bbox all] break .$n.c config -width $width -height $height pack .$n.c bind .$n.c exit update incr n } ---- '''See also''' * [Blurring an image] * [Crisping an image] * [Expanding an image] * [Shrinking an image] ---- [Category Graphics] | [Category Image Processing] | [Category Example]