# Color selection dialog for platforms that do not support a
# standard color selection dialog.
# RCS: @(#) $Id: clrpick.tcl,v 1.20 2003/02/21 14:40:26 dkf Exp $
# Copyright (c) 1996 Sun Microsystems, Inc.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# (1): Find out how many free colors are left in the colormap and
# don't allocate too many colors.
# (2): Implement HSV color selection.
# Make sure namespaces exist
namespace eval ::tk::dialog {}
namespace eval ::tk::dialog::color {
namespace import
::tk::msgcat::*
# ::tk::dialog::color:: --
# Create a color dialog and let the user choose a color. This function
# should not be called directly. It is called by the tk_chooseColor
# function when a native color selector widget does not exist
proc ::tk::dialog::color:: {args
} {
upvar ::tk::dialog::color::$dataName data
# The lines variables track the start and end indices of the line
# elements in the colorbar canvases.
set data
(lines
,red
,start
) 0
set data
(lines
,red
,last
) -1
set data
(lines
,green
,start
) 0
set data
(lines
,green
,last
) -1
set data
(lines
,blue
,start
) 0
set data
(lines
,blue
,last
) -1
# This is the actual number of lines that are drawn in each color strip.
# Note that the bars may be of any width.
# However, NUM_COLORBARS must be a number that evenly divides 256.
# Such as 256, 128, 64, etc.
set data
(NUM_COLORBARS
) 16
# BARS_WIDTH is the number of pixels wide the color bar portion of the
# canvas is. This number must be a multiple of NUM_COLORBARS
# PLGN_WIDTH is the number of pixels wide of the triangular selection
# polygon. This also results in the definition of the padding on the
# left and right sides which is half of PLGN_WIDTH. Make this number even.
# PLGN_HEIGHT is the height of the selection polygon and the height of the
# selection rectangle at the bottom of the color bar. No restrictions.
set sc
[winfo screen
$data(-parent)]
set winExists
[winfo exists
$w]
if {!$winExists ||
[string compare
$sc [winfo screen
$w]]} {
toplevel $w -class TkColorDialog
-screen $sc
# Dialog boxes should be transient with respect to their parent,
# so that they will always stay on top of their parent window. However,
# some window managers will create the window as withdrawn if the parent
# window is withdrawn or iconified. Combined with the grab we put on the
# window, this can hang the entire application. Therefore we only make
# the dialog transient if the parent is viewable.
if {[winfo viewable
[winfo toplevel $data(-parent)]] } {
wm transient
$w $data(-parent)
# 5. Withdraw the window, then update all the geometry information
# so we know how big it wants to be, then center the window in the
# display and de-iconify it.
::tk::PlaceWindow $w widget
$data(-parent)
wm title
$w $data(-title)
# 6. Set a grab and claim the focus too.
::tk::SetFocusGrab $w $data(okBtn
)
# 7. Wait for the user to respond, then restore the focus and
# return the index of the selected button. Restore the focus
# before deleting the window, since otherwise the window manager
# may take the focus away so we can't redirect it. Finally,
# restore any grab that was in effect.
vwait ::tk::Priv(selectColor
)
::tk::RestoreFocusGrab $w $data(okBtn
)
return $Priv(selectColor
)
# ::tk::dialog::color::InitValues --
# Get called during initialization or when user resets NUM_COLORBARS
proc ::tk::dialog::color::InitValues {dataName
} {
upvar ::tk::dialog::color::$dataName data
# IntensityIncr is the difference in color intensity between a colorbar
set data
(intensityIncr
) [expr {256 / $data(NUM_COLORBARS
)}]
# ColorbarWidth is the width of each colorbar
set data
(colorbarWidth
) \
[expr {$data(BARS_WIDTH
) / $data(NUM_COLORBARS
)}]
# Indent is the width of the space at the left and right side of the
# colorbar. It is always half the selector polygon width, because the
# polygon extends into the space.
set data
(indent
) [expr {$data(PLGN_WIDTH
) / 2}]
set data
(selPad
) [expr {$data(PLGN_WIDTH
) / 2}]
# minX is the x coordinate of the first colorbar
set data
(minX
) $data(indent
)
# maxX is the x coordinate of the last colorbar
set data
(maxX
) [expr {$data(BARS_WIDTH
) + $data(indent
)-1}]
# canvasWidth is the width of the entire canvas, including the indents
set data
(canvasWidth
) [expr {$data(BARS_WIDTH
) + $data(PLGN_WIDTH
)}]
# Set the initial color, specified by -initialcolor, or the
# color chosen by the user the last time.
set data
(selection) $data(-initialcolor)
set data
(finalColor
) $data(-initialcolor)
set rgb
[winfo rgb .
$data(selection)]
set data
(red
,intensity
) [expr {[lindex $rgb 0]/0x100}]
set data
(green
,intensity
) [expr {[lindex $rgb 1]/0x100}]
set data
(blue
,intensity
) [expr {[lindex $rgb 2]/0x100}]
# ::tk::dialog::color::Config --
# Parses the command line arguments to tk_chooseColor
proc ::tk::dialog::color::Config {dataName argList
} {
upvar ::tk::dialog::color::$dataName data
# 1: the configuration specs
if {[info exists Priv
(selectColor
)] && \
[string compare
$Priv(selectColor
) ""]} {
set defaultColor
$Priv(selectColor
)
set defaultColor
[. cget
-background]
[list -initialcolor "" "" $defaultColor] \
[list -parent "" "" "."] \
[list -title "" "" [mc
"Color"]] \
tclParseConfigSpec
::tk::dialog::color::$dataName $specs "" $argList
if {[string equal
$data(-title) ""]} {
if {[catch {winfo rgb .
$data(-initialcolor)} err
]} {
if {![winfo exists
$data(-parent)]} {
error "bad window path name \"$data(-parent)\""
# ::tk::dialog::color::BuildDialog --
proc ::tk::dialog::color::BuildDialog {w
} {
upvar ::tk::dialog::color::[winfo name
$w] data
# TopFrame contains the color strips and the color selection
set topFrame
[frame $w.top
-relief raised
-bd 1]
# StripsFrame contains the colorstrips and the individual RGB entries
set stripsFrame
[frame $topFrame.colorStrip
]
set maxWidth
[::tk::mcmaxamp &Red
&Green
&Blue
]
set maxWidth
[expr {$maxWidth<6?
6:$maxWidth}]
foreach {color l
} $colorList {
# each f frame contains an [R|G|B] entry and the equiv. color strip.
set f
[frame $stripsFrame.
$color]
# The box frame contains the label and entry widget for an [R|G|B]
bind [::tk::AmpWidget label $box.
label -text $l: -width $maxWidth \
-anchor ne
] <<AltUnderlined
>> [list focus $box.
entry]
entry $box.
entry -textvariable \
::tk::dialog::color::[winfo name
$w]($color,intensity
) \
pack $box.
label -side left
-fill y
-padx 2 -pady 3
pack $box.
entry -side left
-anchor n
-pady 0
pack $box -side left
-fill both
{[winfo reqheight
$box.
entry] - \
2*([$box.
entry cget
-highlightthickness] + [$box.
entry cget
-bd])}]
canvas $f.color
-height $height\
-width $data(BARS_WIDTH
) -relief sunken
-bd 2
canvas $f.sel
-height $data(PLGN_HEIGHT
) \
-width $data(canvasWidth
) -highlightthickness 0
pack $f.color
-expand yes
-fill both
pack $f.sel
-expand yes
-fill both
pack $f -side top
-fill x
-padx 0 -pady 2
set data
($color,entry) $box.
entry
set data
($color,col
) $f.color
set data
($color,sel
) $f.sel
bind $data($color,col
) <Configure
> \
[list tk::dialog::color::DrawColorScale $w $color 1]
bind $data($color,col
) <Enter
> \
[list tk::dialog::color::EnterColorBar $w $color]
bind $data($color,col
) <Leave
> \
[list tk::dialog::color::LeaveColorBar $w $color]
bind $data($color,sel
) <Enter
> \
[list tk::dialog::color::EnterColorBar $w $color]
bind $data($color,sel
) <Leave
> \
[list tk::dialog::color::LeaveColorBar $w $color]
bind $box.
entry <Return
> [list tk::dialog::color::HandleRGBEntry $w]
pack $stripsFrame -side left
-fill both
-padx 4 -pady 10
# The selFrame contains a frame that demonstrates the currently
set selFrame
[frame $topFrame.sel
]
set lab
[::tk::AmpWidget label $selFrame.lab
-text [mc
"&Selection:"] \
set ent
[entry $selFrame.ent
\
-textvariable ::tk::dialog::color::[winfo name
$w](selection) \
set f1
[frame $selFrame.f1
-relief sunken
-bd 2]
set data
(finalCanvas
) [frame $f1.demo
-bd 0 -width 100 -height 70]
pack $lab $ent -side top
-fill x
-padx 4 -pady 2
pack $f1 -expand yes
-anchor nw
-fill both
-padx 6 -pady 10
pack $data(finalCanvas
) -expand yes
-fill both
bind $ent <Return
> [list tk::dialog::color::HandleSelEntry $w]
pack $selFrame -side left
-fill none
-anchor nw
pack $topFrame -side top
-expand yes
-fill both
-anchor nw
# the botFrame frame contains the buttons
set botFrame
[frame $w.bot
-relief raised
-bd 1]
::tk::AmpWidget button $botFrame.ok
-text [mc
"&OK"] \
-command [list tk::dialog::color::OkCmd $w]
::tk::AmpWidget button $botFrame.cancel
-text [mc
"&Cancel"] \
-command [list tk::dialog::color::CancelCmd $w]
set data
(okBtn
) $botFrame.ok
set data
(cancelBtn
) $botFrame.cancel
grid x
$botFrame.ok x
$botFrame.cancel x
-sticky ew
grid configure
$botFrame.ok
$botFrame.cancel
-padx 10 -pady 10
grid columnconfigure
$botFrame {0 4} -weight 1 -uniform space
grid columnconfigure
$botFrame {1 3} -weight 1 -uniform button
grid columnconfigure
$botFrame 2 -weight 2 -uniform space
pack $botFrame -side bottom
-fill x
bind $lab <<AltUnderlined
>> [list focus $ent]
bind $w <KeyPress-Escape
> [list tk::ButtonInvoke $data(cancelBtn
)]
bind $w <Alt-Key
> [list tk::AltKeyInDialog $w %A
]
wm protocol
$w WM_DELETE_WINDOW
[list tk::dialog::color::CancelCmd $w]
# ::tk::dialog::color::SetRGBValue --
# Sets the current selection of the dialog box
proc ::tk::dialog::color::SetRGBValue {w color
} {
upvar ::tk::dialog::color::[winfo name
$w] data
set data
(red
,intensity
) [lindex $color 0]
set data
(green
,intensity
) [lindex $color 1]
set data
(blue
,intensity
) [lindex $color 2]
# Now compute the new x value of each colorbars pointer polygon
foreach color
[list red green blue
] {
set x
[RgbToX
$w $data($color,intensity
)]
MoveSelector
$w $data($color,sel
) $color $x 0
# ::tk::dialog::color::XToRgb --
# Converts a screen coordinate to intensity
proc ::tk::dialog::color::XToRgb {w x
} {
upvar ::tk::dialog::color::[winfo name
$w] data
set x
[expr {($x * $data(intensityIncr
))/ $data(colorbarWidth
)}]
if {$x > 255} { set x
255 }
# ::tk::dialog::color::RgbToX
# Converts an intensity to screen coordinate.
proc ::tk::dialog::color::RgbToX {w color
} {
upvar ::tk::dialog::color::[winfo name
$w] data
return [expr {($color * $data(colorbarWidth
)/ $data(intensityIncr
))}]
# ::tk::dialog::color::DrawColorScale --
# Draw color scale is called whenever the size of one of the color
# scale canvases is changed.
proc ::tk::dialog::color::DrawColorScale {w c
{create
0}} {
upvar ::tk::dialog::color::[winfo name
$w] data
# First handle the case that we are creating everything for the first time.
# First remove all the lines that already exist.
if { $data(lines
,$c,last
) > $data(lines
,$c,start
)} {
for {set i
$data(lines
,$c,start
)} \
{$i <= $data(lines
,$c,last
)} { incr i
} {
# Delete the selector if it exists
if {[info exists data
($c,index
)]} {
$sel delete
$data($c,index
)
# Draw the selection polygons
CreateSelector
$w $sel $c
$sel bind $data($c,index
) <ButtonPress-1
> \
[list tk::dialog::color::StartMove $w $sel $c %x
$data(selPad
) 1]
$sel bind $data($c,index
) <B1-Motion
> \
[list tk::dialog::color::MoveSelector $w $sel $c %x
$data(selPad
)]
$sel bind $data($c,index
) <ButtonRelease-1
> \
[list tk::dialog::color::ReleaseMouse $w $sel $c %x
$data(selPad
)]
set height
[winfo height
$col]
# Create an invisible region under the colorstrip to catch mouse clicks
# that aren't on the selector.
set data
($c,clickRegion
) [$sel create rectangle
0 0 \
$data(canvasWidth
) $height -fill {} -outline {}]
bind $col <ButtonPress-1
> \
[list tk::dialog::color::StartMove $w $sel $c %x
$data(colorPad
)]
[list tk::dialog::color::MoveSelector $w $sel $c %x
$data(colorPad
)]
bind $col <ButtonRelease-1
> \
[list tk::dialog::color::ReleaseMouse $w $sel $c %x
$data(colorPad
)]
$sel bind $data($c,clickRegion
) <ButtonPress-1
> \
[list tk::dialog::color::StartMove $w $sel $c %x
$data(selPad
)]
$sel bind $data($c,clickRegion
) <B1-Motion
> \
[list tk::dialog::color::MoveSelector $w $sel $c %x
$data(selPad
)]
$sel bind $data($c,clickRegion
) <ButtonRelease-1
> \
[list tk::dialog::color::ReleaseMouse $w $sel $c %x
$data(selPad
)]
# l is the canvas index of the first colorbar.
set l
$data(lines
,$c,start
)
set highlightW
[expr {[$col cget
-highlightthickness] + [$col cget
-bd]}]
for {set i
0} { $i < $data(NUM_COLORBARS
)} { incr i
} {
set intensity
[expr {$i * $data(intensityIncr
)}]
set startx
[expr {$i * $data(colorbarWidth
) + $highlightW}]
if {[string equal
$c "red"]} {
set color
[format "#%02x%02x%02x" \
} elseif
{[string equal
$c "green"]} {
set color
[format "#%02x%02x%02x" \
set color
[format "#%02x%02x%02x" \
set index
[$col create rect
$startx $highlightW \
[expr {$startx +$data(colorbarWidth
)}] \
[expr {[winfo height
$col] + $highlightW}]\
-fill $color -outline $color]
$col itemconfigure
$l -fill $color -outline $color
$sel raise $data($c,index
)
set data
(lines
,$c,last
) $index
set data
(lines
,$c,start
) [expr {$index - $data(NUM_COLORBARS
) + 1}]
# ::tk::dialog::color::CreateSelector --
# Creates and draws the selector polygon at the position
proc ::tk::dialog::color::CreateSelector {w sel c
} {
upvar ::tk::dialog::color::[winfo name
$w] data
set data
($c,index
) [$sel create polygon
\
$data(PLGN_WIDTH
) $data(PLGN_HEIGHT
) \
set data
($c,x
) [RgbToX
$w $data($c,intensity
)]
$sel move
$data($c,index
) $data($c,x
) 0
# ::tk::dialog::color::RedrawFinalColor
# Combines the intensities of the three colors into the final color
proc ::tk::dialog::color::RedrawFinalColor {w
} {
upvar ::tk::dialog::color::[winfo name
$w] data
set color
[format "#%02x%02x%02x" $data(red
,intensity
) \
$data(green
,intensity
) $data(blue
,intensity
)]
$data(finalCanvas
) configure
-bg $color
set data
(finalColor
) $color
set data
(selection) $color
set data
(finalRGB
) [list \
# ::tk::dialog::color::RedrawColorBars --
# Only redraws the colors on the color strips that were not manipulated.
# Params: color of colorstrip that changed. If color is not [red|green|blue]
# Then all colorstrips will be updated
proc ::tk::dialog::color::RedrawColorBars {w colorChanged
} {
upvar ::tk::dialog::color::[winfo name
$w] data
#----------------------------------------------------------------------
#----------------------------------------------------------------------
# ::tk::dialog::color::StartMove --
# Handles a mousedown button event over the selector polygon.
# Adds the bindings for moving the mouse while the button is
# pressed. Sets the binding for the button-release event.
# Params: sel is the selector canvas window, color is the color of the strip.
proc ::tk::dialog::color::StartMove {w sel color x delta
{dontMove
0}} {
upvar ::tk::dialog::color::[winfo name
$w] data
MoveSelector
$w $sel $color $x $delta
# ::tk::dialog::color::MoveSelector --
# Moves the polygon selector so that its middle point has the same
# x value as the specified x. If x is outside the bounds [0,255],
# the selector is set to the closest endpoint.
# Params: sel is the selector canvas, c is [red|green|blue]
proc ::tk::dialog::color::MoveSelector {w sel color x delta
} {
upvar ::tk::dialog::color::[winfo name
$w] data
} elseif
{ $x > $data(BARS_WIDTH
)} {
set diff
[expr {$x - $data($color,x
)}]
$sel move
$data($color,index
) $diff 0
set data
($color,x
) [expr {$data($color,x
) + $diff}]
# Return the x value that it was actually set at
# ::tk::dialog::color::ReleaseMouse
# Removes mouse tracking bindings, updates the colorbars.
# Params: sel is the selector canvas, color is the color of the strip,
# x is the x-coord of the mouse.
proc ::tk::dialog::color::ReleaseMouse {w sel color x delta
} {
upvar ::tk::dialog::color::[winfo name
$w] data
set x
[MoveSelector
$w $sel $color $x $delta]
# Determine exactly what color we are looking at.
set data
($color,intensity
) [XToRgb
$w $x]
RedrawColorBars
$w $color
# ::tk::dialog::color::ResizeColorbars --
# Completely redraws the colorbars, including resizing the
proc ::tk::dialog::color::ResizeColorBars {w
} {
upvar ::tk::dialog::color::[winfo name
$w] data
if { ($data(BARS_WIDTH
) < $data(NUM_COLORBARS
)) ||
(($data(BARS_WIDTH
) % $data(NUM_COLORBARS
)) != 0)} {
set data
(BARS_WIDTH
) $data(NUM_COLORBARS
)
InitValues
[winfo name
$w]
foreach color
[list red green blue
] {
$data($color,col
) configure
-width $data(canvasWidth
)
DrawColorScale
$w $color 1
# ::tk::dialog::color::HandleSelEntry --
# Handles the return keypress event in the "Selection:" entry
proc ::tk::dialog::color::HandleSelEntry {w
} {
upvar ::tk::dialog::color::[winfo name
$w] data
set text [string trim
$data(selection)]
# Check to make sure that the color is valid
if {[catch {set color
[winfo rgb .
$text]} ]} {
set data
(selection) $data(finalColor
)
set R
[expr {[lindex $color 0]/0x100}]
set G
[expr {[lindex $color 1]/0x100}]
set B
[expr {[lindex $color 2]/0x100}]
SetRGBValue
$w "$R $G $B"
set data
(selection) $text
# ::tk::dialog::color::HandleRGBEntry --
# Handles the return keypress event in the R, G or B entry
proc ::tk::dialog::color::HandleRGBEntry {w
} {
upvar ::tk::dialog::color::[winfo name
$w] data
foreach c
[list red green blue
] {
set data
($c,intensity
) [expr {int
($data($c,intensity
))}]
if {$data($c,intensity
) < 0} {
if {$data($c,intensity
) > 255} {
set data
($c,intensity
) 255
SetRGBValue
$w "$data(red,intensity) \
$data(green,intensity) $data(blue,intensity)"
# mouse cursor enters a color bar
proc ::tk::dialog::color::EnterColorBar {w color
} {
upvar ::tk::dialog::color::[winfo name
$w] data
$data($color,sel
) itemconfig
$data($color,index
) -fill red
# mouse leaves enters a color bar
proc ::tk::dialog::color::LeaveColorBar {w color
} {
upvar ::tk::dialog::color::[winfo name
$w] data
$data($color,sel
) itemconfig
$data($color,index
) -fill black
proc ::tk::dialog::color::OkCmd {w
} {
upvar ::tk::dialog::color::[winfo name
$w] data
set Priv
(selectColor
) $data(finalColor
)
# user hits Cancel button
proc ::tk::dialog::color::CancelCmd {w
} {