#!/bin/sh
# -*- tcl -*- \
    exec wish "$0" "$@"

# Copyright (C) 2001 Robert Fenk
#
# Author:      Robert Fenk
# X-URL:       http://www.robf.de/Hacking/TclTk.html
# X-RCS:       $Id: xcolors.tk,v 1.3 2003/04/28 19:42:06 fenk Exp $
#
# This code is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 1, or (at your option)
# any later version.
#
# 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, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

#####################################################################
#
set op {-fg}
proc newColor {{junk {}}} {
  global op ColorName ColorValue ColorList color value red green blue
  if {[catch {set value [format \#%02x%02x%02x $red $green $blue]}]} return 
  .test configure $op $value

  set err [catch {set name $ColorName($red $green $blue)}]
  if {$err == 0} {
    set i [lsearch $ColorList $name]
    .l see $i
    .l selection set $i
    set color "$name"
  } else {
    set color {}
  }
}

#####################################################################
#

button .exit -text Exit -command exit

text .test -width 40 -height 5 -wrap word
.test insert end "Klick left/right mousebutton in the listbox to change foreground/background color of this test field"

set red 233
set green 233
set blue 233

bind NewColor <Any-Key> newColor

foreach color {Red Green Blue} {
  set v [string tolower $color]
  set f ".frame$v"
  frame $f
  label $f.label -text "$color:"
  entry $f.entry -textvariable $v
  scale $f.scale -from 0 -to 255 -length 255 -orient horizontal -width 10 \
      -variable [string tolower $color] -command newColor -showvalue 0

  bindtags $f.entry "[bindtags $f.entry] NewColor"
  
  pack $f.scale -side bottom -fill x 
  pack $f.label -side left
  pack $f.entry -side left -fill x -expand 1
}

frame .fcname 
label .lcname -text Name: -width 6 -anchor e
entry .ecname -textvariable color
frame .fchex  
label .lchex  -text Hex: -width 6 -anchor e
entry .echex  -textvariable value -font [.test cget -font]

scrollbar .sb -command {.l yview}
listbox .l -bd 1 -relief sunken -yscroll {.sb set}

pack .l -expand 1 -fill both -side left -padx 2
pack .sb -fill y -side left
pack .exit -fill x
pack .test -expand 1 -fill both -padx 2
pack .lcname -in .fcname -side left 
pack .ecname -in .fcname -side left -expand 1 -fill x
pack .lchex -in .fchex -side left 
pack .echex -in .fchex -side left -expand 1 -fill x
pack .framered .framegreen .frameblue .fcname .fchex -fill x
pack .fcname .fchex -fill x -pady 2 -padx 2

#####################################################################
#
set XLIBDIR {}
foreach xmkmf [exec which xmkmf] {
  set fd [open $xmkmf r]
  while {![eof $fd]} {
    gets $fd line
    if {[regexp {"-I((/[^/]+)*)/config"} $line junk XLIBDIR]} {
      break
    }
  }
  close $fd
  if {$XLIBDIR != ""} {
    break
  }
}
  
set fd [open "$XLIBDIR/rgb.txt" r]

while {![eof $fd]} {
  gets $fd line
  if {[regexp "^\[ \t\]*\[0-9\]+" $line]} {
    scan $line "%i %i %i" red green blue
    regsub "^\[ \t\]*$red\[ \t\]+$green\[ \t\]+$blue\[ \t\]+" \
	$line {} name

    set value "$red $green $blue"
    
    set ColorName($value) $name
    set ColorValue($name)  $value
  }
}

close $fd

#####################################################################
#
set ColorList [lsort -ascii [array names ColorValue]]
foreach c  $ColorList {
  .l insert end $c
}

#####################################################################
#
bind .l <Button-1> {
  global op color red green blue
  set op {-fg}
  set name [.l get [.l index @%x,%y]]
  set val $ColorValue($name)
  set red [lindex $val 0]
  set green [lindex $val 1]
  set blue [lindex $val 2]
  newColor
  set color $name
}

bind .l <Button-3> {
  global op color
  set op {-bg}
  set name [.l get [.l index @%x,%y]]
  set val $ColorValue($name)
  set red [lindex $val 0]
  set green [lindex $val 1]
  set blue [lindex $val 2]
  newColor
  set color $name
}

bind all <q> exit