Module rempla�ant la gestion des couleurs (d�grad�s) de Tk.

1 files changed, 1213 insertions, 0 deletions

diff --git a/generic/Color.c b/generic/Color.c
new file mode 100644
index 0000000..4cbaa6c
--- /dev/null
+++ b/generic/Color.c
@@ -0,0 +1,1213 @@
+/*
+ * Color.c -- Color management module.
+ *
+ * Authors		: Patrick Lecoanet.
+ * Creation date	: Thu Dec 16 15:41:53 1999
+ *
+ * $Id$
+ */
+
+/*
+ *  Copyright (c) 1999 CENA, Patrick Lecoanet --
+ *
+ * This code is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Library General Public
+ * License as published by the Free Software Foundation; either
+ * version 2 of the License, or (at your option) any later version.
+ *
+ * This code 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
+ * Library General Public License for more details.
+ *
+ * You should have received a copy of the GNU Library General Public
+ * License along with this code; if not, write to the Free
+ * Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ */
+
+/*
+ * Most of this file is derived from Tk color code and thus
+ * also copyrighted:
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ */
+
+
+#include <malloc.h>
+
+#include "Types.h"
+#include "Image.h"
+#include "Color.h"
+#include "Geo.h"
+
+
+/*
+ * If a colormap fills up, attempts to allocate new colors from that
+ * colormap will fail.  When that happens, we'll just choose the
+ * closest color from those that are available in the colormap.
+ * One of the following structures will be created for each "stressed"
+ * colormap to keep track of the colors that are available in the
+ * colormap (otherwise we would have to re-query from the server on
+ * each allocation, which would be very slow).  These entries are
+ * flushed after a few seconds, since other clients may release or
+ * reallocate colors over time.
+ */
+typedef struct StressedCmap {
+  Colormap	colormap;	/* X's token for the colormap. */
+  int		num_colors;	/* Number of entries currently active
+				 * at *colorPtr. */
+  XColor	*color;		/* Pointer to malloc'ed array of all
+				 * colors that seem to be available in
+				 * the colormap.  Some may not actually
+				 * be available, e.g. because they are
+				 * read-write for another client;  when
+				 * we find this out, we remove them
+				 * from the array. */
+  struct StressedCmap *next;	/* Next in list of all stressed
+				 * colormaps for the display. */
+} StressedCmap;
+
+typedef struct StressedDpy {
+  Display		*dpy;
+  StressedCmap		*stress;
+  struct StressedDpy	*next;
+} StressedDpy;
+
+static StressedDpy	*stressed_display_list = NULL;
+
+
+#define COLOR_MAGIC ((unsigned int) 0x46140277)
+
+typedef struct TkColor {
+  XColor	color;		/* Information about this color. */
+  unsigned int	magic;		/* Used for quick integrity check on this
+				 * structure.   Must always have the
+				 * value COLOR_MAGIC. */
+  Screen	*screen;	/* Screen where this color is valid.  Used
+				 * to delete it, and to find its display. */
+  Colormap	colormap;	/* Colormap from which this entry was
+				 * allocated. */
+  Visual	*visual;	/* Visual associated with colormap. */
+  int		ref_count;	/* Number of uses of this structure. */
+  Tcl_HashTable	*table;		/* Hash table that indexes this structure
+				 * (needed when deleting structure). */
+  Tcl_HashEntry	*hash;		/* Pointer to hash table entry for this
+				 * structure. (for use in deleting entry). */
+} TkColor;
+
+
+/*
+ * A two-level data structure is used to manage the color database.
+ * The top level consists of one entry for each color name that is
+ * currently active, and the bottom level contains one entry for each
+ * pixel value that is still in use.  The distinction between
+ * levels is necessary because the same pixel may have several
+ * different names.  There are two hash tables, one used to index into
+ * each of the data structures.  The name hash table is used when
+ * allocating colors, and the pixel hash table is used when freeing
+ * colors.
+ */
+
+/*
+ * Hash table for name -> TkColor mapping, and key structure used to
+ * index into that table:
+ */
+static Tcl_HashTable	name_table;
+
+typedef struct {
+    Tk_Uid name;		/* Name of desired color. */
+    Colormap colormap;		/* Colormap from which color will be
+				 * allocated. */
+    Display *display;		/* Display for colormap. */
+} NameKey;
+
+
+/*
+ * Hash table for value -> TkColor mapping, and key structure used to
+ * index into that table:
+ */
+static Tcl_HashTable	value_table;
+
+typedef struct {
+    int red, green, blue;	/* Values for desired color. */
+    Colormap colormap;		/* Colormap from which color will be
+				 * allocated. */
+    Display *display;		/* Display for colormap. */
+} ValueKey;
+
+
+typedef struct _ColorGradient {
+  Screen	*screen;	/* Screen on which the gradient will be used. */
+  Visual	*visual;	/* Visual for all windows and pixmaps using
+				 * the gradient. */
+  int		depth;		/* Number of bits per pixel of drawables where
+				 * the gradient will be used. */
+  Colormap	colormap;	/* Colormap out of which pixels are
+				 * allocated. */
+  int		ref_count;
+  Tcl_HashEntry	*hash;
+  RadarBool	realized;
+  int		num_colors;	/* Number of steps in the gradient. */
+  XColor	*colors[1];	/* Colors of the gradient. */
+} ColorGradient;
+
+
+/*
+ * Maximum size of a color name including the \0.
+ */
+#define COLOR_NAME_SIZE 128
+
+/*
+ * Maximum intensity for a color.
+ */
+#define MAX_INTENSITY 65535
+
+/*
+ * Number of steps in a border gradient (should be odd).
+ */
+#define BORDER_STEPS	(RELIEF_STEPS*2+1)
+
+/*
+ * Hash table to map from a gradient's values (color, etc.) to a
+ * gradient structure for those values.
+ */
+static Tcl_HashTable gradient_table;
+
+typedef struct {
+    Tk_Uid	name;		/* Gradient spec. */
+    Colormap	colormap;	/* Colormap used for allocating gradient
+				 * colors. */
+    Screen	*screen;	/* Screen on which gradient will be drawn. */
+} GradientKey;
+
+
+static int initialized = 0;	/* 0 means static structures haven't been
+				 * initialized yet. */
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetStressedDisplay --
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+static StressedDpy *
+GetStressedDisplay(Display	*dpy)
+{
+  StressedDpy	*cur;
+
+  for (cur = stressed_display_list; cur != NULL; cur = cur->next) {
+    if (cur->dpy == dpy) {
+      break;
+    }
+  }
+  if (cur == NULL) {
+    /*
+     * Not found, allocate a new one.
+     */
+    cur = (StressedDpy *) RadarMalloc(sizeof(StressedDpy));
+    cur->dpy = dpy;
+    cur->stress = NULL;
+    cur->next = stressed_display_list;
+    stressed_display_list = cur;
+  }
+  
+  return cur;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteStressedCmap --
+ *
+ *	This procedure releases the information cached for "colormap"
+ *	so that it will be refetched from the X server the next time
+ *	it is needed.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The StressedCmap structure for colormap is deleted;  the
+ *	colormap is no longer considered to be "stressed".
+ *
+ * Note:
+ *	This procedure is invoked whenever a color in a colormap is
+ *	freed, and whenever a color allocation in a colormap succeeds.
+ *	This guarantees that StressedCmap structures are always
+ *	deleted before the corresponding Colormap is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+DeleteStressedCmap(Display	*display,
+		   Colormap	colormap)
+{
+  StressedDpy	*dpy = GetStressedDisplay(display);
+  StressedCmap	*prev, *stress;
+  
+  for (prev = NULL, stress = dpy->stress; stress != NULL;
+       prev = stress, stress = stress->next) {
+    if (stress->colormap == colormap) {
+      if (prev == NULL) {
+	dpy->stress = stress->next;
+      }
+      else {
+	prev->next = stress->next;
+      }
+      RadarFree(stress->color);
+      RadarFree(stress);
+      return;
+    }
+  }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindClosestColor --
+ *
+ *	When Tk can't allocate a color because a colormap has filled
+ *	up, this procedure is called to find and allocate the closest
+ *	available color in the colormap.
+ *
+ * Results:
+ *	There is no return value, but *actualColorPtr is filled in
+ *	with information about the closest available color in tkwin's
+ *	colormap.  This color has been allocated via X, so it must
+ *	be released by the caller when the caller is done with it.
+ *
+ * Side effects:
+ *	A color is allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+FindClosestColor(Tk_Window	tkwin,		/* Window where color will
+						 * be used. */
+		 XColor		*desired_color,	/* RGB values of color that was
+						 * wanted (but unavailable). */
+		 XColor		*actual_color)	/* Structure to fill in with
+						 * RGB and pixel for closest
+						 * available color. */
+{
+  StressedDpy	*dpy = GetStressedDisplay(Tk_Display(tkwin));
+  StressedCmap	*stress;
+  double	tmp, distance, closest_dist;
+  int		i, closest, num_found;
+  XColor	*color;
+  Colormap	colormap = Tk_Colormap(tkwin);
+  XVisualInfo	template, *vis_info;
+  
+  /*
+   * Find the StressedCmap structure for this colormap, or create
+   * a new one if needed.
+   */
+  for (stress = dpy->stress; ; stress = stress->next) {
+    if (stress == NULL) {
+      stress = (StressedCmap *) RadarMalloc(sizeof(StressedCmap));
+      stress->colormap = colormap;
+      template.visualid = XVisualIDFromVisual(Tk_Visual(tkwin));
+      vis_info = XGetVisualInfo(Tk_Display(tkwin), VisualIDMask,
+				&template, &num_found);
+      if (num_found < 1) {
+	RadarWarning("FindClosestColor (Radar) couldn't lookup visual");
+	abort();
+      }
+      stress->num_colors = vis_info->colormap_size;
+      XFree((char *) vis_info);
+      stress->color = (XColor *) RadarMalloc((unsigned)
+					     (stress->num_colors*sizeof(XColor)));
+      for (i = 0; i < stress->num_colors; i++) {
+	stress->color[i].pixel = (unsigned long) i;
+      }
+      XQueryColors(Tk_Display(tkwin), colormap, stress->color, stress->num_colors);
+      stress->next = dpy->stress;
+      dpy->stress = stress;
+      break;
+    }
+    if (stress->colormap == colormap) {
+      break;
+    }
+  }
+  
+  /*
+   * Find the color that best approximates the desired one, then
+   * try to allocate that color.  If that fails, it must mean that
+   * the color was read-write (so we can't use it, since it's owner
+   * might change it) or else it was already freed.  Try again,
+   * over and over again, until something succeeds.
+   */
+  while (1)  {
+    if (stress->num_colors == 0) {
+      RadarWarning("FindClosestColor (Radar) ran out of colors");
+      abort();
+    }
+    closest_dist = 1e30;
+    closest = 0;
+    for (color = stress->color, i = 0; i < stress->num_colors;
+	 color++, i++) {
+      /*
+       * Use Euclidean distance in RGB space, weighted by Y (of YIQ)
+       * as the objective function;  this accounts for differences
+       * in the color sensitivity of the eye.
+       */
+      tmp = 0.30*(((int) desired_color->red) - (int) color->red);
+      distance = tmp*tmp;
+      tmp = 0.61*(((int) desired_color->green) - (int) color->green);
+      distance += tmp*tmp;
+      tmp = 0.11*(((int) desired_color->blue) - (int) color->blue);
+      distance += tmp*tmp;
+      if (distance < closest_dist) {
+	closest = i;
+	closest_dist = distance;
+      }
+    }
+    if (XAllocColor(Tk_Display(tkwin), colormap, &stress->color[closest]) != 0) {
+      *actual_color = stress->color[closest];
+      return;
+    }
+    
+    /*
+     * Couldn't allocate the color.  Remove it from the table and
+     * go back to look for the next best color.
+     */
+    stress->color[closest] = stress->color[stress->num_colors-1];
+    stress->num_colors -= 1;
+  }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CmapStressed --
+ *
+ *	Check to see whether a given colormap is known to be out
+ *	of entries.
+ *
+ * Results:
+ *	1 is returned if "colormap" is stressed (i.e. it has run out
+ *	of entries recently), 0 otherwise.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+#if 0
+static RadarBool
+CmapStressed(Tk_Window	tkwin,
+	     Colormap	colormap)
+{
+  StressedDpy	*dpy = GetStressedDisplay(Tk_Display(tkwin));
+  StressedCmap	*stress;
+
+  for (stress = dpy->stress; stress != NULL; stress = stress->next) {
+    if (stress->colormap == colormap) {
+      return True;
+    }
+  }
+  return False;
+}
+#endif
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ColorInit --
+ *
+ *	Initialize the structure used for color management.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Read the code.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+ColorInit()
+{
+  initialized = 1;
+  Tcl_InitHashTable(&name_table, sizeof(NameKey)/sizeof(int));
+  Tcl_InitHashTable(&value_table, sizeof(ValueKey)/sizeof(int));
+  Tcl_InitHashTable(&gradient_table, sizeof(GradientKey)/sizeof(int));
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RadarGetColor --
+ *
+ *	Given a string name for a color, map the name to a corresponding
+ *	XColor structure.
+ *
+ * Results:
+ *	The return value is a pointer to an XColor structure that
+ *	indicates the red, blue, and green intensities for the color
+ *	given by "name", and also specifies a pixel value to use to
+ *	draw in that color.  If an error occurs, NULL is returned and
+ *	an error message will be left in interp->result.
+ *
+ * Side effects:
+ *	The color is added to an internal database with a reference count.
+ *	For each call to this procedure, there should eventually be a call
+ *	to RadarFreeColor so that the database is cleaned up when colors
+ *	aren't in use anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+XColor *
+RadarGetColor(Tcl_Interp	*interp,
+	      Tk_Window		tkwin,	/* Window in which color will be used. */
+	      Tk_Uid		name)	/* Name of color to allocated (in form
+					 * suitable for passing to XParseColor). */
+{
+  NameKey	name_key;
+  Tcl_HashEntry	*name_hash;
+  int		new;
+  Display	*dpy = Tk_Display(tkwin);
+  Colormap	colormap = Tk_Colormap(tkwin);
+  XColor	color, screen;
+  TkColor	*tk_col;
+
+  if (!initialized) {
+    ColorInit();
+  }
+
+  /*printf("RadarGetColor color: %s\n", name);*/
+  /*
+   * First, check to see if there's already a mapping for this color
+   * name.
+   */
+  name_key.name = name;
+  name_key.colormap = Tk_Colormap(tkwin);
+  name_key.display = Tk_Display(tkwin);
+  name_hash = Tcl_CreateHashEntry(&name_table, (char *) &name_key, &new);
+  if (!new) {
+    tk_col = (TkColor *) Tcl_GetHashValue(name_hash);
+    tk_col->ref_count++;
+    /*printf("RadarGetColor cache hit for: %d %d %d\n",
+      tk_col->color.red, tk_col->color.green, tk_col->color.blue);*/ 
+    return &tk_col->color;
+  }
+
+  /*
+   * Map from the name to a pixel value.  Call XAllocNamedColor rather than
+   * XParseColor for non-# names: this saves a server round-trip for those
+   * names.
+   */
+  if (*name != '#') {
+    if (XAllocNamedColor(dpy, colormap, name, &screen, &color) != 0) {
+      /*printf("RadarGetColor XAllocNamedColor gives: %d %d %d\n",
+	     color.red, color.green, color.blue);*/
+      DeleteStressedCmap(dpy, colormap);
+    }
+    else {
+      /*
+       * Couldn't allocate the color.  Try translating the name to
+       * a color value, to see whether the problem is a bad color
+       * name or a full colormap.  If the colormap is full, then
+       * pick an approximation to the desired color.
+       */
+      if (XLookupColor(dpy, colormap, name, &color, &screen) == 0) {
+      col_err:
+	if (*name == '#') {
+	  Tcl_AppendResult(interp, "invalid color name \"", name,
+			   "\"", (char *) NULL);
+	}
+	else {
+	  Tcl_AppendResult(interp, "unknown color name \"", name,
+			   "\"", (char *) NULL);
+	}
+	Tcl_DeleteHashEntry(name_hash);
+	return (XColor *) NULL;  
+      }
+      FindClosestColor(tkwin, &screen, &color);
+    }
+  }
+  else {
+    if (XParseColor(dpy, colormap, name, &color) == 0) {
+      goto col_err;
+    }
+    if (XAllocColor(dpy, colormap, &color) != 0) {
+      DeleteStressedCmap(dpy, colormap);
+    }
+    else {
+      FindClosestColor(tkwin, &color, &color);
+    }
+  }
+  
+  tk_col = (TkColor *) RadarMalloc(sizeof(TkColor));
+  tk_col->color = color;
+
+  /*
+   * Now create a new TkColor structure and add it to nameTable.
+   */  
+  tk_col->magic = COLOR_MAGIC;
+  tk_col->screen = Tk_Screen(tkwin);
+  tk_col->colormap = name_key.colormap;
+  tk_col->visual  = Tk_Visual(tkwin);
+  tk_col->ref_count = 1;
+  tk_col->table = &name_table;
+  tk_col->hash = name_hash;
+  Tcl_SetHashValue(name_hash, tk_col);
+  
+  /*printf("RadarGetColor created: %d %d %d\n",
+    tk_col->color.red, tk_col->color.green, tk_col->color.blue);*/ 
+  return &tk_col->color;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RadarGetColorByValue --
+ *
+ *	Given a desired set of red-green-blue intensities for a color,
+ *	locate a pixel value to use to draw that color in a given
+ *	window.
+ *
+ * Results:
+ *	The return value is a pointer to an XColor structure that
+ *	indicates the closest red, blue, and green intensities available
+ *	to those specified in colorPtr, and also specifies a pixel
+ *	value to use to draw in that color.
+ *
+ * Side effects:
+ *	The color is added to an internal database with a reference count.
+ *	For each call to this procedure, there should eventually be a call
+ *	to RadarFreeColor, so that the database is cleaned up when colors
+ *	aren't in use anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+XColor *
+RadarGetColorByValue(Tk_Window	tkwin,
+		     XColor	*color)
+{
+  ValueKey	value_key;
+  Tcl_HashEntry	*value_hash;
+  int		new;
+  TkColor	*tk_col;
+  Display	*dpy = Tk_Display(tkwin);
+  Colormap	colormap = Tk_Colormap(tkwin);
+  
+  if (!initialized) {
+    ColorInit();
+  }
+  
+  /*
+   * First, check to see if there's already a mapping for this color
+   * name.
+   */
+  value_key.red = color->red;
+  value_key.green = color->green;
+  value_key.blue = color->blue;
+  value_key.colormap = Tk_Colormap(tkwin);
+  value_key.display = Tk_Display(tkwin);
+  value_hash = Tcl_CreateHashEntry(&value_table, (char *) &value_key, &new);
+  if (!new) {
+    tk_col = (TkColor *) Tcl_GetHashValue(value_hash);
+    tk_col->ref_count++;
+    return &tk_col->color;
+  }
+  
+  /*
+   * The name isn't currently known.  Find a pixel value 
+   * to use to draw that color in a given window.
+   */
+  tk_col = (TkColor *) RadarMalloc(sizeof(TkColor));
+  tk_col->color.red = color->red;
+  tk_col->color.green = color->green;
+  tk_col->color.blue = color->blue;
+  if (XAllocColor(dpy, colormap, &tk_col->color) != 0) {
+    DeleteStressedCmap(dpy, colormap);
+  }
+  else {
+    FindClosestColor(tkwin, &tk_col->color, &tk_col->color);
+  }
+  
+  tk_col->magic = COLOR_MAGIC;
+  tk_col->screen = Tk_Screen(tkwin);
+  tk_col->colormap = value_key.colormap;
+  tk_col->visual  = Tk_Visual(tkwin);
+  tk_col->ref_count = 1;
+  tk_col->table = &value_table;
+  tk_col->hash = value_hash;
+  Tcl_SetHashValue(value_hash, tk_col);
+
+  return &tk_col->color;
+}
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * RadarNameOfColor --
+ *
+ *	Given a color, return a textual string identifying
+ *	the color.
+ *
+ * Results:
+ *	If colorPtr was created by Tk_GetColor, then the return
+ *	value is the "string" that was used to create it.
+ *	Otherwise the return value is a string that could have
+ *	been passed to Tk_GetColor to allocate that color.  The
+ *	storage for the returned string is only guaranteed to
+ *	persist up until the next call to this procedure.
+ *
+ * Side effects:
+ *	None.
+ *
+ *--------------------------------------------------------------
+ */
+char *
+RadarNameOfColor(XColor	*color)
+{
+  register TkColor *tk_col = (TkColor *) color;
+  static char	   string[20];
+  
+  if ((tk_col->magic == COLOR_MAGIC) && (tk_col->table == &name_table)) {
+    return ((NameKey *) tk_col->hash->key.words)->name;
+  }
+  sprintf(string, "#%04x%04x%04x", color->red, color->green, color->blue);
+  return string;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RadarFreeColor --
+ *
+ *	This procedure is called to release a color allocated by
+ *	RadarGetColor or RadarGetColorByValue.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The reference count associated with colorPtr is deleted, and
+ *	the color is released to X if there are no remaining uses
+ *	for it.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+RadarFreeColor(XColor	*color)	/* Color to be released.  Must have been
+				 * allocated by RadarGetColor or
+				 * RadarGetColorByValue. */
+{
+  TkColor	*tk_col = (TkColor *) color;
+  Visual	*visual;
+  Screen	*screen = tk_col->screen;
+  Tk_ErrorHandler handler;
+
+  /*
+   * Do a quick sanity check to make sure this color was really
+   * allocated by RadarGetColor.
+   */
+  if (tk_col->magic != COLOR_MAGIC) {
+    RadarWarning("RadarFreeColor called with bogus color");
+    abort();
+  }
+  
+  tk_col->ref_count--;
+  if (tk_col->ref_count == 0) {
+    /*printf("RadarFreeColor freeing %s\n", RadarNameOfColor(color));*/
+    /*
+     * Careful!  Don't free black or white, since this will
+     * make some servers very unhappy.  Also, there is a bug in
+     * some servers (such Sun's X11/NeWS server) where reference
+     * counting is performed incorrectly, so that if a color is
+     * allocated twice in different places and then freed twice,
+     * the second free generates an error (this bug existed as of
+     * 10/1/92).  To get around this problem, ignore errors that
+     * occur during the free operation.
+     */
+    visual = tk_col->visual;
+    if ((visual->class != StaticGray) && (visual->class != StaticColor) &&
+	(tk_col->color.pixel != BlackPixelOfScreen(screen)) &&
+	(tk_col->color.pixel != WhitePixelOfScreen(screen))) {
+      handler = Tk_CreateErrorHandler(DisplayOfScreen(screen),
+				      -1, -1, -1, (Tk_ErrorProc *) NULL,
+				      (ClientData) NULL);
+      XFreeColors(DisplayOfScreen(screen), tk_col->colormap,
+		  &tk_col->color.pixel, 1, 0L);
+      Tk_DeleteErrorHandler(handler);
+    }
+    DeleteStressedCmap(DisplayOfScreen(screen), tk_col->colormap);
+    
+    Tcl_DeleteHashEntry(tk_col->hash);
+    tk_col->magic = 0;
+    RadarFree(tk_col);
+  }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RealizeColorGradient --
+ *
+ *	This procedure allocate the colors still unallocated in
+ *	a gradient. The first and last colors are always allocated
+ *	during the gradient's creation. For 3D gradients the center
+ *	color is also allocated.
+ *	It's called lazily by RadarColorGradientPixel, so that the
+ *	colors aren't allocated until something is actually drawn
+ *	with them.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+RealizeColorGradient(ColorGradient	*grad,
+		     Tk_Window		tkwin)
+{
+  int		i, num_colors;
+  XColor	*base, *first, *last, color;
+  int		red_range, green_range, blue_range;
+  
+  if (grad->realized) {
+    return;
+  }
+
+  num_colors = grad->num_colors;
+  first = grad->colors[0];
+  last = grad->colors[num_colors-1];
+  
+  /*
+   * Fill the in between colors. For a border gradient, this
+   * is done in two steps, first compute the colors between the
+   * base and the lightest, then the colors between base and the
+   * darkest. This ensure that the gradient will go through base.
+   * For others gradients proceed from lightest to darkest.
+   */
+  if ((num_colors == BORDER_STEPS) &&
+      (grad->colors[BORDER_STEPS/2+1])) {
+    base = grad->colors[BORDER_STEPS/2+1];
+    red_range = (int) base->red - (int) first->red;
+    green_range = (int) base->green - (int) first->green;
+    blue_range = (int) base->blue - (int) first->blue;
+    for (i = BORDER_STEPS/2; i > 0; i--) {
+      color.red = (int) base->red + red_range * i / (num_colors-2);
+      color.green = (int) base->green + green_range * i / (num_colors-2);
+      color.blue = (int) base->blue + blue_range * i / (num_colors-2);
+      grad->colors[i] = RadarGetColorByValue(tkwin, &color);
+    }
+    red_range = (int) base->red - (int) last->red;
+    green_range = (int) base->green - (int) last->green;
+    blue_range = (int) base->blue - (int) last->blue;
+    for (i = BORDER_STEPS/2+2; i < num_colors-1; i++) {
+      color.red = (int) base->red + red_range * i / (num_colors-2);
+      color.green = (int) base->green + green_range * i / (num_colors-2);
+      color.blue = (int) base->blue + blue_range * i / (num_colors-2);
+      grad->colors[i] = RadarGetColorByValue(tkwin, &color);
+    }
+  }
+  else {
+    red_range = (int) last->red - (int) first->red;
+    green_range = (int) last->green - (int) first->green;
+    blue_range = (int) last->blue - (int) first->blue;
+    for (i = 1; i < num_colors-1; i++) {
+      color.red =(int) first->red +  red_range * i / (num_colors-2);
+      color.green = (int) first->green + green_range * i / (num_colors-2);
+      color.blue = (int) first->blue + blue_range * i / (num_colors-2);
+      grad->colors[i] = RadarGetColorByValue(tkwin, &color);
+    }
+  }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RadarColorGradientSpan --
+ *
+ *----------------------------------------------------------------------
+ */
+int
+RadarColorGradientSpan(RadarColorGradient	gradient)
+{
+  return ((ColorGradient *) gradient)->num_colors;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RadarColorGradientPixel --
+ *
+ *----------------------------------------------------------------------
+ */
+int
+RadarColorGradientPixel(RadarColorGradient	gradient,
+			Tk_Window		tkwin,
+			int			color_index)
+{
+  ColorGradient	*grad = (ColorGradient *) gradient;
+
+  if (color_index < 0) {
+    color_index += grad->num_colors;
+  }
+  else if (color_index >= grad->num_colors) {
+    color_index = grad->num_colors-1;
+  }
+  if (!grad->realized) {
+    RealizeColorGradient(grad, tkwin);
+  }
+  return RadarPixel(grad->colors[color_index]);
+}
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * RadarGetReliefGradient --
+ *
+ *	Create a data structure containing a range of colors
+ *	used to display a 3D border. Name contains the base
+ *	color for the border. This is a slight variation on
+ *	the syntax of a gradient that make life easier in this
+ *	simple case.
+ *
+ * Results:
+ *	The return value is a token for a data structure
+ *	describing a gradient.  This token may be passed
+ *	to the drawing routines. This function allocate
+ *	the base color and the two end colors in an attempt
+ *	to use only actually needed resources. The function
+ *	RadarColorGradientPixel asserts that all the colors
+ *	get allocated when needed.
+ *	If an error prevented the gradient from being created
+ *	then NULL is returned and an error message will be
+ *	left in interp.
+ *
+ * Side effects:
+ *	Data structures, etc. are allocated.
+ *	It is the caller's responsibility to eventually call
+ *	RadarFreeColorGradient to release the resources.
+ *
+ *--------------------------------------------------------------
+ */
+RadarColorGradient
+RadarGetReliefGradient(Tcl_Interp	*interp,
+		       Tk_Window	tkwin,
+		       Tk_Uid		name)
+{
+  GradientKey	key;
+  Tcl_HashEntry	*hash;
+  ColorGradient	*grad;
+  int		i, new, tmp1, tmp2;
+  XColor	*base, color;
+
+  if (!initialized) {
+    ColorInit();
+  }
+  
+  /*
+   * First, check to see if there's already a gradient that will work
+   * for this request.
+   */  
+  key.name = name;
+  key.colormap = Tk_Colormap(tkwin);
+  key.screen = Tk_Screen(tkwin);
+  
+  hash = Tcl_CreateHashEntry(&gradient_table, (char *) &key, &new);
+  if (!new) {
+    grad = (ColorGradient *) Tcl_GetHashValue(hash);
+    grad->ref_count++;
+  }
+  else {
+    /*
+     * No satisfactory gradient exists yet.  Initialize a new one.
+     */
+    base = RadarGetColor(interp, tkwin, name);
+    if (base == NULL) {
+      Tcl_AppendResult(interp, " in border gradient", NULL);
+      Tcl_DeleteHashEntry(hash);
+      return NULL;
+    }
+
+    grad = (ColorGradient *) RadarMalloc(sizeof(ColorGradient) +
+					 sizeof(XColor *)*(BORDER_STEPS-1));
+    grad->screen = Tk_Screen(tkwin);
+    grad->visual = Tk_Visual(tkwin);
+    grad->depth = Tk_Depth(tkwin);
+    grad->colormap = key.colormap;
+    grad->ref_count = 1; 
+    grad->realized = False;
+    grad->hash = hash;
+    grad->num_colors = BORDER_STEPS;
+    /*
+     * BORDER_STEPS should be odd, the base color
+     * takes the center position.
+     */
+    grad->colors[BORDER_STEPS/2+1] = base;
+
+    /*
+     * Compute the border gradient.
+     *
+     * Always consider that we are dealing with a color display with
+     * enough colors available. If the colormap is full (stressed)
+     * then just pray, the susbstitution algorithm may return something
+     * adequate ;-).
+     *
+     * The extremum colors get computed using whichever formula results
+     * in the greatest change in color:
+     * 1. Lighter color is half-way to white, darker color is half
+     *    way to dark.
+     * 2. Lighter color is 40% brighter than base, darker color
+     *    is 40% darker than base.
+     * The first approach works better for unsaturated colors, the
+     * second for saturated ones.
+     *
+     * NOTE: Colors are computed with integers not color shorts which
+     * may lead to overflow errors.
+     */
+    tmp1 = (60 * (int) base->red)/100;
+    tmp2 = (MAX_INTENSITY + (int) base->red)/2;
+    color.red = MIN(tmp1, tmp2);
+    tmp1 = (60 * (int) base->green)/100;
+    tmp2 = (MAX_INTENSITY + (int) base->green)/2;
+    color.green = MIN(tmp1, tmp2);
+    tmp1 = (60 * (int) base->blue)/100;
+    tmp2 = (MAX_INTENSITY + (int) base->blue)/2;
+    color.blue = MIN(tmp1, tmp2);
+    grad->colors[0] = RadarGetColorByValue(tkwin, &color);
+
+    tmp1 = (14 * (int) base->red)/10;
+    if (tmp1 > MAX_INTENSITY) {
+      tmp1 = MAX_INTENSITY;
+    }
+    tmp2 = (MAX_INTENSITY + (int) base->red)/2;
+    color.red = MAX(tmp1, tmp2);
+    tmp1 = (14 * (int) base->green)/10;
+    if (tmp1 > MAX_INTENSITY) {
+      tmp1 = MAX_INTENSITY;
+    }
+    tmp2 = (MAX_INTENSITY + (int) base->green)/2;
+    color.green = MAX(tmp1, tmp2);
+    tmp1 = (14 * (int) base->blue)/10;
+    if (tmp1 > MAX_INTENSITY) {
+      tmp1 = MAX_INTENSITY;
+    }
+    tmp2 = (MAX_INTENSITY + (int) base->blue)/2;
+    color.blue = MAX(tmp1, tmp2);
+    grad->colors[BORDER_STEPS-1] = RadarGetColorByValue(tkwin, &color);
+    
+    /*
+     * Now init the in between colors to let RealizeColorGradient know
+     * what it has to do.
+     */
+    for (i = BORDER_STEPS/2+1; i > 0; i--) {
+      grad->colors[i] = NULL;
+    }
+    for (i = BORDER_STEPS/2+2; i < BORDER_STEPS-1; i++) {
+      grad->colors[i] = NULL;
+    }
+    Tcl_SetHashValue(hash, grad);
+  }
+  
+  /*
+   * Delay the allocation of colors until they are actually
+   * needed for drawing.
+   */
+  return (RadarColorGradient) grad;
+}
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * RadarGetColorGradient --
+ *
+ *	Create a data structure containing a range of colors
+ *	used to display a gradient. Name contains the gradient
+ *	description in the form:
+ *		color1:color2:steps
+ *
+ * Results:
+ *	The return value is a token for a data structure
+ *	describing a gradient.  This token may be passed
+ *	to the drawing routines.  This function allocate
+ *	the two end colors in an attempt to use only
+ *	actually needed resources. The function
+ *	RadarColorGradientPixel asserts that all the colors
+ *	get allocated when needed.
+ *	If an error prevented the gradient from being created
+ *	then NULL is returned and an error message will be
+ *	left in interp.
+ *
+ * Side effects:
+ *	Data structures, etc. are allocated.
+ *	It is the caller's responsibility to eventually call
+ *	RadarFreeColorGradient to release the resources.
+ *
+ *--------------------------------------------------------------
+ */
+RadarColorGradient
+RadarGetColorGradientByValue(RadarColorGradient	gradient)
+{
+  ColorGradient	*grad;
+
+  grad = (ColorGradient *) gradient;
+  grad->ref_count++;
+  return gradient;
+}
+
+
+RadarColorGradient
+RadarGetColorGradient(Tcl_Interp	*interp,
+		      Tk_Window		tkwin,
+		      Tk_Uid		name)
+{
+  GradientKey	key;
+  Tcl_HashEntry	*hash;
+  ColorGradient	*grad;
+  int		i, new, steps, num_tok;
+  XColor	*first, *last;
+  char		name_first[COLOR_NAME_SIZE], name_last[COLOR_NAME_SIZE];
+  
+  if (!initialized) {
+    ColorInit();
+  }
+  
+  /*
+   * First, check to see if there's already a gradient that will work
+   * for this request.
+   */  
+  key.name = name;
+  key.colormap = Tk_Colormap(tkwin);
+  key.screen = Tk_Screen(tkwin);
+  
+  hash = Tcl_CreateHashEntry(&gradient_table, (char *) &key, &new);
+  if (!new) {
+    grad = (ColorGradient *) Tcl_GetHashValue(hash);
+    grad->ref_count++;
+  }
+  else {
+    /*
+     * No satisfactory gradient exists yet.  Initialize a new one.
+     */
+    num_tok = sscanf(name, "%s:%s:%d", name_first, name_last, &steps);
+    if ((num_tok != 3) || (steps < 2)) {
+      Tcl_AppendResult(interp, "incorrect gradient format \"",
+		       name, "\"", NULL);
+    grad_err:
+      Tcl_DeleteHashEntry(hash);
+      return NULL;
+    }
+    first = RadarGetColor(interp, tkwin, name_first);
+    if (first == NULL) {
+    grad_err2:
+      Tcl_AppendResult(interp, " in gradient", NULL);
+      goto grad_err;
+    }
+    last = RadarGetColor(interp, tkwin, name_last);
+    if (last == NULL) {
+      RadarFreeColor(first);
+      goto grad_err2;
+    }
+    
+    grad = (ColorGradient *) RadarMalloc(sizeof(ColorGradient) +
+					 sizeof(XColor *)*(steps-1));
+    grad->screen = Tk_Screen(tkwin);
+    grad->visual = Tk_Visual(tkwin);
+    grad->depth = Tk_Depth(tkwin);
+    grad->colormap = key.colormap;
+    grad->ref_count = 1;
+    grad->colors[0] = first;
+    grad->colors[steps-1] = last;
+    for (i = 0; i < steps-1; i++) {
+      grad->colors[i] = NULL;
+    }
+    grad->num_colors = steps;
+    grad->realized = False;
+    grad->hash = hash;
+    Tcl_SetHashValue(hash, grad);
+  }
+  
+  /*
+   * Delay the allocation of colors until they are actually
+   * needed for drawing.
+   */
+  return (RadarColorGradient) grad;
+}
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * RadarNameOfColorGradient --
+ *
+ *	Given a gradient, return a textual string identifying
+ *	the gradient. This can be either a single color (for
+ *	gradients allocated by RadarGetReliefGradient) or a
+ *	full gradient spec: color1:color2:steps.
+ *
+ * Results:
+ *	The return value is the string that was used to create
+ *	the gradient.
+ *
+ * Side effects:
+ *	None.
+ *
+ *--------------------------------------------------------------
+ */
+char *
+RadarNameOfColorGradient(RadarColorGradient	gradient)
+{
+  ColorGradient *grad = (ColorGradient *) gradient;
+  
+  return ((GradientKey *) grad->hash->key.words)->name;
+}
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * RadarFreeColorGradient --
+ *
+ *	This procedure is called when a gradient is no longer
+ *	needed.  It frees the resources associated with the
+ *	gradient.  After this call, the caller should never
+ *	again use the gradient.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Resources are freed.
+ *
+ *--------------------------------------------------------------
+ */
+void
+RadarFreeColorGradient(RadarColorGradient	gradient)
+{
+  ColorGradient	*grad = (ColorGradient *) gradient;
+  int		i;
+  
+  grad->ref_count--;
+  if (grad->ref_count == 0) {
+    for (i = 0; i < grad->num_colors; i++) {
+      if (grad->colors[i] != NULL) {
+	RadarFreeColor(grad->colors[i]);
+      }
+    }
+    Tcl_DeleteHashEntry(grad->hash);
+    RadarFree(grad);
+  }
+}