/*--------------------------------------------------------------*/
/*								*/ 
/* tkPixmap.c --- routines for implementing an "xpm" format	*/
/*	pixmap image type in Tk.  Lifted mostly from Tk's	*/
/* 	bitmap image format source "tkImgBmap.c"		*/
/*								*/ 
/*--------------------------------------------------------------*/

#if defined(TCL_WRAPPER) && defined(HAVE_XPM)

#include <stdio.h>
#include <stdlib.h>

#include <X11/Intrinsic.h>
#include <X11/StringDefs.h>

#include <X11/xpm.h>

#include <tk.h>

/*
 * The following data structure represents the master for an XPM-format
 * pixmap image:
 */

typedef struct XPMMaster {
    Tk_ImageMaster tkMaster;	/* Tk's token for image master.  NULL means
				 * the image is being deleted. */
    Tcl_Interp *interp;		/* Interpreter for application that is
				 * using image. */
    Tcl_Command imageCmd;	/* Token for image command (used to delete
				 * it when the image goes away).  NULL means
				 * the image command has already been
				 * deleted. */
    XpmImage *imageData;	/* Contains primary information about the image */
    XpmInfo  *imageInfo;	/* Contains comment and extension information */
    char *fileString;		/* Value of -file option (malloc'ed). */
    struct XPMInstance *instancePtr;
				/* First in list of all instances associated
				 * with this master. */
} XPMMaster;

/*
 * The following data structure represents all of the instances of an
 * image that lie within a particular window:
 */

typedef struct XPMInstance {
    int refCount;		/* Number of instances that share this
				 * data structure. */
    XPMMaster *masterPtr;	/* Pointer to master for image. */
    Tk_Window tkwin;		/* Window in which the instances will be
				 * displayed. */
    Pixmap pixmap;		/* The pixmap to display. */
    Pixmap mask;		/* The bitmap to use for the shapemask */
    GC gc;			/* Graphics context for displaying pixmap */
    struct XPMInstance *nextPtr;
				/* Next in list of all instance structures
				 * associated with masterPtr (NULL means
				 * end of list). */
} XPMInstance;

/*
 * The type record for bitmap images:
 */

static int		ImgXPMCreate _ANSI_ARGS_((Tcl_Interp *interp,
			    char *name, int argc, Tcl_Obj *CONST objv[],
			    Tk_ImageType *typePtr, Tk_ImageMaster master,
			    ClientData *clientDataPtr));
static ClientData	ImgXPMGet _ANSI_ARGS_((Tk_Window tkwin,
			    ClientData clientData));
static void		ImgXPMDisplay _ANSI_ARGS_((ClientData clientData,
			    Display *display, Drawable drawable, 
			    int imageX, int imageY, int width, int height,
			    int drawableX, int drawableY));
static void		ImgXPMFree _ANSI_ARGS_((ClientData clientData,
			    Display *display));
static void		ImgXPMDelete _ANSI_ARGS_((ClientData clientData));

Tk_ImageType tkXPMImageType = {
    "xpm",			/* name */
    ImgXPMCreate,		/* createProc */
    ImgXPMGet,			/* getProc */
    ImgXPMDisplay,		/* displayProc */
    ImgXPMFree,			/* freeProc */
    ImgXPMDelete,		/* deleteProc */
    NULL,			/* postscriptProc */
    (Tk_ImageType *) NULL	/* nextPtr */
};

/*
 * Information used for parsing configuration specs:
 * Size defaults to a 16x16 area.
 */

static Tk_ConfigSpec configSpecs[] = {
    {TK_CONFIG_STRING, "-file", (char *) NULL, (char *) NULL,
	(char *) NULL, Tk_Offset(XPMMaster, fileString), TK_CONFIG_NULL_OK},
    {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
	(char *) NULL, 0, 0}
};

/*
 * Prototypes for procedures used only locally in this file:
 */

static int		ImgXPMCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[]));
static void		ImgXPMCmdDeletedProc _ANSI_ARGS_((
			    ClientData clientData));
static void		ImgXPMConfigureInstance _ANSI_ARGS_((
			    XPMInstance *instancePtr));
static int		ImgXPMConfigureMaster _ANSI_ARGS_((
			    XPMMaster *masterPtr, int argc, Tcl_Obj *CONST objv[],
			    int flags));

/*
 *----------------------------------------------------------------------
 *
 * ImgXPMCreate --
 *
 *	This procedure is called by the Tk image code to create "test"
 *	images.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	The data structure for a new image is allocated.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
ImgXPMCreate(interp, name, argc, argv, typePtr, master, clientDataPtr)
    Tcl_Interp *interp;		/* Interpreter for application containing
				 * image. */
    char *name;			/* Name to use for image. */
    int argc;			/* Number of arguments. */
    Tcl_Obj *CONST argv[];	/* Argument objects for options (doesn't
				 * include image name or type). */
    Tk_ImageType *typePtr;	/* Pointer to our type record (not used). */
    Tk_ImageMaster master;	/* 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. */
{
    XPMMaster *masterPtr;

    masterPtr = (XPMMaster *) ckalloc(sizeof(XPMMaster));
    masterPtr->tkMaster = master;
    masterPtr->interp = interp;
    masterPtr->imageCmd = Tcl_CreateObjCommand(interp, name, ImgXPMCmd,
	    (ClientData) masterPtr, ImgXPMCmdDeletedProc);
    masterPtr->imageData = NULL;
    masterPtr->imageInfo = NULL;
    masterPtr->fileString = NULL;
    masterPtr->instancePtr = NULL;
    if (ImgXPMConfigureMaster(masterPtr, argc, argv, 0) != TCL_OK) {
	ImgXPMDelete((ClientData) masterPtr);
	return TCL_ERROR;
    }
    *clientDataPtr = (ClientData) masterPtr;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ImgXPMConfigureMaster --
 *
 *	This procedure is called when a bitmap image is created or
 *	reconfigured.  It process configuration options and resets
 *	any instances of the image.
 *
 * Results:
 *	A standard Tcl return value.  If TCL_ERROR is returned then
 *	an error message is left in the masterPtr->interp's result.
 *
 * Side effects:
 *	Existing instances of the image will be redisplayed to match
 *	the new configuration options.
 *
 *----------------------------------------------------------------------
 */

static int
ImgXPMConfigureMaster(masterPtr, objc, objv, flags)
    XPMMaster *masterPtr;	/* Pointer to data structure describing
				 * overall pixmap image to (reconfigure). */
    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. */
{
    XPMInstance *instancePtr;
    int maskWidth, maskHeight, dummy1;

    char **argv = (char **) Tcl_Alloc((objc+1) * sizeof(char *));
    for (dummy1 = 0; dummy1 < objc; dummy1++) {
	argv[dummy1]=Tcl_GetString(objv[dummy1]);
    }
    argv[objc] = NULL;

    if (Tk_ConfigureWidget(masterPtr->interp, Tk_MainWindow(masterPtr->interp),
	    configSpecs, objc, argv, (char *) masterPtr, flags)
	    != TCL_OK) {
	Tcl_Free((char *) argv);
	return TCL_ERROR;
    }
    Tcl_Free((char *) argv);

    /*
     * Parse the pixmap and/or mask to create binary data.  Make sure that
     * the pixmap and mask have the same dimensions.
     */

    if (masterPtr->imageData != NULL) {
	XpmFreeXpmImage(masterPtr->imageData);
	masterPtr->imageData = NULL;
    }
    if (masterPtr->imageInfo != NULL) {
	XpmFreeXpmInfo(masterPtr->imageInfo);
	masterPtr->imageInfo = NULL;
    }
    if (masterPtr->fileString != NULL) {
	masterPtr->imageData = (XpmImage *)malloc(sizeof(XpmImage));
	masterPtr->imageInfo = (XpmInfo *)malloc(sizeof(XpmInfo));
        if (XpmReadFileToXpmImage(masterPtr->fileString,
		masterPtr->imageData, masterPtr->imageInfo) != XpmSuccess) {
	    free((char *)masterPtr->imageData);
	    free((char *)masterPtr->imageInfo);
	    masterPtr->imageData = NULL;
	    masterPtr->imageInfo = NULL;
	    return TCL_ERROR;
	}
    }

    /*
     * Cycle through all of the instances of this image, regenerating
     * the information for each instance.  Then force the image to be
     * redisplayed everywhere that it is used.
     */

    for (instancePtr = masterPtr->instancePtr; instancePtr != NULL;
	    instancePtr = instancePtr->nextPtr) {
	ImgXPMConfigureInstance(instancePtr);
    }
    Tk_ImageChanged(masterPtr->tkMaster, 0, 0, masterPtr->imageData->width,
	    masterPtr->imageData->height, masterPtr->imageData->width,
	    masterPtr->imageData->height);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ImgXPMConfigureInstance --
 *
 *	This procedure is called to create displaying information for
 *	a xpm image instance based on the configuration information
 *	in the master.  It is invoked both when new instances are
 *	created and when the master is reconfigured.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Generates errors via Tcl_BackgroundError if there are problems
 *	in setting up the instance.
 *
 *----------------------------------------------------------------------
 */

static void
ImgXPMConfigureInstance(instancePtr)
    XPMInstance *instancePtr;	/* Instance to reconfigure. */
{
    XPMMaster *masterPtr = instancePtr->masterPtr;
    XGCValues gcValues;
    GC gc;
    unsigned int gcmask;
    Pixmap oldMask;
    Tk_Window tkwind = instancePtr->tkwin;
    Window xwind;
    XpmAttributes locattr;
    Display *dpy = Tk_Display(instancePtr->tkwin);

    if ((xwind = Tk_WindowId(tkwind)) == 0)
	Tk_MakeWindowExist(tkwind);

    if ((xwind = Tk_WindowId(tkwind)) == 0)
	goto error;

    /*
     * For each of the options in masterPtr, translate the string
     * form into an internal form appropriate for instancePtr.
     */

    if (instancePtr->pixmap != None) {
	XFreePixmap(dpy, instancePtr->pixmap);
	instancePtr->pixmap = None;
    }

    if (masterPtr->imageData != NULL) {
        if (masterPtr->imageData->width <= 0
		|| masterPtr->imageData->height <= 0) goto error;
	oldMask = instancePtr->mask;
	instancePtr->mask = None;
	locattr.valuemask = XpmSize | XpmCloseness;
	locattr.closeness = 65536;

	XpmCreatePixmapFromXpmImage(dpy, xwind, masterPtr->imageData,
		&instancePtr->pixmap, &instancePtr->mask, &locattr);
	if (oldMask != None) {
	    XFreePixmap(dpy, oldMask);
	}
    }

    /* Create the GC for copying the pixmap */

    if (masterPtr->imageData != NULL) {
	gcValues.graphics_exposures = False;
	gcmask = GCGraphicsExposures;
	gc = Tk_GetGC(instancePtr->tkwin, gcmask, &gcValues);
	XSetClipMask(dpy, gc, instancePtr->mask);
    } else {
	gc = None;
    }
    if (instancePtr->gc != None) {
	Tk_FreeGC(dpy, instancePtr->gc);
    }
    instancePtr->gc = gc;
    return;

error:

    /*
     * An error occurred: clear the graphics context in the instance to
     * make it clear that this instance cannot be displayed.  Then report
     * the error.
     */

    if (instancePtr->gc != None)
	Tk_FreeGC(dpy, instancePtr->gc);
    instancePtr->gc = None; 

    Tcl_AddErrorInfo(masterPtr->interp, "\n    (while configuring image \"");
    Tcl_AddErrorInfo(masterPtr->interp, Tk_NameOfImage(masterPtr->tkMaster));
    Tcl_AddErrorInfo(masterPtr->interp, "\")");
    Tcl_BackgroundError(masterPtr->interp);
}


/*
 *--------------------------------------------------------------
 *
 * ImgXPMCmd --
 *
 *	This procedure is invoked to process the Tcl command
 *	that corresponds to an image managed by this module.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

static int
ImgXPMCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Information about the image master. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    static char *xpmOptions[] = {"cget", "configure", (char *) NULL};
    XPMMaster *masterPtr = (XPMMaster *) clientData;
    int code, index;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], xpmOptions, "option", 0,
	    &index) != TCL_OK) {
	return TCL_ERROR;
    }
    switch (index) {
      case 0: {
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "option");
	    return TCL_ERROR;
	}
	return Tk_ConfigureValue(interp, Tk_MainWindow(interp), configSpecs,
		(char *) masterPtr, Tcl_GetString(objv[2]), 0);
      }
      case 1: {
	if (objc == 2) {
	    code = Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
		    configSpecs, (char *) masterPtr, (char *) NULL, 0);
	} else if (objc == 3) {
	    code = Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
		    configSpecs, (char *) masterPtr,
		    Tcl_GetString(objv[2]), 0);
	} else {
	    code = ImgXPMConfigureMaster(masterPtr, objc-2, objv+2,
		    TK_CONFIG_ARGV_ONLY);
	}
	return code;
      }
      default: {
	panic("bad const entries to xpmOptions in ImgXPMCmd");
      }
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ImgXPMGet --
 *
 *	This procedure is called for each use of a xpm image in a
 *	widget.
 *
 * Results:
 *	The return value is a token for the instance, which is passed
 *	back to us in calls to ImgXPMDisplay and ImgXPMFree.
 *
 * Side effects:
 *	A data structure is set up for the instance (or, an existing
 *	instance is re-used for the new one).
 *
 *----------------------------------------------------------------------
 */

static ClientData
ImgXPMGet(tkwin, masterData)
    Tk_Window tkwin;		/* Window in which the instance will be
				 * used. */
    ClientData masterData;	/* Pointer to our master structure for the
				 * image. */
{
    XPMMaster *masterPtr = (XPMMaster *) masterData;
    XPMInstance *instancePtr;

    /*
     * See if there is already an instance for this window.  If so
     * then just re-use it.
     */

    for (instancePtr = masterPtr->instancePtr; instancePtr != NULL;
	    instancePtr = instancePtr->nextPtr) {
	if (instancePtr->tkwin == tkwin) {
	    instancePtr->refCount++;
	    return (ClientData) instancePtr;
	}
    }

    /*
     * The image isn't already in use in this window.  Make a new
     * instance of the image.
     */

    instancePtr = (XPMInstance *) Tcl_Alloc(sizeof(XPMInstance));
    instancePtr->refCount = 1;
    instancePtr->masterPtr = masterPtr;
    instancePtr->tkwin = tkwin;
    instancePtr->pixmap = None;
    instancePtr->mask = None;
    instancePtr->gc = None;
    instancePtr->nextPtr = masterPtr->instancePtr;
    masterPtr->instancePtr = instancePtr;
    ImgXPMConfigureInstance(instancePtr);

    /*
     * If this is the first instance, must set the size of the image.
     */

    if (instancePtr->nextPtr == NULL) {
	if (masterPtr->imageData != NULL)
	    Tk_ImageChanged(masterPtr->tkMaster, 0, 0, 0, 0,
			masterPtr->imageData->width, masterPtr->imageData->height);
	else
	    Tk_ImageChanged(masterPtr->tkMaster, 0, 0, 0, 0, 0, 0);
    }

    return (ClientData) instancePtr;
}

/*
 *----------------------------------------------------------------------
 *
 * ImgXPMDisplay --
 *
 *	This procedure is invoked to draw a xpm image.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	A portion of the image gets rendered in a pixmap or window.
 *
 *----------------------------------------------------------------------
 */

static void
ImgXPMDisplay(clientData, display, drawable, imageX, imageY, width,
	height, drawableX, drawableY)
    ClientData clientData;	/* Pointer to BitmapInstance structure for
				 * for instance to be displayed. */
    Display *display;		/* Display on which to draw image. */
    Drawable drawable;		/* Pixmap or window in which to draw image. */
    int imageX, imageY;		/* Upper-left corner of region within image
				 * to draw. */
    int width, height;		/* Dimensions of region within image to draw. */
    int drawableX, drawableY;	/* Coordinates within drawable that
				 * correspond to imageX and imageY. */
{
    XPMInstance *instancePtr = (XPMInstance *) clientData;
    int masking;

    /*
     * If there's no GC, then an error occurred during image creation
     * and it should not be displayed.
     */

    if (instancePtr->gc == None) return;

    masking = (instancePtr->mask != None);
    if (masking) {
	XSetClipOrigin(display, instancePtr->gc, drawableX - imageX,
		drawableY - imageY);
    }
    XCopyArea(display, instancePtr->pixmap, drawable, instancePtr->gc,
	    imageX, imageY, (unsigned) width, (unsigned) height,
	    drawableX, drawableY);
    if (masking) {
	XSetClipOrigin(display, instancePtr->gc, 0, 0);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ImgXPMFree --
 *
 *	This procedure is called when a widget ceases to use a
 *	particular instance of an image.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Internal data structures get cleaned up.
 *
 *----------------------------------------------------------------------
 */

static void
ImgXPMFree(clientData, display)
    ClientData clientData;	/* Pointer to BitmapInstance structure for
				 * for instance to be displayed. */
    Display *display;		/* Display containing window that used image. */
{
    XPMInstance *instancePtr = (XPMInstance *) clientData;
    XPMInstance *prevPtr;

    instancePtr->refCount--;
    if (instancePtr->refCount > 0) {
	return;
    }

    /*
     * There are no more uses of the image within this widget.  Free
     * the instance structure.
     */

    if (instancePtr->pixmap != None) {
	XFreePixmap(display, instancePtr->pixmap);
    }
    if (instancePtr->mask != None) {
	XFreePixmap(display, instancePtr->mask);
    }
    if (instancePtr->masterPtr->instancePtr == instancePtr) {
	instancePtr->masterPtr->instancePtr = instancePtr->nextPtr;
    } else {
	for (prevPtr = instancePtr->masterPtr->instancePtr;
		prevPtr->nextPtr != instancePtr; prevPtr = prevPtr->nextPtr) {
	    /* Empty loop body */
	}
	prevPtr->nextPtr = instancePtr->nextPtr;
    }
    Tcl_Free((char *) instancePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * ImgXPMDelete --
 *
 *	This procedure is called by the image code to delete the
 *	master structure for an image.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Resources associated with the image get freed.
 *
 *----------------------------------------------------------------------
 */

static void
ImgXPMDelete(masterData)
    ClientData masterData;	/* Pointer to BitmapMaster structure for
				 * image.  Must not have any more instances. */
{
    XPMMaster *masterPtr = (XPMMaster *) masterData;

    if (masterPtr->instancePtr != NULL) {
	panic("tried to delete xpm image when instances still exist");
    }
    masterPtr->tkMaster = NULL;
    if (masterPtr->imageCmd != NULL) {
	Tcl_DeleteCommandFromToken(masterPtr->interp, masterPtr->imageCmd);
    }
    if (masterPtr->imageData != NULL) {
	XpmFreeXpmImage(masterPtr->imageData);
    }
    if (masterPtr->imageInfo != NULL) {
	XpmFreeXpmInfo(masterPtr->imageInfo);
    }
    Tk_FreeOptions(configSpecs, (char *) masterPtr, (Display *) NULL, 0);
    Tcl_Free((char *) masterPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * ImgXPMCmdDeletedProc --
 *
 *	This procedure is invoked when the image command for an image
 *	is deleted.  It deletes the image.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The image is deleted.
 *
 *----------------------------------------------------------------------
 */

static void
ImgXPMCmdDeletedProc(clientData)
    ClientData clientData;	/* Pointer to BitmapMaster structure for
				 * image. */
{
    XPMMaster *masterPtr = (XPMMaster *) clientData;

    masterPtr->imageCmd = NULL;
    if (masterPtr->tkMaster != NULL) {
	Tk_DeleteImage(masterPtr->interp, Tk_NameOfImage(masterPtr->tkMaster));
    }
}

/*
 *---------------------------------------------------------
 * register the XPM image type with the Tk "image" command
 *---------------------------------------------------------
 */

void
RegisterXPMImageType()
{
    Tk_CreateImageType(&tkXPMImageType);
}

#endif   /* TCL_WRAPPER && HAVE_XPM */
