3 # Color selection dialog for platforms that do not support a
4 # standard color selection dialog.
8 # Copyright (c) 1996 Sun Microsystems, Inc.
10 # See the file "license.terms" for information on usage and redistribution
11 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
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.
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
26 proc tkColorDialog {args} {
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
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
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
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
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
59 tkColorDialog_Config $w $args
60 tkColorDialog_InitValues $w
62 set sc [winfo screen $data(-parent)]
63 set winExists [winfo exists $w]
64 if {!$winExists || [string compare $sc [winfo screen $w]]} {
68 toplevel $w -class tkColorDialog -screen $sc
69 tkColorDialog_BuildDialog $w
72 wm transient $w $data(-parent)
74 # 5. Withdraw the window, then update all the geometry information
75 # so we know how big it wants to be, then center the window in the
76 # display and de-iconify it.
78 ::tk::PlaceWindow $w widget $data(-parent)
79 wm title $w $data(-title)
81 # 6. Set a grab and claim the focus too.
83 ::tk::SetFocusGrab $w $data(okBtn)
85 # 7. Wait for the user to respond, then restore the focus and
86 # return the index of the selected button. Restore the focus
87 # before deleting the window, since otherwise the window manager
88 # may take the focus away so we can't redirect it. Finally,
89 # restore any grab that was in effect.
91 vwait tkPriv(selectColor)
92 ::tk::RestoreFocusGrab $w $data(okBtn)
95 return $tkPriv(selectColor)
98 # tkColorDialog_InitValues --
100 # Get called during initialization or when user resets NUM_COLORBARS
102 proc tkColorDialog_InitValues {w} {
105 # IntensityIncr is the difference in color intensity between a colorbar
107 set data(intensityIncr) [expr {256 / $data(NUM_COLORBARS)}]
109 # ColorbarWidth is the width of each colorbar
110 set data(colorbarWidth) \
111 [expr {$data(BARS_WIDTH) / $data(NUM_COLORBARS)}]
113 # Indent is the width of the space at the left and right side of the
114 # colorbar. It is always half the selector polygon width, because the
115 # polygon extends into the space.
116 set data(indent) [expr {$data(PLGN_WIDTH) / 2}]
119 set data(selPad) [expr {$data(PLGN_WIDTH) / 2}]
122 # minX is the x coordinate of the first colorbar
124 set data(minX) $data(indent)
127 # maxX is the x coordinate of the last colorbar
129 set data(maxX) [expr {$data(BARS_WIDTH) + $data(indent)-1}]
132 # canvasWidth is the width of the entire canvas, including the indents
134 set data(canvasWidth) [expr {$data(BARS_WIDTH) + $data(PLGN_WIDTH)}]
136 # Set the initial color, specified by -initialcolor, or the
137 # color chosen by the user the last time.
138 set data(selection) $data(-initialcolor)
139 set data(finalColor) $data(-initialcolor)
140 set rgb [winfo rgb . $data(selection)]
142 set data(red,intensity) [expr {[lindex $rgb 0]/0x100}]
143 set data(green,intensity) [expr {[lindex $rgb 1]/0x100}]
144 set data(blue,intensity) [expr {[lindex $rgb 2]/0x100}]
147 # tkColorDialog_Config --
149 # Parses the command line arguments to tk_chooseColor
151 proc tkColorDialog_Config {w argList} {
155 # 1: the configuration specs
157 if {[info exists tkPriv(selectColor)] && \
158 [string compare $tkPriv(selectColor) ""]} {
159 set defaultColor $tkPriv(selectColor)
161 set defaultColor [. cget -background]
165 [list -initialcolor "" "" $defaultColor] \
166 [list -parent "" "" "."] \
167 [list -title "" "" "Color"] \
170 # 2: parse the arguments
172 tclParseConfigSpec $w $specs "" $argList
174 if {[string equal $data(-title) ""]} {
177 if {[catch {winfo rgb . $data(-initialcolor)} err]} {
181 if {![winfo exists $data(-parent)]} {
182 error "bad window path name \"$data(-parent)\""
186 # tkColorDialog_BuildDialog --
190 proc tkColorDialog_BuildDialog {w} {
193 # TopFrame contains the color strips and the color selection
195 set topFrame [frame $w.top -relief raised -bd 1]
197 # StripsFrame contains the colorstrips and the individual RGB entries
198 set stripsFrame [frame $topFrame.colorStrip]
200 foreach c { Red Green Blue } {
201 set color [string tolower $c]
203 # each f frame contains an [R|G|B] entry and the equiv. color strip.
204 set f [frame $stripsFrame.$color]
206 # The box frame contains the label and entry widget for an [R|G|B]
207 set box [frame $f.box]
209 label $box.label -text $c: -width 6 -under 0 -anchor ne
210 entry $box.entry -textvariable [format %s $w]($color,intensity) \
212 pack $box.label -side left -fill y -padx 2 -pady 3
213 pack $box.entry -side left -anchor n -pady 0
214 pack $box -side left -fill both
217 {[winfo reqheight $box.entry] - \
218 2*([$box.entry cget -highlightthickness] + [$box.entry cget -bd])}]
220 canvas $f.color -height $height\
221 -width $data(BARS_WIDTH) -relief sunken -bd 2
222 canvas $f.sel -height $data(PLGN_HEIGHT) \
223 -width $data(canvasWidth) -highlightthickness 0
224 pack $f.color -expand yes -fill both
225 pack $f.sel -expand yes -fill both
227 pack $f -side top -fill x -padx 0 -pady 2
229 set data($color,entry) $box.entry
230 set data($color,col) $f.color
231 set data($color,sel) $f.sel
233 bind $data($color,col) <Configure> \
234 [list tkColorDialog_DrawColorScale $w $color 1]
235 bind $data($color,col) <Enter> \
236 [list tkColorDialog_EnterColorBar $w $color]
237 bind $data($color,col) <Leave> \
238 [list tkColorDialog_LeaveColorBar $w $color]
240 bind $data($color,sel) <Enter> \
241 [list tkColorDialog_EnterColorBar $w $color]
242 bind $data($color,sel) <Leave> \
243 [list tkColorDialog_LeaveColorBar $w $color]
245 bind $box.entry <Return> [list tkColorDialog_HandleRGBEntry $w]
248 pack $stripsFrame -side left -fill both -padx 4 -pady 10
250 # The selFrame contains a frame that demonstrates the currently
253 set selFrame [frame $topFrame.sel]
254 set lab [label $selFrame.lab -text "Selection:" -under 0 -anchor sw]
255 set ent [entry $selFrame.ent -textvariable [format %s $w](selection) \
257 set f1 [frame $selFrame.f1 -relief sunken -bd 2]
258 set data(finalCanvas) [frame $f1.demo -bd 0 -width 100 -height 70]
260 pack $lab $ent -side top -fill x -padx 4 -pady 2
261 pack $f1 -expand yes -anchor nw -fill both -padx 6 -pady 10
262 pack $data(finalCanvas) -expand yes -fill both
264 bind $ent <Return> [list tkColorDialog_HandleSelEntry $w]
266 pack $selFrame -side left -fill none -anchor nw
267 pack $topFrame -side top -expand yes -fill both -anchor nw
269 # the botFrame frame contains the buttons
271 set botFrame [frame $w.bot -relief raised -bd 1]
272 button $botFrame.ok -text OK -width 8 -under 0 \
273 -command [list tkColorDialog_OkCmd $w]
274 button $botFrame.cancel -text Cancel -width 8 -under 0 \
275 -command [list tkColorDialog_CancelCmd $w]
277 set data(okBtn) $botFrame.ok
278 set data(cancelBtn) $botFrame.cancel
280 pack $botFrame.ok $botFrame.cancel \
281 -padx 10 -pady 10 -expand yes -side left
282 pack $botFrame -side bottom -fill x
285 # Accelerator bindings
287 bind $w <Alt-r> [list focus $data(red,entry)]
288 bind $w <Alt-g> [list focus $data(green,entry)]
289 bind $w <Alt-b> [list focus $data(blue,entry)]
290 bind $w <Alt-s> [list focus $ent]
291 bind $w <KeyPress-Escape> [list tkButtonInvoke $data(cancelBtn)]
292 bind $w <Alt-c> [list tkButtonInvoke $data(cancelBtn)]
293 bind $w <Alt-o> [list tkButtonInvoke $data(okBtn)]
295 wm protocol $w WM_DELETE_WINDOW [list tkColorDialog_CancelCmd $w]
298 # tkColorDialog_SetRGBValue --
300 # Sets the current selection of the dialog box
302 proc tkColorDialog_SetRGBValue {w color} {
305 set data(red,intensity) [lindex $color 0]
306 set data(green,intensity) [lindex $color 1]
307 set data(blue,intensity) [lindex $color 2]
309 tkColorDialog_RedrawColorBars $w all
311 # Now compute the new x value of each colorbars pointer polygon
312 foreach color { red green blue } {
313 set x [tkColorDialog_RgbToX $w $data($color,intensity)]
314 tkColorDialog_MoveSelector $w $data($color,sel) $color $x 0
318 # tkColorDialog_XToRgb --
320 # Converts a screen coordinate to intensity
322 proc tkColorDialog_XToRgb {w x} {
325 return [expr {($x * $data(intensityIncr))/ $data(colorbarWidth)}]
328 # tkColorDialog_RgbToX
330 # Converts an intensity to screen coordinate.
332 proc tkColorDialog_RgbToX {w color} {
335 return [expr {($color * $data(colorbarWidth)/ $data(intensityIncr))}]
339 # tkColorDialog_DrawColorScale --
341 # Draw color scale is called whenever the size of one of the color
342 # scale canvases is changed.
344 proc tkColorDialog_DrawColorScale {w c {create 0}} {
348 # col: color bar canvas
349 # sel: selector canvas
350 set col $data($c,col)
351 set sel $data($c,sel)
353 # First handle the case that we are creating everything for the first time.
355 # First remove all the lines that already exist.
356 if { $data(lines,$c,last) > $data(lines,$c,start)} {
357 for {set i $data(lines,$c,start)} \
358 {$i <= $data(lines,$c,last)} { incr i} {
362 # Delete the selector if it exists
363 if {[info exists data($c,index)]} {
364 $sel delete $data($c,index)
367 # Draw the selection polygons
368 tkColorDialog_CreateSelector $w $sel $c
369 $sel bind $data($c,index) <ButtonPress-1> \
370 [list tkColorDialog_StartMove $w $sel $c %x $data(selPad) 1]
371 $sel bind $data($c,index) <B1-Motion> \
372 [list tkColorDialog_MoveSelector $w $sel $c %x $data(selPad)]
373 $sel bind $data($c,index) <ButtonRelease-1> \
374 [list tkColorDialog_ReleaseMouse $w $sel $c %x $data(selPad)]
376 set height [winfo height $col]
377 # Create an invisible region under the colorstrip to catch mouse clicks
378 # that aren't on the selector.
379 set data($c,clickRegion) [$sel create rectangle 0 0 \
380 $data(canvasWidth) $height -fill {} -outline {}]
382 bind $col <ButtonPress-1> \
383 [list tkColorDialog_StartMove $w $sel $c %x $data(colorPad)]
384 bind $col <B1-Motion> \
385 [list tkColorDialog_MoveSelector $w $sel $c %x $data(colorPad)]
386 bind $col <ButtonRelease-1> \
387 [list tkColorDialog_ReleaseMouse $w $sel $c %x $data(colorPad)]
389 $sel bind $data($c,clickRegion) <ButtonPress-1> \
390 [list tkColorDialog_StartMove $w $sel $c %x $data(selPad)]
391 $sel bind $data($c,clickRegion) <B1-Motion> \
392 [list tkColorDialog_MoveSelector $w $sel $c %x $data(selPad)]
393 $sel bind $data($c,clickRegion) <ButtonRelease-1> \
394 [list tkColorDialog_ReleaseMouse $w $sel $c %x $data(selPad)]
396 # l is the canvas index of the first colorbar.
397 set l $data(lines,$c,start)
400 # Draw the color bars.
401 set highlightW [expr {[$col cget -highlightthickness] + [$col cget -bd]}]
402 for {set i 0} { $i < $data(NUM_COLORBARS)} { incr i} {
403 set intensity [expr {$i * $data(intensityIncr)}]
404 set startx [expr {$i * $data(colorbarWidth) + $highlightW}]
405 if {[string equal $c "red"]} {
406 set color [format "#%02x%02x%02x" \
408 $data(green,intensity) \
409 $data(blue,intensity)]
410 } elseif {[string equal $c "green"]} {
411 set color [format "#%02x%02x%02x" \
412 $data(red,intensity) \
414 $data(blue,intensity)]
416 set color [format "#%02x%02x%02x" \
417 $data(red,intensity) \
418 $data(green,intensity) \
423 set index [$col create rect $startx $highlightW \
424 [expr {$startx +$data(colorbarWidth)}] \
425 [expr {[winfo height $col] + $highlightW}]\
426 -fill $color -outline $color]
428 $col itemconfigure $l -fill $color -outline $color
432 $sel raise $data($c,index)
435 set data(lines,$c,last) $index
436 set data(lines,$c,start) [expr {$index - $data(NUM_COLORBARS) + 1}]
439 tkColorDialog_RedrawFinalColor $w
442 # tkColorDialog_CreateSelector --
444 # Creates and draws the selector polygon at the position
445 # $data($c,intensity).
447 proc tkColorDialog_CreateSelector {w sel c } {
449 set data($c,index) [$sel create polygon \
450 0 $data(PLGN_HEIGHT) \
451 $data(PLGN_WIDTH) $data(PLGN_HEIGHT) \
453 set data($c,x) [tkColorDialog_RgbToX $w $data($c,intensity)]
454 $sel move $data($c,index) $data($c,x) 0
457 # tkColorDialog_RedrawFinalColor
459 # Combines the intensities of the three colors into the final color
461 proc tkColorDialog_RedrawFinalColor {w} {
464 set color [format "#%02x%02x%02x" $data(red,intensity) \
465 $data(green,intensity) $data(blue,intensity)]
467 $data(finalCanvas) configure -bg $color
468 set data(finalColor) $color
469 set data(selection) $color
470 set data(finalRGB) [list \
471 $data(red,intensity) \
472 $data(green,intensity) \
473 $data(blue,intensity)]
476 # tkColorDialog_RedrawColorBars --
478 # Only redraws the colors on the color strips that were not manipulated.
479 # Params: color of colorstrip that changed. If color is not [red|green|blue]
480 # Then all colorstrips will be updated
482 proc tkColorDialog_RedrawColorBars {w colorChanged} {
485 switch $colorChanged {
487 tkColorDialog_DrawColorScale $w green
488 tkColorDialog_DrawColorScale $w blue
491 tkColorDialog_DrawColorScale $w red
492 tkColorDialog_DrawColorScale $w blue
495 tkColorDialog_DrawColorScale $w red
496 tkColorDialog_DrawColorScale $w green
499 tkColorDialog_DrawColorScale $w red
500 tkColorDialog_DrawColorScale $w green
501 tkColorDialog_DrawColorScale $w blue
504 tkColorDialog_RedrawFinalColor $w
507 #----------------------------------------------------------------------
509 #----------------------------------------------------------------------
511 # tkColorDialog_StartMove --
513 # Handles a mousedown button event over the selector polygon.
514 # Adds the bindings for moving the mouse while the button is
515 # pressed. Sets the binding for the button-release event.
517 # Params: sel is the selector canvas window, color is the color of the strip.
519 proc tkColorDialog_StartMove {w sel color x delta {dontMove 0}} {
523 tkColorDialog_MoveSelector $w $sel $color $x $delta
527 # tkColorDialog_MoveSelector --
529 # Moves the polygon selector so that its middle point has the same
530 # x value as the specified x. If x is outside the bounds [0,255],
531 # the selector is set to the closest endpoint.
533 # Params: sel is the selector canvas, c is [red|green|blue]
534 # x is a x-coordinate.
536 proc tkColorDialog_MoveSelector {w sel color x delta} {
543 } elseif { $x >= $data(BARS_WIDTH)} {
544 set x [expr {$data(BARS_WIDTH) - 1}]
546 set diff [expr {$x - $data($color,x)}]
547 $sel move $data($color,index) $diff 0
548 set data($color,x) [expr {$data($color,x) + $diff}]
550 # Return the x value that it was actually set at
554 # tkColorDialog_ReleaseMouse
556 # Removes mouse tracking bindings, updates the colorbars.
558 # Params: sel is the selector canvas, color is the color of the strip,
559 # x is the x-coord of the mouse.
561 proc tkColorDialog_ReleaseMouse {w sel color x delta} {
564 set x [tkColorDialog_MoveSelector $w $sel $color $x $delta]
566 # Determine exactly what color we are looking at.
567 set data($color,intensity) [tkColorDialog_XToRgb $w $x]
569 tkColorDialog_RedrawColorBars $w $color
572 # tkColorDialog_ResizeColorbars --
574 # Completely redraws the colorbars, including resizing the
577 proc tkColorDialog_ResizeColorBars {w} {
580 if { ($data(BARS_WIDTH) < $data(NUM_COLORBARS)) ||
581 (($data(BARS_WIDTH) % $data(NUM_COLORBARS)) != 0)} {
582 set data(BARS_WIDTH) $data(NUM_COLORBARS)
584 tkColorDialog_InitValues $w
585 foreach color { red green blue } {
586 $data($color,col) configure -width $data(canvasWidth)
587 tkColorDialog_DrawColorScale $w $color 1
591 # tkColorDialog_HandleSelEntry --
593 # Handles the return keypress event in the "Selection:" entry
595 proc tkColorDialog_HandleSelEntry {w} {
598 set text [string trim $data(selection)]
599 # Check to make sure that the color is valid
600 if {[catch {set color [winfo rgb . $text]} ]} {
601 set data(selection) $data(finalColor)
605 set R [expr {[lindex $color 0]/0x100}]
606 set G [expr {[lindex $color 1]/0x100}]
607 set B [expr {[lindex $color 2]/0x100}]
609 tkColorDialog_SetRGBValue $w "$R $G $B"
610 set data(selection) $text
613 # tkColorDialog_HandleRGBEntry --
615 # Handles the return keypress event in the R, G or B entry
617 proc tkColorDialog_HandleRGBEntry {w} {
620 foreach c {red green blue} {
622 set data($c,intensity) [expr {int($data($c,intensity))}]
624 set data($c,intensity) 0
627 if {$data($c,intensity) < 0} {
628 set data($c,intensity) 0
630 if {$data($c,intensity) > 255} {
631 set data($c,intensity) 255
635 tkColorDialog_SetRGBValue $w "$data(red,intensity) $data(green,intensity) \
636 $data(blue,intensity)"
639 # mouse cursor enters a color bar
641 proc tkColorDialog_EnterColorBar {w color} {
644 $data($color,sel) itemconfig $data($color,index) -fill red
647 # mouse leaves enters a color bar
649 proc tkColorDialog_LeaveColorBar {w color} {
652 $data($color,sel) itemconfig $data($color,index) -fill black
655 # user hits OK button
657 proc tkColorDialog_OkCmd {w} {
661 set tkPriv(selectColor) $data(finalColor)
664 # user hits Cancel button
666 proc tkColorDialog_CancelCmd {w} {
669 set tkPriv(selectColor) ""