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 \

                    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

        }

}