#!/bin/sh
# The next line restarts using tclsh since sh ignores the backslash \
exec oagwish "$0" "$@"

set auto_path [linsert $auto_path 0 /usr/local/oag/apps/lib/$env(HOST_ARCH)]
set auto_path [linsert $auto_path 0 /usr/local/oag/lib_patch/$env(HOST_ARCH)]
APSDebugPath

# $Log: not supported by cvs2svn $
# Revision 1.2  1996/03/27  20:29:43  evans
# First time.
#

# **************************** matchcolor ******************************
proc matchcolor {} {
    global userframe

#    set f [open /usr/lib/X11/rgb.txt]
    set f [open /opt/X11R6/lib/X11/rgb.txt]
    set error0 1.e40
    set red 0
    set green 0
    set blue 0
    set name Error
    while {[gets $f line] >= 0} {
	# Check for comment
	if ![string compare [lindex $line 0] "!"] continue
        set r [lindex $line 0]
        set g [lindex $line 1]
        set b [lindex $line 2]
        set r0 [$userframe.red get]
        set g0 [$userframe.green get]
        set b0 [$userframe.blue get]
        set error [expr ($r-$r0)*($r-$r0)+($g-$g0)*($g-$g0)+($b-$b0)*($b-$b0)]
        if {$error < $error0} {
            set error0 $error
            set red $r
            set green $g
            set blue $b
            set name [lrange $line 3 end]
        }
    }
    close $f
    set color [format \#%02x%02x%02x $red $green $blue]
    $userframe.match.match config -bg $color
    $userframe.name config -text "$name $red $green $blue ($color)"
}
# **************************** newcolor ********************************
proc newcolor value {
    global userframe

    set color [format \#%02x%02x%02x \
		 [$userframe.red get] \
		 [$userframe.green get] \
		 [$userframe.blue get]]
    $userframe.sample.sample config -bg $color
}

# **************************** overviewtext ****************************
proc overviewtext {} {
    return "\
X Database Color Matcher\
\n\n\
Slide the bars to define a color, which will be displayed in the upper\
 box.  Click on Match to find the color in the X color database that most\
 closely matches it.\
\n\n\ "
}

# **********************************************************************
# **************************** main ************************************
# **********************************************************************

set name "X Database Color Matcher"
set overview [overviewtext]
set version "\$Revision: 1.3 $ \$Author: soliday $"

APSApplication . -name $name -version $version -overview $overview \
  -contextHelp "Sorry, there is no context help available for this widget."

set userframe .userFrame

foreach color {red green blue} {
    scale $userframe.$color -label $color -from 0 -to 255 -length 10c \
      -orient horizontal -command newcolor
    pack $userframe.$color -side top -pady 2 -padx 2
    set apsContextHelp($userframe.$color) \
      "Select the $color component of a color to be displayed below."
}

frame $userframe.sample -relief groove -bd 4
frame $userframe.sample.sample -height 1.5c -width 6c
pack $userframe.sample -side top -padx 5 -pady 5
pack $userframe.sample.sample
set apsContextHelp($userframe.sample.sample) \
  "The color corresponding to the RGB components selected by the\
   sliders is displayed here."

frame $userframe.match -relief groove -bd 4
frame $userframe.match.match -height 1.5c -width 6c
pack $userframe.match -side top -padx 5 -pady 5
pack $userframe.match.match
set apsContextHelp($userframe.match.match) \
  "The color in the database that most nearly matches the selected color\
   is displayed here."

label $userframe.name -text "" 
pack $userframe.name -side top -pady 2

APSButton .matchbutton -parent $userframe -text Match \
  -command matchcolor -contextHelp \
  "Find the color in the X color database that most\
   closely matches the selected color."

APSButton .done -parent $userframe -text Done \
  -command exit -contextHelp \
  "Exit the application."
pack $userframe.matchbutton $userframe.done -side left -pady 5 -padx 5 -expand 1

# **************************** Emacs Editing Sequences *****************
# Local Variables:
# mode: tcl
# End:
