]> git.zerfleddert.de Git - micropolis/blob - src/tk/tkcursor.c
src/tclx/ucbsrc/tclbasic.sed: Micropolis build fixes for recent macOS
[micropolis] / src / tk / tkcursor.c
1 /*
2 * tkCursor.c --
3 *
4 * This file maintains a database of read-only cursors for the Tk
5 * toolkit. This allows cursors to be shared between widgets and
6 * also avoids round-trips to the X server.
7 *
8 * Copyright 1990 Regents of the University of California
9 * Permission to use, copy, modify, and distribute this
10 * software and its documentation for any purpose and without
11 * fee is hereby granted, provided that the above copyright
12 * notice appear in all copies. The University of California
13 * makes no representations about the suitability of this
14 * software for any purpose. It is provided "as is" without
15 * express or implied warranty.
16 */
17
18 #ifndef lint
19 static char rcsid[] = "$Header: /user6/ouster/wish/RCS/tkCursor.c,v 1.12 91/10/31 11:40:41 ouster Exp $ SPRITE (Berkeley)";
20 #endif /* not lint */
21
22 #include "tkconfig.h"
23 #include "tkint.h"
24
25 /*
26 * One of the following data structures exists for each cursor that is
27 * currently active. Each structure is indexed with two hash tables
28 * defined below. One of the tables is idTable, and the other is either
29 * nameTable or dataTable, also defined below.
30 * .
31 */
32
33 typedef struct {
34 Cursor cursor; /* X identifier for cursor. */
35 Display *display; /* Display for which cursor is valid. */
36 int refCount; /* Number of active uses of cursor. */
37 Tcl_HashTable *otherTable; /* Second table (other than idTable) used
38 * to index this entry. */
39 Tcl_HashEntry *hashPtr; /* Entry in otherTable for this structure
40 * (needed when deleting). */
41 } TkCursor;
42
43 /*
44 * Hash table to map from a textual description of a cursor to the
45 * TkCursor record for the cursor, and key structure used in that
46 * hash table:
47 */
48
49 static Tcl_HashTable nameTable;
50 typedef struct {
51 Tk_Uid name; /* Textual name for desired cursor. */
52 Display *display; /* Display for which cursor will be used. */
53 } NameKey;
54
55 /*
56 * Hash table to map from a collection of in-core data about a
57 * cursor (bitmap contents, etc.) to a TkCursor structure:
58 */
59
60 static Tcl_HashTable dataTable;
61 typedef struct {
62 char *source; /* Cursor bits. */
63 char *mask; /* Mask bits. */
64 unsigned int width, height; /* Dimensions of cursor (and data
65 * and mask). */
66 int xHot, yHot; /* Location of cursor hot-spot. */
67 Tk_Uid fg, bg; /* Colors for cursor. */
68 Display *display; /* Display on which cursor will be used. */
69 } DataKey;
70
71 /*
72 * Hash table that maps from Cursor identifiers to the TkCursor structure
73 * for the cursor. This table is indexed by Cursor ids, and is used by
74 * Tk_FreeCursor.
75 */
76
77 static Tcl_HashTable idTable;
78
79 static int initialized = 0; /* 0 means static structures haven't been
80 * initialized yet. */
81
82 /*
83 * The table below is used to map from the name of a cursor to its
84 * index in the official cursor font:
85 */
86
87 static struct CursorName {
88 char *name;
89 unsigned int shape;
90 } cursorNames[] = {
91 {"X_cursor", XC_X_cursor},
92 {"arrow", XC_arrow},
93 {"based_arrow_down", XC_based_arrow_down},
94 {"based_arrow_up", XC_based_arrow_up},
95 {"boat", XC_boat},
96 {"bogosity", XC_bogosity},
97 {"bottom_left_corner", XC_bottom_left_corner},
98 {"bottom_right_corner", XC_bottom_right_corner},
99 {"bottom_side", XC_bottom_side},
100 {"bottom_tee", XC_bottom_tee},
101 {"box_spiral", XC_box_spiral},
102 {"center_ptr", XC_center_ptr},
103 {"circle", XC_circle},
104 {"clock", XC_clock},
105 {"coffee_mug", XC_coffee_mug},
106 {"cross", XC_cross},
107 {"cross_reverse", XC_cross_reverse},
108 {"crosshair", XC_crosshair},
109 {"diamond_cross", XC_diamond_cross},
110 {"dot", XC_dot},
111 {"dotbox", XC_dotbox},
112 {"double_arrow", XC_double_arrow},
113 {"draft_large", XC_draft_large},
114 {"draft_small", XC_draft_small},
115 {"draped_box", XC_draped_box},
116 {"exchange", XC_exchange},
117 {"fleur", XC_fleur},
118 {"gobbler", XC_gobbler},
119 {"gumby", XC_gumby},
120 {"hand1", XC_hand1},
121 {"hand2", XC_hand2},
122 {"heart", XC_heart},
123 {"icon", XC_icon},
124 {"iron_cross", XC_iron_cross},
125 {"left_ptr", XC_left_ptr},
126 {"left_side", XC_left_side},
127 {"left_tee", XC_left_tee},
128 {"leftbutton", XC_leftbutton},
129 {"ll_angle", XC_ll_angle},
130 {"lr_angle", XC_lr_angle},
131 {"man", XC_man},
132 {"middlebutton", XC_middlebutton},
133 {"mouse", XC_mouse},
134 {"pencil", XC_pencil},
135 {"pirate", XC_pirate},
136 {"plus", XC_plus},
137 {"question_arrow", XC_question_arrow},
138 {"right_ptr", XC_right_ptr},
139 {"right_side", XC_right_side},
140 {"right_tee", XC_right_tee},
141 {"rightbutton", XC_rightbutton},
142 {"rtl_logo", XC_rtl_logo},
143 {"sailboat", XC_sailboat},
144 {"sb_down_arrow", XC_sb_down_arrow},
145 {"sb_h_double_arrow", XC_sb_h_double_arrow},
146 {"sb_left_arrow", XC_sb_left_arrow},
147 {"sb_right_arrow", XC_sb_right_arrow},
148 {"sb_up_arrow", XC_sb_up_arrow},
149 {"sb_v_double_arrow", XC_sb_v_double_arrow},
150 {"shuttle", XC_shuttle},
151 {"sizing", XC_sizing},
152 {"spider", XC_spider},
153 {"spraycan", XC_spraycan},
154 {"star", XC_star},
155 {"target", XC_target},
156 {"tcross", XC_tcross},
157 {"top_left_arrow", XC_top_left_arrow},
158 {"top_left_corner", XC_top_left_corner},
159 {"top_right_corner", XC_top_right_corner},
160 {"top_side", XC_top_side},
161 {"top_tee", XC_top_tee},
162 {"trek", XC_trek},
163 {"ul_angle", XC_ul_angle},
164 {"umbrella", XC_umbrella},
165 {"ur_angle", XC_ur_angle},
166 {"watch", XC_watch},
167 {"xterm", XC_xterm},
168 {NULL, 0}
169 };
170
171 /*
172 * Font to use for cursors:
173 */
174
175 #ifndef CURSORFONT
176 #define CURSORFONT "cursor"
177 #endif
178
179 /*
180 * Forward declarations for procedures defined in this file:
181 */
182
183 static void CursorInit _ANSI_ARGS_((void));
184 \f
185 /*
186 *----------------------------------------------------------------------
187 *
188 * Tk_GetCursor --
189 *
190 * Given a string describing a cursor, locate (or create if necessary)
191 * a cursor that fits the description.
192 *
193 * Results:
194 * The return value is the X identifer for the desired cursor,
195 * unless string couldn't be parsed correctly. In this case,
196 * None is returned and an error message is left in interp->result.
197 * The caller should never modify the cursor that is returned, and
198 * should eventually call Tk_FreeCursor when the cursor is no longer
199 * needed.
200 *
201 * Side effects:
202 * The cursor is added to an internal database with a reference count.
203 * For each call to this procedure, there should eventually be a call
204 * to Tk_FreeCursor, so that the database can be cleaned up when cursors
205 * aren't needed anymore.
206 *
207 *----------------------------------------------------------------------
208 */
209
210 Cursor
211 Tk_GetCursor(interp, tkwin, string)
212 Tcl_Interp *interp; /* Interpreter to use for error reporting. */
213 Tk_Window tkwin; /* Window in which cursor will be used. */
214 Tk_Uid string; /* Description of cursor. See manual entry
215 * for details on legal syntax. */
216 {
217 NameKey key;
218 Tcl_HashEntry *nameHashPtr, *idHashPtr;
219 register TkCursor *cursorPtr;
220 int new;
221 Cursor cursor;
222 int argc;
223 char **argv = NULL;
224 Pixmap source = None;
225 Pixmap mask = None;
226
227 if (!initialized) {
228 CursorInit();
229 }
230
231 key.name = string;
232 key.display = Tk_Display(tkwin);
233 nameHashPtr = Tcl_CreateHashEntry(&nameTable, (char *) &key, &new);
234 if (!new) {
235 cursorPtr = (TkCursor *) Tcl_GetHashValue(nameHashPtr);
236 cursorPtr->refCount++;
237 return cursorPtr->cursor;
238 }
239
240 /*
241 * No suitable cursor exists. Parse the cursor name into fields
242 * and create a cursor, either from the standard cursor font or
243 * from bitmap files.
244 */
245
246 if (Tcl_SplitList(interp, string, &argc, &argv) != TCL_OK) {
247 goto error;
248 }
249 if (argc == 0) {
250 badString:
251 Tcl_AppendResult(interp, "bad cursor spec \"", string, "\"",
252 (char *) NULL);
253 goto error;
254 }
255 if (argv[0][0] != '@') {
256 XColor fg, bg;
257 int maskIndex;
258 register struct CursorName *namePtr;
259 TkDisplay *dispPtr;
260
261 /*
262 * The cursor is to come from the standard cursor font. If one
263 * arg, it is cursor name (use black and white for fg and bg).
264 * If two args, they are name and fg color (ignore mask). If
265 * three args, they are name, fg, bg. Some of the code below
266 * is stolen from the XCreateFontCursor Xlib procedure.
267 */
268
269 if (argc > 3) {
270 goto badString;
271 }
272 for (namePtr = cursorNames; ; namePtr++) {
273 if (namePtr->name == NULL) {
274 goto badString;
275 }
276 if ((namePtr->name[0] == argv[0][0])
277 && (strcmp(namePtr->name, argv[0]) == 0)) {
278 break;
279 }
280 }
281 maskIndex = namePtr->shape + 1;
282 if (argc == 1) {
283 fg.red = fg.green = fg.blue = 0;
284 bg.red = bg.green = bg.blue = 65535;
285 } else {
286 if (XParseColor(key.display,
287 Tk_DefaultColormap(Tk_Screen(tkwin)),
288 argv[1], &fg) == 0) {
289 Tcl_AppendResult(interp, "invalid color name \"", argv[1],
290 "\"", (char *) NULL);
291 goto error;
292 }
293 if (argc == 2) {
294 bg.red = bg.green = bg.blue = 0;
295 maskIndex = namePtr->shape;
296 } else {
297 if (XParseColor(key.display,
298 Tk_DefaultColormap(Tk_Screen(tkwin)),
299 argv[2], &bg) == 0) {
300 Tcl_AppendResult(interp, "invalid color name \"", argv[2],
301 "\"", (char *) NULL);
302 goto error;
303 }
304 }
305 }
306 dispPtr = ((TkWindow *) tkwin)->dispPtr;
307 if (dispPtr->cursorFont == None) {
308 dispPtr->cursorFont = XLoadFont(key.display, CURSORFONT);
309 if (dispPtr->cursorFont == None) {
310 interp->result = "couldn't load cursor font";
311 goto error;
312 }
313 }
314 cursor = XCreateGlyphCursor(key.display, dispPtr->cursorFont,
315 dispPtr->cursorFont, namePtr->shape, maskIndex,
316 &fg, &bg);
317 } else {
318 unsigned int width, height, maskWidth, maskHeight;
319 int xHot, yHot, dummy1, dummy2;
320 XColor fg, bg;
321
322 /*
323 * The cursor is to be created by reading bitmap files. There
324 * should be either two elements in the list (source, color) or
325 * four (source mask fg bg).
326 */
327
328 if ((argc != 2) && (argc != 4)) {
329 goto badString;
330 }
331 if (XReadBitmapFile(key.display, RootWindowOfScreen(Tk_Screen(tkwin)),
332 &argv[0][1], &width, &height, &source, &xHot, &yHot)
333 != BitmapSuccess) {
334 Tcl_AppendResult(interp, "error reading bitmap file \"",
335 &argv[0][1], "\"", (char *) NULL);
336 goto error;
337 }
338 if ((xHot < 0) || (yHot < 0) || (xHot >= width) || (yHot >= height)) {
339 Tcl_AppendResult(interp, "bad hot spot in bitmap file \"",
340 &argv[0][1], "\"", (char *) NULL);
341 goto error;
342 }
343 if (argc == 2) {
344 if (XParseColor(key.display,
345 Tk_DefaultColormap(Tk_Screen(tkwin)),
346 argv[1], &fg) == 0) {
347 Tcl_AppendResult(interp, "invalid color name \"",
348 argv[1], "\"", (char *) NULL);
349 goto error;
350 }
351 cursor = XCreatePixmapCursor(key.display, source, source,
352 &fg, &fg, xHot, yHot);
353 } else {
354 if (XReadBitmapFile(key.display,
355 RootWindowOfScreen(Tk_Screen(tkwin)), argv[1],
356 &maskWidth, &maskHeight, &mask, &dummy1,
357 &dummy2) != BitmapSuccess) {
358 Tcl_AppendResult(interp, "error reading bitmap file \"",
359 argv[1], "\"", (char *) NULL);
360 goto error;
361 }
362 if ((maskWidth != width) && (maskHeight != height)) {
363 interp->result =
364 "source and mask bitmaps have different sizes";
365 goto error;
366 }
367 if (XParseColor(key.display,
368 Tk_DefaultColormap(Tk_Screen(tkwin)),
369 argv[2], &fg) == 0) {
370 Tcl_AppendResult(interp, "invalid color name \"", argv[2],
371 "\"", (char *) NULL);
372 goto error;
373 }
374 if (XParseColor(key.display,
375 Tk_DefaultColormap(Tk_Screen(tkwin)),
376 argv[3], &bg) == 0) {
377 Tcl_AppendResult(interp, "invalid color name \"", argv[3],
378 "\"", (char *) NULL);
379 goto error;
380 }
381 cursor = XCreatePixmapCursor(key.display, source, mask,
382 &fg, &bg, xHot, yHot);
383 }
384 }
385 ckfree((char *) argv);
386
387 /*
388 * Add information about this cursor to our database.
389 */
390
391 cursorPtr = (TkCursor *) ckalloc(sizeof(TkCursor));
392 cursorPtr->cursor = cursor;
393 cursorPtr->display = key.display;
394 cursorPtr->refCount = 1;
395 cursorPtr->otherTable = &nameTable;
396 cursorPtr->hashPtr = nameHashPtr;
397 idHashPtr = Tcl_CreateHashEntry(&idTable, (char *) cursorPtr->cursor,
398 &new);
399 if (!new) {
400 /* deh patched to support multiple displays */
401 /* panic("cursor already registered in Tk_GetCursor"); */
402 cursorPtr->refCount = 1000;
403 }
404 Tcl_SetHashValue(nameHashPtr, cursorPtr);
405 Tcl_SetHashValue(idHashPtr, cursorPtr);
406 return cursorPtr->cursor;
407
408 error:
409 Tcl_DeleteHashEntry(nameHashPtr);
410 if (argv != NULL) {
411 ckfree((char *) argv);
412 }
413 if (source != None) {
414 XFreePixmap(key.display, source);
415 }
416 if (mask != None) {
417 XFreePixmap(key.display, mask);
418 }
419 return None;
420 }
421 \f
422 /*
423 *----------------------------------------------------------------------
424 *
425 * Tk_GetCursorFromData --
426 *
427 * Given a description of the bits and colors for a cursor,
428 * make a cursor that has the given properties.
429 *
430 * Results:
431 * The return value is the X identifer for the desired cursor,
432 * unless it couldn't be created properly. In this case, None is
433 * returned and an error message is left in interp->result. The
434 * caller should never modify the cursor that is returned, and
435 * should eventually call Tk_FreeCursor when the cursor is no
436 * longer needed.
437 *
438 * Side effects:
439 * The cursor is added to an internal database with a reference count.
440 * For each call to this procedure, there should eventually be a call
441 * to Tk_FreeCursor, so that the database can be cleaned up when cursors
442 * aren't needed anymore.
443 *
444 *----------------------------------------------------------------------
445 */
446
447 Cursor
448 Tk_GetCursorFromData(interp, tkwin, source, mask, width, height,
449 xHot, yHot, fg, bg)
450 Tcl_Interp *interp; /* Interpreter to use for error reporting. */
451 Tk_Window tkwin; /* Window in which cursor will be used. */
452 char *source; /* Bitmap data for cursor shape. */
453 char *mask; /* Bitmap data for cursor mask. */
454 unsigned int width, height; /* Dimensions of cursor. */
455 int xHot, yHot; /* Location of hot-spot in cursor. */
456 Tk_Uid fg; /* Foreground color for cursor. */
457 Tk_Uid bg; /* Background color for cursor. */
458 {
459 DataKey key;
460 Tcl_HashEntry *dataHashPtr, *idHashPtr;
461 register TkCursor *cursorPtr;
462 int new;
463 XColor fgColor, bgColor;
464 Pixmap sourcePixmap, maskPixmap;
465
466 if (!initialized) {
467 CursorInit();
468 }
469
470 key.source = source;
471 key.mask = mask;
472 key.width = width;
473 key.height = height;
474 key.xHot = xHot;
475 key.yHot = yHot;
476 key.fg = fg;
477 key.bg = bg;
478 key.display = Tk_Display(tkwin);
479 dataHashPtr = Tcl_CreateHashEntry(&dataTable, (char *) &key, &new);
480 if (!new) {
481 cursorPtr = (TkCursor *) Tcl_GetHashValue(dataHashPtr);
482 cursorPtr->refCount++;
483 return cursorPtr->cursor;
484 }
485
486 /*
487 * No suitable cursor exists yet. Make one using the data
488 * available and add it to the database.
489 */
490
491 if (XParseColor(key.display, Tk_DefaultColormap(Tk_Screen(tkwin)),
492 fg, &fgColor) == 0) {
493 Tcl_AppendResult(interp, "invalid color name \"", fg, "\"",
494 (char *) NULL);
495 goto error;
496 }
497 if (XParseColor(key.display, Tk_DefaultColormap(Tk_Screen(tkwin)),
498 bg, &bgColor) == 0) {
499 Tcl_AppendResult(interp, "invalid color name \"", bg, "\"",
500 (char *) NULL);
501 goto error;
502 }
503
504 cursorPtr = (TkCursor *) ckalloc(sizeof(TkCursor));
505 sourcePixmap = XCreateBitmapFromData(key.display,
506 RootWindowOfScreen(Tk_Screen(tkwin)), source, width, height);
507 maskPixmap = XCreateBitmapFromData(key.display,
508 RootWindowOfScreen(Tk_Screen(tkwin)), mask, width, height);
509 cursorPtr->cursor = XCreatePixmapCursor(key.display, sourcePixmap,
510 maskPixmap, &fgColor, &bgColor, xHot, yHot);
511 XFreePixmap(key.display, sourcePixmap);
512 XFreePixmap(key.display, maskPixmap);
513 cursorPtr->display = key.display;
514 cursorPtr->refCount = 1;
515 cursorPtr->otherTable = &dataTable;
516 cursorPtr->hashPtr = dataHashPtr;
517 idHashPtr = Tcl_CreateHashEntry(&idTable, (char *) cursorPtr->cursor, &new);
518 if (!new) {
519 /* deh patched to support multiple displays */
520 /* panic("cursor already registered in Tk_GetCursorFromData"); */
521 cursorPtr->refCount = 1000;
522 }
523 Tcl_SetHashValue(dataHashPtr, cursorPtr);
524 Tcl_SetHashValue(idHashPtr, cursorPtr);
525 return cursorPtr->cursor;
526
527 error:
528 Tcl_DeleteHashEntry(dataHashPtr);
529 return None;
530 }
531 \f
532 /*
533 *--------------------------------------------------------------
534 *
535 * Tk_NameOfCursor --
536 *
537 * Given a cursor, return a textual string identifying it.
538 *
539 * Results:
540 * If cursor was created by Tk_GetCursor, then the return
541 * value is the "string" that was used to create it.
542 * Otherwise the return value is a string giving the X
543 * identifier for the cursor. The storage for the returned
544 * string is only guaranteed to persist up until the next
545 * call to this procedure.
546 *
547 * Side effects:
548 * None.
549 *
550 *--------------------------------------------------------------
551 */
552
553 char *
554 Tk_NameOfCursor(cursor)
555 Cursor cursor; /* Cursor to be released. */
556 {
557 Tcl_HashEntry *idHashPtr;
558 TkCursor *cursorPtr;
559 static char string[20];
560
561 if (!initialized) {
562 printid:
563 sprintf(string, "cursor id 0x%x", cursor);
564 return string;
565 }
566 idHashPtr = Tcl_FindHashEntry(&idTable, (char *) cursor);
567 if (idHashPtr == NULL) {
568 goto printid;
569 }
570 cursorPtr = (TkCursor *) Tcl_GetHashValue(idHashPtr);
571 if (cursorPtr->otherTable != &nameTable) {
572 goto printid;
573 }
574 return ((NameKey *) cursorPtr->hashPtr->key.words)->name;
575 }
576 \f
577 /*
578 *----------------------------------------------------------------------
579 *
580 * Tk_FreeCursor --
581 *
582 * This procedure is called to release a cursor allocated by
583 * Tk_GetCursor or TkGetCursorFromData.
584 *
585 * Results:
586 * None.
587 *
588 * Side effects:
589 * The reference count associated with cursor is decremented, and
590 * it is officially deallocated if no-one is using it anymore.
591 *
592 *----------------------------------------------------------------------
593 */
594
595 void
596 Tk_FreeCursor(cursor)
597 Cursor cursor; /* Cursor to be released. */
598 {
599 Tcl_HashEntry *idHashPtr;
600 register TkCursor *cursorPtr;
601
602 if (!initialized) {
603 panic("Tk_FreeCursor called before Tk_GetCursor");
604 }
605
606 idHashPtr = Tcl_FindHashEntry(&idTable, (char *) cursor);
607 if (idHashPtr == NULL) {
608 panic("Tk_FreeCursor received unknown cursor argument");
609 }
610 cursorPtr = (TkCursor *) Tcl_GetHashValue(idHashPtr);
611 cursorPtr->refCount--;
612 if (cursorPtr->refCount == 0) {
613 XFreeCursor(cursorPtr->display, cursorPtr->cursor);
614 Tcl_DeleteHashEntry(cursorPtr->hashPtr);
615 Tcl_DeleteHashEntry(idHashPtr);
616 ckfree((char *) cursorPtr);
617 }
618 }
619 \f
620 /*
621 *----------------------------------------------------------------------
622 *
623 * CursorInit --
624 *
625 * Initialize the structures used for cursor management.
626 *
627 * Results:
628 * None.
629 *
630 * Side effects:
631 * Read the code.
632 *
633 *----------------------------------------------------------------------
634 */
635
636 static void
637 CursorInit()
638 {
639 initialized = 1;
640 Tcl_InitHashTable(&nameTable, sizeof(NameKey)/sizeof(long));
641 Tcl_InitHashTable(&dataTable, sizeof(DataKey)/sizeof(long));
642 Tcl_InitHashTable(&idTable, TCL_ONE_WORD_KEYS);
643 }
Impressum, Datenschutz