Tk Source Code

#define SET_COMPLEXPIXEL(objPtr, repPtr)		\
    (objPtr)->internalRep.twoPtrValue.ptr1 = NULL;		\
    (objPtr)->internalRep.twoPtrValue.ptr2 = repPtr

#define GET_COMPLEXPIXEL(objPtr)			\
    ((PixelRep *) (objPtr)->internalRep.twoPtrValue.ptr2)

/*
 * One of these structures is created per thread to store thread-specific
 * data. In this case, it is used to contain references to selected
 * Tcl_ObjTypes that we can use as screen distances without conversion. The
 * "dataKey" below is used to locate the ThreadSpecificData for the current
 * thread.
 */

typedef struct {
    const Tcl_ObjType *doubleTypePtr;
    const Tcl_ObjType *intTypePtr;
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * The following structure is the internal representation for mm objects.
 */

typedef struct MMRep {
    double value;
    int units;

static void		DupMMInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static void		DupPixelInternalRep(Tcl_Obj *srcPtr, Tcl_Obj*copyPtr);
static void		DupWindowInternalRep(Tcl_Obj *srcPtr,Tcl_Obj*copyPtr);
static void		FreeMMInternalRep(Tcl_Obj *objPtr);
static void		FreePixelInternalRep(Tcl_Obj *objPtr);
static void		FreeWindowInternalRep(Tcl_Obj *objPtr);
static ThreadSpecificData *GetTypeCache(void);
static void		UpdateStringOfMM(Tcl_Obj *objPtr);
static int		SetMMFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static int		SetPixelFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static int		SetWindowFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);

#if TCL_MAJOR_VERSION < 9
#ifdef __cplusplus

static const Tcl_ObjType windowObjType = {
    "window",			/* name */
    FreeWindowInternalRep,	/* freeIntRepProc */
    DupWindowInternalRep,	/* dupIntRepProc */
    NULL,			/* updateStringProc */
    NULL			/* setFromAnyProc */
};

/*
 *----------------------------------------------------------------------
 *
 * GetTypeCache --
 *
 *	Get (and build if necessary) the cache of useful Tcl object types for
 *	comparisons in the conversion functions.  This allows optimized checks
 *	for standard cases.
 *
 *----------------------------------------------------------------------
 */

static ThreadSpecificData *
GetTypeCache(void)
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (tsdPtr->doubleTypePtr == NULL) {
	/* Smart initialization of doubleTypePtr/intTypePtr without
	 * hash-table lookup or creating complete Tcl_Obj's */
	Tcl_Obj obj;
	obj.bytes = (char *)"0.0";
	obj.length = 3;
	obj.typePtr = NULL;
	Tcl_GetDoubleFromObj(NULL, &obj, &obj.internalRep.doubleValue);
	tsdPtr->doubleTypePtr = obj.typePtr;
	obj.bytes = (char *)"0";
	obj.length = 1;
	obj.typePtr = NULL;
	Tcl_GetLongFromObj(NULL, &obj, &obj.internalRep.longValue);
	tsdPtr->intTypePtr = obj.typePtr;
    }
    return tsdPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TkGetIntForIndex --
 *
 *	Almost the same as Tcl_GetIntForIndex, but it return an int. Accepts

    Tk_Window tkwin,
    Tcl_Obj *objPtr,		/* The object from which to get pixels. */
    int *intPtr,
    double *dblPtr)		/* Places to store resulting pixels. */
{
    int result, fresh;
    double d;

    PixelRep *pixelPtr;
    static const double bias[] = {
	1.0,	10.0,	25.4,	0.35278 /*25.4 / 72.0*/
    };

    /*
     * Special hacks where the type of the object is known to be something
     * that is just numeric and cannot require distance conversion. This pokes
     * holes in Tcl's abstractions, but they are just for optimization, not
     * semantics.
     */

    if (objPtr->typePtr != &pixelObjType) {
	ThreadSpecificData *typeCache = GetTypeCache();


	if (objPtr->typePtr == typeCache->doubleTypePtr) {
	    (void) Tcl_GetDoubleFromObj(interp, objPtr, &d);



	    if (dblPtr != NULL) {
		*dblPtr = d;
	    }
	    *intPtr = (int) (d<0 ? d-0.5 : d+0.5);
	    return TCL_OK;
	} else if (objPtr->typePtr == typeCache->intTypePtr) {



	    (void) Tcl_GetIntFromObj(interp, objPtr, intPtr);
	    if (dblPtr) {
		*dblPtr = (double) (*intPtr);
	    }
	    return TCL_OK;





	}
    }

 retry:
    fresh = (objPtr->typePtr != &pixelObjType);
    if (fresh) {
	result = SetPixelFromAny(interp, objPtr);

 */

static int
SetMMFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr)		/* The object to convert. */
{
    ThreadSpecificData *typeCache = GetTypeCache();
    const Tcl_ObjType *typePtr;
    const char *string;
    char *rest;
    double d;
    int units;
    MMRep *mmPtr;




    if (objPtr->typePtr == typeCache->doubleTypePtr) {

	Tcl_GetDoubleFromObj(interp, objPtr, &d);




	units = -1;

    } else if (objPtr->typePtr == typeCache->intTypePtr) {




	Tcl_GetIntFromObj(interp, objPtr, &units);
	d = (double) units;
	units = -1;

	/*
	 * In the case of ints, we need to ensure that a valid string exists
	 * in order for int-but-not-string objects to be converted back to
	 * ints again from mm obj types.


	 */

	(void) Tcl_GetString(objPtr);



    } else {

	/*
	 * It wasn't a known int or double, so parse it.
	 */

	string = Tcl_GetString(objPtr);

	d = strtod(string, &rest);