1 |
578 |
markom |
# clrpick.tcl --
|
2 |
|
|
#
|
3 |
|
|
# Color selection dialog for platforms that do not support a
|
4 |
|
|
# standard color selection dialog.
|
5 |
|
|
#
|
6 |
|
|
# SCCS: @(#) clrpick.tcl 1.3 96/09/05 09:59:24
|
7 |
|
|
#
|
8 |
|
|
# Copyright (c) 1996 Sun Microsystems, Inc.
|
9 |
|
|
#
|
10 |
|
|
# See the file "license.terms" for information on usage and redistribution
|
11 |
|
|
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
12 |
|
|
#
|
13 |
|
|
# ToDo:
|
14 |
|
|
#
|
15 |
|
|
# (1): Find out how many free colors are left in the colormap and
|
16 |
|
|
# don't allocate too many colors.
|
17 |
|
|
# (2): Implement HSV color selection.
|
18 |
|
|
#
|
19 |
|
|
|
20 |
|
|
# tkColorDialog --
|
21 |
|
|
#
|
22 |
|
|
# Create a color dialog and let the user choose a color. This function
|
23 |
|
|
# should not be called directly. It is called by the tk_chooseColor
|
24 |
|
|
# function when a native color selector widget does not exist
|
25 |
|
|
#
|
26 |
|
|
proc tkColorDialog {args} {
|
27 |
|
|
global tkPriv
|
28 |
|
|
set w .__tk__color
|
29 |
|
|
upvar #0 $w data
|
30 |
|
|
|
31 |
|
|
# The lines variables track the start and end indices of the line
|
32 |
|
|
# elements in the colorbar canvases.
|
33 |
|
|
set data(lines,red,start) 0
|
34 |
|
|
set data(lines,red,last) -1
|
35 |
|
|
set data(lines,green,start) 0
|
36 |
|
|
set data(lines,green,last) -1
|
37 |
|
|
set data(lines,blue,start) 0
|
38 |
|
|
set data(lines,blue,last) -1
|
39 |
|
|
|
40 |
|
|
# This is the actual number of lines that are drawn in each color strip.
|
41 |
|
|
# Note that the bars may be of any width.
|
42 |
|
|
# However, NUM_COLORBARS must be a number that evenly divides 256.
|
43 |
|
|
# Such as 256, 128, 64, etc.
|
44 |
|
|
set data(NUM_COLORBARS) 8
|
45 |
|
|
|
46 |
|
|
# BARS_WIDTH is the number of pixels wide the color bar portion of the
|
47 |
|
|
# canvas is. This number must be a multiple of NUM_COLORBARS
|
48 |
|
|
set data(BARS_WIDTH) 128
|
49 |
|
|
|
50 |
|
|
# PLGN_WIDTH is the number of pixels wide of the triangular selection
|
51 |
|
|
# polygon. This also results in the definition of the padding on the
|
52 |
|
|
# left and right sides which is half of PLGN_WIDTH. Make this number even.
|
53 |
|
|
set data(PLGN_HEIGHT) 10
|
54 |
|
|
|
55 |
|
|
# PLGN_HEIGHT is the height of the selection polygon and the height of the
|
56 |
|
|
# selection rectangle at the bottom of the color bar. No restrictions.
|
57 |
|
|
set data(PLGN_WIDTH) 10
|
58 |
|
|
|
59 |
|
|
tkColorDialog_Config $w $args
|
60 |
|
|
tkColorDialog_InitValues $w
|
61 |
|
|
|
62 |
|
|
if {![winfo exists $w]} {
|
63 |
|
|
toplevel $w -class tkColorDialog
|
64 |
|
|
tkColorDialog_BuildDialog $w
|
65 |
|
|
}
|
66 |
|
|
wm transient $w $data(-parent)
|
67 |
|
|
|
68 |
|
|
|
69 |
|
|
# 5. Withdraw the window, then update all the geometry information
|
70 |
|
|
# so we know how big it wants to be, then center the window in the
|
71 |
|
|
# display and de-iconify it.
|
72 |
|
|
|
73 |
|
|
wm withdraw $w
|
74 |
|
|
update idletasks
|
75 |
|
|
set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
|
76 |
|
|
- [winfo vrootx [winfo parent $w]]}]
|
77 |
|
|
set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
|
78 |
|
|
- [winfo vrooty [winfo parent $w]]}]
|
79 |
|
|
wm geom $w +$x+$y
|
80 |
|
|
wm deiconify $w
|
81 |
|
|
wm title $w $data(-title)
|
82 |
|
|
|
83 |
|
|
# 6. Set a grab and claim the focus too.
|
84 |
|
|
|
85 |
|
|
set oldFocus [focus]
|
86 |
|
|
set oldGrab [grab current $w]
|
87 |
|
|
if {$oldGrab != ""} {
|
88 |
|
|
set grabStatus [grab status $oldGrab]
|
89 |
|
|
}
|
90 |
|
|
grab $w
|
91 |
|
|
focus $data(okBtn)
|
92 |
|
|
|
93 |
|
|
# 7. Wait for the user to respond, then restore the focus and
|
94 |
|
|
# return the index of the selected button. Restore the focus
|
95 |
|
|
# before deleting the window, since otherwise the window manager
|
96 |
|
|
# may take the focus away so we can't redirect it. Finally,
|
97 |
|
|
# restore any grab that was in effect.
|
98 |
|
|
|
99 |
|
|
tkwait variable tkPriv(selectColor)
|
100 |
|
|
catch {focus $oldFocus}
|
101 |
|
|
grab release $w
|
102 |
|
|
destroy $w
|
103 |
|
|
unset data
|
104 |
|
|
if {$oldGrab != ""} {
|
105 |
|
|
if {$grabStatus == "global"} {
|
106 |
|
|
grab -global $oldGrab
|
107 |
|
|
} else {
|
108 |
|
|
grab $oldGrab
|
109 |
|
|
}
|
110 |
|
|
}
|
111 |
|
|
return $tkPriv(selectColor)
|
112 |
|
|
}
|
113 |
|
|
|
114 |
|
|
# tkColorDialog_InitValues --
|
115 |
|
|
#
|
116 |
|
|
# Get called during initialization or when user resets NUM_COLORBARS
|
117 |
|
|
#
|
118 |
|
|
proc tkColorDialog_InitValues {w} {
|
119 |
|
|
upvar #0 $w data
|
120 |
|
|
|
121 |
|
|
# IntensityIncr is the difference in color intensity between a colorbar
|
122 |
|
|
# and its neighbors.
|
123 |
|
|
set data(intensityIncr) [expr {256 / $data(NUM_COLORBARS)}]
|
124 |
|
|
|
125 |
|
|
# ColorbarWidth is the width of each colorbar
|
126 |
|
|
set data(colorbarWidth) \
|
127 |
|
|
[expr {$data(BARS_WIDTH) / $data(NUM_COLORBARS)}]
|
128 |
|
|
|
129 |
|
|
# Indent is the width of the space at the left and right side of the
|
130 |
|
|
# colorbar. It is always half the selector polygon width, because the
|
131 |
|
|
# polygon extends into the space.
|
132 |
|
|
set data(indent) [expr {$data(PLGN_WIDTH) / 2}]
|
133 |
|
|
|
134 |
|
|
set data(colorPad) 2
|
135 |
|
|
set data(selPad) [expr {$data(PLGN_WIDTH) / 2}]
|
136 |
|
|
|
137 |
|
|
#
|
138 |
|
|
# minX is the x coordinate of the first colorbar
|
139 |
|
|
#
|
140 |
|
|
set data(minX) $data(indent)
|
141 |
|
|
|
142 |
|
|
#
|
143 |
|
|
# maxX is the x coordinate of the last colorbar
|
144 |
|
|
#
|
145 |
|
|
set data(maxX) [expr {$data(BARS_WIDTH) + $data(indent)-1}]
|
146 |
|
|
|
147 |
|
|
#
|
148 |
|
|
# canvasWidth is the width of the entire canvas, including the indents
|
149 |
|
|
#
|
150 |
|
|
set data(canvasWidth) [expr {$data(BARS_WIDTH) + \
|
151 |
|
|
$data(PLGN_WIDTH)}]
|
152 |
|
|
|
153 |
|
|
# Set the initial color, specified by -initialcolor, or the
|
154 |
|
|
# color chosen by the user the last time.
|
155 |
|
|
set data(selection) $data(-initialcolor)
|
156 |
|
|
set data(finalColor) $data(-initialcolor)
|
157 |
|
|
set rgb [winfo rgb . $data(selection)]
|
158 |
|
|
|
159 |
|
|
set data(red,intensity) [expr {[lindex $rgb 0]/0x100}]
|
160 |
|
|
set data(green,intensity) [expr {[lindex $rgb 1]/0x100}]
|
161 |
|
|
set data(blue,intensity) [expr {[lindex $rgb 2]/0x100}]
|
162 |
|
|
}
|
163 |
|
|
|
164 |
|
|
# tkColorDialog_Config --
|
165 |
|
|
#
|
166 |
|
|
# Parses the command line arguments to tk_chooseColor
|
167 |
|
|
#
|
168 |
|
|
proc tkColorDialog_Config {w argList} {
|
169 |
|
|
global tkPriv
|
170 |
|
|
upvar #0 $w data
|
171 |
|
|
|
172 |
|
|
# 1: the configuration specs
|
173 |
|
|
#
|
174 |
|
|
set specs {
|
175 |
|
|
{-initialcolor "" "" ""}
|
176 |
|
|
{-parent "" "" "."}
|
177 |
|
|
{-title "" "" "Color"}
|
178 |
|
|
}
|
179 |
|
|
|
180 |
|
|
# 2: parse the arguments
|
181 |
|
|
#
|
182 |
|
|
tclParseConfigSpec $w $specs "" $argList
|
183 |
|
|
|
184 |
|
|
if {![string compare $data(-title) ""]} {
|
185 |
|
|
set data(-title) " "
|
186 |
|
|
}
|
187 |
|
|
if {![string compare $data(-initialcolor) ""]} {
|
188 |
|
|
if {[info exists tkPriv(selectColor)] && \
|
189 |
|
|
[string compare $tkPriv(selectColor) ""]} {
|
190 |
|
|
set data(-initialcolor) $tkPriv(selectColor)
|
191 |
|
|
} else {
|
192 |
|
|
set data(-initialcolor) [. cget -background]
|
193 |
|
|
}
|
194 |
|
|
} else {
|
195 |
|
|
if {[catch {winfo rgb . $data(-initialcolor)} err]} {
|
196 |
|
|
error $err
|
197 |
|
|
}
|
198 |
|
|
}
|
199 |
|
|
|
200 |
|
|
if {![winfo exists $data(-parent)]} {
|
201 |
|
|
error "bad window path name \"$data(-parent)\""
|
202 |
|
|
}
|
203 |
|
|
}
|
204 |
|
|
|
205 |
|
|
# tkColorDialog_BuildDialog --
|
206 |
|
|
#
|
207 |
|
|
# Build the dialog.
|
208 |
|
|
#
|
209 |
|
|
proc tkColorDialog_BuildDialog {w} {
|
210 |
|
|
upvar #0 $w data
|
211 |
|
|
|
212 |
|
|
# TopFrame contains the color strips and the color selection
|
213 |
|
|
#
|
214 |
|
|
set topFrame [frame $w.top -relief raised -bd 1]
|
215 |
|
|
|
216 |
|
|
# StripsFrame contains the colorstrips and the individual RGB entries
|
217 |
|
|
set stripsFrame [frame $topFrame.colorStrip]
|
218 |
|
|
|
219 |
|
|
foreach c { Red Green Blue } {
|
220 |
|
|
set color [string tolower $c]
|
221 |
|
|
|
222 |
|
|
# each f frame contains an [R|G|B] entry and the equiv. color strip.
|
223 |
|
|
set f [frame $stripsFrame.$color]
|
224 |
|
|
|
225 |
|
|
# The box frame contains the label and entry widget for an [R|G|B]
|
226 |
|
|
set box [frame $f.box]
|
227 |
|
|
|
228 |
|
|
label $box.label -text $c: -width 6 -under 0 -anchor ne
|
229 |
|
|
entry $box.entry -textvariable [format %s $w]($color,intensity) \
|
230 |
|
|
-width 4
|
231 |
|
|
pack $box.label -side left -fill y -padx 2 -pady 3
|
232 |
|
|
pack $box.entry -side left -anchor n -pady 0
|
233 |
|
|
pack $box -side left -fill both
|
234 |
|
|
|
235 |
|
|
set height [expr \
|
236 |
|
|
{[winfo reqheight $box.entry] - \
|
237 |
|
|
2*([$box.entry cget -highlightthickness] + [$box.entry cget -bd])}]
|
238 |
|
|
|
239 |
|
|
canvas $f.color -height $height\
|
240 |
|
|
-width $data(BARS_WIDTH) -relief sunken -bd 2
|
241 |
|
|
canvas $f.sel -height $data(PLGN_HEIGHT) \
|
242 |
|
|
-width $data(canvasWidth) -highlightthickness 0
|
243 |
|
|
pack $f.color -expand yes -fill both
|
244 |
|
|
pack $f.sel -expand yes -fill both
|
245 |
|
|
|
246 |
|
|
pack $f -side top -fill x -padx 0 -pady 2
|
247 |
|
|
|
248 |
|
|
set data($color,entry) $box.entry
|
249 |
|
|
set data($color,col) $f.color
|
250 |
|
|
set data($color,sel) $f.sel
|
251 |
|
|
|
252 |
|
|
bind $data($color,col) <Configure> \
|
253 |
|
|
"tkColorDialog_DrawColorScale $w $color 1"
|
254 |
|
|
bind $data($color,col) <Enter> \
|
255 |
|
|
"tkColorDialog_EnterColorBar $w $color"
|
256 |
|
|
bind $data($color,col) <Leave> \
|
257 |
|
|
"tkColorDialog_LeaveColorBar $w $color"
|
258 |
|
|
|
259 |
|
|
bind $data($color,sel) <Enter> \
|
260 |
|
|
"tkColorDialog_EnterColorBar $w $color"
|
261 |
|
|
bind $data($color,sel) <Leave> \
|
262 |
|
|
"tkColorDialog_LeaveColorBar $w $color"
|
263 |
|
|
|
264 |
|
|
bind $box.entry <Return> "tkColorDialog_HandleRGBEntry $w"
|
265 |
|
|
}
|
266 |
|
|
|
267 |
|
|
pack $stripsFrame -side left -fill both -padx 4 -pady 10
|
268 |
|
|
|
269 |
|
|
# The selFrame contains a frame that demonstrates the currently
|
270 |
|
|
# selected color
|
271 |
|
|
#
|
272 |
|
|
set selFrame [frame $topFrame.sel]
|
273 |
|
|
set lab [label $selFrame.lab -text "Selection:" -under 0 -anchor sw]
|
274 |
|
|
set ent [entry $selFrame.ent -textvariable [format %s $w](selection) \
|
275 |
|
|
-width 16]
|
276 |
|
|
set f1 [frame $selFrame.f1 -relief sunken -bd 2]
|
277 |
|
|
set data(finalCanvas) [frame $f1.demo -bd 0 -width 100 -height 70]
|
278 |
|
|
|
279 |
|
|
pack $lab $ent -side top -fill x -padx 4 -pady 2
|
280 |
|
|
pack $f1 -expand yes -anchor nw -fill both -padx 6 -pady 10
|
281 |
|
|
pack $data(finalCanvas) -expand yes -fill both
|
282 |
|
|
|
283 |
|
|
bind $ent <Return> "tkColorDialog_HandleSelEntry $w"
|
284 |
|
|
|
285 |
|
|
pack $selFrame -side left -fill none -anchor nw
|
286 |
|
|
pack $topFrame -side top -expand yes -fill both -anchor nw
|
287 |
|
|
|
288 |
|
|
# the botFrame frame contains the buttons
|
289 |
|
|
#
|
290 |
|
|
set botFrame [frame $w.bot -relief raised -bd 1]
|
291 |
|
|
button $botFrame.ok -text OK -width 8 -under 0 \
|
292 |
|
|
-command "tkColorDialog_OkCmd $w"
|
293 |
|
|
button $botFrame.cancel -text Cancel -width 8 -under 0 \
|
294 |
|
|
-command "tkColorDialog_CancelCmd $w"
|
295 |
|
|
|
296 |
|
|
set data(okBtn) $botFrame.ok
|
297 |
|
|
set data(cancelBtn) $botFrame.cancel
|
298 |
|
|
|
299 |
|
|
pack $botFrame.ok $botFrame.cancel \
|
300 |
|
|
-padx 10 -pady 10 -expand yes -side left
|
301 |
|
|
pack $botFrame -side bottom -fill x
|
302 |
|
|
|
303 |
|
|
|
304 |
|
|
# Accelerator bindings
|
305 |
|
|
|
306 |
|
|
bind $w <Alt-r> "focus $data(red,entry)"
|
307 |
|
|
bind $w <Alt-g> "focus $data(green,entry)"
|
308 |
|
|
bind $w <Alt-b> "focus $data(blue,entry)"
|
309 |
|
|
bind $w <Alt-s> "focus $ent"
|
310 |
|
|
bind $w <KeyPress-Escape> "tkButtonInvoke $data(cancelBtn)"
|
311 |
|
|
bind $w <Alt-c> "tkButtonInvoke $data(cancelBtn)"
|
312 |
|
|
bind $w <Alt-o> "tkButtonInvoke $data(okBtn)"
|
313 |
|
|
|
314 |
|
|
wm protocol $w WM_DELETE_WINDOW "tkColorDialog_CancelCmd $w"
|
315 |
|
|
}
|
316 |
|
|
|
317 |
|
|
# tkColorDialog_SetRGBValue --
|
318 |
|
|
#
|
319 |
|
|
# Sets the current selection of the dialog box
|
320 |
|
|
#
|
321 |
|
|
proc tkColorDialog_SetRGBValue {w color} {
|
322 |
|
|
upvar #0 $w data
|
323 |
|
|
|
324 |
|
|
set data(red,intensity) [lindex $color 0]
|
325 |
|
|
set data(green,intensity) [lindex $color 1]
|
326 |
|
|
set data(blue,intensity) [lindex $color 2]
|
327 |
|
|
|
328 |
|
|
tkColorDialog_RedrawColorBars $w all
|
329 |
|
|
|
330 |
|
|
# Now compute the new x value of each colorbars pointer polygon
|
331 |
|
|
foreach color { red green blue } {
|
332 |
|
|
set x [tkColorDialog_RgbToX $w $data($color,intensity)]
|
333 |
|
|
tkColorDialog_MoveSelector $w $data($color,sel) $color $x 0
|
334 |
|
|
}
|
335 |
|
|
}
|
336 |
|
|
|
337 |
|
|
# tkColorDialog_XToRgb --
|
338 |
|
|
#
|
339 |
|
|
# Converts a screen coordinate to intensity
|
340 |
|
|
#
|
341 |
|
|
proc tkColorDialog_XToRgb {w x} {
|
342 |
|
|
upvar #0 $w data
|
343 |
|
|
|
344 |
|
|
return [expr {($x * $data(intensityIncr))/ $data(colorbarWidth)}]
|
345 |
|
|
}
|
346 |
|
|
|
347 |
|
|
# tkColorDialog_RgbToX
|
348 |
|
|
#
|
349 |
|
|
# Converts an intensity to screen coordinate.
|
350 |
|
|
#
|
351 |
|
|
proc tkColorDialog_RgbToX {w color} {
|
352 |
|
|
upvar #0 $w data
|
353 |
|
|
|
354 |
|
|
return [expr {($color * $data(colorbarWidth)/ $data(intensityIncr))}]
|
355 |
|
|
}
|
356 |
|
|
|
357 |
|
|
|
358 |
|
|
# tkColorDialog_DrawColorScale --
|
359 |
|
|
#
|
360 |
|
|
# Draw color scale is called whenever the size of one of the color
|
361 |
|
|
# scale canvases is changed.
|
362 |
|
|
#
|
363 |
|
|
proc tkColorDialog_DrawColorScale {w c {create 0}} {
|
364 |
|
|
global lines
|
365 |
|
|
upvar #0 $w data
|
366 |
|
|
|
367 |
|
|
# col: color bar canvas
|
368 |
|
|
# sel: selector canvas
|
369 |
|
|
set col $data($c,col)
|
370 |
|
|
set sel $data($c,sel)
|
371 |
|
|
|
372 |
|
|
# First handle the case that we are creating everything for the first time.
|
373 |
|
|
if {$create} {
|
374 |
|
|
# First remove all the lines that already exist.
|
375 |
|
|
if { $data(lines,$c,last) > $data(lines,$c,start)} {
|
376 |
|
|
for {set i $data(lines,$c,start)} \
|
377 |
|
|
{$i <= $data(lines,$c,last)} { incr i} {
|
378 |
|
|
$sel delete $i
|
379 |
|
|
}
|
380 |
|
|
}
|
381 |
|
|
# Delete the selector if it exists
|
382 |
|
|
if {[info exists data($c,index)]} {
|
383 |
|
|
$sel delete $data($c,index)
|
384 |
|
|
}
|
385 |
|
|
|
386 |
|
|
# Draw the selection polygons
|
387 |
|
|
tkColorDialog_CreateSelector $w $sel $c
|
388 |
|
|
$sel bind $data($c,index) <ButtonPress-1> \
|
389 |
|
|
"tkColorDialog_StartMove $w $sel $c %x $data(selPad) 1"
|
390 |
|
|
$sel bind $data($c,index) <B1-Motion> \
|
391 |
|
|
"tkColorDialog_MoveSelector $w $sel $c %x $data(selPad)"
|
392 |
|
|
$sel bind $data($c,index) <ButtonRelease-1> \
|
393 |
|
|
"tkColorDialog_ReleaseMouse $w $sel $c %x $data(selPad)"
|
394 |
|
|
|
395 |
|
|
set height [winfo height $col]
|
396 |
|
|
# Create an invisible region under the colorstrip to catch mouse clicks
|
397 |
|
|
# that aren't on the selector.
|
398 |
|
|
set data($c,clickRegion) [$sel create rectangle 0 0 \
|
399 |
|
|
$data(canvasWidth) $height -fill {} -outline {}]
|
400 |
|
|
|
401 |
|
|
bind $col <ButtonPress-1> \
|
402 |
|
|
"tkColorDialog_StartMove $w $sel $c %x $data(colorPad)"
|
403 |
|
|
bind $col <B1-Motion> \
|
404 |
|
|
"tkColorDialog_MoveSelector $w $sel $c %x $data(colorPad)"
|
405 |
|
|
bind $col <ButtonRelease-1> \
|
406 |
|
|
"tkColorDialog_ReleaseMouse $w $sel $c %x $data(colorPad)"
|
407 |
|
|
|
408 |
|
|
$sel bind $data($c,clickRegion) <ButtonPress-1> \
|
409 |
|
|
"tkColorDialog_StartMove $w $sel $c %x $data(selPad)"
|
410 |
|
|
$sel bind $data($c,clickRegion) <B1-Motion> \
|
411 |
|
|
"tkColorDialog_MoveSelector $w $sel $c %x $data(selPad)"
|
412 |
|
|
$sel bind $data($c,clickRegion) <ButtonRelease-1> \
|
413 |
|
|
"tkColorDialog_ReleaseMouse $w $sel $c %x $data(selPad)"
|
414 |
|
|
} else {
|
415 |
|
|
# l is the canvas index of the first colorbar.
|
416 |
|
|
set l $data(lines,$c,start)
|
417 |
|
|
}
|
418 |
|
|
|
419 |
|
|
# Draw the color bars.
|
420 |
|
|
set highlightW [expr \
|
421 |
|
|
{[$col cget -highlightthickness] + [$col cget -bd]}]
|
422 |
|
|
for {set i 0} { $i < $data(NUM_COLORBARS)} { incr i} {
|
423 |
|
|
set intensity [expr {$i * $data(intensityIncr)}]
|
424 |
|
|
set startx [expr {$i * $data(colorbarWidth) + $highlightW}]
|
425 |
|
|
if { $c == "red" } {
|
426 |
|
|
set color [format "#%02x%02x%02x" \
|
427 |
|
|
$intensity \
|
428 |
|
|
$data(green,intensity) \
|
429 |
|
|
$data(blue,intensity)]
|
430 |
|
|
} elseif { $c == "green" } {
|
431 |
|
|
set color [format "#%02x%02x%02x" \
|
432 |
|
|
$data(red,intensity) \
|
433 |
|
|
$intensity \
|
434 |
|
|
$data(blue,intensity)]
|
435 |
|
|
} else {
|
436 |
|
|
set color [format "#%02x%02x%02x" \
|
437 |
|
|
$data(red,intensity) \
|
438 |
|
|
$data(green,intensity) \
|
439 |
|
|
$intensity]
|
440 |
|
|
}
|
441 |
|
|
|
442 |
|
|
if {$create} {
|
443 |
|
|
set index [$col create rect $startx $highlightW \
|
444 |
|
|
[expr {$startx +$data(colorbarWidth)}] \
|
445 |
|
|
[expr {[winfo height $col] + $highlightW}]\
|
446 |
|
|
-fill $color -outline $color]
|
447 |
|
|
} else {
|
448 |
|
|
$col itemconf $l -fill $color -outline $color
|
449 |
|
|
incr l
|
450 |
|
|
}
|
451 |
|
|
}
|
452 |
|
|
$sel raise $data($c,index)
|
453 |
|
|
|
454 |
|
|
if {$create} {
|
455 |
|
|
set data(lines,$c,last) $index
|
456 |
|
|
set data(lines,$c,start) [expr {$index - $data(NUM_COLORBARS) + 1}]
|
457 |
|
|
}
|
458 |
|
|
|
459 |
|
|
tkColorDialog_RedrawFinalColor $w
|
460 |
|
|
}
|
461 |
|
|
|
462 |
|
|
# tkColorDialog_CreateSelector --
|
463 |
|
|
#
|
464 |
|
|
# Creates and draws the selector polygon at the position
|
465 |
|
|
# $data($c,intensity).
|
466 |
|
|
#
|
467 |
|
|
proc tkColorDialog_CreateSelector {w sel c } {
|
468 |
|
|
upvar #0 $w data
|
469 |
|
|
set data($c,index) [$sel create polygon \
|
470 |
|
|
|
471 |
|
|
$data(PLGN_WIDTH) $data(PLGN_HEIGHT) \
|
472 |
|
|
$data(indent) 0]
|
473 |
|
|
set data($c,x) [tkColorDialog_RgbToX $w $data($c,intensity)]
|
474 |
|
|
$sel move $data($c,index) $data($c,x) 0
|
475 |
|
|
}
|
476 |
|
|
|
477 |
|
|
# tkColorDialog_RedrawFinalColor
|
478 |
|
|
#
|
479 |
|
|
# Combines the intensities of the three colors into the final color
|
480 |
|
|
#
|
481 |
|
|
proc tkColorDialog_RedrawFinalColor {w} {
|
482 |
|
|
upvar #0 $w data
|
483 |
|
|
|
484 |
|
|
set color [format "#%02x%02x%02x" $data(red,intensity) \
|
485 |
|
|
$data(green,intensity) $data(blue,intensity)]
|
486 |
|
|
|
487 |
|
|
$data(finalCanvas) conf -bg $color
|
488 |
|
|
set data(finalColor) $color
|
489 |
|
|
set data(selection) $color
|
490 |
|
|
set data(finalRGB) [list \
|
491 |
|
|
$data(red,intensity) \
|
492 |
|
|
$data(green,intensity) \
|
493 |
|
|
$data(blue,intensity)]
|
494 |
|
|
}
|
495 |
|
|
|
496 |
|
|
# tkColorDialog_RedrawColorBars --
|
497 |
|
|
#
|
498 |
|
|
# Only redraws the colors on the color strips that were not manipulated.
|
499 |
|
|
# Params: color of colorstrip that changed. If color is not [red|green|blue]
|
500 |
|
|
# Then all colorstrips will be updated
|
501 |
|
|
#
|
502 |
|
|
proc tkColorDialog_RedrawColorBars {w colorChanged} {
|
503 |
|
|
upvar #0 $w data
|
504 |
|
|
|
505 |
|
|
switch $colorChanged {
|
506 |
|
|
red {
|
507 |
|
|
tkColorDialog_DrawColorScale $w green
|
508 |
|
|
tkColorDialog_DrawColorScale $w blue
|
509 |
|
|
}
|
510 |
|
|
green {
|
511 |
|
|
tkColorDialog_DrawColorScale $w red
|
512 |
|
|
tkColorDialog_DrawColorScale $w blue
|
513 |
|
|
}
|
514 |
|
|
blue {
|
515 |
|
|
tkColorDialog_DrawColorScale $w red
|
516 |
|
|
tkColorDialog_DrawColorScale $w green
|
517 |
|
|
}
|
518 |
|
|
default {
|
519 |
|
|
tkColorDialog_DrawColorScale $w red
|
520 |
|
|
tkColorDialog_DrawColorScale $w green
|
521 |
|
|
tkColorDialog_DrawColorScale $w blue
|
522 |
|
|
}
|
523 |
|
|
}
|
524 |
|
|
tkColorDialog_RedrawFinalColor $w
|
525 |
|
|
}
|
526 |
|
|
|
527 |
|
|
#----------------------------------------------------------------------
|
528 |
|
|
# Event handlers
|
529 |
|
|
#----------------------------------------------------------------------
|
530 |
|
|
|
531 |
|
|
# tkColorDialog_StartMove --
|
532 |
|
|
#
|
533 |
|
|
# Handles a mousedown button event over the selector polygon.
|
534 |
|
|
# Adds the bindings for moving the mouse while the button is
|
535 |
|
|
# pressed. Sets the binding for the button-release event.
|
536 |
|
|
#
|
537 |
|
|
# Params: sel is the selector canvas window, color is the color of the strip.
|
538 |
|
|
#
|
539 |
|
|
proc tkColorDialog_StartMove {w sel color x delta {dontMove 0}} {
|
540 |
|
|
upvar #0 $w data
|
541 |
|
|
|
542 |
|
|
if {!$dontMove} {
|
543 |
|
|
tkColorDialog_MoveSelector $w $sel $color $x $delta
|
544 |
|
|
}
|
545 |
|
|
}
|
546 |
|
|
|
547 |
|
|
# tkColorDialog_MoveSelector --
|
548 |
|
|
#
|
549 |
|
|
# Moves the polygon selector so that its middle point has the same
|
550 |
|
|
# x value as the specified x. If x is outside the bounds [0,255],
|
551 |
|
|
# the selector is set to the closest endpoint.
|
552 |
|
|
#
|
553 |
|
|
# Params: sel is the selector canvas, c is [red|green|blue]
|
554 |
|
|
# x is a x-coordinate.
|
555 |
|
|
#
|
556 |
|
|
proc tkColorDialog_MoveSelector {w sel color x delta} {
|
557 |
|
|
upvar #0 $w data
|
558 |
|
|
|
559 |
|
|
incr x -$delta
|
560 |
|
|
|
561 |
|
|
if { $x < 0 } {
|
562 |
|
|
set x 0
|
563 |
|
|
} elseif { $x >= $data(BARS_WIDTH)} {
|
564 |
|
|
set x [expr {$data(BARS_WIDTH) - 1}]
|
565 |
|
|
}
|
566 |
|
|
set diff [expr {$x - $data($color,x)}]
|
567 |
|
|
$sel move $data($color,index) $diff 0
|
568 |
|
|
set data($color,x) [expr {$data($color,x) + $diff}]
|
569 |
|
|
|
570 |
|
|
# Return the x value that it was actually set at
|
571 |
|
|
return $x
|
572 |
|
|
}
|
573 |
|
|
|
574 |
|
|
# tkColorDialog_ReleaseMouse
|
575 |
|
|
#
|
576 |
|
|
# Removes mouse tracking bindings, updates the colorbars.
|
577 |
|
|
#
|
578 |
|
|
# Params: sel is the selector canvas, color is the color of the strip,
|
579 |
|
|
# x is the x-coord of the mouse.
|
580 |
|
|
#
|
581 |
|
|
proc tkColorDialog_ReleaseMouse {w sel color x delta} {
|
582 |
|
|
upvar #0 $w data
|
583 |
|
|
|
584 |
|
|
set x [tkColorDialog_MoveSelector $w $sel $color $x $delta]
|
585 |
|
|
|
586 |
|
|
# Determine exactly what color we are looking at.
|
587 |
|
|
set data($color,intensity) [tkColorDialog_XToRgb $w $x]
|
588 |
|
|
|
589 |
|
|
tkColorDialog_RedrawColorBars $w $color
|
590 |
|
|
}
|
591 |
|
|
|
592 |
|
|
# tkColorDialog_ResizeColorbars --
|
593 |
|
|
#
|
594 |
|
|
# Completely redraws the colorbars, including resizing the
|
595 |
|
|
# colorstrips
|
596 |
|
|
#
|
597 |
|
|
proc tkColorDialog_ResizeColorBars {w} {
|
598 |
|
|
upvar #0 $w data
|
599 |
|
|
|
600 |
|
|
if { ($data(BARS_WIDTH) < $data(NUM_COLORBARS)) ||
|
601 |
|
|
(($data(BARS_WIDTH) % $data(NUM_COLORBARS)) != 0)} {
|
602 |
|
|
set data(BARS_WIDTH) $data(NUM_COLORBARS)
|
603 |
|
|
}
|
604 |
|
|
tkColorDialog_InitValues $w
|
605 |
|
|
foreach color { red green blue } {
|
606 |
|
|
$data($color,col) conf -width $data(canvasWidth)
|
607 |
|
|
tkColorDialog_DrawColorScale $w $color 1
|
608 |
|
|
}
|
609 |
|
|
}
|
610 |
|
|
|
611 |
|
|
# tkColorDialog_HandleSelEntry --
|
612 |
|
|
#
|
613 |
|
|
# Handles the return keypress event in the "Selection:" entry
|
614 |
|
|
#
|
615 |
|
|
proc tkColorDialog_HandleSelEntry {w} {
|
616 |
|
|
upvar #0 $w data
|
617 |
|
|
|
618 |
|
|
set text [string trim $data(selection)]
|
619 |
|
|
# Check to make sure that the color is valid
|
620 |
|
|
if {[catch {set color [winfo rgb . $text]} ]} {
|
621 |
|
|
set data(selection) $data(finalColor)
|
622 |
|
|
return
|
623 |
|
|
}
|
624 |
|
|
|
625 |
|
|
set R [expr {[lindex $color 0]/0x100}]
|
626 |
|
|
set G [expr {[lindex $color 1]/0x100}]
|
627 |
|
|
set B [expr {[lindex $color 2]/0x100}]
|
628 |
|
|
|
629 |
|
|
tkColorDialog_SetRGBValue $w "$R $G $B"
|
630 |
|
|
set data(selection) $text
|
631 |
|
|
}
|
632 |
|
|
|
633 |
|
|
# tkColorDialog_HandleRGBEntry --
|
634 |
|
|
#
|
635 |
|
|
# Handles the return keypress event in the R, G or B entry
|
636 |
|
|
#
|
637 |
|
|
proc tkColorDialog_HandleRGBEntry {w} {
|
638 |
|
|
upvar #0 $w data
|
639 |
|
|
|
640 |
|
|
foreach c {red green blue} {
|
641 |
|
|
if {[catch {
|
642 |
|
|
set data($c,intensity) [expr {int($data($c,intensity))}]
|
643 |
|
|
}]} {
|
644 |
|
|
set data($c,intensity) 0
|
645 |
|
|
}
|
646 |
|
|
|
647 |
|
|
if {$data($c,intensity) < 0} {
|
648 |
|
|
set data($c,intensity) 0
|
649 |
|
|
}
|
650 |
|
|
if {$data($c,intensity) > 255} {
|
651 |
|
|
set data($c,intensity) 255
|
652 |
|
|
}
|
653 |
|
|
}
|
654 |
|
|
|
655 |
|
|
tkColorDialog_SetRGBValue $w "$data(red,intensity) $data(green,intensity) \
|
656 |
|
|
$data(blue,intensity)"
|
657 |
|
|
}
|
658 |
|
|
|
659 |
|
|
# mouse cursor enters a color bar
|
660 |
|
|
#
|
661 |
|
|
proc tkColorDialog_EnterColorBar {w color} {
|
662 |
|
|
upvar #0 $w data
|
663 |
|
|
|
664 |
|
|
$data($color,sel) itemconfig $data($color,index) -fill red
|
665 |
|
|
}
|
666 |
|
|
|
667 |
|
|
# mouse leaves enters a color bar
|
668 |
|
|
#
|
669 |
|
|
proc tkColorDialog_LeaveColorBar {w color} {
|
670 |
|
|
upvar #0 $w data
|
671 |
|
|
|
672 |
|
|
$data($color,sel) itemconfig $data($color,index) -fill black
|
673 |
|
|
}
|
674 |
|
|
|
675 |
|
|
# user hits OK button
|
676 |
|
|
#
|
677 |
|
|
proc tkColorDialog_OkCmd {w} {
|
678 |
|
|
global tkPriv
|
679 |
|
|
upvar #0 $w data
|
680 |
|
|
|
681 |
|
|
set tkPriv(selectColor) $data(finalColor)
|
682 |
|
|
}
|
683 |
|
|
|
684 |
|
|
# user hits Cancel button
|
685 |
|
|
#
|
686 |
|
|
proc tkColorDialog_CancelCmd {w} {
|
687 |
|
|
global tkPriv
|
688 |
|
|
|
689 |
|
|
set tkPriv(selectColor) ""
|
690 |
|
|
}
|
691 |
|
|
|