/[dtapublic]/projs/trunk/shared_source/c_tk_base_7_5_w_mods/tkget.c
ViewVC logotype

Diff of /projs/trunk/shared_source/c_tk_base_7_5_w_mods/tkget.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 44 by dashley, Fri Oct 14 02:09:58 2016 UTC revision 71 by dashley, Sat Nov 5 11:07:06 2016 UTC
# Line 1  Line 1 
 /* $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    /* $Header$ */
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    /* End of tkget.c */
Legend:
Removed from v.44  
changed lines
  Added in v.71
dashley@gmail.com
 ViewVC Help
Powered by ViewVC 1.1.25