#!/bin/sh
# the next line restarts using wish \
exec wish $0 -- $@
#
package require msgcat
proc _ {s} {return [::msgcat::mc $s]};	# Define shorthand for gettext
#::msgcat::mcload [file join [file dirname [info script]] msgs];
::msgcat::mcset fr "About" "À Propos"
::msgcat::mcset fr "Help"  "Aide"
::msgcat::mcset fr "Dismiss" "Quitter"
::msgcat::mcset fr "Random" "Alléatoire"
::msgcat::mcset fr "Find"   "Chercher"
::msgcat::mcset fr "Find Again" "Chercher Encore"
::msgcat::mcset fr "Closest" "Plus Proche"
::msgcat::mcset fr "This is what the current color looks like." "Ceci exemplifie la couleur choisie."

font create MainFont -family Courier -size 13

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

set COLOR(red)   0xFF;
set COLOR(green) 0xFF;
set COLOR(blue)  0xFF;

proc ColorPicker {} {
    global COLOR
    set cols {
	fffafa snow
	f8f8ff {ghost white}
	f5f5f5 {white smoke}
	dcdcdc gainsboro
	fffaf0 {floral white}
	fdf5e6 {old lace}
	faf0e6 linen
	faebd7 {antique white}
	ffefd5 {papaya whip}
	ffebcd {blanched almond}
	ffe4c4 bisque
	bebebe gray
	d3d3d3 {light grey}
	4169e1 {royal blue}
	3cb371 {medium sea green}
	20b2aa {light sea green}
	98fb98 {pale green}
	00ff7f {spring green}
	7cfc00 {lawn green}
	00ff00 green
	7fff00 chartreuse
	00fa9a {medium spring green}
	adff2f {green yellow}
    }

    set CurrentColor \#FFFFFF
    #Major pieces
    set NOT  [frame .not]
    set BARS [frame $NOT.bars]
    set ::NAMES [frame .c -relief ridge -bd 2]
    set ::RDT [label $NOT.rdt -textvariable CurrentColor -width 9 -relief raised \
		   -height 1 -border 2 -font [font create -size 14 -weight bold]] 
    set ::ENT [entry $NOT.ent -width 9 -relief sunken -border 2 \
		   -font [font create -size 14 -weight bold]]
    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 $::RDT <ButtonPress-1> SwapInEntry;

    #Color name list
    set ItemWidth 180
    set NameListHeight 200
    set canvas [canvas .c.canvas -yscrollcommand ".c.sy set" \
		    -width $ItemWidth -height $NameListHeight -relief raised -bd 2]
    scrollbar .c.sy -orient vert -command "$canvas yview" -bd 1
    pack $::NAMES.sy -side right -fill y -expand 1
    pack $canvas -fill both -expand 1 -side right

    set mark 0
    foreach {i j} $cols {
	scan $i "%2x%2x%2x" r g b
	if {($r+$g+$b)<350} { set col white } else { set col black }
	
	set i \#[string toupper $i]
	$canvas create rect 0 $mark $ItemWidth [incr mark 30] \
	    -fill $i -outline {} -tags $i
	#Store the id associated with the text for use in searches.
	set ::ID($j) \
	    [$canvas create text 10 [expr $mark-15] -text $j -fill $col -tags $i -anchor w]
	$canvas bind $i <ButtonPress-1> "SetColor $i"
    }
    $canvas config -scrollregion "0 0 200 $mark"

    #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
    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;
#Comment out the following line to eliminate the bug.
    pack .srch.search -side left -expand 1 -fill x -anchor e  -padx 4;


    #Controls
    frame  .cntls
    button .cntls.random -text  [_ "Random"]  -command PickRandomColor
    pack .cntls.random -side left -expand 1 -fill both -padx 10 -pady 2

    pack .cntls       -side top -expand 1 -fill both  -padx 2 -pady 2
    pack .srch       -side bottom   -expand 1 -fill both  -padx 2 -pady 2
    pack $NOT         -side right -expand 1 -fill both  -padx 2 -pady 2
    pack $::NAMES       -side left  -expand 1 -fill both  -padx 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 $::RDT         -side top   -expand 0 -fill both  -padx 2 -pady 2

    foreach {i j} $cols { 
	lappend ::ColorNameList $j;
	lappend ::ColorSpecList $i;
    }

    focus $::NAMES.sy
    return
}

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

    if [string comp {} $rgb] {
	scan $rgb "\#%2x%2x%2x" red green blue
	foreach c {red green blue} { set COLOR($c) [format %d [set $c]] }
	set rgbtxt [format "%02.2X %02.2X %02.2X" $COLOR(red) $COLOR(green) $COLOR(blue)]
    } else {
	set rgb [format "\#%02.2X%02.2X%02.2X" $COLOR(red) $COLOR(green) $COLOR(blue)]
	set rgbtxt [format "%02.2X %02.2X %02.2X" $COLOR(red) $COLOR(green) $COLOR(blue)]
    }
    $EXAMPLE config -bg $rgb
    set RGB $rgb;
    set ::CurrentColor $rgbtxt
    update
}

proc ShowEntry {index} {
    global NAMES;
    global ColorNameList;
    set id $::ID([lindex $::ColorNameList $index]);
    set y [lindex [$NAMES.canvas coords [expr $id -1]] 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;
    event generate $NAMES.canvas <ButtonPress-1>
}

proc SwapInEntry {} {
    pack forget $::RDT;
    pack $::ENT -side top -after $::EXAMPLE -expand 0 -fill both -padx 2 -pady 2
    focus $::ENT;
}

proc SwapInReadout {} {
    pack forget $::ENT;
    pack $::RDT -side top -after $::EXAMPLE -expand 0 -fill both -padx 2 -pady 2
}

proc DoEntry {} {
    set Raw [$::ENT get]
    if {[string length $Raw] < 1} {
	SwapInReadout;
	return ;
    }
    set cs [string map {\u0020 ""} $Raw]
    if {![regexp {^[[:xdigit:]]{6}$} $cs]} {
	$::ENT delete 0 end
	return ;
    }
    SetColor \#$cs 
    $::ENT delete 0 end
    SwapInReadout;
}

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

    set tgt [string trimleft $::CurrentColor "\#"]

    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 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 SearchOffset 0;
ColorPicker



