# clrpick.tcl -- # # Color selection dialog for platforms that do not support a # standard color selection dialog. # # RCS: @(#) $Id: clrpick.tcl,v 1.20.2.2 2006/03/17 10:50:11 patthoyts 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. # # 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 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 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) unset data 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 # 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 [list \ red [mc "&Red"] \ green [mc "&Green"] \ blue [mc "&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] bind [::tk::AmpWidget label $box.label -text $l: -width $maxWidth \ -anchor ne] <> [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) \ [list tk::dialog::color::DrawColorScale $w $color 1] bind $data($color,col) \ [list tk::dialog::color::EnterColorBar $w $color] bind $data($color,col) \ [list tk::dialog::color::LeaveColorBar $w $color] bind $data($color,sel) \ [list tk::dialog::color::EnterColorBar $w $color] bind $data($color,sel) \ [list tk::dialog::color::LeaveColorBar $w $color] bind $box.entry [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 [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 <> [list focus $ent] bind $w [list tk::ButtonInvoke $data(cancelBtn)] bind $w [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] RedrawColorBars $w all # 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 } 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) \ [list tk::dialog::color::StartMove $w $sel $c %x $data(selPad) 1] $sel bind $data($c,index) \ [list tk::dialog::color::MoveSelector $w $sel $c %x $data(selPad)] $sel bind $data($c,index) \ [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 \ [list tk::dialog::color::StartMove $w $sel $c %x $data(colorPad)] bind $col \ [list tk::dialog::color::MoveSelector $w $sel $c %x $data(colorPad)] bind $col \ [list tk::dialog::color::ReleaseMouse $w $sel $c %x $data(colorPad)] $sel bind $data($c,clickRegion) \ [list tk::dialog::color::StartMove $w $sel $c %x $data(selPad)] $sel bind $data($c,clickRegion) \ [list tk::dialog::color::MoveSelector $w $sel $c %x $data(selPad)] $sel bind $data($c,clickRegion) \ [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)} { 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) 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 [list 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 # proc ::tk::dialog::color::CancelCmd {w} { variable ::tk::Priv set Priv(selectColor) "" }