/[dtapublic]/projs/trunk/shared_source/tk_base/tkcolor.c
ViewVC logotype

Contents of /projs/trunk/shared_source/tk_base/tkcolor.c

Parent Directory Parent Directory | Revision Log Revision Log


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

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25