iwidgets4 4.0.1-6 / usr / share / tcltk / iwidgets4.0.1 / scripts / colors.itcl

#
# 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
	}
}