#!/bin/sh
#-*- mode: Tcl;time-stamp-start:"TimeStamp[ 	]+\\\\?[\"<]+";-*-
# the next line restarts using wish \
exec /usr/local/bin/wish8.5 "$0" ${1+"$@"}
set TimeStamp "2008-04-14 20:23:41 poser"
#
# Copyright (C) 2005-2008 William J. Poser (billposer@alum.mit.edu)
# This program is free software; you can redistribute it and/or modify
# it under the terms of version 3 of the GNU General Public License
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
# or go to the web page:  http://www.gnu.org/licenses/gpl.txt.

#The colorized list of color names is adapted from Jeffrey Hobbs'
#1996 rewrite of a color picker by Spencer Smith, as found
#at http://wiki.tcl.tk/3538. The copyright for this belongs to the
#University of Oregon. In other respects this is my own rather different design.

set Version 1.8
package require msgcat
package require Tk
proc _ {s} {return [::msgcat::mc $s]};	# Define shorthand for gettext
set DataDir /usr/local/share
#::msgcat::mcload [file join [file dirname [info script]] msgs];
::msgcat::mcload [file join $DataDir ColorExplorer msgs]

set RecordHistoryP 0
set UseDecimalP 0;
set HTMLP 0;
set WindowSystemX11P 0;
set XorisOKP 0;
set ItemWidth 180
set KeepMainOnTopP 0
set KeepHistoryListOnTopP 0

set ColorSpecs(BalloonHelp,Background) "\#FFD689"
set ColorSpecs(BalloonHelp,Foreground) black
set ColorSpecs(Button,Background) "\#FFCC99"
set ColorSpecs(Button,Foreground) black
set ColorSpecs(HistoryList,Foreground) black
set ColorSpecs(HistoryList,Background) coral
set ColorSpecs(Default,Background) "\#ceceFF"
set ColorSpecs(InfoPopup,Background)	 	\#DEFFE6
set ColorSpecs(InfoPopup,Foreground)	 	black
set ColorSpecs(MainFrame,Background) red

option add *Background $ColorSpecs(Default,Background)
option add *Button.Background $ColorSpecs(Button,Background)
option add *Button.Foreground $ColorSpecs(Button,Foreground)
option add *Button.activeBackground "\#FFAE7F"
option add *Button.activeForeground black
option add *Checkbutton.activeBackground blue
option add *Radiobutton.activeBackground blue
option add *Checkbutton.selectColor red
option add *Radiobutton.selectColor red
option add *Entry.Background  $ColorSpecs(Default,Background)
option add *Scrollbar.activeBackground blue
set Lock 0;
bind . <Escape> {exec wish $argv0 &; exit}
set RGB "\#FFFFFF"
set HistoryList [list]
array set Colors {
    red    255
    green  255
    blue   255
}
array set PreviousColors {
    red    255
    green  255
    blue   255
}

if {[string match X11*  [winfo server .]]} {
    set WindowSystemX11P 1;
    if {[string length [auto_execok xoris]] > 0} {
	set XorisOKP 1;
    }
}

#Figure out what system we are running on
if {[string equal $tcl_platform(platform) windows]} {
    set System MSWindows;
} elseif {[string equal $tcl_platform(platform) unix]} {
    if {[string equal $tcl_platform(os) Darwin]} {
	set System MacOSX;
    } else {
	set System Unix;
    }
}

#Find out what our base graphics system is
if {[string match X11*  [winfo server .]]} {
    set AquaP 0
    set WindowSystem X11
} else {
    if {[string match $System MSWindows]} {
	set AquaP 0;
	set WindowSystem MSWindows;
    }
    if {[string match $System MacOSX]} {
	set AquaP 1
	set WindowSystem Aqua
    }
}

#Find out if we are running in Tcl/Tk 8.5 or greater
#This matters because fonts are bigger in 8.5+ under Linux
set TkEightFivePlusOnX11P 0
set VLevelList [split [info patchlevel] "."]
set Major [lindex $VLevelList 0]
set Minor [lindex $VLevelList 1]
if {$WindowSystem eq "X11"} {
    if {$Major > 8} {
	set TkEightFivePlusOnX11P 1
    } else {
	if {($Major == 8) && ($Minor >= 5)} {
	    set TkEightFivePlusOnX11P 1
	}
    } 
}

proc ProgramTimeDateStamp {} {
    set sts [split $::TimeStamp]
    return "[lindex $sts 0] [lindex $sts 1]"
}

proc rgb2hsv {r g b} {
    incr r
    incr g
    incr b
    set Max [expr {$r > $g ? $r : $g}]
    set Max [expr {$b > $Max ? $b : $Max}]
    set Min [expr {$r < $g ? $r : $g}]
    set Min [expr {$b < $Min ? $b : $Min}]
    set delta [expr {$Max - $Min}]
    set v [expr 100.0 * double($Max)/256.0]
    if {$Max == 0 || $delta == 0} {
	set h -1
	set s 0
    } else {
	set s [expr 100.0 * ($delta / double($Max))]
	if {$r == $Max} { 
	    set h [expr {0.0   + ($g - $b) * 60.0 / $delta}] 
	} elseif {$g == $Max} {
	    set h [expr {120.0 + ($b - $r) * 60.0 / $delta}]
	} else {
	    set h [expr {240.0 + ($r - $g) * 60.0 / $delta}]
	}
    }
    if {$h < 0.0} {
	set h [expr {$h + 361.0}]
    }
    return [list $h $s $v]
}

proc ShowHSV {} {
    set hsv [rgb2hsv $::Colors(red) $::Colors(green) $::Colors(blue)]
    set ::HSV [format "%3d %3d %3d" \
	   [expr int([lindex $hsv 0])] \
	   [expr int([lindex $hsv 1])] \
	   [expr int([lindex $hsv 2])]]
}

proc PutColorText {} {
    set SavedLock $::Lock
    set ::Lock 0
    set HexHoldColor [$::HOLDEXAMPLE cget -bg]
    scan $HexHoldColor "\#%2x%2x%2x" HoldRed HoldGreen HoldBlue
    if {$::UseDecimalP} {
	set ::CurrentColor [format "%03d %03d %03d" \
		$::Colors(red) $::Colors(green) $::Colors(blue)]
	set ::HoldColor [format "%03d %03d %03d" \
		$HoldRed $HoldGreen $HoldBlue]

    } else {
	set ::CurrentColor [format "%02X %02X %02X" \
		$::Colors(red) $::Colors(green) $::Colors(blue)]
	set ::HoldColor [format "%02X %02X %02X" \
		$HoldRed $HoldGreen $HoldBlue]
    }
    ShowHSV
    set ::Lock $SavedLock
}

proc RecordPreviousColor {e o n} {
    set ::PreviousColors($o) $::Colors($o)
}
trace add variable Colors(red) write RecordPreviousColor
trace add variable Colors(green) write RecordPreviousColor
trace add variable Colors(blue) write RecordPreviousColor


if {$TkEightFivePlusOnX11P} {
    font create MainFont -family Courier -size 11
    font create ListFont -family Courier -size 10
} else {
    font create MainFont -family Courier -size 13
    font create ListFont -family Courier -size 12
}

#Figure out what system we are running on
if {[string equal $tcl_platform(platform) windows]} {
    set System MSWindows;
} elseif {[string equal $tcl_platform(platform) unix]} {
    if {[string equal $tcl_platform(os) Darwin]} {
	set System MacOSX;
    } else {
	set System Unix;
    }
}

switch $System {
    Unix {
	event add <<B3>> <ButtonPress-3>
	event add <<B3Release>> <ButtonRelease-3>
    }
    MacOSX {
	event add <<B3>> <Control-ButtonPress-1>
	event add <<B3Release>> <Control-ButtonRelease-1>
    }
    MSWindows {
	event add <<B3>> <ButtonPress-3>
	event add <<B3Release>> <ButtonRelease-3>
    }
}

proc ScrollbarMoveBigIncrement {w f x y} {
    set part [$w identify $x $y]
    switch -exact -- $part {
	trough1 {
	    set dir -1;
	}
	arrow1 {
	    set dir -1;
	}
	trough2 {
	    set dir  1;
	}
	arrow2 {
	    set dir  1;
	}
	default {
	    return ;
	}
    }
    set CurrentFraction [lindex [$w get] 0]
    set NewFraction [expr $CurrentFraction + ($dir * $f)]
    eval [concat [$w cget -command] moveto $NewFraction]
}

proc ScaleMoveBigIncrement {w k x y} {
    set part [$w identify $x $y]
    set inc 0;
    switch -exact -- $part {
	trough1 {
	    set dir -1;
	}
	trough2 {
	    set dir  1;
	}
	default {
	    return ;
	}
    }
    set Resolution [$w cget -resolution]
    set CurrentValue [$w get]
    set Delta [expr $dir * $k * $Resolution]
    $w set [expr $CurrentValue + $Delta]
}

if {[string match $::System MSWindows]} {

    proc ToggleKeepMainOnTop {} {
	if {!$::KeepMainOnTopP} {
	    after cancel $::MainAfterID
	} else {
	    if {[winfo exists .]} {
		raise .
		set ::MainAfterID [after 1000 [info level 0]]
	    }
	}
    }
    
    proc ToggleKeepHistoryListOnTop {} {
	if {!$::KeepHistoryListOnTopP} {
	    after cancel $::HistoryListAfterID
	} else {
	    if {[winfo exists .hl]} {
		raise .hl
		set ::HistoryListAfterID [after 1000 [info level 0]]
	    }
	}
    }

} else {
    proc ToggleKeepMainOnTop {} {
	if {[winfo exists .]} {
	    if {!$::KeepMainOnTopP} {
		bind . <Visibility> ""
	    } else {
		bind . <Visibility> {
		    if {[string match %W .] &&
			[string compare %s VisibilityUnobscured]} {
			raise %W
			update
		    }
		}
	    }
	}
    }
    
    proc ToggleKeepHistoryListOnTop {} {
	if {[winfo exists .hl]} {
	    if {!$::KeepHistoryListOnTopP} {
		bind .hl <Visibility> ""
	    } else {
		bind .hl <Visibility> {
		    if {[string match %W .hl] &&
			[string compare %s VisibilityUnobscured]} {
			raise %W
			update
		    }
		}
	    }
	}
    }
}



proc CreateTextDisplay {title width height {bg "\#000000"} {fg "\#000000"} } {
    if {[string equal $bg $fg]} {
	set abg $::ColorSpecs(InfoPopup,Background)
	set afg $::ColorSpecs(InfoPopup,Foreground)
    } else {
	set abg $bg;
	set afg $fg;
    }
    set top [CreateDialog Textdisplay]
    wm title $top $title
    set info [dialog_info $top]
    set sb [scrollbar $info.sbar -command "$info.text yview" ]
    lappend ::ScrollbarList  $sb;
    set ::PackCommand($sb) [list pack $info.sbar -side right -fill y]
    pack $info.sbar -side right -fill y
    bind $info.sbar <<B3>> "ScrollbarMoveBigIncrement $info.sbar 0.10 %x %y"
    text $info.text -height $height -width $width -font MainFont -wrap word \
	-yscrollcommand "$info.sbar set"  -exportselection 1 \
	-background $abg -foreground $afg
    pack $info.text -side left -expand yes -fill both
    $info.text configure -state disabled
    return $top
}

proc OSName {} {
    set OS $::tcl_platform(os);
    if {$OS == "Linux"} {set OS "GNU/Linux"};
    return [format "%s %s" $OS  $::tcl_platform(osVersion)]
}

proc AppendToTextDisplay {top mesg {col 0}} {
    set info [dialog_info $top]
    $info.text configure -state normal
    if {$col > 0} {
	$info.text configure -tabs [list $col]
    }
    $info.text insert end $mesg
    $info.text configure -state disabled
}

set AboutPopup "";
proc About {} {
    global Version;
    global AboutPopup

    if {[winfo exists $AboutPopup]} {
	destroy $AboutPopup;
	return
    }
    set AboutPopup [CreateTextDisplay [_ "About"] 60 8];
    AppendToTextDisplay $AboutPopup [format [_ "This is ColorExplorer version %s, Copyright 2005, 2008 William J. Poser.\n\n"] $Version];
    AppendToTextDisplay $AboutPopup [_ "You can obtain the latest version of ColorExplorer from: http://www.billposer.org/Software/ColorExplorer.html.\n\n"];
    AppendToTextDisplay $AboutPopup [_ "ColorExplorer is free software; you can redistribute it and/or modify it under the terms of version 3 of the GNU General Public License as published by the Free Software Foundation.\n\n"]
    AppendToTextDisplay $AboutPopup [_ "Send bug reports to: billposer@alum.mit.edu.\n\n"];
    AppendToTextDisplay $AboutPopup [_ "Please include the following information:\n\n"];
    AppendToTextDisplay $AboutPopup [_ "  What version of the program are you using?\n"];
    AppendToTextDisplay $AboutPopup [format [_ "    (This is version %s \[%s\].)\n\n"] $Version [ProgramTimeDateStamp]];
    AppendToTextDisplay $AboutPopup [_ "  What operating system are you running?.\n"];
    AppendToTextDisplay $AboutPopup [format [_ "    (This is %s.)\n\n"] [OSName]];
    AppendToTextDisplay $AboutPopup [_ "  What window system are you using?.\n"];
    AppendToTextDisplay $AboutPopup [format [_ "    (This is %s.)\n\n"] $::WindowSystem]
    AppendToTextDisplay $AboutPopup [_ "  What version of tcl/tk are you using?.\n"];
    AppendToTextDisplay $AboutPopup [format [_ "    (This is version %s.)\n\n"] [info patchlevel]];

    if {$::XorisOKP} {
	AppendToTextDisplay $AboutPopup [_ "\nThe ability to copy the color from a chosen pixel depends on Alexander Gromnizki's xoris program, which is distributed under the MIT/X Consortium License.\n"];
    } else {
	AppendToTextDisplay $AboutPopup [_ "Color copying is not available because "];
	if {$::WindowSystemX11P} {
	    AppendToTextDisplay $AboutPopup [_ "the Xoris program is not available on this system.\n"];
	} else {
	    AppendToTextDisplay $AboutPopup [_ "this system is not running the X11 window system.\n"];
	}
    }
}

set HelpPopup "";
proc Help {} {
    global Version;
    global HelpPopup

    if {[winfo exists $HelpPopup]} {
	destroy $HelpPopup;
	return
    }
    set HelpPopup [CreateTextDisplay [_ "Help"] 56 8];
    AppendToTextDisplay $HelpPopup [_ "ColorExplorer is a tool for exploring the color space and\
finding out how colors, color names, and numerical color specifications are related. You can specify a color by selecting its name from a list of color names, by adjusting sliders that control the mixture of red, green, and blue, or by entering a numerical color specification. The numerical specification of the current color and an example of that color are shown in a pair of adjacent boxes.\n\n"]
    AppendToTextDisplay $HelpPopup [_ "You can lock any two colors or all three colors together by clicking on one of the lock buttons. When colors are locked, changing one changes the others to which it is locked by the same amount.\n\n"];
    AppendToTextDisplay $HelpPopup [_ "You can search the list of color names by entering a regular expression in the entry box in the lower right corner. Clicking the 'Find' button searches for a match starting at the beginning of the list. Clicking the 'Find Again' button searches for a match starting from the previous match.\n\n"];
    if {$::XorisOKP} {
	AppendToTextDisplay $HelpPopup [_ "You can set the color to the same color as any pixel on your display by clicking on the 'Copy' button and then left-clicking with the pointer over the pixel of interest.\n\n"]
    }
    AppendToTextDisplay $HelpPopup [_ "You can find out what named color is closest to the current color by clicking on the 'Closest' button. Here 'closest' means 'closest in Euclidean distance in RGB coordinates'.\n\n"]
    AppendToTextDisplay $HelpPopup [_ "Another way to find an interesting color is to ask for a random color by clicking the 'Random' button."]
    AppendToTextDisplay $HelpPopup "\n\n"
    AppendToTextDisplay $HelpPopup [_ "Every color is recorded on a history list. Click the History button to display the history list. Each entry shows the numerical color specification over a background in the color. Double-click on a history entry to make it the current color."]
}

#Set up balloon help
option add *Balloonhelp*background white widgetDefault
option add *Balloonhelp*foreground black widgetDefault
option add *Balloonhelpinfo.wrapLength 3i  widgetDefault
option add *Balloonhelp.info.justify left widgetDefault
toplevel .balloonhelp -class Balloonhelp -background black -borderwidth 1 -relief flat
#label .balloonhelp.arrow -anchor nw -bitmap @arrow.xbm
#pack .balloonhelp.arrow -side left -fill y
font create BalloonHelpFont -family lucida -size 13
label .balloonhelp.info -font BalloonHelpFont -bg $ColorSpecs(BalloonHelp,Background) \
 -fg $ColorSpecs(BalloonHelp,Foreground)
pack .balloonhelp.info -side left -fill y
wm overrideredirect .balloonhelp 1
wm withdraw .balloonhelp
set bhInfo(active) 1
array set OverlapP {}

set BalloonHelpP 1;

proc balloonhelp_control {state} {
     global bhInfo
     if {$state} {
          set bhInfo(active) 1
     } else {
	balloonhelp_cancel
	set bhInfo(active) 0
     }
}

proc balloonhelp_for {win mesg} {
    global bhInfo
    set bhInfo($win) $mesg
    set ::bhOverlapP($win) 1; 
    bind $win <Enter> {+balloonhelp_pending %W}
    bind $win <Leave> {+balloonhelp_cancel}
}

proc balloonhelpd_for {win mesg} {
    global bhInfo
    set ::bhOverlapP($win,d) 0;
    set bhInfo($win,d) $mesg
    bind $win <Enter> {+balloonhelp_show %W 1}
    bind $win <Leave> {+wm withdraw .balloonhelp}
}

proc balloonhelp_pending {win} {
     global bhInfo
     balloonhelp_cancel
    if {[info exist bhInfo($win,d)]} {
	set PendTime 2000;
    } else {
	set PendTime 1000;
    }
    set bhInfo(pending) [after $PendTime [list balloonhelp_show $win 0]]
}

proc balloonhelp_cancel {} {
    global bhInfo
    if { [info exists bhInfo(pending)]} {
	after cancel $bhInfo(pending)
	unset bhInfo(pending)
    }
    wm withdraw .balloonhelp
}

proc balloonhelp_show {win d} {
    global bhInfo;
    global bhOverlapP;
    if {$d} {
	set Overlap 75;
	set Text $bhInfo($win,d);
    } else { 
	set Overlap 25;
	set Text $bhInfo($win);
    }

    if {[winfo exists $win]} {
	if {$bhInfo(active)} {
	    .balloonhelp.info configure -text $Text;
	    #Set abcissa
	    set MaxStringWidth 0;
	    if {$d} {
		set Text $bhInfo($win,d)
	    } else {
		set Text $bhInfo($win)
	    }
	    foreach line [split $Text "\n"] {
		set StringWidth [font measure BalloonHelpFont -displayof .balloonhelp.info $line]
		if {$StringWidth > $MaxStringWidth} {
		    set MaxStringWidth $StringWidth;
		}
	    }
	    set ScreenWidth [winfo screenwidth $win]
	    set Width [winfo width $win];
	    set LeftEdge  [winfo rootx $win];
	    set RightEdge [expr $LeftEdge + $Width];
	    if {$ScreenWidth - $RightEdge < $MaxStringWidth} { 
		if {$LeftEdge > $MaxStringWidth} {
		    set x [expr $LeftEdge - $MaxStringWidth + $Overlap];
		} else {
		    if {$ScreenWidth - $MaxStringWidth > 0} {
			set x [expr $RightEdge - $MaxStringWidth];
		    } else {
			set x [expr $ScreenWidth - $MaxStringWidth];
		    }
		}
	    } else {
		set x [expr $RightEdge - $Overlap];
	    }
	    #Set ordinate
	    set Height [winfo height $win];
	    set TopEdge [winfo rooty $win];
	    set y [expr $TopEdge + int(($Height/1.25))];
	    wm geometry .balloonhelp +$x+$y
	    wm deiconify .balloonhelp
	    raise .balloonhelp
	}
    }
    if {[info exist bhInfo(pending)]} {
	unset bhInfo(pending)
    }
}

proc dialog_info {win} {
    return "$win.info"
}

proc CreateDialog {class {win "auto"}} {
    if {$win == "auto"} {
        set count 0
        set win ".ndialog[incr count]"
        while {[winfo exists $win]} {
            set win ".ndialog[incr count]"
        }
    }
    toplevel $win -class $class;
    frame $win.info
    pack $win.info -expand yes -fill both -padx 4 -pady 4
    wm title $win $class
    wm group $win .

    after idle [format {
        update idletasks
        wm minsize %s [winfo reqwidth %s] [winfo reqheight %s]
    } $win $win $win]

    return $win
}

proc SetHold {} {
    set ::HoldColor $::CurrentColor;
    $::HOLDEXAMPLE configure -bg $::RGB
}

proc ControlBalloonHelp {} {
    if {$::BalloonHelpP} {
	balloonhelp_control 1;
    } else {
	balloonhelp_control 0;
    }
}

proc SetColor {{rgb {}}} {
    global Colors EXAMPLE RGB

    if {[string comp {} $rgb]} {
	scan $rgb "\#%2x%2x%2x" red green blue
	foreach c {red green blue} {
	    set Colors($c) [format %d [set $c]]
	}
	set rgbtxt [format "%02.2X %02.2X %02.2X" $Colors(red) $Colors(green) $Colors(blue)]
    } else {
	set rgb [format "\#%02.2X%02.2X%02.2X" $Colors(red) $Colors(green) $Colors(blue)]
    }
    $EXAMPLE config -bg $rgb
    set RGB $rgb;			
    #Always record the color value in hex
    if {$::RecordHistoryP} {lappend ::HistoryList $RGB}
    PutColorText;
    update
}

proc UpdateHistoryDisplay {e o n} {
    if {[winfo exists .hl]} {
	if {[winfo ismapped .hl]} {
	    PopupHistoryList;
	}
    }
}

proc SetColorAux args { SetColor }

proc Search {args} {
    global SearchOffset;
    global ColorNameList;

    if {[llength $args]} {set SearchOffset 0}
    set re [.srch.search get]
    set ind [lsearch -start $SearchOffset  -regexp $ColorNameList (?i)$re]
    if {$ind < 0} {return}
    set ::SearchOffset [expr $ind + 1];
    ShowEntry $ind;
    return
}

proc ShowEntry {index} {
    global NAMES;
    global ColorNameList;
    global ColorSpecList;
    set id $::ID([lindex $::ColorNameList $index]);
    if {$id > 0} { 
	set lookid [expr $id -1]
    } else {
	set lookid $id;
    }
    set y [lindex [$NAMES.canvas coords $lookid] 1];
    set LastID $::ID([lindex $ColorNameList end])
    set LastY [lindex [$NAMES.canvas coords $LastID] 1];
    set fraction [expr $y/$LastY];
    $NAMES.canvas yview moveto $fraction;
    $NAMES.canvas focus $id;
    SetColor \#[string toupper [lindex $ColorSpecList $index]];
}

proc DoEntry {} {
    set Raw [$::ENT get]
    if {$::UseDecimalP} {
	set cs $Raw;
	if {![regexp {^(([0-2])?[[:digit:]])?[[:digit:]] (([0-2])?[[:digit:]])?[[:digit:]] (([0-2])?[[:digit:]])?[[:digit:]]$} $cs]} {
	    $::ENT delete 0 end
	    PutColorText
	    return;
	}
	scan $cs "%d %d %d" red green blue
	set cs [format "%02X%02X%02X" $red $green $blue]
    } else {
	set cs [string map {\u0020 ""} $Raw]
	if {![regexp {^[[:xdigit:]]{6}$} $cs]} {
	    $::ENT delete 0 end
	    PutColorText
	    return ;
	}
    }
    SetColor \#$cs 
}

#Returns the square of the Euclidean distance between two colors in RGB coordinates.
#(Since we're only interested in relative distance, there's no point in computing
#the square root.) In this program, with modern computers, it makes little difference,
#but there's no reason to be profligate with resources when the optimization
#is so easy.
proc ColorDistance {x y} {
    scan $x "%2x%2x%2x" rx gx bx
    scan $y "%2x%2x%2x" ry gy by
    set dr [expr $rx - $ry]
    set dg [expr $gx - $gy]
    set db [expr $bx - $by]
    return [expr ($dr*$dr) + ($dg*$dg) + ($db*$db)]
}

set MaximumColorDistance [ColorDistance 000000 FFFFFF];
proc FindClosestNamedColor {} {
    global MaximumColorDistance;
    global Colors

#    set tgt [string trimleft $::CurrentColor "\#"]
    set tgt [format "%02X%02X%02X" $Colors(red) $Colors(green) $Colors(blue)]

    set min $MaximumColorDistance;
    set BestColorIndex 0;
    set cnt 0;
    foreach cs $::ColorSpecList {
	set delta [ColorDistance $tgt $cs]
	if {$delta < $min} {
	    set min $delta;
	    set BestColorIndex $cnt;
	}
	incr cnt;
    }
    SetHold;
    ShowEntry $BestColorIndex;
    return
}

proc PickRandomColor {} {
    set SavedLock $::Lock
    set ::Lock 0
    set red   [expr int(256 * rand())]
    set green [expr int(256 * rand())]
    set blue  [expr int(256 * rand())]
    SetColor [format "\#%02x%02x%02x" $red $green $blue]
    set ::Lock $SavedLock
}

proc GreenLockedToRed {e o n} {
    set delta [expr $::Colors(red) - $::PreviousColors(red)]
    set NewGreen [expr $::Colors(green) + $delta]
    if {$NewGreen > 255} {
	set NewGreen 255;
    } elseif {$NewGreen < 0} {
	set NewGreen 0;
    }
    trace remove variable ::Colors(green) write RedLockedToGreen 
    set ::Colors(green) $NewGreen
    trace add variable ::Colors(green) write RedLockedToGreen 
}

proc RedLockedToGreen {e o n} {
    set delta [expr $::Colors(green) - $::PreviousColors(green)]
    set NewRed [expr $::Colors(red) + $delta]
    if {$NewRed > 255} {
	set NewRed 255;
    } elseif {$NewRed < 0} {
	set NewRed 0;
    }
    trace remove variable ::Colors(red) write GreenLockedToRed
    set ::Colors(red) $NewRed
    trace add variable ::Colors(red) write GreenLockedToRed
}

proc BlueLockedToGreen {e o n} {
    set delta [expr $::Colors(green) - $::PreviousColors(green)]
    set NewBlue [expr $::Colors(blue) + $delta]
    if {$NewBlue > 255} {
	set NewBlue 255;
    } elseif {$NewBlue < 0} {
	set NewBlue 0;
    }
    trace remove variable ::Colors(blue) write GreenLockedToBlue
    set ::Colors(blue) $NewBlue
    trace add variable ::Colors(blue) write GreenLockedToBlue
}

proc GreenLockedToBlue {e o n} {
    set delta [expr $::Colors(blue) - $::PreviousColors(blue)]
    set NewGreen [expr $::Colors(green) + $delta]
    if {$NewGreen > 255} {
	set NewGreen 255;
    } elseif {$NewGreen < 0} {
	set NewGreen 0;
    }
    trace remove variable ::Colors(green) write BlueLockedToGreen
    set ::Colors(green) $NewGreen
    trace add variable ::Colors(green) write BlueLockedToGreen
}

proc RedLockedToBlue {e o n} {
    set delta [expr $::Colors(blue) - $::PreviousColors(blue)]
    set NewRed [expr $::Colors(red) + $delta]
    if {$NewRed > 255} {
	set NewRed 255;
    } elseif {$NewRed < 0} {
	set NewRed 0;
    }
    trace remove variable ::Colors(red) write BlueLockedToRed
    set ::Colors(red) $NewRed
    trace add variable ::Colors(red) write BlueLockedToRed
}

proc BlueLockedToRed {e o n} {
    set delta [expr $::Colors(red) - $::PreviousColors(red)]
    set NewBlue [expr $::Colors(blue) + $delta]
    if {$NewBlue > 255} {
	set NewBlue 255;
    } elseif {$NewBlue < 0} {
	set NewBlue 0;
    }
    trace remove variable ::Colors(blue) write RedLockedToBlue 
    set ::Colors(blue) $NewBlue
    trace add variable ::Colors(blue) write RedLockedToBlue 
}

proc GreenBlueLockedToRed {e o n} {
    set delta [expr $::Colors(red) - $::PreviousColors(red)]
    set NewBlue [expr $::Colors(blue) + $delta]
    if {$NewBlue > 255} {
	set NewBlue 255;
    } elseif {$NewBlue < 0} {
	set NewBlue 0;
    }
    trace remove variable ::Colors(blue) write RedGreenLockedToBlue 
    set ::Colors(blue) $NewBlue
    trace add variable ::Colors(blue) write RedGreenLockedToBlue 

    set NewGreen [expr $::Colors(green) + $delta]
    if {$NewGreen > 255} {
	set NewGreen 255;
    } elseif {$NewGreen < 0} {
	set NewGreen 0;
    }
    trace remove variable ::Colors(green) write RedBlueLockedToGreen
    set ::Colors(green) $NewGreen
    trace add variable ::Colors(green) write RedBlueLockedToGreen
}

proc RedBlueLockedToGreen {e o n} {
    set delta [expr $::Colors(green) - $::PreviousColors(green)]
    set NewBlue [expr $::Colors(blue) + $delta]
    if {$NewBlue > 255} {
	set NewBlue 255;
    } elseif {$NewBlue < 0} {
	set NewBlue 0;
    }
    trace remove variable ::Colors(blue) write RedGreenLockedToBlue
    set ::Colors(blue) $NewBlue
    trace add variable ::Colors(blue) write RedGreenLockedToBlue 

    set NewRed [expr $::Colors(red) + $delta]
    if {$NewRed > 255} {
	set NewRed 255;
    } elseif {$NewRed < 0} {
	set NewRed 0;
    }
    trace remove variable ::Colors(red) write GreenBlueLockedToRed
    set ::Colors(red) $NewRed
    trace add variable ::Colors(red) write GreenBlueLockedToRed
}

proc RedGreenLockedToBlue {e o n} {
    set delta [expr $::Colors(blue) - $::PreviousColors(blue)]
    set NewRed [expr $::Colors(red) + $delta]
    if {$NewRed > 255} {
	set NewRed 255;
    } elseif {$NewRed < 0} {
	set NewRed 0;
    }
    trace remove variable ::Colors(red) write GreenBlueLockedToRed
    set ::Colors(red) $NewRed
    trace add variable ::Colors(red) write GreenBlueLockedToRed

    set NewGreen [expr $::Colors(green) + $delta]
    if {$NewGreen > 255} {
	set NewGreen 255;
    } elseif {$NewGreen < 0} {
	set NewGreen 0;
    }
    trace remove variable ::Colors(green) write RedBlueLockedToGreen
    set ::Colors(green) $NewGreen
    trace add variable ::Colors(green) write RedBlueLockedToGreen
}


proc SetupLock {e o n} {
    global Lock
    switch -exact -- $Lock {
	0 {
	    trace remove variable ::Colors(red) write   GreenLockedToRed
	    trace remove variable ::Colors(green) write RedLockedToGreen
	    trace remove variable ::Colors(red) write   BlueLockedToRed
	    trace remove variable ::Colors(blue) write RedLockedToBlue
	    trace remove variable ::Colors(green) write BlueLockedToGreen
	    trace remove variable ::Colors(blue) write GreenLockedToBlue
	    trace remove variable ::Colors(green) write RedBlueLockedToGreen
	    trace remove variable ::Colors(blue) write RedGreenLockedToBlue
	    trace remove variable ::Colors(red) write   GreenBlueLockedToRed
	}
	1 {
	    trace add variable ::Colors(red) write GreenLockedToRed
	    trace add variable ::Colors(green) write RedLockedToGreen
	    trace remove variable ::Colors(red) write   BlueLockedToRed
	    trace remove variable ::Colors(blue) write RedLockedToBlue
	    trace remove variable ::Colors(green) write BlueLockedToGreen
	    trace remove variable ::Colors(blue) write GreenLockedToBlue
	    trace remove variable ::Colors(green) write RedBlueLockedToGreen
	    trace remove variable ::Colors(blue) write RedGreenLockedToBlue
	    trace remove variable ::Colors(red) write   GreenBlueLockedToRed
	}
	2 {
	    trace add variable ::Colors(red) write BlueLockedToRed
	    trace add variable ::Colors(blue) write RedLockedToBlue
	    trace remove variable ::Colors(red) write   GreenLockedToRed
	    trace remove variable ::Colors(green) write BlueLockedToGreen
	    trace remove variable ::Colors(blue) write GreenLockedToBlue
	    trace remove variable ::Colors(green) write RedLockedToGreen
	    trace remove variable ::Colors(green) write RedBlueLockedToGreen
	    trace remove variable ::Colors(blue) write RedGreenLockedToBlue
	    trace remove variable ::Colors(red) write   GreenBlueLockedToRed
	}
	3 {
	    trace add variable ::Colors(green) write BlueLockedToGreen
	    trace add variable ::Colors(blue) write GreenLockedToBlue
	    trace remove variable ::Colors(red) write   GreenLockedToRed
	    trace remove variable ::Colors(green) write RedLockedToGreen
	    trace remove variable ::Colors(red) write   BlueLockedToRed
	    trace remove variable ::Colors(blue) write RedLockedToBlue
	    trace remove variable ::Colors(green) write RedBlueLockedToGreen
	    trace remove variable ::Colors(blue) write RedGreenLockedToBlue
	    trace remove variable ::Colors(red) write   GreenBlueLockedToRed
	}
	4 {
	    trace add variable ::Colors(green) write RedBlueLockedToGreen
	    trace add variable ::Colors(blue) write RedGreenLockedToBlue
	    trace add variable ::Colors(red) write   GreenBlueLockedToRed
	    trace remove variable ::Colors(red) write   GreenLockedToRed
	    trace remove variable ::Colors(green) write RedLockedToGreen
	    trace remove variable ::Colors(red) write   BlueLockedToRed
	    trace remove variable ::Colors(blue) write RedLockedToBlue
	    trace remove variable ::Colors(green) write BlueLockedToGreen
	    trace remove variable ::Colors(blue) write GreenLockedToBlue
	}
    }
}

trace add variable Lock write SetupLock

proc SelectionHandler {w} {
    clipboard clear;
    if {[catch {selection get} sel] == 0} {
	clipboard append $sel;
    }
}

proc binop {a op b} {
    set la [string length $a]
    set lb [string length $b]
    if {$la>$lb} {
        set b [string repeat 0 [expr {$la-$lb}]]$b
    } elseif {$la<$lb} {
        set a [string repeat 0 [expr {$lb-$la}]]$a
    }
    set res ""
    foreach i [split $a ""] j [split $b ""] {
        append res [expr $i $op $j]
    }
    regsub ^0+ $res "" res     ;# suppress leading zeroes
    expr {$res eq ""? 0: $res} ;# but not with 0
 }

proc ToggleHistoryList {} {
    if {[winfo exists .hl] &&  [winfo ismapped .hl]} {
	destroy .hl
    } else {
	PopupHistoryList
    }
}

proc PopupHistoryList {} {
    global ColorSpecs
    set MaxHeight 12
    set Entries [llength $::HistoryList]
    if {$Entries == 0} {return}
    if {[winfo exists .hl] == 0} {toplevel .hl}
    wm title .hl "History"
    destroy .hl.hlist
    destroy .hl.sbar
    if {$Entries > $MaxHeight} {
	set Height $MaxHeight
    } else {set Height $Entries}
    if {$::UseDecimalP} {set Width 15} else {set Width 12}
    listbox .hl.hlist -height $Height -width $Width -font MainFont \
	-fg $ColorSpecs(HistoryList,Foreground) \
	-bg $ColorSpecs(HistoryList,Background) -yscrollcommand {.hl.sbar set} \
	-selectbackground white
    scrollbar .hl.sbar -command {.hl.hlist yview} \
	-trough $::ColorSpecs(HistoryList,Background);
    pack .hl.hlist -side left -expand 1 -fill both -anchor w
    pack .hl.sbar  -side left -expand 0 -fill y    -anchor w
    bind .hl.sbar <<B3>> "ScrollbarMoveBigIncrement .hl.sbar 0.20 %x %y"
    set cnt -1
    foreach e $::HistoryList {
	incr cnt
	scan $e "\#%2x%2x%2x" r g b
	set InternalColor [format "%02X%02X%02X" $r $g $b]
	if {$::UseDecimalP} {
	    set text [format "  %03d %03d %03d  " $r $g $b]
	} else {
	    set text [format "  %02X %02X %02X  " $r $g $b]
	}
	.hl.hlist insert 0 $text
	set sum [expr $r+$g+$b]
	if {$sum <384} {set TextColor white } else { set TextColor black }
	.hl.hlist itemconfigure 0 -background \#$InternalColor -foreground $TextColor
	.hl.hlist itemconfigure 0 -selectbackground \#$InternalColor \
	    -selectforeground $TextColor
	bind .hl.hlist <Double-Button-1>  InsertHistoryEntry
	balloonhelp_for .hl.hlist  \
	    [_ "Double click to make a history entry the current color."];
    }
}

proc InsertHistoryEntry {} {
    set Color [.hl.hlist get active];
    if {$::UseDecimalP} {
	scan $Color "%3d%3d%3d" r g b
    } else {
	scan $Color "%2x%2x%2x" r g b
    }
    set ::Colors(red)  $r;
    set ::Colors(green) $g;
    set ::Colors(blue) $b;
    SetColor [format "\#%02X%02X%02X" $r $g $b]
}

proc  SetX11ColorDefinitions {} {
    global NamesToColors
    set NamesToColors(gray)   bebebe
    set NamesToColors(green)  00ff00
    set NamesToColors(maroon) b03060
    set NamesToColors(purple) a020f0
}

proc  SetHTMLColorDefinitions {} {
    global NamesToColors
    set NamesToColors(gray)   808080
    set NamesToColors(green)  008000
    set NamesToColors(maroon) 800000
    set NamesToColors(purple) 800080
}

proc ToggleColorScheme {} {
    if {$::HTMLP} {
	SetHTMLColorDefinitions
    } else {
	SetX11ColorDefinitions
    }
    InvertArray
    FillColorNameList
}

array set NamesToColors {
    snow fffafa
    {ghost white} f8f8ff
    {white smoke} f5f5f5
    gainsboro dcdcdc
    {floral white} fffaf0
    {old lace} fdf5e6
    linen faf0e6
    {antique white} faebd7
    {papaya whip} ffefd5
    {blanched almond} ffebcd
    bisque ffe4c4
    {peach puff} ffdab9
    {navajo white} ffdead
    moccasin ffe4b5
    cornsilk fff8dc
    ivory fffff0
    {lemon chiffon} fffacd
    seashell fff5ee
    honeydew f0fff0
    {mint cream} f5fffa
    azure f0ffff
    {alice blue} f0f8ff
    lavender e6e6fa
    {lavender blush} fff0f5
    {misty rose} ffe4e1
    white ffffff
    black 000000
    {dark slate gray} 2f4f4f
    {dim gray} 696969
    {slate gray} 708090
    {light slate gray} 778899
    gray bebebe
    {light grey} d3d3d3
    {midnight blue} 191970
    navy 000080
    {cornflower blue} 6495ed
    {dark slate blue} 483d8b
    {slate blue} 6a5acd
    {medium slate blue} 7b68ee
    {light slate blue} 8470ff
    {medium blue} 0000cd
    {royal blue} 4169e1
    blue 0000ff
    {dodger blue} 1e90ff
    {deep sky blue} 00bfff
    {sky blue} 87ceeb
    {light sky blue} 87cefa
    {steel blue} 4682b4
    {light steel blue} b0c4de
    {light blue} add8e6
    {powder blue} b0e0e6
    {pale turquoise} afeeee
    {dark turquoise} 00ced1
    {medium turquoise} 48d1cc
    turquoise 40e0d0
    cyan 00ffff
    {light cyan} e0ffff
    {cadet blue} 5f9ea0
    {medium aquamarine} 66cdaa
    aquamarine 7fffd4
    {dark green} 006400
    {dark olive green} 556b2f
    {dark sea green} 8fbc8f
    {sea green} 2e8b57
    {medium sea green} 3cb371
    {light sea green} 20b2aa
    {pale green} 98fb98
    {spring green} 00ff7f
    {lawn green} 7cfc00
    green 00ff00
    chartreuse 7fff00
    {medium spring green} 00fa9a
    {green yellow} adff2f
    {lime green} 32cd32
    {yellow green} 9acd32
    {forest green} 228b22
    {olive drab} 6b8e23
    {dark khaki} bdb76b
    khaki f0e68c
    {pale goldenrod} eee8aa
    {light goldenrod yellow} fafad2
    {light yellow} ffffe0
    yellow ffff00
    gold ffd700
    {light goldenrod} eedd82
    goldenrod daa520
    {dark goldenrod} b8860b
    {rosy brown} bc8f8f
    {indian red} cd5c5c
    {saddle brown} 8b4513
    sienna a0522d
    peru cd853f
    burlywood deb887
    beige f5f5dc
    wheat f5deb3
    {sandy brown} f4a460
    tan d2b48c
    chocolate d2691e
    firebrick b22222
    brown a52a2a
    {dark salmon} e9967a
    salmon fa8072
    {light salmon} ffa07a
    orange ffa500
    {dark orange} ff8c00
    coral ff7f50
    {light coral} f08080
    tomato ff6347
    {orange red} ff4500
    red ff0000
    {hot pink} ff69b4
    {deep pink} ff1493
    pink ffc0cb
    {light pink} ffb6c1
    {pale violet red} db7093
    maroon b03060
    {medium violet red} c71585
    {violet red} d02090
    magenta ff00ff
    violet ee82ee
    plum dda0dd
    orchid da70d6
    {medium orchid} ba55d3
    {dark orchid} 9932cc
    {dark violet} 9400d3
    {blue violet} 8a2be2
    purple a020f0
    {medium purple} 9370db
    thistle d8bfd8
    snow2 eee9e9
    snow3 cdc9c9
    snow4 8b8989
    seashell2 eee5de
    seashell3 cdc5bf
    seashell4 8b8682
    AntiqueWhite1 ffefdb
    AntiqueWhite2 eedfcc
    AntiqueWhite3 cdc0b0
    AntiqueWhite4 8b8378
    bisque2 eed5b7
    bisque3 cdb79e
    bisque4 8b7d6b
    PeachPuff2 eecbad
    PeachPuff3 cdaf95
    PeachPuff4 8b7765
    NavajoWhite2 eecfa1
    NavajoWhite3 cdb38b
    NavajoWhite4 8b795e
    LemonChiffon2 eee9bf
    LemonChiffon3 cdc9a5
    LemonChiffon4 8b8970
    cornsilk2 eee8cd
    cornsilk3 cdc8b1
    cornsilk4 8b8878
    ivory2 eeeee0
    ivory3 cdcdc1
    ivory4 8b8b83
    honeydew2 e0eee0
    honeydew3 c1cdc1
    honeydew4 838b83
    LavenderBlush2 eee0e5
    LavenderBlush3 cdc1c5
    LavenderBlush4 8b8386
    MistyRose2 eed5d2
    MistyRose3 cdb7b5
    MistyRose4 8b7d7b
    azure2 e0eeee
    azure3 c1cdcd
    azure4 838b8b
    SlateBlue1 836fff
    SlateBlue2 7a67ee
    SlateBlue3 6959cd
    SlateBlue4 473c8b
    RoyalBlue1 4876ff
    RoyalBlue2 436eee
    RoyalBlue3 3a5fcd
    RoyalBlue4 27408b
    blue2 0000ee
    blue4 00008b
    DodgerBlue2 1c86ee
    DodgerBlue3 1874cd
    DodgerBlue4 104e8b
    SteelBlue1 63b8ff
    SteelBlue2 5cacee
    SteelBlue3 4f94cd
    SteelBlue4 36648b
    DeepSkyBlue2 00b2ee
    DeepSkyBlue3 009acd
    DeepSkyBlue4 00688b
    SkyBlue1 87ceff
    SkyBlue2 7ec0ee
    SkyBlue3 6ca6cd
    SkyBlue4 4a708b
    LightSkyBlue1 b0e2ff
    LightSkyBlue2 a4d3ee
    LightSkyBlue3 8db6cd
    LightSkyBlue4 607b8b
    SlateGray1 c6e2ff
    SlateGray2 b9d3ee
    SlateGray3 9fb6cd
    SlateGray4 6c7b8b
    LightSteelBlue1 cae1ff
    LightSteelBlue2 bcd2ee
    LightSteelBlue3 a2b5cd
    LightSteelBlue4 6e7b8b
    LightBlue1 bfefff
    LightBlue2 b2dfee
    LightBlue3 9ac0cd
    LightBlue4 68838b
    LightCyan2 d1eeee
    LightCyan3 b4cdcd
    LightCyan4 7a8b8b
    PaleTurquoise1 bbffff
    PaleTurquoise2 aeeeee
    PaleTurquoise3 96cdcd
    PaleTurquoise4 668b8b
    CadetBlue1 98f5ff
    CadetBlue2 8ee5ee
    CadetBlue3 7ac5cd
    CadetBlue4 53868b
    turquoise1 00f5ff
    turquoise2 00e5ee
    turquoise3 00c5cd
    turquoise4 00868b
    cyan2 00eeee
    cyan3 00cdcd
    cyan4 008b8b
    DarkSlateGray1 97ffff
    DarkSlateGray2 8deeee
    DarkSlateGray3 79cdcd
    DarkSlateGray4 528b8b
    aquamarine2 76eec6
    aquamarine4 458b74
    DarkSeaGreen1 c1ffc1
    DarkSeaGreen2 b4eeb4
    DarkSeaGreen3 9bcd9b
    DarkSeaGreen4 698b69
    SeaGreen1 54ff9f
    SeaGreen2 4eee94
    SeaGreen3 43cd80
    PaleGreen1 9aff9a
    PaleGreen2 90ee90
    PaleGreen3 7ccd7c
    PaleGreen4 548b54
    SpringGreen2 00ee76
    SpringGreen3 00cd66
    SpringGreen4 008b45
    green2 00ee00
    green3 00cd00
    green4 008b00
    chartreuse2 76ee00
    chartreuse3 66cd00
    chartreuse4 458b00
    OliveDrab1 c0ff3e
    OliveDrab2 b3ee3a
    OliveDrab4 698b22
    DarkOliveGreen1 caff70
    DarkOliveGreen2 bcee68
    DarkOliveGreen3 a2cd5a
    DarkOliveGreen4 6e8b3d
    khaki1 fff68f
    khaki2 eee685
    khaki3 cdc673
    khaki4 8b864e
    LightGoldenrod1 ffec8b
    LightGoldenrod2 eedc82
    LightGoldenrod3 cdbe70
    LightGoldenrod4 8b814c
    LightYellow2 eeeed1
    LightYellow3 cdcdb4
    LightYellow4 8b8b7a
    yellow2 eeee00
    yellow3 cdcd00
    yellow4 8b8b00
    gold2 eec900
    gold3 cdad00
    gold4 8b7500
    goldenrod1 ffc125
    goldenrod2 eeb422
    goldenrod3 cd9b1d
    goldenrod4 8b6914
    DarkGoldenrod1 ffb90f
    DarkGoldenrod2 eead0e
    DarkGoldenrod3 cd950c
    DarkGoldenrod4 8b6508
    RosyBrown1 ffc1c1
    RosyBrown2 eeb4b4
    RosyBrown3 cd9b9b
    RosyBrown4 8b6969
    IndianRed1 ff6a6a
    IndianRed2 ee6363
    IndianRed3 cd5555
    IndianRed4 8b3a3a
    sienna1 ff8247
    sienna2 ee7942
    sienna3 cd6839
    sienna4 8b4726
    burlywood1 ffd39b
    burlywood2 eec591
    burlywood3 cdaa7d
    burlywood4 8b7355
    wheat1 ffe7ba
    wheat2 eed8ae
    wheat3 cdba96
    wheat4 8b7e66
    tan1 ffa54f
    tan2 ee9a49
    tan4 8b5a2b
    chocolate1 ff7f24
    chocolate2 ee7621
    chocolate3 cd661d
    firebrick1 ff3030
    firebrick2 ee2c2c
    firebrick3 cd2626
    firebrick4 8b1a1a
    brown1 ff4040
    brown2 ee3b3b
    brown3 cd3333
    brown4 8b2323
    salmon1 ff8c69
    salmon2 ee8262
    salmon3 cd7054
    salmon4 8b4c39
    LightSalmon2 ee9572
    LightSalmon3 cd8162
    LightSalmon4 8b5742
    orange2 ee9a00
    orange3 cd8500
    orange4 8b5a00
    DarkOrange1 ff7f00
    DarkOrange2 ee7600
    DarkOrange3 cd6600
    DarkOrange4 8b4500
    coral1 ff7256
    coral2 ee6a50
    coral3 cd5b45
    coral4 8b3e2f
    tomato2 ee5c42
    tomato3 cd4f39
    tomato4 8b3626
    OrangeRed2 ee4000
    OrangeRed3 cd3700
    OrangeRed4 8b2500
    red2 ee0000
    red3 cd0000
    red4 8b0000
    DeepPink2 ee1289
    DeepPink3 cd1076
    DeepPink4 8b0a50
    HotPink1 ff6eb4
    HotPink2 ee6aa7
    HotPink3 cd6090
    HotPink4 8b3a62
    pink1 ffb5c5
    pink2 eea9b8
    pink3 cd919e
    pink4 8b636c
    LightPink1 ffaeb9
    LightPink2 eea2ad
    LightPink3 cd8c95
    LightPink4 8b5f65
    PaleVioletRed1 ff82ab
    PaleVioletRed2 ee799f
    PaleVioletRed3 cd6889
    PaleVioletRed4 8b475d
    maroon1 ff34b3
    maroon2 ee30a7
    maroon3 cd2990
    maroon4 8b1c62
    VioletRed1 ff3e96
    VioletRed2 ee3a8c
    VioletRed3 cd3278
    VioletRed4 8b2252
    magenta2 ee00ee
    magenta3 cd00cd
    magenta4 8b008b
    orchid1 ff83fa
    orchid2 ee7ae9
    orchid3 cd69c9
    orchid4 8b4789
    plum1 ffbbff
    plum2 eeaeee
    plum3 cd96cd
    plum4 8b668b
    MediumOrchid1 e066ff
    MediumOrchid2 d15fee
    MediumOrchid3 b452cd
    MediumOrchid4 7a378b
    DarkOrchid1 bf3eff
    DarkOrchid2 b23aee
    DarkOrchid3 9a32cd
    DarkOrchid4 68228b
    purple1 9b30ff
    purple2 912cee
    purple3 7d26cd
    purple4 551a8b
    MediumPurple1 ab82ff
    MediumPurple2 9f79ee
    MediumPurple3 8968cd
    MediumPurple4 5d478b
    thistle1 ffe1ff
    thistle2 eed2ee
    thistle3 cdb5cd
    thistle4 8b7b8b
    gray1 030303
    gray2 050505
    gray3 080808
    gray4 0a0a0a
    gray5 0d0d0d
    gray6 0f0f0f
    gray7 121212
    gray8 141414
    gray9 171717
    gray10 1a1a1a
    gray11 1c1c1c
    gray12 1f1f1f
    gray13 212121
    gray14 242424
    gray15 262626
    gray16 292929
    gray17 2b2b2b
    gray18 2e2e2e
    gray19 303030
    gray20 333333
    gray21 363636
    gray22 383838
    gray23 3b3b3b
    gray24 3d3d3d
    gray25 404040
    gray26 424242
    gray27 454545
    gray28 474747
    gray29 4a4a4a
    gray30 4d4d4d
    gray31 4f4f4f
    gray32 525252
    gray33 545454
    gray34 575757
    gray35 595959
    gray36 5c5c5c
    gray37 5e5e5e
    gray38 616161
    gray39 636363
    gray40 666666
    gray42 6b6b6b
    gray43 6e6e6e
    gray44 707070
    gray45 737373
    gray46 757575
    gray47 787878
    gray48 7a7a7a
    gray49 7d7d7d
    gray50 7f7f7f
    gray51 828282
    gray52 858585
    gray53 878787
    gray54 8a8a8a
    gray55 8c8c8c
    gray56 8f8f8f
    gray57 919191
    gray58 949494
    gray59 969696
    gray60 999999
    gray61 9c9c9c
    gray62 9e9e9e
    gray63 a1a1a1
    gray64 a3a3a3
    gray65 a6a6a6
    gray66 a8a8a8
    gray67 ababab
    gray68 adadad
    gray69 b0b0b0
    gray70 b3b3b3
    gray71 b5b5b5
    gray72 b8b8b8
    gray73 bababa
    gray74 bdbdbd
    gray75 bfbfbf
    gray76 c2c2c2
    gray77 c4c4c4
    gray78 c7c7c7
    gray79 c9c9c9
    gray80 cccccc
    gray81 cfcfcf
    gray82 d1d1d1
    gray83 d4d4d4
    gray84 d6d6d6
    gray85 d9d9d9
    gray86 dbdbdb
    gray87 dedede
    gray88 e0e0e0
    gray89 e3e3e3
    gray90 e5e5e5
    gray91 e8e8e8
    gray92 ebebeb
    gray93 ededed
    gray94 f0f0f0
    gray95 f2f2f2
    gray96 f5f5f5
    gray97 f7f7f7
    gray98 fafafa
    gray99 fcfcfc
}


proc InvertArray {} {
    global ColorsToNames
    global NamesToColors
    foreach n [array names NamesToColors] {
	set v $NamesToColors($n)
	set ColorsToNames($v) $n
    }
}

#Make colors with similar names sort together
proc ColorNameCompare {a b} {
    set AMain [lindex [split $a] end]
    set BMain [lindex [split $b] end]
    set A [string trim [regsub -nocase \
	    ^(dark|deep|hot|medium|light|forest|antique|indian|pale|misty|royal|mint) $AMain ""]]
    set B [string trim [regsub -nocase \
	    ^(dark|deep|hot|medium|light|forest|antique|indian|pale|misty|royal|mint) $BMain ""]]
    set A [string trim [regsub -nocase  \
	    ^(sky|slate|steel|powder|midnight|dim|dodger|cadet|lime|sea|olive|spring) $A ""]]
    set B [string trim [regsub -nocase  \
	    ^(sky|slate|steel|powder|midnight|dim|dodger|cadet|lime|sea|olive|spring) $B ""]]
    set cr [string compare -nocase $A $B]
    if {$cr != 0} {
	return $cr;
    } else {
	set LengthA [string length $a]
	set LengthB [string length $b]
	set cr [expr $LengthA - $LengthB]
	if {$cr != 0} {
	    return $cr;
	} else {
	    set cr [string compare -nocase $a $b]
	    if {$cr != 0} {
		return $cr;
	    } else {
		return [string compare $a $b]
	    }
	}
    }
}

proc FillColorNameList {} {
    global NamesToColors
    set mark 0
    foreach n [lsort -command ColorNameCompare [array names NamesToColors]] {
	set v $NamesToColors($n)
	scan $v "%2x%2x%2x" r g b
	set sum [expr $r+$g+$b]
	if {$sum <384} {set TextColor white } else { set TextColor black }
	set cs \#[string toupper $v]
	$::ColorNameListCanvas create rect 0 $mark $::ItemWidth [incr mark 30] \
	    -fill $cs -outline $TextColor -tags $cs
	#Store the id associated with the text for use in searches.
	set ::ID($n) \
	    [$::ColorNameListCanvas create text 10 [expr $mark-15] -text $n -font ListFont -fill $TextColor -tags $n -anchor w]

	$::ColorNameListCanvas bind $cs <ButtonPress-1> "SetColor $cs"
	$::ColorNameListCanvas bind $cs <Enter> "SetColorBalloon [list $n] %y"
    }
    $::ColorNameListCanvas config -scrollregion "0 0 200 $mark"
}

proc SetColorBalloon {cname y} {
    .balloonhelp.info configure -text $cname
    set gl [split [wm geometry .balloonhelp] "=x+-"]
    set x [lindex $gl 2]
    set y [expr $y + 50]
    wm geometry .balloonhelp +$x+$y
}

#Sets the color to the color of a chosen pixel using the separate program xoris.
#Works only on X11. We validate the form of the color spec since the user
#might mistakenly control-click or control-shift-click and thus generate
#the information in an uninterpretable format.
proc GetPixelColor {} {
    set SavedLock $::Lock
    set ::Lock 0
    if {[catch {exec xoris} cspec] == 0} {
	if {[regexp {#[[:xdigit:]]{6}} $cspec]} {
	    SetColor $cspec
	}
    }
    set ::Lock $SavedLock
}

proc ColorPicker {} {
    global NamesToColors
    wm title . "ColorExplorer $::Version";
    set CurrentColor \#FFFFFF
    #Major pieces
    set NOT  [frame .not]
    set BARS [frame $NOT.bars]
    set ::NAMES [frame .c -relief ridge -bd 2]
    set ::ENT [entry $NOT.ent -width 9 -relief sunken -border 2 -exportselection 1\
		   -font [font create -size 14 -weight bold] -justify center\
		   -textvariable CurrentColor]
    set HOLDRDT [label $NOT.rdt2 -textvariable HoldColor -width 9 -relief raised \
		     -height 1 -border 2 -font [font create -size 14 -weight bold]]
    set ::EXAMPLE [label $NOT.ex -relief raised]
    set ::HOLDEXAMPLE [label $NOT.holdex -relief raised]

    bind $::HOLDEXAMPLE <ButtonPress-1> SetHold;
    bind $HOLDRDT <ButtonPress-1> SetHold;
    bind $::ENT <Return> DoEntry
    bind $::ENT <ButtonRelease-1> {SelectionHandler %W}
    set msg [_ "If you are using hexadecimal color values, enter the six\n\
hexadecimal digits of a color specification that you would\n\
like to look at. You may separate the three components with\n\
spaces if you wish to. If you are using decimal color values,\n\
enter three groups of decimal rgb values separated by spaces.\n\
Keep in mind that the values must range from 0 to 255 inclusive."]
    balloonhelp_for $::ENT $msg;
    set msg [_ "Click here to copy the current color example into this box\n\
and the current color specification into the box above it."]
    balloonhelp_for $::HOLDEXAMPLE $msg;
    set msg [_ "Click here to copy the current color specification into\n\
this box and the current color example into the box below it."]
    balloonhelp_for $HOLDRDT $msg;
    set msg [_ "This is what the current color looks like."]
    balloonhelp_for $::EXAMPLE $msg;

    #Search
    frame .srch
    button .srch.closest -text [_ "Closest"] -command FindClosestNamedColor;
    button .srch.slab -text [_ "Find"] -command {Search 0}
    button .srch.slaba -text [_ "Find Again"] -command Search
    entry .srch.search -width 12 -bg "\#EFEFEF" -fg black
    pack .srch.closest -side left -expand 1 -fill none -anchor w -padx 4
    pack .srch.slab -side left -expand 1 -fill x  -padx 4;
    pack .srch.slaba -side left -expand 1 -fill x  -padx 4;
    pack .srch.search -side left -expand 1 -fill x -anchor e  -padx 4;
    bind .srch.search <Return> Search;

    set msg [_ "Press this button to locate the named color that is\n\
the closest match to the color you have specified."]
    balloonhelp_for .srch.closest $msg
    set msg [_ "Press this button to search the list of color names\n\
from the beginning for a case-insensitive match to the\n\
regular expression you have entered in the box to the right."]
    balloonhelp_for .srch.slab $msg
    set msg [_ "Press this button to search again starting from the previous match."]
    balloonhelp_for .srch.slaba $msg
    set msg [_ "Enter a regular expression to match against the color names."]
    balloonhelp_for .srch.search $msg

    #Color bars
    set ln 90;
    set wd 18
    set trc \#D4B8C1
    scale $BARS.red -orient v -digit 1 -from 255 -to 0 -tickinterval 0 \
	-variable Colors(red)  -showvalue 0 -length $ln -width $wd\
	-troughcolor red -activebackground "\#00FFFF" \
	-bg goldenrod1  -fg yellow -command {SetColorAux}
    scale $BARS.green -orient v -digit 1 -from 255 -to 0 -tickinterval 0 \
	-variable Colors(green)  -showvalue 0 -length $ln -width $wd\
	-troughcolor green -activebackground "\#FF00FF" \
	-bg goldenrod1 -fg yellow -command {SetColorAux}
    scale $BARS.blue -orient v -digit 1 -from 255 -to 0 -tickinterval 0 \
	-variable Colors(blue)  -showvalue 0 -length $ln -width $wd\
	-troughcolor blue -activebackground "\#FFFF00" \
	-bg goldenrod1 -fg yellow -command {SetColorAux}

    bind $BARS.red   <<B3>> "ScaleMoveBigIncrement $BARS.red   -32 %x %y"
    bind $BARS.green <<B3>> "ScaleMoveBigIncrement $BARS.green -32 %x %y"
    bind $BARS.blue  <<B3>> "ScaleMoveBigIncrement $BARS.blue  -32 %x %y"

    set msg [_ "Adjust the amount of this color in the mixture. You can\n\
hold the left mouse button down and move the slider or\n\
you can click your mouse buttons in the trough. A left\n\
click moves by one unit. A right click moves by 32 units."]
    balloonhelp_for $BARS.red   $msg;
    balloonhelp_for $BARS.green $msg;
    balloonhelp_for $BARS.blue  $msg;

    #Color name list
    set NameListHeight 210
    set ::ColorNameListCanvas [canvas .c.canvas -yscrollcommand ".c.sy set" \
		    -width $::ItemWidth -height $NameListHeight -relief raised -bd 2]
    scrollbar .c.sy -orient vert -command "$::ColorNameListCanvas yview" -bd 1
    pack $::NAMES.sy -side right -fill y -expand 1
    pack $::ColorNameListCanvas -fill both -expand 1 -side right
    bind .c.sy <<B3>> "ScrollbarMoveBigIncrement .c.sy .2 %x %y"

    set msg [_ "Click on a color name to make it the current color."]
    balloonhelpd_for .c.canvas $msg;
    set msg [_ "Left click in the trough to scroll by one page.\n\
Right click to scroll by 20% of the list."]
    balloonhelp_for .c.sy $msg;

    FillColorNameList

    #Controls
    frame  .cntls
    button .cntls.about -text [_ "About"] -command About
    button .cntls.help -text [_ "Help"] -command Help
    button .cntls.dismiss -text [_ "Dismiss"] -command exit
    button .cntls.random -text [_ "Random"]  -command PickRandomColor
    button .cntls.history -text [_ "History"]  -command ToggleHistoryList
    if {$::XorisOKP} {
	button .cntls.pixel -text [_ "Copy"]  -command GetPixelColor
	set msg [_ "Copy the color from a chosen pixel. After\nclicking on this button, place the pointer over\nthe desired point on the display and left-click."]
	balloonhelp_for .cntls.pixel $msg;
    }
    set xpd 8
    pack .cntls.dismiss -side left -expand 1 -fill both -padx $xpd -pady 2
    pack .cntls.about -side left -expand 1 -fill both -padx $xpd -pady 2
    pack .cntls.history -side left -expand 1 -fill both -padx $xpd -pady 2
    if {$::XorisOKP} {
	pack .cntls.pixel -side left -expand 1 -fill both -padx $xpd -pady 2
    }
    pack .cntls.random -side left -expand 1 -fill both -padx $xpd -pady 2
    pack .cntls.help -side left -expand 1 -fill both -padx $xpd -pady 2

    set msg [_ "Check out a random color."]
    balloonhelp_for .cntls.random $msg;
    set msg [_ "Some information about this program."]
    balloonhelp_for .cntls.about $msg;
    set msg [_ "Toggle display of the history list."]
    balloonhelp_for .cntls.history $msg;

    frame .bhcb
    frame .bhcb.opt
    checkbutton .bhcb.opt.cb -text [_ "Balloon Help?"] \
	-variable BalloonHelpP -onvalue 1 -offvalue 0 -command ControlBalloonHelp
    checkbutton .bhcb.opt.ud -text [_ "Decimal?"] \
	-variable UseDecimalP -onvalue 1 -offvalue 0 -command PutColorText
    set msg [_ "Select this if you want to use decimal color values.\nDeselect it if you want to use hexadecimal color values."]
    balloonhelp_for .bhcb.opt.ud $msg;

    checkbutton .bhcb.opt.cs -text [_ "HTML?"] -variable HTMLP -onvalue 1 -offvalue 0 \
	-command ToggleColorScheme
    set msg [_ "In a few cases, the X11 colors are different from the\nHTML/CSS colors. By default, the X11 values are used.\nIf this button is checked, the HTML/CSS values will be used."]
    balloonhelp_for .bhcb.opt.cs $msg

    checkbutton .bhcb.opt.krm -text [_ "Keep Main Raised?"] \
	-command ToggleKeepMainOnTop \
	-onvalue 1 -offvalue 0 -variable KeepMainOnTopP

    checkbutton .bhcb.opt.krh -text [_ "Keep History Raised?"] \
	-command ToggleKeepHistoryListOnTop \
	-onvalue 1 -offvalue 0 -variable KeepHistoryListOnTopP

    frame  .bhcb.opt.hsv -relief ridge -border 2
    label .bhcb.opt.hsv.b -text [_ "HSV"] -relief raised -width 5
    label .bhcb.opt.hsv.l -textvariable HSV -width 14 -bg NavajoWhite	
    pack .bhcb.opt.hsv.b -side left -expand 1 -fill x -anchor w -padx {0 4}
    pack .bhcb.opt.hsv.l -side left -expand 1 -fill x -anchor w -padx {4 0}

    balloonhelp_for .bhcb.opt.hsv.b [_ \
"This is the HSV equivalent of the current\n\
RGB color value. Hue values range from 0\n\
to 360. Saturation and value values range\n\
from 0 to 100."]

    grid .bhcb.opt.cs  -row 0 -column 0 -sticky w -padx 2 -pady 2
    grid .bhcb.opt.ud  -row 1 -column 0 -sticky w -padx 2 -pady 2
    grid .bhcb.opt.cb  -row 2 -column 0 -sticky w -padx 2 -pady 2
    grid .bhcb.opt.krm -row 1 -column 1 -sticky w -padx 2 -pady 2
    grid .bhcb.opt.krh -row 0 -column 1 -sticky w -padx 2 -pady 2
    grid .bhcb.opt.hsv -row 2 -column 1 -sticky w -padx 2 -pady 2

    frame .bhcb.lock
    label .bhcb.lock.lab -text [_ "Lock"]
    radiobutton .bhcb.lock.no -variable Lock -value 0 -text [_ "none"]
    frame .bhcb.lock.rg
    radiobutton .bhcb.lock.rg.rgb -variable Lock -value 1 -text ""
    text .bhcb.lock.rg.rgl -width 2 -height 1 -relief raised
    pack .bhcb.lock.rg.rgb .bhcb.lock.rg.rgl -side left -expand 0 -fill none -padx 0 -anchor w
    .bhcb.lock.rg.rgl insert end "r" [list R]
    .bhcb.lock.rg.rgl insert end "g" [list G]
    .bhcb.lock.rg.rgl tag configure R -background red -foreground red
    .bhcb.lock.rg.rgl tag configure G -background green -foreground green
    .bhcb.lock.rg.rgl configure -state disabled

    frame .bhcb.lock.rb
    radiobutton .bhcb.lock.rb.rbb -variable Lock -value 2 -text ""
    text .bhcb.lock.rb.rbl -width 2 -height 1 -relief raised
    pack .bhcb.lock.rb.rbb .bhcb.lock.rb.rbl -side left -expand 0 -fill none -padx 0 -anchor w
    .bhcb.lock.rb.rbl insert end "r" [list R]
    .bhcb.lock.rb.rbl insert end "b" [list B]
    .bhcb.lock.rb.rbl tag configure R -background red -foreground red
    .bhcb.lock.rb.rbl tag configure B -background blue -foreground blue
    .bhcb.lock.rb.rbl configure -state disabled

    frame .bhcb.lock.gb
    radiobutton .bhcb.lock.gb.gbb -variable Lock -value 3 -text ""
    text .bhcb.lock.gb.gbl -width 2 -height 1 -relief raised
    pack .bhcb.lock.gb.gbb .bhcb.lock.gb.gbl -side left -expand 0 -fill none -padx 0 -anchor w
    .bhcb.lock.gb.gbl insert end "g" [list G]
    .bhcb.lock.gb.gbl insert end "b" [list B]
    .bhcb.lock.gb.gbl tag configure G -background green -foreground green
    .bhcb.lock.gb.gbl tag configure B -background blue -foreground blue
    .bhcb.lock.gb.gbl configure -state disabled

    frame .bhcb.lock.all
    radiobutton .bhcb.lock.all.allb -variable Lock -value 4 -text ""
    text .bhcb.lock.all.alll -width 3 -height 1 -relief raised
    pack .bhcb.lock.all.allb .bhcb.lock.all.alll -side left -expand 0 -fill none -padx 0 -anchor w
    .bhcb.lock.all.alll insert end "r" [list R]
    .bhcb.lock.all.alll insert end "g" [list G]
    .bhcb.lock.all.alll insert end "b" [list B]
    .bhcb.lock.all.alll tag configure R -background red -foreground red
    .bhcb.lock.all.alll tag configure G -background green -foreground green
    .bhcb.lock.all.alll tag configure B -background blue -foreground blue
    .bhcb.lock.all.alll configure -state disabled

    grid .bhcb.lock.lab -row 0 -column 0 -padx 1 -pady 1 -sticky w
    grid .bhcb.lock.no  -row 1 -column 1 -padx 1 -pady 1 -sticky w
    grid .bhcb.lock.all -row 1 -column 2 -padx 1 -pady 1 -sticky w
    grid .bhcb.lock.rg  -row 0 -column 1 -padx 1 -pady 1 -sticky w
    grid .bhcb.lock.rb  -row 0 -column 2 -padx 1 -pady 1 -sticky w
    grid .bhcb.lock.gb  -row 0 -column 3 -padx 1 -pady 1 -sticky w


    pack .bhcb.opt  -side left  -expand 0 -fill none -anchor e  -padx 12
    pack .bhcb.lock -side right -expand 0 -fill none -anchor e  -padx 12
    if {0} {
    pack .bhcb.cb -side top -expand 0 -fill none -anchor w -padx 6 -pady 2
    pack .bhcb.ud -side top -expand 0 -fill none -anchor w -padx 6 -pady 2
    pack .bhcb.cs -side top -expand 0 -fill none -anchor w -padx 6 -pady 2
    pack .bhcb.kr -side top -expand 1 -fill x    -anchor w -padx 6 -pady 2
    }

    pack .cntls       -side top -expand 1 -fill both  -padx {3 2} -pady 2
    pack .srch       -side bottom   -expand 1 -fill both  -padx {3 2} -pady 2
    pack .bhcb        -side bottom   -expand 1 -fill both  -padx {3 2} -pady 2
    pack $NOT         -side right -expand 1 -fill both  -padx {3 2} -pady 2
    pack $::NAMES       -side left  -expand 0 -fill y  -padx {3 2} -pady 2

    pack $HOLDRDT         -side top   -expand 0 -fill both  -padx 2 -pady 2
    pack $::HOLDEXAMPLE   -side top   -expand 1 -fill both  -padx 2 -pady 1
    pack $::EXAMPLE   -side top   -expand 1 -fill both  -padx 2 -pady 1
    pack $::ENT -side top -after $::EXAMPLE -expand 0 -fill both -padx 2 -pady 2
    pack $BARS.red    -side left  -expand 1 -fill y
    pack $BARS.green  -side left  -expand 1 -fill y
    pack $BARS.blue   -side left  -expand 1 -fill y
    pack $BARS        -side top   -expand 1 -fill both  -padx 2 -pady 2

    foreach k [lsort -command ColorNameCompare [array names NamesToColors]] { 
	lappend ::ColorNameList $k
	lappend ::ColorSpecList $NamesToColors($k)
    }

    focus $::NAMES.sy
    return
}

SetX11ColorDefinitions
InvertArray
ColorPicker
SetHold
set SearchOffset 0;
trace add variable HistoryList write UpdateHistoryDisplay
trace add variable UseDecimalP write UpdateHistoryDisplay
. configure -bg $ColorSpecs(MainFrame,Background)
#We need to clear the event queue before enabling history recording so as to
#avoid each of the color scales making an entry
update;
set RecordHistoryP 1

