shared/tk_base/tkget.c

/* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tk_base/tkget.c,v 1.1.1.1 2001/06/13 05:01:24 dtashley Exp $ */

/* 
 * tkGet.c --
 *
 *      This file contains a number of "Tk_GetXXX" procedures, which
 *      parse text strings into useful forms for Tk.  This file has
 *      the simpler procedures, like Tk_GetDirection and Tk_GetUid.
 *      The more complex procedures like Tk_GetColor are in separate
 *      files.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkget.c,v 1.1.1.1 2001/06/13 05:01:24 dtashley Exp $
 */

#include "tkInt.h"
#include "tkPort.h"

/*
 * One of these structures is created per thread to store 
 * thread-specific data.  In this case, it is used to house the 
 * Tk_Uid structs used by each thread.  The "dataKey" below is 
 * used to locate the ThreadSpecificData for the current thread.
 */

typedef struct ThreadSpecificData {
    int initialized;
    Tcl_HashTable uidTable;
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * The following tables defines the string values for reliefs, which are
 * used by Tk_GetAnchorFromObj and Tk_GetJustifyFromObj.
 */

static char *anchorStrings[] = {"n", "ne", "e", "se", "s", "sw", "w", "nw",
        "center", (char *) NULL};
static char *justifyStrings[] = {"left", "right", "center", (char *) NULL};


/*
 *----------------------------------------------------------------------
 *
 * Tk_GetAnchorFromObj --
 *
 *      Return a Tk_Anchor value based on the value of the objPtr.
 *
 * Results:
 *      The return value is a standard Tcl result. If an error occurs during
 *      conversion, an error message is left in the interpreter's result
 *      unless "interp" is NULL.
 *
 * Side effects:
 *      The object gets converted by Tcl_GetIndexFromObj.
 *
 *----------------------------------------------------------------------
 */

int
Tk_GetAnchorFromObj(interp, objPtr, anchorPtr)
    Tcl_Interp *interp;         /* Used for error reporting. */
    Tcl_Obj *objPtr;            /* The object we are trying to get the 
                                 * value from. */
    Tk_Anchor *anchorPtr;       /* Where to place the Tk_Anchor that
                                 * corresponds to the string value of
                                 * objPtr. */
{
    int index, code;

    code = Tcl_GetIndexFromObj(interp, objPtr, anchorStrings, "anchor", 0, 
            &index);
    if (code == TCL_OK) {
        *anchorPtr = (Tk_Anchor) index;
    }
    return code;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_GetAnchor --
 *
 *      Given a string, return the corresponding Tk_Anchor.
 *
 * Results:
 *      The return value is a standard Tcl return result.  If
 *      TCL_OK is returned, then everything went well and the
 *      position is stored at *anchorPtr;  otherwise TCL_ERROR
 *      is returned and an error message is left in
 *      the interp's result.
 *
 * Side effects:
 *      None.
 *
 *--------------------------------------------------------------
 */

int
Tk_GetAnchor(interp, string, anchorPtr)
    Tcl_Interp *interp;         /* Use this for error reporting. */
    char *string;               /* String describing a direction. */
    Tk_Anchor *anchorPtr;       /* Where to store Tk_Anchor corresponding
                                 * to string. */
{
    switch (string[0]) {
        case 'n':
            if (string[1] == 0) {
                *anchorPtr = TK_ANCHOR_N;
                return TCL_OK;
            } else if ((string[1] == 'e') && (string[2] == 0)) {
                *anchorPtr = TK_ANCHOR_NE;
                return TCL_OK;
            } else if ((string[1] == 'w') && (string[2] == 0)) {
                *anchorPtr = TK_ANCHOR_NW;
                return TCL_OK;
            }
            goto error;
        case 's':
            if (string[1] == 0) {
                *anchorPtr = TK_ANCHOR_S;
                return TCL_OK;
            } else if ((string[1] == 'e') && (string[2] == 0)) {
                *anchorPtr = TK_ANCHOR_SE;
                return TCL_OK;
            } else if ((string[1] == 'w') && (string[2] == 0)) {
                *anchorPtr = TK_ANCHOR_SW;
                return TCL_OK;
            } else {
                goto error;
            }
        case 'e':
            if (string[1] == 0) {
                *anchorPtr = TK_ANCHOR_E;
                return TCL_OK;
            }
            goto error;
        case 'w':
            if (string[1] == 0) {
                *anchorPtr = TK_ANCHOR_W;
                return TCL_OK;
            }
            goto error;
        case 'c':
            if (strncmp(string, "center", strlen(string)) == 0) {
                *anchorPtr = TK_ANCHOR_CENTER;
                return TCL_OK;
            }
            goto error;
    }

    error:
    Tcl_AppendResult(interp, "bad anchor position \"", string,
            "\": must be n, ne, e, se, s, sw, w, nw, or center",
            (char *) NULL);
    return TCL_ERROR;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_NameOfAnchor --
 *
 *      Given a Tk_Anchor, return the string that corresponds
 *      to it.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      None.
 *
 *--------------------------------------------------------------
 */

char *
Tk_NameOfAnchor(anchor)
    Tk_Anchor anchor;           /* Anchor for which identifying string
                                 * is desired. */
{
    switch (anchor) {
        case TK_ANCHOR_N: return "n";
        case TK_ANCHOR_NE: return "ne";
        case TK_ANCHOR_E: return "e";
        case TK_ANCHOR_SE: return "se";
        case TK_ANCHOR_S: return "s";
        case TK_ANCHOR_SW: return "sw";
        case TK_ANCHOR_W: return "w";
        case TK_ANCHOR_NW: return "nw";
        case TK_ANCHOR_CENTER: return "center";
    }
    return "unknown anchor position";
}

/*
 *--------------------------------------------------------------
 *
 * Tk_GetJoinStyle --
 *
 *      Given a string, return the corresponding Tk JoinStyle.
 *
 * Results:
 *      The return value is a standard Tcl return result.  If
 *      TCL_OK is returned, then everything went well and the
 *      justification is stored at *joinPtr;  otherwise
 *      TCL_ERROR is returned and an error message is left in
 *      the interp's result.
 *
 * Side effects:
 *      None.
 *
 *--------------------------------------------------------------
 */

int
Tk_GetJoinStyle(interp, string, joinPtr)
    Tcl_Interp *interp;         /* Use this for error reporting. */
    char *string;               /* String describing a justification style. */
    int *joinPtr;               /* Where to store join style corresponding
                                 * to string. */
{
    int c;
    size_t length;

    c = string[0];
    length = strlen(string);

    if ((c == 'b') && (strncmp(string, "bevel", length) == 0)) {
        *joinPtr = JoinBevel;
        return TCL_OK;
    }
    if ((c == 'm') && (strncmp(string, "miter", length) == 0)) {
        *joinPtr = JoinMiter;
        return TCL_OK;
    }
    if ((c == 'r') && (strncmp(string, "round", length) == 0)) {
        *joinPtr = JoinRound;
        return TCL_OK;
    }

    Tcl_AppendResult(interp, "bad join style \"", string,
            "\": must be bevel, miter, or round",
            (char *) NULL);
    return TCL_ERROR;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_NameOfJoinStyle --
 *
 *      Given a Tk JoinStyle, return the string that corresponds
 *      to it.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      None.
 *
 *--------------------------------------------------------------
 */

char *
Tk_NameOfJoinStyle(join)
    int join;                   /* Join style for which identifying string
                                 * is desired. */
{
    switch (join) {
        case JoinBevel: return "bevel";
        case JoinMiter: return "miter";
        case JoinRound: return "round";
    }
    return "unknown join style";
}

/*
 *--------------------------------------------------------------
 *
 * Tk_GetCapStyle --
 *
 *      Given a string, return the corresponding Tk CapStyle.
 *
 * Results:
 *      The return value is a standard Tcl return result.  If
 *      TCL_OK is returned, then everything went well and the
 *      justification is stored at *capPtr;  otherwise
 *      TCL_ERROR is returned and an error message is left in
 *      the interp's result.
 *
 * Side effects:
 *      None.
 *
 *--------------------------------------------------------------
 */

int
Tk_GetCapStyle(interp, string, capPtr)
    Tcl_Interp *interp;         /* Use this for error reporting. */
    char *string;               /* String describing a justification style. */
    int *capPtr;                /* Where to store cap style corresponding
                                 * to string. */
{
    int c;
    size_t length;

    c = string[0];
    length = strlen(string);

    if ((c == 'b') && (strncmp(string, "butt", length) == 0)) {
        *capPtr = CapButt;
        return TCL_OK;
    }
    if ((c == 'p') && (strncmp(string, "projecting", length) == 0)) {
        *capPtr = CapProjecting;
        return TCL_OK;
    }
    if ((c == 'r') && (strncmp(string, "round", length) == 0)) {
        *capPtr = CapRound;
        return TCL_OK;
    }

    Tcl_AppendResult(interp, "bad cap style \"", string,
            "\": must be butt, projecting, or round",
            (char *) NULL);
    return TCL_ERROR;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_NameOfCapStyle --
 *
 *      Given a Tk CapStyle, return the string that corresponds
 *      to it.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      None.
 *
 *--------------------------------------------------------------
 */

char *
Tk_NameOfCapStyle(cap)
    int cap;                    /* Cap style for which identifying string
                                 * is desired. */
{
    switch (cap) {
        case CapButt: return "butt";
        case CapProjecting: return "projecting";
        case CapRound: return "round";
    }
    return "unknown cap style";
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_GetJustifyFromObj --
 *
 *      Return a Tk_Justify value based on the value of the objPtr.
 *
 * Results:
 *      The return value is a standard Tcl result. If an error occurs during
 *      conversion, an error message is left in the interpreter's result
 *      unless "interp" is NULL.
 *
 * Side effects:
 *      The object gets converted by Tcl_GetIndexFromObj.
 *
 *----------------------------------------------------------------------
 */

int
Tk_GetJustifyFromObj(interp, objPtr, justifyPtr)
    Tcl_Interp *interp;         /* Used for error reporting. */
    Tcl_Obj *objPtr;            /* The object we are trying to get the 
                                 * value from. */
    Tk_Justify *justifyPtr;     /* Where to place the Tk_Justify that
                                 * corresponds to the string value of
                                 * objPtr. */
{
    int index, code;

    code = Tcl_GetIndexFromObj(interp, objPtr, justifyStrings,
            "justification", 0, &index);
    if (code == TCL_OK) {
        *justifyPtr = (Tk_Justify) index;
    }
    return code;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_GetJustify --
 *
 *      Given a string, return the corresponding Tk_Justify.
 *
 * Results:
 *      The return value is a standard Tcl return result.  If
 *      TCL_OK is returned, then everything went well and the
 *      justification is stored at *justifyPtr;  otherwise
 *      TCL_ERROR is returned and an error message is left in
 *      the interp's result.
 *
 * Side effects:
 *      None.
 *
 *--------------------------------------------------------------
 */

int
Tk_GetJustify(interp, string, justifyPtr)
    Tcl_Interp *interp;         /* Use this for error reporting. */
    char *string;               /* String describing a justification style. */
    Tk_Justify *justifyPtr;     /* Where to store Tk_Justify corresponding
                                 * to string. */
{
    int c;
    size_t length;

    c = string[0];
    length = strlen(string);

    if ((c == 'l') && (strncmp(string, "left", length) == 0)) {
        *justifyPtr = TK_JUSTIFY_LEFT;
        return TCL_OK;
    }
    if ((c == 'r') && (strncmp(string, "right", length) == 0)) {
        *justifyPtr = TK_JUSTIFY_RIGHT;
        return TCL_OK;
    }
    if ((c == 'c') && (strncmp(string, "center", length) == 0)) {
        *justifyPtr = TK_JUSTIFY_CENTER;
        return TCL_OK;
    }

    Tcl_AppendResult(interp, "bad justification \"", string,
            "\": must be left, right, or center",
            (char *) NULL);
    return TCL_ERROR;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_NameOfJustify --
 *
 *      Given a Tk_Justify, return the string that corresponds
 *      to it.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      None.
 *
 *--------------------------------------------------------------
 */

char *
Tk_NameOfJustify(justify)
    Tk_Justify justify;         /* Justification style for which
                                 * identifying string is desired. */
{
    switch (justify) {
        case TK_JUSTIFY_LEFT: return "left";
        case TK_JUSTIFY_RIGHT: return "right";
        case TK_JUSTIFY_CENTER: return "center";
    }
    return "unknown justification style";
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_GetUid --
 *
 *      Given a string, this procedure returns a unique identifier
 *      for the string.
 *
 * Results:
 *      This procedure returns a Tk_Uid corresponding to the "string"
 *      argument.  The Tk_Uid has a string value identical to string
 *      (strcmp will return 0), but it's guaranteed that any other
 *      calls to this procedure with a string equal to "string" will
 *      return exactly the same result (i.e. can compare Tk_Uid
 *      *values* directly, without having to call strcmp on what they
 *      point to).
 *
 * Side effects:
 *      New information may be entered into the identifier table.
 *
 *----------------------------------------------------------------------
 */

Tk_Uid
Tk_GetUid(string)
    CONST char *string;         /* String to convert. */
{
    int dummy;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    Tcl_HashTable *tablePtr = &tsdPtr->uidTable;

    if (!tsdPtr->initialized) {
        Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS);
        tsdPtr->initialized = 1;
    }
    return (Tk_Uid) Tcl_GetHashKey(tablePtr,
            Tcl_CreateHashEntry(tablePtr, string, &dummy));
}

/*
 *--------------------------------------------------------------
 *
 * Tk_GetScreenMM --
 *
 *      Given a string, returns the number of screen millimeters
 *      corresponding to that string.
 *
 * Results:
 *      The return value is a standard Tcl return result.  If
 *      TCL_OK is returned, then everything went well and the
 *      screen distance is stored at *doublePtr;  otherwise
 *      TCL_ERROR is returned and an error message is left in
 *      the interp's result.
 *
 * Side effects:
 *      None.
 *
 *--------------------------------------------------------------
 */

int
Tk_GetScreenMM(interp, tkwin, string, doublePtr)
    Tcl_Interp *interp;         /* Use this for error reporting. */
    Tk_Window tkwin;            /* Window whose screen determines conversion
                                 * from centimeters and other absolute
                                 * units. */
    char *string;               /* String describing a screen distance. */
    double *doublePtr;          /* Place to store converted result. */
{
    char *end;
    double d;

    d = strtod(string, &end);
    if (end == string) {
        error:
        Tcl_AppendResult(interp, "bad screen distance \"", string,
                "\"", (char *) NULL);
        return TCL_ERROR;
    }
    while ((*end != '\0') && isspace(UCHAR(*end))) {
        end++;
    }
    switch (*end) {
        case 0:
            d /= WidthOfScreen(Tk_Screen(tkwin));
            d *= WidthMMOfScreen(Tk_Screen(tkwin));
            break;
        case 'c':
            d *= 10;
            end++;
            break;
        case 'i':
            d *= 25.4;
            end++;
            break;
        case 'm':
            end++;
            break;
        case 'p':
            d *= 25.4/72.0;
            end++;
            break;
        default:
            goto error;
    }
    while ((*end != '\0') && isspace(UCHAR(*end))) {
        end++;
    }
    if (*end != 0) {
        goto error;
    }
    *doublePtr = d;
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_GetPixels --
 *
 *      Given a string, returns the number of pixels corresponding
 *      to that string.
 *
 * Results:
 *      The return value is a standard Tcl return result.  If
 *      TCL_OK is returned, then everything went well and the
 *      rounded pixel distance is stored at *intPtr;  otherwise
 *      TCL_ERROR is returned and an error message is left in
 *      the interp's result.
 *
 * Side effects:
 *      None.
 *
 *--------------------------------------------------------------
 */

int
Tk_GetPixels(interp, tkwin, string, intPtr)
    Tcl_Interp *interp;         /* Use this for error reporting. */
    Tk_Window tkwin;            /* Window whose screen determines conversion
                                 * from centimeters and other absolute
                                 * units. */
    char *string;               /* String describing a number of pixels. */
    int *intPtr;                /* Place to store converted result. */
{
    double d;

    if (TkGetDoublePixels(interp, tkwin, string, &d) != TCL_OK) {
        return TCL_ERROR;
    }

    if (d < 0) {
        *intPtr = (int) (d - 0.5);
    } else {
        *intPtr = (int) (d + 0.5);
    }
    return TCL_OK;
}
/*
 *--------------------------------------------------------------
 *
 * TkGetDoublePixels --
 *
 *      Given a string, returns the number of pixels corresponding
 *      to that string.
 *
 * Results:
 *      The return value is a standard Tcl return result.  If
 *      TCL_OK is returned, then everything went well and the
 *      pixel distance is stored at *doublePtr;  otherwise
 *      TCL_ERROR is returned and an error message is left in
 *      interp->result.
 *
 * Side effects:
 *      None.
 *
 *--------------------------------------------------------------
 */

int
TkGetDoublePixels(interp, tkwin, string, doublePtr)
    Tcl_Interp *interp;         /* Use this for error reporting. */
    Tk_Window tkwin;            /* Window whose screen determines conversion
                                 * from centimeters and other absolute
                                 * units. */
    CONST char *string;         /* String describing a number of pixels. */
    double *doublePtr;          /* Place to store converted result. */
{
    char *end;
    double d;

    d = strtod((char *) string, &end);
    if (end == string) {
        error:
        Tcl_AppendResult(interp, "bad screen distance \"", string,
                "\"", (char *) NULL);
        return TCL_ERROR;
    }
    while ((*end != '\0') && isspace(UCHAR(*end))) {
        end++;
    }
    switch (*end) {
        case 0:
            break;
        case 'c':
            d *= 10*WidthOfScreen(Tk_Screen(tkwin));
            d /= WidthMMOfScreen(Tk_Screen(tkwin));
            end++;
            break;
        case 'i':
            d *= 25.4*WidthOfScreen(Tk_Screen(tkwin));
            d /= WidthMMOfScreen(Tk_Screen(tkwin));
            end++;
            break;
        case 'm':
            d *= WidthOfScreen(Tk_Screen(tkwin));
            d /= WidthMMOfScreen(Tk_Screen(tkwin));
            end++;
            break;
        case 'p':
            d *= (25.4/72.0)*WidthOfScreen(Tk_Screen(tkwin));
            d /= WidthMMOfScreen(Tk_Screen(tkwin));
            end++;
            break;
        default:
            goto error;
    }
    while ((*end != '\0') && isspace(UCHAR(*end))) {
        end++;
    }
    if (*end != 0) {
        goto error;
    }
    *doublePtr = d;
    return TCL_OK;
}


/* $History: tkGet.c $
 * 
 * *****************  Version 1  *****************
 * User: Dtashley     Date: 1/02/01    Time: 2:47a
 * Created in $/IjuScripter, IjuConsole/Source/Tk Base
 * Initial check-in.
 */

/* End of TKGET.C */
1	dashley	25	/* $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 = 10WidthOfScreen(Tk_Screen(tkwin));
690			d /= WidthMMOfScreen(Tk_Screen(tkwin));
691			end++;
692			break;
693			case 'i':
694			d = 25.4WidthOfScreen(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 */