/***********************************************************************
 *
 *  Blox
 *
 *  Standardized, Tk-based GUI widgets available for various window
 *  systems - Interface to Tcl
 *
 ***********************************************************************/

/***********************************************************************
 *
 * Copyright 1988-92, 1994-95, 1999, 2000 Free Software Foundation, Inc.
 * XPM code is Copyright (C) 1989-94 GROUPE BULL
 * Written by Paolo Bonzini.
 *
 * This file is part of GNU Smalltalk.
 *
 * GNU Smalltalk is free software; you can redistribute it and/or modify it
 * under the terms of the GNU General Public License as published by the Free
 * Software Foundation; either version 2, or (at your option) any later 
 * version.
 * 
 * GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
 * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 
 * FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
 * more details.
 * 
 * You should have received a copy of the GNU General Public License along with
 * GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
 * Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  
 *
 * Here is the copyright notice for the XPM code:
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
 * deal in the Software without restriction, including without limitation the
 * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
 * sell copies of the Software, and to permit persons to whom the Software is
 * furnished to do so, subject to the following conditions:
 *
 * The above copyright notice and this permission notice shall be included in
 * all copies or substantial portions of the Software.
 *
 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
 * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
 * GROUPE BULL BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN
 * AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
 * CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 *
 * Except as contained in this notice, the name of GROUPE BULL shall not be
 * used in advertising or otherwise to promote the sale, use or other dealings
 * in this Software without prior written authorization from GROUPE BULL.

 ***********************************************************************/

#include "gst.h"
#include "gstpub.h"
#include "alloc.h"
#include "oop.h"

#ifndef HAVE_TCLTK
#error Tcl/Tk 8.0 needed to install the GNU Smalltalk GUI
#endif

#include <stdio.h>
#include <ctype.h>
#include <errno.h>
#include <tcl.h>
#include <tk.h>

#ifdef STDC_HEADERS
#include <stdlib.h>
#include <string.h>
#endif

/* Smalltalk call-ins */
static Tcl_Interp 		*tclInit();
static void 			bloxIdle();

/* TCL callbacks */
static int 			doCallback();
static int 			xpmFileMatch();
static int 			xpmStringMatch();
static int 			xpmFileRead();
static int 			xpmStringRead();

/* Globals */
static Tcl_Interp *interp;

static void 			xpmInit();

void
initBlox()
{
  defineCFunc("Tcl_Eval", Tcl_Eval);
  defineCFunc("Tcl_GetStringResult", Tcl_GetStringResult);
  defineCFunc("tclInit", tclInit);
  defineCFunc("bloxIdle", bloxIdle);
}

void
bloxIdle()
{
  Tcl_DoOneEvent(TCL_ALL_EVENTS | TCL_DONT_WAIT);
}

int
doCallback(clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp *interp;
     int argc;
     char *argv[];
{
  OOP oop, *args;
  int i;

  /* argv[0] is "callback", the command name */
  args = alloca(sizeof(OOP) * (argc - 2));
  oop = oopAt(atoi(argv[1]));
  for (i=0;i<argc-3;i++) {
    args[i] = stringToOOP(argv[i+3]);
  }
  args[argc - 3] = NULL;
  if (vmsgSend(oop, symbolToOOP(argv[2]), args) == trueOOP) {
    Tcl_SetResult(interp, "1", TCL_STATIC);
  } else {
    Tcl_SetResult(interp, "0", TCL_STATIC);
  }

  return TCL_OK;
}

Tcl_Interp *
tclInit()
{
  if (interp) {
    return(NULL);
  }

  interp = Tcl_CreateInterp();
  if (Tcl_Init(interp) == TCL_ERROR) {
    fprintf(stderr, "Tcl_Init failed: %s\n", interp->result);
    exit(1);
  }
  if (Tk_Init(interp) == TCL_ERROR) {
    fprintf(stderr, "Tk_Init failed: %s\n", interp->result);
    exit(1);
  }
  Tcl_CreateCommand(interp, "callback", doCallback, NULL, NULL);
  xpmInit();

  return (interp);
}

/******************* BEGINNING OF XPM CODE ***********************/

typedef struct {
    char	*cptr;
    char	*Bcmt, *Ecmt, Bos, Eos;
    mst_Boolean xpm1;			/* 1 if XPM1, 0 otherwise */
} XpmData;

#include "rgbtab.h"

/* number of xpmColorKeys */
#define NKEYS 5

char *xpmColorKeys[] = {
    "s",				/* key #1: symbol */
    "m",				/* key #2: mono visual */
    "g4",				/* key #3: 4 grays visual */
    "g",				/* key #4: gray visual */
    "c",				/* key #5: color visual */
};

typedef struct {
    char *type;			/* key word */
    char *Bcmt;			/* string beginning comments */
    char *Ecmt;			/* string ending comments */
    char Bos;			/* character beginning strings */
    char Eos;			/* character ending strings */
} XpmDataType;

typedef struct {
    char *string;		/* characters string */
    char *symbolic;		/* symbolic name */
    char *m_color;		/* monochrom default */
    char *g4_color;		/* 4 level grayscale default */
    char *g_color;		/* other level grayscale default */
    char *c_color;		/* color default */
    int rgb;
} XpmColor;

typedef struct {
    unsigned int width;		/* image width */
    unsigned int height;	/* image height */
    unsigned int *data;		/* image data */
} XpmImage;


static XpmDataType xpmDataTypes[] =
{
    { "", "!", "\n", '\0', '\n' },	/* Natural type */
    { "C", "/*", "*/", '"', '"' },
    { "Lisp", ";", "\n", '"', '"' },
    { NULL, NULL, NULL, 0, 0, }
};

static int		xpmParseHeader(), xpmParseValues(), xpmParseColors(),
			xpmParsePixels(), xpmParseData();

static mst_Boolean	xpmNextUI(), atoui();

static void		xpmNextString(), xpmParseComment(), xpmFreeColorTable();

static unsigned int	xpmNextWord();

void
ParseNumericColor(str, prgb)
     char	*str;
     int	*prgb;
{
#define HEX(ch, shift)	\
	( ((unsigned int) (((ch) - ((ch) < 'A' ? 48 : 55)) & 15)) << (shift))

  switch (strlen(str)) {
    case 4:
      *prgb = HEX(str[1], 20) | HEX(str[2], 12) | HEX(str[1], 4);
      return;

    case 7:
      *prgb = HEX(str[1], 20) | HEX(str[3], 12) | HEX(str[5], 4)
	    | HEX(str[2], 16) | HEX(str[4],  8) | HEX(str[6], 0);
      return;

    case 10:
      *prgb = HEX(str[1], 20) | HEX(str[4], 12) | HEX(str[7], 4)
	    | HEX(str[2], 16) | HEX(str[5],  8) | HEX(str[8], 0);
      return;

    case 13:
      *prgb = HEX(str[1], 20) | HEX(str[5], 12) | HEX(str[ 9], 4)
	    | HEX(str[2], 16) | HEX(str[6],  8) | HEX(str[10], 0);
      return;
  }
}

void
ParseXColor(uid, prgb)
     Tk_Uid	uid;
     int	*prgb;
{
  xpmColorEntry *ce;

  for (ce = xColors; ce->color; ce++) {
    if((char *)ce->color == uid) {
      *prgb = ce->rgb;
      return;
    }
  }
}

void
xpmParseComment(mdata)
     XpmData *mdata;
{
  register char c;
  register unsigned int n = 0;
  char *s2;

  /* skip the string beginning comment */
  s2 = mdata->Bcmt;
  do {
    c = *mdata->cptr++;
    n++;
    s2++;
  } while (c == *s2 && *s2 != '\0' && c && c != mdata->Bos);

  if (*s2 != '\0') {
    /* this wasn't the beginning of a comment */
    mdata->cptr -= n;
    return;
  }
  /* skip comment */
  do {
    s2 = mdata->Ecmt;
    while (c && c != *s2 && c != mdata->Bos) {
      c = *mdata->cptr++;
    }
    do {
      c = *mdata->cptr++;
      s2++;
    } while (c == *s2 && *s2 != '\0' && c && c != mdata->Bos);
  } while (*s2 != '\0');

  /* this is the end of the comment */
  mdata->cptr--;
  return;
}

/*
 * skip to the end of the current string and the beginning of the next one
 */
void
xpmNextString(mdata)
     XpmData *mdata;
{
  register char c;

  /* get to the end of the current string */
  if (mdata->Eos)
    while ((c = *mdata->cptr++) && c != mdata->Eos);

  /*
   * then get to the beginning of the next string looking for possible
   * comment
   */
  if (mdata->Bos) {
    while ((c = *mdata->cptr++) && c != mdata->Bos)
      if (mdata->Bcmt && c == mdata->Bcmt[0])
	xpmParseComment(mdata);
  } else if (mdata->Bcmt) {   /* XPM2 natural */
    while ((c = *mdata->cptr++) == mdata->Bcmt[0])
      xpmParseComment(mdata);
    mdata->cptr--;
  }
  return;
}


/*
 * skip whitespace and return the following word
 */
unsigned int
xpmNextWord(mdata, buf, buflen)
     XpmData *mdata;
     char *buf;
     unsigned int buflen;
{
  register unsigned int n = 0;
  int c;

  while (isspace(c = *mdata->cptr) && c != mdata->Eos)
    mdata->cptr++;
  do {
    c = *mdata->cptr++;
    *buf++ = c;
    n++;
  } while (!isspace(c) && c != mdata->Eos && n < buflen);
  n--;
  mdata->cptr--;

  return (n);
}

/*
 * skip whitespace and compute the following unsigned int,
 * returns true if one is found and false if not
 */
mst_Boolean
atoui(buf, l, ui_return)
     char *buf;
     int l;
     unsigned int *ui_return;
{
  unsigned long int result;

  buf[l] = 0;
  errno = 0;
  *ui_return = strtoul (buf, NULL, 0);
  result = !errno;
  errno = 0;
  return (unsigned int) result;
}

mst_Boolean
xpmNextUI(mdata, ui_return)
     XpmData *mdata;
     unsigned int *ui_return;
{
  long int l;
  char buf[BUFSIZ + 1];

  l = xpmNextWord(mdata, buf, BUFSIZ);
  return atoui(buf, l, ui_return);
}

/*
 * parse xpm header
 */
int
xpmParseHeader(mdata)
     XpmData *mdata;
{
  char buf[BUFSIZ + 1];
  int l, n = 0;

  mdata->Bos = '\0';
  mdata->Eos = '\n';
  mdata->Bcmt = mdata->Ecmt = NULL;
  l = xpmNextWord(mdata, buf, BUFSIZ);
  if (l == 7 && !strncmp("#define", buf, 7)) {
    /* this maybe an XPM 1 file */
    char *ptr;

    l = xpmNextWord(mdata, buf, BUFSIZ);
    if (!l)
      return (TCL_ERROR); /* File Invalid */
    ptr = index(buf, '_');
    if (!ptr || strncmp("_format", ptr, l - (ptr - buf)))
      return (TCL_ERROR); /* File Invalid */
    /* this is definitely an XPM 1 file */
    mdata->xpm1 = true;
    n = 1;	      /* handle XPM1 as mainly XPM2 C */
  } else {

    /*
     * skip the first word, get the second one, and see if this is
     * XPM 2 or 3
     */
    l = xpmNextWord(mdata, buf, BUFSIZ);
    if ((l == 3 && !strncmp("XPM", buf, 3)) ||
      (l == 4 && !strncmp("XPM2", buf, 4))) {
      if (l == 3)
	n = 1;	      /* handle XPM as XPM2 C */
      else {
	/* get the type key word */
	l = xpmNextWord(mdata, buf, BUFSIZ);

	/*
	 * get infos about this type
	 */
	while (xpmDataTypes[n].type
	     && strncmp(xpmDataTypes[n].type, buf, l))
	  n++;
      }
      mdata->xpm1 = false;
    } else
      /* nope this is not an XPM file */
      return (TCL_ERROR); /* File Invalid */
  }
  if (xpmDataTypes[n].type) {
    if (n == 0) {	/* natural type */
      mdata->Bcmt = xpmDataTypes[n].Bcmt;
      mdata->Ecmt = xpmDataTypes[n].Ecmt;
      xpmNextString(mdata);   /* skip the end of the headerline */
      mdata->Bos = xpmDataTypes[n].Bos;
      mdata->Eos = xpmDataTypes[n].Eos;
    } else {
      mdata->Bcmt = xpmDataTypes[n].Bcmt;
      mdata->Ecmt = xpmDataTypes[n].Ecmt;
      if (!mdata->xpm1) {   /* XPM 2 or 3 */
	mdata->Bos = xpmDataTypes[n].Bos;
	mdata->Eos = '\0';
	/* get to the beginning of the first string */
	xpmNextString(mdata);
	mdata->Eos = xpmDataTypes[n].Eos;
      } else		/* XPM 1 skip end of line */
	xpmNextString(mdata);
    }
  } else
    /* we don't know about that type of XPM file... */
    return (TCL_ERROR); /* File Invalid */

  return (TCL_OK);
}

int
xpmParseValues(data, width, height, ncolors, cpp)
     XpmData *data;
     unsigned int *width, *height, *ncolors, *cpp;
{
  unsigned int l;
  unsigned int x_hotspot, y_hotspot, hotspot;
  unsigned int extensions;
  char buf[BUFSIZ + 1];

  if (!data->xpm1) {	      /* XPM 2 or 3 */

    /*
     * read values: width, height, ncolors, chars_per_pixel
     */
    if (!(xpmNextUI(data, width) && xpmNextUI(data, height)
	&& xpmNextUI(data, ncolors) && xpmNextUI(data, cpp)))
      return (TCL_ERROR); /* File invalid */

    /*
     * read optional information (hotspot and/or XPMEXT) if any
     */
    l = xpmNextWord(data, buf, BUFSIZ);
    if (l) {
      extensions = (l == 6 && !strncmp("XPMEXT", buf, 6));
      if (extensions)
	hotspot = (xpmNextUI(data, &x_hotspot)
	      && xpmNextUI(data, &y_hotspot));
      else {
	hotspot = (atoui(buf, l, &x_hotspot)
	      && xpmNextUI(data, &y_hotspot));
	l = xpmNextWord(data, buf, BUFSIZ);
      }
    }
  } else {

    /*
     * XPM 1 file read values: width, height, ncolors, chars_per_pixel
     */
    int i;
    char *ptr;

    for (i = 0; i < 4; i++) {
      l = xpmNextWord(data, buf, BUFSIZ);
      if (l != 7 || strncmp("#define", buf, 7))
	return (TCL_ERROR); /* File invalid */
      l = xpmNextWord(data, buf, BUFSIZ);
      if (!l)
	return (TCL_ERROR); /* File invalid */
      ptr = index(buf, '_');
      if (!ptr)
	return (TCL_ERROR); /* File invalid */
      switch (l - (ptr - buf)) {
      case 6:
	if (!strncmp("_width", ptr, 6) && !xpmNextUI(data, width))
	  return (TCL_ERROR); /* File invalid */
	break;
      case 7:
	if (!strncmp("_height", ptr, 7) && !xpmNextUI(data, height))
	  return (TCL_ERROR); /* File invalid */
	break;
      case 8:
	if (!strncmp("_ncolors", ptr, 8) && !xpmNextUI(data, ncolors))
	  return (TCL_ERROR); /* File invalid */
	break;
      case 16:
	if (!strncmp("_chars_per_pixel", ptr, 16)
	  && !xpmNextUI(data, cpp))
	  return (TCL_ERROR); /* File invalid */
	break;
      default:
	return (TCL_ERROR); /* File invalid */
      }
      /* skip the end of line */
      xpmNextString(data);
    }
  }
  return (TCL_OK);
}

int
xpmParseColors(data, ncolors, cpp, colorTablePtr)
     XpmData *data;
     unsigned int ncolors;
     unsigned int cpp;
     XpmColor **colorTablePtr;
{
  unsigned int key, l, a, b;
  unsigned int curkey;	      /* current color key */
  unsigned int lastwaskey;	  /* key read */
  char buf[BUFSIZ + 1];
  char curbuf[BUFSIZ + 1];	  /* current buffer */
  char **sptr, *s;
  XpmColor *color;
  XpmColor *colorTable;
  char **defaults;

  colorTable = (XpmColor *) xmalloc(ncolors * sizeof(XpmColor));
  if (!colorTable)
    return (TCL_ERROR); /* No memory */

  memset(colorTable, 0, ncolors * sizeof(XpmColor));
  if (!data->xpm1) {	      /* XPM 2 or 3 */
    for (a = 0, color = colorTable; a < ncolors; a++, color++) {
      xpmNextString(data);    /* skip the line */

      /*
       * read pixel value
       */
      color->string = (char *) xmalloc(cpp + 1);
      if (!color->string) {
	xpmFreeColorTable(colorTable, ncolors);
	return (TCL_ERROR); /* No memory */
      }
      for (b = 0, s = color->string; b < cpp; b++, s++)
	*s = *data->cptr++;
      *s = '\0';

      /*
       * read color keys and values
       */
      defaults = (char **) color;
      curkey = 0;
      lastwaskey = 0;
      *curbuf = '\0';	    /* init curbuf */
      while (l = xpmNextWord(data, buf, BUFSIZ)) {
	if (!lastwaskey) {
	  for (key = 0, sptr = xpmColorKeys; key < NKEYS; key++, sptr++)
	    if ((strlen(*sptr) == l) && (!strncmp(*sptr, buf, l)))
	      break;
	}
	if (!lastwaskey && key < NKEYS) {   /* open new key */
	  if (curkey) {	  /* flush string */
	    s = (char *) xmalloc(strlen(curbuf) + 1);
	    if (!s) {
	      xpmFreeColorTable(colorTable, ncolors);
	      return (TCL_ERROR); /* No memory */
	    }
	    defaults[curkey] = s;
	    strcpy(s, curbuf);
	  }
	  curkey = key + 1;   /* set new key  */
	  *curbuf = '\0';   /* reset curbuf */
	  lastwaskey = 1;
	} else {
	  if (!curkey) {    /* key without value */
	    xpmFreeColorTable(colorTable, ncolors);
	    return (TCL_ERROR); /* File invalid */
	  }
	  if (!lastwaskey)
	    strcat(curbuf, " ");    /* append space */
	  buf[l] = '\0';
	  strcat(curbuf, buf);/* append buf */
	  lastwaskey = 0;
	}
      }
      if (!curkey) {	    /* key without value */
	xpmFreeColorTable(colorTable, ncolors);
	return (TCL_ERROR); /* File invalid */
      }
      s = defaults[curkey] = (char *) xmalloc(strlen(curbuf) + 1);
      if (!s) {
	xpmFreeColorTable(colorTable, ncolors);
	return (TCL_ERROR); /* No memory */
      }
      strcpy(s, curbuf);
    }
  } else {		  /* XPM 1 */
    /* get to the beginning of the first string */
    data->Bos = '"';
    data->Eos = '\0';
    xpmNextString(data);
    data->Eos = '"';
    for (a = 0, color = colorTable; a < ncolors; a++, color++) {

      /*
       * read pixel value
       */
      color->string = (char *) xmalloc(cpp + 1);
      if (!color->string) {
	xpmFreeColorTable(colorTable, ncolors);
	return (TCL_ERROR); /* No memory */
      }
      for (b = 0, s = color->string; b < cpp; b++, s++)
	*s = *data->cptr++;
      *s = '\0';

      /*
       * read color values
       */
      xpmNextString(data);    /* get to the next string */
      *curbuf = '\0';	    /* init curbuf */
      while (l = xpmNextWord(data, buf, BUFSIZ)) {
	if (*curbuf != '\0')
	  strcat(curbuf, " "); /* append space */
	buf[l] = '\0';
	strcat(curbuf, buf);	/* append buf */
      }
      s = (char *) xmalloc(strlen(curbuf) + 1);
      if (!s) {
	xpmFreeColorTable(colorTable, ncolors);
	return (TCL_ERROR); /* No memory */
      }
      strcpy(s, curbuf);
      color->c_color = s;
      *curbuf = '\0';	    /* reset curbuf */
      if (a < ncolors - 1)
	xpmNextString(data);	/* get to the next string */
    }
  }

  for (a = 0, color = colorTable; a < ncolors; a++, color++) {
    Tk_Uid noneUid = Tk_GetUid("None");

    for (curkey = NKEYS, color->rgb = -2, defaults = (char **) color;
       color->rgb == -2 && curkey; curkey--) {

      Tk_Uid colorUid;
      if (!defaults[curkey]) {
	continue;
      }
      if (defaults[curkey][0] == '#') {
	ParseNumericColor(defaults[curkey], &color->rgb);
	continue;
      }
      if (!strncmp(defaults[curkey], "grey", 4)) {
	/* Recognize `greys' too, not just `grays'... */
	defaults[curkey][2] = 'a';
      }

      /* Make black the transparent color -- black becomes a very dark gray */
      colorUid = Tk_GetUid(defaults[curkey]);
      if (colorUid == noneUid) {
	color->rgb = 0;
	continue;
      }
      ParseXColor(colorUid, &color->rgb);
      if (!color->rgb) {
	color->rgb = 0x30303;		/* This is gray1 */
      }
    }
  }

  *colorTablePtr = colorTable;
  return (TCL_OK);
}

int
xpmParsePixels(data, width, height, ncolors, cpp, colorTable, pixels)
     XpmData *data;
     unsigned int width, height, ncolors, cpp;
     XpmColor *colorTable;
     unsigned int **pixels;
{
  unsigned int *iptr, *iptr2;
  unsigned int a, x, y;

  iptr2 = (unsigned int *) xmalloc(sizeof(unsigned int) * width * height);
  if (!iptr2)
    return (TCL_ERROR); /* No memory */

  iptr = iptr2;

  switch (cpp) {

  case (1):		  /* Optimize for single character colors */
    {
      unsigned int colrgb[256];

      memset(colrgb, 0, 256 * sizeof(int));
      for (a = 0; a < 256; a++)
	colrgb[a] = -1;
      for (a = 0; a < ncolors; a++)
	colrgb[(unsigned int) colorTable[a].string[0]] = colorTable[a].rgb;

      for (y = 0; y < height; y++) {
	xpmNextString(data);
	for (x = 0; x < width; x++, iptr++) {
	  int rgb = colrgb[(unsigned int) *data->cptr++];

	  if (rgb != -1)
	    *iptr = rgb;
	  else {
	    xfree(iptr2);
	    return (TCL_ERROR); /* File invalid */
	  }
	}
      }
    }
    break;

  case (2):		  /* Optimize for double character scolors */
    {

/* free all allocated pointers at all exits */
#define FREE_CRGB {int f; for (f = 0; f < 256; f++) \
if (crgb[f]) xfree(crgb[f]);}

      /* array of pointers malloced by need */
      unsigned int *crgb[256];
      int char1, a2;

      memset(crgb, 0, 256 * sizeof(unsigned int *)); /* init */
      for (a = 0; a < ncolors; a++) {
	char1 = colorTable[a].string[0];
	if (crgb[char1] == NULL) { /* get new memory */
	  crgb[char1] = (unsigned int *)
	    xmalloc(256 * sizeof(unsigned int));
	  if (crgb[char1] == NULL) { /* new block failed */
	    FREE_CRGB;
	    xfree(iptr2);
	    return (TCL_ERROR); /* No memory */
	  }
	  for (a2 = 0; a2 < 256; a2++)
	    crgb[char1][a2] = -1;
	}
	crgb[char1][(unsigned int) colorTable[a].string[1]] = colorTable[a].rgb;
      }

      for (y = 0; y < height; y++) {
	xpmNextString(data);
	for (x = 0; x < width; x++, iptr++) {
	  int cc1 = *data->cptr++;
	  int rgb = crgb[cc1][(unsigned int) *data->cptr++];

	  if (rgb != -1)
	    *iptr = rgb - 1;
	  else {
	    FREE_CRGB;
	    xfree(iptr2);
	    return (TCL_ERROR); /* File invalid */
	  }
	}
      }
      FREE_CRGB;
    }
    break;

  default:		  /* Long color names */
    return (TCL_ERROR); /* Not supported */
  }
  *pixels = iptr2;
  return (TCL_OK);
}
/*
 * This function parses an xpm file or data and store the found informations
 * in an an XpmImage structure which is returned.
 */
int
xpmParseData(buffer, image, readPixels)
     char *buffer;
     XpmImage *image;
     mst_Boolean readPixels;
{
  /* variables to return */
  unsigned int width, height, ncolors, cpp;
  XpmColor *colorTable = NULL;
  unsigned int *pixelindex = NULL;

  int ErrorStatus;
  XpmData data;

  /*
   * parse the header
   */
  memset(image, 0, sizeof(XpmImage));
  data.cptr = buffer;
  ErrorStatus = xpmParseHeader(&data);
  if (ErrorStatus != TCL_OK)
    return (ErrorStatus);

  /*
   * read values
   */
  ErrorStatus = xpmParseValues(&data, &width, &height, &ncolors, &cpp);
  if (ErrorStatus != TCL_OK)
    return (ErrorStatus);

  /*
   * store found informations in the XpmImage structure
   */
  image->width = width;
  image->height = height;
  if (!readPixels) {
    return (TCL_OK);
  }

  /*
   * read colors
   */
  ErrorStatus = xpmParseColors(&data, ncolors, cpp, &colorTable);
  if (ErrorStatus != TCL_OK)
    return (ErrorStatus);

  /*
   * read pixels and index them on color number
   */
  ErrorStatus = xpmParsePixels(&data, width, height, ncolors, cpp, colorTable,
		&pixelindex);

  xpmFreeColorTable(colorTable, ncolors);
  if (ErrorStatus != TCL_OK) {
    return (ErrorStatus);
  }

  image->data = pixelindex;
  return (TCL_OK);
}

/*
 * Free the computed color table
 */
void
xpmFreeColorTable(colorTable, ncolors)
     XpmColor *colorTable;
     int ncolors;
{
  int a, b;
  XpmColor *color;
  char **sptr;

  for (a = 0, color = colorTable; a < ncolors; a++, color++) {
    for (b = 0, sptr = (char **) color; b <= NKEYS; b++, sptr++)
      if (*sptr)
	xfree(*sptr);
  }
  xfree(colorTable);
}


/******************************* TCL INTERFACE FOR XPM **************/

int
xpmStringMatch(string, formatString, widthPtr, heightPtr)
     char		*string, *formatString;
     int		*widthPtr, *heightPtr;
{
  XpmImage	img;
  int		result;

  result = xpmParseData(string, &img, false);
  if (result != TCL_OK) {
    return (0);
  }
  *widthPtr = img.width;
  *heightPtr = img.height;
  return (1);
}

int
xpmStringRead(interp, string, formatString, imageHandle,
	destX, destY, width, height, srcX, srcY)
     Tcl_Interp		*interp;
     char		*string, *formatString;
     Tk_PhotoHandle	imageHandle;
     int		destX, destY, width, height, srcX, srcY;
{
  XpmImage	img;
  int		result;
  unsigned int	*block;

#ifdef WORDS_BIG_ENDIAN
#define BYTEOFS(i) (sizeof(int)-i)
#else
#define BYTEOFS(i) (i)
#endif

  static Tk_PhotoImageBlock blk = {
    NULL, /* unsigned char *pixelPtr; */
    0, /* int width; */
    1, /* int height; */
    0, /* int pitch; */
    sizeof(int), /* int pixelSize; */
    {BYTEOFS(2), BYTEOFS(1), BYTEOFS(0)}, /* int offset[3]; */
  };

#undef BYTEOFS

  result = xpmParseData(string, &img, true);
  if (result != TCL_OK) {
    return (result);
  }

  for(block = img.data + img.width * srcY + srcX; img.height; img.height--, destY++) {
    int		 todo;
    unsigned int last;

    for(blk.pixelPtr = (voidPtr) block, blk.width = 0, last = *block,
        destX = 0, todo = img.width; todo--; last = *block, block++) {

      if ((*block == 0) ^ (last == 0)) {
        if (last) {
          Tk_PhotoPutBlock(imageHandle, &blk, destX, destY, blk.width, 1);
        }
        destX += blk.width;
        blk.width = 1;
        blk.pixelPtr = (voidPtr) block;
      } else {
        blk.width++;
      }
    }

    if (last) {
      Tk_PhotoPutBlock(imageHandle, &blk, destX, destY, blk.width, 1);
    }
  }

  xfree(img.data);
  return (result);
}

int
xpmFileMatch(channel, fileName, formatString, widthPtr, heightPtr)
     Tcl_Channel	channel;
     char		*fileName, *formatString;
     int		*widthPtr, *heightPtr;
{
  int	fileSize, bytesRead, result;
  char	*buf;
  fileSize = Tcl_Seek(channel, 0, SEEK_END);
  if (fileSize < 0 || Tcl_Seek(channel, 0, SEEK_SET) < 0) {
    return (0);
  }

  buf = xmalloc(fileSize + 1);
  if (!buf) {
    return (0);
  }

  bytesRead = Tcl_Read(channel, buf, fileSize);
  if (bytesRead < 0) {
    xfree (buf);
    return (0);
  }

  buf[bytesRead] = '\0';
  result = xpmStringMatch(buf, formatString, widthPtr, heightPtr);
  xfree (buf);
  return (result);
}

int
xpmFileRead(interp, channel, fileName, formatString, imageHandle,
	destX, destY, width, height, srcX, srcY)
     Tcl_Interp		*interp;
     Tcl_Channel	channel;
     char		*fileName, *formatString;
     Tk_PhotoHandle	imageHandle;
     int		destX, destY, width, height, srcX, srcY;
{
  int	fileSize, bytesRead, result;
  char	*buf;
  fileSize = Tcl_Seek(channel, 0, SEEK_END);
  if (fileSize < 0 || Tcl_Seek(channel, 0, SEEK_SET) < 0) {
    return (TCL_ERROR);
  }

  buf = xmalloc(fileSize + 1);
  if (!buf) {
    return (TCL_ERROR);
  }

  bytesRead = Tcl_Read(channel, buf, fileSize);
  if (bytesRead < 0) {
    xfree (buf);
    return (TCL_ERROR);
  }

  buf[bytesRead] = '\0';
  result = xpmStringRead(interp, fileName, formatString, imageHandle,
	destX, destY, width, height, srcX, srcY);
  xfree (buf);
  return (result);
}

void
xpmInit()
{
  static Tk_PhotoImageFormat xpmFormat = {
    "XPM",
    xpmFileMatch,
    xpmStringMatch,
    xpmFileRead,
    xpmStringRead,
    NULL,
    NULL,
    NULL
  };
  xpmColorEntry *ce;

  Tk_CreatePhotoImageFormat(&xpmFormat);

  for (ce = xColors; ce->color; ce++) {
    ce->color = (char *) Tk_GetUid(ce->color);
  }
}