Tk Source Code

}

# TIP #264
declare 271 {
    Tcl_Interp *Tk_Interp(Tk_Window tkwin)
}

# TIP #714
declare 273 {
    int Tk_SetTypeInfoProc(Tk_ImageType *typePtr,
	    Tk_ImageInfoProc *typeInfo)
}

# ----- BASELINE -- FOR -- 8.6.0 ----- #


# TIP#580
declare 274 {
    int Tk_AlwaysShowSelection(Tk_Window tkwin)

typedef void (Tk_ImageFreeProc) (void *clientData, Display *display);
typedef void (Tk_ImageDeleteProc) (void *clientData);
typedef void (Tk_ImageChangedProc) (void *clientData, int x, int y,
	int width, int height, int imageWidth, int imageHeight);
typedef int (Tk_ImagePostscriptProc) (void *clientData,
	Tcl_Interp *interp, Tk_Window tkwin, Tk_PostscriptInfo psinfo,
	int x, int y, int width, int height, int prepass);
typedef int (Tk_ImageInfoProc) (Tcl_Interp *interp);

/*
 * The following structure represents a particular type of image (bitmap, xpm
 * image, etc.). It provides information common to all images of that type,
 * such as the type name and a collection of procedures in the image manager
 * that respond to various events. Each image manager is represented by one of
 * these structures.

/* 269 */
EXTERN long		Tk_GetUserInactiveTime(Display *dpy);
/* 270 */
EXTERN void		Tk_ResetUserInactiveTime(Display *dpy);
/* 271 */
EXTERN Tcl_Interp *	Tk_Interp(Tk_Window tkwin);
/* Slot 272 is reserved */
/* 273 */
EXTERN int		Tk_SetTypeInfoProc(Tk_ImageType *typePtr,
				Tk_ImageInfoProc *typeInfo);
/* 274 */
EXTERN int		Tk_AlwaysShowSelection(Tk_Window tkwin);
/* 275 */
EXTERN unsigned		Tk_GetButtonMask(unsigned button);
/* 276 */
EXTERN int		Tk_GetDoublePixelsFromObj(Tcl_Interp *interp,
				Tk_Window tkwin, Tcl_Obj *objPtr,

    int (*tk_PhotoPutBlock) (Tcl_Interp *interp, Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height, int compRule); /* 266 */
    int (*tk_PhotoPutZoomedBlock) (Tcl_Interp *interp, Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height, int zoomX, int zoomY, int subsampleX, int subsampleY, int compRule); /* 267 */
    int (*tk_PhotoSetSize) (Tcl_Interp *interp, Tk_PhotoHandle handle, int width, int height); /* 268 */
    long (*tk_GetUserInactiveTime) (Display *dpy); /* 269 */
    void (*tk_ResetUserInactiveTime) (Display *dpy); /* 270 */
    Tcl_Interp * (*tk_Interp) (Tk_Window tkwin); /* 271 */
    void (*reserved272)(void);
    int (*tk_SetTypeInfoProc) (Tk_ImageType *typePtr, Tk_ImageInfoProc *typeInfo); /* 273 */
    int (*tk_AlwaysShowSelection) (Tk_Window tkwin); /* 274 */
    unsigned (*tk_GetButtonMask) (unsigned button); /* 275 */
    int (*tk_GetDoublePixelsFromObj) (Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr, double *doublePtr); /* 276 */
    Tcl_Obj * (*tk_NewWindowObj) (Tk_Window tkwin); /* 277 */
    void (*tk_SendVirtualEvent) (Tk_Window tkwin, const char *eventName, Tcl_Obj *detail); /* 278 */
    Tcl_Obj * (*tk_FontGetDescription) (Tk_Font tkfont); /* 279 */
    void (*tk_CreatePhotoImageFormatVersion3) (const Tk_PhotoImageFormatVersion3 *formatPtr); /* 280 */

#define Tk_GetUserInactiveTime \
	(tkStubsPtr->tk_GetUserInactiveTime) /* 269 */
#define Tk_ResetUserInactiveTime \
	(tkStubsPtr->tk_ResetUserInactiveTime) /* 270 */
#define Tk_Interp \
	(tkStubsPtr->tk_Interp) /* 271 */
/* Slot 272 is reserved */
#define Tk_SetTypeInfoProc \
	(tkStubsPtr->tk_SetTypeInfoProc) /* 273 */
#define Tk_AlwaysShowSelection \
	(tkStubsPtr->tk_AlwaysShowSelection) /* 274 */
#define Tk_GetButtonMask \
	(tkStubsPtr->tk_GetButtonMask) /* 275 */
#define Tk_GetDoublePixelsFromObj \
	(tkStubsPtr->tk_GetDoublePixelsFromObj) /* 276 */
#define Tk_NewWindowObj \

EXTERN int Tk_SafeInit(Tcl_Interp *interp);
EXTERN int Tk_CreateConsoleWindow(Tcl_Interp *interp);

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#undef TkUnusedStubEntry

#if defined(USE_TK_STUBS)
#   undef Tk_SetTypeInfoProc
#   define Tk_SetTypeInfoProc(t,i) \
	if (!tkStubsPtr->tk_SetTypeInfoProc) {/* NOP */} else tkStubsPtr->tk_SetTypeInfoProc(t,i)
#endif

#endif /* _TKDECLS */

} ImageModel;

typedef struct {
    Tk_ImageType *imageTypeList;/* First in a list of all known image
				 * types. */
    int initialized;		/* Set to 1 if we've initialized the
				 * structure. */
    Tcl_HashTable *infoCmdTable;
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * Prototypes for local functions:
 */

	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    while (tsdPtr->imageTypeList != NULL) {
	freePtr = tsdPtr->imageTypeList;
	tsdPtr->imageTypeList = tsdPtr->imageTypeList->nextPtr;
	ckfree(freePtr);
    }
    /* Cleanup the infoCmdTable hash table */
    Tcl_HashEntry *entryPtr;
    Tcl_HashSearch search;
    for (entryPtr = Tcl_FirstHashEntry(tsdPtr->infoCmdTable, &search);
	    entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
	Tcl_DeleteHashEntry(entryPtr);
    }
    Tcl_DeleteHashTable(tsdPtr->infoCmdTable);
    ckfree(tsdPtr->infoCmdTable);
}

int Tk_SetTypeInfoProc(
    Tk_ImageType *typePtr,
    Tk_ImageInfoProc *infoProc)
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    Tcl_HashEntry *entryPtr;
    int isNew;

    entryPtr = Tcl_CreateHashEntry(tsdPtr->infoCmdTable, typePtr->name, &isNew);
    if (isNew) {
	Tcl_SetHashValue(entryPtr, infoProc);
    } /* else? */
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_CreateImageType --
 *

    Tk_ImageType *copyPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (!tsdPtr->initialized) {
	tsdPtr->initialized = 1;
	Tcl_CreateThreadExitHandler(ImageTypeThreadExitProc, NULL);
	tsdPtr->infoCmdTable = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(tsdPtr->infoCmdTable, TCL_STRING_KEYS);
    }
    copyPtr = (Tk_ImageType *)ckalloc(sizeof(Tk_ImageType));
    *copyPtr = *typePtr;
    copyPtr->nextPtr = tsdPtr->imageTypeList;
    tsdPtr->imageTypeList = copyPtr;
}


	    }
	    Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(
		    (const char *)Tcl_GetHashKey(&winPtr->mainPtr->imageTable, hPtr), TCL_INDEX_NONE));
	}
	Tcl_SetObjResult(interp, resultObj);
	break;
    case IMAGE_TYPES:
	if (objc != 2 && objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "?type?");
	    return TCL_ERROR;
	}
if (objc == 2) {
	resultObj = Tcl_NewObj();
	for (typePtr = tsdPtr->imageTypeList; typePtr != NULL;
		typePtr = typePtr->nextPtr) {
	    Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(
		    typePtr->name, TCL_INDEX_NONE));
	}
	Tcl_SetObjResult(interp, resultObj);
} else {
	Tk_ImageInfoProc *proc;
	Tcl_HashEntry *entryPtr;

	entryPtr = Tcl_FindHashEntry(tsdPtr->infoCmdTable, Tcl_GetString(objv[2]));
	if (entryPtr) {
	    proc = (Tk_ImageInfoProc *) Tcl_GetHashValue(entryPtr);
	    proc(interp);
	}
}
	break;

    case IMAGE_HEIGHT:
    case IMAGE_INUSE:
    case IMAGE_TYPE:
    case IMAGE_WIDTH:
	/*

    Tk_PhotoImageBlock block;

    Tk_PhotoGetImage(clientData, &block);
    block.pixelPtr += y * block.pitch + x * block.pixelSize;

    return Tk_PostscriptPhoto(interp, &block, psInfo, width, height);
}

/*
 *--------------------------------------------------------------
 *
 * TkPhotoInfoProc --
 *
 *	This function is called to return an information dict on
 *	all photo images.
 *	It is called by the command "image types photo".
 *
 * Results:
 *	Returns a standard Tcl return value.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

int
TkPhotoInfoProc(Tcl_Interp *interp) {

    Tcl_Obj *resultObj, *formatValueObj, *fileValueObj, *writeValueObj;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    Tk_PhotoImageFormat *formatPtr;
    Tk_PhotoImageFormatVersion3 *formatVersion3Ptr;
    const char * defaultFormatName = NULL;

    formatValueObj = Tcl_NewListObj(0, NULL);
    fileValueObj = Tcl_NewListObj(0, NULL);
    writeValueObj = Tcl_NewListObj(0, NULL);

    /*
     * Scan through the table of file format handlers and collect the
     * data.
     */

    for (formatPtr = tsdPtr->formatList; formatPtr != NULL;
	    formatPtr = formatPtr->nextPtr) {

	/*
	 * Default will be evaluated last, so put it at the end of the
	 * evaluation list
	 */

	if (strncasecmp("default", formatPtr->name,
		strlen(formatPtr->name)) == 0) {
	    defaultFormatName = formatPtr->name;

	    /*
	     * The default format does not implement any file operations.
	     * So no need to check for fileMatchProc or fileWriteProc
	     */

	} else {
	    Tcl_Obj *formatNameObj = Tcl_NewStringObj(formatPtr->name,-1);
	    Tcl_ListObjAppendElement(NULL, formatValueObj, formatNameObj);
	    if (NULL != formatPtr->fileMatchProc) {
		Tcl_ListObjAppendElement(NULL, fileValueObj, formatNameObj);
	    }
	    if (NULL != formatPtr->fileWriteProc) {
		Tcl_ListObjAppendElement(NULL, writeValueObj, formatNameObj);
	    }
	}
    }

    for (formatVersion3Ptr = tsdPtr->formatListVersion3;
	    formatVersion3Ptr != NULL;
	    formatVersion3Ptr = formatVersion3Ptr->nextPtr) {
	Tcl_Obj *formatNameObj = Tcl_NewStringObj(formatVersion3Ptr->name,-1);
	Tcl_ListObjAppendElement(NULL, formatValueObj, formatNameObj);
	if (NULL != formatVersion3Ptr->fileMatchProc) {
	    Tcl_ListObjAppendElement(NULL, fileValueObj, formatNameObj);
	}
	if (NULL != formatVersion3Ptr->fileWriteProc) {
	    Tcl_ListObjAppendElement(NULL, writeValueObj, formatNameObj);
	}
    }

    if (NULL != defaultFormatName) {
	Tcl_ListObjAppendElement(interp, formatValueObj,
		Tcl_NewStringObj(defaultFormatName, -1));
    }

    /*
     * set the format key in the result dictionary
     */

    resultObj = Tcl_NewObj();
    Tcl_DictObjPut(NULL, resultObj, Tcl_NewStringObj("format", -1),
	    formatValueObj);
    Tcl_DictObjPut(NULL, resultObj, Tcl_NewStringObj("file", -1),
	    fileValueObj);
    Tcl_DictObjPut(NULL, resultObj, Tcl_NewStringObj("write", -1),
	    writeValueObj);
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8

MODULE_SCOPE Tk_PhotoImageFormat tkImgFmtSVGnano;
MODULE_SCOPE TkMainInfo		*tkMainWindowList;
MODULE_SCOPE Tk_ImageType	tkPhotoImageType;
MODULE_SCOPE Tcl_HashTable	tkPredefBitmapTable;

MODULE_SCOPE const char *const tkWebColors[20];

MODULE_SCOPE Tk_ImageInfoProc TkPhotoInfoProc;
/*
 * The definition of pi, at least from the perspective of double-precision
 * floats.
 */

#ifndef PI
#ifdef M_PI

    Tk_PhotoPutBlock, /* 266 */
    Tk_PhotoPutZoomedBlock, /* 267 */
    Tk_PhotoSetSize, /* 268 */
    Tk_GetUserInactiveTime, /* 269 */
    Tk_ResetUserInactiveTime, /* 270 */
    Tk_Interp, /* 271 */
    0, /* 272 */
    Tk_SetTypeInfoProc, /* 273 */
    Tk_AlwaysShowSelection, /* 274 */
    Tk_GetButtonMask, /* 275 */
    Tk_GetDoublePixelsFromObj, /* 276 */
    Tk_NewWindowObj, /* 277 */
    Tk_SendVirtualEvent, /* 278 */
    Tk_FontGetDescription, /* 279 */
    Tk_CreatePhotoImageFormatVersion3, /* 280 */

	/*
	 * Create built-in image types.
	 */

	Tk_CreateImageType(&tkBitmapImageType);
	Tk_CreateImageType(&tkPhotoImageType);

	Tk_SetTypeInfoProc(&tkPhotoImageType, TkPhotoInfoProc);

	/*
	 * Create built-in photo image formats.
	 */

	Tk_CreatePhotoImageFormat(&tkImgFmtDefault);
	Tk_CreatePhotoImageFormatVersion3(&tkImgFmtGIF);

    imageCleanup
} -returnCodes error -result {image "myimage" does not exist}


test image-6.1 {Tk_ImageCmd procedure, "types" option} -constraints {
    testImageType
} -body {
    image types x y
} -returnCodes error -result {wrong # args: should be "image types ?type?"}
test image-6.2 {Tk_ImageCmd procedure, "types" option} -body {
    lsort [image types]
} -match glob -result {bitmap*photo test}
test image-6.3 {Tk_ImageCmd procedure, "types" argument} -body {
    image types x
} -result {}


test image-7.1 {Tk_ImageCmd procedure, "width" option} -body {
    image width
} -returnCodes error -result {wrong # args: should be "image width name"}
test image-7.2 {Tk_ImageCmd procedure, "width" option} -body {
    image width a b

    image create photo png1
    catch {png1 read $ousterPhotoFile -from 102 62 2000 1000} msg
    list $msg [image width png1] [image height png1]
} -cleanup {
    catch {image delete png1}
} -result {{coordinates for -from option extend outside source image} 0 0}
unset ousterPhotoFile

# test 26.x: ImgPhotoInfo, command "image types photo"

test image-26.1 {ImgPhotoDriver/image types photo: format key} -body {
    dict get [image types photo] format
} -match glob -result {svg ppm png gif *default}
# take into account, that the list of formats may extend
# Any new format may be inserted between our own ones and the default format.

test image-26.2 {ImgPhotoDriver/image types photo: format file} -body {
    dict get [image types photo] file
} -match glob -result {svg ppm png gif*}

test image-26.3 {ImgPhotoDriver/image types photo: format write} -body {
    dict get [image types photo] write
} -match glob -result {ppm png gif*}

catch {rename foreachPixel {}}
catch {rename checkImgTrans {}}
catch {rename checkImgTransLoop {}}
imageFinish

# cleanup