tkColor.c
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:23k
源码类别:

通讯编程

开发平台:

Visual C++

  1. /* 
  2.  * tkColor.c --
  3.  *
  4.  * This file maintains a database of color values for the Tk
  5.  * toolkit, in order to avoid round-trips to the server to
  6.  * map color names to pixel values.
  7.  *
  8.  * Copyright (c) 1990-1994 The Regents of the University of California.
  9.  * Copyright (c) 1994-1997 Sun Microsystems, Inc.
  10.  *
  11.  * See the file "license.terms" for information on usage and redistribution
  12.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13.  *
  14.  * RCS: @(#) $Id: tkColor.c,v 1.9 2002/08/05 04:30:38 dgp Exp $
  15.  */
  16. #include "tkColor.h"
  17. /*
  18.  * Structures of the following following type are used as keys for 
  19.  * colorValueTable (in TkDisplay).
  20.  */
  21. typedef struct {
  22.     int red, green, blue; /* Values for desired color. */
  23.     Colormap colormap; /* Colormap from which color will be
  24.  * allocated. */
  25.     Display *display; /* Display for colormap. */
  26. } ValueKey;
  27. /*
  28.  * The structure below is used to allocate thread-local data. 
  29.  */
  30. typedef struct ThreadSpecificData {
  31.     char rgbString[20];            /* */
  32. } ThreadSpecificData;
  33. static Tcl_ThreadDataKey dataKey;
  34. /*
  35.  * Forward declarations for procedures defined in this file:
  36.  */
  37. static void ColorInit _ANSI_ARGS_((TkDisplay *dispPtr));
  38. static void DupColorObjProc _ANSI_ARGS_((Tcl_Obj *srcObjPtr,
  39.     Tcl_Obj *dupObjPtr));
  40. static void FreeColorObjProc _ANSI_ARGS_((Tcl_Obj *objPtr));
  41. static void InitColorObj _ANSI_ARGS_((Tcl_Obj *objPtr));
  42. /*
  43.  * The following structure defines the implementation of the "color" Tcl
  44.  * object, which maps a string color name to a TkColor object.  The
  45.  * ptr1 field of the Tcl_Obj points to a TkColor object.
  46.  */
  47. Tcl_ObjType tkColorObjType = {
  48.     "color", /* name */
  49.     FreeColorObjProc, /* freeIntRepProc */
  50.     DupColorObjProc, /* dupIntRepProc */
  51.     NULL, /* updateStringProc */
  52.     NULL /* setFromAnyProc */
  53. };
  54. /*
  55.  *----------------------------------------------------------------------
  56.  *
  57.  * Tk_AllocColorFromObj --
  58.  *
  59.  * Given a Tcl_Obj *, map the value to a corresponding
  60.  * XColor structure based on the tkwin given.
  61.  *
  62.  * Results:
  63.  * The return value is a pointer to an XColor structure that
  64.  * indicates the red, blue, and green intensities for the color
  65.  * given by the string in objPtr, and also specifies a pixel value 
  66.  * to use to draw in that color.  If an error occurs, NULL is 
  67.  * returned and an error message will be left in interp's result
  68.  * (unless interp is NULL).
  69.  *
  70.  * Side effects:
  71.  * The color is added to an internal database with a reference count.
  72.  * For each call to this procedure, there should eventually be a call
  73.  * to Tk_FreeColorFromObj so that the database is cleaned up when colors
  74.  * aren't in use anymore.
  75.  *
  76.  *----------------------------------------------------------------------
  77.  */
  78. XColor *
  79. Tk_AllocColorFromObj(interp, tkwin, objPtr)
  80.     Tcl_Interp *interp; /* Used only for error reporting.  If NULL,
  81.  * then no messages are provided. */
  82.     Tk_Window tkwin; /* Window in which the color will be used.*/
  83.     Tcl_Obj *objPtr; /* Object that describes the color; string
  84.  * value is a color name such as "red" or
  85.  * "#ff0000".*/
  86. {
  87.     TkColor *tkColPtr;
  88.     if (objPtr->typePtr != &tkColorObjType) {
  89. InitColorObj(objPtr);
  90.     }
  91.     tkColPtr = (TkColor *) objPtr->internalRep.twoPtrValue.ptr1;
  92.     /*
  93.      * If the object currently points to a TkColor, see if it's the
  94.      * one we want.  If so, increment its reference count and return.
  95.      */
  96.     if (tkColPtr != NULL) {
  97. if (tkColPtr->resourceRefCount == 0) {
  98.     /*
  99.      * This is a stale reference: it refers to a TkColor that's
  100.      * no longer in use.  Clear the reference.
  101.      */
  102.     FreeColorObjProc(objPtr);
  103.     tkColPtr = NULL;
  104. } else if ((Tk_Screen(tkwin) == tkColPtr->screen)
  105. && (Tk_Colormap(tkwin) == tkColPtr->colormap)) {
  106.     tkColPtr->resourceRefCount++;
  107.     return (XColor *) tkColPtr;
  108. }
  109.     }
  110.     /*
  111.      * The object didn't point to the TkColor that we wanted.  Search
  112.      * the list of TkColors with the same name to see if one of the
  113.      * other TkColors is the right one.
  114.      */
  115.     if (tkColPtr != NULL) {
  116. TkColor *firstColorPtr = 
  117. (TkColor *) Tcl_GetHashValue(tkColPtr->hashPtr);
  118. FreeColorObjProc(objPtr);
  119. for (tkColPtr = firstColorPtr; tkColPtr != NULL;
  120. tkColPtr = tkColPtr->nextPtr) {
  121.     if ((Tk_Screen(tkwin) == tkColPtr->screen)
  122.     && (Tk_Colormap(tkwin) == tkColPtr->colormap)) {
  123. tkColPtr->resourceRefCount++;
  124. tkColPtr->objRefCount++;
  125. objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkColPtr;
  126. return (XColor *) tkColPtr;
  127.     }
  128. }
  129.     }
  130.     /*
  131.      * Still no luck.  Call Tk_GetColor to allocate a new TkColor object.
  132.      */
  133.     tkColPtr = (TkColor *) Tk_GetColor(interp, tkwin, Tcl_GetString(objPtr));
  134.     objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkColPtr;
  135.     if (tkColPtr != NULL) {
  136. tkColPtr->objRefCount++;
  137.     }
  138.     return (XColor *) tkColPtr;
  139. }
  140. /*
  141.  *----------------------------------------------------------------------
  142.  *
  143.  * Tk_GetColor --
  144.  *
  145.  * Given a string name for a color, map the name to a corresponding
  146.  * XColor structure.
  147.  *
  148.  * Results:
  149.  * The return value is a pointer to an XColor structure that
  150.  * indicates the red, blue, and green intensities for the color
  151.  * given by "name", and also specifies a pixel value to use to
  152.  * draw in that color.  If an error occurs, NULL is returned and
  153.  * an error message will be left in the interp's result.
  154.  *
  155.  * Side effects:
  156.  * The color is added to an internal database with a reference count.
  157.  * For each call to this procedure, there should eventually be a call
  158.  * to Tk_FreeColor so that the database is cleaned up when colors
  159.  * aren't in use anymore.
  160.  *
  161.  *----------------------------------------------------------------------
  162.  */
  163. XColor *
  164. Tk_GetColor(interp, tkwin, name)
  165.     Tcl_Interp *interp; /* Place to leave error message if
  166.  * color can't be found. */
  167.     Tk_Window tkwin; /* Window in which color will be used. */
  168.     Tk_Uid name; /* Name of color to be allocated (in form
  169.  * suitable for passing to XParseColor). */
  170. {
  171.     Tcl_HashEntry *nameHashPtr;
  172.     int new;
  173.     TkColor *tkColPtr;
  174.     TkColor *existingColPtr;
  175.     TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
  176.     if (!dispPtr->colorInit) {
  177. ColorInit(dispPtr);
  178.     }
  179.     /*
  180.      * First, check to see if there's already a mapping for this color
  181.      * name.
  182.      */
  183.     nameHashPtr = Tcl_CreateHashEntry(&dispPtr->colorNameTable, name, &new);
  184.     if (!new) {
  185. existingColPtr = (TkColor *) Tcl_GetHashValue(nameHashPtr);
  186. for (tkColPtr = existingColPtr;  tkColPtr != NULL;
  187. tkColPtr = tkColPtr->nextPtr) {
  188.     if ((tkColPtr->screen == Tk_Screen(tkwin))
  189.     && (Tk_Colormap(tkwin) == tkColPtr->colormap)) {
  190. tkColPtr->resourceRefCount++;
  191. return &tkColPtr->color;
  192.     }
  193. }
  194.     } else {
  195. existingColPtr = NULL;
  196.     }
  197.     /*
  198.      * The name isn't currently known.  Map from the name to a pixel
  199.      * value.
  200.      */
  201.     tkColPtr = TkpGetColor(tkwin, name);
  202.     if (tkColPtr == NULL) {
  203. if (interp != NULL) {
  204.     if (*name == '#') {
  205. Tcl_AppendResult(interp, "invalid color name "", name,
  206. """, (char *) NULL);
  207.     } else {
  208. Tcl_AppendResult(interp, "unknown color name "", name,
  209. """, (char *) NULL);
  210.     }
  211. }
  212. if (new) {
  213.     Tcl_DeleteHashEntry(nameHashPtr);
  214. }
  215. return (XColor *) NULL;
  216.     }
  217.     /*
  218.      * Now create a new TkColor structure and add it to colorNameTable
  219.      * (in TkDisplay).
  220.      */
  221.     tkColPtr->magic = COLOR_MAGIC;
  222.     tkColPtr->gc = None;
  223.     tkColPtr->screen = Tk_Screen(tkwin);
  224.     tkColPtr->colormap = Tk_Colormap(tkwin);
  225.     tkColPtr->visual  = Tk_Visual(tkwin);
  226.     tkColPtr->resourceRefCount = 1;
  227.     tkColPtr->objRefCount = 0;
  228.     tkColPtr->type = TK_COLOR_BY_NAME;
  229.     tkColPtr->hashPtr = nameHashPtr;
  230.     tkColPtr->nextPtr = existingColPtr;
  231.     Tcl_SetHashValue(nameHashPtr, tkColPtr);
  232.     return &tkColPtr->color;
  233. }
  234. /*
  235.  *----------------------------------------------------------------------
  236.  *
  237.  * Tk_GetColorByValue --
  238.  *
  239.  * Given a desired set of red-green-blue intensities for a color,
  240.  * locate a pixel value to use to draw that color in a given
  241.  * window.
  242.  *
  243.  * Results:
  244.  * The return value is a pointer to an XColor structure that
  245.  * indicates the closest red, blue, and green intensities available
  246.  * to those specified in colorPtr, and also specifies a pixel
  247.  * value to use to draw in that color.
  248.  *
  249.  * Side effects:
  250.  * The color is added to an internal database with a reference count.
  251.  * For each call to this procedure, there should eventually be a call
  252.  * to Tk_FreeColor, so that the database is cleaned up when colors
  253.  * aren't in use anymore.
  254.  *
  255.  *----------------------------------------------------------------------
  256.  */
  257. XColor *
  258. Tk_GetColorByValue(tkwin, colorPtr)
  259.     Tk_Window tkwin; /* Window where color will be used. */
  260.     XColor *colorPtr; /* Red, green, and blue fields indicate
  261.  * desired color. */
  262. {
  263.     ValueKey valueKey;
  264.     Tcl_HashEntry *valueHashPtr;
  265.     int new;
  266.     TkColor *tkColPtr;
  267.     Display *display = Tk_Display(tkwin);
  268.     TkDisplay *dispPtr = TkGetDisplay(display);
  269.     if (!dispPtr->colorInit) {
  270. ColorInit(dispPtr);
  271.     }
  272.     /*
  273.      * First, check to see if there's already a mapping for this color
  274.      * name.
  275.      */
  276.     valueKey.red = colorPtr->red;
  277.     valueKey.green = colorPtr->green;
  278.     valueKey.blue = colorPtr->blue;
  279.     valueKey.colormap = Tk_Colormap(tkwin);
  280.     valueKey.display = display;
  281.     valueHashPtr = Tcl_CreateHashEntry(&dispPtr->colorValueTable, 
  282.             (char *) &valueKey, &new);
  283.     if (!new) {
  284. tkColPtr = (TkColor *) Tcl_GetHashValue(valueHashPtr);
  285. tkColPtr->resourceRefCount++;
  286. return &tkColPtr->color;
  287.     }
  288.     /*
  289.      * The name isn't currently known.  Find a pixel value for this
  290.      * color and add a new structure to colorValueTable (in TkDisplay).
  291.      */
  292.     tkColPtr = TkpGetColorByValue(tkwin, colorPtr);
  293.     tkColPtr->magic = COLOR_MAGIC;
  294.     tkColPtr->gc = None;
  295.     tkColPtr->screen = Tk_Screen(tkwin);
  296.     tkColPtr->colormap = valueKey.colormap;
  297.     tkColPtr->visual  = Tk_Visual(tkwin);
  298.     tkColPtr->resourceRefCount = 1;
  299.     tkColPtr->objRefCount = 0;
  300.     tkColPtr->type = TK_COLOR_BY_VALUE;
  301.     tkColPtr->hashPtr = valueHashPtr;
  302.     tkColPtr->nextPtr = NULL;
  303.     Tcl_SetHashValue(valueHashPtr, tkColPtr);
  304.     return &tkColPtr->color;
  305. }
  306. /*
  307.  *--------------------------------------------------------------
  308.  *
  309.  * Tk_NameOfColor --
  310.  *
  311.  * Given a color, return a textual string identifying
  312.  * the color.
  313.  *
  314.  * Results:
  315.  * If colorPtr was created by Tk_GetColor, then the return
  316.  * value is the "string" that was used to create it.
  317.  * Otherwise the return value is a string that could have
  318.  * been passed to Tk_GetColor to allocate that color.  The
  319.  * storage for the returned string is only guaranteed to
  320.  * persist up until the next call to this procedure.
  321.  *
  322.  * Side effects:
  323.  * None.
  324.  *
  325.  *--------------------------------------------------------------
  326.  */
  327. CONST char *
  328. Tk_NameOfColor(colorPtr)
  329.     XColor *colorPtr; /* Color whose name is desired. */
  330. {
  331.     register TkColor *tkColPtr = (TkColor *) colorPtr;
  332.     
  333.     if ((tkColPtr->magic == COLOR_MAGIC) &&
  334.     (tkColPtr->type == TK_COLOR_BY_NAME)) {
  335. return tkColPtr->hashPtr->key.string;
  336.     } else {
  337. ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
  338.             Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
  339. sprintf(tsdPtr->rgbString, "#%04x%04x%04x", colorPtr->red, 
  340. colorPtr->green, colorPtr->blue);
  341. return tsdPtr->rgbString;
  342.     }
  343. }
  344. /*
  345.  *----------------------------------------------------------------------
  346.  *
  347.  * Tk_GCForColor --
  348.  *
  349.  * Given a color allocated from this module, this procedure
  350.  * returns a GC that can be used for simple drawing with that
  351.  * color.
  352.  *
  353.  * Results:
  354.  * The return value is a GC with color set as its foreground
  355.  * color and all other fields defaulted.  This GC is only valid
  356.  * as long as the color exists;  it is freed automatically when
  357.  * the last reference to the color is freed.
  358.  *
  359.  * Side effects:
  360.  * None.
  361.  *
  362.  *----------------------------------------------------------------------
  363.  */
  364. GC
  365. Tk_GCForColor(colorPtr, drawable)
  366.     XColor *colorPtr; /* Color for which a GC is desired. Must
  367.  * have been allocated by Tk_GetColor. */
  368.     Drawable drawable; /* Drawable in which the color will be
  369.  * used (must have same screen and depth
  370.  * as the one for which the color was
  371.  * allocated). */
  372. {
  373.     TkColor *tkColPtr = (TkColor *) colorPtr;
  374.     XGCValues gcValues;
  375.     /*
  376.      * Do a quick sanity check to make sure this color was really
  377.      * allocated by Tk_GetColor.
  378.      */
  379.     if (tkColPtr->magic != COLOR_MAGIC) {
  380. panic("Tk_GCForColor called with bogus color");
  381.     }
  382.     if (tkColPtr->gc == None) {
  383. gcValues.foreground = tkColPtr->color.pixel;
  384. tkColPtr->gc = XCreateGC(DisplayOfScreen(tkColPtr->screen),
  385. drawable, GCForeground, &gcValues);
  386.     }
  387.     return tkColPtr->gc;
  388. }
  389. /*
  390.  *----------------------------------------------------------------------
  391.  *
  392.  * Tk_FreeColor --
  393.  *
  394.  * This procedure is called to release a color allocated by
  395.  * Tk_GetColor.
  396.  *
  397.  * Results:
  398.  * None.
  399.  *
  400.  * Side effects:
  401.  * The reference count associated with colorPtr is deleted, and
  402.  * the color is released to X if there are no remaining uses
  403.  * for it.
  404.  *
  405.  *----------------------------------------------------------------------
  406.  */
  407. void
  408. Tk_FreeColor(colorPtr)
  409.     XColor *colorPtr; /* Color to be released.  Must have been
  410.  * allocated by Tk_GetColor or
  411.  * Tk_GetColorByValue. */
  412. {
  413.     TkColor *tkColPtr = (TkColor *) colorPtr;
  414.     Screen *screen = tkColPtr->screen;
  415.     TkColor *prevPtr;
  416.     /*
  417.      * Do a quick sanity check to make sure this color was really
  418.      * allocated by Tk_GetColor.
  419.      */
  420.     if (tkColPtr->magic != COLOR_MAGIC) {
  421. panic("Tk_FreeColor called with bogus color");
  422.     }
  423.     tkColPtr->resourceRefCount--;
  424.     if (tkColPtr->resourceRefCount > 0) {
  425. return;
  426.     }
  427.     /*
  428.      * This color is no longer being actively used, so free the color
  429.      * resources associated with it and remove it from the hash table.
  430.      * no longer any objects referencing it.
  431.      */
  432.     if (tkColPtr->gc != None) {
  433. XFreeGC(DisplayOfScreen(screen), tkColPtr->gc);
  434. tkColPtr->gc = None;
  435.     }
  436.     TkpFreeColor(tkColPtr);
  437.     prevPtr = (TkColor *) Tcl_GetHashValue(tkColPtr->hashPtr);
  438.     if (prevPtr == tkColPtr) {
  439. if (tkColPtr->nextPtr == NULL) {
  440.     Tcl_DeleteHashEntry(tkColPtr->hashPtr);
  441. } else  {
  442.     Tcl_SetHashValue(tkColPtr->hashPtr, tkColPtr->nextPtr);
  443. }
  444.     } else {
  445. while (prevPtr->nextPtr != tkColPtr) {
  446.     prevPtr = prevPtr->nextPtr;
  447. }
  448. prevPtr->nextPtr = tkColPtr->nextPtr;
  449.     }
  450.     /*
  451.      * Free the TkColor structure if there are no objects referencing
  452.      * it.  However, if there are objects referencing it then keep the
  453.      * structure around; it will get freed when the last reference is
  454.      * cleared
  455.      */
  456.     if (tkColPtr->objRefCount == 0) {
  457. ckfree((char *) tkColPtr);
  458.     }
  459. }
  460. /*
  461.  *----------------------------------------------------------------------
  462.  *
  463.  * Tk_FreeColorFromObj --
  464.  *
  465.  * This procedure is called to release a color allocated by
  466.  * Tk_AllocColorFromObj. It does not throw away the Tcl_Obj *;
  467.  * it only gets rid of the hash table entry for this color
  468.  * and clears the cached value that is normally stored in the object.
  469.  *
  470.  * Results:
  471.  * None.
  472.  *
  473.  * Side effects:
  474.  * The reference count associated with the color represented by
  475.  * objPtr is decremented, and the color is released to X if there are 
  476.  * no remaining uses for it.
  477.  *
  478.  *----------------------------------------------------------------------
  479.  */
  480. void
  481. Tk_FreeColorFromObj(tkwin, objPtr)
  482.     Tk_Window tkwin; /* The window this color lives in. Needed
  483.  * for the screen and colormap values. */
  484.     Tcl_Obj *objPtr; /* The Tcl_Obj * to be freed. */
  485. {
  486.     Tk_FreeColor(Tk_GetColorFromObj(tkwin, objPtr));
  487.     FreeColorObjProc(objPtr);
  488. }
  489. /*
  490.  *---------------------------------------------------------------------------
  491.  *
  492.  * FreeColorObjProc -- 
  493.  *
  494.  * This proc is called to release an object reference to a color.
  495.  * Called when the object's internal rep is released or when
  496.  * the cached tkColPtr needs to be changed.
  497.  *
  498.  * Results:
  499.  * None.
  500.  *
  501.  * Side effects:
  502.  * The object reference count is decremented. When both it
  503.  * and the hash ref count go to zero, the color's resources
  504.  * are released.
  505.  *
  506.  *---------------------------------------------------------------------------
  507.  */
  508. static void
  509. FreeColorObjProc(objPtr)
  510.     Tcl_Obj *objPtr; /* The object we are releasing. */
  511. {
  512.     TkColor *tkColPtr = (TkColor *) objPtr->internalRep.twoPtrValue.ptr1;
  513.     if (tkColPtr != NULL) {
  514. tkColPtr->objRefCount--;
  515. if ((tkColPtr->objRefCount == 0) 
  516. && (tkColPtr->resourceRefCount == 0)) {
  517.     ckfree((char *) tkColPtr);
  518. }
  519. objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
  520.     }
  521. }
  522. /*
  523.  *---------------------------------------------------------------------------
  524.  *
  525.  * DupColorObjProc -- 
  526.  *
  527.  * When a cached color object is duplicated, this is called to
  528.  * update the internal reps.
  529.  *
  530.  * Results:
  531.  * None.
  532.  *
  533.  * Side effects:
  534.  * The color's objRefCount is incremented and the internal rep
  535.  * of the copy is set to point to it.
  536.  *
  537.  *---------------------------------------------------------------------------
  538.  */
  539. static void
  540. DupColorObjProc(srcObjPtr, dupObjPtr)
  541.     Tcl_Obj *srcObjPtr; /* The object we are copying from. */
  542.     Tcl_Obj *dupObjPtr; /* The object we are copying to. */
  543. {
  544.     TkColor *tkColPtr = (TkColor *) srcObjPtr->internalRep.twoPtrValue.ptr1;
  545.     
  546.     dupObjPtr->typePtr = srcObjPtr->typePtr;
  547.     dupObjPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkColPtr;
  548.     if (tkColPtr != NULL) {
  549. tkColPtr->objRefCount++;
  550.     }
  551. }
  552. /*
  553.  *----------------------------------------------------------------------
  554.  *
  555.  * Tk_GetColorFromObj --
  556.  *
  557.  * Returns the color referred to by a Tcl object.  The color must
  558.  * already have been allocated via a call to Tk_AllocColorFromObj
  559.  * or Tk_GetColor.
  560.  *
  561.  * Results:
  562.  * Returns the XColor * that matches the tkwin and the string rep
  563.  * of objPtr.
  564.  *
  565.  * Side effects:
  566.  * If the object is not already a color, the conversion will free
  567.  * any old internal representation. 
  568.  *
  569.  *----------------------------------------------------------------------
  570.  */
  571. XColor *
  572. Tk_GetColorFromObj(tkwin, objPtr)
  573.     Tk_Window tkwin; /* The window in which the color will be
  574.  * used. */
  575.     Tcl_Obj *objPtr; /* String value contains the name of the
  576.  * desired color. */
  577. {
  578.     TkColor *tkColPtr;
  579.     Tcl_HashEntry *hashPtr;
  580.     TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
  581.     if (objPtr->typePtr != &tkColorObjType) {
  582. InitColorObj(objPtr);
  583.     }
  584.   
  585.     /*
  586.      * First check to see if the internal representation of the object
  587.      * is defined and is a color that is valid for the current screen
  588.      * and color map.  If it is, we are done.
  589.      */
  590.     tkColPtr = (TkColor *) objPtr->internalRep.twoPtrValue.ptr1;
  591.     if ((tkColPtr != NULL)
  592.     && (tkColPtr->resourceRefCount > 0)
  593.     && (Tk_Screen(tkwin) == tkColPtr->screen)
  594.     && (Tk_Colormap(tkwin) == tkColPtr->colormap)) {
  595. /*
  596.  * The object already points to the right TkColor structure.
  597.  * Just return it.
  598.  */
  599. return (XColor *) tkColPtr;
  600.     }
  601.     /*
  602.      * If we reach this point, it means that the TkColor structure
  603.      * that we have cached in the internal representation is not valid
  604.      * for the current screen and colormap.  But there is a list of
  605.      * other TkColor structures attached to the TkDisplay.  Walk this
  606.      * list looking for the right TkColor structure.
  607.      */
  608.     hashPtr = Tcl_FindHashEntry(&dispPtr->colorNameTable, 
  609.     Tcl_GetString(objPtr));
  610.     if (hashPtr == NULL) {
  611. goto error;
  612.     }
  613.     for (tkColPtr = (TkColor *) Tcl_GetHashValue(hashPtr);
  614.     (tkColPtr != NULL); tkColPtr = tkColPtr->nextPtr) {
  615. if ((Tk_Screen(tkwin) == tkColPtr->screen)
  616. && (Tk_Colormap(tkwin) == tkColPtr->colormap)) {
  617.     FreeColorObjProc(objPtr);
  618.     objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkColPtr;
  619.     tkColPtr->objRefCount++;
  620.     return (XColor *) tkColPtr;
  621. }
  622.     }
  623.     error:
  624.     panic(" Tk_GetColorFromObj called with non-existent color!");
  625.     /*
  626.      * The following code isn't reached; it's just there to please compilers.
  627.      */
  628.     return NULL;
  629. }
  630. /*
  631.  *----------------------------------------------------------------------
  632.  *
  633.  * InitColorObj --
  634.  *
  635.  * Bookeeping procedure to change an objPtr to a color type.
  636.  *
  637.  * Results:
  638.  * None.
  639.  *
  640.  * Side effects:
  641.  * The old internal rep of the object is freed. The object's
  642.  * type is set to color with a NULL TkColor pointer (the pointer
  643.  * will be set later by either Tk_AllocColorFromObj or
  644.  * Tk_GetColorFromObj).
  645.  *
  646.  *----------------------------------------------------------------------
  647.  */
  648. static void
  649. InitColorObj(objPtr)
  650.     Tcl_Obj *objPtr; /* The object to convert. */
  651. {
  652.     Tcl_ObjType *typePtr;
  653.     /*
  654.      * Free the old internalRep before setting the new one. 
  655.      */
  656.     Tcl_GetString(objPtr);
  657.     typePtr = objPtr->typePtr;
  658.     if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
  659. (*typePtr->freeIntRepProc)(objPtr);
  660.     }
  661.     objPtr->typePtr = &tkColorObjType;
  662.     objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
  663. }
  664. /*
  665.  *----------------------------------------------------------------------
  666.  *
  667.  * ColorInit --
  668.  *
  669.  * Initialize the structure used for color management.
  670.  *
  671.  * Results:
  672.  * None.
  673.  *
  674.  * Side effects:
  675.  * Read the code.
  676.  *
  677.  *----------------------------------------------------------------------
  678.  */
  679. static void
  680. ColorInit(dispPtr)
  681.     TkDisplay *dispPtr;
  682. {
  683.     if (!dispPtr->colorInit) {
  684.         dispPtr->colorInit = 1;
  685. Tcl_InitHashTable(&dispPtr->colorNameTable, TCL_STRING_KEYS);
  686. Tcl_InitHashTable(&dispPtr->colorValueTable, 
  687.                 sizeof(ValueKey)/sizeof(int));
  688.     }
  689. }
  690. /*
  691.  *----------------------------------------------------------------------
  692.  *
  693.  * TkDebugColor --
  694.  *
  695.  * This procedure returns debugging information about a color.
  696.  *
  697.  * Results:
  698.  * The return value is a list with one sublist for each TkColor
  699.  * corresponding to "name".  Each sublist has two elements that
  700.  * contain the resourceRefCount and objRefCount fields from the
  701.  * TkColor structure.
  702.  *
  703.  * Side effects:
  704.  * None.
  705.  *
  706.  *----------------------------------------------------------------------
  707.  */
  708. Tcl_Obj *
  709. TkDebugColor(tkwin, name)
  710.     Tk_Window tkwin; /* The window in which the color will be
  711.  * used (not currently used). */
  712.     char *name; /* Name of the desired color. */
  713. {
  714.     TkColor *tkColPtr;
  715.     Tcl_HashEntry *hashPtr;
  716.     Tcl_Obj *resultPtr, *objPtr;
  717.     TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
  718.     resultPtr = Tcl_NewObj();
  719.     hashPtr = Tcl_FindHashEntry(&dispPtr->colorNameTable, name);
  720.     if (hashPtr != NULL) {
  721. tkColPtr = (TkColor *) Tcl_GetHashValue(hashPtr);
  722. if (tkColPtr == NULL) {
  723.     panic("TkDebugColor found empty hash table entry");
  724. }
  725. for ( ; (tkColPtr != NULL); tkColPtr = tkColPtr->nextPtr) {
  726.     objPtr = Tcl_NewObj();
  727.     Tcl_ListObjAppendElement(NULL, objPtr,
  728.     Tcl_NewIntObj(tkColPtr->resourceRefCount));
  729.     Tcl_ListObjAppendElement(NULL, objPtr,
  730.     Tcl_NewIntObj(tkColPtr->objRefCount)); 
  731.     Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
  732. }
  733.     }
  734.     return resultPtr;
  735. }