/* * tkObj.c -- * * This file contains procedures that implement the common Tk object * types * * Copyright (c) 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: tkObj.c,v 1.1.2.2 1998/09/30 02:17:12 stanton Exp $ */ #include "tkInt.h" /* * The following structure is the internal representation for pixel objects. */ typedef struct PixelRep { double value; int units; Tk_Window tkwin; int returnValue; } PixelRep; #define SIMPLE_PIXELREP(objPtr) \ ((objPtr)->internalRep.twoPtrValue.ptr2 == 0) #define SET_SIMPLEPIXEL(objPtr, intval) \ (objPtr)->internalRep.twoPtrValue.ptr1 = (VOID *) (intval); \ (objPtr)->internalRep.twoPtrValue.ptr2 = 0 #define GET_SIMPLEPIXEL(objPtr) \ ((int) (objPtr)->internalRep.twoPtrValue.ptr1) #define SET_COMPLEXPIXEL(objPtr, repPtr) \ (objPtr)->internalRep.twoPtrValue.ptr1 = 0; \ (objPtr)->internalRep.twoPtrValue.ptr2 = (VOID *) repPtr #define GET_COMPLEXPIXEL(objPtr) \ ((PixelRep *) (objPtr)->internalRep.twoPtrValue.ptr2) /* * The following structure is the internal representation for mm objects. */ typedef struct MMRep { double value; int units; Tk_Window tkwin; double returnValue; } MMRep; /* * Prototypes for procedures defined later in this file: */ static void DupMMInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr, Tcl_Obj *copyPtr)); static void DupPixelInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr, Tcl_Obj *copyPtr)); static void FreeMMInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr)); static void FreePixelInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr)); static int SetMMFromAny _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); static int SetPixelFromAny _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); static int SetWindowFromAny _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); /* * The following structure defines the implementation of the "pixel" * Tcl object, used for measuring distances. The pixel object remembers * its initial display-independant settings. */ static Tcl_ObjType pixelObjType = { "pixel", /* name */ FreePixelInternalRep, /* freeIntRepProc */ DupPixelInternalRep, /* dupIntRepProc */ NULL, /* updateStringProc */ SetPixelFromAny /* setFromAnyProc */ }; /* * The following structure defines the implementation of the "pixel" * Tcl object, used for measuring distances. The pixel object remembers * its initial display-independant settings. */ static Tcl_ObjType mmObjType = { "mm", /* name */ FreeMMInternalRep, /* freeIntRepProc */ DupMMInternalRep, /* dupIntRepProc */ NULL, /* updateStringProc */ SetMMFromAny /* setFromAnyProc */ }; /* * The following structure defines the implementation of the "window" * Tcl object. */ static Tcl_ObjType windowObjType = { "window", /* name */ (Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */ (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */ NULL, /* updateStringProc */ SetWindowFromAny /* setFromAnyProc */ }; /* *---------------------------------------------------------------------- * * Tk_GetPixelsFromObj -- * * Attempt to return a pixel value from the Tcl object "objPtr". If the * object is not already a pixel value, an attempt will be made to convert * it to one. * * Results: * The return value is a standard Tcl object result. If an error occurs * during conversion, an error message is left in the interpreter's * result unless "interp" is NULL. * * Side effects: * If the object is not already a pixel, the conversion will free * any old internal representation. * *---------------------------------------------------------------------- */ int Tk_GetPixelsFromObj(interp, tkwin, objPtr, intPtr) Tcl_Interp *interp; /* Used for error reporting if not NULL. */ Tk_Window tkwin; Tcl_Obj *objPtr; /* The object from which to get pixels. */ int *intPtr; /* Place to store resulting pixels. */ { int result; double d; PixelRep *pixelPtr; static double bias[] = { 1.0, 10.0, 25.4, 25.4 / 72.0 }; if (objPtr->typePtr != &pixelObjType) { result = SetPixelFromAny(interp, objPtr); if (result != TCL_OK) { return result; } } if (SIMPLE_PIXELREP(objPtr)) { *intPtr = GET_SIMPLEPIXEL(objPtr); } else { pixelPtr = GET_COMPLEXPIXEL(objPtr); if (pixelPtr->tkwin != tkwin) { d = pixelPtr->value; if (pixelPtr->units >= 0) { d *= bias[pixelPtr->units] * WidthOfScreen(Tk_Screen(tkwin)); d /= WidthMMOfScreen(Tk_Screen(tkwin)); } if (d < 0) { pixelPtr->returnValue = (int) (d - 0.5); } else { pixelPtr->returnValue = (int) (d + 0.5); } pixelPtr->tkwin = tkwin; } *intPtr = pixelPtr->returnValue; } return TCL_OK; } /* *---------------------------------------------------------------------- * * FreePixelInternalRep -- * * Deallocate the storage associated with a pixel object's internal * representation. * * Results: * None. * * Side effects: * Frees objPtr's internal representation and sets objPtr's * internalRep to NULL. * *---------------------------------------------------------------------- */ static void FreePixelInternalRep(objPtr) Tcl_Obj *objPtr; /* Pixel object with internal rep to free. */ { PixelRep *pixelPtr; if (!SIMPLE_PIXELREP(objPtr)) { pixelPtr = GET_COMPLEXPIXEL(objPtr); ckfree((char *) pixelPtr); } SET_SIMPLEPIXEL(objPtr, 0); } /* *---------------------------------------------------------------------- * * DupPixelInternalRep -- * * Initialize the internal representation of a pixel Tcl_Obj to a * copy of the internal representation of an existing pixel object. * * Results: * None. * * Side effects: * copyPtr's internal rep is set to the pixel corresponding to * srcPtr's internal rep. * *---------------------------------------------------------------------- */ static void DupPixelInternalRep(srcPtr, copyPtr) register Tcl_Obj *srcPtr; /* Object with internal rep to copy. */ register Tcl_Obj *copyPtr; /* Object with internal rep to set. */ { PixelRep *oldPtr, *newPtr; copyPtr->typePtr = srcPtr->typePtr; if (SIMPLE_PIXELREP(srcPtr)) { SET_SIMPLEPIXEL(copyPtr, GET_SIMPLEPIXEL(srcPtr)); } else { oldPtr = GET_COMPLEXPIXEL(srcPtr); newPtr = (PixelRep *) ckalloc(sizeof(PixelRep)); newPtr->value = oldPtr->value; newPtr->units = oldPtr->units; newPtr->tkwin = oldPtr->tkwin; newPtr->returnValue = oldPtr->returnValue; SET_COMPLEXPIXEL(copyPtr, newPtr); } } /* *---------------------------------------------------------------------- * * SetPixelFromAny -- * * Attempt to generate a pixel internal form for the Tcl object * "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: * If no error occurs, a pixel representation of the object is * stored internally and the type of "objPtr" is set to pixel. * *---------------------------------------------------------------------- */ static int SetPixelFromAny(interp, objPtr) Tcl_Interp *interp; /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr; /* The object to convert. */ { Tcl_ObjType *typePtr; char *string, *rest; double d; int i, units; PixelRep *pixelPtr; string = Tcl_GetStringFromObj(objPtr, NULL); d = strtod(string, &rest); if (rest == string) { /* * Must copy string before resetting the result in case a caller * is trying to convert the interpreter's result to pixels. */ char buf[100]; error: sprintf(buf, "bad screen distance \"%.50s\"", string); Tcl_ResetResult(interp); Tcl_AppendResult(interp, buf, NULL); return TCL_ERROR; } while ((*rest != '\0') && isspace(UCHAR(*rest))) { rest++; } switch (*rest) { case '\0': units = -1; break; case 'm': units = 0; break; case 'c': units = 1; break; case 'i': units = 2; break; case 'p': units = 3; break; default: goto error; } /* * Free the old internalRep before setting the new one. */ typePtr = objPtr->typePtr; if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { (*typePtr->freeIntRepProc)(objPtr); } objPtr->typePtr = &pixelObjType; i = (int) d; if ((units < 0) && (i == d)) { SET_SIMPLEPIXEL(objPtr, i); } else { pixelPtr = (PixelRep *) ckalloc(sizeof(PixelRep)); pixelPtr->value = d; pixelPtr->units = units; pixelPtr->tkwin = NULL; pixelPtr->returnValue = i; SET_COMPLEXPIXEL(objPtr, pixelPtr); } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tk_GetMMFromObj -- * * Attempt to return an mm value from the Tcl object "objPtr". If the * object is not already an mm value, an attempt will be made to convert * it to one. * * Results: * The return value is a standard Tcl object result. If an error occurs * during conversion, an error message is left in the interpreter's * result unless "interp" is NULL. * * Side effects: * If the object is not already a pixel, the conversion will free * any old internal representation. * *---------------------------------------------------------------------- */ int Tk_GetMMFromObj(interp, tkwin, objPtr, doublePtr) Tcl_Interp *interp; /* Used for error reporting if not NULL. */ Tk_Window tkwin; Tcl_Obj *objPtr; /* The object from which to get mms. */ double *doublePtr; /* Place to store resulting millimeters. */ { int result; double d; MMRep *mmPtr; static double bias[] = { 10.0, 25.4, 1.0, 25.4 / 72.0 }; if (objPtr->typePtr != &mmObjType) { result = SetMMFromAny(interp, objPtr); if (result != TCL_OK) { return result; } } mmPtr = (MMRep *) objPtr->internalRep.otherValuePtr; if (mmPtr->tkwin != tkwin) { d = mmPtr->value; if (mmPtr->units == -1) { d /= WidthOfScreen(Tk_Screen(tkwin)); d *= WidthMMOfScreen(Tk_Screen(tkwin)); } else { d *= bias[mmPtr->units]; } mmPtr->tkwin = tkwin; mmPtr->returnValue = d; } *doublePtr = mmPtr->returnValue; return TCL_OK; } /* *---------------------------------------------------------------------- * * FreeMMInternalRep -- * * Deallocate the storage associated with a mm object's internal * representation. * * Results: * None. * * Side effects: * Frees objPtr's internal representation and sets objPtr's * internalRep to NULL. * *---------------------------------------------------------------------- */ static void FreeMMInternalRep(objPtr) Tcl_Obj *objPtr; /* MM object with internal rep to free. */ { ckfree((char *) objPtr->internalRep.otherValuePtr); objPtr->internalRep.otherValuePtr = NULL; } /* *---------------------------------------------------------------------- * * DupMMInternalRep -- * * Initialize the internal representation of a pixel Tcl_Obj to a * copy of the internal representation of an existing pixel object. * * Results: * None. * * Side effects: * copyPtr's internal rep is set to the pixel corresponding to * srcPtr's internal rep. * *---------------------------------------------------------------------- */ static void DupMMInternalRep(srcPtr, copyPtr) register Tcl_Obj *srcPtr; /* Object with internal rep to copy. */ register Tcl_Obj *copyPtr; /* Object with internal rep to set. */ { MMRep *oldPtr, *newPtr; copyPtr->typePtr = srcPtr->typePtr; oldPtr = (MMRep *) srcPtr->internalRep.otherValuePtr; newPtr = (MMRep *) ckalloc(sizeof(MMRep)); newPtr->value = oldPtr->value; newPtr->units = oldPtr->units; newPtr->tkwin = oldPtr->tkwin; newPtr->returnValue = oldPtr->returnValue; copyPtr->internalRep.otherValuePtr = (VOID *) newPtr; } /* *---------------------------------------------------------------------- * * SetMMFromAny -- * * Attempt to generate a mm internal form for the Tcl object * "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: * If no error occurs, a mm representation of the object is * stored internally and the type of "objPtr" is set to mm. * *---------------------------------------------------------------------- */ static int SetMMFromAny(interp, objPtr) Tcl_Interp *interp; /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr; /* The object to convert. */ { Tcl_ObjType *typePtr; char *string, *rest; double d; int units; MMRep *mmPtr; string = Tcl_GetStringFromObj(objPtr, NULL); d = strtod(string, &rest); if (rest == string) { /* * Must copy string before resetting the result in case a caller * is trying to convert the interpreter's result to mms. */ error: Tcl_AppendResult(interp, "bad screen distance \"", string, "\"", (char *) NULL); return TCL_ERROR; } while ((*rest != '\0') && isspace(UCHAR(*rest))) { rest++; } switch (*rest) { case '\0': units = -1; break; case 'c': units = 0; break; case 'i': units = 1; break; case 'm': units = 2; break; case 'p': units = 3; break; default: goto error; } /* * Free the old internalRep before setting the new one. */ typePtr = objPtr->typePtr; if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { (*typePtr->freeIntRepProc)(objPtr); } objPtr->typePtr = &mmObjType; mmPtr = (MMRep *) ckalloc(sizeof(MMRep)); mmPtr->value = d; mmPtr->units = units; mmPtr->tkwin = NULL; mmPtr->returnValue = d; objPtr->internalRep.otherValuePtr = (VOID *) mmPtr; return TCL_OK; } /* *---------------------------------------------------------------------- * * TkGetWindowFromObj -- * * Attempt to return a Tk_Window from the Tcl object "objPtr". If the * object is not already a Tk_Window, an attempt will be made to convert * it to one. * * Results: * The return value is a standard Tcl object result. If an error occurs * during conversion, an error message is left in the interpreter's * result unless "interp" is NULL. * * Side effects: * If the object is not already a Tk_Window, the conversion will free * any old internal representation. * *---------------------------------------------------------------------- */ int TkGetWindowFromObj(interp, tkwin, objPtr, windowPtr) Tcl_Interp *interp; /* Used for error reporting if not NULL. */ Tk_Window tkwin; /* A token to get the main window from. */ register Tcl_Obj *objPtr; /* The object from which to get boolean. */ Tk_Window *windowPtr; /* Place to store resulting window. */ { register int result; Tk_Window lastWindow; result = SetWindowFromAny(interp, objPtr); if (result != TCL_OK) { return result; } lastWindow = (Tk_Window) objPtr->internalRep.twoPtrValue.ptr1; if (tkwin != lastWindow) { Tk_Window foundWindow = Tk_NameToWindow(interp, Tcl_GetStringFromObj(objPtr, NULL), tkwin); if (foundWindow == NULL) { return TCL_ERROR; } objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkwin; objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) foundWindow; } *windowPtr = (Tk_Window) objPtr->internalRep.twoPtrValue.ptr2; return result; } /* *---------------------------------------------------------------------- * * SetWindowFromAny -- * * Attempt to generate a Tk_Window internal form for the Tcl object * "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: * If no error occurs, a standard window value is stored as "objPtr"s * internal representation and the type of "objPtr" is set to Tk_Window. * *---------------------------------------------------------------------- */ static int SetWindowFromAny(interp, objPtr) Tcl_Interp *interp; /* Used for error reporting if not NULL. */ register Tcl_Obj *objPtr; /* The object to convert. */ { Tcl_ObjType *typePtr; /* * Free the old internalRep before setting the new one. */ Tcl_GetStringFromObj(objPtr, NULL); typePtr = objPtr->typePtr; if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { (*typePtr->freeIntRepProc)(objPtr); } objPtr->typePtr = &windowObjType; objPtr->internalRep.twoPtrValue.ptr1 = NULL; objPtr->internalRep.twoPtrValue.ptr2 = NULL; return TCL_OK; }