/* $Id: magick.c,v 1.49 2006/01/24 21:05:41 agraef Exp $ */

/* This file is part of the Q programming system.

   The Q programming system 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.

   The Q programming system 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 this program; if not, write to the Free Software
   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */

#if defined (HAVE_CONFIG_H)
#  include "config.h"
#endif

#ifdef _WIN32
#define STDC_HEADERS 1
#define HAVE_STRDUP 1
#define HAVE_MEMCPY 1
#define HAVE_LIMITS_H 1
#include <windows.h>
#endif

/* system headers */

#include <stdio.h>
#include <ctype.h>
#include <math.h>

/* check for standard C headers */
#if STDC_HEADERS
# include <stdlib.h>
# include <string.h>
#else
# ifndef HAVE_STRCHR
#  define strchr index
#  define strrchr rindex
# endif
char *strchr (), *strrchr ();
#endif

#ifdef HAVE_MALLOC_H
#include <malloc.h>
#endif

#ifdef HAVE_LIMITS_H
#include <limits.h>
#endif

#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif

#ifdef DMALLOC
#include <dmalloc.h>
#endif

#include <libq.h>
#include <magick/api.h>

#if MagickLibVersion < 0x550
#define ScaleQuantumToChar(quantum) Downscale(quantum)
#define PixelIntensityToQuantum(color) Intensity(color)
#define RLECompression RunlengthEncodedCompression
#define ScaleCharToQuantum(value) Upscale(value)
#define ScaleShortToQuantum(value) XDownscale(value)
#define ScaleQuantumToShort(quantum) XUpscale(quantum)
#endif

MODULE(magick)

#define sys_to_utf8(s) to_utf8(s, NULL)
#define utf8_to_sys(s) from_utf8(s, NULL)

static ExceptionInfo exception;
static char msg[1024];

static inline int
check_exception(ExceptionInfo *exception)
{
  int res = exception->severity != UndefinedException;
  if (res)
    sprintf(msg, "%d: %s%s%s%s", exception->severity,
	    exception->reason?exception->reason:"ERROR",
	    exception->description?" (":"",
	    exception->description?exception->description:"",
	    exception->description?")":"");
  else
    *msg = 0;
  SetExceptionInfo(exception, UndefinedException);
  return res;
}

INIT(magick)
{
  InitializeMagick("magick");
  GetExceptionInfo(&exception);
}

FINI(magick)
{
  DestroyMagick();
}

/* ByteStr data structure, see clib.c */

typedef struct bstr {
  long size;
  unsigned char *v;
} bstr_t;

/* manifest constants */

FUNCTION(magick,magick_vars,argc,argv)
{
  if (argc != 0) return __FAIL;
  return mktuplel
    (84,
     mkuint(NoCompression),
     mkuint(BZipCompression),
     mkuint(FaxCompression),
     mkuint(Group4Compression),
     mkuint(JPEGCompression),
     mkuint(LosslessJPEGCompression),
     mkuint(LZWCompression),
     mkuint(RLECompression),
     mkuint(ZipCompression),

     mkuint(ForgetGravity),
     mkuint(NorthWestGravity),
     mkuint(NorthGravity),
     mkuint(NorthEastGravity),
     mkuint(WestGravity),
     mkuint(CenterGravity),
     mkuint(EastGravity),
     mkuint(SouthWestGravity),
     mkuint(SouthGravity),
     mkuint(SouthEastGravity),
     mkuint(StaticGravity),

     mkuint(RGBColorspace),
     mkuint(GRAYColorspace),
     mkuint(TransparentColorspace),
     mkuint(OHTAColorspace),
     mkuint(XYZColorspace),
     mkuint(YCbCrColorspace),
     mkuint(YCCColorspace),
     mkuint(YIQColorspace),
     mkuint(YPbPrColorspace),
     mkuint(YUVColorspace),
     mkuint(CMYKColorspace),
     mkuint(sRGBColorspace),

     mkuint(PointFilter),
     mkuint(BoxFilter),
     mkuint(TriangleFilter),
     mkuint(HermiteFilter),
     mkuint(HanningFilter),
     mkuint(HammingFilter),
     mkuint(BlackmanFilter),
     mkuint(GaussianFilter),
     mkuint(QuadraticFilter),
     mkuint(CubicFilter),
     mkuint(CatromFilter),
     mkuint(MitchellFilter),
     mkuint(LanczosFilter),
     mkuint(BesselFilter),
     mkuint(SincFilter),

     mkuint(OverCompositeOp),
     mkuint(InCompositeOp),
     mkuint(OutCompositeOp),
     mkuint(AtopCompositeOp),
     mkuint(XorCompositeOp),
     mkuint(PlusCompositeOp),
     mkuint(MinusCompositeOp),
     mkuint(AddCompositeOp),
     mkuint(SubtractCompositeOp),
     mkuint(DifferenceCompositeOp),
     mkuint(MultiplyCompositeOp),
     mkuint(BumpmapCompositeOp),
     mkuint(CopyCompositeOp),
     mkuint(CopyRedCompositeOp),
     mkuint(CopyGreenCompositeOp),
     mkuint(CopyBlueCompositeOp),
     mkuint(CopyOpacityCompositeOp),
     mkuint(ClearCompositeOp),
     mkuint(DissolveCompositeOp),
     mkuint(DisplaceCompositeOp),
     mkuint(ModulateCompositeOp),
     mkuint(ThresholdCompositeOp),
     mkuint(NoCompositeOp),
     mkuint(DarkenCompositeOp),
     mkuint(LightenCompositeOp),
     mkuint(HueCompositeOp),
     mkuint(SaturateCompositeOp),
     mkuint(ColorizeCompositeOp),
     mkuint(LuminizeCompositeOp),
     mkuint(ScreenCompositeOp),
     mkuint(OverlayCompositeOp),

     mkuint(UniformNoise),
     mkuint(GaussianNoise),
     mkuint(MultiplicativeGaussianNoise),
     mkuint(ImpulseNoise),
     mkuint(LaplacianNoise),
     mkuint(PoissonNoise)

     );
}

FUNCTION(magick,magick_info,argc,argv)
{
#if MagickLibVersion < 0x623
  const MagickInfo *info;
  expr x;
  if (argc != 0) return __FAIL;
  info = GetMagickInfo("*", &exception);
  if (check_exception(&exception))
    return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
  else if (!info)
    return __FAIL;
  while (info->next) info = info->next;
  /* we're at the last info record now */
  x = mknil;
  while (x && info) {
    char mode[10];
    sprintf(mode, "%c%c%c%c",
	    info->blob_support?'*':'-',
	    info->decoder?'r':'-',
	    info->encoder?'w':'-',
	    info->adjoin?'+':'-');
    x = mkcons(mktuplel(4, mkstr(sys_to_utf8(info->name?info->name:"")),
			mkstr(sys_to_utf8(mode)),
			mkstr(sys_to_utf8(info->description?info->description:"")),
			mkstr(sys_to_utf8(info->version?info->version:""))),
	       x);
    info = info->previous;
  }
#else
  /* GetMagickInfo() is deprecated (and utterly broken) in recent IM
     releases, so we use GetMagickInfoList() instead. */
  const MagickInfo **info;
  expr x;
  unsigned long n;
  int res;
  if (argc != 0) return __FAIL;
  info = GetMagickInfoList("*", &n, &exception);
  res = check_exception(&exception);
  if (!info)
    if (res)
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else
      return __FAIL;
  x = mknil;
  while (x && n>0) {
    char mode[10];
    --n;
    sprintf(mode, "%c%c%c%c",
	    info[n]->blob_support?'*':'-',
	    info[n]->decoder?'r':'-',
	    info[n]->encoder?'w':'-',
	    info[n]->adjoin?'+':'-');
    x = mkcons(mktuplel(4, mkstr(sys_to_utf8(info[n]->name?info[n]->name:"")),
			mkstr(sys_to_utf8(mode)),
			mkstr(sys_to_utf8(info[n]->description?info[n]->description:"")),
			mkstr(sys_to_utf8(info[n]->version?info[n]->version:""))),
	       x);
  }
#endif
  return x;
}

FUNCTION(magick,magick_limit,argc,argv)
{
#if MagickLibVersion >= 0x550
  char *res;
  unsigned long limit;
  if (argc == 2 && isstr(argv[0], &res) && isuint(argv[1], &limit)) {
#if 0 /* not supported */
    if (!strcmp(res, "file"))
      SetMagickResourceLimit(FileResource, limit);
    else
#endif
    if (!strcmp(res, "memory"))
      SetMagickResourceLimit(MemoryResource, limit);
    else if (!strcmp(res, "map"))
      SetMagickResourceLimit(MapResource, limit);
    else if (!strcmp(res, "disk"))
      SetMagickResourceLimit(DiskResource, limit);
    else
      return __FAIL;
    return mkvoid;
  } else
#endif
    return __FAIL;
}

FUNCTION(magick,magick_limits,argc,argv)
{
#if MagickLibVersion >= 0x550
  if (argc == 0) {
    ListMagickResourceInfo(stdout, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else
      return mkvoid;
  } else
#endif
    return __FAIL;
}

FUNCTION(magick,magick_resources,argc,argv)
{
#if MagickLibVersion >= 0x550
  if (argc == 0)
    return mktuplel(4, mkuint(GetMagickResource(FileResource)),
		    mkuint(GetMagickResource(MemoryResource)),
		    mkuint(GetMagickResource(MapResource)),
		    mkuint(GetMagickResource(DiskResource)));
  else
#endif
    return __FAIL;
}

/* private image data; we use this to store the draw info and other
   information needed by the operations of this module */

typedef struct {
  DrawInfo *draw_info;
  int tag;
} ImageData;

static inline ImageData *init_data(void)
{
  ImageData *data = malloc(sizeof(ImageData));
  if (data) {
    data->draw_info = NULL;
    data->tag = 0;
  }
  return data;
}

static inline DrawInfo *get_draw_info(Image *img)
{
  ImageData *data = (ImageData*)img->client_data;
  if (data) {
    if (!data->draw_info)
      data->draw_info = CloneDrawInfo(NULL, NULL);
    return data->draw_info;
  } else
    return NULL;
}

/* image type */

DESTRUCTOR(magick,Image,ptr)
{
  Image *img = (Image*)ptr;
  if (img->client_data) {
    ImageData *data = (ImageData*)img->client_data;
    if (data->draw_info) DestroyDrawInfo(data->draw_info);
    free(img->client_data);
  }
  DestroyImage(img);
}

static expr mk_image(Image *img)
{
  img->scene = 0;
  if ((img->client_data = init_data()))
    return mkobj(type(Image), img);
  else {
    DestroyImage(img);
    return __ERROR;
  }
}

static void decompose_image_list(Image *img)
{
  Image *tmp, *tmp2;
  for (tmp = img; tmp; tmp = tmp2) {
    tmp2 = tmp->next;
    tmp->previous = tmp->next = NULL;
    if (!tmp->client_data)
      /* dispose temporary */
      DestroyImage(tmp);
    else
      ((ImageData*)tmp->client_data)->tag = 0;
  }
}

static expr mk_image_list(Image *img)
{
  expr x = mknil;
  Image *imgs;
  /* convert image sequence into list of images */
  for (imgs = img; imgs->next; imgs = imgs->next)
    ;
  /* imgs now points at the last image in the sequence */
  while (x && imgs) {
    Image *tmp = imgs->previous;
    imgs->scene = 0;
    if ((imgs->client_data = init_data()))
      x = mkcons(mkobj(type(Image), imgs), x);
    else {
      dispose(x); x = __ERROR;
    }
    imgs = tmp;
  }
  if (x)
    decompose_image_list(img);
  else {
    for (imgs = img; imgs; imgs = imgs->next)
      if (imgs->client_data) free(imgs->client_data);
    DestroyImageList(img);
  }
  return x;
}

static int is_image_list(expr x, Image **img)
{
  expr y, hd, tl;
  Image *tmp, *tmp2;
  for (y = x; iscons(y, &hd, &tl); y = tl)
    if (!(isobj(hd, type(Image), (void**)&tmp) &&
	  tmp->columns > 0 && tmp->rows > 0))
      return 0;
  if (!isnil(y)) return 0;
  *img = NULL;
  if (isnil(x)) return 1;
  tmp2 = NULL;
  for (y = x; iscons(y, &hd, &tl); y = tl) {
    isobj(hd, type(Image), (void**)&tmp);
    if (tmp->client_data && ((ImageData*)tmp->client_data)->tag) {
      /* this image is already in the list, create a temporary copy */
      tmp = CloneImage(tmp, 0, 0, 1, &exception);
      if (check_exception(&exception)) {
	decompose_image_list(*img);
	return 0;
      }
      tmp->client_data = NULL;
    } else
      ((ImageData*)tmp->client_data)->tag = 1;
    if (tmp2) {
      tmp->previous = tmp2;
      tmp2->next = tmp;
    } else
      *img = tmp;
    tmp2 = tmp;
  }
  return 1;
}

/* Read RGBA pixels from a buffer. The color values are scaled to 16 bit and
   returned in RGBA order which matches the layout of GGI color values. */

static void get_pixels(unsigned char *dest, PixelPacket *source,
		       unsigned long count, unsigned matte)
{
  unsigned long i;
  register PixelPacket *p;
  register unsigned short *q;

  p = source;
  q = (unsigned short*)dest;
  if (matte)
    for (i = 0; i < count; i++) {
      *q++=ScaleQuantumToShort(p->red);
      *q++=ScaleQuantumToShort(p->green);
      *q++=ScaleQuantumToShort(p->blue);
      *q++=ScaleQuantumToShort(MaxRGB-p->opacity);
      p++;
    }
  else
    for (i = 0; i < count; i++) {
      *q++=ScaleQuantumToShort(p->red);
      *q++=ScaleQuantumToShort(p->green);
      *q++=ScaleQuantumToShort(p->blue);
      *q++=ScaleQuantumToShort(MaxRGB);
      p++;
    }
}

/* Write RGBA pixels to a buffer. */

static void set_pixels(PixelPacket *dest, unsigned char *source,
		       unsigned long count, unsigned matte)
{
  unsigned long i;
  register unsigned short *p;
  register PixelPacket *q;

  p = (unsigned short*)source;
  q = dest;
  if (matte)
    for (i = 0; i < count; i++) {
      q->red=ScaleShortToQuantum(*p++);
      q->green=ScaleShortToQuantum(*p++);
      q->blue=ScaleShortToQuantum(*p++);
      q->opacity=ScaleShortToQuantum(0xffff-*p++);
      q++;
    }
  else
    for (i = 0; i < count; i++) {
      q->red=ScaleShortToQuantum(*p++);
      q->green=ScaleShortToQuantum(*p++);
      q->blue=ScaleShortToQuantum(*p++);
      p++;
      q++;
    }
}

static inline expr mkpixel(PixelPacket *pixel)
{
  bstr_t *m;
  if (!(m = malloc(sizeof(bstr_t))) || !(m->v = malloc(8))) {
    if (m) free(m); return __ERROR;
  }
  m->size = 8;
  get_pixels(m->v, pixel, 1, 1);
  return mkobj(type(ByteStr), m);
}

/* parse info tuples */

static int parse_info(int n, expr *xv, ImageInfo *info, int *_matte)
{
  int i = 0;
  unsigned long width, height, depth, offset, matte;
  char *magick;
  static char geom[100];
  *_matte = -1;
  if (i >= n) return 1;
  if (!isuint(xv[i++], &width)) return 0;
  if (i >= n) return 1;
  if (!isuint(xv[i++], &height)) return 0;
  if (width > 0 && height > 0) {
    sprintf(geom, "%ux%u", width, height);
    info->size = geom;
  }
  if (i >= n) return 1;
  if (!isuint(xv[i++], &offset)) return 0;
  if (offset > 0) {
    sprintf(geom, "%ux%u+%u", width, height, offset);
    info->size = geom;
  }
  if (i >= n) return 1;
  if (!isuint(xv[i++], &depth) || depth > QuantumDepth) return 0;
  if (depth > 0)
    info->depth = depth;
  if (i >= n) return 1;
  if (!isuint(xv[i++], &matte) || matte > 1) return 0;
  *_matte = (int)matte;
  if (i >= n) return 1;
  if (!isstr(xv[i++], &magick)) return 0;
  strncpy(info->magick, magick, MaxTextExtent-1);
  if (i >= n) return 1;
  return 0;
}

/* compression info used by write_image and image_to_blob */

static int parse_info2(int n, expr *xv, ImageInfo *info)
{
  int i = 0;
  unsigned long compression, quality;
  char *sampling_factor;
  if (i >= n) return 1;
  if (!isuint(xv[i++], &compression)) return 0;
  info->compression = compression;
  if (i >= n) return 1;
  if (!isuint(xv[i++], &quality)) return 0;
  info->quality = quality;
  if (i >= n) return 1;
  if (!isstr(xv[i++], &sampling_factor)) return 0;
  info->sampling_factor = sampling_factor;
  if (i >= n) return 1;
  return 0;
}

FUNCTION(magick,image_info,argc,argv)
{
  Image *img;
  if (argc == 1 && isobj(argv[0], type(Image), (void**)&img))
    return mktuplel(6, mkuint(img->columns), mkuint(img->rows),
		    mkuint(img->offset), mkuint(img->depth),
		    mkuint((unsigned long)img->matte),
		    mkstr(sys_to_utf8(img->magick)));
  else
    return __FAIL;
}

FUNCTION(magick,draw_info,argc,argv)
{
  Image *img;
  DrawInfo *draw_info;
  if (argc == 1 && isobj(argv[0], type(Image), (void**)&img) &&
      (draw_info = get_draw_info(img))) {
    expr font, tile;
    if (draw_info->font)
      font = mkstr(sys_to_utf8(draw_info->font));
    else
      font = mkvoid;
    if (draw_info->tile)
      tile = mkobj(type(Image), ReferenceImage(draw_info->tile));
    else
      tile = mkvoid;
    return mktuplel(11, font,
		    mkfloat(draw_info->pointsize),
		    mkuint(draw_info->gravity),
		    mkpixel(&draw_info->fill),
		    mkpixel(&draw_info->stroke),
		    mkpixel(&draw_info->undercolor),
		    mkpixel(&draw_info->border_color),
		    mkfloat(draw_info->stroke_width),
		    mkbool(draw_info->stroke_antialias),
		    mkbool(draw_info->text_antialias),
		    tile);
  } else
    return __FAIL;
}

FUNCTION(magick,type_metrics,argc,argv)
{
  Image *img;
  DrawInfo *draw_info;
  if (argc == 1 && isobj(argv[0], type(Image), (void**)&img) &&
      (draw_info = get_draw_info(img))) {
    TypeMetric metrics;
    if (GetTypeMetrics(img, draw_info, &metrics))
      return mktuplel(9, mkfloat(metrics.pixels_per_em.x),
		      mkfloat(metrics.pixels_per_em.y),
		      mkfloat(metrics.ascent),
		      mkfloat(metrics.descent),
		      mkfloat(metrics.width),
		      mkfloat(metrics.height),
		      mkfloat(metrics.max_advance),
		      mkfloat(metrics.underline_position),
		      mkfloat(metrics.underline_thickness));
    else
      return __FAIL;
  } else
    return __FAIL;
}

FUNCTION(magick,set_draw_font,argc,argv)
{
  Image *img;
  DrawInfo *draw_info;
  char *font = NULL;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      (draw_info = get_draw_info(img)) &&
      (isvoid(argv[1]) || isstr(argv[1], &font)))
    if (!font) {
      LiberateMemory((void**)&draw_info->font);
      return mkvoid;
    } else {
      char *res;
      if (!(font = utf8_to_sys(font)))
	return __FAIL;
      res = CloneString(&draw_info->font, font);
      free(font);
      if (res)
	return mkvoid;
      else
	return __FAIL;
    }
  else
    return __FAIL;
}

FUNCTION(magick,set_draw_pointsize,argc,argv)
{
  Image *img;
  DrawInfo *draw_info;
  double val;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      (draw_info = get_draw_info(img)) &&
      (isfloat(argv[1], &val) || ismpz_float(argv[1], &val))) {
    draw_info->pointsize = val;
    return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(magick,set_draw_gravity,argc,argv)
{
  Image *img;
  DrawInfo *draw_info;
  unsigned long val;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      (draw_info = get_draw_info(img)) && isuint(argv[1], &val)) {
    draw_info->gravity = val;
    return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(magick,set_draw_fill,argc,argv)
{
  Image *img;
  DrawInfo *draw_info;
  bstr_t *m;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      (draw_info = get_draw_info(img)) &&
      isobj(argv[1], type(ByteStr), (void**)&m) && m->size == 8) {
    set_pixels(&draw_info->fill, m->v, 1, 1);
    return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(magick,set_draw_stroke,argc,argv)
{
  Image *img;
  DrawInfo *draw_info;
  bstr_t *m;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      (draw_info = get_draw_info(img)) &&
      isobj(argv[1], type(ByteStr), (void**)&m) && m->size == 8) {
    set_pixels(&draw_info->stroke, m->v, 1, 1);
    return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(magick,set_draw_undercolor,argc,argv)
{
  Image *img;
  DrawInfo *draw_info;
  bstr_t *m;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      (draw_info = get_draw_info(img)) &&
      isobj(argv[1], type(ByteStr), (void**)&m) && m->size == 8) {
    set_pixels(&draw_info->undercolor, m->v, 1, 1);
    return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(magick,set_draw_border_color,argc,argv)
{
  Image *img;
  DrawInfo *draw_info;
  bstr_t *m;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      (draw_info = get_draw_info(img)) &&
      isobj(argv[1], type(ByteStr), (void**)&m) && m->size == 8) {
    set_pixels(&draw_info->border_color, m->v, 1, 1);
    return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(magick,set_draw_stroke_width,argc,argv)
{
  Image *img;
  DrawInfo *draw_info;
  double val;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      (draw_info = get_draw_info(img)) &&
      (isfloat(argv[1], &val) || ismpz_float(argv[1], &val))) {
    draw_info->stroke_width = val;
    return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(magick,set_draw_stroke_antialias,argc,argv)
{
  Image *img;
  DrawInfo *draw_info;
  int val;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      (draw_info = get_draw_info(img)) && isbool(argv[1], &val)) {
    draw_info->stroke_antialias = val;
    return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(magick,set_draw_text_antialias,argc,argv)
{
  Image *img;
  DrawInfo *draw_info;
  int val;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      (draw_info = get_draw_info(img)) && isbool(argv[1], &val)) {
    draw_info->text_antialias = val;
    return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(magick,set_draw_tile,argc,argv)
{
  Image *img, *tile = NULL;
  DrawInfo *draw_info;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      (draw_info = get_draw_info(img)) &&
      (isvoid(argv[1]) || isobj(argv[1], type(Image), (void**)&tile))) {
    if (tile) {
      /* we better clone the image here, to avoid nasty circular references */
      tile = CloneImage(tile, 0, 0, 1, &exception);
      if (check_exception(&exception))
	return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
      else if (tile)
	draw_info->tile = tile;
      else
	return __FAIL;
    } else {
      if (draw_info->tile) DestroyImage(draw_info->tile);
      draw_info->tile = NULL;
    }
    return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(magick,image_background_color,argc,argv)
{
  Image *img;
  if (argc == 1 && isobj(argv[0], type(Image), (void**)&img)) {
    bstr_t *m;
    if (!(m = malloc(sizeof(bstr_t))) || !(m->v = malloc(8))) {
      if (m) free(m); return __ERROR;
    }
    m->size = 8;
    get_pixels(m->v, &img->background_color, 1, img->matte);
    return mkobj(type(ByteStr), m);
  } else
    return __FAIL;
}

FUNCTION(magick,set_image_background_color,argc,argv)
{
  Image *img;
  bstr_t *m;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      isobj(argv[1], type(ByteStr), (void**)&m) && m->size == 8) {
    set_pixels(&img->background_color, m->v, 1, 1);
    return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(magick,image_border_color,argc,argv)
{
  Image *img;
  if (argc == 1 && isobj(argv[0], type(Image), (void**)&img)) {
    bstr_t *m;
    if (!(m = malloc(sizeof(bstr_t))) || !(m->v = malloc(8))) {
      if (m) free(m); return __ERROR;
    }
    m->size = 8;
    get_pixels(m->v, &img->border_color, 1, img->matte);
    return mkobj(type(ByteStr), m);
  } else
    return __FAIL;
}

FUNCTION(magick,set_image_border_color,argc,argv)
{
  Image *img;
  bstr_t *m;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      isobj(argv[1], type(ByteStr), (void**)&m) && m->size == 8) {
    set_pixels(&img->border_color, m->v, 1, 1);
    return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(magick,image_matte_color,argc,argv)
{
  Image *img;
  if (argc == 1 && isobj(argv[0], type(Image), (void**)&img)) {
    bstr_t *m;
    if (!(m = malloc(sizeof(bstr_t))) || !(m->v = malloc(8))) {
      if (m) free(m); return __ERROR;
    }
    m->size = 8;
    get_pixels(m->v, &img->matte_color, 1, img->matte);
    return mkobj(type(ByteStr), m);
  } else
    return __FAIL;
}

FUNCTION(magick,set_image_matte_color,argc,argv)
{
  Image *img;
  bstr_t *m;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      isobj(argv[1], type(ByteStr), (void**)&m) && m->size == 8) {
    set_pixels(&img->matte_color, m->v, 1, 1);
    return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(magick,image_compression,argc,argv)
{
  Image *img;
  if (argc == 1 && isobj(argv[0], type(Image), (void**)&img))
    return mkuint(img->compression);
  else
    return __FAIL;
}

FUNCTION(magick,set_image_compression,argc,argv)
{
  Image *img;
  unsigned long compression;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      isuint(argv[1], &compression)) {
    img->compression = compression;
    return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(magick,image_fuzz,argc,argv)
{
  Image *img;
  if (argc == 1 && isobj(argv[0], type(Image), (void**)&img))
    return mkfloat(img->fuzz);
  else
    return __FAIL;
}

FUNCTION(magick,set_image_fuzz,argc,argv)
{
  Image *img;
  double fuzz;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      (isfloat(argv[1], &fuzz) || ismpz_float(argv[1], &fuzz))) {
    img->fuzz = fuzz;
    return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(magick,image_page,argc,argv)
{
  Image *img;
  if (argc == 1 && isobj(argv[0], type(Image), (void**)&img))
    return mktuplel(4, mkint(img->page.x), mkint(img->page.y),
		    mkuint(img->page.width), mkuint(img->page.height));
  else
    return __FAIL;
}

FUNCTION(magick,set_image_page,argc,argv)
{
  Image *img;
  int n;
  expr *xv;
  long x, y;
  unsigned long w, h;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      istuple(argv[1], &n, &xv)) {
    if (n == 2)
      if (isint(xv[0], &x) && isint(xv[1], &y)) {
	img->page.x = x;
	img->page.y = y;
      } else
	return __FAIL;
    else if (n == 4)
      if (isint(xv[0], &x) && isint(xv[1], &y) &&
	  isuint(xv[2], &w) && isuint(xv[3], &h)) {
	img->page.x = x;
	img->page.y = y;
	img->page.width = w;
	img->page.height = h;
      } else
	return __FAIL;
    else
      return __FAIL;
    return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(magick,image_attr,argc,argv)
{
  Image *img;
  char *key;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      isstr(argv[1], &key)) {
    const ImageAttribute *attr;
    if (!(key = utf8_to_sys(key)))
      return __ERROR;
    attr = GetImageAttribute(img, key);
    free(key);
    if (attr)
      return mkstr(sys_to_utf8(attr->value));
    else
      return __FAIL;
  } else
    return __FAIL;
}

FUNCTION(magick,set_image_attr,argc,argv)
{
  Image *img;
  char *key, *val = NULL;
  if (argc == 3 && isobj(argv[0], type(Image), (void**)&img) &&
      isstr(argv[1], &key) &&
      (isvoid(argv[2]) || isstr(argv[2], &val))) {
    if (!(key = utf8_to_sys(key)))
      return __ERROR;
    if (val && !(val = utf8_to_sys(val))) {
      free(key);
      return __ERROR;
    }
    SetImageAttribute(img, key, val);
    free(key); if (val) free(val);
    return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(magick,count_image_colors,argc,argv)
{
  Image *img;
  if (argc == 1 && isobj(argv[0], type(Image), (void**)&img)) {
    unsigned long colors = GetNumberColors(img, NULL, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else
      return mkuint(colors);
  } else
    return __FAIL;
}

FUNCTION(magick,is_gray_image,argc,argv)
{
  Image *img;
  if (argc == 1 && isobj(argv[0], type(Image), (void**)&img)) {
    unsigned res = IsGrayImage(img, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else
      return mkbool(res);
  } else
    return __FAIL;
}

FUNCTION(magick,is_monochrome_image,argc,argv)
{
  Image *img;
  if (argc == 1 && isobj(argv[0], type(Image), (void**)&img)) {
    unsigned res = IsMonochromeImage(img, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else
      return mkbool(res);
  } else
    return __FAIL;
}

FUNCTION(magick,is_opaque_image,argc,argv)
{
  Image *img;
  if (argc == 1 && isobj(argv[0], type(Image), (void**)&img)) {
    unsigned res = IsOpaqueImage(img, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else
      return mkbool(res);
  } else
    return __FAIL;
}

FUNCTION(magick,is_palette_image,argc,argv)
{
  Image *img;
  if (argc == 1 && isobj(argv[0], type(Image), (void**)&img)) {
    unsigned res = IsPaletteImage(img, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else
      return mkbool(res);
  } else
    return __FAIL;
}

FUNCTION(magick,magick_pixel,argc,argv)
{
  char *s;
  expr *xv, x, hd, tl;
  int n;
  unsigned long r, g, b, a = 0xffff;
  PixelPacket pixel;
  bstr_t *m;
  unsigned char *v;
  if (argc != 1) return __FAIL;
  /* treat the case of a single color value: */
  if (isstr(argv[0], &s)) {
    if (!(s = utf8_to_sys(s)))
      return __ERROR;
    if (!QueryColorDatabase(s, &pixel, &exception)) {
      free(s);
      if (check_exception(&exception))
	return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
      else
	return __FAIL;
    }
    free(s);
  } else if (istuple(argv[0], &n, &xv) && n >= 3 && n <= 4 &&
	     isuint(xv[0], &r) && isuint(xv[1], &g) && isuint(xv[2], &b) &&
	     (n == 3 || isuint(xv[3], &a)) &&
	     r <= 0xffff && g <= 0xffff && b <= 0xffff && a <= 0xffff) {
    pixel.red = ScaleShortToQuantum(r);
    pixel.green = ScaleShortToQuantum(g);
    pixel.blue = ScaleShortToQuantum(b);
    pixel.opacity = ScaleShortToQuantum(0xffff-a);
  } else
    goto skip;
  if (!(m = malloc(sizeof(bstr_t))) || !(m->v = malloc(8))) {
    if (m) free(m); return __ERROR;
  }
  m->size = 8;
  get_pixels(m->v, &pixel, 1, 1);
  return mkobj(type(ByteStr), m);
 skip:
  /* if we come here, we should deal with a list of color values */
  for (n = 0, x = argv[0]; iscons(x, &hd, &tl); x = tl) n++;
  if (!isnil(x)) return __FAIL;
  if (n == 0) {
    if (!(m = malloc(sizeof(bstr_t)))) return __ERROR;
    m->size = 0;
    m->v = NULL;
    return mkobj(type(ByteStr), m);
  }
  if (n < 0 || ULONG_MAX/8 < n) return __ERROR;
  if (!(m = malloc(sizeof(bstr_t))) || !(m->v = malloc(n*8))) {
    if (m) free(m); return __ERROR;
  }
  m->size = n*8;
  for (v = m->v, x = argv[0]; iscons(x, &hd, &tl); x = tl, v += 8) {
    if (isstr(hd, &s)) {
      if (!(s = utf8_to_sys(s))) {
	free(m->v); free(m);
	return __ERROR;
      }
      if (!QueryColorDatabase(s, &pixel, &exception)) {
	free(s);
	free(m->v); free(m);
	if (check_exception(&exception))
	  return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
	else
	  return __FAIL;
      }
      free(s);
    } else if (istuple(hd, &n, &xv) && n >= 3 && n <= 4 &&
	       isuint(xv[0], &r) && isuint(xv[1], &g) && isuint(xv[2], &b) &&
	       (n == 3 || isuint(xv[3], &a)) &&
	       r <= 0xffff && g <= 0xffff && b <= 0xffff && a <= 0xffff) {
      pixel.red = ScaleShortToQuantum(r);
      pixel.green = ScaleShortToQuantum(g);
      pixel.blue = ScaleShortToQuantum(b);
      pixel.opacity = ScaleShortToQuantum(0xffff-a);
    } else {
      free(m->v); free(m);
      return __FAIL;
    }
    get_pixels(v, &pixel, 1, 1);
  }
  return mkobj(type(ByteStr), m);
}

FUNCTION(magick,magick_color,argc,argv)
{
  bstr_t *m;
  if (argc == 1 && isobj(argv[0], type(ByteStr), (void**)&m) &&
      m->size%8 == 0) {
    if (m->size == 0)
      return mknil;
    else if (m->size == 8) {
      unsigned short *v = (unsigned short*)m->v;
      unsigned short r, g, b, a;
      r = *v++; g = *v++; b = *v++; a = *v++;
      return mktuplel(4, mkuint(r), mkuint(g), mkuint(b), mkuint(a));
    } else {
      expr x = mknil;
      int i, n = m->size/8;
      unsigned short *v = (unsigned short*)(m->v+m->size);
      unsigned short r, g, b, a;
      for (i = 0; x && i < n; i++) {
	a = *--v; b = *--v; g = *--v; r = *--v;
	x = mkcons(mktuplel(4, mkuint(r), mkuint(g), mkuint(b), mkuint(a)),
		   x);
      }
      return x;
    }
  } else
    return __FAIL;
}

FUNCTION(magick,magick_colors,argc,argv)
{
  char *s;
  if (argc == 1 && isstr(argv[0], &s) && (s = utf8_to_sys(s))) {
#if MagickLibVersion < 0x550
    int n;
#else
    unsigned long n;
#endif
#if MagickLibVersion < 0x610
    char **color_list = GetColorList(s, &n);
#else
    char **color_list = GetColorList(s, &n, &exception);
    free(s);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else
#endif
    if (color_list) {
      expr *x = mknil;
      while (n > 0 && x) {
	char *c = color_list[--n];
	x = mkcons(mkstr(sys_to_utf8(c)), x);
	free(c);
      }
      free(color_list);
      return x;
    } else
      return __FAIL;
  } else
    return __FAIL;
}

FUNCTION(magick,create_image,argc,argv)
{
  expr *xv = NULL;
  int n = 0;
  bstr_t *m;
  unsigned long w, h;
  if (argc == 2 && istuple(argv[0], &n, &xv) && n >= 2 &&
      isuint(xv[0], &w) && isuint(xv[1], &h) && w > 0 && h > 0 &&
      isobj(argv[1], type(ByteStr), (void**)&m)) {
    unsigned long size = w*h*8;
    ImageInfo info;
    Image *img;
    int matte;
    GetImageInfo(&info);
    if (ULONG_MAX/8 < w*h || m->size != 8 && m->size != size ||
	!parse_info(n, xv, &info, &matte))
      return __FAIL;
    img = AllocateImage(&info);
    if (!img)
      return __ERROR;
    else {
      PixelPacket *pixels;
      if (matte >= 0) img->matte = (unsigned)matte;
      if (!(pixels = SetImagePixels(img, 0, 0, w, h))) {
	DestroyImage(img);
	return __FAIL;
      }
      if (m->size > 8)
	set_pixels(pixels, m->v, w*h, img->matte);
      else {
	unsigned long x, y;
	for (y = 0; y < h; y++, pixels += w)
	  for (x = 0; x < w; x++)
	    set_pixels(pixels+x, m->v, 1, img->matte);
      }
      img->storage_class = DirectClass;
      if (SyncImagePixels(img))
	return mk_image(img);
      else {
	DestroyImage(img);
	return __FAIL;
      }
    }
  } else
    return __FAIL;
}

FUNCTION(magick,clone_image,argc,argv)
{
  Image *img;
  if (argc == 1 && isobj(argv[0], type(Image), (void**)&img)) {
    img = CloneImage(img, 0, 0, 1, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __ERROR;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,read_image,argc,argv)
{
  char *s;
  expr *xv = NULL;
  int n = 0;
  if (argc == 2 && isstr(argv[0], &s) &&
      (istuple(argv[1], &n, &xv) || isvoid(argv[1]))) {
    ImageInfo info;
    Image *img;
    int matte;
    GetImageInfo(&info);
    if (!parse_info(n, xv, &info, &matte))
      return __FAIL;
    if (!(s = utf8_to_sys(s)))
      return __ERROR;
    strncpy(info.filename, s, MaxTextExtent-1);
    free(s);
    img = ReadImage(&info, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    if (!img)
      return __FAIL;
    else if (img->next) {
      Image *imgs;
      if (matte >= 0)
	for (imgs = img; imgs; imgs = imgs->next)
	  imgs->matte = (unsigned)matte;
      return mk_image_list(img);
    } else {
      if (matte >= 0) img->matte = (unsigned)matte;
      return mk_image(img);
    }
  } else
    return __FAIL;
}

FUNCTION(magick,ping_image,argc,argv)
{
  char *s;
  expr *xv = NULL;
  int n = 0;
  if (argc == 2 && isstr(argv[0], &s) &&
      (istuple(argv[1], &n, &xv) || isvoid(argv[1]))) {
    ImageInfo info;
    Image *img;
    int matte;
    GetImageInfo(&info);
    if (!parse_info(n, xv, &info, &matte))
      return __FAIL;
    if (!(s = utf8_to_sys(s)))
      return __ERROR;
    strncpy(info.filename, s, MaxTextExtent-1);
    free(s);
    img = PingImage(&info, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    if (!img)
      return __FAIL;
    else if (img->next) {
      Image *imgs;
      if (matte >= 0)
	for (imgs = img; imgs; imgs = imgs->next)
	  imgs->matte = (unsigned)matte;
      return mk_image_list(img);
    } else {
      if (matte >= 0) img->matte = (unsigned)matte;
      return mk_image(img);
    }
  } else
    return __FAIL;
}

FUNCTION(magick,write_image,argc,argv)
{
  char *s;
  expr *xv = NULL;
  int n = 0;
  if (argc == 3 && isstr(argv[0], &s)) {
    Image *img = NULL;
    ImageInfo info;
    int res;
    if (isnil(argv[1]))
      return __FAIL;
    GetImageInfo(&info);
    if (!isvoid(argv[2]) && !istuple(argv[2], &n, &xv)) {
      xv = argv+2;
      n = 1;
    }
    if (!parse_info2(n, xv, &info))
      return __FAIL;
    if (is_image_list(argv[1], &img)) {
      if (!(s = utf8_to_sys(s)))
	return __ERROR;
      res = WriteImages(&info, img, s, &exception);
      free(s);
      decompose_image_list(img);
    } else {
      /* must be a singleton image */
      if (!(isobj(argv[1], type(Image), (void**)&img) &&
	    img->columns > 0 && img->rows > 0))
	return __FAIL;
      if (!(s = utf8_to_sys(s)))
	return __ERROR;
      strncpy(img->filename, s, MaxTextExtent-1);
      free(s);
      res = WriteImage(&info, img);
      exception = img->exception;
    }
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!res)
      return __FAIL;
    else
      return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(magick,image_to_blob,argc,argv)
{
  char *s = NULL;
  Image *img;
  expr *xv;
  int n = 0;
  if (argc == 3 &&
      (isobj(argv[1], type(Image), (void**)&img) ||
       is_image_list(argv[1], &img)) &&
      img->columns > 0 && img->rows > 0 &&
      (isvoid(argv[0]) && *img->magick || isstr(argv[0], &s) && *s)) {
    ImageInfo info;
    size_t len;
    void *blob;
    bstr_t *m;
    char magick[MaxTextExtent];
    GetImageInfo(&info);
    if (!isvoid(argv[2]) && !istuple(argv[2], &n, &xv)) {
      xv = argv+2;
      n = 1;
    }
    if (!parse_info2(n, xv, &info))
      return __FAIL;
    if (s) {
      strncpy(magick, img->magick, MaxTextExtent-1);
      strncpy(img->magick, s, MaxTextExtent-1);
    }
    blob = ImageToBlob(&info, img, &len, &exception);
    decompose_image_list(img);
    if (s)
      strncpy(img->magick, magick, MaxTextExtent-1);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!blob)
      return __FAIL;
    else if ((int)len < 0 || !(m = malloc(sizeof(bstr_t)))) {
      free(blob);
      return __ERROR;
    } else {
      m->size = (int)len;
      m->v = (unsigned char*)blob;
      return mkobj(type(ByteStr), m);
    }
  } else
    return __FAIL;
}

FUNCTION(magick,blob_to_image,argc,argv)
{
  bstr_t *m;
  expr *xv = NULL;
  int n = 0;
  if (argc == 2 && isobj(argv[0], type(ByteStr), (void**)&m) &&
      m->size > 0 &&
      (istuple(argv[1], &n, &xv) || isvoid(argv[1]))) {
    ImageInfo info;
    Image *img;
    int matte;
    size_t len = (size_t)m->size;
    void *blob = m->v;
    GetImageInfo(&info);
    if (!parse_info(n, xv, &info, &matte))
      return __FAIL;
    img = BlobToImage(&info, blob, len, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    if (!img)
      return __FAIL;
    else if (img->next) {
      Image *imgs;
      if (matte >= 0)
	for (imgs = img; imgs; imgs = imgs->next)
	  imgs->matte = (unsigned)matte;
      return mk_image_list(img);
    } else {
      if (matte >= 0) img->matte = (unsigned)matte;
      return mk_image(img);
    }
  } else
    return __FAIL;
}

FUNCTION(magick,get_image_pixels,argc,argv)
{
  Image *img;
  expr *xv;
  int n;
  long x, y;
  unsigned long w, h;
  PixelPacket *pixels;
  if (argc == 3 && isobj(argv[0], type(Image), (void**)&img) &&
      istuple(argv[1], &n, &xv) && n == 2 &&
      isint(xv[0], &x) && isint(xv[1], &y) &&
      istuple(argv[2], &n, &xv) && n == 2 &&
      isuint(xv[0], &w) && isuint(xv[1], &h) &&
      (pixels = GetImagePixels(img, x, y, w, h))) {
    unsigned long size = w*h*8;
    bstr_t *m;
    if (ULONG_MAX/8 < w*h) return __ERROR;
    if (!(m = malloc(sizeof(bstr_t)))) return __ERROR;
    if (size == 0) {
      m->size = 0;
      m->v = NULL;
      return mkobj(type(ByteStr), m);
    } else if (!(m->v = malloc(size))) {
      free(m);
      return __ERROR;
    }
    m->size = size;
    get_pixels(m->v, pixels, w*h, img->matte);
    return mkobj(type(ByteStr), m);
  } else
    return __FAIL;
}

FUNCTION(magick,set_image_pixels,argc,argv)
{
  Image *img;
  expr *xv;
  int n;
  long x, y;
  unsigned long w, h;
  bstr_t *m;
  PixelPacket *pixels;
  if (argc == 4 && isobj(argv[0], type(Image), (void**)&img) &&
      istuple(argv[1], &n, &xv) && n == 2 &&
      isint(xv[0], &x) && isint(xv[1], &y) &&
      istuple(argv[2], &n, &xv) && n == 2 &&
      isuint(xv[0], &w) && isuint(xv[1], &h) &&
      isobj(argv[3], type(ByteStr), (void**)&m)) {
    unsigned long size = w*h*8;
    if (ULONG_MAX/8 < w*h || size != m->size)
      return __FAIL;
    else if (size == 0)
      return mkvoid;
    if (!(pixels = SetImagePixels(img, x, y, w, h)))
      return __FAIL;
    set_pixels(pixels, m->v, w*h, img->matte);
    img->storage_class = DirectClass;
    if (SyncImagePixels(img))
      return mkvoid;
    else
      return __FAIL;
  } else
    return __FAIL;
}

FUNCTION(magick,quantize,argc,argv)
{
  Image *img = NULL, *imgs = NULL, *img2 = NULL;
  unsigned long space = RGBColorspace, ncolors = 255;
  int dither = 0, res;
  int n;
  expr *xv;
  if (argc == 2 &&
      (isobj(argv[0], type(Image), (void**)&img) ||
       is_image_list(argv[0], &imgs)) &&
      (isuint(argv[1], &space) ||
       isobj(argv[1], type(Image), (void**)&img2) ||
       istuple(argv[1], &n, &xv) &&
       (n == 1 &&
	(isuint(xv[0], &space) ||
	 isobj(xv[0], type(Image), (void**)&img2)) ||
	n == 2 &&
	(isuint(xv[0], &space) &&
	 (isuint(xv[1], &ncolors) || isbool(xv[1], &dither)) ||
	 isobj(xv[0], type(Image), (void**)&img2) &&
	 isbool(xv[1], &dither)) ||
	n == 3 &&
	isuint(xv[0], &space) &&
	isuint(xv[1], &ncolors) &&
	isbool(xv[2], &dither))) &&
       ncolors <= MaxRGB) {
    if (img2) {
      if (imgs) {
	res = MapImages(imgs, img2, dither);
	decompose_image_list(imgs);
      } else
	res = MapImage(img, img2, dither);
    } else {
      QuantizeInfo info;
      GetQuantizeInfo(&info);
      info.dither = dither;
      info.number_colors = ncolors;
      info.colorspace = space;
      if (imgs) {
	res = QuantizeImages(&info, imgs);
	decompose_image_list(imgs);
      } else
	res = QuantizeImage(&info, img);
    }
    if (res)
      return mkvoid;
    else
      return __FAIL;
  } else
    return __FAIL;
}

FUNCTION(magick,chop,argc,argv)
{
  Image *img;
  int n;
  expr *xv;
  long x, y;
  unsigned long w, h;
  if (argc == 3 && isobj(argv[0], type(Image), (void**)&img) &&
      istuple(argv[1], &n, &xv) && 
      isint(xv[0], &x) && isint(xv[1], &y) &&
      istuple(argv[2], &n, &xv) && n == 2 &&
      isuint(xv[0], &w) && isuint(xv[1], &h)) {
    RectangleInfo info;
    info.x = x; info.y = y;
    info.width = w; info.height = h;
    img = ChopImage(img, &info, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,crop,argc,argv)
{
  Image *img;
  int n;
  expr *xv;
  long x, y;
  unsigned long w, h;
  if (argc == 3 && isobj(argv[0], type(Image), (void**)&img) &&
      istuple(argv[1], &n, &xv) && 
      isint(xv[0], &x) && isint(xv[1], &y) &&
      istuple(argv[2], &n, &xv) && n == 2 &&
      isuint(xv[0], &w) && isuint(xv[1], &h)) {
    RectangleInfo info;
    info.x = x; info.y = y;
    info.width = w; info.height = h;
    img = CropImage(img, &info, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,roll,argc,argv)
{
  Image *img;
  int n;
  expr *xv;
  long x, y;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      istuple(argv[1], &n, &xv) && n == 2 &&
      isint(xv[0], &x) && isint(xv[1], &y)) {
    img = RollImage(img, x, y, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,shave,argc,argv)
{
  Image *img;
  int n;
  expr *xv;
  unsigned long w, h;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      istuple(argv[1], &n, &xv) && n == 2 &&
      isuint(xv[0], &w) && isuint(xv[1], &h)) {
    RectangleInfo info;
    info.x = 0; info.y = 0;
    info.width = w; info.height = h;
    img = ShaveImage(img, &info, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,magnify,argc,argv)
{
  Image *img;
  if (argc == 1 && isobj(argv[0], type(Image), (void**)&img)) {
    img = MagnifyImage(img, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,minify,argc,argv)
{
  Image *img;
  if (argc == 1 && isobj(argv[0], type(Image), (void**)&img)) {
    img = MinifyImage(img, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,resize,argc,argv)
{
  Image *img;
  int n;
  expr *xv;
  unsigned long w, h, filter;
  double blur;
  if (argc == 4 && isobj(argv[0], type(Image), (void**)&img) &&
      istuple(argv[1], &n, &xv) && n == 2 &&
      isuint(xv[0], &w) && isuint(xv[1], &h) &&
      isuint(argv[2], &filter) &&
      (isfloat(argv[3], &blur) || ismpz_float(argv[3], &blur))) {
    img = ResizeImage(img, w, h, filter, blur, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,sample,argc,argv)
{
  Image *img;
  int n;
  expr *xv;
  unsigned long w, h;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      istuple(argv[1], &n, &xv) && n == 2 &&
      isuint(xv[0], &w) && isuint(xv[1], &h)) {
    img = SampleImage(img, w, h, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,scale,argc,argv)
{
  Image *img;
  int n;
  expr *xv;
  unsigned long w, h;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      istuple(argv[1], &n, &xv) && n == 2 &&
      isuint(xv[0], &w) && isuint(xv[1], &h)) {
    img = ScaleImage(img, w, h, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,thumbnail,argc,argv)
{
#if MagickLibVersion >= 0x550
  Image *img;
  int n;
  expr *xv;
  unsigned long w, h;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      istuple(argv[1], &n, &xv) && n == 2 &&
      isuint(xv[0], &w) && isuint(xv[1], &h)) {
    img = ThumbnailImage(img, w, h, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
#endif
    return __FAIL;
}

FUNCTION(magick,flipx,argc,argv)
{
  Image *img;
  if (argc == 1 && isobj(argv[0], type(Image), (void**)&img)) {
    img = FlopImage(img, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,flipy,argc,argv)
{
  Image *img;
  if (argc == 1 && isobj(argv[0], type(Image), (void**)&img)) {
    img = FlipImage(img, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,rotate,argc,argv)
{
  Image *img;
  double angle;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      (isfloat(argv[1], &angle) || ismpz_float(argv[1], &angle))) {
    img = RotateImage(img, angle, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,shear,argc,argv)
{
  Image *img;
  int n;
  expr *xv;
  double xshear, yshear;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      istuple(argv[1], &n, &xv) && n == 2 &&
      (isfloat(xv[0], &xshear) || ismpz_float(xv[0], &xshear)) &&
      (isfloat(xv[1], &yshear) || ismpz_float(xv[1], &yshear))) {
    img = ShearImage(img, xshear, yshear, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,affine_transform,argc,argv)
{
  Image *img;
  int n;
  expr *xv;
  AffineMatrix matrix;
  if (argc == 3 && isobj(argv[0], type(Image), (void**)&img) &&
      istuple(argv[1], &n, &xv) && n == 4 &&
      (isfloat(xv[0], &matrix.sx) || ismpz_float(xv[0], &matrix.sx)) &&
      (isfloat(xv[1], &matrix.rx) || ismpz_float(xv[1], &matrix.rx)) &&
      (isfloat(xv[2], &matrix.ry) || ismpz_float(xv[2], &matrix.ry)) &&
      (isfloat(xv[3], &matrix.sy) || ismpz_float(xv[3], &matrix.sy)) &&
      istuple(argv[2], &n, &xv) && n == 2 &&
      (isfloat(xv[0], &matrix.tx) || ismpz_float(xv[0], &matrix.tx)) &&
      (isfloat(xv[1], &matrix.ty) || ismpz_float(xv[1], &matrix.ty))) {
    img = AffineTransformImage(img, &matrix, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,coalesce,argc,argv)
{
  Image *imgs;
  if (argc == 1 && is_image_list(argv[0], &imgs) && imgs) {
    Image *img = CoalesceImages(imgs, &exception);
    decompose_image_list(imgs);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image_list(img);
  } else
    return __FAIL;
}

FUNCTION(magick,flatten,argc,argv)
{
  Image *imgs;
  if (argc == 1 && is_image_list(argv[0], &imgs) && imgs) {
    Image *img = FlattenImages(imgs, &exception);
    decompose_image_list(imgs);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,mosaic,argc,argv)
{
  Image *imgs;
  if (argc == 1 && is_image_list(argv[0], &imgs) && imgs) {
    Image *img = MosaicImages(imgs, &exception);
    decompose_image_list(imgs);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

/* info structure used by montage */

static int parse_montage_info(int n, expr *xv, MontageInfo *info)
{
  int i = 0, b;
  unsigned long u;
  double f;
  char *s;
  bstr_t *m;

  if (i >= n) return 1;
  s = NULL;
  if (!isvoid(xv[i]) && !isstr(xv[i], &s)) return 0;
  if (s) info->title = utf8_to_sys(s);
  i++;
  if (i >= n) return 1;
  s = NULL;
  if (!isvoid(xv[i]) && !isstr(xv[i], &s)) return 0;
  if (s) info->tile = s;
  i++;
  if (i >= n) return 1;
  s = NULL;
  if (!isvoid(xv[i]) && !isstr(xv[i], &s)) return 0;
  if (s) info->geometry = s;
  i++;
  if (i >= n) return 1;
  s = NULL;
  if (!isvoid(xv[i]) && !isstr(xv[i], &s)) return 0;
  if (s) info->frame = s;
  i++;
  if (i >= n) return 1;
  if (!isuint(xv[i++], &u)) return 0;
  if (u > 0) info->border_width = u;
  if (i >= n) return 1;
  if (!isbool(xv[i++], &b)) return 0;
  info->shadow = b;
  if (i >= n) return 1;
  s = NULL;
  if (!isvoid(xv[i]) && !isstr(xv[i], &s)) return 0;
  if (s) info->texture = utf8_to_sys(s);
  i++;
  if (i >= n) return 1;
  s = NULL;
  if (!isvoid(xv[i]) && !isstr(xv[i], &s)) return 0;
  if (s) info->font = utf8_to_sys(s);
  i++;
  if (i >= n) return 1;
  if (!isfloat(xv[i], &f) && !ismpz_float(xv[i], &f)) return 0;
  if (f > 0.0) info->pointsize = f;
  i++;
  if (i >= n) return 1;
  if (!isobj(xv[i++], type(ByteStr), (void**)&m) || m->size != 8) return 0;
  set_pixels(&info->background_color, m->v, 1, 1);
  if (i >= n) return 1;
  if (!isobj(xv[i++], type(ByteStr), (void**)&m) || m->size != 8) return 0;
  set_pixels(&info->fill, m->v, 1, 1);
  if (i >= n) return 1;
  if (!isobj(xv[i++], type(ByteStr), (void**)&m) || m->size != 8) return 0;
  set_pixels(&info->matte_color, m->v, 1, 1);
  if (i >= n) return 1;
  return 0;
}

static void free_montage_info(MontageInfo *info, MontageInfo *info0)
{
  if (info->title != NULL &&
      info->title != info0->title)
    free(info->title);
  if (info->texture != NULL &&
      info->texture != info0->texture)
    free(info->texture);
  if (info->font != NULL &&
      info->font != info0->font)
    free(info->font);
}

FUNCTION(magick,montage,argc,argv)
{
  static int montage_init = 0;
  static MontageInfo montage_info0;
  Image *imgs;
  if (argc == 2 && is_image_list(argv[0], &imgs) && imgs) {
    Image *img, *next;
    MontageInfo montage_info;
    int n;
    expr *xv;
    if (!montage_init) {
      /* this is only initialized once */
      ImageInfo image_info;
      GetImageInfo(&image_info);
      GetMontageInfo(&image_info, &montage_info0);
      montage_init = 1;
    }
    montage_info = montage_info0;
    if (!istuple(argv[1], &n, &xv)) {
      n = 1;
      xv = argv+1;
    }
    if (!parse_montage_info(n, xv, &montage_info))
      return __FAIL;
    img = MontageImages(imgs, &montage_info, &exception);
    free_montage_info(&montage_info, &montage_info0);
    decompose_image_list(imgs);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else if (img->next)
      return mk_image_list(img);
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,deconstruct,argc,argv)
{
  Image *imgs;
  if (argc == 1 && is_image_list(argv[0], &imgs) && imgs) {
    Image *img = DeconstructImages(imgs, &exception);
    decompose_image_list(imgs);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image_list(img);
  } else
    return __FAIL;
}

FUNCTION(magick,segment,argc,argv)
{
  Image *img;
  unsigned long space;
  int verbose;
  double cluster, smooth;
  if (argc == 5 && isobj(argv[0], type(Image), (void**)&img) &&
      isuint(argv[1], &space) &&
      isbool(argv[2], &verbose) &&
      (isfloat(argv[3], &cluster) || ismpz_float(argv[3], &cluster)) &&
      (isfloat(argv[4], &smooth) || ismpz_float(argv[4], &smooth))) {
    int res = SegmentImage(img, space, verbose, cluster, smooth);
    if (!res)
      return __FAIL;
    else
      return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(magick,composite,argc,argv)
{
  Image *img, *img2;
  unsigned long op;
  long x, y;
  int n;
  expr *xv;
  if (argc == 4 && isobj(argv[0], type(Image), (void**)&img) &&
      isuint(argv[1], &op) &&
      isobj(argv[2], type(Image), (void**)&img2) &&
      istuple(argv[3], &n, &xv) &&
      isint(xv[0], &x) && isint(xv[1], &y)) {
    int res = CompositeImage(img, op, img2, x, y);
    if (!res)
      return __FAIL;
    else
      return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(magick,contrast,argc,argv)
{
  Image *img;
  int sharpen;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      isbool(argv[1], &sharpen)) {
    /* With IM 5.5 this always returns false, bug? Therfore we just ignore the
       return value. */
    ContrastImage(img, sharpen);
    return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(magick,equalize,argc,argv)
{
  Image *img;
  if (argc == 1 && isobj(argv[0], type(Image), (void**)&img)) {
    int res = EqualizeImage(img);
    if (!res)
      return __FAIL;
    else
      return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(magick,gamma,argc,argv)
{
  Image *img;
  char *val;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      isstr(argv[1], &val) && GammaImage(img, val))
    return mkvoid;
  else
    return __FAIL;
}

FUNCTION(magick,level,argc,argv)
{
  Image *img;
  char *val;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      isstr(argv[1], &val) && LevelImage(img, val))
    return mkvoid;
  else
    return __FAIL;
}

FUNCTION(magick,modulate,argc,argv)
{
  Image *img;
  char *val;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      isstr(argv[1], &val) && ModulateImage(img, val))
    return mkvoid;
  else
    return __FAIL;
}

FUNCTION(magick,negate,argc,argv)
{
  Image *img;
  if (argc == 1 && isobj(argv[0], type(Image), (void**)&img)) {
    int res = NegateImage(img, 0);
    if (!res)
      return __FAIL;
    else
      return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(magick,normalize,argc,argv)
{
  Image *img;
  if (argc == 1 && isobj(argv[0], type(Image), (void**)&img)) {
    int res = NormalizeImage(img);
    if (!res)
      return __FAIL;
    else
      return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(magick,adaptive_threshold,argc,argv)
{
#if MagickLibVersion >= 0x550
  Image *img;
  unsigned long w, h;
  long offs;
  int n;
  expr *xv;
  if (argc == 3 && isobj(argv[0], type(Image), (void**)&img) &&
      istuple(argv[1], &n, &xv) && n == 2 &&
      isuint(xv[0], &w) && isuint(xv[1], &h) &&
      isint(argv[2], &offs)) {
    img = AdaptiveThresholdImage(img, w, h, offs, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
#endif
    return __FAIL;
}

FUNCTION(magick,add_noise,argc,argv)
{
  Image *img;
  unsigned long noise;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      isuint(argv[1], &noise)) {
    img = AddNoiseImage(img, noise, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,blur,argc,argv)
{
  Image *img;
  double radius, sigma;
  if (argc == 3 && isobj(argv[0], type(Image), (void**)&img) &&
      (isfloat(argv[1], &radius) || ismpz_float(argv[1], &radius)) &&
      (isfloat(argv[2], &sigma) || ismpz_float(argv[2], &sigma))) {
    img = BlurImage(img, radius, sigma, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,despeckle,argc,argv)
{
  Image *img;
  if (argc == 1 && isobj(argv[0], type(Image), (void**)&img)) {
    img = DespeckleImage(img, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,edge,argc,argv)
{
  Image *img;
  double radius;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      (isfloat(argv[1], &radius) || ismpz_float(argv[1], &radius))) {
    img = EdgeImage(img, radius, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,emboss,argc,argv)
{
  Image *img;
  double radius, sigma;
  if (argc == 3 && isobj(argv[0], type(Image), (void**)&img) &&
      (isfloat(argv[1], &radius) || ismpz_float(argv[1], &radius)) &&
      (isfloat(argv[2], &sigma) || ismpz_float(argv[2], &sigma))) {
    img = EmbossImage(img, radius, sigma, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,enhance,argc,argv)
{
  Image *img;
  if (argc == 1 && isobj(argv[0], type(Image), (void**)&img)) {
    img = EnhanceImage(img, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,gaussian_blur,argc,argv)
{
  Image *img;
  double radius, sigma;
  if (argc == 3 && isobj(argv[0], type(Image), (void**)&img) &&
      (isfloat(argv[1], &radius) || ismpz_float(argv[1], &radius)) &&
      (isfloat(argv[2], &sigma) || ismpz_float(argv[2], &sigma))) {
    img = GaussianBlurImage(img, radius, sigma, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,median_filter,argc,argv)
{
  Image *img;
  double radius;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      (isfloat(argv[1], &radius) || ismpz_float(argv[1], &radius))) {
    img = MedianFilterImage(img, radius, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,motion_blur,argc,argv)
{
  Image *img;
  double radius, sigma, angle;
  if (argc == 4 && isobj(argv[0], type(Image), (void**)&img) &&
      (isfloat(argv[1], &radius) || ismpz_float(argv[1], &radius)) &&
      (isfloat(argv[2], &sigma) || ismpz_float(argv[2], &sigma)) &&
      (isfloat(argv[3], &angle) || ismpz_float(argv[3], &angle))) {
    img = MotionBlurImage(img, radius, sigma, angle, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,reduce_noise,argc,argv)
{
  Image *img;
  double radius;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      (isfloat(argv[1], &radius) || ismpz_float(argv[1], &radius))) {
    img = ReduceNoiseImage(img, radius, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,shade,argc,argv)
{
  Image *img;
  double azimuth, elevation;
  if (argc == 3 && isobj(argv[0], type(Image), (void**)&img) &&
      (isfloat(argv[1], &azimuth) || ismpz_float(argv[1], &azimuth)) &&
      (isfloat(argv[2], &elevation) || ismpz_float(argv[2], &elevation))) {
    img = ShadeImage(img, 0, azimuth, elevation, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,sharpen,argc,argv)
{
  Image *img;
  double radius, sigma;
  if (argc == 3 && isobj(argv[0], type(Image), (void**)&img) &&
      (isfloat(argv[1], &radius) || ismpz_float(argv[1], &radius)) &&
      (isfloat(argv[2], &sigma) || ismpz_float(argv[2], &sigma))) {
    img = SharpenImage(img, radius, sigma, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,spread,argc,argv)
{
  Image *img;
  double radius;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      (isfloat(argv[1], &radius) || ismpz_float(argv[1], &radius)) &&
      radius >= 0.0) {
    img = SpreadImage(img, (unsigned)radius, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,threshold,argc,argv)
{
  /* This one doesn't seem to be implemented in older IM versions. */
#if MagickLibVersion >= 0x550
  Image *img;
  char *val;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      isstr(argv[1], &val)) {
    int res = ThresholdImageChannel(img, val);
    if (!res)
      return __FAIL;
    else
      return mkvoid;
  } else
#endif
    return __FAIL;
}

FUNCTION(magick,unsharp_mask,argc,argv)
{
  Image *img;
  double radius, sigma, amount, threshold;
  if (argc == 5 && isobj(argv[0], type(Image), (void**)&img) &&
      (isfloat(argv[1], &radius) || ismpz_float(argv[1], &radius)) &&
      (isfloat(argv[2], &sigma) || ismpz_float(argv[2], &sigma)) &&
      (isfloat(argv[3], &amount) || ismpz_float(argv[3], &amount)) &&
      (isfloat(argv[3], &threshold) || ismpz_float(argv[3], &threshold))) {
    img = UnsharpMaskImage(img, radius, sigma, amount, threshold, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,charcoal,argc,argv)
{
  Image *img;
  double radius, sigma;
  if (argc == 3 && isobj(argv[0], type(Image), (void**)&img) &&
      (isfloat(argv[1], &radius) || ismpz_float(argv[1], &radius)) &&
      (isfloat(argv[2], &sigma) || ismpz_float(argv[2], &sigma))) {
    img = CharcoalImage(img, radius, sigma, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,colorize,argc,argv)
{
  Image *img;
  char *val;
  bstr_t *m;
  if (argc == 3 && isobj(argv[0], type(Image), (void**)&img) &&
      isstr(argv[1], &val) &&
      isobj(argv[2], type(ByteStr), (void**)&m) && m->size == 8) {
    PixelPacket pixel;
    set_pixels(&pixel, m->v, 1, 1);
    img = ColorizeImage(img, val, pixel, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,convolve,argc,argv)
{
  Image *img;
  int n;
  expr *xv;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      istuple(argv[1], &n, &xv) && n > 0) {
    int order = (int)sqrt(n), i;
    double *kernel;
    if (order*order != n) return __FAIL;
    if (!(kernel = malloc(n*sizeof(double)))) return __ERROR;
    for (i = 0; i < n; i++)
      if (!isfloat(xv[i], kernel+i) && !ismpz_float(xv[i], kernel+i)) {
	free(kernel);
	return __FAIL;
      }
    img = ConvolveImage(img, order, kernel, &exception);
    free(kernel);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,implode,argc,argv)
{
  Image *img;
  double amount;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      (isfloat(argv[1], &amount) || ismpz_float(argv[1], &amount))) {
    img = ImplodeImage(img, amount, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,morph,argc,argv)
{
  Image *imgs, *imgs2;
  unsigned long frames;
  if (argc == 2 && is_image_list(argv[0], &imgs) && imgs &&
      isuint(argv[1], &frames)) {
    imgs2 = MorphImages(imgs, frames, &exception);
    decompose_image_list(imgs);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!imgs2)
      return __FAIL;
    else
      return mk_image_list(imgs2);
  } else
    return __FAIL;
}

FUNCTION(magick,oil_paint,argc,argv)
{
  Image *img;
  double radius;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      (isfloat(argv[1], &radius) || ismpz_float(argv[1], &radius))) {
    img = OilPaintImage(img, radius, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,solarize,argc,argv)
{
  Image *img;
  double threshold;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      ismpz_float(argv[1], &threshold)) {
    SolarizeImage(img, threshold);
    return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(magick,stegano,argc,argv)
{
  Image *img, *img2;
  long offset;
  if (argc == 3 && isobj(argv[0], type(Image), (void**)&img) &&
      isobj(argv[1], type(Image), (void**)&img2) &&
      isint(argv[2], &offset)) {
    img->offset = offset;
    img = SteganoImage(img, img2, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,stereo,argc,argv)
{
  Image *img, *img2;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      isobj(argv[1], type(Image), (void**)&img2)) {
    img = StereoImage(img, img2, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,swirl,argc,argv)
{
  Image *img;
  double angle;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      (isfloat(argv[1], &angle) || ismpz_float(argv[1], &angle))) {
    img = SwirlImage(img, angle, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,wave,argc,argv)
{
  Image *img;
  double amp, wavelen;
  if (argc == 3 && isobj(argv[0], type(Image), (void**)&img) &&
      (isfloat(argv[1], &amp) || ismpz_float(argv[1], &amp)) &&
      (isfloat(argv[2], &wavelen) || ismpz_float(argv[2], &wavelen))) {
    img = WaveImage(img, amp, wavelen, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,border,argc,argv)
{
  Image *img;
  int n;
  expr *xv;
  unsigned long w, h;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      istuple(argv[1], &n, &xv) && n == 2 &&
      isuint(xv[0], &w) && isuint(xv[1], &h)) {
    RectangleInfo rect;
    rect.x = rect.y = 0; rect.width = w; rect.height = h;
    img = BorderImage(img, &rect, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,frame,argc,argv)
{
  Image *img;
  int n;
  expr *xv;
  long x, y;
  unsigned long w, h;
  long inner, outer;
  if (argc == 4 && isobj(argv[0], type(Image), (void**)&img) &&
      istuple(argv[1], &n, &xv) && n == 2 &&
      isint(xv[0], &x) && isint(xv[1], &y) &&
      istuple(argv[2], &n, &xv) && n == 2 &&
      isuint(xv[0], &w) && isuint(xv[1], &h) &&
      istuple(argv[3], &n, &xv) && n == 2 &&
      isint(xv[0], &inner) && isint(xv[1], &outer)) {
    FrameInfo frame;
    frame.x = x; frame.y = y; frame.width = w; frame.height = h;
    frame.inner_bevel = inner; frame.outer_bevel = outer;
    img = FrameImage(img, &frame, &exception);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    else if (!img)
      return __FAIL;
    else
      return mk_image(img);
  } else
    return __FAIL;
}

FUNCTION(magick,button,argc,argv)
{
  Image *img;
  int n;
  expr *xv;
  unsigned long w, h;
  int raise;
  if (argc == 3 && isobj(argv[0], type(Image), (void**)&img) &&
      istuple(argv[1], &n, &xv) && n == 2 &&
      isuint(xv[0], &w) && isuint(xv[1], &h) &&
      isbool(argv[2], &raise)) {
    RectangleInfo rect;
    rect.x = rect.y = 0; rect.width = w; rect.height = h;
    if (RaiseImage(img, &rect, raise))
      return mkvoid;
    else
      return __FAIL;
  } else
    return __FAIL;
}

FUNCTION(magick,annotate,argc,argv)
{
  Image *img;
  DrawInfo *draw_info;
  expr *xv;
  int n;
  long x, y;
  char *s;
  if (argc == 3 && isobj(argv[0], type(Image), (void**)&img) &&
      (draw_info = get_draw_info(img)) && istuple(argv[1], &n, &xv) &&
      isint(xv[0], &x) && isint(xv[1], &y) &&
      isstr(argv[2], &s)) {
    int res;
    char geom[100];
    sprintf(geom, "%+d%+d", x, y);
    if (!(draw_info->text = utf8_to_sys(s)))
      return __ERROR;
    draw_info->geometry = geom;
    res = AnnotateImage(img, draw_info);
    free(draw_info->text);
    draw_info->text = draw_info->geometry = NULL;
    if (!res)
      return __FAIL;
    else
      return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(magick,draw,argc,argv)
{
  Image *img;
  DrawInfo *draw_info;
  char *s;
  if (argc == 2 && isobj(argv[0], type(Image), (void**)&img) &&
      (draw_info = get_draw_info(img)) && isstr(argv[1], &s)) {
    int res;
    if (!(draw_info->primitive = utf8_to_sys(s)))
      return __ERROR;
    res = DrawImage(img, draw_info);
    free(draw_info->primitive);
    draw_info->primitive = NULL;
    if (!res)
      return __FAIL;
    else
      return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(magick,color_flood_fill,argc,argv)
{
  Image *img;
  int n;
  expr *xv;
  long x, y;
  bstr_t *m1, *m2 = NULL;
  if (argc == 4 && isobj(argv[0], type(Image), (void**)&img) &&
      istuple(argv[1], &n, &xv) && n == 2 &&
      isint(xv[0], &x) && isint(xv[1], &y) &&
      x >= 0 && x < img->columns && y >= 0 && y < img->rows &&
      isobj(argv[2], type(ByteStr), (void**)&m1) && m1->size == 8 &&
      (isvoid(argv[3]) ||
       isobj(argv[3], type(ByteStr), (void**)&m2) && m2->size == 8)) {
    int res;
    DrawInfo *draw_info = CloneDrawInfo(NULL, NULL);
    PixelPacket fill, target;
    if (!draw_info) return __ERROR;
    set_pixels(&fill, m1->v, 1, 1);
    draw_info->fill = fill;
    if (m2)
      set_pixels(&target, m2->v, 1, 1);
    else {
      target = AcquireOnePixel(img, x, y, &exception);
      if (check_exception(&exception)) {
	DestroyDrawInfo(draw_info);
	return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
      }
    }
    res = ColorFloodfillImage(img, draw_info, target, x, y,
			      m2?FillToBorderMethod:FloodfillMethod);
    DestroyDrawInfo(draw_info);
    if (!res)
      return __FAIL;
    else
      return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(magick,matte_flood_fill,argc,argv)
{
  Image *img;
  int n;
  expr *xv;
  long x, y;
  unsigned long opacity;
  bstr_t *m2 = NULL;
  if (argc == 4 && isobj(argv[0], type(Image), (void**)&img) &&
      istuple(argv[1], &n, &xv) && n == 2 &&
      isint(xv[0], &x) && isint(xv[1], &y) &&
      x >= 0 && x < img->columns && y >= 0 && y < img->rows &&
      isuint(argv[2], &opacity) && opacity <= 0xffff &&
      (isvoid(argv[3]) ||
       isobj(argv[3], type(ByteStr), (void**)&m2) && m2->size == 8)) {
    int res;
    PixelPacket target;
    if (m2)
      set_pixels(&target, m2->v, 1, 1);
    else {
      target = AcquireOnePixel(img, x, y, &exception);
      if (check_exception(&exception))
	return mkapp(mksym(sym(magick_error)), mkstr(sys_to_utf8(msg)));
    }
    res = MatteFloodfillImage(img, target, 0xffff-opacity, x, y,
			      m2?FillToBorderMethod:FloodfillMethod);
    if (!res)
      return __FAIL;
    else
      return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(magick,opaque,argc,argv)
{
  Image *img;
  bstr_t *m1, *m2;
  if (argc == 3 && isobj(argv[0], type(Image), (void**)&img) &&
      isobj(argv[1], type(ByteStr), (void**)&m1) && m1->size == 8 &&
      isobj(argv[2], type(ByteStr), (void**)&m2) && m2->size == 8) {
    int res;
    PixelPacket target, fill;
    set_pixels(&target, m1->v, 1, 1);
    set_pixels(&fill, m2->v, 1, 1);
    res = OpaqueImage(img, target, fill);
    if (!res)
      return __FAIL;
    else
      return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(magick,transparent,argc,argv)
{
  Image *img;
  bstr_t *m1;
  unsigned long opacity;
  if (argc == 3 && isobj(argv[0], type(Image), (void**)&img) &&
      isobj(argv[1], type(ByteStr), (void**)&m1) && m1->size == 8 &&
      isuint(argv[2], &opacity) && opacity <= 0xffff) {
    int res;
    PixelPacket target;
    set_pixels(&target, m1->v, 1, 1);
    res = TransparentImage(img, target, 0xffff-opacity);
    if (!res)
      return __FAIL;
    else
      return mkvoid;
  } else
    return __FAIL;
}