2 # the next line restarts using wish \
6 # This script implements a simple color editor, where you can
7 # create colors using either the RGB, HSB, or CYM color spaces
8 # and apply the color to existing applications.
10 # RCS: @(#) $Id: tcolor,v 1.4 2003/09/30 14:54:30 dkf Exp $
12 package require Tk
8.4
13 wm title .
"Color Editor"
15 # Global variables that control the program:
17 # colorSpace - Color space currently being used for
18 # editing. Must be "rgb", "cmy", or "hsb".
19 # label1, label2, label3 - Labels for the scales.
20 # red, green, blue - Current color intensities in decimal
21 # on a scale of 0-65535.
22 # color - A string giving the current color value
23 # in the proper form for x:
25 # updating - Non-zero means that we're in the middle of
26 # updating the scales to load a new color,so
27 # information shouldn't be propagating back
28 # from the scales to other elements of the
29 # program: this would make an infinite loop.
30 # command - Holds the command that has been typed
31 # into the "Command" entry.
32 # autoUpdate - 1 means execute the update command
33 # automatically whenever the color changes.
34 # name - Name for new color, typed into entry.
40 set color
#ffff00000000
45 if {$tcl_platform(platform
) eq
"unix"} {
46 option add
*Entry.background white
49 # Create the menu bar at the top of the window.
51 . configure
-menu [menu .menu
]
53 .menu add cascade
-menu .menu.
file -label File
-underline 0
54 .menu.
file add radio
-label "RGB color space" -variable colorSpace \
55 -value rgb
-underline 0 -command {changeColorSpace rgb
}
56 .menu.
file add radio
-label "CMY color space" -variable colorSpace \
57 -value cmy
-underline 0 -command {changeColorSpace cmy
}
58 .menu.
file add radio
-label "HSB color space" -variable colorSpace \
59 -value hsb
-underline 0 -command {changeColorSpace hsb
}
60 .menu.
file add separator
61 .menu.
file add radio
-label "Automatic updates" -variable autoUpdate \
63 .menu.
file add radio
-label "Manual updates" -variable autoUpdate \
65 .menu.
file add separator
66 .menu.
file add
command -label "Exit program" -underline 0 -command {exit}
68 # Create the command entry window at the bottom of the window, along
69 # with the update button.
71 labelframe .
command -text "Command:" -padx {1m
0}
72 entry .
command.e
-relief sunken
-borderwidth 2 -textvariable command \
74 button .
command.update
-text Update
-command doUpdate
75 pack .
command.update
-side right
-pady .1c
-padx {.25c
0}
76 pack .
command.e
-expand yes -fill x
-ipadx 0.25c
79 # Create the listbox that holds all of the color names in rgb.txt,
80 # if an rgb.txt file can be found.
82 grid .
command -sticky nsew
-row 2 -columnspan 3 -padx 1m
-pady {0 1m
}
84 grid columnconfigure .
{1 2} -weight 1
85 grid rowconfigure .
0 -weight 1
87 /usr
/local
/lib
/X11
/rgb.txt
/usr
/lib
/X11
/rgb.txt
88 /X11
/R
5/lib
/X11
/rgb.txt
/X11
/R
4/lib
/rgb
/rgb.txt
89 /usr
/openwin
/lib
/X11
/rgb.txt
91 if {![file readable
$i]} {
95 labelframe .names
-text "Select:" -padx .1c
-pady .1c
96 grid .names
-row 0 -column 0 -sticky nsew
-padx .15c
-pady .15c
-rowspan 2
97 grid columnconfigure .
0 -weight 1
98 listbox .names.lb
-width 20 -height 12 -yscrollcommand ".names.s set" \
99 -relief sunken
-borderwidth 2 -exportselection false
100 bind .names.lb
<Double-1
> {
101 tc_loadNamedColor
[.names.lb get
[.names.lb curselection
]]
103 scrollbar .names.s
-orient vertical
-command ".names.lb yview" \
104 -relief sunken
-borderwidth 2
105 pack .names.lb .names.s
-side left
-fill y
-expand 1
106 while {[gets
$f line
] >= 0} {
107 if {[regexp
{^\s
*\d
+\s
+\d
+\s
+\d
+\s
+(\S
+)$
} $line -> col]} {
108 .names.lb insert end
$col
115 # Create the three scales for editing the color, and the entry for
116 # typing in a color value.
120 label .adjust.l
$i -textvariable label
$i -pady 0
121 labelframe .adjust.
$i -labelwidget .adjust.l
$i -padx 1m
-pady 1m
122 scale .scale
$i -from 0 -to 1000 -length 6c
-orient horizontal \
123 -command tc_scaleChanged
124 pack .scale
$i -in .adjust.
$i
127 grid .adjust
-row 0 -column 1 -sticky nsew
-padx .15c
-pady .15c
129 labelframe .name
-text "Name:" -padx 1m
-pady 1m
130 entry .name.e
-relief sunken
-borderwidth 2 -textvariable name
-width 10 \
132 pack .name.e
-side right
-expand 1 -fill x
133 bind .name.e
<Return
> {tc_loadNamedColor
$name}
134 grid .name
-column 1 -row 1 -sticky nsew
-padx .15c
-pady .15c
136 # Create the color display swatch on the right side of the window.
138 labelframe .sample
-text "Color:" -padx 1m
-pady 1m
139 frame .sample.swatch
-width 2c
-height 5c
-background $color
140 label .sample.value
-textvariable color
-width 13 -font {Courier
12}
141 pack .sample.swatch
-side top
-expand yes -fill both
142 pack .sample.value
-side bottom
-pady .25c
143 grid .sample
-row 0 -column 2 -sticky nsew
-padx .15c
-pady .15c
-rowspan 2
146 # The procedure below is invoked when one of the scales is adjusted.
147 # It propagates color information from the current scale readings
148 # to everywhere else that it is used.
150 proc tc_scaleChanged args
{
151 global red green blue colorSpace color updating autoUpdate
157 set red
[format
%.0f
[expr {[.scale1 get
]*65.535}]]
158 set green
[format
%.0f
[expr {[.scale2 get
]*65.535}]]
159 set blue
[format
%.0f
[expr {[.scale3 get
]*65.535}]]
162 set red
[format
%.0f
[expr {65535 - [.scale1 get
]*65.535}]]
163 set green
[format
%.0f
[expr {65535 - [.scale2 get
]*65.535}]]
164 set blue
[format
%.0f
[expr {65535 - [.scale3 get
]*65.535}]]
167 set list
[hsbToRgb
[expr {[.scale1 get
]/1000.0}] \
168 [expr {[.scale2 get
]/1000.0}] \
169 [expr {[.scale3 get
]/1000.0}]]
170 set red
[lindex
$list 0]
171 set green
[lindex
$list 1]
172 set blue
[lindex
$list 2]
175 set color
[format
"#%04x%04x%04x" $red $green $blue]
176 .sample.swatch config
-bg $color
177 if {$autoUpdate} doUpdate
181 # The procedure below is invoked to update the scales from the
182 # current red, green, and blue intensities. It's invoked after
183 # a change in the color space and after a named color value has
186 proc tc_setScales
{} {
187 global red green blue colorSpace updating
191 .scale1
set [format
%.0f
[expr {$red/65.535}]]
192 .scale2
set [format
%.0f
[expr {$green/65.535}]]
193 .scale3
set [format
%.0f
[expr {$blue/65.535}]]
196 .scale1
set [format
%.0f
[expr {(65535-$red)/65.535}]]
197 .scale2
set [format
%.0f
[expr {(65535-$green)/65.535}]]
198 .scale3
set [format
%.0f
[expr {(65535-$blue)/65.535}]]
201 set list
[rgbToHsv
$red $green $blue]
202 .scale1
set [format
%.0f
[expr {[lindex
$list 0] * 1000.0}]]
203 .scale2
set [format
%.0f
[expr {[lindex
$list 1] * 1000.0}]]
204 .scale3
set [format
%.0f
[expr {[lindex
$list 2] * 1000.0}]]
210 # The procedure below is invoked when a named color has been
211 # selected from the listbox or typed into the entry. It loads
212 # the color into the editor.
214 proc tc_loadNamedColor name
{
215 global red green blue color autoUpdate
217 if {[string index
$name 0] != "#"} {
218 set list
[winfo rgb .sample.swatch
$name]
219 set red
[lindex
$list 0]
220 set green
[lindex
$list 1]
221 set blue
[lindex
$list 2]
223 switch
[string length
$name] {
224 4 {set format
"#%1x%1x%1x"; set shift 12}
225 7 {set format
"#%2x%2x%2x"; set shift 8}
226 10 {set format
"#%3x%3x%3x"; set shift 4}
227 13 {set format
"#%4x%4x%4x"; set shift 0}
228 default
{error
"syntax error in color name \"$name\""}
230 if {[scan
$name $format red green blue
] != 3} {
231 error
"syntax error in color name \"$name\""
233 set red
[expr {$red<<$shift}]
234 set green
[expr {$green<<$shift}]
235 set blue
[expr {$blue<<$shift}]
238 set color
[format
"#%04x%04x%04x" $red $green $blue]
239 .sample.swatch config
-bg $color
240 if {$autoUpdate} doUpdate
243 # The procedure below is invoked when a new color space is selected.
244 # It changes the labels on the scales and re-loads the scales with
245 # the appropriate values for the current color in the new color space
247 proc changeColorSpace space
{
248 global label1 label2 label3
251 set label1
"Adjust Red:"
252 set label2
"Adjust Green:"
253 set label3
"Adjust Blue:"
258 set label1
"Adjust Cyan:"
259 set label2
"Adjust Magenta:"
260 set label3
"Adjust Yellow:"
265 set label1
"Adjust Hue:"
266 set label2
"Adjust Saturation:"
267 set label3
"Adjust Brightness:"
274 # The procedure below converts an RGB value to HSB. It takes red, green,
275 # and blue components (0-65535) as arguments, and returns a list containing
276 # HSB components (floating-point, 0-1) as result. The code here is a copy
277 # of the code on page 615 of "Fundamentals of Interactive Computer Graphics"
278 # by Foley and Van Dam.
280 proc rgbToHsv
{red green blue
} {
282 set max
[expr {double
($red)}]
283 set min
[expr {double
($green)}]
285 set max
[expr {double
($green)}]
286 set min
[expr {double
($red)}]
289 set max
[expr {double
($blue)}]
290 } elseif
{$blue < $min} {
291 set min
[expr {double
($blue)}]
293 set range
[expr {$max-$min}]
297 set sat
[expr {($max-$min)/$max}]
302 set rc
[expr {($max - $red)/$range}]
303 set gc
[expr {($max - $green)/$range}]
304 set bc [expr {($max - $blue)/$range}]
306 set hue
[expr {($bc - $gc)/6.0}]
307 } elseif
{$green == $max} {
308 set hue
[expr {(2 + $rc - $bc)/6.0}]
310 set hue
[expr {(4 + $gc - $rc)/6.0}]
313 set hue
[expr {$hue + 1.0}]
316 return [list
$hue $sat [expr {$max/65535}]]
319 # The procedure below converts an HSB value to RGB. It takes hue, saturation,
320 # and value components (floating-point, 0-1.0) as arguments, and returns a
321 # list containing RGB components (integers, 0-65535) as result. The code
322 # here is a copy of the code on page 616 of "Fundamentals of Interactive
323 # Computer Graphics" by Foley and Van Dam.
325 proc hsbToRgb
{hue sat value
} {
326 set v
[format
%.0f
[expr {65535.0*$value}]]
330 set hue
[expr {$hue*6.0}]
335 set f
[expr {$hue-$i}]
336 set p
[format
%.0f
[expr {65535.0*$value*(1 - $sat)}]]
337 set q
[format
%.0f
[expr {65535.0*$value*(1 - ($sat*$f))}]]
338 set t
[format
%.0f
[expr {65535.0*$value*(1 - ($sat*(1 - $f)))}]]
340 0 {return "$v $t $p"}
341 1 {return "$q $v $p"}
342 2 {return "$p $v $t"}
343 3 {return "$p $q $v"}
344 4 {return "$t $p $v"}
345 5 {return "$v $p $q"}
346 default
{error
"i value $i is out of range"}
351 # The procedure below is invoked when the "Update" button is pressed,
352 # and whenever the color changes if update mode is enabled. It
353 # propagates color information as determined by the command in the
359 regsub
-all %% $command $color newCmd