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