Subversion Repositories or1k

#
# 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.1.1.1 2002-01-16 10:24:50 markom 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
        }
}