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

Diff of /projs/dtats/trunk/shared_source/c_tk_base_7_5_w_mods/tkobj.c

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

revision 69 by dashley, Sat Nov 5 10:54:17 2016 UTC revision 71 by dashley, Sat Nov 5 11:07:06 2016 UTC
# Line 1  Line 1 
1  /* $Header$ */  /* $Header$ */
2    
3  /*  /*
4   * tkObj.c --   * tkObj.c --
5   *   *
6   *      This file contains procedures that implement the common Tk object   *      This file contains procedures that implement the common Tk object
7   *      types   *      types
8   *   *
9   * Copyright (c) 1997 Sun Microsystems, Inc.   * Copyright (c) 1997 Sun Microsystems, Inc.
10   *   *
11   * See the file "license.terms" for information on usage and redistribution   * See the file "license.terms" for information on usage and redistribution
12   * of this file, and for a DISCLAIMER OF ALL WARRANTIES.   * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13   *   *
14   * RCS: @(#) $Id: tkobj.c,v 1.1.1.1 2001/06/13 05:06:19 dtashley Exp $   * RCS: @(#) $Id: tkobj.c,v 1.1.1.1 2001/06/13 05:06:19 dtashley Exp $
15   */   */
16    
17  #include "tkInt.h"  #include "tkInt.h"
18    
19  /*  /*
20   * The following structure is the internal representation for pixel objects.   * The following structure is the internal representation for pixel objects.
21   */   */
22    
23  typedef struct PixelRep {  typedef struct PixelRep {
24      double value;      double value;
25      int units;      int units;
26      Tk_Window tkwin;      Tk_Window tkwin;
27      int returnValue;      int returnValue;
28  } PixelRep;  } PixelRep;
29    
30  #define SIMPLE_PIXELREP(objPtr)                         \  #define SIMPLE_PIXELREP(objPtr)                         \
31      ((objPtr)->internalRep.twoPtrValue.ptr2 == 0)      ((objPtr)->internalRep.twoPtrValue.ptr2 == 0)
32    
33  #define SET_SIMPLEPIXEL(objPtr, intval)                 \  #define SET_SIMPLEPIXEL(objPtr, intval)                 \
34      (objPtr)->internalRep.twoPtrValue.ptr1 = (VOID *) (intval); \      (objPtr)->internalRep.twoPtrValue.ptr1 = (VOID *) (intval); \
35      (objPtr)->internalRep.twoPtrValue.ptr2 = 0      (objPtr)->internalRep.twoPtrValue.ptr2 = 0
36    
37  #define GET_SIMPLEPIXEL(objPtr)                         \  #define GET_SIMPLEPIXEL(objPtr)                         \
38      ((int) (objPtr)->internalRep.twoPtrValue.ptr1)      ((int) (objPtr)->internalRep.twoPtrValue.ptr1)
39    
40  #define SET_COMPLEXPIXEL(objPtr, repPtr)                \  #define SET_COMPLEXPIXEL(objPtr, repPtr)                \
41      (objPtr)->internalRep.twoPtrValue.ptr1 = 0;         \      (objPtr)->internalRep.twoPtrValue.ptr1 = 0;         \
42      (objPtr)->internalRep.twoPtrValue.ptr2 = (VOID *) repPtr      (objPtr)->internalRep.twoPtrValue.ptr2 = (VOID *) repPtr
43    
44  #define GET_COMPLEXPIXEL(objPtr)                        \  #define GET_COMPLEXPIXEL(objPtr)                        \
45      ((PixelRep *) (objPtr)->internalRep.twoPtrValue.ptr2)      ((PixelRep *) (objPtr)->internalRep.twoPtrValue.ptr2)
46    
47    
48  /*  /*
49   * The following structure is the internal representation for mm objects.   * The following structure is the internal representation for mm objects.
50   */   */
51    
52  typedef struct MMRep {  typedef struct MMRep {
53      double value;      double value;
54      int units;      int units;
55      Tk_Window tkwin;      Tk_Window tkwin;
56      double returnValue;      double returnValue;
57  } MMRep;  } MMRep;
58    
59  /*  /*
60   * Prototypes for procedures defined later in this file:   * Prototypes for procedures defined later in this file:
61   */   */
62    
63  static void             DupMMInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,  static void             DupMMInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
64                              Tcl_Obj *copyPtr));                              Tcl_Obj *copyPtr));
65  static void             DupPixelInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,  static void             DupPixelInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
66                              Tcl_Obj *copyPtr));                              Tcl_Obj *copyPtr));
67  static void             FreeMMInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));  static void             FreeMMInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
68  static void             FreePixelInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));  static void             FreePixelInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
69  static int              SetMMFromAny _ANSI_ARGS_((Tcl_Interp *interp,  static int              SetMMFromAny _ANSI_ARGS_((Tcl_Interp *interp,
70                              Tcl_Obj *objPtr));                              Tcl_Obj *objPtr));
71  static int              SetPixelFromAny _ANSI_ARGS_((Tcl_Interp *interp,  static int              SetPixelFromAny _ANSI_ARGS_((Tcl_Interp *interp,
72                              Tcl_Obj *objPtr));                              Tcl_Obj *objPtr));
73  static int              SetWindowFromAny _ANSI_ARGS_((Tcl_Interp *interp,  static int              SetWindowFromAny _ANSI_ARGS_((Tcl_Interp *interp,
74                              Tcl_Obj *objPtr));                              Tcl_Obj *objPtr));
75                                                    
76  /*  /*
77   * The following structure defines the implementation of the "pixel"   * The following structure defines the implementation of the "pixel"
78   * Tcl object, used for measuring distances.  The pixel object remembers   * Tcl object, used for measuring distances.  The pixel object remembers
79   * its initial display-independant settings.   * its initial display-independant settings.
80   */   */
81    
82  static Tcl_ObjType pixelObjType = {  static Tcl_ObjType pixelObjType = {
83      "pixel",                    /* name */      "pixel",                    /* name */
84      FreePixelInternalRep,       /* freeIntRepProc */      FreePixelInternalRep,       /* freeIntRepProc */
85      DupPixelInternalRep,        /* dupIntRepProc */      DupPixelInternalRep,        /* dupIntRepProc */
86      NULL,                       /* updateStringProc */      NULL,                       /* updateStringProc */
87      SetPixelFromAny             /* setFromAnyProc */      SetPixelFromAny             /* setFromAnyProc */
88  };  };
89    
90  /*  /*
91   * The following structure defines the implementation of the "pixel"   * The following structure defines the implementation of the "pixel"
92   * Tcl object, used for measuring distances.  The pixel object remembers   * Tcl object, used for measuring distances.  The pixel object remembers
93   * its initial display-independant settings.   * its initial display-independant settings.
94   */   */
95    
96  static Tcl_ObjType mmObjType = {  static Tcl_ObjType mmObjType = {
97      "mm",                       /* name */      "mm",                       /* name */
98      FreeMMInternalRep,          /* freeIntRepProc */      FreeMMInternalRep,          /* freeIntRepProc */
99      DupMMInternalRep,           /* dupIntRepProc */      DupMMInternalRep,           /* dupIntRepProc */
100      NULL,                       /* updateStringProc */      NULL,                       /* updateStringProc */
101      SetMMFromAny                /* setFromAnyProc */      SetMMFromAny                /* setFromAnyProc */
102  };  };
103    
104  /*  /*
105   * The following structure defines the implementation of the "window"   * The following structure defines the implementation of the "window"
106   * Tcl object.   * Tcl object.
107   */   */
108    
109  static Tcl_ObjType windowObjType = {  static Tcl_ObjType windowObjType = {
110      "window",                           /* name */      "window",                           /* name */
111      (Tcl_FreeInternalRepProc *) NULL,   /* freeIntRepProc */      (Tcl_FreeInternalRepProc *) NULL,   /* freeIntRepProc */
112      (Tcl_DupInternalRepProc *) NULL,    /* dupIntRepProc */      (Tcl_DupInternalRepProc *) NULL,    /* dupIntRepProc */
113      NULL,                               /* updateStringProc */      NULL,                               /* updateStringProc */
114      SetWindowFromAny                    /* setFromAnyProc */      SetWindowFromAny                    /* setFromAnyProc */
115  };  };
116    
117    
118    
119  /*  /*
120   *----------------------------------------------------------------------   *----------------------------------------------------------------------
121   *   *
122   * Tk_GetPixelsFromObj --   * Tk_GetPixelsFromObj --
123   *   *
124   *      Attempt to return a pixel value from the Tcl object "objPtr". If the   *      Attempt to return a pixel value from the Tcl object "objPtr". If the
125   *      object is not already a pixel value, an attempt will be made to convert   *      object is not already a pixel value, an attempt will be made to convert
126   *      it to one.   *      it to one.
127   *   *
128   * Results:   * Results:
129   *      The return value is a standard Tcl object result. If an error occurs   *      The return value is a standard Tcl object result. If an error occurs
130   *      during conversion, an error message is left in the interpreter's   *      during conversion, an error message is left in the interpreter's
131   *      result unless "interp" is NULL.   *      result unless "interp" is NULL.
132   *   *
133   * Side effects:   * Side effects:
134   *      If the object is not already a pixel, the conversion will free   *      If the object is not already a pixel, the conversion will free
135   *      any old internal representation.   *      any old internal representation.
136   *   *
137   *----------------------------------------------------------------------   *----------------------------------------------------------------------
138   */   */
139    
140  int  int
141  Tk_GetPixelsFromObj(interp, tkwin, objPtr, intPtr)  Tk_GetPixelsFromObj(interp, tkwin, objPtr, intPtr)
142      Tcl_Interp *interp;         /* Used for error reporting if not NULL. */      Tcl_Interp *interp;         /* Used for error reporting if not NULL. */
143      Tk_Window tkwin;      Tk_Window tkwin;
144      Tcl_Obj *objPtr;            /* The object from which to get pixels. */      Tcl_Obj *objPtr;            /* The object from which to get pixels. */
145      int *intPtr;                /* Place to store resulting pixels. */      int *intPtr;                /* Place to store resulting pixels. */
146  {  {
147      int result;      int result;
148      double d;      double d;
149      PixelRep *pixelPtr;      PixelRep *pixelPtr;
150      static double bias[] = {      static double bias[] = {
151          1.0,    10.0,   25.4,   25.4 / 72.0          1.0,    10.0,   25.4,   25.4 / 72.0
152      };      };
153    
154      if (objPtr->typePtr != &pixelObjType) {      if (objPtr->typePtr != &pixelObjType) {
155          result = SetPixelFromAny(interp, objPtr);          result = SetPixelFromAny(interp, objPtr);
156          if (result != TCL_OK) {          if (result != TCL_OK) {
157              return result;              return result;
158          }          }
159      }      }
160    
161      if (SIMPLE_PIXELREP(objPtr)) {      if (SIMPLE_PIXELREP(objPtr)) {
162          *intPtr = GET_SIMPLEPIXEL(objPtr);          *intPtr = GET_SIMPLEPIXEL(objPtr);
163      } else {      } else {
164          pixelPtr = GET_COMPLEXPIXEL(objPtr);          pixelPtr = GET_COMPLEXPIXEL(objPtr);
165          if (pixelPtr->tkwin != tkwin) {          if (pixelPtr->tkwin != tkwin) {
166              d = pixelPtr->value;              d = pixelPtr->value;
167              if (pixelPtr->units >= 0) {              if (pixelPtr->units >= 0) {
168                  d *= bias[pixelPtr->units] * WidthOfScreen(Tk_Screen(tkwin));                  d *= bias[pixelPtr->units] * WidthOfScreen(Tk_Screen(tkwin));
169                  d /= WidthMMOfScreen(Tk_Screen(tkwin));                  d /= WidthMMOfScreen(Tk_Screen(tkwin));
170              }              }
171              if (d < 0) {              if (d < 0) {
172                  pixelPtr->returnValue = (int) (d - 0.5);                  pixelPtr->returnValue = (int) (d - 0.5);
173              } else {              } else {
174                  pixelPtr->returnValue = (int) (d + 0.5);                  pixelPtr->returnValue = (int) (d + 0.5);
175              }              }
176              pixelPtr->tkwin = tkwin;              pixelPtr->tkwin = tkwin;
177          }          }
178          *intPtr = pixelPtr->returnValue;          *intPtr = pixelPtr->returnValue;
179      }      }
180      return TCL_OK;      return TCL_OK;
181  }  }
182    
183  /*  /*
184   *----------------------------------------------------------------------   *----------------------------------------------------------------------
185   *   *
186   * FreePixelInternalRep --   * FreePixelInternalRep --
187   *   *
188   *      Deallocate the storage associated with a pixel object's internal   *      Deallocate the storage associated with a pixel object's internal
189   *      representation.   *      representation.
190   *   *
191   * Results:   * Results:
192   *      None.   *      None.
193   *   *
194   * Side effects:   * Side effects:
195   *      Frees objPtr's internal representation and sets objPtr's   *      Frees objPtr's internal representation and sets objPtr's
196   *      internalRep to NULL.   *      internalRep to NULL.
197   *   *
198   *----------------------------------------------------------------------   *----------------------------------------------------------------------
199   */   */
200    
201  static void  static void
202  FreePixelInternalRep(objPtr)  FreePixelInternalRep(objPtr)
203      Tcl_Obj *objPtr;            /* Pixel object with internal rep to free. */      Tcl_Obj *objPtr;            /* Pixel object with internal rep to free. */
204  {  {
205      PixelRep *pixelPtr;      PixelRep *pixelPtr;
206            
207      if (!SIMPLE_PIXELREP(objPtr)) {      if (!SIMPLE_PIXELREP(objPtr)) {
208          pixelPtr = GET_COMPLEXPIXEL(objPtr);          pixelPtr = GET_COMPLEXPIXEL(objPtr);
209          ckfree((char *) pixelPtr);          ckfree((char *) pixelPtr);
210      }      }
211      SET_SIMPLEPIXEL(objPtr, 0);      SET_SIMPLEPIXEL(objPtr, 0);
212  }  }
213    
214  /*  /*
215   *----------------------------------------------------------------------   *----------------------------------------------------------------------
216   *   *
217   * DupPixelInternalRep --   * DupPixelInternalRep --
218   *   *
219   *      Initialize the internal representation of a pixel Tcl_Obj to a   *      Initialize the internal representation of a pixel Tcl_Obj to a
220   *      copy of the internal representation of an existing pixel object.   *      copy of the internal representation of an existing pixel object.
221   *   *
222   * Results:   * Results:
223   *      None.   *      None.
224   *   *
225   * Side effects:   * Side effects:
226   *      copyPtr's internal rep is set to the pixel corresponding to   *      copyPtr's internal rep is set to the pixel corresponding to
227   *      srcPtr's internal rep.   *      srcPtr's internal rep.
228   *   *
229   *----------------------------------------------------------------------   *----------------------------------------------------------------------
230   */   */
231    
232  static void  static void
233  DupPixelInternalRep(srcPtr, copyPtr)  DupPixelInternalRep(srcPtr, copyPtr)
234      register Tcl_Obj *srcPtr;   /* Object with internal rep to copy. */      register Tcl_Obj *srcPtr;   /* Object with internal rep to copy. */
235      register Tcl_Obj *copyPtr;  /* Object with internal rep to set. */      register Tcl_Obj *copyPtr;  /* Object with internal rep to set. */
236  {  {
237      PixelRep *oldPtr, *newPtr;      PixelRep *oldPtr, *newPtr;
238            
239      copyPtr->typePtr = srcPtr->typePtr;      copyPtr->typePtr = srcPtr->typePtr;
240    
241      if (SIMPLE_PIXELREP(srcPtr)) {      if (SIMPLE_PIXELREP(srcPtr)) {
242          SET_SIMPLEPIXEL(copyPtr, GET_SIMPLEPIXEL(srcPtr));          SET_SIMPLEPIXEL(copyPtr, GET_SIMPLEPIXEL(srcPtr));
243      } else {      } else {
244          oldPtr = GET_COMPLEXPIXEL(srcPtr);          oldPtr = GET_COMPLEXPIXEL(srcPtr);
245          newPtr = (PixelRep *) ckalloc(sizeof(PixelRep));          newPtr = (PixelRep *) ckalloc(sizeof(PixelRep));
246          newPtr->value = oldPtr->value;          newPtr->value = oldPtr->value;
247          newPtr->units = oldPtr->units;          newPtr->units = oldPtr->units;
248          newPtr->tkwin = oldPtr->tkwin;          newPtr->tkwin = oldPtr->tkwin;
249          newPtr->returnValue = oldPtr->returnValue;          newPtr->returnValue = oldPtr->returnValue;
250          SET_COMPLEXPIXEL(copyPtr, newPtr);          SET_COMPLEXPIXEL(copyPtr, newPtr);
251      }      }
252  }  }
253    
254  /*  /*
255   *----------------------------------------------------------------------   *----------------------------------------------------------------------
256   *   *
257   * SetPixelFromAny --   * SetPixelFromAny --
258   *   *
259   *      Attempt to generate a pixel internal form for the Tcl object   *      Attempt to generate a pixel internal form for the Tcl object
260   *      "objPtr".   *      "objPtr".
261   *   *
262   * Results:   * Results:
263   *      The return value is a standard Tcl result. If an error occurs during   *      The return value is a standard Tcl result. If an error occurs during
264   *      conversion, an error message is left in the interpreter's result   *      conversion, an error message is left in the interpreter's result
265   *      unless "interp" is NULL.   *      unless "interp" is NULL.
266   *   *
267   * Side effects:   * Side effects:
268   *      If no error occurs, a pixel representation of the object is   *      If no error occurs, a pixel representation of the object is
269   *      stored internally and the type of "objPtr" is set to pixel.   *      stored internally and the type of "objPtr" is set to pixel.
270   *   *
271   *----------------------------------------------------------------------   *----------------------------------------------------------------------
272   */   */
273    
274  static int  static int
275  SetPixelFromAny(interp, objPtr)  SetPixelFromAny(interp, objPtr)
276      Tcl_Interp *interp;         /* Used for error reporting if not NULL. */      Tcl_Interp *interp;         /* Used for error reporting if not NULL. */
277      Tcl_Obj *objPtr;            /* The object to convert. */      Tcl_Obj *objPtr;            /* The object to convert. */
278  {  {
279      Tcl_ObjType *typePtr;      Tcl_ObjType *typePtr;
280      char *string, *rest;      char *string, *rest;
281      double d;      double d;
282      int i, units;      int i, units;
283      PixelRep *pixelPtr;      PixelRep *pixelPtr;
284    
285      string = Tcl_GetStringFromObj(objPtr, NULL);      string = Tcl_GetStringFromObj(objPtr, NULL);
286    
287      d = strtod(string, &rest);      d = strtod(string, &rest);
288      if (rest == string) {      if (rest == string) {
289          /*          /*
290           * Must copy string before resetting the result in case a caller           * Must copy string before resetting the result in case a caller
291           * is trying to convert the interpreter's result to pixels.           * is trying to convert the interpreter's result to pixels.
292           */           */
293    
294          char buf[100];          char buf[100];
295    
296          error:          error:
297          sprintf(buf, "bad screen distance \"%.50s\"", string);          sprintf(buf, "bad screen distance \"%.50s\"", string);
298          Tcl_ResetResult(interp);          Tcl_ResetResult(interp);
299          Tcl_AppendResult(interp, buf, NULL);          Tcl_AppendResult(interp, buf, NULL);
300          return TCL_ERROR;          return TCL_ERROR;
301      }      }
302      while ((*rest != '\0') && isspace(UCHAR(*rest))) {      while ((*rest != '\0') && isspace(UCHAR(*rest))) {
303          rest++;          rest++;
304      }      }
305      switch (*rest) {      switch (*rest) {
306          case '\0':          case '\0':
307              units = -1;              units = -1;
308              break;              break;
309    
310          case 'm':          case 'm':
311              units = 0;              units = 0;
312              break;              break;
313    
314          case 'c':          case 'c':
315              units = 1;              units = 1;
316              break;              break;
317    
318          case 'i':          case 'i':
319              units = 2;              units = 2;
320              break;              break;
321    
322          case 'p':          case 'p':
323              units = 3;              units = 3;
324              break;              break;
325    
326          default:          default:
327              goto error;              goto error;
328      }      }
329    
330      /*      /*
331       * Free the old internalRep before setting the new one.       * Free the old internalRep before setting the new one.
332       */       */
333    
334      typePtr = objPtr->typePtr;      typePtr = objPtr->typePtr;
335      if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {      if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
336          (*typePtr->freeIntRepProc)(objPtr);          (*typePtr->freeIntRepProc)(objPtr);
337      }      }
338    
339      objPtr->typePtr = &pixelObjType;      objPtr->typePtr = &pixelObjType;
340    
341      i = (int) d;      i = (int) d;
342      if ((units < 0) && (i == d)) {      if ((units < 0) && (i == d)) {
343          SET_SIMPLEPIXEL(objPtr, i);          SET_SIMPLEPIXEL(objPtr, i);
344      } else {      } else {
345          pixelPtr = (PixelRep *) ckalloc(sizeof(PixelRep));          pixelPtr = (PixelRep *) ckalloc(sizeof(PixelRep));
346          pixelPtr->value = d;          pixelPtr->value = d;
347          pixelPtr->units = units;          pixelPtr->units = units;
348          pixelPtr->tkwin = NULL;          pixelPtr->tkwin = NULL;
349          pixelPtr->returnValue = i;          pixelPtr->returnValue = i;
350          SET_COMPLEXPIXEL(objPtr, pixelPtr);          SET_COMPLEXPIXEL(objPtr, pixelPtr);
351      }      }
352      return TCL_OK;      return TCL_OK;
353  }  }
354    
355  /*  /*
356   *----------------------------------------------------------------------   *----------------------------------------------------------------------
357   *   *
358   * Tk_GetMMFromObj --   * Tk_GetMMFromObj --
359   *   *
360   *      Attempt to return an mm value from the Tcl object "objPtr". If the   *      Attempt to return an mm value from the Tcl object "objPtr". If the
361   *      object is not already an mm value, an attempt will be made to convert   *      object is not already an mm value, an attempt will be made to convert
362   *      it to one.   *      it to one.
363   *   *
364   * Results:   * Results:
365   *      The return value is a standard Tcl object result. If an error occurs   *      The return value is a standard Tcl object result. If an error occurs
366   *      during conversion, an error message is left in the interpreter's   *      during conversion, an error message is left in the interpreter's
367   *      result unless "interp" is NULL.   *      result unless "interp" is NULL.
368   *   *
369   * Side effects:   * Side effects:
370   *      If the object is not already a pixel, the conversion will free   *      If the object is not already a pixel, the conversion will free
371   *      any old internal representation.   *      any old internal representation.
372   *   *
373   *----------------------------------------------------------------------   *----------------------------------------------------------------------
374   */   */
375    
376  int  int
377  Tk_GetMMFromObj(interp, tkwin, objPtr, doublePtr)  Tk_GetMMFromObj(interp, tkwin, objPtr, doublePtr)
378      Tcl_Interp *interp;         /* Used for error reporting if not NULL. */      Tcl_Interp *interp;         /* Used for error reporting if not NULL. */
379      Tk_Window tkwin;      Tk_Window tkwin;
380      Tcl_Obj *objPtr;            /* The object from which to get mms. */      Tcl_Obj *objPtr;            /* The object from which to get mms. */
381      double *doublePtr;          /* Place to store resulting millimeters. */      double *doublePtr;          /* Place to store resulting millimeters. */
382  {  {
383      int result;      int result;
384      double d;      double d;
385      MMRep *mmPtr;      MMRep *mmPtr;
386      static double bias[] = {      static double bias[] = {
387          10.0,   25.4,   1.0,    25.4 / 72.0          10.0,   25.4,   1.0,    25.4 / 72.0
388      };      };
389    
390      if (objPtr->typePtr != &mmObjType) {      if (objPtr->typePtr != &mmObjType) {
391          result = SetMMFromAny(interp, objPtr);          result = SetMMFromAny(interp, objPtr);
392          if (result != TCL_OK) {          if (result != TCL_OK) {
393              return result;              return result;
394          }          }
395      }      }
396    
397      mmPtr = (MMRep *) objPtr->internalRep.otherValuePtr;      mmPtr = (MMRep *) objPtr->internalRep.otherValuePtr;
398      if (mmPtr->tkwin != tkwin) {      if (mmPtr->tkwin != tkwin) {
399          d = mmPtr->value;          d = mmPtr->value;
400          if (mmPtr->units == -1) {          if (mmPtr->units == -1) {
401              d /= WidthOfScreen(Tk_Screen(tkwin));              d /= WidthOfScreen(Tk_Screen(tkwin));
402              d *= WidthMMOfScreen(Tk_Screen(tkwin));              d *= WidthMMOfScreen(Tk_Screen(tkwin));
403          } else {          } else {
404              d *= bias[mmPtr->units];              d *= bias[mmPtr->units];
405          }          }
406          mmPtr->tkwin = tkwin;          mmPtr->tkwin = tkwin;
407          mmPtr->returnValue = d;          mmPtr->returnValue = d;
408      }      }
409      *doublePtr = mmPtr->returnValue;      *doublePtr = mmPtr->returnValue;
410    
411      return TCL_OK;      return TCL_OK;
412  }  }
413    
414  /*  /*
415   *----------------------------------------------------------------------   *----------------------------------------------------------------------
416   *   *
417   * FreeMMInternalRep --   * FreeMMInternalRep --
418   *   *
419   *      Deallocate the storage associated with a mm object's internal   *      Deallocate the storage associated with a mm object's internal
420   *      representation.   *      representation.
421   *   *
422   * Results:   * Results:
423   *      None.   *      None.
424   *   *
425   * Side effects:   * Side effects:
426   *      Frees objPtr's internal representation and sets objPtr's   *      Frees objPtr's internal representation and sets objPtr's
427   *      internalRep to NULL.   *      internalRep to NULL.
428   *   *
429   *----------------------------------------------------------------------   *----------------------------------------------------------------------
430   */   */
431    
432  static void  static void
433  FreeMMInternalRep(objPtr)  FreeMMInternalRep(objPtr)
434      Tcl_Obj *objPtr;            /* MM object with internal rep to free. */      Tcl_Obj *objPtr;            /* MM object with internal rep to free. */
435  {  {
436      ckfree((char *) objPtr->internalRep.otherValuePtr);      ckfree((char *) objPtr->internalRep.otherValuePtr);
437      objPtr->internalRep.otherValuePtr = NULL;      objPtr->internalRep.otherValuePtr = NULL;
438  }  }
439    
440  /*  /*
441   *----------------------------------------------------------------------   *----------------------------------------------------------------------
442   *   *
443   * DupMMInternalRep --   * DupMMInternalRep --
444   *   *
445   *      Initialize the internal representation of a pixel Tcl_Obj to a   *      Initialize the internal representation of a pixel Tcl_Obj to a
446   *      copy of the internal representation of an existing pixel object.   *      copy of the internal representation of an existing pixel object.
447   *   *
448   * Results:   * Results:
449   *      None.   *      None.
450   *   *
451   * Side effects:   * Side effects:
452   *      copyPtr's internal rep is set to the pixel corresponding to   *      copyPtr's internal rep is set to the pixel corresponding to
453   *      srcPtr's internal rep.   *      srcPtr's internal rep.
454   *   *
455   *----------------------------------------------------------------------   *----------------------------------------------------------------------
456   */   */
457    
458  static void  static void
459  DupMMInternalRep(srcPtr, copyPtr)  DupMMInternalRep(srcPtr, copyPtr)
460      register Tcl_Obj *srcPtr;   /* Object with internal rep to copy. */      register Tcl_Obj *srcPtr;   /* Object with internal rep to copy. */
461      register Tcl_Obj *copyPtr;  /* Object with internal rep to set. */      register Tcl_Obj *copyPtr;  /* Object with internal rep to set. */
462  {  {
463      MMRep *oldPtr, *newPtr;      MMRep *oldPtr, *newPtr;
464            
465      copyPtr->typePtr = srcPtr->typePtr;      copyPtr->typePtr = srcPtr->typePtr;
466      oldPtr = (MMRep *) srcPtr->internalRep.otherValuePtr;      oldPtr = (MMRep *) srcPtr->internalRep.otherValuePtr;
467      newPtr = (MMRep *) ckalloc(sizeof(MMRep));      newPtr = (MMRep *) ckalloc(sizeof(MMRep));
468      newPtr->value = oldPtr->value;      newPtr->value = oldPtr->value;
469      newPtr->units = oldPtr->units;      newPtr->units = oldPtr->units;
470      newPtr->tkwin = oldPtr->tkwin;      newPtr->tkwin = oldPtr->tkwin;
471      newPtr->returnValue = oldPtr->returnValue;      newPtr->returnValue = oldPtr->returnValue;
472      copyPtr->internalRep.otherValuePtr = (VOID *) newPtr;      copyPtr->internalRep.otherValuePtr = (VOID *) newPtr;
473  }  }
474    
475  /*  /*
476   *----------------------------------------------------------------------   *----------------------------------------------------------------------
477   *   *
478   * SetMMFromAny --   * SetMMFromAny --
479   *   *
480   *      Attempt to generate a mm internal form for the Tcl object   *      Attempt to generate a mm internal form for the Tcl object
481   *      "objPtr".   *      "objPtr".
482   *   *
483   * Results:   * Results:
484   *      The return value is a standard Tcl result. If an error occurs during   *      The return value is a standard Tcl result. If an error occurs during
485   *      conversion, an error message is left in the interpreter's result   *      conversion, an error message is left in the interpreter's result
486   *      unless "interp" is NULL.   *      unless "interp" is NULL.
487   *   *
488   * Side effects:   * Side effects:
489   *      If no error occurs, a mm representation of the object is   *      If no error occurs, a mm representation of the object is
490   *      stored internally and the type of "objPtr" is set to mm.   *      stored internally and the type of "objPtr" is set to mm.
491   *   *
492   *----------------------------------------------------------------------   *----------------------------------------------------------------------
493   */   */
494    
495  static int  static int
496  SetMMFromAny(interp, objPtr)  SetMMFromAny(interp, objPtr)
497      Tcl_Interp *interp;         /* Used for error reporting if not NULL. */      Tcl_Interp *interp;         /* Used for error reporting if not NULL. */
498      Tcl_Obj *objPtr;            /* The object to convert. */      Tcl_Obj *objPtr;            /* The object to convert. */
499  {  {
500      Tcl_ObjType *typePtr;      Tcl_ObjType *typePtr;
501      char *string, *rest;      char *string, *rest;
502      double d;      double d;
503      int units;      int units;
504      MMRep *mmPtr;      MMRep *mmPtr;
505    
506      string = Tcl_GetStringFromObj(objPtr, NULL);      string = Tcl_GetStringFromObj(objPtr, NULL);
507    
508      d = strtod(string, &rest);      d = strtod(string, &rest);
509      if (rest == string) {      if (rest == string) {
510          /*          /*
511           * Must copy string before resetting the result in case a caller           * Must copy string before resetting the result in case a caller
512           * is trying to convert the interpreter's result to mms.           * is trying to convert the interpreter's result to mms.
513           */           */
514    
515          error:          error:
516          Tcl_AppendResult(interp, "bad screen distance \"", string,          Tcl_AppendResult(interp, "bad screen distance \"", string,
517                  "\"", (char *) NULL);                  "\"", (char *) NULL);
518          return TCL_ERROR;          return TCL_ERROR;
519      }      }
520      while ((*rest != '\0') && isspace(UCHAR(*rest))) {      while ((*rest != '\0') && isspace(UCHAR(*rest))) {
521          rest++;          rest++;
522      }      }
523      switch (*rest) {      switch (*rest) {
524          case '\0':          case '\0':
525              units = -1;              units = -1;
526              break;              break;
527    
528          case 'c':          case 'c':
529              units = 0;              units = 0;
530              break;              break;
531    
532          case 'i':          case 'i':
533              units = 1;              units = 1;
534              break;              break;
535    
536          case 'm':          case 'm':
537              units = 2;              units = 2;
538              break;              break;
539    
540          case 'p':          case 'p':
541              units = 3;              units = 3;
542              break;              break;
543    
544          default:          default:
545              goto error;              goto error;
546      }      }
547    
548      /*      /*
549       * Free the old internalRep before setting the new one.       * Free the old internalRep before setting the new one.
550       */       */
551    
552      typePtr = objPtr->typePtr;      typePtr = objPtr->typePtr;
553      if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {      if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
554          (*typePtr->freeIntRepProc)(objPtr);          (*typePtr->freeIntRepProc)(objPtr);
555      }      }
556    
557      objPtr->typePtr = &mmObjType;      objPtr->typePtr = &mmObjType;
558    
559      mmPtr = (MMRep *) ckalloc(sizeof(MMRep));      mmPtr = (MMRep *) ckalloc(sizeof(MMRep));
560      mmPtr->value = d;      mmPtr->value = d;
561      mmPtr->units = units;      mmPtr->units = units;
562      mmPtr->tkwin = NULL;      mmPtr->tkwin = NULL;
563      mmPtr->returnValue = d;      mmPtr->returnValue = d;
564      objPtr->internalRep.otherValuePtr = (VOID *) mmPtr;      objPtr->internalRep.otherValuePtr = (VOID *) mmPtr;
565      return TCL_OK;      return TCL_OK;
566  }  }
567    
568  /*  /*
569   *----------------------------------------------------------------------   *----------------------------------------------------------------------
570   *   *
571   * TkGetWindowFromObj --   * TkGetWindowFromObj --
572   *   *
573   *      Attempt to return a Tk_Window from the Tcl object "objPtr". If the   *      Attempt to return a Tk_Window from the Tcl object "objPtr". If the
574   *      object is not already a Tk_Window, an attempt will be made to convert   *      object is not already a Tk_Window, an attempt will be made to convert
575   *      it to one.   *      it to one.
576   *   *
577   * Results:   * Results:
578   *      The return value is a standard Tcl object result. If an error occurs   *      The return value is a standard Tcl object result. If an error occurs
579   *      during conversion, an error message is left in the interpreter's   *      during conversion, an error message is left in the interpreter's
580   *      result unless "interp" is NULL.   *      result unless "interp" is NULL.
581   *   *
582   * Side effects:   * Side effects:
583   *      If the object is not already a Tk_Window, the conversion will free   *      If the object is not already a Tk_Window, the conversion will free
584   *      any old internal representation.   *      any old internal representation.
585   *   *
586   *----------------------------------------------------------------------   *----------------------------------------------------------------------
587   */   */
588    
589  int  int
590  TkGetWindowFromObj(interp, tkwin, objPtr, windowPtr)  TkGetWindowFromObj(interp, tkwin, objPtr, windowPtr)
591      Tcl_Interp *interp;         /* Used for error reporting if not NULL. */      Tcl_Interp *interp;         /* Used for error reporting if not NULL. */
592      Tk_Window tkwin;            /* A token to get the main window from. */      Tk_Window tkwin;            /* A token to get the main window from. */
593      register Tcl_Obj *objPtr;   /* The object from which to get boolean. */      register Tcl_Obj *objPtr;   /* The object from which to get boolean. */
594      Tk_Window *windowPtr;       /* Place to store resulting window. */      Tk_Window *windowPtr;       /* Place to store resulting window. */
595  {  {
596      register int result;      register int result;
597      Tk_Window lastWindow;      Tk_Window lastWindow;
598    
599      result = SetWindowFromAny(interp, objPtr);      result = SetWindowFromAny(interp, objPtr);
600      if (result != TCL_OK) {      if (result != TCL_OK) {
601          return result;          return result;
602      }      }
603    
604      lastWindow = (Tk_Window) objPtr->internalRep.twoPtrValue.ptr1;      lastWindow = (Tk_Window) objPtr->internalRep.twoPtrValue.ptr1;
605      if (tkwin != lastWindow) {      if (tkwin != lastWindow) {
606          Tk_Window foundWindow = Tk_NameToWindow(interp,          Tk_Window foundWindow = Tk_NameToWindow(interp,
607                  Tcl_GetStringFromObj(objPtr, NULL), tkwin);                  Tcl_GetStringFromObj(objPtr, NULL), tkwin);
608    
609          if (foundWindow == NULL) {          if (foundWindow == NULL) {
610              return TCL_ERROR;              return TCL_ERROR;
611          }          }
612          objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkwin;          objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkwin;
613          objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) foundWindow;          objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) foundWindow;
614      }      }
615      *windowPtr = (Tk_Window) objPtr->internalRep.twoPtrValue.ptr2;      *windowPtr = (Tk_Window) objPtr->internalRep.twoPtrValue.ptr2;
616    
617      return result;      return result;
618  }  }
619    
620  /*  /*
621   *----------------------------------------------------------------------   *----------------------------------------------------------------------
622   *   *
623   * SetWindowFromAny --   * SetWindowFromAny --
624   *   *
625   *      Attempt to generate a Tk_Window internal form for the Tcl object   *      Attempt to generate a Tk_Window internal form for the Tcl object
626   *      "objPtr".   *      "objPtr".
627   *   *
628   * Results:   * Results:
629   *      The return value is a standard Tcl result. If an error occurs during   *      The return value is a standard Tcl result. If an error occurs during
630   *      conversion, an error message is left in the interpreter's result   *      conversion, an error message is left in the interpreter's result
631   *      unless "interp" is NULL.   *      unless "interp" is NULL.
632   *   *
633   * Side effects:   * Side effects:
634   *      If no error occurs, a standard window value is stored as "objPtr"s   *      If no error occurs, a standard window value is stored as "objPtr"s
635   *      internal representation and the type of "objPtr" is set to Tk_Window.   *      internal representation and the type of "objPtr" is set to Tk_Window.
636   *   *
637   *----------------------------------------------------------------------   *----------------------------------------------------------------------
638   */   */
639    
640  static int  static int
641  SetWindowFromAny(interp, objPtr)  SetWindowFromAny(interp, objPtr)
642      Tcl_Interp *interp;         /* Used for error reporting if not NULL. */      Tcl_Interp *interp;         /* Used for error reporting if not NULL. */
643      register Tcl_Obj *objPtr;   /* The object to convert. */      register Tcl_Obj *objPtr;   /* The object to convert. */
644  {  {
645      Tcl_ObjType *typePtr;      Tcl_ObjType *typePtr;
646    
647      /*      /*
648       * Free the old internalRep before setting the new one.       * Free the old internalRep before setting the new one.
649       */       */
650    
651      Tcl_GetStringFromObj(objPtr, NULL);      Tcl_GetStringFromObj(objPtr, NULL);
652      typePtr = objPtr->typePtr;      typePtr = objPtr->typePtr;
653      if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {      if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
654          (*typePtr->freeIntRepProc)(objPtr);          (*typePtr->freeIntRepProc)(objPtr);
655      }      }
656      objPtr->typePtr = &windowObjType;      objPtr->typePtr = &windowObjType;
657      objPtr->internalRep.twoPtrValue.ptr1 = NULL;      objPtr->internalRep.twoPtrValue.ptr1 = NULL;
658      objPtr->internalRep.twoPtrValue.ptr2 = NULL;      objPtr->internalRep.twoPtrValue.ptr2 = NULL;
659    
660      return TCL_OK;      return TCL_OK;
661  }  }
662    
663  /* End of tkobj.c */  /* End of tkobj.c */
Legend:
Removed from v.69  
changed lines
  Added in v.71
dashley@gmail.com
 ViewVC Help
Powered by ViewVC 1.1.25