694 lines
21 KiB
Tcl
694 lines
21 KiB
Tcl
|
# clrpick.tcl --
|
||
|
|
#
|
||
|
|
# Color selection dialog for platforms that do not support a
|
||
|
|
# standard color selection dialog.
|
||
|
|
#
|
||
|
|
# 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.
|
||
|
|
#
|
||
|
|
# ToDo:
|
||
|
|
#
|
||
|
|
# (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 {}
|
||
|
|
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} {
|
||
|
|
variable ::tk::Priv
|
||
|
|
set dataName __tk__color
|
||
|
|
upvar ::tk::dialog::color::$dataName data
|
||
|
|
set w .$dataName
|
||
|
|
|
||
|
|
# 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
|
||
|
|
set data(BARS_WIDTH) 160
|
||
|
|
|
||
|
|
# 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.
|
||
|
|
set data(PLGN_HEIGHT) 10
|
||
|
|
|
||
|
|
# 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 data(PLGN_WIDTH) 10
|
||
|
|
|
||
|
|
Config $dataName $args
|
||
|
|
InitValues $dataName
|
||
|
|
|
||
|
|
set sc [winfo screen $data(-parent)]
|
||
|
|
set winExists [winfo exists $w]
|
||
|
|
if {!$winExists || $sc ne [winfo screen $w]} {
|
||
|
|
if {$winExists} {
|
||
|
|
destroy $w
|
||
|
|
}
|
||
|
|
toplevel $w -class TkColorDialog -screen $sc
|
||
|
|
if {[tk windowingsystem] eq "x11"} {wm attributes $w -type dialog}
|
||
|
|
BuildDialog $w
|
||
|
|
}
|
||
|
|
|
||
|
|
# 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 (Motif style) 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)
|
||
|
|
set result $Priv(selectColor)
|
||
|
|
::tk::RestoreFocusGrab $w $data(okBtn)
|
||
|
|
unset data
|
||
|
|
|
||
|
|
return $result
|
||
|
|
}
|
||
|
|
|
||
|
|
# ::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
|
||
|
|
# and its neighbors.
|
||
|
|
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(colorPad) 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} {
|
||
|
|
variable ::tk::Priv
|
||
|
|
upvar ::tk::dialog::color::$dataName data
|
||
|
|
|
||
|
|
# 1: the configuration specs
|
||
|
|
#
|
||
|
|
if {[info exists Priv(selectColor)] && $Priv(selectColor) ne ""} {
|
||
|
|
set defaultColor $Priv(selectColor)
|
||
|
|
} else {
|
||
|
|
set defaultColor [. cget -background]
|
||
|
|
}
|
||
|
|
|
||
|
|
set specs [list \
|
||
|
|
[list -initialcolor "" "" $defaultColor] \
|
||
|
|
[list -parent "" "" "."] \
|
||
|
|
[list -title "" "" [mc "Color"]] \
|
||
|
|
]
|
||
|
|
|
||
|
|
# 2: parse the arguments
|
||
|
|
#
|
||
|
|
tclParseConfigSpec ::tk::dialog::color::$dataName $specs "" $argList
|
||
|
|
|
||
|
|
if {$data(-title) eq ""} {
|
||
|
|
set data(-title) " "
|
||
|
|
}
|
||
|
|
if {[catch {winfo rgb . $data(-initialcolor)} err]} {
|
||
|
|
error $err
|
||
|
|
}
|
||
|
|
|
||
|
|
if {![winfo exists $data(-parent)]} {
|
||
|
|
error "bad window path name \"$data(-parent)\""
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# ::tk::dialog::color::BuildDialog --
|
||
|
|
#
|
||
|
|
# Build the dialog.
|
||
|
|
#
|
||
|
|
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}]
|
||
|
|
set colorList {
|
||
|
|
red "&Red"
|
||
|
|
green "&Green"
|
||
|
|
blue "&Blue"
|
||
|
|
}
|
||
|
|
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]
|
||
|
|
set box [frame $f.box]
|
||
|
|
|
||
|
|
::tk::AmpWidget label $box.label -text "[mc $l]:" \
|
||
|
|
-width $maxWidth -anchor ne
|
||
|
|
bind $box.label <<AltUnderlined>> [list focus $box.entry]
|
||
|
|
|
||
|
|
entry $box.entry -textvariable \
|
||
|
|
::tk::dialog::color::[winfo name $w]($color,intensity) \
|
||
|
|
-width 4
|
||
|
|
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
|
||
|
|
|
||
|
|
set height [expr {
|
||
|
|
[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
|
||
|
|
# selected color
|
||
|
|
#
|
||
|
|
set selFrame [frame $topFrame.sel]
|
||
|
|
set lab [::tk::AmpWidget label $selFrame.lab \
|
||
|
|
-text [mc "&Selection:"] -anchor sw]
|
||
|
|
set ent [entry $selFrame.ent \
|
||
|
|
-textvariable ::tk::dialog::color::[winfo name $w](selection) \
|
||
|
|
-width 16]
|
||
|
|
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
|
||
|
|
|
||
|
|
# Accelerator bindings
|
||
|
|
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]
|
||
|
|
bind $lab <Destroy> [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]
|
||
|
|
|
||
|
|
RedrawColorBars $w all
|
||
|
|
|
||
|
|
# Now compute the new x value of each colorbars pointer polygon
|
||
|
|
foreach color {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
|
||
|
|
}
|
||
|
|
return $x
|
||
|
|
}
|
||
|
|
|
||
|
|
# ::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
|
||
|
|
|
||
|
|
# col: color bar canvas
|
||
|
|
# sel: selector canvas
|
||
|
|
set col $data($c,col)
|
||
|
|
set sel $data($c,sel)
|
||
|
|
|
||
|
|
# First handle the case that we are creating everything for the first time.
|
||
|
|
if {$create} {
|
||
|
|
# 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} {
|
||
|
|
$sel delete $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)]
|
||
|
|
bind $col <B1-Motion> \
|
||
|
|
[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)]
|
||
|
|
} else {
|
||
|
|
# l is the canvas index of the first colorbar.
|
||
|
|
set l $data(lines,$c,start)
|
||
|
|
}
|
||
|
|
|
||
|
|
# Draw the color bars.
|
||
|
|
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 {$c eq "red"} {
|
||
|
|
set color [format "#%02x%02x%02x" \
|
||
|
|
$intensity $data(green,intensity) $data(blue,intensity)]
|
||
|
|
} elseif {$c eq "green"} {
|
||
|
|
set color [format "#%02x%02x%02x" \
|
||
|
|
$data(red,intensity) $intensity $data(blue,intensity)]
|
||
|
|
} else {
|
||
|
|
set color [format "#%02x%02x%02x" \
|
||
|
|
$data(red,intensity) $data(green,intensity) $intensity]
|
||
|
|
}
|
||
|
|
|
||
|
|
if {$create} {
|
||
|
|
set index [$col create rect $startx $highlightW \
|
||
|
|
[expr {$startx +$data(colorbarWidth)}] \
|
||
|
|
[expr {[winfo height $col] + $highlightW}] \
|
||
|
|
-fill $color -outline $color]
|
||
|
|
} else {
|
||
|
|
$col itemconfigure $l -fill $color -outline $color
|
||
|
|
incr l
|
||
|
|
}
|
||
|
|
}
|
||
|
|
$sel raise $data($c,index)
|
||
|
|
|
||
|
|
if {$create} {
|
||
|
|
set data(lines,$c,last) $index
|
||
|
|
set data(lines,$c,start) [expr {$index - $data(NUM_COLORBARS) + 1}]
|
||
|
|
}
|
||
|
|
|
||
|
|
RedrawFinalColor $w
|
||
|
|
}
|
||
|
|
|
||
|
|
# ::tk::dialog::color::CreateSelector --
|
||
|
|
#
|
||
|
|
# Creates and draws the selector polygon at the position
|
||
|
|
# $data($c,intensity).
|
||
|
|
#
|
||
|
|
proc ::tk::dialog::color::CreateSelector {w sel c } {
|
||
|
|
upvar ::tk::dialog::color::[winfo name $w] data
|
||
|
|
set data($c,index) [$sel create polygon \
|
||
|
|
0 $data(PLGN_HEIGHT) \
|
||
|
|
$data(PLGN_WIDTH) $data(PLGN_HEIGHT) \
|
||
|
|
$data(indent) 0]
|
||
|
|
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 \
|
||
|
|
$data(red,intensity) \
|
||
|
|
$data(green,intensity) \
|
||
|
|
$data(blue,intensity)]
|
||
|
|
}
|
||
|
|
|
||
|
|
# ::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
|
||
|
|
|
||
|
|
switch $colorChanged {
|
||
|
|
red {
|
||
|
|
DrawColorScale $w green
|
||
|
|
DrawColorScale $w blue
|
||
|
|
}
|
||
|
|
green {
|
||
|
|
DrawColorScale $w red
|
||
|
|
DrawColorScale $w blue
|
||
|
|
}
|
||
|
|
blue {
|
||
|
|
DrawColorScale $w red
|
||
|
|
DrawColorScale $w green
|
||
|
|
}
|
||
|
|
default {
|
||
|
|
DrawColorScale $w red
|
||
|
|
DrawColorScale $w green
|
||
|
|
DrawColorScale $w blue
|
||
|
|
}
|
||
|
|
}
|
||
|
|
RedrawFinalColor $w
|
||
|
|
}
|
||
|
|
|
||
|
|
#----------------------------------------------------------------------
|
||
|
|
# Event handlers
|
||
|
|
#----------------------------------------------------------------------
|
||
|
|
|
||
|
|
# ::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
|
||
|
|
|
||
|
|
if {!$dontMove} {
|
||
|
|
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]
|
||
|
|
# x is a x-coordinate.
|
||
|
|
#
|
||
|
|
proc ::tk::dialog::color::MoveSelector {w sel color x delta} {
|
||
|
|
upvar ::tk::dialog::color::[winfo name $w] data
|
||
|
|
|
||
|
|
incr x -$delta
|
||
|
|
|
||
|
|
if { $x < 0 } {
|
||
|
|
set x 0
|
||
|
|
} elseif { $x > $data(BARS_WIDTH)} {
|
||
|
|
set 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
|
||
|
|
return $x
|
||
|
|
}
|
||
|
|
|
||
|
|
# ::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
|
||
|
|
# colorstrips
|
||
|
|
#
|
||
|
|
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)
|
||
|
|
} then {
|
||
|
|
set data(BARS_WIDTH) $data(NUM_COLORBARS)
|
||
|
|
}
|
||
|
|
InitValues [winfo name $w]
|
||
|
|
foreach color {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)
|
||
|
|
return
|
||
|
|
}
|
||
|
|
|
||
|
|
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 {red green blue} {
|
||
|
|
if {[catch {
|
||
|
|
set data($c,intensity) [expr {int($data($c,intensity))}]
|
||
|
|
}]} {
|
||
|
|
set data($c,intensity) 0
|
||
|
|
}
|
||
|
|
|
||
|
|
if {$data($c,intensity) < 0} {
|
||
|
|
set 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) itemconfigure $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) itemconfigure $data($color,index) -fill black
|
||
|
|
}
|
||
|
|
|
||
|
|
# user hits OK button
|
||
|
|
#
|
||
|
|
proc ::tk::dialog::color::OkCmd {w} {
|
||
|
|
variable ::tk::Priv
|
||
|
|
upvar ::tk::dialog::color::[winfo name $w] data
|
||
|
|
|
||
|
|
set Priv(selectColor) $data(finalColor)
|
||
|
|
}
|
||
|
|
|
||
|
|
# user hits Cancel button or destroys window
|
||
|
|
#
|
||
|
|
proc ::tk::dialog::color::CancelCmd {w} {
|
||
|
|
variable ::tk::Priv
|
||
|
|
set Priv(selectColor) ""
|
||
|
|
}
|