1 |
578 |
markom |
#
|
2 |
|
|
# colors
|
3 |
|
|
# ----------------------------------------------------------------------
|
4 |
|
|
# The colors class encapsulates several color related utility functions.
|
5 |
|
|
# Class level scope resolution must be used inorder to access the static
|
6 |
|
|
# member functions.
|
7 |
|
|
#
|
8 |
|
|
# USAGE:
|
9 |
|
|
# set hsb [colors::rgbToHsb [winfo rgb . bisque]]
|
10 |
|
|
#
|
11 |
|
|
# ----------------------------------------------------------------------
|
12 |
|
|
# AUTHOR: Mark L. Ulferts EMAIL: mulferts@spd.dsccc.com
|
13 |
|
|
#
|
14 |
|
|
# @(#) $Id: colors.itcl,v 1.1.1.1 2002-01-16 10:24:50 markom Exp $
|
15 |
|
|
# ----------------------------------------------------------------------
|
16 |
|
|
# Copyright (c) 1995 Mark L. Ulferts
|
17 |
|
|
# ======================================================================
|
18 |
|
|
# Permission is hereby granted, without written agreement and without
|
19 |
|
|
# license or royalty fees, to use, copy, modify, and distribute this
|
20 |
|
|
# software and its documentation for any purpose, provided that the
|
21 |
|
|
# above copyright notice and the following two paragraphs appear in
|
22 |
|
|
# all copies of this software.
|
23 |
|
|
#
|
24 |
|
|
# IN NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE TO ANY PARTY FOR
|
25 |
|
|
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
|
26 |
|
|
# ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN
|
27 |
|
|
# IF THE COPYRIGHT HOLDER HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
|
28 |
|
|
# DAMAGE.
|
29 |
|
|
#
|
30 |
|
|
# THE COPYRIGHT HOLDER SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING,
|
31 |
|
|
# BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
|
32 |
|
|
# FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS
|
33 |
|
|
# ON AN "AS IS" BASIS, AND THE COPYRIGHT HOLDER HAS NO OBLIGATION TO
|
34 |
|
|
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
|
35 |
|
|
# ======================================================================
|
36 |
|
|
|
37 |
|
|
namespace eval iwidgets::colors {
|
38 |
|
|
|
39 |
|
|
# ------------------------------------------------------------------
|
40 |
|
|
# PROCEDURE: rgbToNumeric
|
41 |
|
|
#
|
42 |
|
|
# Returns the numeric value for a list of red, green, and blue.
|
43 |
|
|
# ------------------------------------------------------------------
|
44 |
|
|
proc rgbToNumeric {rgb} {
|
45 |
|
|
if {[llength $rgb] != 3} {
|
46 |
|
|
error "bad arg: \"$rgb\", should be list of red, green, and blue"
|
47 |
|
|
}
|
48 |
|
|
|
49 |
|
|
return [format "#%04x%04x%04x" \
|
50 |
|
|
[lindex $rgb 0] [lindex $rgb 1] [lindex $rgb 2]]
|
51 |
|
|
}
|
52 |
|
|
|
53 |
|
|
# ------------------------------------------------------------------
|
54 |
|
|
# PROCEDURE: rgbToHsb
|
55 |
|
|
#
|
56 |
|
|
# The procedure below converts an RGB value to HSB. It takes red,
|
57 |
|
|
# green, and blue components (0-65535) as arguments, and returns a
|
58 |
|
|
# list containing HSB components (floating-point, 0-1) as result.
|
59 |
|
|
# The code here is a copy of the code on page 615 of "Fundamentals
|
60 |
|
|
# of Interactive Computer Graphics" by Foley and Van Dam.
|
61 |
|
|
# ------------------------------------------------------------------
|
62 |
|
|
proc rgbToHsb {rgb} {
|
63 |
|
|
if {[llength $rgb] != 3} {
|
64 |
|
|
error "bad arg: \"$rgb\", should be list of red, green, and blue"
|
65 |
|
|
}
|
66 |
|
|
|
67 |
|
|
set r [expr [lindex $rgb 0]/65535.0]
|
68 |
|
|
set g [expr [lindex $rgb 1]/65535.0]
|
69 |
|
|
set b [expr [lindex $rgb 2]/65535.0]
|
70 |
|
|
|
71 |
|
|
set max 0
|
72 |
|
|
if {$r > $max} {set max $r}
|
73 |
|
|
if {$g > $max} {set max $g}
|
74 |
|
|
if {$b > $max} {set max $b}
|
75 |
|
|
|
76 |
|
|
set min 65535
|
77 |
|
|
if {$r < $min} {set min $r}
|
78 |
|
|
if {$g < $min} {set min $g}
|
79 |
|
|
if {$b < $min} {set min $b}
|
80 |
|
|
|
81 |
|
|
if {$max != 0} {
|
82 |
|
|
set sat [expr ($max-$min)/$max]
|
83 |
|
|
} else {
|
84 |
|
|
set sat 0
|
85 |
|
|
}
|
86 |
|
|
if {$sat == 0} {
|
87 |
|
|
set hue 0
|
88 |
|
|
} else {
|
89 |
|
|
set rc [expr ($max-$r)/($max-$min)]
|
90 |
|
|
set gc [expr ($max-$g)/($max-$min)]
|
91 |
|
|
set bc [expr ($max-$b)/($max-$min)]
|
92 |
|
|
|
93 |
|
|
if {$r == $max} {
|
94 |
|
|
set hue [expr $bc-$gc]
|
95 |
|
|
} elseif {$g == $max} {
|
96 |
|
|
set hue [expr 2+$rc-$bc]
|
97 |
|
|
} elseif {$b == $max} {
|
98 |
|
|
set hue [expr 4+$gc-$rc]
|
99 |
|
|
}
|
100 |
|
|
set hue [expr $hue*0.1666667]
|
101 |
|
|
if {$hue < 0} {set hue [expr $hue+1.0]}
|
102 |
|
|
}
|
103 |
|
|
return [list $hue $sat $max]
|
104 |
|
|
}
|
105 |
|
|
|
106 |
|
|
# ------------------------------------------------------------------
|
107 |
|
|
# PROCEDURE: hsbToRgb
|
108 |
|
|
#
|
109 |
|
|
# The procedure below converts an HSB value to RGB. It takes hue,
|
110 |
|
|
# saturation, and value components (floating-point, 0-1.0) as
|
111 |
|
|
# arguments, and returns a list containing RGB components (integers,
|
112 |
|
|
# 0-65535) as result. The code here is a copy of the code on page
|
113 |
|
|
# 616 of "Fundamentals of Interactive Computer Graphics" by Foley
|
114 |
|
|
# and Van Dam.
|
115 |
|
|
# ------------------------------------------------------------------
|
116 |
|
|
proc hsbToRgb {hsb} {
|
117 |
|
|
|
118 |
|
|
if {[llength $hsb] != 3} {
|
119 |
|
|
error "bad arg: \"$hsb\", should be list of hue, saturation, and brightness"
|
120 |
|
|
}
|
121 |
|
|
|
122 |
|
|
set hue [lindex $hsb 0]
|
123 |
|
|
set sat [lindex $hsb 1]
|
124 |
|
|
set value [lindex $hsb 2]
|
125 |
|
|
|
126 |
|
|
set v [format %.0f [expr 65535.0*$value]]
|
127 |
|
|
if {$sat == 0} {
|
128 |
|
|
return "$v $v $v"
|
129 |
|
|
} else {
|
130 |
|
|
set hue [expr $hue*6.0]
|
131 |
|
|
if {$hue >= 6.0} {
|
132 |
|
|
set hue 0.0
|
133 |
|
|
}
|
134 |
|
|
scan $hue. %d i
|
135 |
|
|
set f [expr $hue-$i]
|
136 |
|
|
set p [format %.0f [expr {65535.0*$value*(1 - $sat)}]]
|
137 |
|
|
set q [format %.0f [expr {65535.0*$value*(1 - ($sat*$f))}]]
|
138 |
|
|
set t [format %.0f [expr {65535.0*$value*(1 - ($sat*(1 - $f)))}]]
|
139 |
|
|
case $i \
|
140 |
|
|
|
141 |
|
|
1 {return "$q $v $p"} \
|
142 |
|
|
2 {return "$p $v $t"} \
|
143 |
|
|
3 {return "$p $q $v"} \
|
144 |
|
|
4 {return "$t $p $v"} \
|
145 |
|
|
5 {return "$v $p $q"}
|
146 |
|
|
error "i value $i is out of range"
|
147 |
|
|
}
|
148 |
|
|
}
|
149 |
|
|
|
150 |
|
|
# ------------------------------------------------------------------
|
151 |
|
|
#
|
152 |
|
|
# PROCEDURE: topShadow bgColor
|
153 |
|
|
#
|
154 |
|
|
# This method computes a lighter shadow variant of bgColor.
|
155 |
|
|
# It wants to decrease the saturation to 25%. But if there is
|
156 |
|
|
# no saturation (as in gray colors) it tries to turn the
|
157 |
|
|
# brightness up by 10%. It maxes the brightness at 1.0 to
|
158 |
|
|
# avoid bogus colors...
|
159 |
|
|
#
|
160 |
|
|
# bgColor is converted to HSB where the calculations are
|
161 |
|
|
# made. Then converted back to an rgb color number (hex fmt)
|
162 |
|
|
#
|
163 |
|
|
# ------------------------------------------------------------------
|
164 |
|
|
proc topShadow { bgColor } {
|
165 |
|
|
|
166 |
|
|
set hsb [rgbToHsb [winfo rgb . $bgColor]]
|
167 |
|
|
|
168 |
|
|
set saturation [lindex $hsb 1]
|
169 |
|
|
set brightness [lindex $hsb 2]
|
170 |
|
|
|
171 |
|
|
if { $brightness < 0.9 } {
|
172 |
|
|
# try turning the brightness up first.
|
173 |
|
|
set brightness [expr $brightness * 1.1]
|
174 |
|
|
} else {
|
175 |
|
|
# otherwise fiddle with saturation
|
176 |
|
|
set saturation [expr $saturation * 0.25]
|
177 |
|
|
}
|
178 |
|
|
|
179 |
|
|
set hsb [lreplace $hsb 1 1 [set saturation]]
|
180 |
|
|
set hsb [lreplace $hsb 2 2 [set brightness]]
|
181 |
|
|
|
182 |
|
|
set rgb [hsbToRgb $hsb]
|
183 |
|
|
set color [rgbToNumeric $rgb]
|
184 |
|
|
return $color
|
185 |
|
|
}
|
186 |
|
|
|
187 |
|
|
|
188 |
|
|
# ------------------------------------------------------------------
|
189 |
|
|
#
|
190 |
|
|
# PROC: bottomShadow bgColor
|
191 |
|
|
#
|
192 |
|
|
#
|
193 |
|
|
# This method computes a darker shadow variant of bg color.
|
194 |
|
|
# It takes the brightness and decreases it to 80% of its
|
195 |
|
|
# original value.
|
196 |
|
|
#
|
197 |
|
|
# bgColor is converted to HSB where the calculations are
|
198 |
|
|
# made. Then converted back to an rgb color number (hex fmt)
|
199 |
|
|
#
|
200 |
|
|
# ------------------------------------------------------------------
|
201 |
|
|
proc bottomShadow { bgColor } {
|
202 |
|
|
|
203 |
|
|
set hsb [rgbToHsb [winfo rgb . $bgColor]]
|
204 |
|
|
set hsb [lreplace $hsb 2 2 [expr [lindex $hsb 2] * 0.8]]
|
205 |
|
|
set rgb [hsbToRgb $hsb]
|
206 |
|
|
set color [rgbToNumeric $rgb]
|
207 |
|
|
return $color
|
208 |
|
|
}
|
209 |
|
|
}
|