blob: c7b7c33de8d2a75a2e611c971efe4f0225767de1 [file] [log] [blame]
#
# 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
}
}