diff options
Diffstat (limited to 'iwidgets/generic/colors.itcl')
| -rw-r--r-- | iwidgets/generic/colors.itcl | 209 |
1 files changed, 209 insertions, 0 deletions
diff --git a/iwidgets/generic/colors.itcl b/iwidgets/generic/colors.itcl new file mode 100644 index 00000000000..948819d7a81 --- /dev/null +++ b/iwidgets/generic/colors.itcl @@ -0,0 +1,209 @@ +# +# 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$ +# ---------------------------------------------------------------------- +# 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 + } +} |