]> git.zerfleddert.de Git - micropolis/blob - src/tk/tkget.c
src/sim/makefile: Micropolis build fixes for recent macOS
[micropolis] / src / tk / tkget.c
1 /*
2 * tkGet.c --
3 *
4 * This file contains a number of "Tk_GetXXX" procedures, which
5 * parse text strings into useful forms for Tk. This file has
6 * the simpler procedures, like Tk_GetDirection and Tk_GetUid.
7 * The more complex procedures like Tk_GetColor are in separate
8 * files.
9 *
10 * Copyright 1991 Regents of the University of California
11 * Permission to use, copy, modify, and distribute this
12 * software and its documentation for any purpose and without
13 * fee is hereby granted, provided that the above copyright
14 * notice appear in all copies. The University of California
15 * makes no representations about the suitability of this
16 * software for any purpose. It is provided "as is" without
17 * express or implied warranty.
18 */
19
20 #ifndef lint
21 static char rcsid[] = "$Header: /user6/ouster/wish/RCS/tkGet.c,v 1.5 92/08/10 09:02:46 ouster Exp $ SPRITE (Berkeley)";
22 #endif /* not lint */
23
24 #include <tk.h>
25 #include "tkconfig.h"
26
27 /*
28 * The hash table below is used to keep track of all the Tk_Uids created
29 * so far.
30 */
31
32 static Tcl_HashTable uidTable;
33 static int initialized = 0;
34 \f
35 /*
36 *--------------------------------------------------------------
37 *
38 * Tk_GetAnchor --
39 *
40 * Given a string, return the corresponding Tk_Anchor.
41 *
42 * Results:
43 * The return value is a standard Tcl return result. If
44 * TCL_OK is returned, then everything went well and the
45 * position is stored at *anchorPtr; otherwise TCL_ERROR
46 * is returned and an error message is left in
47 * interp->result.
48 *
49 * Side effects:
50 * None.
51 *
52 *--------------------------------------------------------------
53 */
54
55 int
56 Tk_GetAnchor(interp, string, anchorPtr)
57 Tcl_Interp *interp; /* Use this for error reporting. */
58 char *string; /* String describing a direction. */
59 Tk_Anchor *anchorPtr; /* Where to store Tk_Anchor corresponding
60 * to string. */
61 {
62 switch (string[0]) {
63 case 'n':
64 if (string[1] == 0) {
65 *anchorPtr = TK_ANCHOR_N;
66 return TCL_OK;
67 } else if ((string[1] == 'e') && (string[2] == 0)) {
68 *anchorPtr = TK_ANCHOR_NE;
69 return TCL_OK;
70 } else if ((string[1] == 'w') && (string[2] == 0)) {
71 *anchorPtr = TK_ANCHOR_NW;
72 return TCL_OK;
73 }
74 goto error;
75 case 's':
76 if (string[1] == 0) {
77 *anchorPtr = TK_ANCHOR_S;
78 return TCL_OK;
79 } else if ((string[1] == 'e') && (string[2] == 0)) {
80 *anchorPtr = TK_ANCHOR_SE;
81 return TCL_OK;
82 } else if ((string[1] == 'w') && (string[2] == 0)) {
83 *anchorPtr = TK_ANCHOR_SW;
84 return TCL_OK;
85 } else {
86 goto error;
87 }
88 case 'e':
89 if (string[1] == 0) {
90 *anchorPtr = TK_ANCHOR_E;
91 return TCL_OK;
92 }
93 goto error;
94 case 'w':
95 if (string[1] == 0) {
96 *anchorPtr = TK_ANCHOR_W;
97 return TCL_OK;
98 }
99 goto error;
100 case 'c':
101 if (strncmp(string, "center", strlen(string)) == 0) {
102 *anchorPtr = TK_ANCHOR_CENTER;
103 return TCL_OK;
104 }
105 goto error;
106 }
107
108 error:
109 Tcl_AppendResult(interp, "bad anchor position \"", string,
110 "\": must be n, ne, e, se, s, sw, w, nw, or center",
111 (char *) NULL);
112 return TCL_ERROR;
113 }
114 \f
115 /*
116 *--------------------------------------------------------------
117 *
118 * Tk_NameOfAnchor --
119 *
120 * Given a Tk_Anchor, return the string that corresponds
121 * to it.
122 *
123 * Results:
124 * None.
125 *
126 * Side effects:
127 * None.
128 *
129 *--------------------------------------------------------------
130 */
131
132 char *
133 Tk_NameOfAnchor(anchor)
134 Tk_Anchor anchor; /* Anchor for which identifying string
135 * is desired. */
136 {
137 switch (anchor) {
138 case TK_ANCHOR_N: return "n";
139 case TK_ANCHOR_NE: return "ne";
140 case TK_ANCHOR_E: return "e";
141 case TK_ANCHOR_SE: return "se";
142 case TK_ANCHOR_S: return "s";
143 case TK_ANCHOR_SW: return "sw";
144 case TK_ANCHOR_W: return "w";
145 case TK_ANCHOR_NW: return "nw";
146 case TK_ANCHOR_CENTER: return "center";
147 }
148 return "unknown anchor position";
149 }
150 \f
151 /*
152 *--------------------------------------------------------------
153 *
154 * Tk_GetJoinStyle --
155 *
156 * Given a string, return the corresponding Tk_JoinStyle.
157 *
158 * Results:
159 * The return value is a standard Tcl return result. If
160 * TCL_OK is returned, then everything went well and the
161 * justification is stored at *joinPtr; otherwise
162 * TCL_ERROR is returned and an error message is left in
163 * interp->result.
164 *
165 * Side effects:
166 * None.
167 *
168 *--------------------------------------------------------------
169 */
170
171 int
172 Tk_GetJoinStyle(interp, string, joinPtr)
173 Tcl_Interp *interp; /* Use this for error reporting. */
174 char *string; /* String describing a justification style. */
175 int *joinPtr; /* Where to store join style corresponding
176 * to string. */
177 {
178 int c, length;
179
180 c = string[0];
181 length = strlen(string);
182
183 if ((c == 'b') && (strncmp(string, "bevel", length) == 0)) {
184 *joinPtr = JoinBevel;
185 return TCL_OK;
186 }
187 if ((c == 'm') && (strncmp(string, "miter", length) == 0)) {
188 *joinPtr = JoinMiter;
189 return TCL_OK;
190 }
191 if ((c == 'r') && (strncmp(string, "round", length) == 0)) {
192 *joinPtr = JoinRound;
193 return TCL_OK;
194 }
195
196 Tcl_AppendResult(interp, "bad join style \"", string,
197 "\": must be bevel, miter, or round",
198 (char *) NULL);
199 return TCL_ERROR;
200 }
201 \f
202 /*
203 *--------------------------------------------------------------
204 *
205 * Tk_NameOfJoinStyle --
206 *
207 * Given a Tk_JoinStyle, return the string that corresponds
208 * to it.
209 *
210 * Results:
211 * None.
212 *
213 * Side effects:
214 * None.
215 *
216 *--------------------------------------------------------------
217 */
218
219 char *
220 Tk_NameOfJoinStyle(join)
221 int join; /* Join style for which identifying string
222 * is desired. */
223 {
224 switch (join) {
225 case JoinBevel: return "bevel";
226 case JoinMiter: return "miter";
227 case JoinRound: return "round";
228 }
229 return "unknown join style";
230 }
231 \f
232 /*
233 *--------------------------------------------------------------
234 *
235 * Tk_GetCapStyle --
236 *
237 * Given a string, return the corresponding Tk_CapStyle.
238 *
239 * Results:
240 * The return value is a standard Tcl return result. If
241 * TCL_OK is returned, then everything went well and the
242 * justification is stored at *capPtr; otherwise
243 * TCL_ERROR is returned and an error message is left in
244 * interp->result.
245 *
246 * Side effects:
247 * None.
248 *
249 *--------------------------------------------------------------
250 */
251
252 int
253 Tk_GetCapStyle(interp, string, capPtr)
254 Tcl_Interp *interp; /* Use this for error reporting. */
255 char *string; /* String describing a justification style. */
256 int *capPtr; /* Where to store cap style corresponding
257 * to string. */
258 {
259 int c, length;
260
261 c = string[0];
262 length = strlen(string);
263
264 if ((c == 'b') && (strncmp(string, "butt", length) == 0)) {
265 *capPtr = CapButt;
266 return TCL_OK;
267 }
268 if ((c == 'p') && (strncmp(string, "projecting", length) == 0)) {
269 *capPtr = CapProjecting;
270 return TCL_OK;
271 }
272 if ((c == 'r') && (strncmp(string, "round", length) == 0)) {
273 *capPtr = CapRound;
274 return TCL_OK;
275 }
276
277 Tcl_AppendResult(interp, "bad cap style \"", string,
278 "\": must be butt, projecting, or round",
279 (char *) NULL);
280 return TCL_ERROR;
281 }
282 \f
283 /*
284 *--------------------------------------------------------------
285 *
286 * Tk_NameOfCapStyle --
287 *
288 * Given a Tk_CapStyle, return the string that corresponds
289 * to it.
290 *
291 * Results:
292 * None.
293 *
294 * Side effects:
295 * None.
296 *
297 *--------------------------------------------------------------
298 */
299
300 char *
301 Tk_NameOfCapStyle(cap)
302 int cap; /* Cap style for which identifying string
303 * is desired. */
304 {
305 switch (cap) {
306 case CapButt: return "butt";
307 case CapProjecting: return "projecting";
308 case CapRound: return "round";
309 }
310 return "unknown cap style";
311 }
312 \f
313 /*
314 *--------------------------------------------------------------
315 *
316 * Tk_GetJustify --
317 *
318 * Given a string, return the corresponding Tk_Justify.
319 *
320 * Results:
321 * The return value is a standard Tcl return result. If
322 * TCL_OK is returned, then everything went well and the
323 * justification is stored at *justifyPtr; otherwise
324 * TCL_ERROR is returned and an error message is left in
325 * interp->result.
326 *
327 * Side effects:
328 * None.
329 *
330 *--------------------------------------------------------------
331 */
332
333 int
334 Tk_GetJustify(interp, string, justifyPtr)
335 Tcl_Interp *interp; /* Use this for error reporting. */
336 char *string; /* String describing a justification style. */
337 Tk_Justify *justifyPtr; /* Where to store Tk_Justify corresponding
338 * to string. */
339 {
340 int c, length;
341
342 c = string[0];
343 length = strlen(string);
344
345 if ((c == 'l') && (strncmp(string, "left", length) == 0)) {
346 *justifyPtr = TK_JUSTIFY_LEFT;
347 return TCL_OK;
348 }
349 if ((c == 'r') && (strncmp(string, "right", length) == 0)) {
350 *justifyPtr = TK_JUSTIFY_RIGHT;
351 return TCL_OK;
352 }
353 if ((c == 'c') && (strncmp(string, "center", length) == 0)) {
354 *justifyPtr = TK_JUSTIFY_CENTER;
355 return TCL_OK;
356 }
357 if ((c == 'f') && (strncmp(string, "fill", length) == 0)) {
358 *justifyPtr = TK_JUSTIFY_FILL;
359 return TCL_OK;
360 }
361
362 Tcl_AppendResult(interp, "bad justification \"", string,
363 "\": must be left, right, center, or fill",
364 (char *) NULL);
365 return TCL_ERROR;
366 }
367 \f
368 /*
369 *--------------------------------------------------------------
370 *
371 * Tk_NameOfJustify --
372 *
373 * Given a Tk_Justify, return the string that corresponds
374 * to it.
375 *
376 * Results:
377 * None.
378 *
379 * Side effects:
380 * None.
381 *
382 *--------------------------------------------------------------
383 */
384
385 char *
386 Tk_NameOfJustify(justify)
387 Tk_Justify justify; /* Justification style for which
388 * identifying string is desired. */
389 {
390 switch (justify) {
391 case TK_JUSTIFY_LEFT: return "left";
392 case TK_JUSTIFY_RIGHT: return "right";
393 case TK_JUSTIFY_CENTER: return "center";
394 case TK_JUSTIFY_FILL: return "fill";
395 }
396 return "unknown justification style";
397 }
398 \f
399 /*
400 *----------------------------------------------------------------------
401 *
402 * Tk_GetUid --
403 *
404 * Given a string, this procedure returns a unique identifier
405 * for the string.
406 *
407 * Results:
408 * This procedure returns a Tk_Uid corresponding to the "string"
409 * argument. The Tk_Uid has a string value identical to string
410 * (strcmp will return 0), but it's guaranteed that any other
411 * calls to this procedure with a string equal to "string" will
412 * return exactly the same result (i.e. can compare Tk_Uid
413 * *values* directly, without having to call strcmp on what they
414 * point to).
415 *
416 * Side effects:
417 * New information may be entered into the identifier table.
418 *
419 *----------------------------------------------------------------------
420 */
421
422 Tk_Uid
423 Tk_GetUid(string)
424 char *string; /* String to convert. */
425 {
426 int dummy;
427
428 if (!initialized) {
429 Tcl_InitHashTable(&uidTable, TCL_STRING_KEYS);
430 initialized = 1;
431 }
432 return (Tk_Uid) Tcl_GetHashKey(&uidTable,
433 Tcl_CreateHashEntry(&uidTable, string, &dummy));
434 }
435 \f
436 /*
437 *--------------------------------------------------------------
438 *
439 * Tk_GetScreenMM --
440 *
441 * Given a string, returns the number of screen millimeters
442 * corresponding to that string.
443 *
444 * Results:
445 * The return value is a standard Tcl return result. If
446 * TCL_OK is returned, then everything went well and the
447 * screen distance is stored at *doublePtr; otherwise
448 * TCL_ERROR is returned and an error message is left in
449 * interp->result.
450 *
451 * Side effects:
452 * None.
453 *
454 *--------------------------------------------------------------
455 */
456
457 int
458 Tk_GetScreenMM(interp, tkwin, string, doublePtr)
459 Tcl_Interp *interp; /* Use this for error reporting. */
460 Tk_Window tkwin; /* Window whose screen determines conversion
461 * from centimeters and other absolute
462 * units. */
463 char *string; /* String describing a screen distance. */
464 double *doublePtr; /* Place to store converted result. */
465 {
466 char *end;
467 double d;
468
469 d = strtod(string, &end);
470 if (end == string) {
471 error:
472 Tcl_AppendResult(interp, "bad screen distance \"", string,
473 "\"", (char *) NULL);
474 return TCL_ERROR;
475 }
476 while ((*end != '\0') && isspace(*end)) {
477 end++;
478 }
479 switch (*end) {
480 case 0:
481 d /= WidthOfScreen(Tk_Screen(tkwin));
482 d *= WidthMMOfScreen(Tk_Screen(tkwin));
483 break;
484 case 'c':
485 d *= 10;
486 end++;
487 break;
488 case 'i':
489 d *= 25.4;
490 end++;
491 break;
492 case 'm':
493 end++;
494 break;
495 case 'p':
496 d *= 25.4/72.0;
497 end++;
498 break;
499 default:
500 goto error;
501 }
502 while ((*end != '\0') && isspace(*end)) {
503 end++;
504 }
505 if (*end != 0) {
506 goto error;
507 }
508 *doublePtr = d;
509 return TCL_OK;
510 }
511 \f
512 /*
513 *--------------------------------------------------------------
514 *
515 * Tk_GetPixels --
516 *
517 * Given a string, returns the number of pixels corresponding
518 * to that string.
519 *
520 * Results:
521 * The return value is a standard Tcl return result. If
522 * TCL_OK is returned, then everything went well and the
523 * rounded pixel distance is stored at *intPtr; otherwise
524 * TCL_ERROR is returned and an error message is left in
525 * interp->result.
526 *
527 * Side effects:
528 * None.
529 *
530 *--------------------------------------------------------------
531 */
532
533 int
534 Tk_GetPixels(interp, tkwin, string, intPtr)
535 Tcl_Interp *interp; /* Use this for error reporting. */
536 Tk_Window tkwin; /* Window whose screen determines conversion
537 * from centimeters and other absolute
538 * units. */
539 char *string; /* String describing a justification style. */
540 int *intPtr; /* Place to store converted result. */
541 {
542 char *end;
543 double d;
544
545 d = strtod(string, &end);
546 if (end == string) {
547 error:
548 Tcl_AppendResult(interp, "bad screen distance \"", string,
549 "\"", (char *) NULL);
550 return TCL_ERROR;
551 }
552 while ((*end != '\0') && isspace(*end)) {
553 end++;
554 }
555 switch (*end) {
556 case 0:
557 break;
558 case 'c':
559 d *= 10*WidthOfScreen(Tk_Screen(tkwin));
560 d /= WidthMMOfScreen(Tk_Screen(tkwin));
561 end++;
562 break;
563 case 'i':
564 d *= 25.4*WidthOfScreen(Tk_Screen(tkwin));
565 d /= WidthMMOfScreen(Tk_Screen(tkwin));
566 end++;
567 break;
568 case 'm':
569 d *= WidthOfScreen(Tk_Screen(tkwin));
570 d /= WidthMMOfScreen(Tk_Screen(tkwin));
571 end++;
572 break;
573 case 'p':
574 d *= (25.4/72.0)*WidthOfScreen(Tk_Screen(tkwin));
575 d /= WidthMMOfScreen(Tk_Screen(tkwin));
576 end++;
577 break;
578 default:
579 goto error;
580 }
581 while ((*end != '\0') && isspace(*end)) {
582 end++;
583 }
584 if (*end != 0) {
585 goto error;
586 }
587 if (d < 0) {
588 *intPtr = (int) (d - 0.5);
589 } else {
590 *intPtr = (int) (d + 0.5);
591 }
592 return TCL_OK;
593 }
Impressum, Datenschutz