# clrpick.tcl --

#

#	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.

#

# 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 || [string compare $sc [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)] && \

	    [string compare $Priv(selectColor) ""]} {

	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 {[string equal $data(-title) ""]} {

	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] <<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]

}

# ::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) <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 {[string equal $c "red"]} {

	    set color [format "#%02x%02x%02x" \

			   $intensity \

			   $data(green,intensity) \

			   $data(blue,intensity)]

	} elseif {[string equal $c "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