Tk Source Code

      os: linux
      dist: focal
      compiler: clang
      env:
        - BUILD_DIR=unix
        - CFGOPT="--enable-symbols"
# Testing on Mac, various styles
    - name: "macOS/Clang/Xcode 11.7/Shared"
      os: osx
      osx_image: xcode11.7
      env:
        - BUILD_DIR=unix
        - CFGOPT="--with-tcl=/usr/local/opt/tcl-tk/lib --enable-aqua CFLAGS=-I/usr/local/opt/tcl-tk/include"
    - name: "macOS/Clang++/Xcode 11.7/Shared"
      os: osx
      osx_image: xcode11.7
      env:
        - BUILD_DIR=unix
        - CFGOPT="--with-tcl=/usr/local/opt/tcl-tk/lib CC=clang++ --enable-aqua CFLAGS=-I/usr/local/opt/tcl-tk/include CPPFLAGS=-D__private_extern__=extern"
    - name: "macOS/Clang/Xcode 11.7/Shared"
      os: osx
      osx_image: xcode11.7
      env:
        - BUILD_DIR=unix
        - CFGOPT="--with-tcl=/usr/local/opt/tcl-tk/lib --enable-aqua CFLAGS=-I/usr/local/opt/tcl-tk/include"
      install:
        - ./configure ${CFGOPT} "--prefix=$HOME" || (cat config.log && exit 1)
      script: &mactest
        - make all tktest
    - name: "macOS/Clang/Xcode 11.7/Static"
      os: osx
      osx_image: xcode11.7
      env:
        - BUILD_DIR=unix
        - CFGOPT="--with-tcl=/usr/local/opt/tcl-tk/lib --enable-aqua --disable-shared CFLAGS=-I/usr/local/opt/tcl-tk/include"
      install:
        - ./configure ${CFGOPT} "--prefix=$HOME" || (cat config.log && exit 1)
      script: *mactest
    - name: "macOS/Clang/Xcode 11.7/Debug"
      os: osx
      osx_image: xcode11.7
      env:
        - BUILD_DIR=unix
        - CFGOPT="--with-tcl=/usr/local/opt/tcl-tk/lib --enable-aqua --enable-symbols CFLAGS=-I/usr/local/opt/tcl-tk/include"
      install:
        - ./configure ${CFGOPT} "--prefix=$HOME" || (cat config.log && exit 1)
      script: *mactest
    - name: "macOS/Clang/Xcode 11.7/Shared/XQuartz"
      os: osx
      osx_image: xcode11.7
      env:
        - BUILD_DIR=unix
        - CFGOPT="--with-tcl=/usr/local/opt/tcl-tk/lib --disable-corefoundation --x-includes=/opt/X11/include --x-libraries=/opt/X11/lib CFLAGS=-I/usr/local/opt/tcl-tk/include"
      install:
        - ./configure ${CFGOPT} "--prefix=$HOME" || (cat config.log && exit 1)

declare 278 {
    void Tk_SendVirtualEvent(Tk_Window tkwin, const char *eventName,
	    Tcl_Obj *detail)
}
declare 279 {
    Tcl_Obj *Tk_FontGetDescription(Tk_Font tkfont)
}

# New in Tk8.7
declare 280 {
    void Tk_CreatePhotoImageFormatVersion3(
	    const Tk_PhotoImageFormatVersion3 *formatPtr)
}


# Define the platform specific public Tk interface.  These functions are
# only available on the designated platform.

interface tkPlat

################################

	Tcl_Obj *format, Tk_PhotoHandle imageHandle, int destX, int destY,
	int width, int height, int srcX, int srcY);
typedef int (Tk_ImageFileWriteProc) (Tcl_Interp *interp, const char *fileName,
	Tcl_Obj *format, Tk_PhotoImageBlock *blockPtr);
typedef int (Tk_ImageStringWriteProc) (Tcl_Interp *interp, Tcl_Obj *format,
	Tk_PhotoImageBlock *blockPtr);
#endif /* USE_OLD_IMAGE */

/*
 * The following alternate definitions are used with the Tk8.7 file format
 * supporting a metadata dict, internal dstring and close file flag
 */

typedef struct Tk_PhotoImageFormatVersion3 Tk_PhotoImageFormatVersion3;
typedef int (Tk_ImageFileMatchProcVersion3) (Tcl_Interp *interp,
	Tcl_Channel chan, const char *fileName, Tcl_Obj *format,
	Tcl_Obj *metadataIn, int *widthPtr, int *heightPtr,
	Tcl_Obj *metadataOut);
typedef int (Tk_ImageStringMatchProcVersion3) (Tcl_Interp *interp,
	Tcl_Obj *dataObj, Tcl_Obj *format, Tcl_Obj *metadataIn, int *widthPtr,
	int *heightPtr, Tcl_Obj *metadataOut);
typedef int (Tk_ImageFileReadProcVersion3) (Tcl_Interp *interp,
	Tcl_Channel chan,
	const char *fileName, Tcl_Obj *format, Tcl_Obj *metadataIn,
	Tk_PhotoHandle imageHandle,
	int destX, int destY, int width, int height, int srcX, int srcY,
	Tcl_Obj *metadataOut);
typedef int (Tk_ImageStringReadProcVersion3) (Tcl_Interp *interp,
	Tcl_Obj *dataObj, Tcl_Obj *format, Tcl_Obj *metadataIn,
	Tk_PhotoHandle imageHandle, int destX, int destY, int width, int height,
	int srcX, int srcY, Tcl_Obj *metadataOut);
typedef int (Tk_ImageFileWriteProcVersion3) (Tcl_Interp *interp,
	const char *fileName, Tcl_Obj *format, Tcl_Obj *metadataIn,
	Tk_PhotoImageBlock *blockPtr);
typedef int (Tk_ImageStringWriteProcVersion3) (Tcl_Interp *interp,
	Tcl_Obj *format, Tcl_Obj *metadataIn, Tk_PhotoImageBlock *blockPtr);


/*
 * The following structure represents a particular file format for storing
 * images (e.g., PPM, GIF, JPEG, etc.). It provides information to allow image
 * files of that format to be recognized and read into a photo image.
 */

				 * representation of the data in a photo
				 * image.*/
    struct Tk_PhotoImageFormat *nextPtr;
				/* Next in list of all photo image formats
				 * currently known. Filled in by Tk, not by
				 * image format handler. */
};

/*
 * The following structure is the same plus added support for the metadata
 * structure.
 */

struct Tk_PhotoImageFormatVersion3 {
    const char *name;		/* Name of image file format */
    Tk_ImageFileMatchProcVersion3 *fileMatchProc;
				/* Procedure to call to determine whether an
				 * image file matches this format. */
    Tk_ImageStringMatchProcVersion3 *stringMatchProc;
				/* Procedure to call to determine whether the
				 * data in a string matches this format. */
    Tk_ImageFileReadProcVersion3 *fileReadProc;
				/* Procedure to call to read data from an
				 * image file into a photo image. */
    Tk_ImageStringReadProcVersion3 *stringReadProc;
				/* Procedure to call to read data from a
				 * string into a photo image. */
    Tk_ImageFileWriteProcVersion3 *fileWriteProc;
				/* Procedure to call to write data from a
				 * photo image to a file. */
    Tk_ImageStringWriteProcVersion3 *stringWriteProc;
				/* Procedure to call to obtain a string
				 * representation of the data in a photo
				 * image.*/
    struct Tk_PhotoImageFormatVersion3 *nextPtr;
				/* Next in list of all photo image formats
				 * currently known. Filled in by Tk, not by
				 * image format handler. */
};

/*
 *----------------------------------------------------------------------
 *
 * Procedure prototypes and structures used for managing styles:
 *
 *----------------------------------------------------------------------

/* 277 */
EXTERN Tcl_Obj *	Tk_NewWindowObj(Tk_Window tkwin);
/* 278 */
EXTERN void		Tk_SendVirtualEvent(Tk_Window tkwin,
				const char *eventName, Tcl_Obj *detail);
/* 279 */
EXTERN Tcl_Obj *	Tk_FontGetDescription(Tk_Font tkfont);
/* 280 */
EXTERN void		Tk_CreatePhotoImageFormatVersion3(
				const Tk_PhotoImageFormatVersion3 *formatPtr);

typedef struct {
    const struct TkPlatStubs *tkPlatStubs;
    const struct TkIntStubs *tkIntStubs;
    const struct TkIntPlatStubs *tkIntPlatStubs;
    const struct TkIntXlibStubs *tkIntXlibStubs;
} TkStubHooks;

    void (*tk_CreateOldPhotoImageFormat) (const Tk_PhotoImageFormat *formatPtr); /* 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 */
} TkStubs;

extern const TkStubs *tkStubsPtr;

#ifdef __cplusplus
}
#endif

	(tkStubsPtr->tk_GetDoublePixelsFromObj) /* 276 */
#define Tk_NewWindowObj \
	(tkStubsPtr->tk_NewWindowObj) /* 277 */
#define Tk_SendVirtualEvent \
	(tkStubsPtr->tk_SendVirtualEvent) /* 278 */
#define Tk_FontGetDescription \
	(tkStubsPtr->tk_FontGetDescription) /* 279 */
#define Tk_CreatePhotoImageFormatVersion3 \
	(tkStubsPtr->tk_CreatePhotoImageFormatVersion3) /* 280 */

#endif /* defined(USE_TK_STUBS) */

/* !END!: Do not edit above this line. */

/* Functions that don't belong in the stub table */
#undef Tk_MainEx

/*
 * tkImage.c --
 *
 *	This module implements the image protocol, which allows lots of
 *	different kinds of images to be used in lots of different widgets.
 *
 * Copyright (c) 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.
 */

#include "tkImgPhoto.h"
#include "tkInt.h"

/*
 * Each call to Tk_GetImage returns a pointer to one of the following
 * structures, which is used as a token by clients (widgets) that display
 * images.
 */

Tk_ImageObjCmd(
    ClientData clientData,	/* Main window associated with interpreter. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument strings. */
{
    static const char *const imageOptions[] = {
	"create", "delete", "height", "inuse", "metadata", 
        "names", "type", "types", "width", NULL
    };
    enum options {
	IMAGE_CREATE, IMAGE_DELETE, IMAGE_HEIGHT, IMAGE_INUSE, IMAGE_METADATA,
        IMAGE_NAMES, IMAGE_TYPE, IMAGE_TYPES, IMAGE_WIDTH
    };
    TkWindow *winPtr = (TkWindow *)clientData;
    int i, isNew, firstOption, index;
    Tk_ImageType *typePtr;
    ImageModel *modelPtr;
    Image *imagePtr;
    Tcl_HashEntry *hPtr;

	for (typePtr = tsdPtr->oldImageTypeList; typePtr != NULL;
		typePtr = typePtr->nextPtr) {
	    Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(
		    typePtr->name, -1));
	}
	Tcl_SetObjResult(interp, resultObj);
	break;

    case IMAGE_METADATA: {
        int w = 0;
        int h = 0;
        Tcl_Channel chan;
        Tcl_Obj *metadataOutObj;
        Tk_PhotoImageFormat *imageFormat;
        Tk_PhotoImageFormatVersion3 *imageFormatVersion3;
        int oldformat;
        Tcl_DictSearch search;
        Tcl_Obj *key, *value;
        int done;
        char * xbmData;
        const char * fmt = "Unknown";
        int x_hot, y_hot;
        int foundImage = 0;
        const char * option;
        TkSizeT length;
        Tcl_Obj *dataObj = NULL;
        const char *fileName = NULL;

	if (objc < 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "?-file name? ?-data string?");
	    return TCL_ERROR;
	}
        option = TkGetStringFromObj(objv[2], &length);
	if (length <= 1 || option[0] != '-') {
	    Tcl_WrongNumArgs(interp, 2, objv, "?-file name? ?-data string?");
	    return TCL_ERROR;
        }
        if (length > 1) {
            if (option[1] == 'f' && (strncmp(option, "-file", length) == 0)) {
                fileName = Tcl_GetString(objv[3]);
            } else if (option[1] == 'd' && (strcmp(option, "-data") == 0)) {
                dataObj = objv[3];
            }
        }
        if (dataObj == NULL && fileName == NULL) {
	    Tcl_WrongNumArgs(interp, 2, objv, "?-file name? ?-data string?");
	    return TCL_ERROR;
        }

        metadataOutObj = Tcl_NewDictObj();
	Tcl_IncrRefCount(metadataOutObj);

        if (fileName != NULL) {
            xbmData = TkGetBitmapData(interp, NULL, fileName, &w, &h, &x_hot, &y_hot);
        } else {
            xbmData = TkGetBitmapData(interp, Tcl_GetString(dataObj), NULL, &w, &h, &x_hot, &y_hot);
        }
        if (xbmData != NULL) {
            foundImage = 1;
            fmt = "xbm"; 
        }

        if (!foundImage) {
            if (fileName != NULL) {
                chan = Tcl_OpenFileChannel(interp, fileName, "r", 0);
                if (chan == NULL) {
                    return TCL_ERROR;
                }
                if (Tcl_SetChannelOption(interp, chan, "-translation", "binary") != TCL_OK) {
                    Tcl_Close(NULL, chan);
                    return TCL_ERROR;
                }
                if (Tcl_SetChannelOption(interp, chan, "-encoding", "binary") != TCL_OK) {
                    Tcl_Close(NULL, chan);
                    return TCL_ERROR;
                }
                if (TkImgPhotoMatchFileFormat(
                        interp, chan, fileName, NULL, NULL, metadataOutObj,
                        &imageFormat, &imageFormatVersion3,
                        &w, &h, &oldformat) == TCL_OK) {
                    foundImage = 1;
                }
                Tcl_Close(NULL, chan);
            } else {
                if (TkImgMatchStringFormat(
                        interp, dataObj, NULL, NULL, metadataOutObj,
                        &imageFormat, &imageFormatVersion3,
                        &w, &h, &oldformat) == TCL_OK) {
                    foundImage = 1;
                }
            }
            if (foundImage) {
                if (imageFormat) {
                    fmt = imageFormat->name;
                }
                if (imageFormatVersion3) {
                    fmt = imageFormatVersion3->name;
                }
            }
        }

	resultObj = Tcl_NewDictObj();
        if (foundImage) {
	    Tcl_DictObjPut(interp, resultObj, Tcl_NewStringObj("format", -1), Tcl_NewStringObj(fmt, -1));
	    Tcl_DictObjPut(interp, resultObj, Tcl_NewStringObj("width",  -1), Tcl_NewWideIntObj(w));
	    Tcl_DictObjPut(interp, resultObj, Tcl_NewStringObj("height", -1), Tcl_NewWideIntObj(h));

	    if (Tcl_DictObjFirst(interp, metadataOutObj, &search, &key, &value, &done) != TCL_OK) {
		return TCL_ERROR;
	    }
	    for (; !done ; Tcl_DictObjNext(&search, &key, &value, &done)) {
		Tcl_DictObjPut(interp, resultObj, key, value);
	    }
	    Tcl_DictObjDone(&search); 
	}
	Tcl_DecrRefCount(metadataOutObj);
	Tcl_SetObjResult(interp, resultObj);
	break;
    }

    case IMAGE_HEIGHT:
    case IMAGE_INUSE:
    case IMAGE_TYPE:
    case IMAGE_WIDTH:
	/*
	 * These operations all parse virtually identically. First check to

typedef size_t (WriteBytesFunc) (ClientData clientData, const char *bytes,
			    size_t byteCount);

/*
 * The format record for the GIF file format:
 */

static int		FileMatchGIF(Tcl_Interp *interp, Tcl_Channel chan,
			    const char *fileName, Tcl_Obj *format,
			    Tcl_Obj *metadataInObj, int *widthPtr,
			    int *heightPtr, Tcl_Obj *metadataOutObj);
static int		FileReadGIF(Tcl_Interp *interp, Tcl_Channel chan,
			    const char *fileName, Tcl_Obj *format,
			    Tcl_Obj *metadataInObj, Tk_PhotoHandle imageHandle,
			    int destX, int destY, int width, int height,
			    int srcX, int srcY, Tcl_Obj *metadataOutObj);
static int		StringMatchGIF(Tcl_Interp *interp, Tcl_Obj *dataObj,
			    Tcl_Obj *format, Tcl_Obj *metadataInObj,
			    int *widthPtr, int *heightPtr,
			    Tcl_Obj *metadataOutObj);
static int		StringReadGIF(Tcl_Interp *interp, Tcl_Obj *dataObj,
			    Tcl_Obj *format, Tcl_Obj *metadataInObj,
			    Tk_PhotoHandle imageHandle,
			    int destX, int destY, int width, int height,
			    int srcX, int srcY, Tcl_Obj *metadataOutObj);
static int		FileWriteGIF(Tcl_Interp *interp, const char *filename,
			    Tcl_Obj *format, Tcl_Obj *metadataInObj,
			    Tk_PhotoImageBlock *blockPtr);
static int		StringWriteGIF(Tcl_Interp *interp, Tcl_Obj *format,
			    Tcl_Obj *metadataInObj,
			    Tk_PhotoImageBlock *blockPtr);
static int		CommonWriteGIF(Tcl_Interp *interp,
			    ClientData clientData,
			    WriteBytesFunc *writeProc, Tcl_Obj *format,
			    Tcl_Obj *metadataInObj,
			    Tk_PhotoImageBlock *blockPtr);

Tk_PhotoImageFormatVersion3 tkImgFmtGIF = {
    "gif",		/* name */
    FileMatchGIF,	/* fileMatchProc */
    StringMatchGIF,	/* stringMatchProc */
    FileReadGIF,	/* fileReadProc */
    StringReadGIF,	/* stringReadProc */
    FileWriteGIF,	/* fileWriteProc */
    StringWriteGIF,	/* stringWriteProc */

#define MAX_LWZ_BITS		12
#define LM_to_uint(a,b)		(((b)<<8)|(a))

/*
 * Prototypes for local functions defined in this file:
 */

static int		ReadOneByte(Tcl_Interp *interp,
			    GIFImageConfig *gifConfPtr, Tcl_Channel chan);
static int		DoExtension(GIFImageConfig *gifConfPtr,
			    Tcl_Channel chan, int label, unsigned char *buffer,
			    int *transparent, Tcl_Obj *metadataOutObj);
static int		GetCode(Tcl_Channel chan, int code_size, int flag,
			    GIFImageConfig *gifConfPtr);
static int		GetDataBlock(GIFImageConfig *gifConfPtr,
			    Tcl_Channel chan, unsigned char *buf);
static int		ReadColorMap(GIFImageConfig *gifConfPtr,
			    Tcl_Channel chan, int number,
			    unsigned char buffer[MAXCOLORMAPSIZE][4]);

 *	The access position in f may change.
 *
 *----------------------------------------------------------------------
 */

static int
FileMatchGIF(
    TCL_UNUSED(Tcl_Interp *),		/* not used */
    Tcl_Channel chan,		/* The image file, open for reading. */
    TCL_UNUSED(const char *),	/* The name of the image file. */
    TCL_UNUSED(Tcl_Obj *),		/* User-specified format object, or NULL. */
    TCL_UNUSED(Tcl_Obj *),	/* metadata input, may be NULL */
    int *widthPtr, int *heightPtr,
				/* The dimensions of the image are returned
				 * here if the file is a valid raw GIF file. */
    TCL_UNUSED(Tcl_Obj *))	/* metadata return dict, may be NULL */
{
    GIFImageConfig gifConf;




    memset(&gifConf, 0, sizeof(GIFImageConfig));
    return ReadGIFHeader(&gifConf, chan, widthPtr, heightPtr);
}

/*
 *----------------------------------------------------------------------

static int
FileReadGIF(
    Tcl_Interp *interp,		/* Interpreter to use for reporting errors. */
    Tcl_Channel chan,		/* The image file, open for reading. */
    const char *fileName,	/* The name of the image file. */
    Tcl_Obj *format,		/* User-specified format object, or NULL. */
    TCL_UNUSED(Tcl_Obj *),	/* metadata input, may be NULL */
    Tk_PhotoHandle imageHandle,	/* The photo image to write into. */
    int destX, int destY,	/* Coordinates of top-left pixel in photo
				 * image to be written to. */
    int width, int height,	/* Dimensions of block of photo image to be
				 * written to. */
    int srcX, int srcY,		/* Coordinates of top-left pixel to be used in
				 * image being read. */
    Tcl_Obj *metadataOutObj)	/* metadata return dict, may be NULL */
{
    int fileWidth, fileHeight, imageWidth, imageHeight;
    unsigned int nBytes;
    int index = 0, argc = 0, i, result = TCL_ERROR;
    Tcl_Obj **objv;
    unsigned char buf[100];
    unsigned char *trashBuffer = NULL;
    int bitPixel;
    int gifLabel;
    unsigned char colorMap[MAXCOLORMAPSIZE][4];
    int transparent = -1;
    static const char *const optionStrings[] = {
	"-index", NULL
    };
    GIFImageConfig gifConf, *gifConfPtr = &gifConf;

     */

    if (Tk_PhotoExpand(interp, imageHandle,
	    destX + width, destY + height) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * -------------------------------------------------------------------------
     * From here on, go to error to not leave memory leaks
     * -------------------------------------------------------------------------
     */

    /*
     * Search for the frame from the GIF to display.
     */

    while (1) {




	if (-1 == (gifLabel = ReadOneByte( interp, gifConfPtr, chan ) ) ) {




	    goto error;
	}

	switch (gifLabel) {
	case GIF_TERMINATOR:
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "no image data for this index", -1));
	    Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "NO_DATA", NULL);
	    goto error;

	case GIF_EXTENSION:
	    /*
	     * This is a GIF extension.
	     */

	    if (-1 == (gifLabel = ReadOneByte( interp, gifConfPtr, chan ) ) ) {





		goto error;
	    }
	    if (DoExtension(gifConfPtr, chan, gifLabel,
		    gifConfPtr->workingBuffer, &transparent, metadataOutObj)
		    < 0) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"error reading extension in GIF image", -1));
		Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "BAD_EXT",
			NULL);
		goto error;
	    }
	    continue;

	ckfree(block.pixelPtr);
    }

    /*
     * We've successfully read the GIF frame (or there was nothing to read,
     * which suits as well). We're done.
     */

    while (1) {
	if (-1 == (gifLabel = ReadOneByte( interp, gifConfPtr, chan ) ) ) {
	    goto error;
	}
	switch (gifLabel) {
	case GIF_TERMINATOR:
	    break;

	case GIF_EXTENSION:
	    /*
	     * This is a GIF extension.
	     */

	    if (-1 == (gifLabel = ReadOneByte( interp, gifConfPtr, chan ) ) ) {
		goto error;
	    }
	    if (DoExtension(gifConfPtr, chan, gifLabel,
		    gifConfPtr->workingBuffer, &transparent, metadataOutObj)
		    < 0) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"error reading extension in GIF image", -1));
		Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "BAD_EXT",
			NULL);
		goto error;
	    }
	    continue;
	case GIF_START:
	    /*
	     * There should not be a second image block - bail out without error
	     */
	    break;
	default:
	    /*
	     * Not a valid start character; ignore it.
	     */

	    continue;
	}
	break;
    }

    Tcl_SetObjResult(interp, Tcl_NewStringObj(tkImgFmtGIF.name, -1));
    result = TCL_OK;

error:
    
    /*
     * If a trash buffer has been allocated, free it now.
     */

    if (trashBuffer != NULL) {
	ckfree(trashBuffer);
    }
    return result;
}


/*
 *----------------------------------------------------------------------
 *
 * Read one Byte --
 *
 *	Read one byte (label byte) from the image stream.
 *
 * Results:
 *	The return value is 1 if the first characters in the data are like GIF
 *	data, and 0 otherwise.
 *
 * Side effects:
 *	The access position in the source is incremented.
 *
 *----------------------------------------------------------------------
 */

static int
ReadOneByte(
    Tcl_Interp *interp,		/* Interpreter to use for reporting errors. */
    GIFImageConfig *gifConfPtr,
    Tcl_Channel chan		/* The image file, open for reading. */
    )
{
    unsigned char buf[2];
    if (Fread(gifConfPtr, buf, 1, 1, chan) != 1) {
        /*
         * Premature end of image.
         */

        Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"premature end of image data", -1));
	Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "PREMATURE_END", NULL);
	return -1;
    }
    return buf[0];
}

/*
 *----------------------------------------------------------------------
 *
 * StringMatchGIF --
 *
 *	This function is invoked by the photo image type to see if an object
 *	contains image data in GIF format.
 *
 * Results:
 *	The return value is 1 if the first characters in the data are like GIF
 *	data, and 0 otherwise.
 *
 * Side effects:
 *	The size of the image is placed in widthPtr and heightPtr.
 *
 *----------------------------------------------------------------------
 */


static int
StringMatchGIF(
    TCL_UNUSED(Tcl_Interp *),		/* not used */
    Tcl_Obj *dataObj,		/* the object containing the image data */
    TCL_UNUSED(Tcl_Obj *),		/* the image format object, or NULL */
    TCL_UNUSED(Tcl_Obj *),	/* metadata input, may be NULL */
    int *widthPtr,		/* where to put the string width */
    int *heightPtr,		/* where to put the string height */

    TCL_UNUSED(Tcl_Obj *))	/* metadata return dict, may be NULL */
{
    unsigned char *data, header[10];
    TkSizeT got, length;
    MFile handle;



    data = TkGetByteArrayFromObj(dataObj, &length);

    /*
     * Header is a minimum of 10 bytes.
     */

 */

static int
StringReadGIF(
    Tcl_Interp *interp,		/* interpreter for reporting errors in */
    Tcl_Obj *dataObj,		/* object containing the image */
    Tcl_Obj *format,		/* format object, or NULL */
    Tcl_Obj *metadataInObj,	/* metadata input, may be NULL */
    Tk_PhotoHandle imageHandle,	/* the image to write this data into */
    int destX, int destY,	/* The rectangular region of the */
    int width, int height,	/* image to copy */
    int srcX, int srcY,
    Tcl_Obj *metadataOutObj)	/* metadata return dict, may be NULL */
{
    MFile handle, *hdlPtr = &handle;
    TkSizeT length;
    const char *xferFormat;
    unsigned char *data = TkGetByteArrayFromObj(dataObj, &length);

    mInit(data, hdlPtr, length);

    /*
     * Fall through to the file reader now that we have a correctly-configured
     * pseudo-channel to pull the data from.
     */

    return FileReadGIF(interp, (Tcl_Channel) hdlPtr, xferFormat, format,
	    metadataInObj, imageHandle, destX, destY, width, height, srcX, srcY,
	    metadataOutObj);
}

/*
 *----------------------------------------------------------------------
 *
 * ReadGIFHeader --
 *

	    buffer[i][CM_BLUE] = rgb[2];
	    buffer[i][CM_ALPHA] = 255;
	}
    }
    return 1;
}

/*
*----------------------------------------------------------------------
*
* DoExtension --
*
*	Process a GIF extension block
*
* Results:
*	-1 to trigger an extension read error
*       >= 0 ok
*
* Side effects:
*	The transparent color is set if present in current extensions
*       The data of the following extensions are saved to the metadata dict:
*       - Application extension
*         - Comment extension in key "comment"
*       Plain text extensions are currently ignored.
*
*----------------------------------------------------------------------
*/

static int
DoExtension(
    GIFImageConfig *gifConfPtr,
    Tcl_Channel chan,
    int label,
    unsigned char *buf, /* defined as 280 byte working buffer */
    int *transparent,
    Tcl_Obj *metadataOutObj)
{
    int count;
    /* Prepare extension name
     * Maximum string size: "comment" + Code(3) + trailing zero
     */
    char extensionStreamName[8];
    extensionStreamName[0] = '\0';

    switch (label) {
    case 0x01:			/* Plain Text Extension */

        /* this extension is ignored, skip below */

	break;







    case 0xf9:			/* Graphic Control Extension */
	count = GetDataBlock(gifConfPtr, chan, buf);
	if (count < 0) {
	    return -1;
	}
	if ((buf[0] & 0x1) != 0) {
	    *transparent = buf[3];
	}
	break;
    case 0xfe:			/* Comment Extension */
	strcpy(extensionStreamName,"comment");
        /* copy the extension data below */
	break;
    }
    /* Add extension to dict */
    if (NULL != metadataOutObj
	    && extensionStreamName[0] != '\0' ) {
	Tcl_Obj *ValueObj;
	int length = 0;
	for (;;) {
	    count = GetDataBlock(gifConfPtr, chan, buf);
	    switch (count) {
	    case -1: /* error */
		return -1;
	    case 0: /* end of data */
		if (length > 0) {
		    if ( TCL_OK != Tcl_DictObjPut(NULL, metadataOutObj,
			    Tcl_NewByteArrayObj(
				(unsigned char *)extensionStreamName,
			    strlen(extensionStreamName)), ValueObj)) {
			return -1;
		    }
		}
		/* return success */
		return 0;
	    default: /* block received */
		if (length == 0) {
		    /* first block */
		    ValueObj = Tcl_NewByteArrayObj(buf, count);
		    length = count;
		} else {
		    /* consecutive block */
		    unsigned char *bytePtr;
		    bytePtr = Tcl_SetByteArrayLength(ValueObj, length+count);
		    memcpy(bytePtr+length,buf,count);
		    length += count;
		}
		break;
	    }
	} /* for */
    }
    /* skip eventual remaining data block bytes */
    do {
	count = GetDataBlock(gifConfPtr, chan, buf);
    } while (count > 0);
    return count; /* this may be -1 for error or 0 */
}

static int
GetDataBlock(
    GIFImageConfig *gifConfPtr,
    Tcl_Channel chan,
    unsigned char *buf)

ReadImage(
    GIFImageConfig *gifConfPtr,
    Tcl_Interp *interp,
    unsigned char *imagePtr,
    Tcl_Channel chan,
    int len, int rows,
    unsigned char cmap[MAXCOLORMAPSIZE][4],
	TCL_UNUSED(int),
	TCL_UNUSED(int),
    int interlace,
    int transparent)
{
    unsigned char initialCodeSize;
    int xpos = 0, ypos = 0, pass = 0, i, count;
    unsigned char *pixelPtr;
    static const int interlaceStep[] = { 8, 8, 4, 2 };
    static const int interlaceStart[] = { 0, 4, 2, 1 };
    unsigned short prefix[(1 << MAX_LWZ_BITS)];
    unsigned char append[(1 << MAX_LWZ_BITS)];
    unsigned char stack[(1 << MAX_LWZ_BITS)*2];
    unsigned char *top;
    int codeSize, clearCode, inCode, endCode, oldCode, maxCode;
    int code, firstCode, v;



    /*
     * Initialize the decoder
     */

    if (((size_t)Fread(gifConfPtr, &initialCodeSize, 1, 1, chan) + 1) < 2) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(


static int
FileWriteGIF(
    Tcl_Interp *interp,		/* Interpreter to use for reporting errors. */
    const char *filename,
    Tcl_Obj *format,
    Tcl_Obj *metadataInObj,
    Tk_PhotoImageBlock *blockPtr)
{
    Tcl_Channel chan = NULL;
    int result;

    chan = Tcl_OpenFileChannel(interp, (char *) filename, "w", 0644);
    if (!chan) {
	return TCL_ERROR;
    }
    if (Tcl_SetChannelOption(interp, chan, "-translation",
	    "binary") != TCL_OK) {
	Tcl_Close(NULL, chan);
	return TCL_ERROR;
    }

    result = CommonWriteGIF(interp, chan, WriteToChannel, format, metadataInObj,
	    blockPtr);

    if (Tcl_Close(interp, chan) == TCL_ERROR) {
	return TCL_ERROR;
    }
    return result;
}

static int
StringWriteGIF(
    Tcl_Interp *interp,		/* Interpreter to use for reporting errors and
				 * returning the GIF data. */
    Tcl_Obj *format,
    Tcl_Obj *metadataInObj,
    Tk_PhotoImageBlock *blockPtr)
{
    int result;
    Tcl_Obj *objPtr = Tcl_NewObj();

    Tcl_IncrRefCount(objPtr);
    result = CommonWriteGIF(interp, objPtr, WriteToByteArray, format,
	    metadataInObj, blockPtr);
    if (result == TCL_OK) {
	Tcl_SetObjResult(interp, objPtr);
    }
    Tcl_DecrRefCount(objPtr);
    return result;
}

}

static int
CommonWriteGIF(
    Tcl_Interp *interp,
    ClientData handle,
    WriteBytesFunc *writeProc,
    TCL_UNUSED(Tcl_Obj *),
    Tcl_Obj *metadataInObj,
    Tk_PhotoImageBlock *blockPtr)
{
    GifWriterState state;
    int resolution;
    long width, height, x;
    unsigned char c;
    unsigned int top, left;


    top = 0;
    left = 0;

    memset(&state, 0, sizeof(state));

    state.pixelSize = blockPtr->pixelSize;

    state.ssize = state.rsize = blockPtr->width;
    state.csize = blockPtr->height;
    Compress(resolution+1, handle, writeProc, ReadValue, &state);

    c = 0;
    writeProc(handle, (char *) &c, 1);
    /*
     * Check for metadata keys to add to file
     */
    if (NULL != metadataInObj) {
	Tcl_Obj *itemData;
	
	/*
	 * Check and code comment block
	 */
	
	if (TCL_ERROR == Tcl_DictObjGet(interp, metadataInObj,
		Tcl_NewStringObj("comment",-1),
		&itemData)) {
	    return TCL_ERROR;
	}
	if (itemData != NULL) {
	    int length;
	    unsigned char *comment;
	    comment = Tcl_GetByteArrayFromObj(itemData, &length);
	    if (length > 0) {
		/* write comment header */
		writeProc(handle, (char *) "\x21\xfe", 2);
		/* write comment blocks */
		for (;length > 0;) {
		    int blockLength;
		    unsigned char blockLengthChar;
		    if (length > 255) {
			length -=255;
			blockLength = 255;
		    } else {
			blockLength = length;
			length = 0;
		    }
		    blockLengthChar = (unsigned char) blockLength;
		    writeProc(handle, (char *) &blockLengthChar, 1);
		    writeProc(handle, (char *) comment, blockLength);
		    comment += blockLength;
		}
		/* Block terminator */
		c = 0;
		writeProc(handle, (char *) &c, 1);
	    }
	}
    }
    c = GIF_TERMINATOR;
    writeProc(handle, (char *) &c, 1);

    return TCL_OK;
}

static int

    Tcl_ZlibStream stream;	/* Inflating or deflating stream; this one is
				 * not bound to a Tcl command. */
    Tcl_Obj *lastLineObj;	/* Last line of pixels, for unfiltering. */
    Tcl_Obj *thisLineObj;	/* Current line of pixels to process. */
    int lineSize;		/* Number of bytes in a PNG line. */
    int phaseSize;		/* Number of bytes/line in current phase. */


    /*
     * Physical size: pHYS chunks.
     */
    
    double DPI;
    double aspect;

} PNGImage;

/*
 * Maximum size of various chunks.
 */

#define	PNG_PLTE_MAXSZ 768	/* 3 bytes/RGB entry, 256 entries max */

			    unsigned long calculated);
static void		CleanupPNGImage(PNGImage *pngPtr);
static int		DecodeLine(Tcl_Interp *interp, PNGImage *pngPtr);
static int		DecodePNG(Tcl_Interp *interp, PNGImage *pngPtr,
			    Tcl_Obj *fmtObj, Tk_PhotoHandle imageHandle,
			    int destX, int destY);
static int		EncodePNG(Tcl_Interp *interp,
			    Tk_PhotoImageBlock *blockPtr, PNGImage *pngPtr,
			    Tcl_Obj *metadataInObj);
static int		FileMatchPNG(Tcl_Interp *interp, Tcl_Channel chan,
			    const char *fileName, Tcl_Obj *fmtObj,
			    Tcl_Obj *metadataInObj, int *widthPtr,
			    int *heightPtr, Tcl_Obj *metadataOut);
static int		FileReadPNG(Tcl_Interp *interp, Tcl_Channel chan,
			    const char *fileName, Tcl_Obj *fmtObj,
			    Tcl_Obj *metadataInObj, Tk_PhotoHandle imageHandle,
			    int destX, int destY, int width, int height,
			    int srcX, int srcY, Tcl_Obj *metadataOutPtr);
static int		FileWritePNG(Tcl_Interp *interp, const char *filename,
			    Tcl_Obj *fmtObj, Tcl_Obj *metadataInObj,
			    Tk_PhotoImageBlock *blockPtr);
static int		InitPNGImage(Tcl_Interp *interp, PNGImage *pngPtr,
			    Tcl_Channel chan, Tcl_Obj *objPtr, int dir);
static inline unsigned char Paeth(int a, int b, int c);
static int		ParseFormat(Tcl_Interp *interp, Tcl_Obj *fmtObj,
			    PNGImage *pngPtr);
static int		ReadBase64(Tcl_Interp *interp, PNGImage *pngPtr,
			    unsigned char *destPtr, size_t destSz,

			    unsigned long *resultPtr, unsigned long *crcPtr);
static int		ReadPLTE(Tcl_Interp *interp, PNGImage *pngPtr,
			    int chunkSz, unsigned long crc);
static int		ReadTRNS(Tcl_Interp *interp, PNGImage *pngPtr,
			    int chunkSz, unsigned long crc);
static int		SkipChunk(Tcl_Interp *interp, PNGImage *pngPtr,
			    int chunkSz, unsigned long crc);
static int		StringMatchPNG(Tcl_Interp *interp, Tcl_Obj *pObjData,
			    Tcl_Obj *fmtObj, Tcl_Obj *metadataInObj,
			    int *widthPtr, int *heightPtr,
			    Tcl_Obj *metadataOutObj);
static int		StringReadPNG(Tcl_Interp *interp, Tcl_Obj *pObjData,
			    Tcl_Obj *fmtObj, Tcl_Obj *metadataInObj,
			    Tk_PhotoHandle imageHandle,
			    int destX, int destY, int width, int height,
			    int srcX, int srcY, Tcl_Obj *metadataOutObj);

static int		StringWritePNG(Tcl_Interp *interp, Tcl_Obj *fmtObj,
			    Tcl_Obj *metadataInObj,
			    Tk_PhotoImageBlock *blockPtr);
static int		UnfilterLine(Tcl_Interp *interp, PNGImage *pngPtr);
static inline int	WriteByte(Tcl_Interp *interp, PNGImage *pngPtr,
			    unsigned char c, unsigned long *crcPtr);
static inline int	WriteChunk(Tcl_Interp *interp, PNGImage *pngPtr,
			    unsigned long chunkType,
			    const unsigned char *dataPtr, size_t dataSize);
static int		WriteData(Tcl_Interp *interp, PNGImage *pngPtr,
			    const unsigned char *srcPtr, size_t srcSz,
			    unsigned long *crcPtr);
static int		WriteExtraChunks(Tcl_Interp *interp,
			    PNGImage *pngPtr, Tcl_Obj *metadataInObj);
static int		WriteIHDR(Tcl_Interp *interp, PNGImage *pngPtr,
			    Tk_PhotoImageBlock *blockPtr);
static int		WriteIDAT(Tcl_Interp *interp, PNGImage *pngPtr,
			    Tk_PhotoImageBlock *blockPtr);
static inline int	WriteInt32(Tcl_Interp *interp, PNGImage *pngPtr,
			    unsigned long l, unsigned long *crcPtr);

/*
 * The format record for the PNG file format:
 */

Tk_PhotoImageFormatVersion3 tkImgFmtPNG = {
    "png",			/* name */
    FileMatchPNG,		/* fileMatchProc */
    StringMatchPNG,		/* stringMatchProc */
    FileReadPNG,		/* fileReadProc */
    StringReadPNG,		/* stringReadProc */
    FileWritePNG,		/* fileWriteProc */
    StringWritePNG,		/* stringWriteProc */

	    Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "ZLIB_INIT", NULL);
	}
	if (objPtr) {
	    Tcl_DecrRefCount(objPtr);
	}
	return TCL_ERROR;
    }
    
    /*
     * Initialize physical size pHYS values
     */
    
    pngPtr->DPI = -1;
    pngPtr->aspect = -1;

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

	    /*
	     * These chunk types are required and/or supported.
	     */

	case CHUNK_IDAT:
	case CHUNK_IEND:
	case CHUNK_IHDR:
	case CHUNK_pHYs:
	case CHUNK_PLTE:
	case CHUNK_tRNS:
	    break;

	    /*
	     * These chunk types are part of the standard, but are not used by
	     * this implementation (at least not yet). Note that these are all
	     * ancillary chunks (lowercase first letter).
	     */

	case CHUNK_bKGD:
	case CHUNK_cHRM:
	case CHUNK_gAMA:
	case CHUNK_hIST:
	case CHUNK_iCCP:
	case CHUNK_iTXt:
	case CHUNK_oFFs:
	case CHUNK_pCAL:

	case CHUNK_sBIT:
	case CHUNK_sCAL:
	case CHUNK_sPLT:
	case CHUNK_sRGB:
	case CHUNK_tEXt:
	case CHUNK_tIME:
	case CHUNK_zTXt:

	pngPtr->useTRNS = 1;
	break;
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ReadPHYS --
 *
 *	This function reads the PHYS (physical size) chunk data from
 *	the PNG file and populates the fields in the PNGImage
 *	structure.
 *
 * Results:
 *	TCL_OK, or TCL_ERROR if an I/O error occurs or the PHYS chunk is
 *	invalid.
 *
 * Side effects:
 *	The access position in f advances.
 *
 *----------------------------------------------------------------------
 */

static int
ReadPHYS(
    Tcl_Interp *interp,
    PNGImage *pngPtr,
    int chunkSz,
    unsigned long crc)
{
    unsigned long PPUx, PPUy;
    char unitSpecifier;

    /*
     * Check chunk size equal 9 bytes
     */

    if (chunkSz != 9) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"invalid physical chunk size", -1));
	Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_PHYS", NULL);
	return TCL_ERROR;
    }

    /*
     * Read the chunk data
     * 4 bytes: Pixels per unit, x axis
     * 4 bytes: Pixels per unit, y axis
     * 1 byte: unit specifier
     */
    
    if (ReadInt32(interp, pngPtr, &PPUx, &crc) == TCL_ERROR) {
	return TCL_ERROR;
    }
    if (ReadInt32(interp, pngPtr, &PPUy, &crc) == TCL_ERROR) {
	return TCL_ERROR;
    }
    if (ReadData(interp, pngPtr, (unsigned char *)&unitSpecifier, 1, &crc) == TCL_ERROR) {
	return TCL_ERROR;
    }

    if (CheckCRC(interp, pngPtr, crc) == TCL_ERROR) {
	return TCL_ERROR;
    }
    
    if ( PPUx > 2147483647 || PPUy > 2147483647
	    || unitSpecifier > 1 ) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"invalid physical size value", -1));
	Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_PHYS", NULL);
	return TCL_ERROR;
    }

    if (PPUx > 0) {
	pngPtr->aspect = ((double) PPUy) / ((double) PPUx);
    }
    if (1 == unitSpecifier) {
	pngPtr->DPI = ((double) PPUx) * 0.0254;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Paeth --
 *
 *	Utility function for applying the Paeth filter to a pixel. The Paeth
 *	filter is a linear function of the pixel to be filtered and the pixels

     * PLTE is mandatory for color type 3 and forbidden for 2 and 6
     */

    if (ReadChunkHeader(interp, pngPtr, &chunkSz, &chunkType,
	    &crc) == TCL_ERROR) {
	return TCL_ERROR;
    }

    /*
     * Physical header may be present here so try to parse it
     */
    
    if (CHUNK_pHYs == chunkType) {
	/*
	 * Finish parsing the PHYS chunk.
	 */

	if (ReadPHYS(interp, pngPtr, chunkSz, crc) == TCL_ERROR) {
	    return TCL_ERROR;
	}

	/*
	 * Begin the next chunk.
	 */

	if (ReadChunkHeader(interp, pngPtr, &chunkSz, &chunkType,
		&crc) == TCL_ERROR) {
	    return TCL_ERROR;
	}
    }

    if (CHUNK_PLTE == chunkType) {
	/*
	 * Finish parsing the PLTE chunk.
	 */

	if (ReadPLTE(interp, pngPtr, chunkSz, crc) == TCL_ERROR) {

	/*
	 * Finish parsing the tRNS chunk.
	 */

	if (ReadTRNS(interp, pngPtr, chunkSz, crc) == TCL_ERROR) {
	    return TCL_ERROR;
	}

	/*
	 * Begin the next chunk.
	 */

	if (ReadChunkHeader(interp, pngPtr, &chunkSz, &chunkType,
		&crc) == TCL_ERROR) {
	    return TCL_ERROR;
	}
    }

    /*
     * Physical header may be present here so try to parse it
     */
    
    if (CHUNK_pHYs == chunkType) {
	/*
	 * Finish parsing the PHYS chunk.
	 */

	if (ReadPHYS(interp, pngPtr, chunkSz, crc) == TCL_ERROR) {
	    return TCL_ERROR;
	}

	/*
	 * Begin the next chunk.
	 */

	if (ReadChunkHeader(interp, pngPtr, &chunkSz, &chunkType,
		&crc) == TCL_ERROR) {

 *	The access position in f may change.
 *
 *----------------------------------------------------------------------
 */

static int
FileMatchPNG(
    Tcl_Interp *interp,		/* Interpreter to use for reporting errors. */
    Tcl_Channel chan,		/* The image file, open for reading. */
    TCL_UNUSED(const char *),	/* The name of the image file. */
    TCL_UNUSED(Tcl_Obj *),		/* User-specified format object, or NULL. */
    TCL_UNUSED(Tcl_Obj *),	/* metadata input, may be NULL */
    int *widthPtr, int *heightPtr,

				/* The dimensions of the image are returned
				 * here if the file is a valid raw GIF file. */
    TCL_UNUSED(Tcl_Obj *))	/* metadata return dict, may be NULL */
{
    PNGImage png;
    int match = 0;



    InitPNGImage(NULL, &png, chan, NULL, TCL_ZLIB_STREAM_INFLATE);

    if (ReadIHDR(interp, &png) == TCL_OK) {
	*widthPtr = png.block.width;
	*heightPtr = png.block.height;
	match = 1;

 *	image given by imageHandle.
 *
 *----------------------------------------------------------------------
 */

static int
FileReadPNG(
    Tcl_Interp *interp,		/* Interpreter to use for reporting errors. */
    Tcl_Channel chan,		/* The image file, open for reading. */
    TCL_UNUSED(const char *),	/* The name of the image file. */
    Tcl_Obj *fmtObj,		/* User-specified format object, or NULL. */
    TCL_UNUSED(Tcl_Obj *),	/* metadata input, may be NULL */
    Tk_PhotoHandle imageHandle,	/* The photo image to write into. */
    int destX, int destY,	/* Coordinates of top-left pixel in photo

				 * image to be written to. */
    TCL_UNUSED(int),	/* Dimensions of block of photo image to be
				 * written to. */
    TCL_UNUSED(int),
    TCL_UNUSED(int),		/* Coordinates of top-left pixel to be used in
				 * image being read. */
    TCL_UNUSED(int),
    Tcl_Obj *metadataOutObj)	/* metadata return dict, may be NULL */
{
    PNGImage png;
    int result = TCL_ERROR;






    result = InitPNGImage(interp, &png, chan, NULL, TCL_ZLIB_STREAM_INFLATE);

    if (TCL_OK == result) {
	result = DecodePNG(interp, &png, fmtObj, imageHandle, destX, destY);
    }

    if (TCL_OK == result && metadataOutObj != NULL && png.DPI != -1) {
	result = Tcl_DictObjPut(NULL, metadataOutObj,
		Tcl_NewStringObj("DPI",-1),
		Tcl_NewDoubleObj(png.DPI));
    }

    if (TCL_OK == result && metadataOutObj != NULL && png.aspect != -1) {
	result = Tcl_DictObjPut(NULL, metadataOutObj,
		Tcl_NewStringObj("aspect",-1),
		Tcl_NewDoubleObj(png.aspect));
    }

    CleanupPNGImage(&png);
    return result;
}

/*
 *----------------------------------------------------------------------

 *	The size of the image is placed in widthPre and heightPtr.
 *
 *----------------------------------------------------------------------
 */

static int
StringMatchPNG(
    Tcl_Interp *interp,		/* Interpreter to use for reporting errors. */
    Tcl_Obj *pObjData,		/* the object containing the image data */
    TCL_UNUSED(Tcl_Obj *),		/* the image format object, or NULL */
    TCL_UNUSED(Tcl_Obj *),	/* metadata input, may be NULL */
    int *widthPtr,		/* where to put the string width */
    int *heightPtr,		/* where to put the string height */
    TCL_UNUSED(Tcl_Obj *))	/* metadata return dict, may be NULL */
{
    PNGImage png;
    int match = 0;


    InitPNGImage(NULL, &png, NULL, pObjData, TCL_ZLIB_STREAM_INFLATE);

    png.strDataBuf = TkGetByteArrayFromObj(pObjData, &png.strDataLen);

    if (ReadIHDR(interp, &png) == TCL_OK) {
	*widthPtr = png.block.width;

 *	New data is added to the image given by imageHandle.
 *
 *----------------------------------------------------------------------
 */

static int
StringReadPNG(
    Tcl_Interp *interp,		/* interpreter for reporting errors in */
    Tcl_Obj *pObjData,		/* object containing the image */
    Tcl_Obj *fmtObj,		/* format object, or NULL */
    TCL_UNUSED(Tcl_Obj *),	/* metadata input, may be NULL */
    Tk_PhotoHandle imageHandle,	/* the image to write this data into */
    int destX, int destY,	/* The rectangular region of the */
    TCL_UNUSED(int),	/* image to copy */
    TCL_UNUSED(int),

    TCL_UNUSED(int),
    TCL_UNUSED(int),
    Tcl_Obj *metadataOutObj)	/* metadata return dict, may be NULL */
{
    PNGImage png;
    int result = TCL_ERROR;





    result = InitPNGImage(interp, &png, NULL, pObjData,
	    TCL_ZLIB_STREAM_INFLATE);

    if (TCL_OK == result) {
	result = DecodePNG(interp, &png, fmtObj, imageHandle, destX, destY);
    }

    if (TCL_OK == result && metadataOutObj != NULL && png.DPI != -1) {
	result = Tcl_DictObjPut(NULL, metadataOutObj,
		Tcl_NewStringObj("DPI",-1),
		Tcl_NewDoubleObj(png.DPI));
    }

    if (TCL_OK == result && metadataOutObj != NULL && png.aspect != -1) {
	result = Tcl_DictObjPut(NULL, metadataOutObj,
		Tcl_NewStringObj("aspect",-1),
		Tcl_NewDoubleObj(png.aspect));
    }

    CleanupPNGImage(&png);
    return result;
}

/*
 *----------------------------------------------------------------------

{
    return WriteData(interp, pngPtr, &c, 1, crcPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * LongToInt32 --
 *
 *	This function transforms to a 32-bit integer value as
 *	four bytes in network byte order.
 *
 * Results:
 *	None
 *
 * Side effects:
 *	Buffer will be modified.
 *
 *----------------------------------------------------------------------
 */

static inline void
LongToInt32(
    unsigned long l,
    unsigned char *pc)
{
    pc[0] = (unsigned char) ((l & 0xff000000) >> 24);
    pc[1] = (unsigned char) ((l & 0x00ff0000) >> 16);
    pc[2] = (unsigned char) ((l & 0x0000ff00) >> 8);
    pc[3] = (unsigned char) ((l & 0x000000ff) >> 0);
}

/*
 *----------------------------------------------------------------------
 *
 * WriteInt32 --
 *
 *	This function writes a 32-bit integer value out to the PNG image as
 *	four bytes in network byte order.
 *
 * Results:
 *	TCL_OK, or TCL_ERROR if the write fails.

WriteInt32(
    Tcl_Interp *interp,
    PNGImage *pngPtr,
    unsigned long l,
    unsigned long *crcPtr)
{
    unsigned char pc[4];
    LongToInt32(l,pc);





    return WriteData(interp, pngPtr, pc, 4, crcPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * WriteChunk --

 *
 *----------------------------------------------------------------------
 */

static int
WriteExtraChunks(
    Tcl_Interp *interp,
    PNGImage *pngPtr,
    Tcl_Obj *metadataInObj)
{
    static const unsigned char sBIT_contents[] = {
	8, 8, 8, 8
    };
    int sBIT_length = 4;
    Tcl_DString buf;

    if (WriteChunk(interp, pngPtr, CHUNK_tEXt,
	    (unsigned char *) Tcl_DStringValue(&buf),
	    Tcl_DStringLength(&buf)) != TCL_OK) {
	Tcl_DStringFree(&buf);
	return TCL_ERROR;
    }
    Tcl_DStringFree(&buf);
    
    /*
     * Add a pHYs chunk if there is metadata for DPI and/or aspect
     * aspect = PPUy / PPUx
     * DPI = PPUx * 0.0254
     * The physical chunc consists of:
     * - Points per meter in x direction (32 bit)
     * - Points per meter in x direction (32 bit)
     * - Unit specifier: 0: no unit (only aspect), 1: Points per meter
     */
    
    if (metadataInObj != NULL) {
	
	Tcl_Obj *aspectObj, *DPIObj;
	double aspectValue=-1, DPIValue=-1;
	unsigned long PPUx = 65536, PPUy = 65536;
	char unitSpecifier;
	
	if (TCL_ERROR == Tcl_DictObjGet(interp, metadataInObj,
		Tcl_NewStringObj("aspect",-1),
		&aspectObj) ||
	    TCL_ERROR == Tcl_DictObjGet(interp, metadataInObj,
		Tcl_NewStringObj("DPI",-1),
		&DPIObj) ) {
	    return TCL_ERROR;
	}
	if (DPIObj != NULL) {
	    if (TCL_ERROR == Tcl_GetDoubleFromObj(interp, DPIObj, &DPIValue))
	    {
		return TCL_ERROR;
	    }
	    PPUx = (unsigned long)floor(DPIValue / 0.0254+0.5);
	    if (aspectObj == NULL) {
		PPUy = PPUx;
	    }
	    unitSpecifier = 1;
	}
	if (aspectObj != NULL) {
	    if (TCL_ERROR == Tcl_GetDoubleFromObj(interp, aspectObj,
		    &aspectValue)) {
		return TCL_ERROR;
	    }

	    /*
	     * aspect = PPUy / PPUx
	     */
	    
	    if (DPIObj == NULL) {
		unitSpecifier = 0;
		PPUx = 65536;
		PPUy = (unsigned long)floor(65536.0 * aspectValue+0.5);
	    } else {
		PPUy = (unsigned long)floor(DPIValue * aspectValue / 0.0254+0.5);
	    }
	}
	if (DPIObj != NULL || aspectObj != NULL) {
	    unsigned char buffer[9];

	    if ( PPUx > 2147483647 || PPUy > 2147483647 ) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"DPI or aspect out of range", -1));
		Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "PHYS", NULL);
		return TCL_ERROR;
	    }
	    
	    LongToInt32(PPUx, buffer);
	    LongToInt32(PPUy, buffer+4);
	    buffer[8] = unitSpecifier;
	    if (WriteChunk(interp, pngPtr, CHUNK_pHYs, buffer, 9)
		    != TCL_OK) {
		return TCL_ERROR;
	    }
	}
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * EncodePNG --

 *----------------------------------------------------------------------
 */

static int
EncodePNG(
    Tcl_Interp *interp,
    Tk_PhotoImageBlock *blockPtr,
    PNGImage *pngPtr,
    Tcl_Obj *metadataInObj)
{
    int greenOffset, blueOffset, alphaOffset;

    /*
     * Determine appropriate color type based on color usage (e.g., only red
     * and maybe alpha channel = grayscale).
     *

    }

    /*
     * Write out the extra chunks containing metadata that is of interest to
     * other programs more than us.
     */

    if (WriteExtraChunks(interp, pngPtr, metadataInObj) == TCL_ERROR) {
	return TCL_ERROR;
    }

    /*
     * Write out the image pixels in the IDAT (data) chunk.
     */

 *----------------------------------------------------------------------
 */

static int
FileWritePNG(
    Tcl_Interp *interp,
    const char *filename,
    TCL_UNUSED(Tcl_Obj *),
    Tcl_Obj *metadataInObj,
    Tk_PhotoImageBlock *blockPtr)
{
    Tcl_Channel chan;
    PNGImage png;
    int result = TCL_ERROR;


    /*
     * Open a Tcl file channel where the image data will be stored. Tk ought
     * to take care of this, and just provide a channel, but it doesn't.
     */

    chan = Tcl_OpenFileChannel(interp, filename, "w", 0644);

	goto cleanup;
    }

    /*
     * Write the raw PNG data out to the file.
     */

    result = EncodePNG(interp, blockPtr, &png, metadataInObj);

  cleanup:
    Tcl_Close(interp, chan);
    CleanupPNGImage(&png);
    return result;
}


 *
 *----------------------------------------------------------------------
 */

static int
StringWritePNG(
    Tcl_Interp *interp,
    TCL_UNUSED(Tcl_Obj *),
    Tcl_Obj *metadataInObj,
    Tk_PhotoImageBlock *blockPtr)
{
    Tcl_Obj *resultObj = Tcl_NewObj();
    PNGImage png;
    int result = TCL_ERROR;


    /*
     * Initalize PNGImage instance for encoding.
     */

    if (InitPNGImage(interp, &png, NULL, resultObj,
	    TCL_ZLIB_STREAM_DEFLATE) == TCL_ERROR) {
	goto cleanup;
    }

    /*
     * Write the raw PNG data into the prepared Tcl_Obj buffer. Set the result
     * back to the interpreter if successful.
     */

    result = EncodePNG(interp, blockPtr, &png, metadataInObj);

    if (TCL_OK == result) {
	Tcl_SetObjResult(interp, png.objDataPtr);
    }

  cleanup:
    CleanupPNGImage(&png);

    int toX2, toY2;		/* Second coordinate pair for -to option. */
    int zoomX, zoomY;		/* Values specified for -zoom option. */
    int subsampleX, subsampleY;	/* Values specified for -subsample option. */
    Tcl_Obj *format;		/* Value specified for -format option. */
    XColor *background;		/* Value specified for -background option. */
    int compositingRule;	/* Value specified for -compositingrule
				 * option. */
    Tcl_Obj *metadata;		/* Value specified for -metadata option. */
};

/*
 * Bit definitions for use with ParseSubcommandOptions: each bit is set in the
 * allowedOptions parameter on a call to ParseSubcommandOptions if that option
 * is allowed for the current photo image subcommand. On return, the bit is
 * set in the options field of the SubcommandOptions structure if that option
 * was specified.
 *
 * OPT_ALPHA:			Set if -alpha option allowed/specified.
 * OPT_BACKGROUND:		Set if -format option allowed/specified.
 * OPT_COMPOSITE:		Set if -compositingrule option allowed/spec'd.
 * OPT_FORMAT:			Set if -format option allowed/specified.
 * OPT_FROM:			Set if -from option allowed/specified.
 * OPT_GRAYSCALE:		Set if -grayscale option allowed/specified.
 * OPT_METADATA:		Set if -metadata option allowed/specified.
 * OPT_SHRINK:			Set if -shrink option allowed/specified.
 * OPT_SUBSAMPLE:		Set if -subsample option allowed/spec'd.
 * OPT_TO:			Set if -to option allowed/specified.
 * OPT_WITHALPHA:		Set if -withalpha option allowed/specified.
 * OPT_ZOOM:			Set if -zoom option allowed/specified.
 */

#define OPT_ALPHA	1
#define OPT_BACKGROUND	2
#define OPT_COMPOSITE	4
#define OPT_FORMAT	8
#define OPT_FROM	0x10
#define OPT_GRAYSCALE	0x20
#define OPT_METADATA	0x40
#define OPT_SHRINK	0x80
#define OPT_SUBSAMPLE	0x100
#define OPT_TO		0x200
#define OPT_WITHALPHA	0x400
#define OPT_ZOOM	0x800

/*
 * List of option names. The order here must match the order of declarations
 * of the OPT_* constants above.
 */

static const char *const optionNames[] = {
    "-alpha",
    "-background",
    "-compositingrule",
    "-format",
    "-from",
    "-grayscale",
    "-metadata",
    "-shrink",
    "-subsample",
    "-to",
    "-withalpha",
    "-zoom",
    NULL
};

				/* Pointer to the first in the list of known
				 * photo image formats.*/
#if !defined(TK_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
    Tk_PhotoImageFormat *oldFormatList;
				/* Pointer to the first in the list of known
				 * photo image formats.*/
#endif
    Tk_PhotoImageFormatVersion3 *formatListVersion3;
				/* Pointer to the first in the list of known
				 * photo image formats in Version3 format.*/
    int initialized;		/* Set to 1 if we've initialized the
				 * structure. */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * Default configuration

			    Tcl_Obj *const objv[], int flags);
static int		ToggleComplexAlphaIfNeeded(PhotoModel *mPtr);
static int		ImgPhotoSetSize(PhotoModel *modelPtr, int width,
			    int height);
static char *		ImgGetPhoto(PhotoModel *modelPtr,
			    Tk_PhotoImageBlock *blockPtr,
			    struct SubcommandOptions *optPtr);








static const char *	GetExtension(const char *path);

/*
 *----------------------------------------------------------------------
 *
 * PhotoFormatThreadExitProc --
 *
 *	Clean up the registered list of photo formats.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The thread's linked lists of photo image formats is deleted.
 *
 *----------------------------------------------------------------------
 */

static void
PhotoFormatThreadExitProc(
    TCL_UNUSED(void *))	/* not used */
{
    Tk_PhotoImageFormat *freePtr;
    Tk_PhotoImageFormatVersion3 *freePtrVersion3;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));


#if !defined(TK_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
    while (tsdPtr->oldFormatList != NULL) {
	freePtr = tsdPtr->oldFormatList;
	tsdPtr->oldFormatList = tsdPtr->oldFormatList->nextPtr;
	ckfree(freePtr);
    }
#endif
    while (tsdPtr->formatList != NULL) {
	freePtr = tsdPtr->formatList;
	tsdPtr->formatList = tsdPtr->formatList->nextPtr;
	ckfree((char *)freePtr->name);
	ckfree(freePtr);
    }
    while (tsdPtr->formatListVersion3 != NULL) {
	freePtrVersion3 = tsdPtr->formatListVersion3;
	tsdPtr->formatListVersion3 = tsdPtr->formatListVersion3->nextPtr;
	ckfree((char *)freePtrVersion3->name);
	ckfree(freePtrVersion3);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_CreateOldPhotoImageFormat, Tk_CreatePhotoImageFormat,
 * Tk_CreatePhotoImageFormatVersion3 --
 *
 *	This function is invoked by an image file handler to register a new
 *	photo image format and the functions that handle the new format. The
 *	function is typically invoked during Tcl_AppInit.
 *
 * Results:
 *	None.

	char *name = (char *)ckalloc(strlen(formatPtr->name) + 1);
	strcpy(name, formatPtr->name);
	copyPtr->name = name;
	copyPtr->nextPtr = tsdPtr->formatList;
	tsdPtr->formatList = copyPtr;
    }
}
void
Tk_CreatePhotoImageFormatVersion3(
    const Tk_PhotoImageFormatVersion3 *formatPtr)
				/* Structure describing the format. All of the
				 * fields except "nextPtr" must be filled in
				 * by caller. */
{
    Tk_PhotoImageFormatVersion3 *copyPtr;
    char *name;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (!tsdPtr->initialized) {
	tsdPtr->initialized = 1;
	Tcl_CreateThreadExitHandler(PhotoFormatThreadExitProc, NULL);
    }
    copyPtr = (Tk_PhotoImageFormatVersion3 *)
	    ckalloc(sizeof(Tk_PhotoImageFormatVersion3));
    *copyPtr = *formatPtr;
    /* for compatibility with aMSN: make a copy of formatPtr->name */
    name = (char *)ckalloc(strlen(formatPtr->name) + 1);
    strcpy(name, formatPtr->name);
    copyPtr->name = name;
    copyPtr->nextPtr = tsdPtr->formatListVersion3;
    tsdPtr->formatListVersion3 = copyPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * ImgPhotoCreate --
 *
 *	This function is called by the Tk image code to create a new photo

ImgPhotoCreate(
    Tcl_Interp *interp,		/* Interpreter for application containing
				 * image. */
    const char *name,		/* Name to use for image. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[],	/* Argument objects for options (doesn't
				 * include image name or type). */
    TCL_UNUSED(const Tk_ImageType *),/* Pointer to our type record (not used). */
    Tk_ImageModel model,	/* Token for image, to be used by us in later
				 * callbacks. */
    ClientData *clientDataPtr)	/* Store manager's token for image here; it
				 * will be returned in later callbacks. */
{
    PhotoModel *modelPtr;


    /*
     * Allocate and initialize the photo image model record.
     */

    modelPtr = (PhotoModel *)ckalloc(sizeof(PhotoModel));
    memset(modelPtr, 0, sizeof(PhotoModel));

    PhotoModel *modelPtr = (PhotoModel *)clientData;
    int result, index, x, y, width, height;
    struct SubcommandOptions options;
    unsigned char *pixelPtr;
    Tk_PhotoImageBlock block;
    Tk_PhotoImageFormat *imageFormat;
    Tk_PhotoImageFormatVersion3 *imageFormatVersion3;
    TkSizeT length;
    int imageWidth, imageHeight, matched, oldformat = 0;
    Tcl_Channel chan;
    Tk_PhotoHandle srcHandle;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

	    if (modelPtr->dataString) {
		Tcl_SetObjResult(interp, modelPtr->dataString);
	    }
	} else if (strncmp(arg,"-format", length) == 0) {
	    if (modelPtr->format) {
		Tcl_SetObjResult(interp, modelPtr->format);
	    }
	} else if (strncmp(arg, "-metadata", length) == 0) {
	    if (modelPtr->metadata) {
		Tcl_SetObjResult(interp, modelPtr->metadata);
	    }
	} else {
	    Tk_ConfigureValue(interp, Tk_MainWindow(interp), configSpecs,
		    (char *) modelPtr, Tcl_GetString(objv[2]), 0);
	}
	return TCL_OK;
    }

	    }
	    Tcl_ListObjAppendElement(interp, obj, subobj);
	    subobj = Tcl_NewStringObj("-format {} {} {}", 16);
	    if (modelPtr->format) {
		Tcl_ListObjAppendElement(NULL, subobj, modelPtr->format);
	    } else {
		Tcl_AppendStringsToObj(subobj, " {}", NULL);
	    }
	    Tcl_ListObjAppendElement(interp, obj, subobj);
	    subobj = Tcl_NewStringObj("-metadata {} {} {}", 16);
	    if (modelPtr->metadata) {
		Tcl_ListObjAppendElement(NULL, subobj, modelPtr->metadata);
	    } else {
		Tcl_AppendStringsToObj(subobj, " {}", NULL);
	    }
	    Tcl_ListObjAppendElement(interp, obj, subobj);
	    Tcl_ListObjAppendList(interp, obj, Tcl_GetObjResult(interp));
	    Tcl_SetObjResult(interp, obj);
	    return TCL_OK;

	} else if (objc == 3) {

		if (modelPtr->format) {
		    /*
		     * TODO: Modifying result is bad!
		     */

		    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
			    modelPtr->format);
		} else {
		    Tcl_AppendResult(interp, " {}", NULL);
		}
		return TCL_OK;
	    } else if (length > 1 &&
		!strncmp(arg, "-metadata", length)) {
		Tcl_AppendResult(interp, "-metadata {} {} {}", NULL);
		if (modelPtr->metadata) {
		    /*
		     * TODO: Modifying result is bad!
		     */

		    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
			modelPtr->metadata);
		} else {
		    Tcl_AppendResult(interp, " {}", NULL);
		}
		return TCL_OK;
	    } else {
		return Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
			configSpecs, (char *) modelPtr, arg, 0);

	    Tk_FreeColor(options.background);
	}
	return result;

    case PHOTO_DATA: {
        char *data = NULL;
        Tcl_Obj *freeObj = NULL;
	Tcl_Obj *metadataIn;

	/*
	 * photo data command - first parse and check any options given.
	 */

	Tk_ImageStringWriteProc *stringWriteProc = NULL;
	Tk_ImageStringWriteProcVersion3 *stringWriteProcVersion3 = NULL;

	index = 1;
	memset(&options, 0, sizeof(options));
	options.name = NULL;
	options.format = NULL;
	options.metadata = NULL;
	options.fromX = 0;
	options.fromY = 0;
	if (ParseSubcommandOptions(&options, interp,
		OPT_FORMAT | OPT_FROM | OPT_GRAYSCALE | OPT_BACKGROUND
		| OPT_METADATA,
		&index, objc, objv) != TCL_OK) {
	    return TCL_ERROR;
	}
	if ((options.name == NULL) || (index < objc)) {
	    Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...?");
	    return TCL_ERROR;
	}

	    options.fromX2 = modelPtr->width;
	    options.fromY2 = modelPtr->height;
	}
	if (!(options.options & OPT_FORMAT)) {
            options.format = Tcl_NewStringObj("default", -1);
            freeObj = options.format;
	}
	
	/*
	 * Use argument metadata if specified, otherwise the model metadata
	 */
	
	if (NULL != options.metadata) {
	    metadataIn = options.metadata;
	} else {
	    metadataIn = modelPtr->metadata;
	}

	/*
	 * Search for an appropriate image string format handler.
	 */

	matched = 0;
	for (imageFormat = tsdPtr->formatList; imageFormat != NULL;

                        break;
                    }
                }
	    }
	}
#endif
	if (stringWriteProc == NULL) {
	    oldformat = 0;
	    for (imageFormatVersion3 = tsdPtr->formatListVersion3;
		    imageFormatVersion3 != NULL;
		    imageFormatVersion3 = imageFormatVersion3->nextPtr) {
		if ((strncasecmp(Tcl_GetString(options.format),
			imageFormatVersion3->name,
			strlen(imageFormatVersion3->name)) == 0)) {
		    matched = 1;
		    if (imageFormatVersion3->stringWriteProc != NULL) {
			stringWriteProcVersion3 =
				imageFormatVersion3->stringWriteProc;
			break;
		    }
		}
	    }
	}
	if (stringWriteProc == NULL && stringWriteProcVersion3 == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "image string format \"%s\" is %s",
		    Tcl_GetString(options.format),
		    (matched ? "not supported" : "unknown")));
	    Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT",
		    Tcl_GetString(options.format), NULL);
	    goto dataErrorExit;
	}

	/*
	 * Call the handler's string write function to write out the image.
	 */

	data = ImgGetPhoto(modelPtr, &block, &options);

	if (stringWriteProc == NULL) {
	    result = (stringWriteProcVersion3)(interp,
		    options.format, metadataIn, &block);
	} else if (oldformat) {
	    Tcl_DString buffer;
	    typedef int (*OldStringWriteProc)(Tcl_Interp *interp,
		    Tcl_DString *dataPtr, const char *formatString,
		    Tk_PhotoImageBlock *blockPtr);

	    Tcl_DStringInit(&buffer);
	    result = ((OldStringWriteProc)(void *)stringWriteProc)(interp, &buffer,

	 * photo put command - first parse the options.
	 */

	index = 2;
	memset(&options, 0, sizeof(options));
	options.name = NULL;
	options.format = NULL;
	options.metadata = NULL;
	if (ParseSubcommandOptions(&options, interp,
		OPT_TO|OPT_FORMAT|OPT_METADATA,
		&index, objc, objv) != TCL_OK) {
	    return TCL_ERROR;
	}
	if ((options.name == NULL) || (index < objc)) {
	    Tcl_WrongNumArgs(interp, 2, objv, "data ?-option value ...?");
	    return TCL_ERROR;
	}

	/*
	 * See if there's a format that can read the data
	 */

	if (TkImgMatchStringFormat(interp, objv[2], options.format,
		options.metadata, NULL, &imageFormat,
		&imageFormatVersion3, &imageWidth, &imageHeight, &oldformat)
		!= TCL_OK) {
	    return TCL_ERROR;
	}

	if (!(options.options & OPT_TO) || (options.toX2 < 0)) {
	    options.toX2 = options.toX + imageWidth;
	    options.toY2 = options.toY + imageHeight;
	}

	if (oldformat) {
	    if (format) {
		format = (Tcl_Obj *) Tcl_GetString(format);
	    }
	    data = (Tcl_Obj *) Tcl_GetString(data);
	}

	if (imageFormat != NULL) {
	    if (imageFormat->stringReadProc(interp, data, format,
		    (Tk_PhotoHandle) modelPtr, options.toX, options.toY,
		    options.toX2 - options.toX,
		    options.toY2 - options.toY, 0, 0) != TCL_OK) {
		return TCL_ERROR;
	    }
	} else {
	    if (imageFormatVersion3->stringReadProc(interp, data, format,
		    options.metadata,
		    (Tk_PhotoHandle) modelPtr, options.toX, options.toY,
		    options.toX2 - options.toX,
		    options.toY2 - options.toY, 0, 0,
		    NULL)
		    != TCL_OK) {
		return TCL_ERROR;
	    }
	}

	/*
	 * SB: is the next line really needed? The stringReadProc
	 * writes image data with Tk_PhotoPutBlock(), which in turn
	 * takes care to notify the changed image and to set/unset the
	 * IMAGE_CHANGED bit.
	 */
	modelPtr->flags |= IMAGE_CHANGED;

	return TCL_OK;
    }
    case PHOTO_READ: {
	Tcl_Obj *format;
	int result;

	/*
	 * photo read command - first parse the options specified.
	 */

	index = 2;
	memset(&options, 0, sizeof(options));
	options.name = NULL;
	options.format = NULL;
	options.metadata = NULL;
	if (ParseSubcommandOptions(&options, interp,
		OPT_FORMAT | OPT_FROM | OPT_TO | OPT_SHRINK | OPT_METADATA,
		&index, objc, objv) != TCL_OK) {
	    return TCL_ERROR;
	}
	if ((options.name == NULL) || (index < objc)) {
	    Tcl_WrongNumArgs(interp, 2, objv, "fileName ?-option value ...?");
	    return TCL_ERROR;
	}

	}
	if (Tcl_SetChannelOption(interp, chan, "-encoding", "binary")
		!= TCL_OK) {
	    Tcl_Close(NULL, chan);
	    return TCL_ERROR;
	}

	if (TkImgPhotoMatchFileFormat(interp, chan,
		Tcl_GetString(options.name), options.format,
		options.metadata, NULL, &imageFormat,
		&imageFormatVersion3, &imageWidth, &imageHeight, &oldformat)

		!= TCL_OK) {
	    result = TCL_ERROR;
	    goto readCleanup;
	}

	/*
	 * Check the values given for the -from option.
	 */

	if ((options.fromX > imageWidth) || (options.fromY > imageHeight)
		|| (options.fromX2 > imageWidth)
		|| (options.fromY2 > imageHeight)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "coordinates for -from option extend outside source image",
		    -1));
	    Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_FROM", NULL);

	    result = TCL_ERROR;
	    goto readCleanup;
	}
	if (!(options.options & OPT_FROM) || (options.fromX2 < 0)) {
	    width = imageWidth - options.fromX;
	    height = imageHeight - options.fromY;
	} else {
	    width = options.fromX2 - options.fromX;
	    height = options.fromY2 - options.fromY;
	}

	/*
	 * If the -shrink option was specified, set the size of the image.
	 */

	if (options.options & OPT_SHRINK) {
	    if (ImgPhotoSetSize(modelPtr, options.toX + width,
		    options.toY + height) != TCL_OK) {
		Tcl_ResetResult(interp);
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1));
		Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL);

		result = TCL_ERROR;
		goto readCleanup;
	    }
	}

	/*
	 * Call the handler's file read function to read the data into the
	 * image.
	 */

	format = options.format;
	if (oldformat && format) {
	    format = (Tcl_Obj *) Tcl_GetString(format);
	}
	if (imageFormat != NULL) {
	    result = imageFormat->fileReadProc(interp, chan,
		    Tcl_GetString(options.name),
		    format, (Tk_PhotoHandle) modelPtr, options.toX,
		    options.toY, width, height, options.fromX, options.fromY);
	} else {
	    result = imageFormatVersion3->fileReadProc(interp, chan,
		    Tcl_GetString(options.name),
		    format, options.metadata, (Tk_PhotoHandle) modelPtr,
		    options.toX, options.toY, width, height, options.fromX,
		    options.fromY, NULL);
	}
readCleanup:
	if (chan != NULL) {
	    Tcl_Close(NULL, chan);
	}
	return result;
    }

    case PHOTO_REDITHER:

	}
	Tcl_Panic("unexpected fallthrough");
    }

    case PHOTO_WRITE: {
	char *data;
	const char *fmtString;
	Tcl_Obj *format, *metadataIn;
	int usedExt;

	/*
	 * Prevent file system access in safe interpreters.
	 */

	if (Tcl_IsSafe(interp)) {

	 * photo write command - first parse and check any options given.
	 */

	index = 2;
	memset(&options, 0, sizeof(options));
	options.name = NULL;
	options.format = NULL;
	options.metadata = NULL;
	if (ParseSubcommandOptions(&options, interp,
		OPT_FORMAT | OPT_FROM | OPT_GRAYSCALE | OPT_BACKGROUND
		| OPT_METADATA,
		&index, objc, objv) != TCL_OK) {
	    return TCL_ERROR;
	}
	if ((options.name == NULL) || (index < objc)) {
	    Tcl_WrongNumArgs(interp, 2, objv, "fileName ?-option value ...?");
	    return TCL_ERROR;
	}

	    fmtString = GetExtension(Tcl_GetString(options.name));
	    usedExt = (fmtString != NULL);
	} else {
	    fmtString = Tcl_GetString(options.format);
	    usedExt = 0;
	}

	
	/*
	 * Use argument metadata if specified, otherwise the model metadata
	 */
	
	if (NULL != options.metadata) {
	    metadataIn = options.metadata;
	} else {
	    metadataIn = modelPtr->metadata;
	}

	/*
	 * Search for an appropriate image file format handler, and give an
	 * error if none is found.
	 */

	matched = 0;
    redoFormatLookup:
	imageFormatVersion3 = NULL;
	for (imageFormat = tsdPtr->formatList; imageFormat != NULL;
		imageFormat = imageFormat->nextPtr) {
	    if ((fmtString == NULL)
		    || (strncasecmp(fmtString, imageFormat->name,
			    strlen(imageFormat->name)) == 0)) {
		matched = 1;
		if (imageFormat->fileWriteProc != NULL) {

		    matched = 1;
		    if (imageFormat->fileWriteProc != NULL) {
			break;
		    }
		}
	    }
	}
	if (imageFormat == NULL) {
	    oldformat = 0;
	    for (imageFormatVersion3 = tsdPtr->formatListVersion3;
		    imageFormatVersion3 != NULL;
		    imageFormatVersion3 = imageFormatVersion3->nextPtr) {
		if ((fmtString == NULL)
			|| (strncasecmp(fmtString, imageFormatVersion3->name,
				strlen(imageFormatVersion3->name)) == 0)) {
		    matched = 1;
		    if (imageFormatVersion3->fileWriteProc != NULL) {
			break;
		    }
		}
	    }
	}
#endif
	if (usedExt && !matched) {
	    /*
	     * If we didn't find one and we're using file extensions as the
	     * basis for the guessing, go back and look again without
	     * prejudice. Supports old broken code.
	     */

	    usedExt = 0;
	    fmtString = NULL;
	    goto redoFormatLookup;
	}
	if (imageFormat == NULL && imageFormatVersion3 == NULL) {
	    if (fmtString == NULL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"no available image file format has file writing"
			" capability", -1));
	    } else if (!matched) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"image file format \"%s\" is unknown", fmtString));

	 */

	data = ImgGetPhoto(modelPtr, &block, &options);
	format = options.format;
	if (oldformat && format) {
	    format = (Tcl_Obj *) Tcl_GetString(options.format);
	}
	if (imageFormat != NULL) {
	    result = imageFormat->fileWriteProc(interp,
		    Tcl_GetString(options.name), format, &block);
	} else {
	    result = imageFormatVersion3->fileWriteProc(interp,
		    Tcl_GetString(options.name), format, metadataIn,
		    &block);
	}
	if (options.background) {
	    Tk_FreeColor(options.background);
	}
	if (data) {
	    ckfree(data);
	}
	return result;

/*
 *----------------------------------------------------------------------
 *
 * ParseSubcommandOptions --
 *
 *	This function is invoked to process one of the options which may be
 *	specified for the photo image subcommands, namely, -from, -to, -zoom,
 *	-subsample, -format, -shrink, -compositingrule, -alpha, -boolean,
 *	-withalpha and -metadata.
 *	Parsing starts at the index in *optIndexPtr and stops at the end of
 *	objv[] or at the first value that does not belong to an option.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:

	     */

	    if (index + 1 >= objc) {
		goto oneValueRequired;
	    }
	    *optIndexPtr = ++index;
	    optPtr->format = objv[index];
	} else if (bit == OPT_METADATA) {
	    /*
	    * The -metadata option takes a single dict value. Note that
	    * parsing this is outside the scope of this function.
	    */

	    if (index + 1 >= objc) {
		goto oneValueRequired;
	    }
	    *optIndexPtr = ++index;
	    optPtr->metadata = objv[index];
	} else if (bit == OPT_COMPOSITE) {
	    /*
	     * The -compositingrule option takes a single value from a
	     * well-known set.
	     */

	    if (index + 1 >= objc) {

    int objc,			/* Number of entries in objv. */
    Tcl_Obj *const objv[],	/* Pairs of configuration options for image. */
    int flags)			/* Flags to pass to Tk_ConfigureWidget, such
				 * as TK_CONFIG_ARGV_ONLY. */
{
    PhotoInstance *instancePtr;
    const char *oldFileString, *oldPaletteString;
    Tcl_Obj *oldData, *data = NULL, *oldFormat, *format = NULL,
	    *metadataInObj = NULL, *metadataOutObj = NULL;
    Tcl_Obj *tempdata, *tempformat;
    TkSizeT length;
    int i, j, result, imageWidth, imageHeight, oldformat;
    double oldGamma;
    Tcl_Channel chan;
    Tk_PhotoImageFormat *imageFormat;
    Tk_PhotoImageFormatVersion3 *imageFormatVersion3;
    const char **args;

    args = (const char **)ckalloc((objc + 1) * sizeof(char *));
    for (i = 0, j = 0; i < objc; i++,j++) {
	args[j] = TkGetStringFromObj(objv[i], &length);
	if ((length > 1) && (args[j][0] == '-')) {
	    if ((args[j][1] == 'd') &&

		} else {
		    ckfree(args);
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "value for \"-format\" missing", -1));
		    Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
			    "MISSING_VALUE", NULL);
		    return TCL_ERROR;
		}
	    } else if ((args[j][1] == 'm') &&
		!strncmp(args[j], "-metadata", length)) {
		if (++i < objc) {
		    metadataInObj = objv[i];
		    j--;
		} else {
		    ckfree(args);
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"value for \"-metadata\" missing", -1));
		    Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
			"MISSING_VALUE", NULL);
		    return TCL_ERROR;
		}
	    }
	}
    }

    /*
     * Save the current values for fileString and dataString, so we can tell

	    j, args, (char *) modelPtr, flags) != TCL_OK) {
	ckfree(args);
	goto errorExit;
    }
    ckfree(args);

    /*
     * Regard the empty string for -file, -data, -format or -metadata as the null value.
     */

    if ((modelPtr->fileString != NULL) && (modelPtr->fileString[0] == 0)) {
	ckfree(modelPtr->fileString);
	modelPtr->fileString = NULL;
    }
    if (data) {

	    format = NULL;
	}
	if (modelPtr->format) {
	    Tcl_DecrRefCount(modelPtr->format);
	}
	modelPtr->format = format;
    }
    if (metadataInObj) {
	/*
	 * make -metadata a dict.
	 * Take also empty metadatas as this may be a sign to replace
	 * existing metadata.
	 */
	int dictSize;

	if (TCL_OK != Tcl_DictObjSize(interp,metadataInObj, &dictSize)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "value for \"-metadata\" not a dict", -1));
	    Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
		    "UNRECOGNIZED_DATA", NULL);
	    return TCL_ERROR;
	}

	if (dictSize > 0) {
	    Tcl_IncrRefCount(metadataInObj);
	} else {
	    metadataInObj = NULL;
	}
	if (modelPtr->metadata) {
	    Tcl_DecrRefCount(modelPtr->metadata);
	}
	modelPtr->metadata = metadataInObj;
    }
    /*
     * Set the image to the user-requested size, if any, and make sure storage
     * is correctly allocated for this image.
     */

    if (ImgPhotoSetSize(modelPtr, modelPtr->width,
	    modelPtr->height) != TCL_OK) {

     * Read in the image from the file or string if the user has specified the
     * -file or -data option.
     */

    if ((modelPtr->fileString != NULL)
	    && ((modelPtr->fileString != oldFileString)
	    || (modelPtr->format != oldFormat))) {

	/*
	 * Prevent file system access in a safe interpreter.
	 */

	if (Tcl_IsSafe(interp)) {
	    Tcl_ResetResult(interp);
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "can't get image from a file in a safe interpreter",
		    -1));
	    Tcl_SetErrorCode(interp, "TK", "SAFE", "PHOTO_FILE", NULL);
	    goto errorExit;
	}

	chan = Tcl_OpenFileChannel(interp, modelPtr->fileString, "r", 0);
	if (chan == NULL) {
	    goto errorExit;
	}

	/*
	 * Flag that we want the metadata result dict
	 */

	metadataOutObj = Tcl_NewDictObj();
	Tcl_IncrRefCount(metadataOutObj);

	/*
	 * -translation binary also sets -encoding binary
	 */

	if ((Tcl_SetChannelOption(interp, chan,
		"-translation", "binary") != TCL_OK) ||
		(TkImgPhotoMatchFileFormat(interp, chan, modelPtr->fileString,
			modelPtr->format, modelPtr->metadata, metadataOutObj,
			&imageFormat, &imageFormatVersion3,
			&imageWidth, &imageHeight, &oldformat) != TCL_OK)) {
	    Tcl_Close(NULL, chan);
	    goto errorExit;
	}
	result = ImgPhotoSetSize(modelPtr, imageWidth, imageHeight);
	if (result != TCL_OK) {
	    Tcl_Close(NULL, chan);
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1));
	    Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL);
	    goto errorExit;
	}
	tempformat = modelPtr->format;
	if (oldformat && tempformat) {
	    tempformat = (Tcl_Obj *) Tcl_GetString(tempformat);
	}
	if (imageFormat != NULL) {
	    result = imageFormat->fileReadProc(interp, chan,
		    modelPtr->fileString, tempformat,
		    (Tk_PhotoHandle) modelPtr,
		    0, 0, imageWidth, imageHeight, 0, 0);
	} else {
	    result = imageFormatVersion3->fileReadProc(interp, chan,
		    modelPtr->fileString, tempformat, modelPtr->metadata,
		    (Tk_PhotoHandle) modelPtr,
		    0, 0, imageWidth, imageHeight, 0, 0,
		    metadataOutObj);
	}

	Tcl_Close(NULL, chan);
	if (result != TCL_OK) {
	    goto errorExit;
	}

	Tcl_ResetResult(interp);
	modelPtr->flags |= IMAGE_CHANGED;
    }

    if ((modelPtr->fileString == NULL) && (modelPtr->dataString != NULL)
	    && ((modelPtr->dataString != oldData)
		    || (modelPtr->format != oldFormat))) {

	/*
	 * Flag that we want the metadata result dict
	 */

	metadataOutObj = Tcl_NewDictObj();
	Tcl_IncrRefCount(metadataOutObj);

	if (TkImgMatchStringFormat(interp, modelPtr->dataString,
		modelPtr->format, modelPtr->metadata, metadataOutObj,
		&imageFormat, &imageFormatVersion3, &imageWidth,
		&imageHeight, &oldformat) != TCL_OK) {
	    goto errorExit;
	}
	if (ImgPhotoSetSize(modelPtr, imageWidth, imageHeight) != TCL_OK) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1));
	    Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL);
	    goto errorExit;
	}
	tempformat = modelPtr->format;
	tempdata = modelPtr->dataString;
	if (oldformat) {
	    if (tempformat) {
		tempformat = (Tcl_Obj *) Tcl_GetString(tempformat);
	    }
	    tempdata = (Tcl_Obj *) Tcl_GetString(tempdata);
	}
	if (imageFormat != NULL) {
	    if (imageFormat->stringReadProc(interp, tempdata, tempformat,
		    (Tk_PhotoHandle) modelPtr, 0, 0, imageWidth, imageHeight,
		    0, 0) != TCL_OK) {
		goto errorExit;
	    }
	} else {
	    
	    if (imageFormatVersion3->stringReadProc(interp, tempdata, tempformat,
		    modelPtr->metadata, (Tk_PhotoHandle) modelPtr, 0, 0,
		    imageWidth, imageHeight, 0, 0, metadataOutObj) != TCL_OK) {
		goto errorExit;
	    }
	}

	Tcl_ResetResult(interp);
	modelPtr->flags |= IMAGE_CHANGED;
    }

    /*
     * Merge driver returned metadata and model metadata
     */
    if (metadataOutObj != NULL) {
	int dictSize;
	if (TCL_OK != Tcl_DictObjSize(interp,metadataOutObj, &dictSize)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "driver metadata not a dict", -1));
	    Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
		    "UNRECOGNIZED_DATA", NULL);
	    goto errorExit;
	}
	if (dictSize > 0) {

	    /*
	     * We have driver return metadata
	     */
	    
	    if (modelPtr->metadata == NULL) {
		modelPtr->metadata = metadataOutObj;
		metadataOutObj = NULL;
	    } else {
		Tcl_DictSearch search;
		Tcl_Obj *key, *value;
		int done;

		if (Tcl_IsShared(modelPtr->metadata)) {
		    Tcl_DecrRefCount(modelPtr->metadata);
		    modelPtr->metadata = Tcl_DuplicateObj(modelPtr->metadata);
		    Tcl_IncrRefCount(modelPtr->metadata);
		}

		if (Tcl_DictObjFirst(interp, metadataOutObj, &search, &key,
			&value, &done) != TCL_OK) {
		    goto errorExit;
		}
		for (; !done ; Tcl_DictObjNext(&search, &key, &value, &done)) {
		    Tcl_DictObjPut(interp, modelPtr->metadata, key, value);
		}
	    }
	}
    }

    /*
     * Enforce a reasonable value for gamma.
     */

    if (modelPtr->gamma <= 0) {
	modelPtr->gamma = 1.0;

    if (oldData != NULL) {
	Tcl_DecrRefCount(oldData);
    }
    if (oldFormat != NULL) {
	Tcl_DecrRefCount(oldFormat);
    }
    if (metadataOutObj != NULL) {
	Tcl_DecrRefCount(metadataOutObj);
    }

    ToggleComplexAlphaIfNeeded(modelPtr);

    return TCL_OK;

  errorExit:
    if (oldData != NULL) {
	Tcl_DecrRefCount(oldData);
    }
    if (oldFormat != NULL) {
	Tcl_DecrRefCount(oldFormat);
    }
    if (metadataOutObj != NULL) {
	Tcl_DecrRefCount(metadataOutObj);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * ToggleComplexAlphaIfNeeded --

    }
    if (modelPtr->dataString != NULL) {
	Tcl_DecrRefCount(modelPtr->dataString);
    }
    if (modelPtr->format != NULL) {
	Tcl_DecrRefCount(modelPtr->format);
    }
    if (modelPtr->metadata != NULL) {
	Tcl_DecrRefCount(modelPtr->metadata);
    }
    Tk_FreeOptions(configSpecs, (char *) modelPtr, NULL, 0);
    ckfree(modelPtr);
}

/*
 *----------------------------------------------------------------------
 *

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TkImgPhotoMatchFileFormat --
 *
 *	This function is called to find a photo image file format handler
 *	which can parse the image data in the given file. If a user-specified
 *	format string is provided, only handlers whose names match a prefix of
 *	the format string are tried.
 *
 * Results:
 *	A standard TCL return value. If the return value is TCL_OK, a pointer
 *	to the image format record is returned in *imageFormatPtr or
 *	*imageFormatVersion3Ptr, and the width and height of the image are
 *	returned in *widthPtr and *heightPtr.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TkImgPhotoMatchFileFormat(
    Tcl_Interp *interp,		/* Interpreter to use for reporting errors. */
    Tcl_Channel chan,		/* The image file, open for reading. */
    const char *fileName,	/* The name of the image file. */
    Tcl_Obj *formatObj,		/* User-specified format string, or NULL. */
    Tcl_Obj *metadataInObj,	/* User-specified metadata, may be NULL */
    Tcl_Obj *metadataOutObj,	/* metadata to return, may be NULL */
    Tk_PhotoImageFormat **imageFormatPtr,
				/* A pointer to the photo image format record
				 * is returned here. For formatVersion3, this is
				 * set to NULL */
    Tk_PhotoImageFormatVersion3 **imageFormatVersion3Ptr,
				/* A pointer to the photo image formatVersion3
				 * record is returned here. For non
				 * formatVersion3, this is set to NULL*/
    int *widthPtr, int *heightPtr,
				/* The dimensions of the image are returned
				 * here. */
    int *oldformat)		/* Returns 1 if the old image API is used. */
{
    int matched = 0;
    int useoldformat = 0;
    Tk_PhotoImageFormat *formatPtr;
    Tk_PhotoImageFormatVersion3 *formatVersion3Ptr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    const char *formatString = NULL;

    if (formatObj) {
	formatString = Tcl_GetString(formatObj);
    }

		    break;
		}
	    }
	}
    }
#endif

    /*
     * For old and not version 3 format, exit now with success
     */

    if (formatPtr != NULL) {
	*imageFormatPtr = formatPtr;
	*imageFormatVersion3Ptr = NULL;
	*oldformat = useoldformat;
	(void) Tcl_Seek(chan, Tcl_LongAsWide(0L), SEEK_SET);
	return TCL_OK;
    }

    /*
     * Scan through the table of file format version 3 handlers to find one
     * which can handle the image.
     */

    for (formatVersion3Ptr = tsdPtr->formatListVersion3;
	    formatVersion3Ptr != NULL;
	    formatVersion3Ptr = formatVersion3Ptr->nextPtr) {
	if (formatObj != NULL) {
	    if (strncasecmp(formatString,
		    formatVersion3Ptr->name, strlen(formatVersion3Ptr->name))
		    != 0) {
		continue;
	    }
	    matched = 1;
	    if (formatVersion3Ptr->fileMatchProc == NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"-file option isn't supported for %s images",
			formatString));
		Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
			"NOT_FILE_FORMAT", NULL);
		return TCL_ERROR;
	    }
	}
	if (formatVersion3Ptr->fileMatchProc != NULL) {
	    (void) Tcl_Seek(chan, Tcl_LongAsWide(0L), SEEK_SET);

	    if (formatVersion3Ptr->fileMatchProc(interp, chan, fileName,
		    formatObj, metadataInObj, widthPtr, heightPtr,
		    metadataOutObj)) {
		if (*widthPtr < 1) {
		    *widthPtr = 1;
		}
		if (*heightPtr < 1) {
		    *heightPtr = 1;
		}
		*imageFormatVersion3Ptr = formatVersion3Ptr;
		*imageFormatPtr = NULL;
		*oldformat = 0;
		(void) Tcl_Seek(chan, Tcl_LongAsWide(0L), SEEK_SET);
		return TCL_OK;
	    }

	    /*
	     * Clear eventual set keys in the metadata object
	     */

	    if (metadataOutObj != NULL) {
		int dictSize;
		if (TCL_OK != Tcl_DictObjSize(interp,metadataOutObj, &dictSize)
			|| dictSize > 0) {
		    /*
		     * Driver has modified the metadata dict, so clear it
		     */
		    Tcl_DecrRefCount(metadataOutObj);
		    metadataOutObj = Tcl_NewDictObj();
		    Tcl_IncrRefCount(metadataOutObj);
		}
	    }
	}
    }
    
    /*
     * No matching format found
     */

    if ((formatObj != NULL) && !matched) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"image file format \"%s\" is not supported",
		formatString));
	Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT",
		formatString, NULL);
    } else {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't recognize data in image file \"%s\"",
		fileName));
	Tcl_SetErrorCode(interp, "TK", "PHOTO", "IMAGE",
		"UNRECOGNIZED_DATA", NULL);
    }
    return TCL_ERROR;






}

/*
 *----------------------------------------------------------------------
 *
 * TkImgMatchStringFormat --
 *
 *	This function is called to find a photo image file format handler
 *	which can parse the image data in the given string. If a
 *	user-specified format string is provided, only handlers whose names
 *	match a prefix of the format string are tried.
 *
 * Results:
 *	A standard TCL return value. If the return value is TCL_OK, a pointer
 *	to the image format record is returned in *imageFormatPtr or
 *	*imageFormatVersion3Ptr, and the width and height of the image are
 *	returned in *widthPtr and *heightPtr.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TkImgMatchStringFormat(
    Tcl_Interp *interp,		/* Interpreter to use for reporting errors. */
    Tcl_Obj *data,		/* Object containing the image data. */
    Tcl_Obj *formatObj,		/* User-specified format string, or NULL. */
    Tcl_Obj *metadataInObj,	/* User-specified metadata, may be NULL */
    Tcl_Obj *metadataOutObj,	/* metadata output dict, may be NULL */
    Tk_PhotoImageFormat **imageFormatPtr,
				/* A pointer to the photo image format record
				 * is returned here. For formatVersion3, this is
				 * set to NULL*/
    Tk_PhotoImageFormatVersion3 **imageFormatVersion3Ptr,
				/* A pointer to the photo image formatVersion3
				 * record is returned here. For non
				 * formatVersion3, this is set to NULL*/
    int *widthPtr, int *heightPtr,
				/* The dimensions of the image are returned
				 * here. */
    int *oldformat)		/* Returns 1 if the old image API is used. */
{
    int matched = 0, useoldformat = 0;
    Tk_PhotoImageFormat *formatPtr, *defaultFormatPtr = NULL;
    Tk_PhotoImageFormatVersion3 *formatVersion3Ptr = NULL;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    const char *formatString = NULL;

    if (formatObj) {
	formatString = Tcl_GetString(formatObj);
    }

		break;
	    }
	}
    }
#endif

    if (formatPtr == NULL) {
	useoldformat = 0;
	for (formatVersion3Ptr = tsdPtr->formatListVersion3;
		formatVersion3Ptr != NULL;
		formatVersion3Ptr = formatVersion3Ptr->nextPtr) {
	    if (formatObj != NULL) {
		if (strncasecmp(formatString,
			formatVersion3Ptr->name, strlen(formatVersion3Ptr->name)
			) != 0) {
		    continue;
		}
		matched = 1;
		if (formatVersion3Ptr->stringMatchProc == NULL) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "-data option isn't supported for %s images",
			    formatString));
		    Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
			    "NOT_DATA_FORMAT", NULL);
		    return TCL_ERROR;
		}
	    }
	    if ((formatVersion3Ptr->stringMatchProc != NULL)
		    && (formatVersion3Ptr->stringReadProc != NULL)
		    && formatVersion3Ptr->stringMatchProc(interp, data,
			    formatObj, metadataInObj, widthPtr, heightPtr,
			    metadataOutObj)) {
		break;
	    }

	    /*
	     * Clear eventual set keys in the metadata object
	     */

	    if (metadataOutObj != NULL) {
		int dictSize;
		if (TCL_OK != Tcl_DictObjSize(interp,metadataOutObj, &dictSize)
			|| dictSize > 0) {
		    /*
		     * Driver has modified the metadata dict, so clear it
		     */
		    Tcl_DecrRefCount(metadataOutObj);
		    metadataOutObj = Tcl_NewDictObj();
		    Tcl_IncrRefCount(metadataOutObj);
		}
	    }
	}
    }

    if (formatPtr == NULL && formatVersion3Ptr == NULL) {
	/*
	 * Try the default format as last resort (only if no -format option
	 * was passed).
	 */

	if ( formatObj == NULL && defaultFormatPtr == NULL) {
	    Tcl_Panic("default image format handler not registered");

		        "UNRECOGNIZED_DATA", NULL);
            }
	    return TCL_ERROR;
	}
    }

    *imageFormatPtr = formatPtr;
    *imageFormatVersion3Ptr = formatVersion3Ptr;
    *oldformat = useoldformat;

    /*
     * Some stringMatchProc might have left error messages and error codes in
     * interp.	Clear them before return.
     */
    Tcl_ResetResult(interp);

 *--------------------------------------------------------------
 */

static int
ImgPhotoPostscript(
    ClientData clientData,	/* Handle for the photo image. */
    Tcl_Interp *interp,		/* Interpreter. */
    TCL_UNUSED(Tk_Window),		/* (unused) */
    Tk_PostscriptInfo psInfo,	/* Postscript info. */
    int x, int y,		/* First pixel to output. */
    int width, int height,	/* Width and height of area. */
    TCL_UNUSED(int))		/* (unused) */
{
    Tk_PhotoImageBlock block;



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

    return Tk_PostscriptPhoto(interp, &block, psInfo, width, height);
}


    Tk_Uid palette;		/* User-specified default palette for
				 * instances of this image. */
    double gamma;		/* Display gamma value to correct for. */
    char *fileString;		/* Name of file to read into image. */
    Tcl_Obj *dataString;	/* Object to use as contents of image. */
    Tcl_Obj *format;		/* User-specified format of data in image file
				 * or string value. */
    Tcl_Obj *metadata;		/* User-specified metadata dict or read from
				 * image file */
    unsigned char *pix32;	/* Local storage for 32-bit image. */
    int ditherX, ditherY;	/* Location of first incorrectly dithered
				 * pixel in image. */
    TkRegion validRegion;	/* Tk region indicating which parts of the
				 * image have valid image data. */
    PhotoInstance *instancePtr;	/* First in the list of instances associated
				 * with this model. */

MODULE_SCOPE void	TkImgPhotoDisplay(ClientData clientData,
			    Display *display, Drawable drawable,
			    int imageX, int imageY, int width, int height,
			    int drawableX, int drawableY);
MODULE_SCOPE void	TkImgPhotoFree(ClientData clientData,
			    Display *display);
MODULE_SCOPE void	TkImgResetDither(PhotoInstance *instancePtr);

MODULE_SCOPE int	TkImgPhotoMatchFileFormat(Tcl_Interp *interp, Tcl_Channel chan,
			    const char *fileName, Tcl_Obj *formatString,
			    Tcl_Obj *metadataInObj,
			    Tcl_Obj *metadataOutObj,
			    Tk_PhotoImageFormat **imageFormatPtr,
			    Tk_PhotoImageFormatVersion3 **imageFormatVersion3Ptr,
			    int *widthPtr, int *heightPtr, int *oldformat);
MODULE_SCOPE int	TkImgMatchStringFormat(Tcl_Interp *interp, Tcl_Obj *data,
			    Tcl_Obj *formatString,
			    Tcl_Obj *metadataInObj,
			    Tcl_Obj *metadataOutObj,
			    Tk_PhotoImageFormat **imageFormatPtr,
			    Tk_PhotoImageFormatVersion3 **imageFormatVersion3Ptr,
			    int *widthPtr, int *heightPtr, int *oldformat);

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

/*
 * tkImgSVGnano.c
 *
 *  A photo file handler for SVG files.
 *
 * Copyright (c) 2013-14 Mikko Mononen [email protected]
 * Copyright (c) 2018 Christian Gollwitzer [email protected]
 * Copyright (c) 2018 Rene Zaumseil [email protected]
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * This handler is build using the original nanosvg library files from
 * https://github.com/memononen/nanosvg and the tcl extension files from
 * https://github.com/auriocus/tksvg
 *
 */

#include "tkInt.h"
#define NANOSVG_malloc  ckalloc
#define NANOSVG_realloc ckrealloc
#define NANOSVG_free    ckfree
#define NANOSVG_SCOPE MODULE_SCOPE
#define NANOSVG_ALL_COLOR_KEYWORDS
#define NANOSVG_IMPLEMENTATION
#include "nanosvg.h"
#define NANOSVGRAST_IMPLEMENTATION
#include "nanosvgrast.h"

#define MAX_MATCH_BYTES 4096

/* Additional parameters to nsvgRasterize() */

typedef struct {
    double scale;
    double dpi;
    int scaleToHeight;
    int scaleToWidth;
} RastOpts;


















static int      FileMatchSVG(Tcl_Channel chan, const char *fileName,
                Tcl_Obj *format, int *widthPtr, int *heightPtr,
                Tcl_Interp *interp);
static int      FileReadSVG(Tcl_Interp *interp, Tcl_Channel chan,
                const char *fileName, Tcl_Obj *format,
                Tk_PhotoHandle imageHandle, int destX, int destY,
                int width, int height, int srcX, int srcY);
static int      StringMatchSVG(Tcl_Obj *dataObj, Tcl_Obj *format,
                int *widthPtr, int *heightPtr, Tcl_Interp *interp);
static int      StringReadSVG(Tcl_Interp *interp, Tcl_Obj *dataObj,
                Tcl_Obj *format, Tk_PhotoHandle imageHandle,
                int destX, int destY, int width, int height,
                int srcX, int srcY);
static NSVGimage * ParseSVGWithOptions(Tcl_Interp *interp,
                const char *input, TkSizeT length, Tcl_Obj *format,
                RastOpts *ropts);
static int      ParseFormatOptions( Tcl_Interp *interp,
                Tcl_Obj *formatObj, RastOpts *ropts);
static int      RasterizeSVG(Tcl_Interp *interp,
                Tk_PhotoHandle imageHandle, NSVGimage *nsvgImage,
                int destX, int destY, int width, int height,
                int srcX, int srcY, RastOpts *ropts);
static double   GetScaleFromParameters(float svgWidth, float svgHeight,
                RastOpts *ropts, int *widthPtr, int *heightPtr);









/*
 * The format record for the SVG nano file format:
 */

Tk_PhotoImageFormat tkImgFmtSVGnano = {
    "svg",              /* name */
    FileMatchSVG,       /* fileMatchProc */
    StringMatchSVG,     /* stringMatchProc */
    FileReadSVG,        /* fileReadProc */
    StringReadSVG,      /* stringReadProc */
    NULL,               /* fileWriteProc */
    NULL,               /* stringWriteProc */
    NULL
};

/*
 *----------------------------------------------------------------------
 *
 * FileMatchSVG --
 *
 *  This function is invoked by the photo image type to see if a file
 *  contains image data in SVG format.
 *
 * Results:
 *  The return value is >0 if the file can be successfully parsed,
 *  and 0 otherwise.



 *
 *----------------------------------------------------------------------
 */

static int svg_parseUnits(const char* units)
{
    if (units[0] == 'p' && units[1] == 'x')
        return NSVG_UNITS_PX;
    else if (units[0] == 'p' && units[1] == 't')
        return NSVG_UNITS_PT;
    else if (units[0] == 'p' && units[1] == 'c')
        return NSVG_UNITS_PC;
    else if (units[0] == 'm' && units[1] == 'm')
        return NSVG_UNITS_MM;
    else if (units[0] == 'c' && units[1] == 'm')
        return NSVG_UNITS_CM;
    else if (units[0] == 'i' && units[1] == 'n')
        return NSVG_UNITS_IN;
    else if (units[0] == '%')
        return NSVG_UNITS_PERCENT;
    else if (units[0] == 'e' && units[1] == 'm')
        return NSVG_UNITS_EM;
    else if (units[0] == 'e' && units[1] == 'x')
        return NSVG_UNITS_EX;
    return NSVG_UNITS_USER;
}

static NSVGcoordinate svg_parseCoordinateRaw(const char* str)
{
    NSVGcoordinate coord = {0, NSVG_UNITS_USER};
    char units[32]="";
    sscanf(str, "%f%2s", &coord.value, units);
    coord.units = svg_parseUnits(units);
    return coord;
}

static float svg_convertToPixels(NSVGcoordinate c, float dpi)
{
    switch (c.units) {
        case NSVG_UNITS_USER:    return c.value;
        case NSVG_UNITS_PX:      return c.value;
        case NSVG_UNITS_PT:      return c.value / 72.0f * dpi;
        case NSVG_UNITS_PC:      return c.value / 6.0f * dpi;
        case NSVG_UNITS_MM:      return c.value / 25.4f * dpi;
        case NSVG_UNITS_CM:      return c.value / 2.54f * dpi;
        case NSVG_UNITS_IN:      return c.value * dpi;
        case NSVG_UNITS_PERCENT: return 0.0f;
        default:                 return c.value;
    }
    return c.value;
}

static float svg_parseCoordinate(const char* str, float dpi)
{
    NSVGcoordinate coord = svg_parseCoordinateRaw(str);
    return svg_convertToPixels(coord, dpi);
}

static int
IsSvgFile(
    const char *data,
    int maxInd,
    float dpi,
    float *svgWidth,
    float *svgHeight)
{
    int curInd = 0;
    const char *svgStart   = NULL;
    const char *svgEnd     = NULL;
    const char *widthStr   = NULL;
    const char *heightStr  = NULL;
    const char *viewBoxStr = NULL;

    svgEnd = data + maxInd;
    while (data[curInd] && curInd < maxInd) {
        if (data[curInd] == '<') {
            curInd++;
            if (curInd + 3 < maxInd && strncmp(&data[curInd], "svg", 3) == 0) {
                curInd += 3;
                svgStart = &data[curInd];
            }
        } else if (data[curInd] == '>' && svgStart) {
            svgEnd = &data[curInd];
            break;
        }
        curInd++;
    }
    if (!svgStart) {
        return 0;
    }
    widthStr   = strstr(svgStart, " width=");
    heightStr  = strstr(svgStart, " height=");
    viewBoxStr = strstr(svgStart, " viewBox=");
    if (viewBoxStr && viewBoxStr < svgEnd) {
        float viewMinx, viewMiny, viewWidth, viewHeight;
        sscanf(viewBoxStr + 10, "%f%*[%%, \t]%f%*[%%, \t]%f%*[%%, \t]%f", 
               &viewMinx, &viewMiny, &viewWidth, &viewHeight);
        *svgWidth  = viewWidth;
        *svgHeight = viewHeight;
    }
    if (widthStr && widthStr < svgEnd) {
        float val = svg_parseCoordinate( widthStr + 8, dpi);
        if (val > 0.0f) {
            *svgWidth = val;
        } else {
            return 0;
        }
    }
    if (heightStr && heightStr < svgEnd) {
        float val = svg_parseCoordinate( heightStr + 9, dpi);
        if (val > 0.0f) {
            *svgHeight = val;
        } else {
            return 0;
        }
    }
    if (*svgHeight == 0.0f && *svgWidth > 0.0f) {
        *svgHeight = *svgWidth;
    }
    if (*svgWidth == 0.0f && *svgHeight > 0.0f) {
        *svgWidth = *svgHeight;
    }
    if (*svgWidth == 0.0f) {
        *svgWidth = 300.0f;
    }
    if (*svgHeight == 0.0f) {
        *svgHeight = 300.0f;
    }
    return 1;
}

static int
FileMatchSVG(
    Tcl_Channel chan,
    const char *fileName,
    Tcl_Obj *formatObj,
    int *widthPtr, int *heightPtr,
    Tcl_Interp *interp)
{
    TkSizeT length;
    Tcl_Obj *dataObj = Tcl_NewObj();
    const char *data;
    unsigned int maxInd;
    float svgWidth  = 0.0f;
    float svgHeight = 0.0f;
    RastOpts ropts;

    int numBytesRead;
    (void)fileName;

    if (!ParseFormatOptions(interp, formatObj, &ropts)) {
        return 0;
    }
    numBytesRead = Tcl_ReadChars(chan, dataObj, MAX_MATCH_BYTES, 0);
    if (numBytesRead == TCL_IO_FAILURE) {
        /* in case of an error reading the file */
        Tcl_DecrRefCount(dataObj);
        return 0;
    }
    data = TkGetStringFromObj(dataObj, &length);

    maxInd = length < MAX_MATCH_BYTES? length: MAX_MATCH_BYTES;
    if (!IsSvgFile (data, maxInd, ropts.dpi, &svgWidth, &svgHeight)) {
        Tcl_DecrRefCount(dataObj);




        return 0;
    }
    GetScaleFromParameters(svgWidth, svgHeight, &ropts, widthPtr, heightPtr);


    Tcl_DecrRefCount(dataObj);
    if ((*widthPtr <= 0.0) || (*heightPtr <= 0.0)) {
        return 0;
    }
    return 1;
}

/*
 *----------------------------------------------------------------------
 *
 * FileReadSVG --
 *
 *  This function is called by the photo image type to read SVG format
 *  data from a file and write it into a given photo image.
 *
 * Results:
 *  A standard TCL completion code. If TCL_ERROR is returned then an error
 *  message is left in the interp's result.
 *
 * Side effects:
 *  The access position in file f is changed, and new data is added to the
 *  image given by imageHandle.
 *
 *----------------------------------------------------------------------
 */

static int
FileReadSVG(
    Tcl_Interp *interp,
    Tcl_Channel chan,
    const char *fileName,
    Tcl_Obj *formatObj,
    Tk_PhotoHandle imageHandle,
    int destX, int destY,
    int width, int height,
    int srcX, int srcY)
{
    TkSizeT length;
    const char *data;
    RastOpts ropts;
    NSVGimage *nsvgImage = NULL;
    Tcl_Obj *dataObj = Tcl_NewObj();
    (void)fileName;




    if (Tcl_ReadChars(chan, dataObj, -1, 0) == TCL_IO_FAILURE) {
        /* in case of an error reading the file */
        Tcl_DecrRefCount(dataObj);
        Tcl_SetObjResult(interp, Tcl_NewStringObj("read error", -1));
        Tcl_SetErrorCode(interp, "TK", "IMAGE", "SVG", "READ_ERROR", NULL);
        return TCL_ERROR;
    }
    data = TkGetStringFromObj(dataObj, &length);
    nsvgImage = ParseSVGWithOptions(interp, data, length, formatObj, &ropts);

    Tcl_DecrRefCount(dataObj);
    if (nsvgImage == NULL) {
        return TCL_ERROR;
    }

    return RasterizeSVG(interp, imageHandle, nsvgImage, destX, destY,
                        width, height, srcX, srcY, &ropts);
}

/*
 *----------------------------------------------------------------------
 *
 * StringMatchSVG --
 *
 *  This function is invoked by the photo image type to see if a string
 *  contains image data in SVG format.
 *
 * Results:
 *  The return value is >0 if the file can be successfully parsed,
 *  and 0 otherwise.



 *
 *----------------------------------------------------------------------
 */

static int
StringMatchSVG(
    Tcl_Obj *dataObj,
    Tcl_Obj *formatObj,
    int *widthPtr, int *heightPtr,
    Tcl_Interp *interp)
{
    TkSizeT length;
    const char *data;
    unsigned int maxInd;
    float svgWidth  = 0.0f;
    float svgHeight = 0.0f;
    RastOpts ropts;

    if (!ParseFormatOptions (interp, formatObj, &ropts)) {
        return 0;
    }

    data = TkGetStringFromObj (dataObj, &length);
    maxInd = length < MAX_MATCH_BYTES? length: MAX_MATCH_BYTES;





    if (!IsSvgFile (data, maxInd, ropts.dpi, &svgWidth, &svgHeight)) {
        return 0;
    }



    GetScaleFromParameters (svgWidth, svgHeight, &ropts, widthPtr, heightPtr);
    if ((*widthPtr <= 0.0) || (*heightPtr <= 0.0)) {
        return 0;
    }
    return 1;
}

/*
 *----------------------------------------------------------------------
 *
 * StringReadSVG --
 *
 *  This function is called by the photo image type to read SVG format
 *  data from a string and write it into a given photo image.
 *
 * Results:
 *  A standard TCL completion code. If TCL_ERROR is returned then an error
 *  message is left in the interp's result.
 *
 * Side effects:
 *  New data is added to the image given by imageHandle.
 *
 *----------------------------------------------------------------------
 */

static int
StringReadSVG(
    Tcl_Interp *interp,
    Tcl_Obj *dataObj,
    Tcl_Obj *formatObj,
    Tk_PhotoHandle imageHandle,
    int destX, int destY,
    int width, int height,
    int srcX, int srcY)
{
    TkSizeT length;
    const char *data;
    RastOpts ropts;
    NSVGimage *nsvgImage = NULL;


    data = TkGetStringFromObj(dataObj, &length);
    nsvgImage = ParseSVGWithOptions(interp, data, length, formatObj, &ropts);


    if (nsvgImage == NULL) {
        return TCL_ERROR;
    }
    return RasterizeSVG(interp, imageHandle, nsvgImage, destX, destY,
                        width, height, srcX, srcY, &ropts);
}

/*
 *----------------------------------------------------------------------
 *
 * ParseSVGWithOptions --
 *
 *  This function is called to parse the given input string as SVG.
 *
 * Results:
 *  Return a newly create NSVGimage on success, and NULL otherwise.
 *
 * Side effects:
 *
 *----------------------------------------------------------------------
 */

static int
ParseFormatOptions(
    Tcl_Interp *interp,
    Tcl_Obj *formatObj,
    RastOpts *ropts)
{
    Tcl_Obj **objv = NULL;
    int objc = 0;
    int parameterScaleSeen = 0;
    static const char *const fmtOptions[] = {
        "-dpi", "-scale", "-scaletoheight", "-scaletowidth", NULL
    };
    enum fmtOptions {
        OPT_DPI, OPT_SCALE, OPT_SCALE_TO_HEIGHT, OPT_SCALE_TO_WIDTH
    };

    /*
     * Process elements of format specification as a list.
     */

    ropts->scale = 1.0;
    ropts->dpi   = 96.0;
    ropts->scaleToHeight = 0;
    ropts->scaleToWidth  = 0;
    if ((formatObj != NULL) &&
        Tcl_ListObjGetElements(interp, formatObj, &objc, &objv) != TCL_OK) {
        return 0;
    }
    for (; objc > 0 ; objc--, objv++) {
        int optIndex;

        /*
         * Ignore the "svg" part of the format specification.
         */

        if (!strcasecmp(Tcl_GetString(objv[0]), "svg")) {
            continue;
        }

        if (Tcl_GetIndexFromObjStruct(interp, objv[0], fmtOptions,
            sizeof(char *), "option", 0, &optIndex) == TCL_ERROR) {
            return 0;
        }

        if (objc < 2) {
            Tcl_WrongNumArgs(interp, 1, objv, "value");
            return 0;
        }

        objc--;
        objv++;

        /*
         * check that only one scale option is given
         */
        switch ((enum fmtOptions) optIndex) {
            case OPT_SCALE:
            case OPT_SCALE_TO_HEIGHT:
            case OPT_SCALE_TO_WIDTH:
                if ( parameterScaleSeen ) {
                    Tcl_SetObjResult(interp, Tcl_NewStringObj(
                        "only one of -scale, -scaletoheight, -scaletowidth may be given", -1));
                    Tcl_SetErrorCode(interp, "TK", "IMAGE", "SVG", "BAD_SCALE", NULL);
                    return 0;
                }
                parameterScaleSeen = 1;
                break;
            default:
                break;
        }

        /*
         * Decode parameters
         */
        switch ((enum fmtOptions) optIndex) {
            case OPT_DPI:
                if (Tcl_GetDoubleFromObj(interp, objv[0], &ropts->dpi) == TCL_ERROR) {
                    return 0;
                }
                if (ropts->dpi < 0.0) {
                    Tcl_SetObjResult(interp, Tcl_NewStringObj(
                        "-dpi value must be positive", -1));
                    Tcl_SetErrorCode(interp, "TK", "IMAGE", "SVG", "BAD_DPI", NULL);
                    return 0;
                }
                break;
            case OPT_SCALE:
                if (Tcl_GetDoubleFromObj(interp, objv[0], &ropts->scale) == TCL_ERROR) {
                    return 0;
                }
                if (ropts->scale <= 0.0) {
                    Tcl_SetObjResult(interp, Tcl_NewStringObj(
                        "-scale value must be positive", -1));
                    Tcl_SetErrorCode(interp, "TK", "IMAGE", "SVG", "BAD_SCALE", NULL);
                    return 0;
                }
                break;
            case OPT_SCALE_TO_HEIGHT:
                if (Tcl_GetIntFromObj(interp, objv[0], &ropts->scaleToHeight) == TCL_ERROR) {
                    return 0;
                }
                if (ropts->scaleToHeight <= 0) {
                    Tcl_SetObjResult(interp, Tcl_NewStringObj(
                        "-scaletoheight value must be positive", -1));
                    Tcl_SetErrorCode(interp, "TK", "IMAGE", "SVG", "BAD_SCALE", NULL);
                    return 0;
                }
                break;
            case OPT_SCALE_TO_WIDTH:
                if (Tcl_GetIntFromObj(interp, objv[0], &ropts->scaleToWidth) == TCL_ERROR) {
                    return 0;
                }
                if (ropts->scaleToWidth <= 0) {
                    Tcl_SetObjResult(interp, Tcl_NewStringObj(
                        "-scaletowidth value must be positive", -1));
                    Tcl_SetErrorCode(interp, "TK", "IMAGE", "SVG", "BAD_SCALE", NULL);
                    return 0;
                }
                break;
        }
    }
    return 1;
}

static NSVGimage *
ParseSVGWithOptions(
    Tcl_Interp *interp,
    const char *input,
    TkSizeT length,
    Tcl_Obj *formatObj,
    RastOpts *ropts)
{



    char *inputCopy = NULL;
    NSVGimage *nsvgImage = NULL;








    /*
     * The parser destroys the original input string,
     * therefore first duplicate.
     */

    inputCopy = (char *)attemptckalloc(length+1);
    if (inputCopy == NULL) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot alloc data buffer", -1));
        Tcl_SetErrorCode(interp, "TK", "IMAGE", "SVG", "OUT_OF_MEMORY", NULL);
        goto error;
    }
    memcpy(inputCopy, input, length);
    inputCopy[length] = '\0';









    ParseFormatOptions (interp, formatObj, ropts);










































































































    nsvgImage = nsvgParse(inputCopy, "px", ropts->dpi);
    if (nsvgImage == NULL) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot parse SVG image", -1));
        Tcl_SetErrorCode(interp, "TK", "IMAGE", "SVG", "PARSE_ERROR", NULL);
        goto error;
    }
    ckfree(inputCopy);
    return nsvgImage;

error:
    if (inputCopy != NULL) {
        ckfree(inputCopy);
    }
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * RasterizeSVG --
 *
 *  This function is called to rasterize the given nsvgImage and
 *  fill the imageHandle with data.
 *
 * Results:
 *  A standard TCL completion code. If TCL_ERROR is returned then an error
 *  message is left in the interp's result.
 *
 *
 * Side effects:
 *  On error the given nsvgImage will be deleted.
 *
 *----------------------------------------------------------------------
 */

static int
RasterizeSVG(
    Tcl_Interp *interp,

    NSVGrasterizer *rast;
    unsigned char *imgData;
    Tk_PhotoImageBlock svgblock;
    double scale;
    (void)srcX;
    (void)srcY;

    scale = GetScaleFromParameters(nsvgImage->width, nsvgImage->height, ropts, &w, &h);

    rast = nsvgCreateRasterizer();
    if (rast == NULL) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot initialize rasterizer", -1));
        Tcl_SetErrorCode(interp, "TK", "IMAGE", "SVG", "RASTERIZER_ERROR", NULL);

        goto cleanAST;
    }
    imgData = (unsigned char *)attemptckalloc(w * h *4);
    if (imgData == NULL) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot alloc image buffer", -1));
        Tcl_SetErrorCode(interp, "TK", "IMAGE", "SVG", "OUT_OF_MEMORY", NULL);
        goto cleanRAST;
    }
    nsvgRasterize(rast, nsvgImage, 0, 0, (float) scale, imgData, w, h, w * 4);

    /* transfer the data to a photo block */
    svgblock.pixelPtr = imgData;
    svgblock.width = w;
    svgblock.height = h;
    svgblock.pitch = w * 4;
    svgblock.pixelSize = 4;
    for (c = 0; c <= 3; c++) {
        svgblock.offset[c] = c;
    }
    if (Tk_PhotoExpand(interp, imageHandle, destX + width, destY + height) != TCL_OK) {

        goto cleanRAST;
    }
    if (Tk_PhotoPutBlock(interp, imageHandle, &svgblock, destX, destY,
                         width, height, TK_PHOTO_COMPOSITE_SET) != TCL_OK) {
        goto cleanimg;
    }
    ckfree(imgData);
    nsvgDeleteRasterizer(rast);
    nsvgDelete(nsvgImage);
    return TCL_OK;

cleanimg:

}

/*
 *----------------------------------------------------------------------
 *
 * GetScaleFromParameters --
 *
 *  Get the scale value from the already parsed parameters -scale,
 *  -scaletoheight and -scaletowidth.
 *
 *  The image width and height is also returned.
 *
 * Results:
 *  The evaluated or configured scale value, or 0.0 on failure
 *
 * Side effects:
 *  heightPtr and widthPtr are set to height and width of the image.
 *
 *----------------------------------------------------------------------
 */

static double
GetScaleFromParameters(
    float svgWidth,
    float svgHeight,
    RastOpts *ropts,
    int *widthPtr,
    int *heightPtr)
{
    double scale;
    int width, height;

    if ((svgWidth == 0.0) || (svgHeight == 0.0)) {
        width = height = 0;
        scale = 1.0;
    } else if (ropts->scaleToHeight > 0) {
        /*
         * Fixed height
         */
        height = ropts->scaleToHeight;
        scale = height / svgHeight;
        width = (int) ceil(svgWidth * scale);
    } else if (ropts->scaleToWidth > 0) {
        /*
         * Fixed width
         */
        width = ropts->scaleToWidth;
        scale = width / svgWidth;
        height = (int) ceil(svgHeight * scale);
    } else {
        /*
         * Scale factor
         */
        scale = ropts->scale;
        width = (int) ceil(svgWidth * scale);
        height = (int) ceil(svgHeight * scale);
    }

    *heightPtr = height;
    *widthPtr = width;
    return scale;
}

/*
 * Miscellaneous variables shared among Tk modules but not exported to the
 * outside world:
 */

MODULE_SCOPE const Tk_SmoothMethod tkBezierSmoothMethod;
MODULE_SCOPE Tk_ImageType	tkBitmapImageType;
MODULE_SCOPE Tk_PhotoImageFormatVersion3 tkImgFmtGIF;
MODULE_SCOPE void		(*tkHandleEventProc) (XEvent* eventPtr);
MODULE_SCOPE Tk_PhotoImageFormat tkImgFmtDefault;
MODULE_SCOPE Tk_PhotoImageFormatVersion3 tkImgFmtPNG;
MODULE_SCOPE Tk_PhotoImageFormat tkImgFmtPPM;
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];

    Tk_CreateOldPhotoImageFormat, /* 273 */
    Tk_AlwaysShowSelection, /* 274 */
    Tk_GetButtonMask, /* 275 */
    Tk_GetDoublePixelsFromObj, /* 276 */
    Tk_NewWindowObj, /* 277 */
    Tk_SendVirtualEvent, /* 278 */
    Tk_FontGetDescription, /* 279 */
    Tk_CreatePhotoImageFormatVersion3, /* 280 */
};

/* !END!: Do not edit above this line. */


#ifdef __CYGWIN__
void *Tk_GetHINSTANCE(void)

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

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

	Tk_CreatePhotoImageFormat(&tkImgFmtDefault);
	Tk_CreatePhotoImageFormatVersion3(&tkImgFmtGIF);
	Tk_CreatePhotoImageFormatVersion3(&tkImgFmtPNG);
	Tk_CreatePhotoImageFormat(&tkImgFmtPPM);
	Tk_CreatePhotoImageFormat(&tkImgFmtSVGnano);
    }

    if ((parent != NULL) && (screenName != NULL) && (screenName[0] == '\0')) {
	dispPtr = ((TkWindow *) parent)->dispPtr;
	screenId = Tk_ScreenNumber(parent);

test image-1.1 {Tk_ImageCmd procedure, "create" option} -body {
    image
} -returnCodes error -result {wrong # args: should be "image option ?args?"}
test image-1.2 {Tk_ImageCmd procedure, "create" option} -body {
    image gorp
} -returnCodes error -result {bad option "gorp": must be create, delete, height, inuse, metadata, names, type, types, or width}
test image-1.3 {Tk_ImageCmd procedure, "create" option} -body {
    image create
} -returnCodes error -result {wrong # args: should be "image create type ?name? ?-option value ...?"}
test image-1.4 {Tk_ImageCmd procedure, "create" option} -body {
    image c bad_type
} -returnCodes error -result {image type "bad_type" doesn't exist}
test image-1.5 {Tk_ImageCmd procedure, "create" option} -constraints {

    lappend x [imageNames]
    image create photo foo -width 20 -height 20
    lappend x [.c bbox i1] [imageNames]
} -cleanup {
    .c delete all
    imageCleanup
} -result {10 10 20 20 foo {} {10 10 30 30} foo}

# Tests 16.x: Basic usage of "image metadata".
# Format specific "image metadata" tests are in the corresponding test files.

test image-16.1 {Tk_ImageCmd procedure, "metadata" option} -body {
    image metadata
} -returnCodes error -result {wrong # args: should be "image metadata ?-file name? ?-data string?"}

test image-16.2 {Tk_ImageCmd procedure, "metadata" option} -body {
    image metadata -gorp
} -returnCodes error -result {wrong # args: should be "image metadata ?-file name? ?-data string?"}

test image-16.3 {Tk_ImageCmd procedure, "metadata" option} -body {
    image metadata -file
} -returnCodes error -result {wrong # args: should be "image metadata ?-file name? ?-data string?"}

test image-16.4 {Tk_ImageCmd procedure, "metadata" option} -body {
    image metadata -data
} -returnCodes error -result {wrong # args: should be "image metadata ?-file name? ?-data string?"}

test image-16.5 {Tk_ImageCmd procedure, "metadata" No image file} -setup {
    imageCleanup
} -body {
    image metadata -file all.tcl
} -cleanup {
    imageCleanup
} -result {}


destroy .c
imageFinish

# cleanup
cleanupTests
return

# Local variables:
# mode: tcl
# End:

    image create bitmap i2 -file foo.bm -maskfile foo2.bm
    rename i2 newi2
    set x [list [info command i2] [info command new*] [newi2 cget -file]]
    image delete i2
    lappend x [info command new*]
} -result {{} newi2 foo.bm {}}


test imageBmap-12.1 {ImgBmapCmdDeletedProc procedure} -body {
    image create bitmap i2 -file foo.bm -maskfile foo2.bm
    rename i2 {}
    list [lsearch -exact [imageNames] i2] [catch {i2 foo} msg] $msg
} -result {-1 1 {invalid command name "i2"}}

# Tests 13.x: Use "image metadata" with XBM image files and image data.

test imageBmp-13.1 {image metadata -file} -setup {
    imageCleanup
} -body {
    image metadata -file face.xbm
} -cleanup {
    imageCleanup
} -result {format xbm width 108 height 144}

test imageBmp-13.2 {image metadata -data} -setup {
    imageCleanup
} -body {
    image metadata -data $data1
} -cleanup {
    imageCleanup
} -result {format xbm width 16 height 16}

removeFile foo.bm
removeFile foo2.bm
imageFinish

# cleanup
cleanupTests

PmSgZc0hPNhvYAruYN27V8n2gtXV8fOShnq5O9t+492kG9n2LQv65KWAaWAMUDPhEaG0oIFyOMgkhy
YOaz2HKRVHc4lqQbf3LMisUrWjrl9XhhBCkwnWnNLiFDVCParR5BeeRJE47aungOASE1gueu+OTh76
0dt3Gzx47dvzRUnHNQ8Cf2yQZE7mg+XtslqVWi5XocjlDu7K0pgS+dfbs2V8tFotPlUqlr+ZyuXNO+
duFtaSrZF3pfCpiGjN2imToJJ39m6BjG1XZRwrkAI8YUKSZWlEZQDAIrNArHnyvpXtmM/B7wJeAbwO
fBcxKuQMrzfLdBoz29fX9led5v6u1XnBJW7vnr/YlrXEoNo22LRYOYlxZ1S6rkOfDcLvPAY/hGmWC7
H68uFI+x0oSPg2MAN/L5/M/vtqSED/T5cMu9J4Wf7HMGsB/4TEv/DFwe3Y/NPN57VXh+5BWApwFLlh
r661tV1eju/ne8YJrkWtES0tmRe2VOviv2j2aBp5nHihiRaz/A4oCnsAsje/+AAAAAElFTkSuQmCC"
    dpi100aspect2
"iVBORw0KGgoAAAANSUhEUgAAAAIAAAACCAIAAAD91JpzAAAACXBIWXMAAA9hAAAewgEw8YEEAAAA
FklEQVR4nGP4+vXrP11lJgYGhj9xSQAzOwXsETZ69QAAAABJRU5ErkJggg=="
	}

# $encoded(basn0g08), $encoded(basn2c08), $encoded(basn3p08), $encoded(basn6a08)
test imgPNG-1.1 {reading basic images; grayscale} -setup {
    catch {rename foo ""}
} -body {
    image create photo foo -data $encoded(basn0g08)
    list [image width foo] [image height foo]

    # the image contains an unknown chunk iDOT
    # since the name of this chunk starts with a lowercase letter,
    # it's an ancillary chunk that shall not trigger an error
    catch {set i [image create photo -file $fileName]}
} -cleanup {
    image delete $i
} -result 0

test imgPNG-4.1 {data image with metadata} -body {
    image create photo i1 -data $encoded(dpi100aspect2)
    i1 cget -metadata
} -cleanup {
    image delete i1
} -result {DPI 99.9998 aspect 2.0}

test imgPNG-4.2 {file image with metadata} -setup {
    set path [file join [configure -tmpdir] test.png]
    set h [open $path "WRONLY BINARY CREAT"]
    puts -nonewline $h [binary decode base64 $encoded(dpi100aspect2)]
    close $h
} -body {
    image create photo i1 -file $path
    i1 cget -metadata
} -cleanup {
    image delete i1
    file delete $path
} -result {DPI 99.9998 aspect 2.0}

test imgPNG-4.3 {data output with metadata} -setup {
    image create photo i1 -data $encoded(dpi100aspect2)
} -body {
    set imgData [i1 data -format png]
    image delete i1
    image create photo i1 -data $imgData
    i1 cget -metadata
} -cleanup {
    image delete i1
} -result {DPI 99.9998 aspect 2.0}

test imgPNG-4.4 {file output with metadata} -setup {
    image create photo i1 -data $encoded(dpi100aspect2)
    set path [file join [configure -tmpdir] test.png]
} -body {
    i1 write $path -format png
    image delete i1
    image create photo i1 -file $path
    i1 cget -metadata
} -cleanup {
    image delete i1
    file delete $path
} -result {DPI 99.9998 aspect 2.0}

# Tests 5.x: Use "image metadata" with PNG image files and image data.

# Note, that extracting addtional metadata like resolution is not
# yet implemented for PNG images.

test imgPNG-5.1 {image metadata -file} -setup {
    imageCleanup
    set path [file join [configure -tmpdir] test.png]
    set h [open $path "WRONLY BINARY CREAT"]
    puts -nonewline $h [binary decode base64 $encoded(dpi100aspect2)]
    close $h
} -body {
    image metadata -file $path
} -cleanup {
    file delete $path
    imageCleanup
} -result {format png width 2 height 2}

test imgPNG-5.2 {image metadata -data} -setup {
    imageCleanup
} -body {
    image metadata -data $encoded(dpi100aspect2)
} -cleanup {
    imageCleanup
} -result {format png width 2 height 2}

}


namespace delete png
imageFinish
cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:

    image create photo ppm
} -body {
    ppm put "P6\n5 4\n150\n012345678901234567890123456789012345678901234567890123456789"
    list [image width ppm] [image height ppm]
} -cleanup {
    image delete ppm
} -result {5 4}

# Tests 6.x: Use "image metadata" with PPM image files and image data.

test imgPPM-6.1 {image metadata -file} -setup {
    imageCleanup
} -body {
    image metadata -file teapot.ppm
} -cleanup {
    imageCleanup
} -result {format ppm width 256 height 256}

test imgPPM-6.2 {image metadata -data} -setup {
    imageCleanup
} -body {
    image metadata -data "P6\n5 4\n150\n012345678901234567890123456789012345678901234567890123456789"
} -cleanup {
    imageCleanup
} -result {format ppm width 5 height 4}


imageFinish

# cleanup
catch {file delete test.ppm}
cleanupTests
return

# ImgPostscriptPhoto                    no tests
# Tk_PhotoPutBlock_NoComposite          no tests, probably none needed
# Tk_PhotoPutZoomedBlock_NoComposite    no tests, probably none needed
# Tk_PhotoExpand_Panic                  no tests, probably none needed
# Tk_PhotoPutBlock_Panic                no tests, probably none needed
# Tk_PhotoPutZoomedBlock_Panic          no tests, probably none needed
# Tk_PhotoSetSize_Panic                 no tests, probably none needed
# Tk_PhotoGetMetadata:                  imgPhoto-19.*
# Tk_PhotoSetMetadata:                  imgPhoto-20.*
#--------------------------------------------------------------------------
#

#
# Some tests are not specific to a function in tkImgPhoto.c. They are:
#

    image create photo photo1
} -body {
    photo1 put {{blue green}}
    photo1 get 1 0 -withalpha
} -cleanup {
    imageCleanup
} -result {0 128 0 255}
test imgPhoto-1.14 {options for photo images - error case} -body {
    image create photo photo1 -metadata
} -returnCodes error -result {value for "-metadata" missing}

test imgPhoto-2.1 {ImgPhotoCreate procedure} -setup {
    imageCleanup
} -body {
    catch {image create photo -blah blah}
    imageNames
} -result {}

} -result {25 30}
test imgPhoto-4.6 {ImgPhotoCmd procedure: configure option} -setup {
    image create photo photo1
} -body {
    llength [photo1 configure]
} -cleanup {
    image delete photo1
} -result 8
test imgPhoto-4.7 {ImgPhotoCmd procedure: configure option} -setup {
    image create photo photo1
} -body {
    photo1 conf -palette 3/4/2
    photo1 configure -palette
} -cleanup {
    image delete photo1

    hasTeapotPhoto
} -setup {
    image create photo photo1
} -body {
    photo1 read $teapotPhotoFile -zoom 2
} -returnCodes error -cleanup {
    image delete photo1
} -result {unrecognized option "-zoom": must be -format, -from, -metadata, -shrink, or -to}
test imgPhoto-4.32 {ImgPhotoCmd procedure: read option} -setup {
    image create photo photo1
} -body {
    list [catch {photo1 read bogus} err] [string tolower $err]
} -cleanup {
    image delete photo1
} -result {1 {couldn't open "bogus": no such file or directory}}

test imgPhoto-4.90 {ImgPhotoCmd put: existing but not allowed opt} -setup {
    image create photo photo1
} -body {
    photo1 put yellow -from 0 0 1 1
} -cleanup {
    imageCleanup
} -returnCodes error -result \
    {unrecognized option "-from": must be -format, -metadata, or -to}
test imgPhoto-4.91 {ImgPhotoCmd put: invalid option} -setup {
    image create photo photo1
} -body {
    photo1 put {{0 1 2 3}} -bogus x
} -returnCodes error -result \
    {unrecognized option "-bogus": must be -format, -metadata, or -to}
test imgPhoto-4.92 {ImgPhotocmd put: missing data} -setup {
    image create photo photo1
} -body {
    photo1 put -to 0 0
} -returnCodes error -result \
    {wrong # args: should be "photo1 put data ?-option value ...?"}
test imgPhoto-4.93 {ImgPhotoCmd put: data in ppm format} -constraints {

test imgPhoto-4.104 {ImgPhotoCmd data: existing but not accepted opt} -setup {
    image create photo photo1
} -body {
    photo1 data -to
} -cleanup {
    imageCleanup
} -returnCodes error -result \
{unrecognized option "-to": must be -background, -format, -from, -grayscale, or -metadata}
test imgPhoto-4.105 {ImgPhotoCmd data: invalid option} -setup {
    image create photo photo1
} -body {
    photo1 data -bogus
} -cleanup {
    imageCleanup
} -returnCodes error -result \
{unrecognized option "-bogus": must be -background, -format, -from, -grayscale, or -metadata}
test imgPhoto-4.106 {ImgPhotoCmd data: extra arg before options} -setup {
    image create photo photo1
} -body {
    photo1 data bogus -grayscale
} -cleanup {
    imageCleanup
} -returnCodes error -result \

test imgPhoto-20.12 {Valid GIF (file)} -setup {
    set fileName [file join [file dirname [info script]] red.gif]
} -body {
    image create photo gif1 -file $fileName
} -cleanup {
    catch {image delete gif1}
} -result gif1

# imgPhoto-21.x : Tk_PhotoGetMetadata

test imgPhoto-21.1 {option -metadata, get configure list} -setup {
    image create photo photo1 -metadata {dpi 100}
} -body {
    photo1 configure -metadata
} -cleanup {
    catch {image delete photo1}
} -result {-metadata {} {} {} {dpi 100}}

test imgPhoto-21.2 {option -metadata, get value} -setup {
    image create photo photo1 -metadata {dpi 100}
} -body {
    photo1 cget -metadata
} -cleanup {
    catch {image delete photo1}
} -result {dpi 100}

test imgPhoto-21.3 {option -metadata, get default value} -setup {
    image create photo photo1
} -body {
    photo1 cget -metadata
} -cleanup {
    catch {image delete photo1}
} -result {}

# imgPhoto-22.x : Tk_PhotoSetMetadata

test imgPhoto-22.1 {option -metadata, set value} -setup {
    image create photo photo1
} -body {
    photo1 configure -metadata {dpi 100}
    photo1 cget -metadata
} -cleanup {
    catch {image delete photo1}
} -result {dpi 100}

test imgPhoto-22.2 {option -metadata, change value} -setup {
    image create photo photo1 -metadata {dpi 200}
} -body {
    photo1 configure -metadata {dpi 100}
    photo1 cget -metadata
} -cleanup {
    catch {image delete photo1}
} -result {dpi 100}

test imgPhoto-22.3 {option -metadata, clear value} -setup {
    image create photo photo1 -metadata {dpi 200}
} -body {
    photo1 configure -metadata {}
    photo1 cget -metadata
} -cleanup {
    catch {image delete photo1}
} -result {}

# 23.x GIF images with metadata

# The following gif core data is used by the following data.
# N.B. this is the same image as test imgPhoto-18.10

# size 16x16, global color table size: 8
set gifstart "GIF89a\x10\x00\x10\x00\xc2\x07\x00"
# color table
append gifstart "\x00\x00\x00\x33\x33\xff\xff\x33\x33\xff\x33\xff\x33\xff\x33\x33\xff\xff\xff\xff\x33\xff\xff\xff"
# Graphic control extension: Transparent color index: 7 (not needed here)
# append gifdata "\x21\xf9\x04\x01\x0a\x00\x07\x00"
# Image descriptor: 16x16, no local color table
set gifdata "\x2c\x00\x00\x00\x00\x10\x00\x10\x00\x00"
# Image data
append gifdata "\x03\x21\x78\xba\xdc\x2d\x30\x42\x77\xa4\x15\xef\xda\xa5\xb5\xea\xd7\x07\x4a\xe2\x38\x55\xe6\x99\xaa\x6b\x69\x72\x2f\x33\x52\x1d\x65\x37\x09\x00"
set gifend "\x3b"

test imgPhoto-23.1 {GIF comment before image data (-data)} -setup {
    set data $::gifstart
    # Append a comment extension block with data "ABCD"
    append data "\x21\xfe\x04" "ABCD" "\x0"
    # Trailer
    append data $::gifdata $::gifend
} -body {
    image create photo gif1 -data $data
    gif1 cget -metadata
} -cleanup {
    catch {image delete gif1}
} -result {comment ABCD}

test imgPhoto-23.2 {GIF file comment before image data (-file)} -setup {
    set data $::gifstart
    # Append a comment extension block with data "ABCD"
    append data "\x21\xfe\x04" "ABCD" "\x0"
    # Trailer
    append data $::gifdata $::gifend
    set path [file join [configure -tmpdir] test.gif]
    set h [open $path "WRONLY BINARY CREAT"]
    puts -nonewline $h $data
    close $h
} -body {
    image create photo gif1 -file $path
    gif1 cget -metadata
} -cleanup {
    catch {image delete gif1}
    file delete $path
} -result {comment ABCD}

test imgPhoto-23.3 {GIF comment after image data (-data)} -setup {
    set data $::gifstart
    append data $::gifdata
    # Append a comment extension block with data "ABCD"
    append data "\x21\xfe\x04" "ABCD" "\x0"
    # Trailer
    append data $::gifend
} -body {
    image create photo gif1 -data $data
    gif1 cget -metadata
} -cleanup {
    catch {image delete gif1}
} -result {comment ABCD}

test imgPhoto-23.4 {GIF comment after image data (-file)} -setup {
    set data $::gifstart
    append data $::gifdata
    # Append a comment extension block with data "ABCD"
    append data "\x21\xfe\x04" "ABCD" "\x0"
    # Trailer
    append data $::gifend
    set path [file join [configure -tmpdir] test.gif]
    set h [open $path "WRONLY BINARY CREAT"]
    puts $h $data
    close $h
} -body {
    image create photo gif1 -file $path
    gif1 cget -metadata
} -cleanup {
    catch {image delete gif1}
    file delete $path
} -result {comment ABCD}

test imgPhoto-23.5 {Two GIF comment blocks (-data)} -setup {
    set data $::gifstart
    # Append a comment extension block with data "1234"
    append data "\x21\xfe\x04" "1234" "\x0"
    append data $::gifdata
    # Append a comment extension block with data "ABCD"
    append data "\x21\xfe\x04" "ABCD" "\x0"
    # Trailer
    append data $::gifend
} -body {
    image create photo gif1 -data $data
    gif1 cget -metadata
} -cleanup {
    catch {image delete gif1}
} -result {comment ABCD}

test imgPhoto-23.6 {Two GIF comment blocks (-file)} -setup {
    set data $::gifstart
    # Append a comment extension block with data "1234"
    append data "\x21\xfe\x04" "1234" "\x0"
    append data $::gifdata
    # Append a comment extension block with data "ABCD"
    append data "\x21\xfe\x04" "ABCD" "\x0"
    # Trailer
    append data $::gifend
    set path [file join [configure -tmpdir] test.gif]
    set h [open $path "WRONLY BINARY CREAT"]
    puts $h $data
    close $h
} -body {
    image create photo gif1 -file $path
    gif1 cget -metadata
} -cleanup {
    catch {image delete gif1}
    file delete $path
} -result {comment ABCD}

test imgPhoto-23.7 {create: test if shared metadata object is not preserved\
	(-data)}\
-setup {
    set data $::gifstart
    # Append a comment extension block with data "ABCD"
    append data "\x21\xfe\x04" "ABCD" "\x0"
    # Trailer
    append data $::gifdata $::gifend
} -body {
    set metadataDict [dict create A 1]
    set metadataDict2 $metadataDict
    image create photo gif1 -data $data -metadata $metadataDict
    list [dict get [gif1 cget -metadata]] $metadataDict $metadataDict2
} -cleanup {
    catch {image delete gif1}
} -result {{A 1 comment ABCD} {A 1} {A 1}}

test imgPhoto-23.8 {create: test if shared metadata object is not preserved\
	(-file)}\
-setup {
    set data $::gifstart
    # Append a comment extension block with data "ABCD"
    append data "\x21\xfe\x04" "ABCD" "\x0"
    # Trailer
    append data $::gifdata $::gifend

    set path [file join [configure -tmpdir] test.gif]
    set h [open $path "WRONLY BINARY CREAT"]
    puts $h $data
    close $h
} -body {
    set metadataDict [dict create A 1]
    set metadataDict2 $metadataDict
    image create photo gif1 -file $path -metadata $metadataDict
    list [dict get [gif1 cget -metadata]] $metadataDict $metadataDict2
} -cleanup {
    catch {image delete gif1}
    file delete $path
} -result {{A 1 comment ABCD} {A 1} {A 1}}

test imgPhoto-23.9 {configure: test if shared metadata object is not\
	preserved (empty image, -data)}\
-setup {
    set data $::gifstart
    # Append a comment extension block with data "ABCD"
    append data "\x21\xfe\x04" "ABCD" "\x0"
    # Trailer
    append data $::gifdata $::gifend
} -body {
    image create photo gif1
    set metadataDict [dict create A 1]
    set metadataDict2 $metadataDict
    gif1 configure -data $data -format gif -metadata $metadataDict
    list [dict get [gif1 cget -metadata]] $metadataDict $metadataDict2
} -cleanup {
    catch {image delete gif1}
} -result {{A 1 comment ABCD} {A 1} {A 1}}

test imgPhoto-23.10 {configure: test if shared metadata object is not preserved\
	(empty image, -file)}\
-setup {
    set data $::gifstart
    # Append a comment extension block with data "ABCD"
    append data "\x21\xfe\x04" "ABCD" "\x0"
    # Trailer
    append data $::gifdata $::gifend

    set path [file join [configure -tmpdir] test.gif]
    set h [open $path "WRONLY BINARY CREAT"]
    puts $h $data
    close $h
} -body {
    image create photo gif1
    set metadataDict [dict create A 1]
    set metadataDict2 $metadataDict
    gif1 configure -file $path -format gif -metadata $metadataDict
    list [dict get [gif1 cget -metadata]] $metadataDict $metadataDict2
} -cleanup {
    catch {image delete gif1}
    file delete $path
} -result {{A 1 comment ABCD} {A 1} {A 1}}

test imgPhoto-23.11 {configure: test if shared metadata object is not preserved\
	(metadata replace, -data}\
-setup {
    set data $::gifstart
    # Append a comment extension block with data "ABCD"
    append data "\x21\xfe\x04" "ABCD" "\x0"
    # Trailer
    append data $::gifdata $::gifend
} -body {
    image create photo gif1 -data "$::gifstart$::gifdata$::gifend"
    set metadataDict [dict create A 1]
    set metadataDict2 $metadataDict
    gif1 configure -data $data -format gif -metadata $metadataDict
    list [dict get [gif1 cget -metadata]] $metadataDict $metadataDict2
} -cleanup {
    catch {image delete gif1}
} -result {{A 1 comment ABCD} {A 1} {A 1}}

test imgPhoto-23.12 {configure: test if shared metadata object is not preserved\
	(metadata replace, -file}\
-setup {
    set data $::gifstart
    # Append a comment extension block with data "ABCD"
    append data "\x21\xfe\x04" "ABCD" "\x0"
    # Trailer
    append data $::gifdata $::gifend

    set path [file join [configure -tmpdir] test.gif]
    set h [open $path "WRONLY BINARY CREAT"]
    puts $h $data
    close $h
} -body {
    image create photo gif1 -data "$::gifstart$::gifdata$::gifend"
    set metadataDict [dict create A 1]
    set metadataDict2 $metadataDict
    gif1 configure -file $path -format gif -metadata $metadataDict
    list [dict get [gif1 cget -metadata]] $metadataDict $metadataDict2
} -cleanup {
    catch {image delete gif1}
    file delete $path
} -result {{A 1 comment ABCD} {A 1} {A 1}}

test imgPhoto-23.13 {configure: test if shared metadata object is not preserved\
	(-data)}\
-setup {
    set data $::gifstart$::gifdata$::gifend
} -body {
    image create photo gif1 -data $data
    set metadataDict [dict create A 1]
    set metadataDict2 $metadataDict
    set data $::gifstart
    # Append a comment extension block with data "ABCD"
    append data "\x21\xfe\x04" "ABCD" "\x0"
    # Trailer
    append data $::gifdata $::gifend
    gif1 configure -data $data -format gif -metadata $metadataDict
    list [dict get [gif1 cget -metadata]] $metadataDict $metadataDict2
} -cleanup {
    catch {image delete gif1}
} -result {{A 1 comment ABCD} {A 1} {A 1}}

test imgPhoto-23.14 {configure: test if shared metadata object is not preserved\
	(-file)}\
-setup {
    set data $::gifstart
    # Append a comment extension block with data "ABCD"
    append data "\x21\xfe\x04" "ABCD" "\x0"
    # Trailer
    append data $::gifdata $::gifend

    set path [file join [configure -tmpdir] test.gif]
    set h [open $path "WRONLY BINARY CREAT"]
    puts $h $data
    close $h
} -body {
    image create photo gif1 -data "$::gifstart$::gifdata$::gifend"
    set metadataDict [dict create A 1]
    set metadataDict2 $metadataDict
    gif1 configure -file $path -format gif -metadata $metadataDict
    list [dict get [gif1 cget -metadata]] $metadataDict $metadataDict2
} -cleanup {
    catch {image delete gif1}
    file delete $path
} -result {{A 1 comment ABCD} {A 1} {A 1}}

test imgPhoto-23.15 {output data with comment (from -metadata argument)}\
-setup {
    set data $::gifstart$::gifdata$::gifend
} -body {
    image create photo gif1 -data $data
    set gifData [gif1 data -format gif -metadata [dict create comment ABCD]]
} -cleanup {
    catch {image delete gif1}
} -match glob -result {*ABCD*}

test imgPhoto-23.22 {output file with comment (from -metadata argument)}\
-setup {
    set data $::gifstart$::gifdata$::gifend
    set path [file join [configure -tmpdir] test.gif]
} -body {
    image create photo gif1 -data $data
    gif1 write $path -format gif -metadata [dict create comment ABCD]
    image delete gif1
    image create photo gif1 -file $path
    dict get [gif1 cget -metadata] comment
} -cleanup {
    catch {image delete gif1}
    file delete $path
} -result {ABCD}

test imgPhoto-23.16 {output data with comment (from -metadata property)}\
-setup {
    set data $::gifstart$::gifdata$::gifend
} -body {
    image create photo gif1 -data $data
    gif1 configure -metadata [dict create comment ABCD]
    set gifData [gif1 data -format gif]
} -cleanup {
    catch {image delete gif1}
} -match glob -result {*ABCD*}

test imgPhoto-23.17 {output file with comment (from -metadata property)}\
-setup {
    set data $::gifstart$::gifdata$::gifend
    set path [file join [configure -tmpdir] test.gif]
} -body {
    image create photo gif1 -data $data
    gif1 configure -metadata [dict create comment ABCD]
    gif1 write $path -format gif
    image delete gif1
    image create photo gif1 -file $path
    dict get [gif1 cget -metadata] comment
} -cleanup {
    catch {image delete gif1}
    file delete $path
} -result {ABCD}

test imgPhoto-23.18 {configure: empty metadata parameter overwrites image metadata} -setup {
    image create photo gif1 -data $::gifstart$::gifdata$::gifend\
	    -metadata {foo bar}
    set data $::gifstart
    # Append a comment extension block with data "ABCD"
    append data "\x21\xfe\x04" "ABCD" "\x0"
    # Trailer
    append data $::gifdata $::gifend
} -body {
    gif1 configure -data $data -metadata {}
    gif1 cget -metadata
} -cleanup {
    catch {image delete gif1}
} -result {comment ABCD}

test imgPhoto-23.19 {write: empty metadata parameter overwrites image metadata} -setup {
    image create photo gif1 -data $::gifstart$::gifdata$::gifend\
	    -metadata {comment bar}
    set path [file join [configure -tmpdir] test.gif]
} -body {
    gif1 write $path -format gif -metadata {}
    image delete gif1
    image create photo gif1 -file $path
    dict size [gif1 cget -metadata]
} -cleanup {
    catch {image delete gif1}
    file delete $path
} -result {0}

test imgPhoto-23.20 {data: empty metadata parameter overwrites image metadata} -setup {
    image create photo gif1 -data $::gifstart$::gifdata$::gifend\
	    -metadata {comment bar}
} -body {
    set data [gif1 data -format gif -metadata {}]
    image delete gif1
    image create photo gif1 -data $data
    dict size [gif1 cget -metadata]
} -cleanup {
    catch {image delete gif1}
    file delete $path
} -result {0}

# Tests 24.x: Use "image metadata" with GIF image files and image data.

test imgPhoto-24.1 {image metadata -file} -setup {
    imageCleanup
} -body {
    image metadata -file earth.gif
} -cleanup {
    imageCleanup
} -result {format gif width 320 height 200}

# Note, that extracting addtional metadata like "comment" is not
# yet implemented for GIF images.
test imgPhoto-24.2 {image metadata -data} -setup {
    set data $::gifstart
    append data "\x21\xfe\x04" "ABCD" "\x0"
    append data $::gifdata $::gifend
} -body {
    image metadata -data $data
} -cleanup {
    imageCleanup
} -result {format gif width 16 height 16}

unset -nocomplain gifstart gifdata gifend


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

# cleanup

    foo configure -format "svg -scale 2"
    lappend res [image width foo] [image height foo]
} -cleanup {
    rename foo ""
    unset res
} -result {100 100 200 200}


test imgSVGnano-4.2 {error on file not accessible on reread due to configure} -setup {
    catch {rename foo ""}
    tcltest::makeFile $data(plus) tmpplus.svg
    image create photo foo -file [file join [tcltest::configure -tmpdir] tmpplus.svg]
    tcltest::removeFile tmpplus.svg
} -body {
    foo configure -format "svg -scale 2"
} -cleanup {
    rename foo ""
    tcltest::removeFile tmpplus.svg
} -returnCodes error -match glob -result {couldn't open "*/tmpplus.svg": no such file or directory}

# Tests 5.x: Use "image metadata" with SVG image files and image data.

test imgSVGnano-5.1 {image metadata -file} -setup {
    imageCleanup
} -body {
    image metadata -file $data(plusFilePath)
} -cleanup {
    imageCleanup
} -result {format svg width 100 height 100}

test imgSVGnano-5.2 {image metadata -data} -setup {
    imageCleanup
} -body {
    image metadata -data $data(plus)
} -cleanup {
    imageCleanup
} -result {format svg width 100 height 100}

test imgSVGnano-5.3 {image metadata -file} -setup {
    imageCleanup
} -body {
    image metadata -file $data(badFilePath)
} -cleanup {
    imageCleanup
} -result {}

test imgSVGnano-5.4 {image metadata -data} -setup {
    imageCleanup
} -body {
    image metadata -data $data(bad)
} -cleanup {
    imageCleanup
} -result {}


};# end of namespace svgnano

namespace delete svgnano
imageFinish
cleanupTests
return