Updated 2010-07-16 23:21:15 by AK

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
  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" }
      # 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} [$image get $x $y] break
          # 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 <Destroy> exit
    update
    incr n
  }

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