3 # Color selection dialog for platforms that do not support a
4 # standard color selection dialog.
6 # Copyright (c) 1996 Sun Microsystems, Inc.
8 # See the file "license.terms" for information on usage and redistribution
9 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13 # (1): Find out how many free colors are left in the colormap and
14 # don't allocate too many colors.
15 # (2): Implement HSV color selection.
18 # Make sure namespaces exist
19 namespace eval ::tk {}
20 namespace eval ::tk::dialog {}
21 namespace eval ::tk::dialog::color {
22 namespace import
::tk::msgcat::*
25 # ::tk::dialog::color:: --
27 # Create a color dialog and let the user choose a color. This function
28 # should not be called directly. It is called by the tk_chooseColor
29 # function when a native color selector widget does not exist
31 proc ::tk::dialog::color:: {args
} {
33 set dataName __tk__color
34 upvar ::tk::dialog::color::$dataName data
37 # The lines variables track the start and end indices of the line
38 # elements in the colorbar canvases.
39 set data
(lines
,red
,start
) 0
40 set data
(lines
,red
,last
) -1
41 set data
(lines
,green
,start
) 0
42 set data
(lines
,green
,last
) -1
43 set data
(lines
,blue
,start
) 0
44 set data
(lines
,blue
,last
) -1
46 # This is the actual number of lines that are drawn in each color strip.
47 # Note that the bars may be of any width.
48 # However, NUM_COLORBARS must be a number that evenly divides 256.
49 # Such as 256, 128, 64, etc.
50 set data
(NUM_COLORBARS
) 16
52 # BARS_WIDTH is the number of pixels wide the color bar portion of the
53 # canvas is. This number must be a multiple of NUM_COLORBARS
54 set data
(BARS_WIDTH
) 160
56 # PLGN_WIDTH is the number of pixels wide of the triangular selection
57 # polygon. This also results in the definition of the padding on the
58 # left and right sides which is half of PLGN_WIDTH. Make this number even.
59 set data
(PLGN_HEIGHT
) 10
61 # PLGN_HEIGHT is the height of the selection polygon and the height of the
62 # selection rectangle at the bottom of the color bar. No restrictions.
63 set data
(PLGN_WIDTH
) 10
65 Config
$dataName $args
68 set sc
[winfo screen
$data(-parent)]
69 set winExists
[winfo exists
$w]
70 if {!$winExists ||
$sc ne
[winfo screen
$w]} {
74 toplevel $w -class TkColorDialog
-screen $sc
75 if {[tk windowingsystem
] eq
"x11"} {wm attributes
$w -type dialog
}
79 # Dialog boxes should be transient with respect to their parent,
80 # so that they will always stay on top of their parent window. However,
81 # some window managers will create the window as withdrawn if the parent
82 # window is withdrawn or iconified. Combined with the grab we put on the
83 # window, this can hang the entire application. Therefore we only make
84 # the dialog transient if the parent is viewable.
86 if {[winfo viewable
[winfo toplevel $data(-parent)]] } {
87 wm transient
$w $data(-parent)
90 # 5. Withdraw the window, then update all the geometry information
91 # so we know how big it wants to be, then center the window in the
92 # display and de-iconify it.
94 ::tk::PlaceWindow $w widget
$data(-parent)
95 wm title
$w $data(-title)
97 # 6. Set a grab and claim the focus too.
99 ::tk::SetFocusGrab $w $data(okBtn
)
101 # 7. Wait for the user to respond, then restore the focus and
102 # return the index of the selected button. Restore the focus
103 # before deleting the window, since otherwise the window manager
104 # may take the focus away so we can't redirect it. Finally,
105 # restore any grab that was in effect.
107 vwait ::tk::Priv(selectColor
)
108 set result
$Priv(selectColor
)
109 ::tk::RestoreFocusGrab $w $data(okBtn
)
115 # ::tk::dialog::color::InitValues --
117 # Get called during initialization or when user resets NUM_COLORBARS
119 proc ::tk::dialog::color::InitValues {dataName
} {
120 upvar ::tk::dialog::color::$dataName data
122 # IntensityIncr is the difference in color intensity between a colorbar
124 set data
(intensityIncr
) [expr {256 / $data(NUM_COLORBARS
)}]
126 # ColorbarWidth is the width of each colorbar
127 set data
(colorbarWidth
) [expr {$data(BARS_WIDTH
) / $data(NUM_COLORBARS
)}]
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}]
135 set data
(selPad
) [expr {$data(PLGN_WIDTH
) / 2}]
138 # minX is the x coordinate of the first colorbar
140 set data
(minX
) $data(indent
)
143 # maxX is the x coordinate of the last colorbar
145 set data
(maxX
) [expr {$data(BARS_WIDTH
) + $data(indent
)-1}]
148 # canvasWidth is the width of the entire canvas, including the indents
150 set data
(canvasWidth
) [expr {$data(BARS_WIDTH
) + $data(PLGN_WIDTH
)}]
152 # Set the initial color, specified by -initialcolor, or the
153 # color chosen by the user the last time.
154 set data
(selection) $data(-initialcolor)
155 set data
(finalColor
) $data(-initialcolor)
156 set rgb
[winfo rgb .
$data(selection)]
158 set data
(red
,intensity
) [expr {[lindex $rgb 0]/0x100}]
159 set data
(green
,intensity
) [expr {[lindex $rgb 1]/0x100}]
160 set data
(blue
,intensity
) [expr {[lindex $rgb 2]/0x100}]
163 # ::tk::dialog::color::Config --
165 # Parses the command line arguments to tk_chooseColor
167 proc ::tk::dialog::color::Config {dataName argList
} {
169 upvar ::tk::dialog::color::$dataName data
171 # 1: the configuration specs
173 if {[info exists Priv
(selectColor
)] && $Priv(selectColor
) ne
""} {
174 set defaultColor
$Priv(selectColor
)
176 set defaultColor
[. cget
-background]
180 [list -initialcolor "" "" $defaultColor] \
181 [list -parent "" "" "."] \
182 [list -title "" "" [mc
"Color"]] \
185 # 2: parse the arguments
187 tclParseConfigSpec
::tk::dialog::color::$dataName $specs "" $argList
189 if {$data(-title) eq
""} {
192 if {[catch {winfo rgb .
$data(-initialcolor)} err
]} {
196 if {![winfo exists
$data(-parent)]} {
197 error "bad window path name \"$data(-parent)\""
201 # ::tk::dialog::color::BuildDialog --
205 proc ::tk::dialog::color::BuildDialog {w
} {
206 upvar ::tk::dialog::color::[winfo name
$w] data
208 # TopFrame contains the color strips and the color selection
210 set topFrame
[frame $w.top
-relief raised
-bd 1]
212 # StripsFrame contains the colorstrips and the individual RGB entries
213 set stripsFrame
[frame $topFrame.colorStrip
]
215 set maxWidth
[::tk::mcmaxamp &Red
&Green
&Blue
]
216 set maxWidth
[expr {$maxWidth<6 ?
6 : $maxWidth}]
222 foreach {color l
} $colorList {
223 # each f frame contains an [R|G|B] entry and the equiv. color strip.
224 set f
[frame $stripsFrame.
$color]
226 # The box frame contains the label and entry widget for an [R|G|B]
227 set box
[frame $f.box
]
229 ::tk::AmpWidget label $box.
label -text "[mc $l]:" \
230 -width $maxWidth -anchor ne
231 bind $box.
label <<AltUnderlined
>> [list focus $box.
entry]
233 entry $box.
entry -textvariable \
234 ::tk::dialog::color::[winfo name
$w]($color,intensity
) \
236 pack $box.
label -side left
-fill y
-padx 2 -pady 3
237 pack $box.
entry -side left
-anchor n
-pady 0
238 pack $box -side left
-fill both
241 [winfo reqheight
$box.
entry] -
242 2*([$box.
entry cget
-highlightthickness] + [$box.
entry cget
-bd])
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
252 pack $f -side top
-fill x
-padx 0 -pady 2
254 set data
($color,entry) $box.
entry
255 set data
($color,col
) $f.color
256 set data
($color,sel
) $f.sel
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]
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]
270 bind $box.
entry <Return
> [list tk::dialog::color::HandleRGBEntry $w]
273 pack $stripsFrame -side left
-fill both
-padx 4 -pady 10
275 # The selFrame contains a frame that demonstrates the currently
278 set selFrame
[frame $topFrame.sel
]
279 set lab
[::tk::AmpWidget label $selFrame.lab
\
280 -text [mc
"&Selection:"] -anchor sw
]
281 set ent
[entry $selFrame.ent
\
282 -textvariable ::tk::dialog::color::[winfo name
$w](selection) \
284 set f1
[frame $selFrame.f1
-relief sunken
-bd 2]
285 set data
(finalCanvas
) [frame $f1.demo
-bd 0 -width 100 -height 70]
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
291 bind $ent <Return
> [list tk::dialog::color::HandleSelEntry $w]
293 pack $selFrame -side left
-fill none
-anchor nw
294 pack $topFrame -side top
-expand yes
-fill both
-anchor nw
296 # the botFrame frame contains the buttons
298 set botFrame
[frame $w.bot
-relief raised
-bd 1]
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]
305 set data
(okBtn
) $botFrame.ok
306 set data
(cancelBtn
) $botFrame.cancel
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
315 # Accelerator bindings
316 bind $lab <<AltUnderlined
>> [list focus $ent]
317 bind $w <KeyPress-Escape
> [list tk::ButtonInvoke $data(cancelBtn
)]
318 bind $w <Alt-Key
> [list tk::AltKeyInDialog $w %A
]
320 wm protocol
$w WM_DELETE_WINDOW
[list tk::dialog::color::CancelCmd $w]
321 bind $lab <Destroy
> [list tk::dialog::color::CancelCmd $w]
324 # ::tk::dialog::color::SetRGBValue --
326 # Sets the current selection of the dialog box
328 proc ::tk::dialog::color::SetRGBValue {w color
} {
329 upvar ::tk::dialog::color::[winfo name
$w] data
331 set data
(red
,intensity
) [lindex $color 0]
332 set data
(green
,intensity
) [lindex $color 1]
333 set data
(blue
,intensity
) [lindex $color 2]
335 RedrawColorBars
$w all
337 # Now compute the new x value of each colorbars pointer polygon
338 foreach color
{red green blue
} {
339 set x
[RgbToX
$w $data($color,intensity
)]
340 MoveSelector
$w $data($color,sel
) $color $x 0
344 # ::tk::dialog::color::XToRgb --
346 # Converts a screen coordinate to intensity
348 proc ::tk::dialog::color::XToRgb {w x
} {
349 upvar ::tk::dialog::color::[winfo name
$w] data
351 set x
[expr {($x * $data(intensityIncr
))/ $data(colorbarWidth
)}]
358 # ::tk::dialog::color::RgbToX
360 # Converts an intensity to screen coordinate.
362 proc ::tk::dialog::color::RgbToX {w color
} {
363 upvar ::tk::dialog::color::[winfo name
$w] data
365 return [expr {($color * $data(colorbarWidth
)/ $data(intensityIncr
))}]
368 # ::tk::dialog::color::DrawColorScale --
370 # Draw color scale is called whenever the size of one of the color
371 # scale canvases is changed.
373 proc ::tk::dialog::color::DrawColorScale {w c
{create
0}} {
374 upvar ::tk::dialog::color::[winfo name
$w] data
376 # col: color bar canvas
377 # sel: selector canvas
378 set col
$data($c,col
)
379 set sel
$data($c,sel
)
381 # First handle the case that we are creating everything for the first time.
383 # First remove all the lines that already exist.
384 if { $data(lines
,$c,last
) > $data(lines
,$c,start
)} {
385 for {set i
$data(lines
,$c,start
)} \
386 {$i <= $data(lines
,$c,last
)} {incr i
} {
390 # Delete the selector if it exists
391 if {[info exists data
($c,index
)]} {
392 $sel delete
$data($c,index
)
395 # Draw the selection polygons
396 CreateSelector
$w $sel $c
397 $sel bind $data($c,index
) <ButtonPress-1
> \
398 [list tk::dialog::color::StartMove $w $sel $c %x
$data(selPad
) 1]
399 $sel bind $data($c,index
) <B1-Motion
> \
400 [list tk::dialog::color::MoveSelector $w $sel $c %x
$data(selPad
)]
401 $sel bind $data($c,index
) <ButtonRelease-1
> \
402 [list tk::dialog::color::ReleaseMouse $w $sel $c %x
$data(selPad
)]
404 set height
[winfo height
$col]
405 # Create an invisible region under the colorstrip to catch mouse clicks
406 # that aren't on the selector.
407 set data
($c,clickRegion
) [$sel create rectangle
0 0 \
408 $data(canvasWidth
) $height -fill {} -outline {}]
410 bind $col <ButtonPress-1
> \
411 [list tk::dialog::color::StartMove $w $sel $c %x
$data(colorPad
)]
412 bind $col <B1-Motion
> \
413 [list tk::dialog::color::MoveSelector $w $sel $c %x
$data(colorPad
)]
414 bind $col <ButtonRelease-1
> \
415 [list tk::dialog::color::ReleaseMouse $w $sel $c %x
$data(colorPad
)]
417 $sel bind $data($c,clickRegion
) <ButtonPress-1
> \
418 [list tk::dialog::color::StartMove $w $sel $c %x
$data(selPad
)]
419 $sel bind $data($c,clickRegion
) <B1-Motion
> \
420 [list tk::dialog::color::MoveSelector $w $sel $c %x
$data(selPad
)]
421 $sel bind $data($c,clickRegion
) <ButtonRelease-1
> \
422 [list tk::dialog::color::ReleaseMouse $w $sel $c %x
$data(selPad
)]
424 # l is the canvas index of the first colorbar.
425 set l
$data(lines
,$c,start
)
428 # Draw the color bars.
429 set highlightW
[expr {[$col cget
-highlightthickness] + [$col cget
-bd]}]
430 for {set i
0} { $i < $data(NUM_COLORBARS
)} { incr i
} {
431 set intensity
[expr {$i * $data(intensityIncr
)}]
432 set startx
[expr {$i * $data(colorbarWidth
) + $highlightW}]
434 set color
[format "#%02x%02x%02x" \
435 $intensity $data(green
,intensity
) $data(blue
,intensity
)]
436 } elseif
{$c eq
"green"} {
437 set color
[format "#%02x%02x%02x" \
438 $data(red
,intensity
) $intensity $data(blue
,intensity
)]
440 set color
[format "#%02x%02x%02x" \
441 $data(red
,intensity
) $data(green
,intensity
) $intensity]
445 set index
[$col create rect
$startx $highlightW \
446 [expr {$startx +$data(colorbarWidth
)}] \
447 [expr {[winfo height
$col] + $highlightW}] \
448 -fill $color -outline $color]
450 $col itemconfigure
$l -fill $color -outline $color
454 $sel raise $data($c,index
)
457 set data
(lines
,$c,last
) $index
458 set data
(lines
,$c,start
) [expr {$index - $data(NUM_COLORBARS
) + 1}]
464 # ::tk::dialog::color::CreateSelector --
466 # Creates and draws the selector polygon at the position
467 # $data($c,intensity).
469 proc ::tk::dialog::color::CreateSelector {w sel c
} {
470 upvar ::tk::dialog::color::[winfo name
$w] data
471 set data
($c,index
) [$sel create polygon
\
472 0 $data(PLGN_HEIGHT
) \
473 $data(PLGN_WIDTH
) $data(PLGN_HEIGHT
) \
475 set data
($c,x
) [RgbToX
$w $data($c,intensity
)]
476 $sel move
$data($c,index
) $data($c,x
) 0
479 # ::tk::dialog::color::RedrawFinalColor
481 # Combines the intensities of the three colors into the final color
483 proc ::tk::dialog::color::RedrawFinalColor {w
} {
484 upvar ::tk::dialog::color::[winfo name
$w] data
486 set color
[format "#%02x%02x%02x" $data(red
,intensity
) \
487 $data(green
,intensity
) $data(blue
,intensity
)]
489 $data(finalCanvas
) configure
-bg $color
490 set data
(finalColor
) $color
491 set data
(selection) $color
492 set data
(finalRGB
) [list \
493 $data(red
,intensity
) \
494 $data(green
,intensity
) \
495 $data(blue
,intensity
)]
498 # ::tk::dialog::color::RedrawColorBars --
500 # Only redraws the colors on the color strips that were not manipulated.
501 # Params: color of colorstrip that changed. If color is not [red|green|blue]
502 # Then all colorstrips will be updated
504 proc ::tk::dialog::color::RedrawColorBars {w colorChanged
} {
505 upvar ::tk::dialog::color::[winfo name
$w] data
507 switch $colorChanged {
509 DrawColorScale
$w green
510 DrawColorScale
$w blue
513 DrawColorScale
$w red
514 DrawColorScale
$w blue
517 DrawColorScale
$w red
518 DrawColorScale
$w green
521 DrawColorScale
$w red
522 DrawColorScale
$w green
523 DrawColorScale
$w blue
529 #----------------------------------------------------------------------
531 #----------------------------------------------------------------------
533 # ::tk::dialog::color::StartMove --
535 # Handles a mousedown button event over the selector polygon.
536 # Adds the bindings for moving the mouse while the button is
537 # pressed. Sets the binding for the button-release event.
539 # Params: sel is the selector canvas window, color is the color of the strip.
541 proc ::tk::dialog::color::StartMove {w sel color x delta
{dontMove
0}} {
542 upvar ::tk::dialog::color::[winfo name
$w] data
545 MoveSelector
$w $sel $color $x $delta
549 # ::tk::dialog::color::MoveSelector --
551 # Moves the polygon selector so that its middle point has the same
552 # x value as the specified x. If x is outside the bounds [0,255],
553 # the selector is set to the closest endpoint.
555 # Params: sel is the selector canvas, c is [red|green|blue]
556 # x is a x-coordinate.
558 proc ::tk::dialog::color::MoveSelector {w sel color x delta
} {
559 upvar ::tk::dialog::color::[winfo name
$w] data
565 } elseif
{ $x > $data(BARS_WIDTH
)} {
566 set x
$data(BARS_WIDTH
)
568 set diff
[expr {$x - $data($color,x
)}]
569 $sel move
$data($color,index
) $diff 0
570 set data
($color,x
) [expr {$data($color,x
) + $diff}]
572 # Return the x value that it was actually set at
576 # ::tk::dialog::color::ReleaseMouse
578 # Removes mouse tracking bindings, updates the colorbars.
580 # Params: sel is the selector canvas, color is the color of the strip,
581 # x is the x-coord of the mouse.
583 proc ::tk::dialog::color::ReleaseMouse {w sel color x delta
} {
584 upvar ::tk::dialog::color::[winfo name
$w] data
586 set x
[MoveSelector
$w $sel $color $x $delta]
588 # Determine exactly what color we are looking at.
589 set data
($color,intensity
) [XToRgb
$w $x]
591 RedrawColorBars
$w $color
594 # ::tk::dialog::color::ResizeColorbars --
596 # Completely redraws the colorbars, including resizing the
599 proc ::tk::dialog::color::ResizeColorBars {w
} {
600 upvar ::tk::dialog::color::[winfo name
$w] data
603 ($data(BARS_WIDTH
) < $data(NUM_COLORBARS
)) ||
604 (($data(BARS_WIDTH
) % $data(NUM_COLORBARS
)) != 0)
606 set data
(BARS_WIDTH
) $data(NUM_COLORBARS
)
608 InitValues
[winfo name
$w]
609 foreach color
{red green blue
} {
610 $data($color,col
) configure
-width $data(canvasWidth
)
611 DrawColorScale
$w $color 1
615 # ::tk::dialog::color::HandleSelEntry --
617 # Handles the return keypress event in the "Selection:" entry
619 proc ::tk::dialog::color::HandleSelEntry {w
} {
620 upvar ::tk::dialog::color::[winfo name
$w] data
622 set text [string trim
$data(selection)]
623 # Check to make sure that the color is valid
624 if {[catch {set color
[winfo rgb .
$text]} ]} {
625 set data
(selection) $data(finalColor
)
629 set R
[expr {[lindex $color 0]/0x100}]
630 set G
[expr {[lindex $color 1]/0x100}]
631 set B
[expr {[lindex $color 2]/0x100}]
633 SetRGBValue
$w "$R $G $B"
634 set data
(selection) $text
637 # ::tk::dialog::color::HandleRGBEntry --
639 # Handles the return keypress event in the R, G or B entry
641 proc ::tk::dialog::color::HandleRGBEntry {w
} {
642 upvar ::tk::dialog::color::[winfo name
$w] data
644 foreach c
{red green blue
} {
646 set data
($c,intensity
) [expr {int
($data($c,intensity
))}]
648 set data
($c,intensity
) 0
651 if {$data($c,intensity
) < 0} {
652 set data
($c,intensity
) 0
654 if {$data($c,intensity
) > 255} {
655 set data
($c,intensity
) 255
659 SetRGBValue
$w "$data(red,intensity) \
660 $data(green,intensity) $data(blue,intensity)"
663 # mouse cursor enters a color bar
665 proc ::tk::dialog::color::EnterColorBar {w color
} {
666 upvar ::tk::dialog::color::[winfo name
$w] data
668 $data($color,sel
) itemconfigure
$data($color,index
) -fill red
671 # mouse leaves enters a color bar
673 proc ::tk::dialog::color::LeaveColorBar {w color
} {
674 upvar ::tk::dialog::color::[winfo name
$w] data
676 $data($color,sel
) itemconfigure
$data($color,index
) -fill black
679 # user hits OK button
681 proc ::tk::dialog::color::OkCmd {w
} {
683 upvar ::tk::dialog::color::[winfo name
$w] data
685 set Priv
(selectColor
) $data(finalColor
)
688 # user hits Cancel button or destroys window
690 proc ::tk::dialog::color::CancelCmd {w
} {
692 set Priv
(selectColor
) ""