Re: [opensuse-xorg] xcms.txt where to get data ?

5 Aug 2007

      Tom Wekell wrote:
...
walter harms wrote:
...
Hello list,
i was diving into Device Color Characterization of X11, since rgb.txt
is dead.
good news you can easy add new color names by adding to xcms.txt:
<name>  rgb:R/G/B
Here is an example from O'Reilly (I think):
XCMS_COLORDB_START 0.1
Berry           CIEuvY:0.34568/0.45488/0.23013
Port            CIEuvY:0.37875/0.45637/0.05117
Straw           CIEuvY:0.19325/0.53761/0.85767
Paprika         CIEuvY:0.39617/0.51446/0.20947
GrapeFruit      CIEuvY:0.19261/0.52793/0.85069
Pool            CIEuvY:0.15229/0.48240/0.60646
SkyBlue         RGB:7f7f/bfbf/ffff
XCMS_COLORDB_END
The last entry is mine, notice the rr/gg/bb format.
To test from a konsole:
$ export XCMSDB=/path/to/xcms.txt(or alternate file name)
$ xterm -bg SkyBlue
and it works for me.
<snip>
i have posted a small awk script that translates from rgb.txt into xmcs.txt :)
you can save use dez numbers.
...
...
I tried xcmsdb -query but always got
xcmsdb -query
Could not find property XDCCC_LINEAR_RGB_MATRICES
Could not find property XDCCC_LINEAR_RGB_CORRECTION
...
Me too
...
i tried the xcms.txt from Jim Carter
(http://www.math.ucla.edu/~jime/xcolor/color.txt)
but it did not work, because for the xcmsdb failure his tcl-script
xcolor breaks also.
Here I get '404'
Tom wekell
It seems they have removed the page. I have a copy attached.

if the (c) ok   should that be added to the bug report ?

I have also a copy of xcolor attached just in case.

re,
 wh

#!/usr/bin/wish -f
# xcolor, Copyright (c) 1994, 1995 by James F. Carter (940727, 950521)

# Probs: 
# CIEuvY, CIELab, CIELuv, CIELSH suffer from various overflow problems.
#	Likely a 0-1 vs 0-100 prob.  

# Purpose: to view a bitmap with easily adjusted foreground and background 
# colors, the colors being set and converted in any Xcms colorsystem (and a 
# few unofficial ones besides).  

# Requires that your TK be built with X11R5 or X11R6 libraries.  (Does not
# require cooperation from the server.)  Kind of useless on a monochrome 
# display.

# Permission to use, copy, modify, distribute, and sell this
# software and its documentation for any purpose is hereby granted
# without fee, provided that the above copyright notice appear in all
# copies and that both that copyright notice and this permission notice
# appear in supporting documentation. James F. Carter makes no
# representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.

# How to operate it:

# Change a color component scale widget or type a value in its entry (and press
# return), and the color in the panel will be updated immediately.  If the
# color is out of range or otherwise rejected, the error indicator will light
# up red.  

# Type a color name from rgb.txt in the Name entry (and press return), and
# that color will be displayed.  Conversely, left click on the Name button and
# the nearest named color to the one currently displayed will be written in
# the entry.  (Be patient, the search algorithm is slow.)  

# To change colorsystems, left click on the Colorsystem button for a menu.
# Select a colorsystem, and choose whether the translation to RGB will be done
# by Xlib or locally by the subroutines in this file.  

# Exit by pressing the quit button.  

# Widget Layout:
#	panel to show bitmap in color.
#	2 groups for background and foreground.  In each:
#	    Title, error indicator, and colorsystem selector/readout;
# 	    3 units consisting of label (R,G,B), scale widget, entry for value;
# 	    Entry for a color name, with a button to find the closest color to
#	    the current numbers, a readout for the ICCCM color code, and a quit
#	    button.

# Summary of "features" whereby Xlib's alleged CIE color systems deviate from
# the official CIE specs; reference:
#	Rea, Mark S (ed.), "Lighting Handbook, Reference & Application",
#	Illuminating Society of North America (N.Y.), 1993, ISBN 0-87995-102-8

# CIEXYZ, each component runs from 0..100 (official) vs. 0..1 (Xlib).

# Color conversion check notes.  Column headings are: 
#   Sys	    Color system; 
#   X/L	    Comparison of Xlib treatment vs. conversion by this program
#   Next    "Next" color system;
#   Linv    Correctness of local sys<->next conversion and its inverse;
#   Xnext   Comparison of xlib treatment of "sys" vs. "next".
# Note that conversions will generally be bogus if the coordinates are out of
# gamut; Xlib may silently accept coordinates that it cannot convert 
# successfully.  "LSB" = a few errors in the least significant bit.
# Sys.		X/L		Next	Linv		Xnext
#   rgb		Perfect		rgbi	LSB		2-3 off at low numbers
#   rgbi	X>L at low nbrs	CIEXYZ	LSB		2*LSB
#   CIEXYZ	X<L everywhere	CIExyY	LSB		Perfect
#   CIExyY	X>L everywhere	--
#   CIEuvY	Bug 1		CIEXYZ
#   CIELab
#   CIELuv
#   CIELSH
#   P-n-o-e

# Bug 1: For L=25 and L=50 both, when v changes from 28 to 29, Xlib makes a
#	big jump from green (28) to blue (29) tones.  In the range u = 15..18
#	(and likely beyond), with v = 28, it jumps alternately from green 
#	to red/magenta.

# ===== Revision history (most recent first):

# Version 1.2 (951226).  Updated for tk 4.0p2.  May or may not still work with
#	tk 3.x.  Added fast rgb->name converter.  Added simultaneous view of
#	all color systems.  

# Version 1.1 (950529).  WARNING, not all of the colorsystems could be tested
#	due to BUGS discovered in Xlib Xcms routines!  
#	Written for tcl/tk 7.3/3.6pl1.  Should work with most (?) 3.x but not
#	4.0.  

# ===== Math subroutines

# Generalized linear interpolation.  Arguments:
#	  x	Value in "from" table
#	  from	Name of "from" table, of form ${from}($j) with j in 0 .. $N-1
#		Can handle increasing or decreasing table.
#	  to	Name of "to" table, similar form
#	  N	Number of elements in tables.
# Return value	Corresponding value in "to" table by linear interpolation.
# Result is floating point.
proc interpolate {x from to N} {
    upvar $from X
    upvar $to Y
		#Binary search to find table segment, j to j+1.
    set n2 [expr $N-2]		;#Must not let j = $N-1 so j+1 is in the table.
    set dn [expr $N/2]
    set j $dn
    set sign [expr {$X($n2) > $X(0)}]	;#Reverse comparison if table decreases
    while {$dn > 1} {
	set dn [expr {($dn+1)/2}]	;#Cannot go below 1
	if {($x == $X($j))} {		;#If exactly on boundary
	    break
	} elseif {($x > $X($j))^$sign} { ;#Target below table(j) so reduce j
	    incr j -$dn
	    if {$j < 0} {set j 0}
	} elseif {($x < $X([expr $j+1]))^$sign} {  ;#Target above table(j+1)
	    incr j $dn
	    if {$j > $n2} {set j $n2}
	} else break			;#Target in interval (j, j+1)
    }
    set j1 [expr $j+1]
		#Linear interpolation
    set denom [expr {$X($j1)-$X($j)}]
    if {$denom == 0} {set denom 1}
    set res \
	[expr {$Y($j)+($Y($j1)-$Y($j))*(double($x)-$X($j))/$denom}]
    return $res
}

# DEBUG print out a matrix.
proc matout {title mtxa} {
    upvar $mtxa mtx
    puts $title
    foreach i {0 1 2} {
	set line {}
	foreach j {0 1 2} {
	    append line [format "%1d%1d  %8.5f  " $i $j $mtx($i$j)]
	}
	puts $line
    }
}

# Invert a 3x3 matrix using Kramer's rule, brute force.  Finesse in this task
# is useless in tcl.  inva is set to the inverse of mtxa (both are names).
proc invert {inva mtxa} {
    upvar $inva inv
    upvar $mtxa mtx
#    matout "Original matrix" mtx
    set det [expr {$mtx(00)*$mtx(11)*$mtx(22) + $mtx(01)*$mtx(12)*$mtx(20) + 
		    $mtx(02)*$mtx(10)*$mtx(21) - $mtx(00)*$mtx(12)*$mtx(21) - 
		    $mtx(01)*$mtx(10)*$mtx(22) - $mtx(02)*$mtx(11)*$mtx(20)}]
    set inv(00) [expr {($mtx(11)*$mtx(22) - $mtx(12)*$mtx(21))/$det}]
    set inv(01) [expr {($mtx(21)*$mtx(02) - $mtx(22)*$mtx(01))/$det}]
    set inv(02) [expr {($mtx(01)*$mtx(12) - $mtx(02)*$mtx(11))/$det}]
    set inv(10) [expr {($mtx(12)*$mtx(20) - $mtx(10)*$mtx(22))/$det}]
    set inv(11) [expr {($mtx(22)*$mtx(00) - $mtx(20)*$mtx(02))/$det}]
    set inv(12) [expr {($mtx(02)*$mtx(10) - $mtx(00)*$mtx(12))/$det}]
    set inv(20) [expr {($mtx(10)*$mtx(21) - $mtx(11)*$mtx(20))/$det}]
    set inv(21) [expr {($mtx(20)*$mtx(01) - $mtx(21)*$mtx(00))/$det}]
    set inv(22) [expr {($mtx(00)*$mtx(11) - $mtx(01)*$mtx(10))/$det}]
#   matout "Its inverse" inv
}

# Matrix multiplication.  p = a * b.  All the args are names, not values.
proc matmpy {pa aa ba} {
    upvar $pa p
    upvar $aa a
    upvar $ba b
    set p(00) [expr {$a(00)*$b(00)+$a(01)*$b(10)+$a(02)*$b(20)}]
    set p(01) [expr {$a(00)*$b(01)+$a(01)*$b(11)+$a(02)*$b(21)}]
    set p(02) [expr {$a(00)*$b(02)+$a(01)*$b(12)+$a(02)*$b(22)}]
    set p(10) [expr {$a(10)*$b(00)+$a(11)*$b(10)+$a(12)*$b(20)}]
    set p(11) [expr {$a(10)*$b(01)+$a(11)*$b(11)+$a(12)*$b(21)}]
    set p(12) [expr {$a(10)*$b(02)+$a(11)*$b(12)+$a(12)*$b(22)}]
    set p(20) [expr {$a(20)*$b(00)+$a(21)*$b(10)+$a(22)*$b(20)}]
    set p(21) [expr {$a(20)*$b(01)+$a(21)*$b(11)+$a(22)*$b(21)}]
    set p(22) [expr {$a(20)*$b(02)+$a(21)*$b(12)+$a(22)*$b(22)}]
}

# Vector multiplication.  p = mtx * vec.  Return value is the product.
# ma is the name of the matrix.  va is a 3-component list, the vector.
proc matvec {ma va} {
    upvar $ma mat
    set v0 [lindex $va 0]
    set v1 [lindex $va 1]
    set v2 [lindex $va 2]
    return "[expr {$mat(00)*$v0+$mat(01)*$v1+$mat(02)*$v2}]\
	    [expr {$mat(10)*$v0+$mat(11)*$v1+$mat(12)*$v2}]\
	    [expr {$mat(20)*$v0+$mat(21)*$v1+$mat(22)*$v2}]"
}

# ===== Color space conversions.  
# The function to convert from color space A to B is called A2B.  A mapping
# function can compose these functions to transform from any space to any 
# other; it relies on the A2B format to know what each function does.

# Gamma correction, rgbi to rgb using theoretical curve with exponent of 2.35.
#   rawmax = raw RGB corresponding to $inten = 1.0.  
#   origin = raw RGB corresponding to $inten = 0.0.
#   inten  = the intensity (in 0..1) to be converted.
# Return value is the RGB to give that intensity. The intensity profile of 
# a "typical" CRT can be modelled as 
#   rgbi = ((rgb - origin)/rawmax)^2.35
proc gamma {rawmax origin inten} {
    global gamma
    return [expr {int(($rawmax-$origin)*exp(log($inten)/$gamma))+$origin}]
}

# rgb to rgbi by interpolation.  Input and result are 3 component lists
# in decimal.
proc rgb2rgbi {rgb} {
    global nip 
    foreach c {0 1 2} {
	global ipi$c ipr$c
	lappend rgbi [interpolate [expr {[lindex $rgb $c]*256}] \
	    ipr$c ipi$c $nip($c)]
    }
    return $rgbi
}

# rgbi to rgb by interpolation.  Input and result are 3 component lists
# in decimal.  Output rgb is rounded to an integer.
proc rgbi2rgb {rgbi} {
    global nip
    foreach c {0 1 2} {
	global ipi$c ipr$c
	lappend rgb [expr {round([interpolate [lindex $rgbi $c] \
	    ipi$c ipr$c $nip($c)]/256.0)}]
    }
    return $rgb
}

# rgbi to and from X-style CIEXYZ by a linear transformation, which is obtained
# if possible from the X-server; if not a good guess is used.
# NOTE that CIEXYZ on the X server runs from
# 0 to 1 while the numbers in the CIE spec appear to go from 0 to 100.  The 
# integral of the standard observer in each channel is approx. 21 (per the 
# spec's scaling).
proc rgbi2CIEXYZ {rgbi} {
    global RGBtoXYZ
    return [matvec RGBtoXYZ $rgbi]
}
proc CIEXYZ2rgbi {xyz} {
    global XYZtoRGB
    return [matvec XYZtoRGB $xyz]
}

# The formulae in the following transformations are from:
# Rea, Mark S (ed.), "Lighting Handbook, Reference & Application",
# Illuminating Society of North America (N.Y.), 1993, ISBN 0-87995-102-8
# (Adapted for this purpose by Jim Carter.)

# CIEXYZ to and from CIExyY.  x = X/(X+Y+Z)  y = Y/(X+Y+Z)  Y from XYZ.
proc CIEXYZ2CIExyY {XYZ} {
    set X [lindex $XYZ 0]
    set Y [lindex $XYZ 1]
    set Z [lindex $XYZ 2]
    set sum [expr {$X+$Y+$Z}]
    if {$sum <= 0} {set sum 1.0}
    return "[expr {$X/$sum}] [expr {$Y/$sum}] $Y"
}
proc CIExyY2CIEXYZ {xyy} {
    set x [lindex $xyy 0]
    set y [lindex $xyy 1]
    set Y [lindex $xyy 2]
    set sum [expr {$Y/(($y>0)?$y:1.0)}]
    set X [expr {$x*$sum}]
    set Z [expr {$sum-$Y-$X}]
    return "$X $Y $Z"
}

# CIEuvY to and from CIEXYZ.  This is presumed to be the uv from the CIEUVW
# definition, with Y from XYZ.  
proc CIEXYZ2CIEuvY {XYZ} {
    set X [lindex $XYZ 0]
    set Y [lindex $XYZ 1]
    set Z [lindex $XYZ 2]
    set denom [expr {$X+15*$Y+3*$Z}]
    if {$denom <= 0} {set denom 1.0}
    return "[expr {4.0*$X/$denom}] [expr {6.0*$Y/$denom}] $Y"
}
proc CIEuvY2CIEXYZ {uvy} {
    set u [lindex $uvy 0]
    set v [lindex $uvy 1]
    set Y [lindex $uvy 2]
    if {$v > 0} {set denom [expr {6.0*$Y/double($v)}]} else {set denom 0}
    set X [expr {0.25*$denom*$u}]
    set Z [expr {($denom-$X-15*$Y)/3.0}]
    return "$X $Y $Z"
}

# CIELuv to and from CIEuvY.  White point is assumed to be rgbi:1/1/1.
proc CIEuvY2CIELuv {uvy} {
    global uvY_white
    set u [expr {[lindex $uvy 0]-[lindex $uvY_white 0]}]
    set v [expr {[lindex $uvy 1]-[lindex $uvY_white 1]}]
    set Y [expr {[lindex $uvy 2]/double([lindex $uvY_white 2])}]
    set L [expr {($Y>0.008856)?(116*pow($Y,1/3.0)-16):(903.29*$Y)}]
    return "$L [expr {13*$L*$u}] [expr {13*$L*$v}]"
}
proc CIELuv2CIEuvY {luv} {
    global uvY_white
    set L [lindex $luv 0]
    set us [lindex $luv 1]
    set vs [lindex $luv 2]
    set Y [expr \
	{(($L>8)?(pow($L+16,3)/116.0):($L/903.29))*[lindex $uvY_white 2]}]
    if {$L <= 0} {set L 1.0}
    set u [expr {$us/(13.0*$L)+[lindex $uvY_white 0]}]
    set v [expr {$vs/(13.0*$L)+[lindex $uvY_white 1]}]
    return "$u $v $Y"
}

# CIEXYZ to and from CIELab.  The white point is taken as rgbi:1/1/1.
proc CIEXYZ2CIELab {XYZ} {
    set x [labfcn $XYZ 0]
    set y [labfcn $XYZ 1]
    set z [labfcn $XYZ 2]
    return "[expr {116*$y-16}] [expr {500*($x-$y)}] [expr {200*($y-$z)}]"
}
# The official CIE gamma correction function for CIELab
proc labfcn {XYZ j} {
    global XYZ_white
    set q [expr {[lindex $XYZ $j]/double([lindex $XYZ_white $j])}]
    return [expr {($q>0.008856)?(pow($q,1.0/3.0)):(7.787*$q+0.13793)}]
}

proc CIELab2CIEXYZ {Lab} {
    set yst [expr {([lindex $Lab 0]+16)/116.0}]
    set xst [expr  {0.002*([lindex $Lab 1]+$yst)}]
    set zst [expr {-0.005*([lindex $Lab 2]-$yst)}]
    return "[labinv $xst 0] [labinv $yst 1] [labinv $zst 2]"
}
proc labinv {qst j} {
    global XYZ_white
    return [expr {(($qst>8)?pow($qst,3):(($qst-0.13793)/7.787))*[lindex $XYZ_white $j]}]
}

# CIELSH to and from CIELuv.  This is as described by Poynton.  The X-server
# doesn't know anything about CIELSH.  (Lightness, Saturation, Hue.)
proc CIELuv2CIELSH {lab} {
    set L [lindex $lab 0]
    set u [lindex $lab 1]
    set v [lindex $lab 2]
    set s [expr {sqrt($u*$u+$v*$v)/($L>0?$L:1)}]	;#Saturation 0-1?
    set h [expr {atan2(-$v,-$u)/(8*atan(1.0))+0.5}]	;#Hue: angle 0-1 circle
    return "$L $s $h"					;#Lightness 0-100
}
proc CIELSH2CIELuv {lsh} {
    set L [lindex $lsh 0]
    set s [lindex $lsh 1]
    set h [lindex $lsh 2]
    set c [expr {$L*$s}]
    set th [expr {$h*8*atan(1.0)}]
    return "$L [expr {$c*cos($th)}] [expr {$c*sin($th)}]"
}

# The functions and menus use the label "P-n-o-e" because it's a proprietary
# standard.  The conversions below are estimated from the published materials.
# If I could negotiate a deal with them I could use the 7-letter name and could
# have the "real" conversions.  Probably hell will freeze over first.

# P-n-o-e to/from CIELSH hue conversion table
set hls_pne_n 0
foreach kv {{.00 36} {.16 16} {.25 13} {.33 7} {.40 0} 
	    {.50 -10} {.66 -19} {.83 -25} {1.00 -28}} {
    set hls_pne_h($hls_pne_n) [lindex $kv 0]
    set hls_pne_p($hls_pne_n) [lindex $kv 1]
    incr hls_pne_n
}
# Unofficial conversion from CIELSH to P-n-o-e.
proc CIELSH2P-n-o-e {lsh} {
    global hls_pne_h hls_pne_p hls_pne_n
    set l [lindex $lsh 0]
    set s [lindex $lsh 1]
    set h [lindex $lsh 2]
    set L [expr {round(19.5-$l*0.085)}]	;#(0,100) -> (19.5,11.0)
    set H [expr {round([interpolate $h hls_pne_h hls_pne_p $hls_pne_n])}]
    if {$H < 0} {set H [expr $H+64]}
    set S [expr {round($s*64)}]			;#(0,1) -> (0,64)
    return "$L $H $S"
}
proc P-n-o-e2CIELSH {LHS} {
    global hls_pne_h hls_pne_p hls_pne_n
    set L [lindex $LHS 0]
    set H [lindex $LHS 1]
    set S [lindex $LHS 2]
    set l [expr {(19.5-$L)/0.085}]		;#(19.5,11.0) -> (0,100)
    if {$H > $hls_pne_p(0)} {set H [expr $H-64]}
    set h [interpolate $H hls_pne_p hls_pne_h $hls_pne_n]
    set s [expr {$S/64.0}]
    return "$l $s $h"
}

# Given a color name, return the RGB numbers as a list.  The names and rgb's
# come out of /usr/lib/X11/rgb.txt.  There is also a file /usr/lib/X11/Xcms.txt
# which has CIEXYZ colors (not very many).  This program doesn't use it.
# NOTE: there is some question whether the rgb.txt numbers are supposed to 
# be rgb, scaled rgbi, ciexyz, or what.
proc name2rgb {name} {
    global color
    regsub -all { } [string tolower $name] {} name
    if {[info exists color($name)]} {
	set col $color($name)
    } else {
	set col {00 00 00}
    }
    return $col
}

# colorsyn(R) = list of {{R G B name} {...}} of all colors having that exact
# red value, no particular order.

# Given a color list {r g b}, return the name that matches most closely.
proc rgb2name {col} {
		#Check for being out of RGB gamut.
    foreach c {0 1 2} {
	set r [lindex $col $c]
	if {0 > $r || $r >= 255.5} {
	    return [concat $col Error]
	}
    }
    set dist 500		;#abs($col - best color), upper bound is 442.6
    set bestname none
		#Start with exact red and green values specified.
    set r [expr {round([lindex $col 0])}]
    set g [expr {round([lindex $col 1])}]
    set dr 0			;#Will look at colors with red = $r +- $dr
		#If a close match has been found in the g-b direction (i.e.
		#with almost equal r), stop looking when delta r would make
		#any match worse even if g-b match exactly.  Guaranteed to exit
		#after max of 500 steps even on total garbage input.
    while {$dr <= $dist} {
	foreach sr {1 -1} {
	    set R [expr {$r+$sr*$dr}]
	    global colorsyn.${R}
	    if {[info exists colorsyn.${R}]} {
		foreach G [array names colorsyn.${R}] {
		    set dg [expr {abs($G-$g)}]
		    if {$dg <= $dist} {
			foreach bcol [set colorsyn.${R}($G)] {
				#Get abs(this color - target color).
			    set db [expr {[lindex $col 2]-[lindex $bcol 2]}]
			    set d [expr {sqrt($dr*$dr+$dg*$dg+$db*$db)}]
			    if {$dist > $d} {
				set dist $d
				set bestname [lindex $bcol 3]
			    }
			}
		    }
		}
	    }
	    if {$dr == 0} break
	}
	incr dr
    }
    return $bestname
}

# ======= Color conversion management

# Set color system info.
# CIEuvY is omitted because I can't find a good definition of it.
# Column headings: System, Slider labels, From, To, Multiplier, Official, Format
# Multiplier: multiply floating point by this to give scrollbar values.
foreach kv {
    {rgb	{Red Green Blue}  {0 0 0} {255 255 255}	{1 1 1}		1 %4.0f}
    {rgbi	{Red Green Blue}  {0 0 0} {99 99 99}	{100 100 100}	1 %4.2f}
    {CIEXYZ	{Red Light Blue}  {0 0 0} {99 99 99}	{100 100 100}	1 %4.2f}
    {CIExyY	{Red Green Light} {0 0 0} {99 99 99}	{100 100 100}	1 %4.2f}
    {CIEuvY	{Red Green Light} {0 0 0} {99 99 99}	{100 100 100}	1 %4.2f}
    {CIELab	{Light Red Green} {0 -500 -200} {100 500 200}	{1 1 1}		1 %4.0f}
    {CIELuv	{Light Red Green} {0 0 0} {99 99 99}	{1 1 1}		1 %4.0f}
    {CIELSH	{Light Sat Hue}	  {0 0 0} {99 130 99}	{100 10 100}	0 %4.2f}
    {P-n-o-e	{Light Hue Sat}   {10 0 0} {20 63 63}	{1 1 1}		0 %3.0f}
} {
    set sys [lindex $kv 0]
    lappend colorsys $sys
    set colornames($sys) [lindex $kv 1]
    set colorfrom($sys)  [lindex $kv 2]
    set colorto($sys)    [lindex $kv 3]
    set colorscale($sys) [lindex $kv 4]
    set official($sys)	 [lindex $kv 5]
    set colorfmt($sys)	 [lindex $kv 6]
}
set official(name) 0

# Generalized color system conversion.  $path is a starting color system (or
# a partial path when this is called recursively) and
# $goal is the ending one.  $path is extended (reverse order) so that 
# path(j+1) can be converted to path(j) by an existing subroutine, ending 
# (path(0)) at $goal.  This is the return value.  {} is returned if the
# conversion cannot be done.  $goal == {} means any "official" color system.
# mazecache caches already computed paths.
proc colormaze {path goal {recurse 0}} {
    global official mazecache
		#Check for transformation already computed and cached.
    set start [lindex $path end]
    set key [list $start $goal]
    if {[info exists mazecache($key)]} {
	return $mazecache($key)
    }
		#Check for identity transformation.
    set from [lindex $path 0]
    if {$from == $goal || ($goal == {} && $official($from))} {
	colormaze_set $path $goal	;#Cache the identity transformation
	return $path
    }
		#Have to do some work -- Scan all functions that can transform
		#the input to any color system.
    foreach conv [info procs ${from}2*] {
	regexp {2(.*)$} $conv junk to		;#System the proc converts to
	if {[lsearch $path $to] >= 0} continue	;#Reject if it makes a loop.
		#While it may not lead to the goal, it leads _somewhere_.
		#Cache the transformation found so far.  For each start-end
		#pair, get the shortest transformation.
	set res [concat $to $path]		;#This is a feasible xform.
	colormaze_set $res $to
	if {$to == $goal} break		;#Can't improve on this result
	if {$goal == {} && $official($to)} {
	    colormaze_set $res $goal
	    break
	}
		#Recursively extend the transformation to the goal if possible.
		#The result is saved in mazecache.
	colormaze $res $goal 1
    }
		#Again extract the transformation from the cache.  If no path
		#was found, return a null result, but no negative caching,
		#because there's always some route to the goal.
    set res [expr {[info exists mazecache($key)]?$mazecache($key):{}}]
    if {$res == {} && !$recurse} {
	puts "colormaze: could not map $goal from $path"
	set res $from		;#Fake the identity transformation
    }
    return $res
}

# A good path to $goal has been found.  Store it in mazecache.  OK for goal=={}.
proc colormaze_set {path goal} {
    global mazecache
    set j 0
    foreach intr $path {
	set key [list $intr $goal]
	if {![info exists mazecache($key)] || \
				    [llength $mazecache($key)] > $j+1} {
	    set mazecache($key) [lrange $path 0 $j]
	}
	incr j
    }
}

# Convert a color ({r g b}, {X Y Z}, etc.) from one color system to another.  
# Color system names are from the list above ($colorsys).  The path is what 
# colormaze returns.
proc convert {path color} {
    for {set j [expr [llength $path]-2]} {$j >= 0} {incr j -1} {
	set conv [lindex $path [expr $j+1]]2[lindex $path $j]
	set color [$conv $color]
    }
    return $color
}

# Convert a color ({r g b}, {X Y Z}, etc.) into a ICCCM color designation.  
# $path = path from given color system to the desired one; could be just one
# component if color is already in the desired system.
proc icccm {path color} {
    global colorfmt
    if {[llength $path] > 1} {set color [convert $path $color]}
    set sys [lindex $path 0]
    set fmt $colorfmt($sys)
		# For RGB, give hex values, and special idiotproof clipping.
    if {$sys == "rgb"} {
	foreach val $color {
	    if {$val < 0} {set val 0}
	    if {$val > 255} {set val 255}
	    set val [format "%02x" [expr {int($val)}]]
	    lappend colory $val
	}
    } else {
	foreach val $color {
	    regsub {^ *(-?)0*} [format $fmt $val] {\1} val
	    regsub {\.$} $val {} val
	    if {$val == {}} {set val 0}
	    lappend colory $val
	}
    }
    return ${sys}:[join $colory /]
}

# Adapter function to call changesys when a change to a color system control
# variable triggers a trace.
proc colorsys_trace {gd array elt oper} {
    after 1 "changesys $gd"
}

# Changing the color system (when newsys.$gd is changed by the menu).  This
# is invoked through a trace on newsys.$gd.  ($gd = fg or bg)
# set system.fg rgbi; set system.bg rgbi	;# (set in widget setup)
set path.fg rgbi; set path.bg rgbi
# set mode.fg Xlib; set mode.bg Xlib	;# (set in widget setup)
proc changesys {gd} {
    global system.$gd		;#Color system to be used
    global newsys.$gd		;#Colorsystem requested through the menu
    global path.$gd		;#Path from current colorsystem to whatever 
				;#should be used to set the panel colors.
    global epath.$gd		;#Path from colorsys to rgbi (for error check)
    global mode.$gd		;#Where RGB conversion is done: Local or Xlib
    global colornames colorfrom colorto
    set  sys [set system.$gd]
    set nsys [set newsys.$gd]
		#Convert color to new system.
    set path [colormaze $sys $nsys]
    set col [getcolor $gd]
    set col [convert $path $col]
    set system.$gd $nsys
		#Cache the conversion path in the new system.
    if {[set mode.$gd] == "Xlib"} {
	set path.$gd [colormaze $nsys {}]	;#Convert to any official system
    } else {
	set path.$gd [colormaze $nsys rgb]	;#We convert to RGB ourself.
    }
    set epath.$gd [colormaze $nsys rgbi]	;#Conversion for error check
		#Update the labels on the scrollbars.
    foreach c {0 1 2} {
	.$gd.bar$c.lbl configure -text [lindex $colornames($nsys) $c] 
	.$gd.bar$c.scl configure -from [lindex $colorfrom($nsys) $c] \
				 -to [lindex $colorto($nsys) $c]
    }
    setgang -1
    setcolor $gd $col				;#Set color when all is ready
    setgang 1
}

# ===== Database reading and default initialization

# Load the RGB database.  Executed only once, at end.
# The color database rgb.txt consists of lines, whitespace separated,
# containing R G B name (comments begin with !).  color(name*)  is set to 
# {R G B}, where name* = name with all blanks removed and converted to lower 
# case.  colorsyn.$R($G) = list of {{R G B name*}} for all colors with 
# that R and G.
proc rgb_load {} {
    global color colorsyn
    set rgbfd [open /usr/lib/X11/rgb.txt r]
    while 1 {
	set row [gets $rgbfd]
	if {[eof $rgbfd]} break
	regsub -all {[ 	]+} [string trim $row] " " row	;#Change whitesp to 1 blank
	if {[string index $row 0] == "!" || [llength $row] < 4} continue
	set rgb [lrange $row 0 2]
	set col2 [lrange $row 3 end]	;#2 word color names like peach puff
		#Canonicalize name: remove blanks, convert to lower case.  
		#Add to inverse list, only if not done yet under different 
		#case/spacing.
	set col $col2
	regsub -all { } [string tolower $col] {} col
	if {![info exists color($col)]} {
	    set color($col) $rgb
	    set R [lindex $rgb 0]
	    if {![info exists colorsyn.${R}]} {global colorsyn.${R}}
	    lappend colorsyn.${R}([lindex $rgb 1]) [concat $rgb $col]
	}
	set color($col2) $rgb		;#Also save using original case/spacing.
    }
    close $rgbfd
}

# Get the color transformation data from the server (if present).  If no data,
# calls default_matrix or default_inten.  Global variables:
#   RGBtoXYZ	Matrix, R($x$r) multiplies RGBi $r giving XYZ $x.
#   XYZtoRGB	Its inverse, X($r$x) multiplies XYZ $x giving RGBi $r.
#   nip($r)	Number of steps in interpolation table for RGB $r.
#   ipi${r}($j)	RGBi for color $r, step $j, with 0 being brightest.
#   ipr${r}($j)	Raw RGB corresponding.
proc readxform {} {
    global nip XYZ_white uvY_white
    set fd [open {|xprop -notype -root \
	32i XDCCC_LINEAR_RGB_MATRICES 32c XDCCC_LINEAR_RGB_CORRECTION} r]
		#Format of the properties: NAME(INTEGER) = {comma sep. list}.
		#Intensity profile: 32 bit integers.  Number of visuals -1;
		#   {visual; number of profiles (colors, 1 or 3); 
		#        {number of pairs in profile -1; {rgb, rgbi}}}
		#   rgbi values in 0..1 are multiplied by 2^32 = 4294967296.  
		#Matrices: 32 bit signed integers scaled by 2^27 = 134217728.  
		#9 components for XYZtoRGB: rx ry rz gx gy gz bx by bz; then
		#9 components for RGBtoXYZ: xr xg xb yr yg yb zr zg zb.
		#If the property is missing, you get NAME: error-message.
    set props {XDCCC_LINEAR_RGB_MATRICES XDCCC_LINEAR_RGB_CORRECTION}
    while {[gets $fd data] > 0} {
	if {![regexp {^[0-9A-Z_a_z]*} $data prop]} continue
	set jprop [lsearch $props $prop]
	if {$jprop < 0} {
	    puts "xprop gives bogus property: $data"
	} elseif {! [regexp {= *(.*$)} $data junk value]} {
		    #Error message (normally missing property)
	    puts "xcolor: $data"
	    default_[lindex {matrix inten} $jprop] $prop
	} else {
	    regsub -all , $value {} value
	    if {! [read_[lindex {matrix inten} $jprop] $prop $value]} {
		default_[lindex {matrix inten} $jprop] $prop
	    }
	}
    }
    close $fd
    set XYZ_white [convert [colormaze rgbi CIEXYZ] {1 1 1}]
    set uvY_white [convert [colormaze rgbi CIEuvY] {1 1 1}]
    return 1
}

#Extract transformation matrices.  Argument is a list of 18 values for
#two matrices, which are signed integers scaled by 2^27.  XYZtoRGB is
#first, then RGBtoXYZ.
proc read_matrix {prop value} {
    global XYZtoRGB  RGBtoXYZ
    set len [llength $value]
    if {$len != 18} {
	puts "$prop should have 18 values, does have $len."
	return 0
    }
    set k 0			;#Subscript in matrix value list
    foreach key {XYZtoRGB RGBtoXYZ} {
	foreach i {0 1 2} {
	    foreach j {0 1 2} {
		set ${key}($i$j) [expr {[lindex $value $k]/134217728.0}]
		incr k
	    }
	}
    }
    return 1
}

# Extract the RGB intensity profiles.  $value is a list of 32 bit unsigned
# integers.  List format:
#   Number-1 of visuals (separate unit for each one; pgm only handles the first)
#	Visual number; number of colors (1 for RGB, 3 for separate)
#	    Number-1 of pairs in profile
#		rgb in 0..255 unscaled (likely can have any maximum)
#		rgbi in 0..1 multiplied by 2^32 = 4294967296.  
proc read_inten {prop value} {
    global nip
    set len [llength $value]
    if {$len < 8} {
	puts "xcolor: $prop value totally bogus."
    }
    set nviz [lindex $value 0]		;#Number of visuals with translations.
    set visual [lindex $value 1]	;#Which visual the first one is for.
    if {$nviz != 0} {
	set nviz [expr {$nviz+1}]
	puts \
"xcolor: $prop specified for $nviz visuals.
The program will use only the first, for visual $visual."
    }
    if {$visual != 0} {
	puts \
"xcolor: local transformations will use $prop for
visual $visual, which is not the default visual (0)."
    }
    set ntab [lindex $value 2]		;#Number-1 of profiles
    set i 2				;#Subscript in $value
    foreach r {0 1 2} {			;#r = color number
	set j [lindex $value [incr i]]	;#Number-1 of pairs in table
	set nip($r) [expr $j+1]
	if {$i+2*$nip($r)+(($r>=$ntab-1)?0:1) >= $len} {
	    puts "xcolor: $prop length is $len, should be longer."
	    return 0
	}
	global ipr$r ipi$r
	for {set m $j} {$m >= 0} {incr m -1} {
	    set ipr${r}($m) [lindex $value [incr i]]
	    set ipi${r}($m) [expr [lindex $value [incr i]].0/4294967296.0]
	}
    }
    return 1
}

# When there is no color characterization data on the server, fake it.
proc default_inten {prop} {
    global nip
    puts "Using default $prop.  Set the property with xcmsdb."
    set rmax 65536			;#Maximum RGB value +1
    set R [expr 2.0/3.0]		;#Ratio in power law intensity profile
    set gamma 1.666			;#Exponent in power law gamma correction
    foreach r {0 1 2} {
	set nip($r) 12
	set n 11
		#Set black and white levels to obvious defaults.
	global ipr$r ipi$r
	set ipi${r}(0) 1.0
	set ipi${r}($n) 0.0
	set ipr${r}(0) [expr $rmax-1]
	set ipr${r}($n) 0
		#Set intensity profile using power law gamma correction.
	for {set i 1} {$i < $n} {incr i} {
	    set ipi${r}($i) [expr {[set ipi${r}([expr $i-1])]*$R}]
		    #ipraw = rmax * ipi${r}($i)^(1/2.35)
	    set ipr${r}($i) \
		[expr {round($rmax*exp(log([set ipi${r}($i)])/$gamma))}]
	}
    }
}

proc default_matrix {prop} {
    global XYZtoRGB RGBtoXYZ
    puts "Using default $prop.  Set the property with xcmsdb."
		# The default matrix values are taken from sample1.dcc 
		# distributed as a sample file with xcmsdb source.  This file
		# describes the Tektronix 4300 monitor with Sony CRT.

		# Comparing the rows with authentic CIEXYZ values, row 0 
		# (00 01 02) seems to be white, row 1 is green, and row 2 is 
		# blue, which is not what I would expect for CIEXYZ.  
		# Reference for CIEXYZ values:
		# Weast, Robert C. (ed.), "Handbook of Chemistry and Physics" 
		# (63rd ed), Chem. Rubber Publ. Co, 1982.  Page E-403, 
		# "Colorimetry",  which in turn is summarizing 
		# Judd, Jour. Optical Society of America, v. 23 p. 359 (1933),
		# Who apparently is summarizing the CIE 1931 standard.
    foreach kv {   {00 0.38106} {01 0.32026} {02 0.24835}
		   {10 0.20730} {11 0.68055} {12 0.11216}
		   {20 0.02134} {21 0.14297} {22 1.24173}} {
	set RGBtoXYZ([lindex $kv 0]) [lindex $kv 1]
    }
    foreach kv {   {00  3.48340} {01 -1.52176} {02 -0.55923}
		   {10 -1.07152} {11  1.96593} {12  0.03673}
		   {20  0.06351} {21 -0.20020} {22  0.81070} } {
	set XYZtoRGB([lindex $kv 0]) [lindex $kv 1]
    }
}

# ======  Widget Operation

# Get the numbers currently in the entries.  Scale as needed, and clip to
# legal range.  Result is a list, {r g b} or whatever the current color system
# involves.  Argument is the "ground" (fg/bg).
proc getcolor {gd} {
    global system.$gd colorfrom colorto colorscale
    set sys [set system.$gd]
    set from  $colorfrom($sys)
    set to    $colorto($sys)
    set scale $colorscale($sys)
    foreach c {0 1 2} {
	global col.$gd$c
	set val [set col.$gd$c]			;#Color component from entry
	set t [lindex $from $c]			;#Clip it (may be user entered)
	if {$val < $t} {set val $t}
	set t [lindex $to $c]
	if {$val > $t} {set val $t}
	set val [expr {$val/double([lindex $scale $c])}]  ;#Scale to color range
	lappend color $val
    }
    return $color
}

# Given one scaled color (i.e. from a scrollbar or entry widget), clip and
# scale to a floating point color, and then set everything.  $gd = bg/fg;
# $c = 0/1/2 for which color; $val = scaled color.
proc scaledcolor {gd c val} {
    global col.$gd$c
    set col.$gd$c $val
    update_color $gd
}

# Set everything from a {r g b} list of floating point color components.
proc setcolor {gd color} {
    global system.$gd colorscale
    set sys [set system.$gd]
    set scale $colorscale($sys)
    foreach c {0 1 2} {
	global col.$gd$c
	set col.$gd$c [expr {round([lindex $color $c]*[lindex $scale $c])}]
    }
    update_color $gd
}

# Initialize global color entry variables
foreach gd {bg fg} {
    foreach c {0 1 2} {
	set col.$gd$c 0
	set oldcol.$gd$c -1
    }
}

# Update everything from the current value of col.$gd$c.  The scaled colors
# in the entry widgets are clipped and unscaled.
proc update_color {gd} {
    global system.$gd colorrgb.$gd path.$gd epath.$gd 
    global colorfrom colorto colorscale panelr
    set sys [set system.$gd]
    set from  $colorfrom($sys)
    set to    $colorto($sys)
    set scale $colorscale($sys)
    set j 0
    foreach c {0 1 2} {
	global col.$gd$c oldcol.$gd$c
	set val [set col.$gd$c]
	if {$val != [set oldcol.$gd$c]} {
	    set fr [lindex $from $c]		;#Clip it
	    if {$val < $fr} {set val $fr}
	    set t [lindex $to $c]
	    if {$val > $t} {set val $t}
	    set col.$gd$c $val		;#Sets the entry widget
	    set range [expr $t-$fr]		;#Set the scrollbar
	    set ssiz [expr {int(0.08*$range)}]
#	    .$gd.bar$c.scl set \
#obsolete?		[expr $range+$ssiz] $ssiz $val [expr $val+$ssiz-1]
	    .$gd.bar$c.scl set $val
	    set oldcol.$gd$c $val
	}
	lappend colorx [expr {$val/double([lindex $scale $c])}] ;#Unscale it
    }
		#Display the ICCCM format of the color
    set colora [icccm $sys $colorx]
    set colorrgb.$gd $colora
		#Produce the ICCCM format and system that the server will
		#actually get.
    set path [set path.$gd]
    if {$path != $sys} {		;#If local conv or unofficial color
	set colora [icccm $path $colorx]
    }
    if {$gd == "bg"} {
	set err [catch ".panel configure -background $colora"]
    } else {
	set err [catch ".panel itemconfigure $panelr -fill $colora"]
    }
    if {! $err} {
	if {$sys == "rgbi"} {
	    set colore $colorx
	} else {
	    set colore [convert [set epath.$gd] $colorx]
	}
	foreach c $colore {
	    if {0 > $c || $c > 1} {set err 1}
	}
    }
    .$gd.head.err configure -text [expr {$err?"Error":""}]
    showall $gd $sys $colorx
}

# Update from a specified color name.
proc update_name {gd} {
    global colorname.$gd system.$gd
    set sys [set system.$gd]
    set path [colormaze name $sys]
    set col [convert $path [set colorname.$gd]]
    setcolor $gd $col
    if {$col == {00 00 00}} {
	.$gd.head.err configure -text Error
    }
}

# Optional features: all system viewer and foreground-background gang 
# operation.  
proc showall {gd sys col} {
    global colorfmt colorsys gangmode.$gd gangmode gangground
		#Fill in the "show all" output area, if turned on.
    set alv .$gd.all.[string tolower [lindex $colorsys 0]].val
    if {[winfo exists $alv]} {
	foreach c $colorsys {
	    set alv .$gd.all.[string tolower $c].val
	    set path [colormaze $sys $c]
	    set vcol [convert $path $col]
	    set fcol {}
	    foreach v $vcol {
		append fcol " [format $colorfmt($c) $v]"
	    }
	    $alv configure -text $fcol
	}
    }
		#Set the other ground if gang mode is turned on.
    if {$gangmode && $gangground != $gd} {
	array set fgbg {fg bg bg fg}
	set gangground $fgbg($gd)
	setcolor $fgbg($gd) [convert [set gangmode.$gd] $col]
	update idletasks
	set gangground {}
    }
}

# Turn gang mode on or off.  ktl:
#   0  = toggle on or off, whichever it wasn't.
#   -1 = turn it off but leave activation state in gangmode.bg
#   1  = Restore activation state and recompute transformation if active.
set gangmode.bg {}			;#Path for gang mode conversion
set gangmode.fg {}			;#Path for gang mode conversion
set gangmode 0				;#Activation mode
set gangground {}			;#Which system initiated a change
proc setgang {ktl} {
    global gangmode gangmode.fg gangmode.bg system.fg system.bg
    set wid .bg.name.quit
    switch -- $ktl {
	-1 {
	    set gangmode 0
	    return
	}
	1 {
	    set gangmode [expr {[set gangmode.fg] != {}}]
	}
	0 {
	    set gangmode [expr {!$gangmode}]
	}
    }
    if {$gangmode} {
	set gangmode.bg [colormaze [set system.bg] [set system.fg]]
	set gangmode.fg [colormaze [set system.fg] [set system.bg]]
	$wid configure -foreground rgbi:1/0/0 -activeforeground rgbi:1/0/0
    } else {
	set gangmode.fg {}
	set gangmode.bg {}
	$wid configure -foreground rgbi:0/0/0 -activeforeground rgbi:0/0/0
    }
}

# Find the name corresponding to the current colors.
proc set_name {gd} {
    global colorname.$gd system.$gd
    set col [getcolor $gd]
    set colorname.$gd [convert [colormaze [set system.$gd] name] $col]
}

# Post the color system menu from other than its menubutton.
proc syspost {gd} {
    set mb .$gd.head.mb
    tkMbPost $mb
}

# ====== Widget layout

# Engage or remove the showall display on both grounds.
proc showall_setup {} {
    global colorsys
    if {[winfo exists .fg.all]} {
	foreach gd {fg bg} {
	    destroy .$gd.all
	}
    } else {
	foreach gd {fg bg} {
	    set all .$gd.all
	    frame $all
	    pack $all -before [lindex [winfo children .$gd] 0] -side right
	    foreach c $colorsys {
		set alf $all.[string tolower $c]
		frame $alf
		pack  $alf -in $all -side top -fill x -expand 1
		label $alf.lbl -text $c
		pack  $alf.lbl -in $alf -side left
		label $alf.val -width 18
		pack  $alf.val -in $alf -side right -anchor e
	    }
	    update_color $gd
	}
    }
}
proc showall_setup_OBSOLETE {} {
    global colorsys
    if {[llength [winfo children .fg.all]] > 0} {
	foreach gd {fg bg} {
	    set all .$gd.all
	    foreach w [winfo children $all] {
		destroy $w
	    }
	    frame $all.junk
	    pack $all.junk -in $all
	    destroy $all.junk
	}
	return
    }
    foreach gd {fg bg} {
	set all .$gd.all
	foreach c $colorsys {
	    set alf $all.[string tolower $c]
	    frame $alf
	    pack  $alf -in $all -side top -fill x -expand 1
	    label $alf.lbl -text $c
	    pack  $alf.lbl -in $alf -side left
	    label $alf.val -width 18
	    pack  $alf.val -in $alf -side right -anchor e
	}
	update_color $gd
    }
}

		# Set up the main widget and canvas (panel).
option add *background rgbi:.5/.5/.5
. configure -background rgbi:.5/.5/.5	;#It already has its default background
set sizx 400; set sizy 300
canvas .panel -width $sizx -height $sizy
pack  .panel -side top -fill x -expand 1

		# Decide which bitmap file to use.
set bitmap /usr/include/X11/bitmaps/xlogo64	;#Hardwired default
set j [option get .panel bitmap Bitmap]
if {$j != {}} {set bitmap $j}			;#From Xresources
set j [lsearch $argv -bitmap]
if {$j >= 0} {set bitmap [lindex $argv [expr $j+1]]}	;#From commmand line

		# Tile the bitmap over the panel.
set panelr [.panel create rectangle 0 0 [expr {$sizx*1.6}] $sizy -outline {} \
	-stipple @$bitmap]

		# Create the background and foreground controllers.
set g 0
foreach gd {bg fg} {			;#Which "ground", background/foreground
		#Ground frame and heading frame
    frame .$gd
    pack  .$gd -in . -side top -fill x -expand 1 -anchor w
		#When "showall" is turned on, the first child will be a
		#frame containing the showall data, packed at the right.

		#Top line of "ground" area.
    frame .$gd.head
    pack  .$gd.head -in .$gd -side top -anchor n -fill x -expand 1
		#Title (Background or Foreground)
    label .$gd.head.title -text [lindex {Background Foreground} $g]
    pack  .$gd.head.title -in .$gd.head -side left
		#Error indicator, says "error" if color is out of gamut.
    label .$gd.head.err -width 5 -foreground rgbi:1/0/0
    pack  .$gd.head.err -in .$gd.head -side left -padx 12
		#Mode variable and indicator (Local or Xlib)
    set mv mode.$gd
    set $mv Xlib
    label .$gd.head.mode -textvariable $mv -width 6 -relief sunken
		#Variable and indicator for name of color system
    set sv newsys.$gd			;#Variable to hold name of color system
    set $sv rgbi
    set system.$gd rgbi
    label .$gd.head.cs -textvariable system.$gd -width 7 -relief sunken
		#Menu and button to select color system and mode
    set mb .$gd.head.mb
    menubutton $mb -text "Color System:" -menu $mb.menu
    bind  .$gd.head.cs   <ButtonRelease-1> "tkMbPost $mb"
    bind  .$gd.head.mode <ButtonRelease-1> "tkMbPost $mb"
    pack  .$gd.head.mode .$gd.head.cs $mb -in .$gd.head -side right
    menu $mb.menu
    foreach c $colorsys {
	$mb.menu add radiobutton -label $c -value $c -variable $sv
    }
    $mb.menu add separator
    $mb.menu add radiobutton -label "Local Conv"  -value Local  -variable $mv
    $mb.menu add radiobutton -label "Xlib Conv" -value Xlib -variable $mv
		#Trace the mode and system variables so that when the menu
		#button changes it, everything gets updated.
    foreach var "$sv $mv" {
	trace variable $var w "colorsys_trace $gd"
    }
		#Command to display simultaneous translations.
    $mb.menu add separator
    $mb.menu add command -label "Show All" -command "showall_setup"
		#Scrollbars for 3 color components, each in its own frame
    foreach c {0 1 2} {
	frame .$gd.bar$c -bd 2
		#Label for name of color component
	label .$gd.bar$c.lbl -relief sunken -width 5
	pack  .$gd.bar$c.lbl -in .$gd.bar$c -side left
		#Variable to hold color component, and entry to set it directly
	set col.$gd$c 0
	entry .$gd.bar$c.ent -textvariable col.$gd$c -relief sunken -width 5
	bind  .$gd.bar$c.ent <Return> "update_color $gd"
	pack  .$gd.bar$c.ent -in .$gd.bar$c -side right
		#The scrollbar itself
#	scrollbar .$gd.bar$c.scl -command "scaledcolor $gd $c" \
#obsolete?	    -orient horizontal -relief sunken
	scale .$gd.bar$c.scl -command "scaledcolor $gd $c" \
	    -orient horizontal -showvalue 0
	pack  .$gd.bar$c.scl -in .$gd.bar$c -side right -expand yes -fill both
	pack  .$gd.bar$c -side top -anchor n -expand yes -fill x
    }
		#Bottom section in its own frame:
    frame .$gd.name -bd 4
		#Button causes color components to be translated to a name.
    button .$gd.name.lbl -text "Name:" -command "set_name $gd"
		#Entry and variable so a name can be entered.  The button's
		#output name also goes here.  The initial names are used 
		#eventually to initialize the panel colors.
    set colorname.$gd [lindex {white black} $g]
    entry .$gd.name.ent -textvariable colorname.$gd -relief sunken -bd 2
    bind  .$gd.name.ent <Return> "update_name $gd"
		#The current color in proper ICCCM format, and variable for it
    set colorrgb.$gd {}
    entry .$gd.name.rgb -textvariable colorrgb.$gd -state disabled\
	-relief sunken -width 21
		#Quit or Gang button.  (Crock: shouldn't be two of them!)
    if {$g} {
	button .$gd.name.quit -text Quit -command {exit}
    } else {
	button .$gd.name.quit -text {Gang} -command "setgang 0"
    }
    pack .$gd.name.lbl -in .$gd.name -side left
    pack .$gd.name.ent -in .$gd.name -side left -fill x -expand 1
    pack .$gd.name.quit .$gd.name.rgb -in .$gd.name -side right
    pack .$gd.name -side top -anchor n -fill x
    incr g
}

wm deiconify .
puts "Loading color characterization data from server"
readxform			;#Load color characterization data from server
puts "Loading color name database"
rgb_load			;#Load RGB name database
foreach gd {bg fg} {
    update_name $gd		;#Initialize colors from initial names
    changesys $gd		;#Set up all transformation data.
}