1 |
/* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tk_base/tkget.c,v 1.1.1.1 2001/06/13 05:01:24 dtashley Exp $ */
|
2 |
|
3 |
/*
|
4 |
* tkGet.c --
|
5 |
*
|
6 |
* This file contains a number of "Tk_GetXXX" procedures, which
|
7 |
* parse text strings into useful forms for Tk. This file has
|
8 |
* the simpler procedures, like Tk_GetDirection and Tk_GetUid.
|
9 |
* The more complex procedures like Tk_GetColor are in separate
|
10 |
* files.
|
11 |
*
|
12 |
* Copyright (c) 1991-1994 The Regents of the University of California.
|
13 |
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
|
14 |
*
|
15 |
* See the file "license.terms" for information on usage and redistribution
|
16 |
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
17 |
*
|
18 |
* RCS: @(#) $Id: tkget.c,v 1.1.1.1 2001/06/13 05:01:24 dtashley Exp $
|
19 |
*/
|
20 |
|
21 |
#include "tkInt.h"
|
22 |
#include "tkPort.h"
|
23 |
|
24 |
/*
|
25 |
* One of these structures is created per thread to store
|
26 |
* thread-specific data. In this case, it is used to house the
|
27 |
* Tk_Uid structs used by each thread. The "dataKey" below is
|
28 |
* used to locate the ThreadSpecificData for the current thread.
|
29 |
*/
|
30 |
|
31 |
typedef struct ThreadSpecificData {
|
32 |
int initialized;
|
33 |
Tcl_HashTable uidTable;
|
34 |
} ThreadSpecificData;
|
35 |
static Tcl_ThreadDataKey dataKey;
|
36 |
|
37 |
/*
|
38 |
* The following tables defines the string values for reliefs, which are
|
39 |
* used by Tk_GetAnchorFromObj and Tk_GetJustifyFromObj.
|
40 |
*/
|
41 |
|
42 |
static char *anchorStrings[] = {"n", "ne", "e", "se", "s", "sw", "w", "nw",
|
43 |
"center", (char *) NULL};
|
44 |
static char *justifyStrings[] = {"left", "right", "center", (char *) NULL};
|
45 |
|
46 |
|
47 |
/*
|
48 |
*----------------------------------------------------------------------
|
49 |
*
|
50 |
* Tk_GetAnchorFromObj --
|
51 |
*
|
52 |
* Return a Tk_Anchor value based on the value of the objPtr.
|
53 |
*
|
54 |
* Results:
|
55 |
* The return value is a standard Tcl result. If an error occurs during
|
56 |
* conversion, an error message is left in the interpreter's result
|
57 |
* unless "interp" is NULL.
|
58 |
*
|
59 |
* Side effects:
|
60 |
* The object gets converted by Tcl_GetIndexFromObj.
|
61 |
*
|
62 |
*----------------------------------------------------------------------
|
63 |
*/
|
64 |
|
65 |
int
|
66 |
Tk_GetAnchorFromObj(interp, objPtr, anchorPtr)
|
67 |
Tcl_Interp *interp; /* Used for error reporting. */
|
68 |
Tcl_Obj *objPtr; /* The object we are trying to get the
|
69 |
* value from. */
|
70 |
Tk_Anchor *anchorPtr; /* Where to place the Tk_Anchor that
|
71 |
* corresponds to the string value of
|
72 |
* objPtr. */
|
73 |
{
|
74 |
int index, code;
|
75 |
|
76 |
code = Tcl_GetIndexFromObj(interp, objPtr, anchorStrings, "anchor", 0,
|
77 |
&index);
|
78 |
if (code == TCL_OK) {
|
79 |
*anchorPtr = (Tk_Anchor) index;
|
80 |
}
|
81 |
return code;
|
82 |
}
|
83 |
|
84 |
/*
|
85 |
*--------------------------------------------------------------
|
86 |
*
|
87 |
* Tk_GetAnchor --
|
88 |
*
|
89 |
* Given a string, return the corresponding Tk_Anchor.
|
90 |
*
|
91 |
* Results:
|
92 |
* The return value is a standard Tcl return result. If
|
93 |
* TCL_OK is returned, then everything went well and the
|
94 |
* position is stored at *anchorPtr; otherwise TCL_ERROR
|
95 |
* is returned and an error message is left in
|
96 |
* the interp's result.
|
97 |
*
|
98 |
* Side effects:
|
99 |
* None.
|
100 |
*
|
101 |
*--------------------------------------------------------------
|
102 |
*/
|
103 |
|
104 |
int
|
105 |
Tk_GetAnchor(interp, string, anchorPtr)
|
106 |
Tcl_Interp *interp; /* Use this for error reporting. */
|
107 |
char *string; /* String describing a direction. */
|
108 |
Tk_Anchor *anchorPtr; /* Where to store Tk_Anchor corresponding
|
109 |
* to string. */
|
110 |
{
|
111 |
switch (string[0]) {
|
112 |
case 'n':
|
113 |
if (string[1] == 0) {
|
114 |
*anchorPtr = TK_ANCHOR_N;
|
115 |
return TCL_OK;
|
116 |
} else if ((string[1] == 'e') && (string[2] == 0)) {
|
117 |
*anchorPtr = TK_ANCHOR_NE;
|
118 |
return TCL_OK;
|
119 |
} else if ((string[1] == 'w') && (string[2] == 0)) {
|
120 |
*anchorPtr = TK_ANCHOR_NW;
|
121 |
return TCL_OK;
|
122 |
}
|
123 |
goto error;
|
124 |
case 's':
|
125 |
if (string[1] == 0) {
|
126 |
*anchorPtr = TK_ANCHOR_S;
|
127 |
return TCL_OK;
|
128 |
} else if ((string[1] == 'e') && (string[2] == 0)) {
|
129 |
*anchorPtr = TK_ANCHOR_SE;
|
130 |
return TCL_OK;
|
131 |
} else if ((string[1] == 'w') && (string[2] == 0)) {
|
132 |
*anchorPtr = TK_ANCHOR_SW;
|
133 |
return TCL_OK;
|
134 |
} else {
|
135 |
goto error;
|
136 |
}
|
137 |
case 'e':
|
138 |
if (string[1] == 0) {
|
139 |
*anchorPtr = TK_ANCHOR_E;
|
140 |
return TCL_OK;
|
141 |
}
|
142 |
goto error;
|
143 |
case 'w':
|
144 |
if (string[1] == 0) {
|
145 |
*anchorPtr = TK_ANCHOR_W;
|
146 |
return TCL_OK;
|
147 |
}
|
148 |
goto error;
|
149 |
case 'c':
|
150 |
if (strncmp(string, "center", strlen(string)) == 0) {
|
151 |
*anchorPtr = TK_ANCHOR_CENTER;
|
152 |
return TCL_OK;
|
153 |
}
|
154 |
goto error;
|
155 |
}
|
156 |
|
157 |
error:
|
158 |
Tcl_AppendResult(interp, "bad anchor position \"", string,
|
159 |
"\": must be n, ne, e, se, s, sw, w, nw, or center",
|
160 |
(char *) NULL);
|
161 |
return TCL_ERROR;
|
162 |
}
|
163 |
|
164 |
/*
|
165 |
*--------------------------------------------------------------
|
166 |
*
|
167 |
* Tk_NameOfAnchor --
|
168 |
*
|
169 |
* Given a Tk_Anchor, return the string that corresponds
|
170 |
* to it.
|
171 |
*
|
172 |
* Results:
|
173 |
* None.
|
174 |
*
|
175 |
* Side effects:
|
176 |
* None.
|
177 |
*
|
178 |
*--------------------------------------------------------------
|
179 |
*/
|
180 |
|
181 |
char *
|
182 |
Tk_NameOfAnchor(anchor)
|
183 |
Tk_Anchor anchor; /* Anchor for which identifying string
|
184 |
* is desired. */
|
185 |
{
|
186 |
switch (anchor) {
|
187 |
case TK_ANCHOR_N: return "n";
|
188 |
case TK_ANCHOR_NE: return "ne";
|
189 |
case TK_ANCHOR_E: return "e";
|
190 |
case TK_ANCHOR_SE: return "se";
|
191 |
case TK_ANCHOR_S: return "s";
|
192 |
case TK_ANCHOR_SW: return "sw";
|
193 |
case TK_ANCHOR_W: return "w";
|
194 |
case TK_ANCHOR_NW: return "nw";
|
195 |
case TK_ANCHOR_CENTER: return "center";
|
196 |
}
|
197 |
return "unknown anchor position";
|
198 |
}
|
199 |
|
200 |
/*
|
201 |
*--------------------------------------------------------------
|
202 |
*
|
203 |
* Tk_GetJoinStyle --
|
204 |
*
|
205 |
* Given a string, return the corresponding Tk JoinStyle.
|
206 |
*
|
207 |
* Results:
|
208 |
* The return value is a standard Tcl return result. If
|
209 |
* TCL_OK is returned, then everything went well and the
|
210 |
* justification is stored at *joinPtr; otherwise
|
211 |
* TCL_ERROR is returned and an error message is left in
|
212 |
* the interp's result.
|
213 |
*
|
214 |
* Side effects:
|
215 |
* None.
|
216 |
*
|
217 |
*--------------------------------------------------------------
|
218 |
*/
|
219 |
|
220 |
int
|
221 |
Tk_GetJoinStyle(interp, string, joinPtr)
|
222 |
Tcl_Interp *interp; /* Use this for error reporting. */
|
223 |
char *string; /* String describing a justification style. */
|
224 |
int *joinPtr; /* Where to store join style corresponding
|
225 |
* to string. */
|
226 |
{
|
227 |
int c;
|
228 |
size_t length;
|
229 |
|
230 |
c = string[0];
|
231 |
length = strlen(string);
|
232 |
|
233 |
if ((c == 'b') && (strncmp(string, "bevel", length) == 0)) {
|
234 |
*joinPtr = JoinBevel;
|
235 |
return TCL_OK;
|
236 |
}
|
237 |
if ((c == 'm') && (strncmp(string, "miter", length) == 0)) {
|
238 |
*joinPtr = JoinMiter;
|
239 |
return TCL_OK;
|
240 |
}
|
241 |
if ((c == 'r') && (strncmp(string, "round", length) == 0)) {
|
242 |
*joinPtr = JoinRound;
|
243 |
return TCL_OK;
|
244 |
}
|
245 |
|
246 |
Tcl_AppendResult(interp, "bad join style \"", string,
|
247 |
"\": must be bevel, miter, or round",
|
248 |
(char *) NULL);
|
249 |
return TCL_ERROR;
|
250 |
}
|
251 |
|
252 |
/*
|
253 |
*--------------------------------------------------------------
|
254 |
*
|
255 |
* Tk_NameOfJoinStyle --
|
256 |
*
|
257 |
* Given a Tk JoinStyle, return the string that corresponds
|
258 |
* to it.
|
259 |
*
|
260 |
* Results:
|
261 |
* None.
|
262 |
*
|
263 |
* Side effects:
|
264 |
* None.
|
265 |
*
|
266 |
*--------------------------------------------------------------
|
267 |
*/
|
268 |
|
269 |
char *
|
270 |
Tk_NameOfJoinStyle(join)
|
271 |
int join; /* Join style for which identifying string
|
272 |
* is desired. */
|
273 |
{
|
274 |
switch (join) {
|
275 |
case JoinBevel: return "bevel";
|
276 |
case JoinMiter: return "miter";
|
277 |
case JoinRound: return "round";
|
278 |
}
|
279 |
return "unknown join style";
|
280 |
}
|
281 |
|
282 |
/*
|
283 |
*--------------------------------------------------------------
|
284 |
*
|
285 |
* Tk_GetCapStyle --
|
286 |
*
|
287 |
* Given a string, return the corresponding Tk CapStyle.
|
288 |
*
|
289 |
* Results:
|
290 |
* The return value is a standard Tcl return result. If
|
291 |
* TCL_OK is returned, then everything went well and the
|
292 |
* justification is stored at *capPtr; otherwise
|
293 |
* TCL_ERROR is returned and an error message is left in
|
294 |
* the interp's result.
|
295 |
*
|
296 |
* Side effects:
|
297 |
* None.
|
298 |
*
|
299 |
*--------------------------------------------------------------
|
300 |
*/
|
301 |
|
302 |
int
|
303 |
Tk_GetCapStyle(interp, string, capPtr)
|
304 |
Tcl_Interp *interp; /* Use this for error reporting. */
|
305 |
char *string; /* String describing a justification style. */
|
306 |
int *capPtr; /* Where to store cap style corresponding
|
307 |
* to string. */
|
308 |
{
|
309 |
int c;
|
310 |
size_t length;
|
311 |
|
312 |
c = string[0];
|
313 |
length = strlen(string);
|
314 |
|
315 |
if ((c == 'b') && (strncmp(string, "butt", length) == 0)) {
|
316 |
*capPtr = CapButt;
|
317 |
return TCL_OK;
|
318 |
}
|
319 |
if ((c == 'p') && (strncmp(string, "projecting", length) == 0)) {
|
320 |
*capPtr = CapProjecting;
|
321 |
return TCL_OK;
|
322 |
}
|
323 |
if ((c == 'r') && (strncmp(string, "round", length) == 0)) {
|
324 |
*capPtr = CapRound;
|
325 |
return TCL_OK;
|
326 |
}
|
327 |
|
328 |
Tcl_AppendResult(interp, "bad cap style \"", string,
|
329 |
"\": must be butt, projecting, or round",
|
330 |
(char *) NULL);
|
331 |
return TCL_ERROR;
|
332 |
}
|
333 |
|
334 |
/*
|
335 |
*--------------------------------------------------------------
|
336 |
*
|
337 |
* Tk_NameOfCapStyle --
|
338 |
*
|
339 |
* Given a Tk CapStyle, return the string that corresponds
|
340 |
* to it.
|
341 |
*
|
342 |
* Results:
|
343 |
* None.
|
344 |
*
|
345 |
* Side effects:
|
346 |
* None.
|
347 |
*
|
348 |
*--------------------------------------------------------------
|
349 |
*/
|
350 |
|
351 |
char *
|
352 |
Tk_NameOfCapStyle(cap)
|
353 |
int cap; /* Cap style for which identifying string
|
354 |
* is desired. */
|
355 |
{
|
356 |
switch (cap) {
|
357 |
case CapButt: return "butt";
|
358 |
case CapProjecting: return "projecting";
|
359 |
case CapRound: return "round";
|
360 |
}
|
361 |
return "unknown cap style";
|
362 |
}
|
363 |
|
364 |
/*
|
365 |
*----------------------------------------------------------------------
|
366 |
*
|
367 |
* Tk_GetJustifyFromObj --
|
368 |
*
|
369 |
* Return a Tk_Justify value based on the value of the objPtr.
|
370 |
*
|
371 |
* Results:
|
372 |
* The return value is a standard Tcl result. If an error occurs during
|
373 |
* conversion, an error message is left in the interpreter's result
|
374 |
* unless "interp" is NULL.
|
375 |
*
|
376 |
* Side effects:
|
377 |
* The object gets converted by Tcl_GetIndexFromObj.
|
378 |
*
|
379 |
*----------------------------------------------------------------------
|
380 |
*/
|
381 |
|
382 |
int
|
383 |
Tk_GetJustifyFromObj(interp, objPtr, justifyPtr)
|
384 |
Tcl_Interp *interp; /* Used for error reporting. */
|
385 |
Tcl_Obj *objPtr; /* The object we are trying to get the
|
386 |
* value from. */
|
387 |
Tk_Justify *justifyPtr; /* Where to place the Tk_Justify that
|
388 |
* corresponds to the string value of
|
389 |
* objPtr. */
|
390 |
{
|
391 |
int index, code;
|
392 |
|
393 |
code = Tcl_GetIndexFromObj(interp, objPtr, justifyStrings,
|
394 |
"justification", 0, &index);
|
395 |
if (code == TCL_OK) {
|
396 |
*justifyPtr = (Tk_Justify) index;
|
397 |
}
|
398 |
return code;
|
399 |
}
|
400 |
|
401 |
/*
|
402 |
*--------------------------------------------------------------
|
403 |
*
|
404 |
* Tk_GetJustify --
|
405 |
*
|
406 |
* Given a string, return the corresponding Tk_Justify.
|
407 |
*
|
408 |
* Results:
|
409 |
* The return value is a standard Tcl return result. If
|
410 |
* TCL_OK is returned, then everything went well and the
|
411 |
* justification is stored at *justifyPtr; otherwise
|
412 |
* TCL_ERROR is returned and an error message is left in
|
413 |
* the interp's result.
|
414 |
*
|
415 |
* Side effects:
|
416 |
* None.
|
417 |
*
|
418 |
*--------------------------------------------------------------
|
419 |
*/
|
420 |
|
421 |
int
|
422 |
Tk_GetJustify(interp, string, justifyPtr)
|
423 |
Tcl_Interp *interp; /* Use this for error reporting. */
|
424 |
char *string; /* String describing a justification style. */
|
425 |
Tk_Justify *justifyPtr; /* Where to store Tk_Justify corresponding
|
426 |
* to string. */
|
427 |
{
|
428 |
int c;
|
429 |
size_t length;
|
430 |
|
431 |
c = string[0];
|
432 |
length = strlen(string);
|
433 |
|
434 |
if ((c == 'l') && (strncmp(string, "left", length) == 0)) {
|
435 |
*justifyPtr = TK_JUSTIFY_LEFT;
|
436 |
return TCL_OK;
|
437 |
}
|
438 |
if ((c == 'r') && (strncmp(string, "right", length) == 0)) {
|
439 |
*justifyPtr = TK_JUSTIFY_RIGHT;
|
440 |
return TCL_OK;
|
441 |
}
|
442 |
if ((c == 'c') && (strncmp(string, "center", length) == 0)) {
|
443 |
*justifyPtr = TK_JUSTIFY_CENTER;
|
444 |
return TCL_OK;
|
445 |
}
|
446 |
|
447 |
Tcl_AppendResult(interp, "bad justification \"", string,
|
448 |
"\": must be left, right, or center",
|
449 |
(char *) NULL);
|
450 |
return TCL_ERROR;
|
451 |
}
|
452 |
|
453 |
/*
|
454 |
*--------------------------------------------------------------
|
455 |
*
|
456 |
* Tk_NameOfJustify --
|
457 |
*
|
458 |
* Given a Tk_Justify, return the string that corresponds
|
459 |
* to it.
|
460 |
*
|
461 |
* Results:
|
462 |
* None.
|
463 |
*
|
464 |
* Side effects:
|
465 |
* None.
|
466 |
*
|
467 |
*--------------------------------------------------------------
|
468 |
*/
|
469 |
|
470 |
char *
|
471 |
Tk_NameOfJustify(justify)
|
472 |
Tk_Justify justify; /* Justification style for which
|
473 |
* identifying string is desired. */
|
474 |
{
|
475 |
switch (justify) {
|
476 |
case TK_JUSTIFY_LEFT: return "left";
|
477 |
case TK_JUSTIFY_RIGHT: return "right";
|
478 |
case TK_JUSTIFY_CENTER: return "center";
|
479 |
}
|
480 |
return "unknown justification style";
|
481 |
}
|
482 |
|
483 |
/*
|
484 |
*----------------------------------------------------------------------
|
485 |
*
|
486 |
* Tk_GetUid --
|
487 |
*
|
488 |
* Given a string, this procedure returns a unique identifier
|
489 |
* for the string.
|
490 |
*
|
491 |
* Results:
|
492 |
* This procedure returns a Tk_Uid corresponding to the "string"
|
493 |
* argument. The Tk_Uid has a string value identical to string
|
494 |
* (strcmp will return 0), but it's guaranteed that any other
|
495 |
* calls to this procedure with a string equal to "string" will
|
496 |
* return exactly the same result (i.e. can compare Tk_Uid
|
497 |
* *values* directly, without having to call strcmp on what they
|
498 |
* point to).
|
499 |
*
|
500 |
* Side effects:
|
501 |
* New information may be entered into the identifier table.
|
502 |
*
|
503 |
*----------------------------------------------------------------------
|
504 |
*/
|
505 |
|
506 |
Tk_Uid
|
507 |
Tk_GetUid(string)
|
508 |
CONST char *string; /* String to convert. */
|
509 |
{
|
510 |
int dummy;
|
511 |
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
|
512 |
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
|
513 |
Tcl_HashTable *tablePtr = &tsdPtr->uidTable;
|
514 |
|
515 |
if (!tsdPtr->initialized) {
|
516 |
Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS);
|
517 |
tsdPtr->initialized = 1;
|
518 |
}
|
519 |
return (Tk_Uid) Tcl_GetHashKey(tablePtr,
|
520 |
Tcl_CreateHashEntry(tablePtr, string, &dummy));
|
521 |
}
|
522 |
|
523 |
/*
|
524 |
*--------------------------------------------------------------
|
525 |
*
|
526 |
* Tk_GetScreenMM --
|
527 |
*
|
528 |
* Given a string, returns the number of screen millimeters
|
529 |
* corresponding to that string.
|
530 |
*
|
531 |
* Results:
|
532 |
* The return value is a standard Tcl return result. If
|
533 |
* TCL_OK is returned, then everything went well and the
|
534 |
* screen distance is stored at *doublePtr; otherwise
|
535 |
* TCL_ERROR is returned and an error message is left in
|
536 |
* the interp's result.
|
537 |
*
|
538 |
* Side effects:
|
539 |
* None.
|
540 |
*
|
541 |
*--------------------------------------------------------------
|
542 |
*/
|
543 |
|
544 |
int
|
545 |
Tk_GetScreenMM(interp, tkwin, string, doublePtr)
|
546 |
Tcl_Interp *interp; /* Use this for error reporting. */
|
547 |
Tk_Window tkwin; /* Window whose screen determines conversion
|
548 |
* from centimeters and other absolute
|
549 |
* units. */
|
550 |
char *string; /* String describing a screen distance. */
|
551 |
double *doublePtr; /* Place to store converted result. */
|
552 |
{
|
553 |
char *end;
|
554 |
double d;
|
555 |
|
556 |
d = strtod(string, &end);
|
557 |
if (end == string) {
|
558 |
error:
|
559 |
Tcl_AppendResult(interp, "bad screen distance \"", string,
|
560 |
"\"", (char *) NULL);
|
561 |
return TCL_ERROR;
|
562 |
}
|
563 |
while ((*end != '\0') && isspace(UCHAR(*end))) {
|
564 |
end++;
|
565 |
}
|
566 |
switch (*end) {
|
567 |
case 0:
|
568 |
d /= WidthOfScreen(Tk_Screen(tkwin));
|
569 |
d *= WidthMMOfScreen(Tk_Screen(tkwin));
|
570 |
break;
|
571 |
case 'c':
|
572 |
d *= 10;
|
573 |
end++;
|
574 |
break;
|
575 |
case 'i':
|
576 |
d *= 25.4;
|
577 |
end++;
|
578 |
break;
|
579 |
case 'm':
|
580 |
end++;
|
581 |
break;
|
582 |
case 'p':
|
583 |
d *= 25.4/72.0;
|
584 |
end++;
|
585 |
break;
|
586 |
default:
|
587 |
goto error;
|
588 |
}
|
589 |
while ((*end != '\0') && isspace(UCHAR(*end))) {
|
590 |
end++;
|
591 |
}
|
592 |
if (*end != 0) {
|
593 |
goto error;
|
594 |
}
|
595 |
*doublePtr = d;
|
596 |
return TCL_OK;
|
597 |
}
|
598 |
|
599 |
/*
|
600 |
*--------------------------------------------------------------
|
601 |
*
|
602 |
* Tk_GetPixels --
|
603 |
*
|
604 |
* Given a string, returns the number of pixels corresponding
|
605 |
* to that string.
|
606 |
*
|
607 |
* Results:
|
608 |
* The return value is a standard Tcl return result. If
|
609 |
* TCL_OK is returned, then everything went well and the
|
610 |
* rounded pixel distance is stored at *intPtr; otherwise
|
611 |
* TCL_ERROR is returned and an error message is left in
|
612 |
* the interp's result.
|
613 |
*
|
614 |
* Side effects:
|
615 |
* None.
|
616 |
*
|
617 |
*--------------------------------------------------------------
|
618 |
*/
|
619 |
|
620 |
int
|
621 |
Tk_GetPixels(interp, tkwin, string, intPtr)
|
622 |
Tcl_Interp *interp; /* Use this for error reporting. */
|
623 |
Tk_Window tkwin; /* Window whose screen determines conversion
|
624 |
* from centimeters and other absolute
|
625 |
* units. */
|
626 |
char *string; /* String describing a number of pixels. */
|
627 |
int *intPtr; /* Place to store converted result. */
|
628 |
{
|
629 |
double d;
|
630 |
|
631 |
if (TkGetDoublePixels(interp, tkwin, string, &d) != TCL_OK) {
|
632 |
return TCL_ERROR;
|
633 |
}
|
634 |
|
635 |
if (d < 0) {
|
636 |
*intPtr = (int) (d - 0.5);
|
637 |
} else {
|
638 |
*intPtr = (int) (d + 0.5);
|
639 |
}
|
640 |
return TCL_OK;
|
641 |
}
|
642 |
/*
|
643 |
*--------------------------------------------------------------
|
644 |
*
|
645 |
* TkGetDoublePixels --
|
646 |
*
|
647 |
* Given a string, returns the number of pixels corresponding
|
648 |
* to that string.
|
649 |
*
|
650 |
* Results:
|
651 |
* The return value is a standard Tcl return result. If
|
652 |
* TCL_OK is returned, then everything went well and the
|
653 |
* pixel distance is stored at *doublePtr; otherwise
|
654 |
* TCL_ERROR is returned and an error message is left in
|
655 |
* interp->result.
|
656 |
*
|
657 |
* Side effects:
|
658 |
* None.
|
659 |
*
|
660 |
*--------------------------------------------------------------
|
661 |
*/
|
662 |
|
663 |
int
|
664 |
TkGetDoublePixels(interp, tkwin, string, doublePtr)
|
665 |
Tcl_Interp *interp; /* Use this for error reporting. */
|
666 |
Tk_Window tkwin; /* Window whose screen determines conversion
|
667 |
* from centimeters and other absolute
|
668 |
* units. */
|
669 |
CONST char *string; /* String describing a number of pixels. */
|
670 |
double *doublePtr; /* Place to store converted result. */
|
671 |
{
|
672 |
char *end;
|
673 |
double d;
|
674 |
|
675 |
d = strtod((char *) string, &end);
|
676 |
if (end == string) {
|
677 |
error:
|
678 |
Tcl_AppendResult(interp, "bad screen distance \"", string,
|
679 |
"\"", (char *) NULL);
|
680 |
return TCL_ERROR;
|
681 |
}
|
682 |
while ((*end != '\0') && isspace(UCHAR(*end))) {
|
683 |
end++;
|
684 |
}
|
685 |
switch (*end) {
|
686 |
case 0:
|
687 |
break;
|
688 |
case 'c':
|
689 |
d *= 10*WidthOfScreen(Tk_Screen(tkwin));
|
690 |
d /= WidthMMOfScreen(Tk_Screen(tkwin));
|
691 |
end++;
|
692 |
break;
|
693 |
case 'i':
|
694 |
d *= 25.4*WidthOfScreen(Tk_Screen(tkwin));
|
695 |
d /= WidthMMOfScreen(Tk_Screen(tkwin));
|
696 |
end++;
|
697 |
break;
|
698 |
case 'm':
|
699 |
d *= WidthOfScreen(Tk_Screen(tkwin));
|
700 |
d /= WidthMMOfScreen(Tk_Screen(tkwin));
|
701 |
end++;
|
702 |
break;
|
703 |
case 'p':
|
704 |
d *= (25.4/72.0)*WidthOfScreen(Tk_Screen(tkwin));
|
705 |
d /= WidthMMOfScreen(Tk_Screen(tkwin));
|
706 |
end++;
|
707 |
break;
|
708 |
default:
|
709 |
goto error;
|
710 |
}
|
711 |
while ((*end != '\0') && isspace(UCHAR(*end))) {
|
712 |
end++;
|
713 |
}
|
714 |
if (*end != 0) {
|
715 |
goto error;
|
716 |
}
|
717 |
*doublePtr = d;
|
718 |
return TCL_OK;
|
719 |
}
|
720 |
|
721 |
|
722 |
/* $History: tkGet.c $
|
723 |
*
|
724 |
* ***************** Version 1 *****************
|
725 |
* User: Dtashley Date: 1/02/01 Time: 2:47a
|
726 |
* Created in $/IjuScripter, IjuConsole/Source/Tk Base
|
727 |
* Initial check-in.
|
728 |
*/
|
729 |
|
730 |
/* End of TKGET.C */ |