/* Interpretation of generic GDL images for Xconq.
   Copyright (C) 1994-1999 Stanley T. Shebs.

Xconq 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.  See the file COPYING.  */

/* Note!  This file does not use the standard "conq.h" header, so can't assume
   all the usual definitions. */
 
#include "config.h"
#include "misc.h"
#include "lisp.h"
#include "imf.h"
extern Image *get_subimg(ImageFamily *imf, int w, int h);
extern Image *largest_image(ImageFamily *imf);
extern int image_pixel_at(Image *img, int imtype, int x, int y);
extern void set_image_pixel_at(Image *img, int imtype, int x, int y, int val);
extern void make_image_from_file_image(ImageFamily *imf, Image *img,
				       Image *subimg, int subi);
#include "module.h"
#include "system.h"

extern void syntax_error(Obj *x, char *msg);

/* RGB above this value should be considered white. */

#define WHITE_THRESHOLD (65535 - 256)

/* RGB below this value should be considered black. */

#define BLACK_THRESHOLD (    0 + 255)

/* (should remove these fixed limits someday) */

#define MAXIMAGEFAMILIES 1000

#define MAXIMAGEPALETTES 100

enum {
    K_MONO_,
    K_MASK_,
    K_COLR_,
    K_FILE_,
    K_OTHER_
};

static ImageFamily *new_imf(char *name);
static Image *add_shrunken_image(ImageFamily *imf);
static Image *add_magnified_image(ImageFamily *imf);
static int bitmaps_match(int w, int h, Obj *lispdata, char *rawdata);
static int color_matches_mono(Image *img);
static void write_pixmap(FILE *fp, int w, int h, int aw, int ah,
				 int pixelsize,
				 Obj *palette, int *rawpalette, int numcolors,
				 Obj *lispdata, char *rawdata);
static void write_bitmap(FILE *fp, char *subtyp, int w, int h,
				 Obj *data, char *rawdata);
static void write_palette_contents(FILE *fp, Obj *palette,
					    int *rawpalette, int numcolors);
static void write_color(FILE *fp, int n, int r, int g, int b);

/* This is the array and count of known image families. */

ImageFamily **images;

int numimages = 0;

/* This is the array and count of named palettes. */

ImagePalette **palettes;

int numpalettes = 0;

/* Head of the linked list of image files. */

ImageFile *image_files;

/* Head of the linked list of "file" images used by several image families. */

FileImage *file_images;

ImageFamily *(*imf_load_hook)(ImageFamily *imf);

ImageFamily *(*imf_interp_hook)(ImageFamily *imf, Image *img, int force);

short write_synthetic_also;

/* Create and return an image family. */

static ImageFamily *
new_imf(name)
char *name;
{
    ImageFamily *imf;

    imf = (ImageFamily *) xmalloc(sizeof(ImageFamily));
    imf->name = name;
    imf->notes = lispnil;
    return imf;
}

ImageFamily *
clone_imf(imf)
ImageFamily *imf;
{
    Image *img, *img2, *truenext;
    ImageFamily *imf2;

    imf2 = new_imf(imf->name);
    memcpy(imf2, imf, sizeof(ImageFamily));
    /* Clear the hook, we expect that the caller of this routine will
       supply any new hook that might be necessary. */
    imf2->hook = NULL;
    imf2->images = NULL;
    imf2->numsizes = 0;
    /* Clone the images. */
    for_all_images(imf, img) {
	img2 = get_img(imf2, img->w, img->h, 0);
	truenext = img2->next;
	memcpy(img2, img, sizeof(Image));
	/* Clear the hook, we expect that the caller of this routine
	   will supply any new hook that might be necessary. */
	img2->hook = NULL;
	/* Restore the link. */
	img2->next = truenext;
	/* Note that pointers to raw image data and suchlike can be
	   left as-is, since they should be shared by image clones. */
	/* (should copy anyway, for safety?) */
    }
    return imf2;
}

/* Test that the given name is a valid image family name (all alphanumeric,
   hyphens anywhere but as first char). */

int
valid_imf_name(name)
char *name;
{
    char *tmp;

    for (tmp = name; *tmp; ++tmp) {
	if (!(isalnum(*tmp)
	      || (tmp != name && *tmp == '-')))
	  return FALSE;
    }
    return TRUE;
}

/* Bash invalid chars in a prospective imf name. */

void
validify_imf_name(buf)
char *buf;
{
    char *tmp;

    for (tmp = buf; *tmp; ++tmp) {
	if (tmp == buf && *tmp == '-')
	  *tmp = 'Z';
	if (!isalnum(*tmp) && *tmp != '-')
	  *tmp = '-';
    }
}

/* Given a name, find or create an image family with that name. */

ImageFamily *
get_imf(name)
char *name;
{
    ImageFamily *imf = NULL;
    
    if (name == NULL) {
	init_warning("can't get an unnamed image family");
	return NULL;
    }
    if (!valid_imf_name(name)) {
	init_warning("\"%s\" is not a valid image family name", name);
	return NULL;
    }
    if (images == NULL) {
	images =
	  (ImageFamily **) xmalloc(MAXIMAGEFAMILIES * sizeof(ImageFamily *));
    }
    imf = find_imf(name);
    if (imf == NULL) {
	if (numimages >= MAXIMAGEFAMILIES) {
	    return NULL;
	}
	imf = new_imf(copy_string(name));
	if (imf != NULL) {
	    images[numimages++] = imf;
	}
    }
    return imf;
}

ImageFile *
get_image_file(name)
char *name;
{
    ImageFile *imfile;
    
    if (name == NULL)
      run_error("can't get an unnamed image file");
    for (imfile = image_files; imfile != NULL; imfile = imfile->next) {
	if (strcmp(name, imfile->name) == 0)
	  return imfile;
    }
    imfile = (ImageFile *) xmalloc(sizeof(ImageFile));
    imfile->name = copy_string(name);
    imfile->next = image_files;
    image_files = imfile;
    return imfile;
}

void
load_image_families(fp, loadnow, callback)
FILE *fp;
int loadnow;
void (*callback)(ImageFamily *imf, int loadnow);
{
    int done = FALSE, first = TRUE;
    char buf[BUFSIZE], *buf1, *buf2, *tmp;
    ImageFamily *imf = NULL;
    ImageFile *imfile;
    
    while (!done) {
	/* Get a line from the file and parse it. */
	if (fgets(buf, BUFSIZE-1, fp)) {
	  buf1 = buf;
	  buf2 = strchr(buf, ' ');
	  if (buf2 == NULL)
	    break;
	  *buf2 = '\0';
	  ++buf2;
	  tmp = strchr(buf2, '\n');
	  if (tmp)
	    *tmp = '\0';
	} else
	  break;
	if (strcmp(buf1, ".") == 0
	    && strcmp(buf2, ".") == 0)
	  done = TRUE;
	else if (first) {
	    if (strcmp(buf1, "ImageFamilyName") == 0
		&& strcmp(buf2, "FileName") == 0)
	      first = FALSE;
	    else {
		init_warning("File not a valid imf dir, will close and ignore");
		/* We've already given a warning message, so pretend we're done
		   so the format error message doesn't get displayed below. */
		done = TRUE;
		break;
	    }
	} else {
	    imf = get_imf(buf1);
	    if (imf != NULL) {
		imfile = get_image_file(buf2);
		imf->location = imfile;
		if (loadnow && !imfile->loaded) {
		    load_imf_file(imfile->name, callback);
		    imfile->loaded = TRUE;
		} else {
		    if (callback != NULL)
		      (*callback)(imf, loadnow);
		}
	    }
	}
    }
    if (!done) {
	init_warning("Format error in imf dir near %s, will only use part",
		     (imf ? imf->name : "???"));
    }
}

/* Given a filename, open it and read/interpret all the image-related
   forms therein. */

int
load_imf_file(filename, callback)
char *filename;
void (*callback)(ImageFamily *imf, int loadnow);
{
    int startlineno = 1, endlineno = 1;
    Obj *form;
    FILE *fp;

    fp = open_file(filename, "r");
    if (fp != NULL) {
	/* Read everything in the file. */
	while ((form = read_form(fp, &startlineno, &endlineno)) != lispeof) {
	    interp_imf_form(form, callback);
	}
	fclose(fp);
	return TRUE;
    }
    return FALSE;
}

/* Interpret a form, looking specifically for image-related forms. */

void
interp_imf_form(form, imf_callback)
Obj *form;
void (*imf_callback)(ImageFamily *imf, int loadnow);
{
    Obj *head;
    ImageFamily *imf;

    /* Ignore any non-lists, we might be reading from a normal game design. */
    if (!consp(form))
      return;
    head = car(form);
    if (match_keyword(head, K_IMF)) {
	imf = interp_imf(form);
	if (imf_callback != NULL && imf != NULL)
	  (*imf_callback)(imf, TRUE);
    } else if (match_keyword(head, K_PALETTE)) {
	interp_palette(form);
    } else {
	/* Ignore any non-image forms, we might be reading from a 
	   normal game design. */
    }
}

/* Find the image family of the given name, if it exists. */

ImageFamily *
find_imf(char *name)
{
    int i;

    for (i = 0; i < numimages; ++i) {
	if (strcmp(name, images[i]->name) == 0)
	  return images[i];
    }
    return NULL;
}

/* Get an image of the given size from the family, creating a new one
   if necessary. */

Image *
get_img(ImageFamily *imf, int w, int h, int subimg)
{
    Image *img, *nimg, *previmg;

    for_all_images(imf, img) {
	if (w == img->w && h == img->h)
	  return img;
    }
    /* Not found; create a new image and add it to the family. */
    nimg = (Image *) xmalloc(sizeof(Image));
    nimg->w = w;  nimg->h = h;
    nimg->embedx = nimg->embedy = -1;
    nimg->embedw = nimg->embedh = -1;
    nimg->monodata = nimg->colrdata = nimg->maskdata = lispnil;
    nimg->filedata = lispnil;
    nimg->palette = lispnil;
    nimg->actualw = w;  nimg->actualh = h;
    nimg->notes = lispnil;
    nimg->bboxw = w;  nimg->bboxh = h;
    /* Subimages get handled separately, we don't want to link into the
       main list of images. */
    if (subimg)
      return nimg;
    /* Rely on zeroing of xmalloc blocks to avoid clearing other fields. */
    /* Link in order by size, smallest first. */
    previmg = NULL;
    for_all_images(imf, img) {
	if ((nimg->w < img->w)
	    || (nimg->w == img->w && nimg->h < img->h))
	  break;
	previmg = img;
    }
    if (previmg != NULL) {
	nimg->next = previmg->next;
	previmg->next = nimg;
    } else {
	nimg->next = imf->images;
	imf->images = nimg;
    }
    ++(imf->numsizes);
    return nimg;
}

/* Get an image of the given size from the family, creating a new one
   if necessary. */

Image *
get_subimg(ImageFamily *imf, int w, int h)
{
    Image *nimg;

    /* Not found; create a new image and add it to the family. */
    nimg = (Image *) xmalloc(sizeof(Image));
    nimg->w = w;  nimg->h = h;
    nimg->embedx = nimg->embedy = -1;
    nimg->embedw = nimg->embedh = -1;
    nimg->monodata = nimg->colrdata = nimg->maskdata = lispnil;
    nimg->filedata = lispnil;
    nimg->palette = lispnil;
    nimg->actualw = w;  nimg->actualh = h;
    nimg->notes = lispnil;
    nimg->bboxw = w;  nimg->bboxh = h;
    return nimg;
}

Image *
find_img(ImageFamily *imf, int w, int h)
{
    Image *img;
	
    for_all_images(imf, img) {
	if (w == img->w && h == img->h)
	  return img;
    }
    return NULL;
}

ImageFamily *
interp_imf(form)
Obj *form;
{
    ImageFamily *imf;

    if (stringp(cadr(form))) {
	imf = get_imf(c_string(cadr(form)));
	if (imf != NULL) {
	    interp_imf_contents(imf, cddr(form));
	}
	return imf;
    } else {
	run_warning("image family name must be a string");
    }
    return NULL;
}

void
interp_imf_contents(imf, clauses)
ImageFamily *imf;
Obj *clauses;
{
    Obj *rest, *clause;

    for_all_list(clauses, rest) {
	clause = car(rest);
	if (consp(clause)) {
	    if (symbolp(car(clause))) {
		if (match_keyword(car(clause), K_NOTES)) {
		    imf->notes = cadr(clause);
		    syntax_error(clause, "extra junk after property value");
		} else {
		    syntax_error(clause, "unknown image family property");
		}
	    } else if (consp(car(clause))) {
		interp_image(imf, car(clause), cdr(clause));
	    } else {
		syntax_error(clause, "not image or image family property");
	    }
	} else {
	    syntax_error(clause, "bogus clause");
	}
    }
    compute_image_bboxes(imf);
}

/* Given an image family, a size, and a list describing the elements
   of a single image, parse the size and elements, put those into the
   right slots of an image object.  Also detect and warn about changes
   to an existing image, since this usually indicates some kind of
   problem. */

void
interp_image(imf, size, parts)
ImageFamily *imf;
Obj *size, *parts;
{
    int w, h, imtype, emx, emy, emw, emh, subi;
    char *name;
    Image *img, *subimg;
    Obj *head, *rest, *typ, *prop, *proptype, *datalist;
    
    w = c_number(car(size));  h = c_number(cadr(size));
    img = get_img(imf, w, h, 0);
    if (img == NULL)
      run_error("no image?");
    if (img->w == 1 && img->h == 1) {
	/* A color is more like a tile than an icon. */
	img->istile = TRUE;
	img->palette = cons(cons(new_number(0), parts), lispnil);
	return;
    }
    if (match_keyword(car(cddr(size)), K_TILE))
      img->istile = TRUE;
    if (match_keyword(car(cddr(size)), K_CONNECTION))
      img->isconnection = TRUE;
    if (match_keyword(car(cddr(size)), K_BORDER))
      img->isborder = TRUE;
    if (symbolp(car(cddr(size))) && strcmp(c_string(car(cddr(size))), "transition") == 0)
      img->istransition = TRUE;
    for_all_list(parts, rest) {
	head = car(rest);
	typ = car(head);
	imtype = K_OTHER_;
	if (match_keyword(typ, K_MONO)) {
	    imtype = K_MONO_;
	} else if (match_keyword(typ, K_MASK)) {
	    imtype = K_MASK_;
	} else if (match_keyword(typ, K_COLOR)) {
	    imtype = K_COLR_;
	} else if (match_keyword(typ, K_FILE)) {
	    imtype = K_FILE_;
	} else if (match_keyword(typ, K_EMBED)) {
	    name = c_string(cadr(head));
	    if (img->embedname != NULL
		&& strcmp(img->embedname, name) != 0)
	      run_warning("Changing embed name from \"%s\" to \"%s\" in %dx%d image of \"%s\"",
			  img->embedname, name, w, h, imf->name);
	    img->embedname = name;
	} else if (match_keyword(typ, K_EMBED_AT)) {
	    emx = c_number(cadr(head));  emy = c_number(caddr(head));
	    if ((img->embedx >= 0 && emx != img->embedx)
		|| (img->embedy >= 0 && emy != img->embedy))
	      run_warning("Changing embed x,y from %d,%d to %d,%d in %dx%d image of \"%s\"",
			  img->embedx, img->embedy, emx, emy, w, h, imf->name);
	    img->embedx = emx;  img->embedy = emy;
	} else if (match_keyword(typ, K_EMBED_SIZE)) {
	    emw = c_number(cadr(head));  emh = c_number(caddr(head));
	    if ((img->embedw >= 0 && emw != img->embedw)
		|| (img->embedh >= 0 && emh != img->embedh))
	      run_warning("Changing embed w,h from %d,%d to %d,%d in %dx%d image of \"%s\"",
			  img->embedw, img->embedh, emw, emh, w, h, imf->name);
	    img->embedw = emw;  img->embedh = emh;
	} else if (match_keyword(typ, K_NOTES)) {
	    img->notes = cadr(head);
	    syntax_error(head, "extra junk after image notes property");
	} else if (match_keyword(typ, K_X)) {
	    img->numsubimages = c_number(cadr(head));
	    if (cddr(head) != lispnil) {
		img->subx = c_number(caddr(head));
		img->suby = c_number(car(cdddr(head)));
	    }
	} else {
	    run_warning("unknown image property in \"%s\"", imf->name);
	}
	/* If there is no actual image data to process, skip to the next
	   clause in the form. */
	if (imtype == K_OTHER_)
	  continue;
	datalist = cdr(head);
	/* Interpret random image subproperties. */
	while (consp(car(datalist))) {
	    prop = car(datalist);
	    proptype = car(prop);
	    if (match_keyword(proptype, K_ACTUAL)) {
		img->actualw = c_number(cadr(prop));
		img->actualh = c_number(caddr(prop));
	    } else if (match_keyword(proptype, K_PIXEL_SIZE)) {
		img->pixelsize = c_number(cadr(prop));
	    } else if (match_keyword(proptype, K_PALETTE)) {
		img->palette = cdr(prop);
	    } else {
		run_warning("unknown image subproperty in \"%s\"", imf->name);
	    }
	    datalist = cdr(datalist);
	}
	switch (imtype) {
	  case K_MONO_:
	    if (img->monodata != lispnil && !equal(datalist, img->monodata))
	      run_warning("Changing mono data in %dx%d image of \"%s\"",
			  w, h, imf->name);
	    img->monodata = datalist;
	    break;
	  case K_COLR_:
	    if (img->colrdata != lispnil && !equal(datalist, img->colrdata))
	      run_warning("Changing color data in %dx%d image of \"%s\"",
			  w, h, imf->name);
	    img->colrdata = datalist;
	    break;
	  case K_MASK_:
	    if (img->maskdata != lispnil && !equal(datalist, img->maskdata))
	      run_warning("Changing mask data in %dx%d image of \"%s\"",
			  w, h, imf->name);
	    img->maskdata = datalist;
	    break;
	  case K_FILE_:
	    if (img->filedata != lispnil && !equal(datalist, img->filedata))
	      run_warning("Changing file data in %dx%d image of \"%s\"",
			  w, h, imf->name);
	    img->filedata = datalist;
	    break;
	  default:
	    break;
	}
    }
    /* Allocate space for any subimages that might be needed. */
    /* (should simplify?) */
    if (img->isborder) {
	img->subimages = (Image **) xmalloc (16 * sizeof(Image *));
	for (subi = 0; subi < 16; ++subi) {
	    subimg = get_subimg(imf, img->w, img->h);
	    img->subimages[subi] = subimg;
	}
    } else if (img->isconnection) {
	img->subimages = (Image **) xmalloc (64 * sizeof(Image *));
	for (subi = 0; subi < 64; ++subi) {
	    subimg = get_subimg(imf, img->w, img->h);
	    img->subimages[subi] = subimg;
	}
    } else if (img->istransition) {
	/* Leave the main image mostly alone, iterate over the subimages. */
	img->subimages = (Image **) xmalloc (4 * 4 * sizeof(Image *));
	for (subi = 0; subi < 4 * 4; ++subi) {
	    subimg = get_subimg(imf, img->w, img->h);
	    img->subimages[subi] = subimg;
	}
    } else {
	if (img->numsubimages > 0) {
	    img->subimages =
	      (Image **) xmalloc (img->numsubimages * sizeof(Image *));
	    for (subi = 0; subi < img->numsubimages; ++subi) {
		subimg = get_subimg(imf, img->w, img->h);
		img->subimages[subi] = subimg;
	    }
	}
    }
}

void
compute_image_bboxes(imf)
ImageFamily *imf;
{
    Image *img;

    if (imf == NULL)
      return;
    for_all_images(imf, img) {
	compute_image_bbox(img);
    }
}

void
compute_image_bbox(img)
Image *img;
{
    int numbytes, i, j = 0, byte, x, y, x1, x2, k;
    int xmin, ymin, xmax, ymax;
    char *data = NULL;
    Obj *datalist, *next;

    datalist = img->maskdata;
    numbytes = img->h * computed_rowbytes(img->w, 1);
    x = y = 0;
    xmin = img->w;  ymin = img->h;
    xmax = 0;  ymax = 0;
    for (i = 0; i < numbytes; ++i) {
	if (img->maskdata != lispnil) {
	    if (data == NULL || data[j] == '\0') {
		next = car(datalist);
		if (!stringp(next)) {
		    syntax_error(datalist, "garbage in image data list");
		    return;
		}
		data = c_string(next);
		j = 0;
		datalist = cdr(datalist);
	    }
	    /* Just skip over slashes, which are for readability only. */
	    if (data[j] == '/')
	      ++j;
	    byte = hextoi(data[j]) * 16 + hextoi(data[j+1]);
	    j += 2;
	} else if (img->rawmaskdata != NULL) {
	    byte = img->rawmaskdata[i] & 0xff;
	} else {
	    byte = 0xff;
	}
	if (byte != 0) {
	    /* Find the most-significant and least-significant bits in
	       the mask byte. */
	    x1 = x2 = -1;
	    k = 0;
	    while (byte != 0) {
		if ((byte & 0x1) != 0 && x2 < 0)
		  x2 = x + 7 - k;
		byte >>= 1;
		if (byte == 0 && x1 < 0)
		  x1 = x + 7 - k;
		++k;
	    }
	    xmin = min(x1, xmin);  ymin = min(y, ymin);
	    xmax = max(x2, xmax);  ymax = max(y, ymax);
	}
	x += 8;
	if (x >= img->w) {
	    x = 0;
	    ++y;
	}
    }
    /* Compute position and size of bounding box. */
    if (xmin <= xmax && ymin <= ymax) {
	img->bboxx = xmin;  img->bboxy = ymin;
	img->bboxw = xmax - xmin;  img->bboxh = ymax - ymin;
    }
}

/* Get a single pixel from the given type of data of an image. */

int
image_pixel_at(Image *img, int imtype, int x, int y)
{
    int rowbytes, psize, i, byte, rslt;
    char *rawdata = NULL;

    if (imtype == K_MONO_) {
	rawdata = img->rawmonodata;
	psize = 1;
    } else if (imtype == K_MASK_) {
	rawdata = img->rawmaskdata;
	psize = 1;
    } else if (imtype == K_COLR_) {
	rawdata = img->rawcolrdata;
	psize = img->pixelsize;
    }
    if (rawdata == NULL)
      return 0;
    rowbytes = computed_rowbytes(img->w, psize);
    i = y * rowbytes + ((x * psize) >> 3);
    byte = rawdata[i];
    rslt = (byte >> ((8 - psize) - ((x * psize) & 0x7))) & ((1 << psize) - 1);
    return rslt;
}

/* Set a single pixel in the given type of data of an image. */

void
set_image_pixel_at(Image *img, int imtype, int x, int y, int val)
{
    int rowbytes, psize, i, byte;
    char *rawdata = NULL;

    if (imtype == K_MONO_) {
	rawdata = img->rawmonodata;
	psize = 1;
    } else if (imtype == K_MASK_) {
	rawdata = img->rawmaskdata;
	psize = 1;
    } else if (imtype == K_COLR_) {
	rawdata = img->rawcolrdata;
	psize = img->pixelsize;
    }
    if (rawdata != NULL) {
	rowbytes = computed_rowbytes(img->w, psize);
	i = y * rowbytes + ((x * psize) >> 3);
	byte = rawdata[i];
	byte |= val << ((8 - psize) - ((x * psize) & 0x7));
	rawdata[i] = byte;
    }
}

/* If an image family includes no small images (16x16 or less), then
   add an image that is half the size of the smallest image in the
   family. */

static Image *
add_shrunken_image(imf)
ImageFamily *imf;
{
    int numbytes, numbytes2, x, y, sum;
    Image *img, *img2;

    if (imf == NULL)
      return NULL;
    img = smallest_image(imf);
    /* Don't try to shrink tiles or already-shrunken images or very
       small images. */
    if (img->istile || img->synthetic || img->w <= 8 || img->h <= 8)
      return NULL;
    img2 = get_img(imf, img->w / 2, img->h / 2, 0);
    /* Chances are that any embedded subimage will become unrecognizable,
       so leave embedname empty. */
    if (img->embedx > 0)
      img2->embedx = img->embedx / 2;
    if (img->embedy > 0)
      img2->embedy = img->embedy / 2;
    if (img->embedw > 0)
      img2->embedw = img->embedw / 2;
    if (img->embedh > 0)
      img2->embedh = img->embedh / 2;
    img2->pixelsize = img->pixelsize;
    img2->palette = img->palette;
    img2->rawpalette = img->rawpalette;
    img2->numcolors = img->numcolors;
    img2->synthetic = TRUE;
    if (img->rawcolrdata == NULL) {
	/* Try different ways to get some image data. */
	if (img->colrdata != lispnil) {
	    numbytes = img->h * computed_rowbytes(img->w, img->pixelsize);
	    img->rawcolrdata = xmalloc(numbytes);
	    interp_bytes(img->colrdata, numbytes, img->rawcolrdata, 0);
	} else if (img->filedata != lispnil) {
	    make_image_from_file_image(imf, img, img, 0);
	}
    }
    if (img->rawcolrdata != NULL) {
	numbytes2 = img2->h * computed_rowbytes(img2->w, img2->pixelsize);
	img2->rawcolrdata = xmalloc(numbytes2);
    }
    numbytes = img->h * computed_rowbytes(img->w, 1);
    numbytes2 = img2->h * computed_rowbytes(img2->w, 1);
    /* Ensure that binary version of mono image exists. */
    make_raw_mono_data(img, FALSE);
    if (img->rawmonodata != NULL)
      img2->rawmonodata = xmalloc(numbytes2);
    /* Ensure that binary version of mask exists. */
    if (img->rawmaskdata == NULL && img->maskdata != lispnil) {
	img->rawmaskdata = xmalloc(numbytes);
	interp_bytes(img->maskdata, numbytes, img->rawmaskdata, 0);
    }
    if (img->rawmaskdata != NULL)
      img2->rawmaskdata = xmalloc(numbytes2);
    /* Scan through the new image, computing each pixel separately. */
    for (x = 0; x < img2->w; ++x) {
	for (y = 0; y < img2->h; ++y) {
	    if (img2->rawcolrdata != NULL) {
		/* (should choose most common or else average colors) */
		int vals[4];
		vals[0] = image_pixel_at(img, K_COLR_, 2 * x,     2 * y);
		vals[1] = image_pixel_at(img, K_COLR_, 2 * x + 1, 2 * y);
		vals[2] = image_pixel_at(img, K_COLR_, 2 * x,     2 * y + 1);
		vals[3] = image_pixel_at(img, K_COLR_, 2 * x + 1, 2 * y + 1);
		sum = vals[0];
		if (vals[1] == vals[2] || vals[1] == vals[3])
		  sum = vals[1];
		else if (vals[2] == vals[3])
		  sum = vals[2];
		set_image_pixel_at(img2, K_COLR_, x, y, sum);
	    }
	    /* Add to the mono image if 2 or more of the 4 original
	       bits are on. */
	    if (img2->rawmonodata != NULL) {
		sum = 0;
		sum += image_pixel_at(img, K_MONO_, 2 * x,     2 * y);
		sum += image_pixel_at(img, K_MONO_, 2 * x + 1, 2 * y);
		sum += image_pixel_at(img, K_MONO_, 2 * x,     2 * y + 1);
		sum += image_pixel_at(img, K_MONO_, 2 * x + 1, 2 * y + 1);
		sum = (sum >= 2 ? 1 : 0);
		set_image_pixel_at(img2, K_MONO_, x, y, sum);
	    }
	    /* Add to the mask if any of the 4 original mask bits are on. */
	    if (img2->rawmaskdata != NULL) {
		if (   image_pixel_at(img, K_MASK_, 2 * x,     2 * y)
		    || image_pixel_at(img, K_MASK_, 2 * x + 1, 2 * y)
		    || image_pixel_at(img, K_MASK_, 2 * x,     2 * y + 1)
		    || image_pixel_at(img, K_MASK_, 2 * x + 1, 2 * y + 1))
		  set_image_pixel_at(img2, K_MASK_, x, y, 1);
	    }
	}
    }
    compute_image_bbox(img2);
    if (imf_interp_hook)
      (*imf_interp_hook)(imf, img2, FALSE);
    return img2;
}

/* Add an image twice the size of the largest image in the family, if
   the family does not already include a large image. */

static Image *
add_magnified_image(imf)
ImageFamily *imf;
{
    int numbytes, numbytes2, x, y, x2, y2;
    Image *img, *img2;

    if (imf == NULL)
      return NULL;
    img = largest_image(imf);
    if (img->istile || img->synthetic || img->w >= 64 || img->h >= 64)
      return NULL;
    img2 = get_img(imf, img->w * 2, img->h * 2, 0);
    img2->embedname = img->embedname;
    if (img->embedx > 0)
      img2->embedx = img->embedx * 2;
    if (img->embedy > 0)
      img2->embedy = img->embedy * 2;
    if (img->embedw > 0)
      img2->embedw = img->embedw * 2;
    if (img->embedh > 0)
      img2->embedh = img->embedh * 2;
    img2->pixelsize = img->pixelsize;
    img2->palette = img->palette;
    img2->rawpalette = img->rawpalette;
    img2->numcolors = img->numcolors;
    img2->synthetic = TRUE;
    if (img->rawcolrdata == NULL) {
	/* Try different ways to get some image data. */
	if (img->colrdata != lispnil) {
	    numbytes = img->h * computed_rowbytes(img->w, img->pixelsize);
	    img->rawcolrdata = xmalloc(numbytes);
	    interp_bytes(img->colrdata, numbytes, img->rawcolrdata, 0);
	} else if (img->filedata != lispnil) {
	    make_image_from_file_image(imf, img, img, 0);
	}
    }
    if (img->rawcolrdata != NULL) {
	numbytes2 = img2->h * computed_rowbytes(img2->w, img2->pixelsize);
	img2->rawcolrdata = xmalloc(numbytes2);
    }
    numbytes = img->h * computed_rowbytes(img->w, 1);
    numbytes2 = img2->h * computed_rowbytes(img2->w, 1);
    make_raw_mono_data(img, FALSE);
    if (img->rawmonodata != NULL)
      img2->rawmonodata = xmalloc(numbytes2);
    if (img->rawmaskdata == NULL && img->maskdata != lispnil ) {
	img->rawmaskdata = xmalloc(numbytes);
	interp_bytes(img->maskdata, numbytes, img->rawmaskdata, 0);
    }
    if (img->rawmaskdata != NULL)
      img2->rawmaskdata = xmalloc(numbytes2);
    for (x = 0; x < img2->w; ++x) {
	for (y = 0; y < img2->h; ++y) {
	    x2 = x >> 1;  y2 = y >> 1;
	    if (img->rawcolrdata != NULL) {
		set_image_pixel_at(img2, K_COLR_, x, y,
				   image_pixel_at(img, K_COLR_, x2, y2));
	    }
	    if (img->rawmonodata != NULL) {
		set_image_pixel_at(img2, K_MONO_, x, y,
				   image_pixel_at(img, K_MONO_, x2, y2));
	    }
	    if (img->rawmaskdata != NULL) {
		set_image_pixel_at(img2, K_MASK_, x, y,
				   image_pixel_at(img, K_MASK_, x2, y2));
	    }
	}
    }
    compute_image_bbox(img2);
    if (imf_interp_hook)
      (*imf_interp_hook)(imf, img2, FALSE);
    return img2;
}

void
make_raw_mono_data(Image *img, int force)
{
    int numbytes = img->h * computed_rowbytes(img->w, 1);

    if ((img->rawmonodata == NULL || force) && img->monodata != lispnil) {
	img->rawmonodata = xmalloc(numbytes);
	interp_bytes(img->monodata, numbytes, img->rawmonodata, 0);
    }
}

/* Given a list of strings, interpret the hex digits and put the
   results at the given address. */

void
interp_bytes(datalist, numbytes, destaddr, jump)
Obj *datalist;
int numbytes, jump;
char *destaddr;
{
    int i, j = 0;
    char *data = NULL;

    for (i = 0; i < numbytes; ++i) {
	if (data == NULL || data[j] == '\0') {
	    if (datalist == lispnil) {
		return;
	    } else if (stringp(car(datalist))) {
		data = c_string(car(datalist));
		j = 0;
	    } else {
		syntax_error(datalist, "Non-string in image data list");
		/* Have to give up now. */
		return;
	    }
	    datalist = cdr(datalist);
	}
	/* Just skip over slashes, which are for readability only. */
	if (data[j] == '/')
	  ++j;
	destaddr[i] = hextoi(data[j]) * 16 + hextoi(data[j+1]);
	if (jump == 1 || (jump > 0 && i % jump == 0)) {
	    i += jump;
	    /* Be neat, put a zero in the location we're jumping over. */
	    /* (doesn't work for jump > 1, but that never happens anymore?) */
	    destaddr[i] = 0;
	}
	j += 2;
    }
}

ImagePalette *
interp_palette(form)
Obj *form;
{
    Obj *elts;
    ImagePalette *imp;

    if (stringp(cadr(form))) {
	imp = get_imp(c_string(cadr(form)));
	elts = cddr(form);
	if (consp(car(elts))
	    && symbolp(car(car(elts)))) {
	    if (match_keyword(car(car(elts)), K_NOTES)) {
		imp->notes = cadr(car(elts));
	    } else {
	    }
	    elts = cdr(elts);
	}
	return imp;
    }
    return NULL;
}

ImagePalette *
new_image_palette(name)
char *name;
{
    ImagePalette *imp;

    imp = (ImagePalette *) xmalloc(sizeof(ImagePalette));
    imp->name = name;
    imp->notes = lispnil;
    imp->palette = lispnil;
    return imp;
}

char *
canonical_palette_name(str)
char *str;
{
    return str;
}

/* Given a name, find or create an image palette with that name. */

ImagePalette *
get_imp(name)
char *name;
{
    ImagePalette *imp = NULL;

    if (name == NULL)
      return NULL;
    if (palettes == NULL)
      palettes =
	(ImagePalette **) xmalloc(MAXIMAGEPALETTES * sizeof(ImagePalette *));
    if ((imp = find_imp(name)) == NULL) {
	if (numpalettes >= MAXIMAGEPALETTES)
	  return NULL;
	imp = new_image_palette(canonical_palette_name(name));
	if (imp != NULL) {
	    palettes[numpalettes++] = imp;
	}
    }
    return imp;
}

/* Find the image palette of the given name, if it exists. */

ImagePalette *
find_imp(name)
char *name;
{
    int i;

    for (i = 0; i < numpalettes; ++i) {
	if (strcmp(name, palettes[i]->name) == 0)
	  return palettes[i];
    }
    return NULL;
}


/* Try to find the best of multiple images for the given bounding box.
   Don't return anything that won't fit in min space. */

Image *
best_image(imf, w, h)
ImageFamily *imf;
int w, h;
{
    Image *img, *best = NULL, *fallback = NULL, *best_tile = NULL;

    if (imf == NULL || imf->images == NULL)
      return NULL;
    for_all_images(imf, img) {
	/* Exact matches need no further searching. */
	if (w == img->w && h == img->h && !img->istile)
	  return img;
	/* Find the best size of image. */
	if (best == NULL
	    || (img->w <= w && img->h <= h
		&& img->w > best->w && img->h > best->h))
	  best = img;
	/* For tiles, pick out the largest tile. */
	if (img->istile) {
	    if (best_tile == NULL
		|| (img->w > best_tile->w && img->h > best_tile->h))
	      best_tile = img;
	}
    }
    /* If there were any tiles at all for this image, we're probably
       here because it's a terrain image for which no exact matches
       were found; so return the largest tile instead. */
    if (best_tile != NULL)
      return best_tile;
    /* If the best image is too large or too small (at this point we
       know it's not a tiling pattern), scale the image and return that. */
    if (best->w > w && best->h > h) {
	best = add_shrunken_image(imf);
    } else if (best->w <= (w >> 1) && best->h <= (h >> 1)) {
	fallback = add_magnified_image(imf);
	if (fallback != NULL)
	  best = fallback;
    }
    return best;
}

Image *
smallest_image(imf)
ImageFamily *imf;
{
    Image *img, *smallest = NULL;

    if (imf == NULL)
      return NULL;
    for_all_images(imf, img) {
	if (smallest == NULL || (img->w < smallest->w && img->h < smallest->h))
	  smallest = img;
    }
    return smallest;
}

Image *
largest_image(imf)
ImageFamily *imf;
{
    Image *img, *largest = NULL;

    if (imf == NULL)
      return NULL;
    for_all_images(imf, img) {
	if (largest == NULL || (img->w > largest->w && img->h > largest->h))
	  largest = img;
    }
    return largest;
}

/* Compute the right location for the given emblem and unit images. */

static int tmpbw;  /* work around Think C bug */

int
emblem_position(uimg, ename, eimf, sw, sh, exxp, eyyp, ewp, ehp)
Image *uimg;
char *ename;
ImageFamily *eimf;
int sw, sh, *exxp, *eyyp, *ewp, *ehp;
{
    int ew1, eh1, ex, ey, ew, eh, bx, by, bw, bh, overlap;
    Image *eimg;

    if (uimg
	&& uimg->embedname
	&& ename != NULL
	&& strcmp(uimg->embedname, ename) == 0) {
	/* Correct emblem is part of the unit's image, don't need to draw. */
	return FALSE;
    }
    /* (should use emblem bbox to help calc) */
    /* Get the size of the emblem, either from the image or by computing
       a reasonable default. */
    if (uimg && uimg->embedw > 0 && uimg->embedh > 0) {
	ew = uimg->embedw;  eh = uimg->embedh;
    } else {
	ew1 = min(sw, max(8, sw / 4));  eh1 = min(sh, max(8, sh / 4));
	eimg = NULL;
	if (eimf != NULL) {
	    eimg = best_image(eimf, ew1, eh1);
	}
	if (eimg) {
	    ew = eimg->w;  eh = eimg->h;
	    /* Make a default 8x6 size for a solid color emblem. */
	    if (ew == 1 && eh == 1) {
		ew = 8;  eh = 6;
	    }
	} else {
	    ew = ew1;  eh = eh1;
	}
    }
    /* Position the emblem, either explicitly, or default to UR corner
       (note that we need the emblem's width to do this) */
    if (uimg && uimg->embedx >= 0 && uimg->embedy >= 0) {
	ex = uimg->embedx;  ey = uimg->embedy;
	/* Don't let the emblem stick out of the unit's area. */
	if (ex + ew > sw)
	  ex = sw - ew;
	if (ey + eh > sh)
	  ey = sh - eh;
    } else if (uimg && (uimg->bboxw != uimg->w || uimg->bboxh != uimg->h)) {
	overlap = FALSE;
	/* Scale bounding box by space given to image. */
	bx = (uimg->bboxx * sw) / uimg->w;  by = (uimg->bboxy * sh) / uimg->h;
	tmpbw = (uimg->bboxw * sw) / uimg->w;
	bh = (uimg->bboxh * sh) / uimg->h;
	bw = tmpbw;
	/* Position the emblem outside the image's bbox if possible,
	   moving in if necessary to stay inside the image's allowed
	   area (sw x sh). */
	ex = bx + bw;
	if (ex + ew > sw) {
	    /* Emblem too wide to fit between unit bbox and edge of
	       area; butt it against edge of area, note the
	       overlap. */
	    ex = sw - ew;
	    overlap = TRUE;
	}
	if (ex < 0)
	  ex = 0;
	ey = by;
	if (overlap)
	  ey -= eh;
	if (ey + eh > sh)
	  ey = sh - eh;
	if (ey < 0)
	  ey = 0;
    } else {
	ex = sw - ew;  ey = 0;
    }
    /* Return the results. */
    *exxp = ex;  *eyyp = ey;
    *ewp = ew;  *ehp = eh;
    return TRUE;
}

/* The comparison function for the image list just does "strcmp" order
   and *requires* that all image families be named and named uniquely. */

static int
image_name_compare(CONST void *imf1, CONST void *imf2)
{
    return strcmp((*((ImageFamily **) imf1))->name,
		  (*((ImageFamily **) imf2))->name);
}

void
sort_all_images(void)
{
    qsort(&(images[0]), numimages, sizeof(ImageFamily *), image_name_compare);
}

/* The comparison function for the palette list just does "strcmp" order
   and *requires* that all image palettes be named and named uniquely. */

static int
palette_name_compare(CONST void *imp1, CONST void *imp2)
{
    return strcmp((*((ImagePalette **) imp1))->name,
		  (*((ImagePalette **) imp2))->name);
}

void
sort_all_palettes(void)
{
    qsort(&(palettes[0]), numpalettes, sizeof(ImagePalette *), palette_name_compare);
}

/* Check Lisp-format and binary-format data for consistency. */

void
check_imf(imf)
ImageFamily *imf;
{
    Image *img;
    
    if (imf == NULL)
      return;
    if (imf->name == NULL) {
	return;
    }
    for_all_images(imf, img) {
	/* Check consistency of Lisp and binary data. */
	if (img->colrdata != lispnil && img->rawcolrdata) {
	    /* (should add color image comparison) */
	}
	if (img->monodata != lispnil && img->rawmonodata) {
	    if (!bitmaps_match(img->w, img->h, img->monodata, img->rawmonodata))
	      run_warning("mono bitmap data not consistent in  %dx%d image of \"%s\"",
			  img->w, img->h, imf->name);
	}
	if (img->maskdata != lispnil && img->rawmaskdata) {
	    if (!bitmaps_match(img->w, img->h, img->maskdata, img->rawmaskdata))
	      run_warning("mask bitmap data not consistent in  %dx%d image of \"%s\"",
			  img->w, img->h, imf->name);
	}
    }
}

static int
bitmaps_match(int w, int h, Obj *lispdata, char *rawdata)
{
    int i, j = 0, rowbytes, numbytes, byte;
    char *datastr = NULL;

    rowbytes = computed_rowbytes(w, 1);
    numbytes =  h * rowbytes;
    for (i = 0; i < numbytes; ++i) {
	if (datastr == NULL || datastr[j] == '\0') {
		if (!stringp(car(lispdata)))
		  break;
		datastr = c_string(car(lispdata));
		j = 0;
		lispdata = cdr(lispdata);
	}
	if (datastr[j] == '/')
	  ++j;
	byte = hextoi(datastr[j]) * 16 + hextoi(datastr[j+1]);
	j += 2;
	if (byte != rawdata[i])
	  return FALSE;
    }
    return TRUE;
}

/* Write the imf directory for the given set of images. */

void
write_imf_dir(char *filename, ImageFamily **images, int num)
{
    int i;
    char *loc;
    ImageFamily *imf;
    FILE *fp;

    fp = open_file(filename, "w");
    if (fp != NULL) {
	fprintf(fp, "ImageFamilyName FileName\n");
	for (i = 0; i < num; ++i) {
	    imf = images[i];
	    loc = "???";
	    if (imf->location && !empty_string(imf->location->name))
	      loc = imf->location->name;
	    fprintf(fp, "%s %s\n", imf->name, loc);
	    /* (to write imf files, should scan through images once for
	       each file, writing all images found that are in that file) */
	}
	fprintf(fp, ". .\n");
	fclose(fp);
    } else {
	run_warning("could not open file \"%s\" for writing", filename);
    }
}

/* Write out the entire image family. */

void
write_imf(fp, imf)
FILE *fp;
ImageFamily *imf;
{
    Obj *palent;
    Image *img;
    
    if (fp == NULL || imf == NULL)
      return;
    if (imf->name == NULL) {
	fprintf(fp, "; garbage image family?\n");
	return;
    }
    if (imf->notes != lispnil) {
	fprintf(fp, "(%s \"%s\"", keyword_name(K_IMF), imf->name);
	fprintf(fp, "\n  (%s ", keyword_name(K_NOTES));
	fprintlisp(fp, imf->notes);
	fprintf(fp, "))\n");
    }
    for_all_images(imf, img) {
	if (img->monodata != lispnil
	    || img->maskdata != lispnil
	    || img->colrdata != lispnil
	    || img->rawmonodata != NULL
	    || img->rawmaskdata != NULL
	    || img->rawcolrdata != NULL
	    || (img->w == 1 && img->h == 1)) {
	    /* Skip over synthesized images. */
	    if (img->synthetic && !write_synthetic_also)
	      continue;
	    fprintf(fp, "(%s \"%s\"", keyword_name(K_IMF), imf->name);
	    fprintf(fp, " (");
	    fprintf(fp, "(%d %d", img->w, img->h);
	    if (img->istile && !(img->w == 1 && img->h == 1))
	      fprintf(fp, " %s", keyword_name(K_TILE));
	    if (img->isconnection)
	      fprintf(fp, " %s", keyword_name(K_CONNECTION));
	    if (img->isborder)
	      fprintf(fp, " %s", keyword_name(K_BORDER));
	    if (img->istransition)
	      fprintf(fp, " %s", "transition");
	    fprintf(fp, ")");
	    if (img->numsubimages > 0) {
	      fprintf(fp, " (%s %d", keyword_name(K_X), img->numsubimages);
	      if (img->subx > 0 || img->suby > 0)
		fprintf(fp, " %d %d", img->subx, img->suby);
	      fprintf(fp, ")");
	    }
	    if (img->embedname) {
		fprintf(fp, " (%s \"%s\")",
			keyword_name(K_EMBED), img->embedname);
	    }
	    if (img->embedx >= 0 && img->embedy >= 0) {
		fprintf(fp, " (%s %d %d)",
			keyword_name(K_EMBED_AT), img->embedx, img->embedy);
	    }
	    if (img->embedw >= 0 && img->embedh >= 0) {
		fprintf(fp, " (%s %d %d)",
			keyword_name(K_EMBED_SIZE), img->embedw, img->embedh);
	    }
	    if (img->notes != lispnil) {
		fprintf(fp, "\n  (%s ", keyword_name(K_NOTES));
		fprintlisp(fp, img->notes);
		fprintf(fp, ")\n ");
	    }
	    /* Write a single color if that's what this image is. */
	    if (img->w == 1 && img->h == 1) {
		if (img->rawpalette != NULL) {
		    write_color(fp, -1,
				img->rawpalette[1], img->rawpalette[2], img->rawpalette[3]);
		} else if (img->palette != lispnil) {
		    palent = cdr(car(img->palette));
		    if (stringp(car(palent)) || symbolp(car(palent))) {
			fprintf(fp, " %s", c_string(car(palent)));
		    } else {
			write_color(fp, -1,
				    c_number(car(palent)),
				    c_number(cadr(palent)),
				    c_number(caddr(palent)));
		    }
		}
	    } else if (img->filedata != lispnil) {
		fprintf(fp, " (%s ", keyword_name(K_FILE));
		fprintf(fp, " \"%s\"", c_string(car(img->filedata)));
		if (cdr(img->filedata) != lispnil)
		  fprintf(fp, " %d %d",
			  c_number(cadr(img->filedata)),
			  c_number(caddr(img->filedata)));
		fprintf(fp, ")");
	    } else if ((img->colrdata != lispnil || img->rawcolrdata)
			&& !color_matches_mono(img)) {
		fprintf(fp, "\n  ");
		write_pixmap(fp, img->w, img->h, img->actualw, img->actualh,
			     img->pixelsize,
			     img->palette, img->rawpalette, img->numcolors,
			     img->colrdata, img->rawcolrdata);
	    }
	    if (img->monodata != lispnil || img->rawmonodata) {
		fprintf(fp, "\n  ");
		write_bitmap(fp, keyword_name(K_MONO), img->w, img->h,
			     img->monodata, img->rawmonodata);
	    }
	    if (img->maskdata != lispnil || img->rawmaskdata) {
		fprintf(fp, "\n  ");
		write_bitmap(fp, keyword_name(K_MASK), img->w, img->h,
			     img->maskdata, img->rawmaskdata);
	    }
	    fprintf(fp, "))\n");
	}
    }
}

/* Study an ostensibly color image to see if its color table includes
   black and white only (white first, then black), and if its data is
   the same as the mono version of the image. */

static int
color_matches_mono(Image *img)
{
    int i, cj, mj, rowbytes, numbytes, cbyte, mbyte;
    int col[2], red[2], grn[2], blu[2];
    char *cdatastr = NULL, *mdatastr = NULL;
    Obj *clispdata = img->colrdata, *mlispdata = img->monodata, *palette;

    if (img->pixelsize != 1)
      return FALSE;

    /* No match possible if not a black-white-only palette. */
    if (img->numcolors > 2)
      return FALSE;

    if (img->rawpalette != NULL) {
	for (i = 0; i < 2; i++) {
	    col[i] = img->rawpalette[4*i+0];
	    red[i] = img->rawpalette[4*i+1];
	    grn[i] = img->rawpalette[4*i+2];
	    blu[i] = img->rawpalette[4*i+3];
	}
    } else if (img->palette != lispnil) {
	palette = img->palette;
	parse_lisp_palette_entry(car(palette), &col[0],
				 &red[0], &grn[0], &blu[0]);
	if (cdr(palette) == lispnil) {
	    /* If only one color in the palette, say the other one is
	       black. */
	    col[1] = 1;
	    red[1] = grn[1] = blu[1] = 0;
	    /* If the one color is black, say it's white. */
	    if (col[0] == 0
		&& red[0] < BLACK_THRESHOLD
		&& grn[0] < BLACK_THRESHOLD
		&& blu[0] < BLACK_THRESHOLD) {
		col[0] = 0;
		red[0] = grn[0] = blu[0] = 65535;
	    }
	} else {
	    /* Parse the second entry in the palette. */
	    parse_lisp_palette_entry(cadr(palette), &col[1],
				     &red[1], &grn[1], &blu[1]);
	}
    } else {
	return FALSE;
    }

    if (!(col[0] == 0
	  && red[0] > WHITE_THRESHOLD
	  && grn[0] > WHITE_THRESHOLD
	  && blu[0] > WHITE_THRESHOLD
	  && col[1] == 1
	  && red[1] < BLACK_THRESHOLD
	  && grn[1] < BLACK_THRESHOLD
	  && blu[1] < BLACK_THRESHOLD))
	return FALSE;

    /* Now compare the contents. */
    rowbytes = computed_rowbytes(img->w, 1);
    numbytes =  img->h * rowbytes;
    cj = mj = 0;
    for (i = 0; i < numbytes; ++i) {
	/* Extract one byte of the color image. */
	if (clispdata != lispnil) {
	    if (cdatastr == NULL || cdatastr[cj] == '\0') {
		if (!stringp(car(clispdata)))
		  break;
		cdatastr = c_string(car(clispdata));
		cj = 0;
		clispdata = cdr(clispdata);
	    }
	    if (cdatastr[cj] == '/')
	      ++cj;
	    cbyte = hextoi(cdatastr[cj]) * 16 + hextoi(cdatastr[cj+1]);
	    cj += 2;
	} else if (img->rawcolrdata != NULL) {
	    cbyte = (img->rawcolrdata)[i];
	} else {
	    return FALSE;
	}
	/* Extract one byte of the mono image. */
	if (mlispdata != lispnil) {
	    if (mdatastr == NULL || mdatastr[mj] == '\0') {
		if (!stringp(car(mlispdata)))
		  break;
		mdatastr = c_string(car(mlispdata));
		mj = 0;
		mlispdata = cdr(mlispdata);
	    }
	    if (mdatastr[mj] == '/')
	      ++mj;
	    mbyte = hextoi(mdatastr[mj]) * 16 + hextoi(mdatastr[mj+1]);
	    mj += 2;
	} else if (img->rawmonodata != NULL) {
	    mbyte = (img->rawmonodata)[i];
	} else {
	    return FALSE;
	}
	/* Compare the bytes. */
	if (cbyte != mbyte)
	  return FALSE;
    }
    return TRUE;
}

static void
write_pixmap(fp, w, h, actualw, actualh, pixelsize,
	     palette, rawpalette, numcolors, lispdata, rawdata)
FILE *fp;
int w, h, actualw, actualh, pixelsize, *rawpalette, numcolors;
Obj *palette, *lispdata;
char *rawdata;
{
    int dolisp, i, j = 0, rowbytes, numbytes, byte;
    char *datastr = NULL;

    actualw = (actualw != 0 ? actualw : w);
    actualh = (actualh != 0 ? actualh : h);
    dolisp = (lispdata != lispnil);
    rowbytes = computed_rowbytes(actualw, pixelsize);
    numbytes = actualh * rowbytes;
    fprintf(fp, "(%s", keyword_name(K_COLOR));
    if (actualw != w || actualh != h)
      fprintf(fp, " (%s %d %d)", keyword_name(K_ACTUAL), actualw, actualh);
    fprintf(fp, " (%s %d)", keyword_name(K_PIXEL_SIZE), pixelsize);
    if (palette != lispnil || (rawpalette && numcolors))
      write_palette_contents(fp, palette, rawpalette, numcolors);
    fprintf(fp, "\n   \"");
    for (i = 0; i < numbytes; ++i) {
	if (i > 0 && i % 32 == 0)
	  fprintf(fp, "\"\n   \"");
	if (i > 0 && i % 32 != 0 && i % rowbytes == 0)
	  fprintf(fp, "/");
	if (dolisp) {
	    if (datastr == NULL || datastr[j] == '\0') {
		if (!stringp(car(lispdata)))
		  break;
		datastr = c_string(car(lispdata));
		j = 0;
		lispdata = cdr(lispdata);
	    }
	    if (datastr[j] == '/')
	      ++j;
	    byte = hextoi(datastr[j]) * 16 + hextoi(datastr[j+1]);
	    j += 2;
	} else {
	    byte = rawdata[i];
	}
	fprintf(fp, "%02x", (unsigned char) byte);
    }
    fprintf(fp, "\")");
}

static void
write_bitmap(fp, subtyp, w, h, lispdata, rawdata)
FILE *fp;
char *subtyp;
int w, h;
Obj *lispdata;
char *rawdata;
{
    int dolisp, i, j = 0, rowbytes, numbytes, byte;
    char *datastr = NULL;

    /* Lisp data overrides raw byte data. */	
    dolisp = (lispdata != lispnil);	
    rowbytes = computed_rowbytes(w, 1);
    numbytes =  h * rowbytes;
    fprintf(fp, "(%s", subtyp);
    if (w > 16 || h > 16)
      fprintf(fp, "\n  ");
    fprintf(fp, " \"");
    for (i = 0; i < numbytes; ++i) {
	if (i > 0 && i % 32 == 0)
	  fprintf(fp, "\"\n   \"");
	if (i > 0 && i % 32 != 0 && i % rowbytes == 0)
	  fprintf(fp, "/");
	if (dolisp) {
	    if (datastr == NULL || datastr[j] == '\0') {
		if (!stringp(car(lispdata)))
		  break;
		datastr = c_string(car(lispdata));
		j = 0;
		lispdata = cdr(lispdata);
	    }
	    /* Ignore any slashes, they're for human readability. */
	    if (datastr[j] == '/')
	      ++j;
	    byte = hextoi(datastr[j]) * 16 + hextoi(datastr[j+1]);
	    j += 2;
	} else {
	    byte = rawdata[i];
	}
	fprintf(fp, "%02x", (unsigned char) byte);
    }
    fprintf(fp, "\")");
}

static void
write_palette_contents(fp, palette, rawpalette, numcolors)
FILE *fp;
Obj *palette;
int *rawpalette, numcolors;
{
    int len, i, col, red, grn, blu;
    Obj *restpal;

    len = (palette != lispnil ? length(palette) : numcolors);
    if (len > 2)
      fprintf(fp, "\n  ");
    fprintf(fp, " (%s", keyword_name(K_PALETTE));
    if (symbolp(palette)) {
	fprintf(fp, " %s", c_string(palette));
    } else if (palette != lispnil) {
	for_all_list(palette, restpal) {
	    parse_lisp_palette_entry(car(restpal), &col, &red, &grn, &blu);
	    if (len > 2)
	      fprintf(fp, "\n   ");
 	    write_color(fp, col, red, grn, blu);
	}
    } else if (rawpalette != NULL) {
	for (i = 0; i < numcolors; i++) {
	    if (len > 2)
	      fprintf(fp, "\n   ");
	    write_color(fp, rawpalette[4*i],
			rawpalette[4*i+1], rawpalette[4*i+2], rawpalette[4*i+3]);
	}
    } else {
	fprintf(fp, " #| no palette? |# ");
    }
    fprintf(fp, ")");
}

static void
write_color(fp, n, r, g, b)
FILE *fp;
int n, r, g, b;
{
    char *colorname;

    if (n >= 0)
      fprintf(fp, " (%d", n);
    colorname = find_color_name(r, g, b);
    if (!empty_string(colorname)) {
	/* Write color name.  Note that we write as a symbol, so that
	   each instance of "white" doesn't become a separate string. */
	fprintf(fp, " %s", colorname);
    } else {
	/* Write individual color components. */
	fprintf(fp, " %d %d %d", r, g, b);
    }
    if (n >= 0)
      fprintf(fp, ")");
}

void
write_imp(fp, imp)
FILE *fp;
ImagePalette *imp;
{
    if (imp == NULL)
      return;
    if (imp->name == NULL) {
	fprintf(fp, "; garbage palette?\n");
	return;
    }
    fprintf(fp, "(%s \"%s\"",
	    keyword_name(K_PALETTE), imp->name);
    if (imp->notes != lispnil) {
	fprintf(fp, "\n  (%s ", keyword_name(K_NOTES));
	fprintlisp(fp, imp->notes);
	fprintf(fp, ")\n ");
    }
    write_palette_contents(fp, imp->palette, NULL, 0);
    fprintf(fp, ")\n");
}

/* Given rgb components, return names of standard colors if the match
   is close. */

char *
find_color_name(r, g, b)
int r, g, b;
{
    if (r > WHITE_THRESHOLD
	&& g > WHITE_THRESHOLD
	&& b > WHITE_THRESHOLD)
      return "white";
    else if (r < BLACK_THRESHOLD
	&& g < BLACK_THRESHOLD
	&& b < BLACK_THRESHOLD)
      return "black";
    else if (r > WHITE_THRESHOLD
	&& g < BLACK_THRESHOLD
	&& b < BLACK_THRESHOLD)
      return "red";
    else if (r < BLACK_THRESHOLD
	&& g > WHITE_THRESHOLD
	&& b < BLACK_THRESHOLD)
      return "green";
    else if (r < BLACK_THRESHOLD
	&& g < BLACK_THRESHOLD
	&& b > WHITE_THRESHOLD)
      return "blue";
    else
      return NULL;
}

void
parse_lisp_palette_entry(palentry, col, red, grn, blu)
Obj *palentry;
int *col, *red, *grn, *blu;
{
    Obj *colorcomp;
    char *colorname;

    *col = c_number(car(palentry));
    colorcomp = cdr(palentry);
    if (symbolp(car(colorcomp)) || stringp(car(colorcomp))) {
	colorname = c_string(car(colorcomp));
	*red = *grn = *blu = 0;
	if (strcmp(colorname, "white") == 0) {
	    *red = *grn = *blu = 65535;
	} else if (strcmp(colorname, "black") == 0) {
	    /* done */
	} else if (strcmp(colorname, "red") == 0) {
	    *red = 65535;
	} else if (strcmp(colorname, "green") == 0) {
	    *grn = 65535;
	} else if (strcmp(colorname, "blue") == 0) {
	    *blu = 65535;
	} else {
	    init_warning("No color named \"%s\" found, substituting gray",
			 colorname);
	    *red = *grn = *blu = 128 * 256;
	}
    } else if (numberp(car(colorcomp))) {
	*red = c_number(car(colorcomp));
	*grn = c_number(cadr(colorcomp));
	*blu = c_number(caddr(colorcomp));
    } else {
	init_warning("palette color info is not a name or set of numbers, ignoring");
    }
}

/* Given a filename, find or create a file image structure for it. */

FileImage *get_file_image(char *fname)
{
    FileImage *fimg, *newfimg;

    for (fimg = file_images; fimg != NULL; fimg = fimg->next) {
	if (strcmp(fimg->name, fname) == 0)
	  return fimg;
    }
    newfimg = (FileImage *) xmalloc(sizeof(FileImage));
    newfimg->name = fname;
    newfimg->next = file_images;
    file_images = newfimg;
    return newfimg;
}

/* Collect the file image for the given image and use it to generate
   the image's (or subimage's) raw data. */

void
make_image_from_file_image(ImageFamily *imf, Image *img, Image *subimg,
			   int subi)
{
    int hch, pad = 2;
    int xoffset, yoffset, xoff, yoff;
    FileImage *fimg;

    if (img->filedata != lispnil) {
	if (img->file_image == NULL) {
	    img->file_image = get_file_image(c_string(car(img->filedata)));
	}
    }
    fimg = img->file_image;
    load_file_image(fimg);
    if (!fimg->loaded) {
	init_warning("Could not load file \"%s\" for image family \"%s\", ignoring",
		     fimg->name, imf->name);
	return;
    }
    xoffset = yoffset = 0;
    if (cdr(img->filedata) != lispnil) {
	xoffset = c_number(cadr(img->filedata));
	yoffset = c_number(caddr(img->filedata));
    }
    /* All subimages share color data. */
    if (subimg == img ||
	(img->subimages != NULL && subimg == img->subimages[0])) {
	subimg->pixelsize = 8;
	/* Copy the palette over verbatim from the file image. */
	subimg->numcolors = fimg->numcolors;
	subimg->rawpalette =
	  (int *) xmalloc(subimg->numcolors * 4 * sizeof(int));
	memcpy(subimg->rawpalette, fimg->palette,
	       subimg->numcolors * 4 * sizeof(int));
    } else {
	/* Inherit color data from the first subimage. */
	subimg->pixelsize = img->subimages[0]->pixelsize;
	subimg->numcolors = img->subimages[0]->numcolors;
	subimg->rawpalette = img->subimages[0]->rawpalette;
    }
    if (img->isborder) {
	/* a hack since this code doesn't know true hch */
	hch = img->h;
	if (img->h == 26)
	  hch = 20;
	else if (img->h == 48)
	  hch = 37;
	else if (img->h == 96)
	  hch = 74;
	xoff = xoffset + (subi % 4) * img->w;
	yoff = yoffset + (subi / 4) * hch;
	copy_from_file_image(subimg, fimg, xoff, yoff);
    } else if (img->isconnection) {
	xoff = xoffset + (subi % 8) * (img->w + pad);
	yoff = yoffset + (subi / 8) * (img->h + pad);
	copy_from_file_image(subimg, fimg, xoff, yoff);
    } else if (img->istransition) {
	xoff = xoffset + (subi % 4) * (img->w + pad);
	yoff = yoffset + (subi / 4) * (img->h + pad);
	copy_from_file_image(subimg, fimg, xoff, yoff);
    } else if (img->numsubimages > 0) {
	/* Figure where the next subimage is at. */
	if (img->subx > 0 || img->suby > 0) {
	    xoff = xoffset + subi * img->subx;
	    yoff = yoffset + subi * img->suby;
	} else {
	    xoff = xoffset + subi * img->w;
	    yoff = yoffset;
	}
	copy_from_file_image(subimg, fimg, xoff, yoff);
    } else {
	copy_from_file_image(img, fimg, xoffset, yoffset);
    }
}

/* Extract a single color image from a file image.  Also create mask
   data for the image, if the file image has any transparent colors.  */

void
copy_from_file_image(Image *img, FileImage *fimg, int xoffset, int yoffset)
{
    char pix;
    int i, j, k, ii, val, kk, kkb;

    /* Make space for the color data (assuming 1 byte/pixel). */
    img->rawcolrdata = (char *) xmalloc(img->w * img->h);
    if (fimg->numtransparent > 0)
      img->rawmaskdata =
	(char *) xmalloc(img->h * computed_rowbytes(img->w, 1));
    /* Scan through all the pixels of the subimage we're building. */
    for (i = 0; i < img->h; ++i) {
	for (j = 0; j < img->w; ++j) {
	    k = (yoffset + i) * fimg->width + xoffset + j;
	    pix = fimg->data[k];
	    kk = i * img->w + j;
	    img->rawcolrdata[kk] = pix;
	    /* If there are transparent colors in the image, modify
	       the mask bitmap. */
	    if (fimg->numtransparent > 0) {
		val = 1;
		for (ii = 0; ii < fimg->numtransparent; ++ii) {
		    if (pix == fimg->transparent[ii]) {
			val = 0;
			break;
		    }
		}
		if (val) {
		    kkb = i * computed_rowbytes(img->w, 1) + j / 8;
		    img->rawmaskdata[kkb] |= 1 << (7 - j % 8);
		}
	    }
	}
    }
}

/* Give a file image, attempt to load it into memory. */

void
load_file_image(FileImage *fimg)
{
    int rslt;

    if (fimg->loaded)
      return;
    /* Only doing GIFs right now. */
    rslt = get_gif(fimg);
    if (rslt)
      fimg->loaded = TRUE;
}

/* Generic image setup. */

static short imf_dir_loaded;

ImageFamily *
get_generic_images(char *name)
{
    FILE *fp;
    int found = FALSE;
    ImageFamily *imf;
    LibraryPath *path;

    imf = get_imf(name);
    if (imf == NULL)
      return NULL;
    if (imf->numsizes > 0 && imf_interp_hook != NULL)
      imf = (*imf_interp_hook)(imf, NULL, FALSE);
    if (imf_load_hook != NULL)
      imf = (*imf_load_hook)(imf);
    if (imf->numsizes == 0) {
	/* Maybe collect the names/locations of all image families. */
	if (!imf_dir_loaded) {
	    /* (should let name be decided by platform?) */
	    fp = open_library_file("imf.dir");
	    if (fp != NULL) {
		load_image_families(fp, FALSE, NULL);
		fclose(fp);
	    } else {
		init_warning("Cannot open \"%s\", will not use it", "imf.dir");
	    }
	    imf_dir_loaded = TRUE;
	}
	/* Get a (possibly empty) family. */
	imf = get_imf(name);
	if (imf == NULL)
	  return NULL;
	if (imf->location != NULL) {
	    /* Load data filling in the family. */
	    for_all_library_paths(path) {
		make_pathname(path->path, imf->location->name, "", spbuf);
		if (load_imf_file(spbuf, NULL))
		  found = TRUE;
		  break;
	    }
	    /* Maybe try the plain filename, just in case. */
	    if (!found)
	      load_imf_file(imf->location->name, NULL);
	    /* We don't complain here about not finding the file, because
	       we'll get a more useful warning alert later on. */
	    if (imf_interp_hook != NULL)
	      imf = (*imf_interp_hook)(imf, NULL, FALSE);
	}
    }
    return imf;
}
