| # |
| # colors |
| # ---------------------------------------------------------------------- |
| # The colors class encapsulates several color related utility functions. |
| # Class level scope resolution must be used inorder to access the static |
| # member functions. |
| # |
| # USAGE: |
| # set hsb [colors::rgbToHsb [winfo rgb . bisque]] |
| # |
| # ---------------------------------------------------------------------- |
| # AUTHOR: Mark L. Ulferts EMAIL: mulferts@spd.dsccc.com |
| # |
| # @(#) $Id: colors.itcl,v 1.2 2001/08/15 18:33:55 smithc Exp $ |
| # ---------------------------------------------------------------------- |
| # Copyright (c) 1995 Mark L. Ulferts |
| # ====================================================================== |
| # Permission is hereby granted, without written agreement and without |
| # license or royalty fees, to use, copy, modify, and distribute this |
| # software and its documentation for any purpose, provided that the |
| # above copyright notice and the following two paragraphs appear in |
| # all copies of this software. |
| # |
| # IN NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE TO ANY PARTY FOR |
| # DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES |
| # ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN |
| # IF THE COPYRIGHT HOLDER HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH |
| # DAMAGE. |
| # |
| # THE COPYRIGHT HOLDER SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING, |
| # BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND |
| # FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS |
| # ON AN "AS IS" BASIS, AND THE COPYRIGHT HOLDER HAS NO OBLIGATION TO |
| # PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. |
| # ====================================================================== |
| |
| namespace eval iwidgets::colors { |
| |
| # ------------------------------------------------------------------ |
| # PROCEDURE: rgbToNumeric |
| # |
| # Returns the numeric value for a list of red, green, and blue. |
| # ------------------------------------------------------------------ |
| proc rgbToNumeric {rgb} { |
| if {[llength $rgb] != 3} { |
| error "bad arg: \"$rgb\", should be list of red, green, and blue" |
| } |
| |
| return [format "#%04x%04x%04x" \ |
| [lindex $rgb 0] [lindex $rgb 1] [lindex $rgb 2]] |
| } |
| |
| # ------------------------------------------------------------------ |
| # PROCEDURE: rgbToHsb |
| # |
| # The procedure below converts an RGB value to HSB. It takes red, |
| # green, and blue components (0-65535) as arguments, and returns a |
| # list containing HSB components (floating-point, 0-1) as result. |
| # The code here is a copy of the code on page 615 of "Fundamentals |
| # of Interactive Computer Graphics" by Foley and Van Dam. |
| # ------------------------------------------------------------------ |
| proc rgbToHsb {rgb} { |
| if {[llength $rgb] != 3} { |
| error "bad arg: \"$rgb\", should be list of red, green, and blue" |
| } |
| |
| set r [expr {[lindex $rgb 0]/65535.0}] |
| set g [expr {[lindex $rgb 1]/65535.0}] |
| set b [expr {[lindex $rgb 2]/65535.0}] |
| |
| set max 0 |
| if {$r > $max} {set max $r} |
| if {$g > $max} {set max $g} |
| if {$b > $max} {set max $b} |
| |
| set min 65535 |
| if {$r < $min} {set min $r} |
| if {$g < $min} {set min $g} |
| if {$b < $min} {set min $b} |
| |
| if {$max != 0} { |
| set sat [expr {($max-$min)/$max}] |
| } else { |
| set sat 0 |
| } |
| if {$sat == 0} { |
| set hue 0 |
| } else { |
| set rc [expr {($max-$r)/($max-$min)}] |
| set gc [expr {($max-$g)/($max-$min)}] |
| set bc [expr {($max-$b)/($max-$min)}] |
| |
| if {$r == $max} { |
| set hue [expr {$bc-$gc}] |
| } elseif {$g == $max} { |
| set hue [expr {2+$rc-$bc}] |
| } elseif {$b == $max} { |
| set hue [expr {4+$gc-$rc}] |
| } |
| set hue [expr {$hue*0.1666667}] |
| if {$hue < 0} {set hue [expr {$hue+1.0}]} |
| } |
| return [list $hue $sat $max] |
| } |
| |
| # ------------------------------------------------------------------ |
| # PROCEDURE: hsbToRgb |
| # |
| # The procedure below converts an HSB value to RGB. It takes hue, |
| # saturation, and value components (floating-point, 0-1.0) as |
| # arguments, and returns a list containing RGB components (integers, |
| # 0-65535) as result. The code here is a copy of the code on page |
| # 616 of "Fundamentals of Interactive Computer Graphics" by Foley |
| # and Van Dam. |
| # ------------------------------------------------------------------ |
| proc hsbToRgb {hsb} { |
| |
| if {[llength $hsb] != 3} { |
| error "bad arg: \"$hsb\", should be list of hue, saturation, and brightness" |
| } |
| |
| set hue [lindex $hsb 0] |
| set sat [lindex $hsb 1] |
| set value [lindex $hsb 2] |
| |
| set v [format %.0f [expr {65535.0*$value}]] |
| if {$sat == 0} { |
| return "$v $v $v" |
| } else { |
| set hue [expr {$hue*6.0}] |
| if {$hue >= 6.0} { |
| set hue 0.0 |
| } |
| scan $hue. %d i |
| set f [expr {$hue-$i}] |
| set p [format %.0f [expr {65535.0*$value*(1 - $sat)}]] |
| set q [format %.0f [expr {65535.0*$value*(1 - ($sat*$f))}]] |
| set t [format %.0f [expr {65535.0*$value*(1 - ($sat*(1 - $f)))}]] |
| case $i \ |
| 0 {return "$v $t $p"} \ |
| 1 {return "$q $v $p"} \ |
| 2 {return "$p $v $t"} \ |
| 3 {return "$p $q $v"} \ |
| 4 {return "$t $p $v"} \ |
| 5 {return "$v $p $q"} |
| error "i value $i is out of range" |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # |
| # PROCEDURE: topShadow bgColor |
| # |
| # This method computes a lighter shadow variant of bgColor. |
| # It wants to decrease the saturation to 25%. But if there is |
| # no saturation (as in gray colors) it tries to turn the |
| # brightness up by 10%. It maxes the brightness at 1.0 to |
| # avoid bogus colors... |
| # |
| # bgColor is converted to HSB where the calculations are |
| # made. Then converted back to an rgb color number (hex fmt) |
| # |
| # ------------------------------------------------------------------ |
| proc topShadow { bgColor } { |
| |
| set hsb [rgbToHsb [winfo rgb . $bgColor]] |
| |
| set saturation [lindex $hsb 1] |
| set brightness [lindex $hsb 2] |
| |
| if { $brightness < 0.9 } { |
| # try turning the brightness up first. |
| set brightness [expr {$brightness * 1.1}] |
| } else { |
| # otherwise fiddle with saturation |
| set saturation [expr {$saturation * 0.25}] |
| } |
| |
| set hsb [lreplace $hsb 1 1 [set saturation]] |
| set hsb [lreplace $hsb 2 2 [set brightness]] |
| |
| set rgb [hsbToRgb $hsb] |
| set color [rgbToNumeric $rgb] |
| return $color |
| } |
| |
| |
| # ------------------------------------------------------------------ |
| # |
| # PROC: bottomShadow bgColor |
| # |
| # |
| # This method computes a darker shadow variant of bg color. |
| # It takes the brightness and decreases it to 80% of its |
| # original value. |
| # |
| # bgColor is converted to HSB where the calculations are |
| # made. Then converted back to an rgb color number (hex fmt) |
| # |
| # ------------------------------------------------------------------ |
| proc bottomShadow { bgColor } { |
| |
| set hsb [rgbToHsb [winfo rgb . $bgColor]] |
| set hsb [lreplace $hsb 2 2 [expr {[lindex $hsb 2] * 0.8}]] |
| set rgb [hsbToRgb $hsb] |
| set color [rgbToNumeric $rgb] |
| return $color |
| } |
| } |