#include <sys/types.h>
  #include <sys/stat.h>
  #include <errno.h>
  #include <stdlib.h>
  #include <string.h>
  #include <tcl.h>
  #include <tk.h>
  #include <X11/xpm.h>
  
  #define OBJ_CMD_ARGS (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
  
  typedef struct Tk_XpmInstance {
    int refCount;
    Display *dis;
    Pixmap pix;
    Pixmap pixMask;
    Tk_Window tkwin;
    Tk_ImageMaster master;
    Tcl_Command cmd;
  } Tk_XpmInstance;
  
  static int GetPixmapSize (Display *dis, Pixmap p, int *width, int *height) {
    Window root;
    int x, y;
    int bd;
    int depth;
    
    if (!XGetGeometry (dis, p, &root, &x, &y, width, height, &bd, &depth)) {
      return 0;
    }
    return 1;
  }
  
  static void FreePixmapsIfNeeded (Tk_XpmInstance *xinst) {
    /*An image may already have been loaded, so we should free the Pixmap's if so.*/
    if (xinst->pix != None) {
      XFreePixmap (xinst->dis, xinst->pix);
      xinst->pix = None;
    }
    if (xinst->pixMask != None) {
      XFreePixmap (xinst->dis, xinst->pixMask);
      xinst->pixMask = None;
    }
  }
  
  static int UpdateSize (Tcl_Interp *interp, Tk_XpmInstance *xinst) {
    int width;
    int height;
    
    if (!GetPixmapSize (xinst->dis, xinst->pix, &width, &height)) {
      Tcl_SetResult (interp, "unable to query pixmap size", TCL_STATIC);
      return TCL_ERROR;
    }
    Tk_ImageChanged (xinst->master, 0, 0, 0, 0, width, height);
    return TCL_OK;
  }
  
  static int Tk_XpmMakePixmapFromBuffer (Tcl_Interp *interp, char *buf, Tk_XpmInstance *xinst) {
    Tk_Window tkmain;
    Window xWin;
    tkmain = Tk_MainWindow (interp);
    Tk_MakeWindowExist (tkmain);
    xWin = Tk_WindowId (tkmain);
    
    if (XpmCreatePixmapFromBuffer (xinst->dis, xWin, buf, &xinst->pix, &xinst->pixMask, NULL)) {
      Tcl_SetResult (interp, "bad xpm", TCL_STATIC);
      xinst->pix = None;
      xinst->pixMask = None;
      return TCL_ERROR;
    }
    return TCL_OK;
  }
    
  static int Tk_XpmReadFileToPixmap (Tcl_Interp *interp, char *fileName, Tk_XpmInstance *xinst) {
    Tcl_Channel chan = NULL;
    Tcl_Obj *xpmBufObj;
    struct stat statBuf;
    
    xpmBufObj = Tcl_NewObj ();
    
    if (Tcl_Stat (fileName, &statBuf)) {
      Tcl_SetResult (interp, (char *) Tcl_ErrnoMsg (errno), TCL_VOLATILE);
      return TCL_ERROR;
    }
    
    chan = Tcl_OpenFileChannel (interp, fileName, "r", 0);
    if (chan == NULL) {
      return TCL_ERROR;
    }
    
    if (Tcl_ReadChars (chan, xpmBufObj, statBuf.st_size, 0) != statBuf.st_size) {
      Tcl_SetResult (interp, (char *) Tcl_ErrnoMsg (errno), TCL_VOLATILE);
      return TCL_ERROR;
    }
    
    if (Tcl_Close (interp, chan) != TCL_OK) {
      return TCL_ERROR;
    }
    
    FreePixmapsIfNeeded (xinst);
    
    if (Tk_XpmMakePixmapFromBuffer (interp, Tcl_GetString (xpmBufObj), xinst) != TCL_OK) {
      return TCL_ERROR;
    }
    
    Tcl_DecrRefCount (xpmBufObj);
    return UpdateSize (interp, xinst);
  }
  
  static int Tk_XpmBufferToPixmap (Tcl_Interp *interp, char *xpmBuf, Tk_XpmInstance *xinst) {
    FreePixmapsIfNeeded (xinst);
    
    if (Tk_XpmMakePixmapFromBuffer (interp, xpmBuf, xinst) != TCL_OK) {
      return TCL_ERROR;
    }
    return UpdateSize (interp, xinst);
  }
  
  static int Tk_XpmInstanceCmd OBJ_CMD_ARGS {
    Tk_XpmInstance *xinst = (Tk_XpmInstance *) clientData;
    char *subCmd = NULL;
    int len = 0;
    fprintf (stderr, "InstanceCmd\n");
  
    if (objc != 3) {
      Tcl_WrongNumArgs (interp, 1, objv, "file|data fileName|xpmData");
      return TCL_ERROR;
    }
  
    subCmd = Tcl_GetStringFromObj (objv[1], &len);
    
    if (strncmp (subCmd, "file", len) == 0) {
      return Tk_XpmReadFileToPixmap (interp, Tcl_GetString (objv[2]), xinst);
    } else if (strncmp (subCmd, "data", len) == 0) {
      return Tk_XpmBufferToPixmap (interp, Tcl_GetString (objv[2]), xinst);
    } 
    
    Tcl_SetResult (interp, "bad instance subcommand", TCL_STATIC);
    
    return TCL_ERROR;
  }
  static void Tk_XpmFree (ClientData clientData, Display *dis) {
    /*I don't do anything specific for widgets that use images, 
     *so AFAIK this doesn't need to do anything.
     */
    /*fprintf (stderr, "FREE\n");*/
  }
  
  static void Tk_XpmDelete (ClientData clientData) {
    Tk_XpmInstance *xinst = (Tk_XpmInstance *) clientData;
    
    /*fprintf (stderr, "DELETE\n");*/
    FreePixmapsIfNeeded (xinst);
    if (xinst != NULL) {
      Tcl_DeleteCommandFromToken (NULL, xinst->cmd);
      Tcl_Free (clientData);
      clientData = NULL;
    }
  }
    
  static int Tk_XpmCreate (
    Tcl_Interp *interp,
    char *name,
    int objc,
    Tcl_Obj *CONST objv[],
    Tk_ImageType *typePtr,
    Tk_ImageMaster master,
    ClientData *clientDataPtr
  ) {
    Tk_XpmInstance *xinst = (Tk_XpmInstance *) Tcl_Alloc (sizeof (Tk_XpmInstance));
    
    xinst->cmd = Tcl_CreateObjCommand (interp, name, Tk_XpmInstanceCmd, (ClientData) xinst, (Tcl_CmdDeleteProc *) NULL);
    xinst->master = master;
    xinst->dis = Tk_Display (Tk_MainWindow (interp));
    xinst->pix = None;
    xinst->pixMask = None;
    
    Tk_ImageChanged (master, 0, 0, 1, 1, 1, 1);
    
    *clientDataPtr = (ClientData) xinst;
    
    return TCL_OK;
  }
  
  static ClientData Tk_XpmGet (Tk_Window tkwin, ClientData clientData) {
    return clientData;
  }
  
  static void Tk_XpmDisplay (
    ClientData clientData,
    Display *dis,
    Drawable d, 
    int x, int y, 
    int width, int height,
    int destX, int destY
  ) {
    Tk_XpmInstance *xinst = clientData;
    int nScreen = 0;
    GC copyGC;
    XGCValues xgcval;
  
    /*
    fprintf (stderr, "x %d y %d width %d height %d destX %d destY %d\n", x, y, width, height, destX, destY);
    */
    
    xgcval.clip_x_origin = destX;
    xgcval.clip_y_origin = destY;
    nScreen = DefaultScreen (dis);
    copyGC = XCreateGC (dis, d, GCClipXOrigin | GCClipYOrigin, &xgcval);
    
    if (xinst->pixMask != None) {
      XSetClipMask (dis, copyGC, xinst->pixMask);
    }
    XCopyArea (dis, xinst->pix, d, copyGC, x, y, width, height, destX, destY);
    
    XFreeGC (dis, copyGC);
    
    XFlush (dis);
  }
    
  Tk_ImageType Tk_XpmImageType = {
    "xpm",
    Tk_XpmCreate,
    Tk_XpmGet,
    Tk_XpmDisplay,
    Tk_XpmFree,
    Tk_XpmDelete,
    NULL,
    (Tk_ImageType *) NULL
  };
  
  int Tk_Xpm_Init (Tcl_Interp *interp) {
    Tk_CreateImageType (&Tk_XpmImageType);
  
    return TCL_OK;
  }