[q-lang-cvs] q/modules/magick Makefile.am,NONE,1.1 Makefile.mingw,NONE,1.1 README-Magick,NONE,1.1 magick.c,NONE,1.1 magick.q,NONE,1.1

[<ag...@us...>]

Update of /cvsroot/q-lang/q/modules/magick
In directory sc8-pr-cvs1:/tmp/cvs-serv655/modules/magick

Added Files:
	Makefile.am Makefile.mingw README-Magick magick.c magick.q 
Log Message:
Added magick module

--- NEW FILE: Makefile.am ---
## Process this file with automake to generate a GNU Makefile

## only built if requested

SUBDIRS = . examples

INCLUDES = -I$(top_srcdir)/libq @MAGICK_INCLUDES@ @INCDMALLOC@

if MAGICK
pkglib_LTLIBRARIES = magick.la
endif

magick_la_SOURCES = magick.c
magick_la_LDFLAGS = -no-undefined -module -avoid-version
magick_la_LIBADD = -L$(top_builddir)/libq -lq @LIBGMP@ @MAGICK_LIBS@ @LIBDMALLOCTH@

stdlibdir = $(pkgdatadir)/lib

if MAGICK
stdlib_DATA = magick.q
endif

etcdir = $(pkgdatadir)/etc

if MAGICK
etc_DATA = README-Magick
endif

EXTRA_DIST = magick.q README-Magick Makefile.mingw

--- NEW FILE: Makefile.mingw ---
# $Id: Makefile.mingw,v 1.1 2003/12/16 19:11:16 agraef Exp $
# this still needs testing

QCC = ../../src/qcc
QCCFLAGS = 

CFLAGS = -O3

SHLEXT = .dll

DEFS = -DSTDC_HEADERS=1 -DHAVE_STRDUP=1 -DHAVE_MEMCPY=1 -DHAVE_LIMITS_H=1

.PHONY: all clean mostlyclean distclean maintainer-clean

all: magick$(SHLEXT)

magick$(SHLEXT): magick.c
	qcc -o magick$(SHLEXT) magick.c -- $(DEFS) -I. -I../../libq -I../../../magick/include -I../../../gmp --link -L. -L../../../magick/lib -lMagick -L../../../gmp -lgmp -L../../libq

clean mostlyclean distclean maintainer-clean::
	rm -f *.o *$(SHLEXT) *.a *.def *% *~ *.bak q.out .q_vars core

distclean maintainer-clean::
	rm -f TAGS Makefile config.h config.status config.cache config.log

--- NEW FILE: README-Magick ---

Q-Magick - ImageMagick interface for the Q programming language
======== = =========== ========= === === = =========== ========

This module implements a simple interface to the ImageMagick C API
(libMagick), a comprehensive library for image manipulation, see
http://www.imagemagick.org/. With this module, you can create, load, save and
manipulate images stored in a plethora of different file formats. Operations
to retrieve and modify the pixel data of an image are also provided. Since the
external pixel representation is compatible with that of the Q-GGI module, you
can easily exchange pixel data between images and GGI visuals as well.

Please note that this is still work in progress. The basic operations to
create, load and save images, and to retrieve and change image pixels are
already in place. Things that still remain to be done are additional options
for write_image (compression etc.), operations to convert between images and
"blobs" (for external storage, e.g., in databases), operations to handle image
lists (i.e., animations), and, last but not least, support for the advanced
image manipulation operations provided by libMagick.

The module requires that you have ImageMagick installed, which should be
readily available in most Linux distributions. The Windows Qpad package
already includes all necessary support files. Currently a fairly recent
ImageMagick version (>= 5.5) is required, but support for older versions will
be added in the near future.

Please see magick.q for a description of the functions provided by this
module. For more in-depth information about ImageMagick please refer to the
corresponding manual pages. A few sample scripts are also provided; you can
find these, once installed, in the <q-prefix>/share/q/examples/magick
directory.


Enjoy! :)

Dec 16 2003
Albert Graef
ag...@mu..., Dr....@t-...
http://www.musikwissenschaft.uni-mainz.de/~ag

--- NEW FILE: magick.c ---
/* $Id: magick.c,v 1.1 2003/12/16 19:11:16 agraef Exp $ */

/* TODO: make this work with older libMagick versions which don't provide
   the ScaleQuantumToXYZ routines. */

/* 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 <gmp.h>
#include <libq.h>
#include <magick/api.h>

MODULE(magick)

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();
}

#define my_mpz_fits_slong_p(z) (mpz_size(z) == 0 || mpz_fits_slong_p(z))
#define my_mpz_fits_ulong_p(z) (mpz_size(z) == 0 || mpz_fits_ulong_p(z))
#define my_mpz_fits_uint_p(z) (mpz_size(z) == 0 || mpz_fits_uint_p(z))

static expr mkuint(unsigned long u)
{
  mpz_t z;
  mpz_init(z);
  if (z->_mp_d) {
    mpz_set_ui(z, u);
    return mkmpz(z);
  } else
    return NULL;
}

static int isuint(expr x, unsigned long *u)
{
  mpz_t z;
  if (ismpz(x, z) && mpz_sgn(z) >= 0 && my_mpz_fits_ulong_p(z)) {
    *u = mpz_get_ui(z);
    return 1;
  } else
    return 0;
}

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

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

#if 0

/* manifest constants */

/* These aren't needed any more. We still leave it in here to have some
   boilerplate code when we have to add some manifest constants in the
   future. */

FUNCTION(magick,magick_vars,argc,argv)
{
  if (argc != 0) return __FAIL;
  return mktuplel
    (16,
     mkuint(UndefinedColorspace),
     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(UndefinedClass),
     mkuint(DirectClass),
     mkuint(PseudoClass));
}

#endif

/* image type */

DESTRUCTOR(magick,Image,ptr)
{
  Image *img = (Image*)ptr;
  DestroyImage(img);
}

/* 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 long i;
  register PixelPacket *p;
  register unsigned short *q;

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

/* Write RGBA pixels to a buffer. */

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

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

/* Read/write alpha channel only. */

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

  p = source;
  q = dest;
  for (i = 0; i < count; i++) {
    *q++=ScaleQuantumToShort(MaxRGB-p->opacity);
    p++;
  }
}

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

  p = source;
  q = dest;
  for (i = 0; i < count; i++) {
    q->opacity=ScaleShortToQuantum(0xffff-*p++);
    q++;
  }
}

/* parse info tuples */

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

static int parse_info2(int n, expr *xv, Image *img)
{
  int i = 3;
  if (i >= n) return 1;
  if (!istrue(xv[i]) && !isfalse(xv[i])) return 0;
  img->matte = istrue(xv[i++])!=0;
  if (i >= n) return 1;
  return 0;
}

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;
  char *v;
  if (argc != 1) return __FAIL;
  /* treat the case of a single color value: */
  if (isstr(argv[0], &s)) {
    if (!QueryColorDatabase(s, &pixel, &exception))
      if (check_exception(&exception))
	return mkapp(mksym(sym(magick_error)), mkstr(strdup(msg)));
      else
	return __FAIL;
  } 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);
  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 (!QueryColorDatabase(s, &pixel, &exception))
	if (check_exception(&exception))
	  return mkapp(mksym(sym(magick_error)), mkstr(strdup(msg)));
	else {
	  free(m->v); free(m);
	  return __FAIL;
	}
    } 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);
  }
  return mkobj(type(ByteStr), m);
}

FUNCTION(magick,magick_alpha,argc,argv)
{
  expr *xv, x, hd, tl;
  int n;
  unsigned long a;
  PixelPacket pixel;
  bstr_t *m;
  unsigned short *v;
  if (argc != 1) return __FAIL;
  pixel.red = pixel.green = pixel.blue = 0;
  /* treat the case of a single alpha value: */
  if (isuint(argv[0], &a) && a <= 0xffff)
    pixel.opacity = ScaleShortToQuantum(0xffff-a);
  else
    goto skip;
  if (!(m = malloc(sizeof(bstr_t))) || !(m->v = malloc(2))) {
    if (m) free(m); return __ERROR;
  }
  m->size = 2;
  get_alpha((unsigned short*)m->v, &pixel, 1);
  return mkobj(type(ByteStr), m);
 skip:
  /* if we come here, we should deal with a list of alpha 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 || n > INT_MAX/2) return __ERROR;
  if (!(m = malloc(sizeof(bstr_t))) || !(m->v = malloc(n*2))) {
    if (m) free(m); return __ERROR;
  }
  m->size = n*2;
  for (v = (unsigned short*)m->v, x = argv[0]; iscons(x, &hd, &tl);
       x = tl, v++) {
    if (isuint(hd, &a) && a <= 0xffff)
      pixel.opacity = ScaleShortToQuantum(0xffff-a);
    else {
      free(m->v); free(m);
      return __FAIL;
    }
    get_alpha(v, &pixel, 1);
  }
  return mkobj(type(ByteStr), m);
}

FUNCTION(magick,create_image,argc,argv)
{
  expr *xv;
  int n = 0;
  if (argc == 1 && (istuple(argv[0], &n, &xv) || isvoid(argv[0])) &&
      n <= 7) {
    ImageInfo *info = CloneImageInfo(NULL);
    Image *img;
    if (!info) return __ERROR;
    if (!parse_info(n, xv, info)) {
      DestroyImageInfo(info);
      return __FAIL;
    }
    img = AllocateImage(info);
    DestroyImageInfo(info);
    if (img && !parse_info2(n, xv, img)) {
      DestroyImage(img);
      return __FAIL;
    }
    if (!img)
      return __ERROR;
    else
      return mkobj(type(Image), img);
  } 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(strdup(msg)));
    else if (!img)
      return __ERROR;
    else
      return mkobj(type(Image), img);
  } else
    return __FAIL;
}

FUNCTION(magick,read_image,argc,argv)
{
  char *s;
  expr *xv;
  int n = 0;
  if (argc == 2 && isstr(argv[0], &s) &&
      (istuple(argv[1], &n, &xv) || isvoid(argv[1])) &&
      n <= 7) {
    ImageInfo *info = CloneImageInfo(NULL);
    Image *img;
    if (!info) return __ERROR;
    if (!parse_info(n, xv, info)) {
      DestroyImageInfo(info);
      return __FAIL;
    }
    strncpy(info->filename, s, MaxTextExtent-1);
    img = ReadImage(info, &exception);
    DestroyImageInfo(info);
    if (check_exception(&exception))
      return mkapp(mksym(sym(magick_error)), mkstr(strdup(msg)));
    if (img && !parse_info2(n, xv, img)) {
      DestroyImage(img);
      return __FAIL;
    }
    if (!img)
      return __FAIL;
    else
      return mkobj(type(Image), img);
  } else
    return __FAIL;
}

FUNCTION(magick,write_image,argc,argv)
{
  char *s;
  Image *img;
  if (argc == 2 && isstr(argv[0], &s) &&
      isobj(argv[1], type(Image), (void**)&img) &&
      img->columns > 0 && img->rows > 0) {
    ImageInfo *info = CloneImageInfo(NULL);
    int res;
    if (!info) return __ERROR;
    strncpy(img->filename, s, MaxTextExtent-1);
    res = WriteImage(info, img);
    DestroyImageInfo(info);
    if (check_exception(&img->exception))
      return mkapp(mksym(sym(magick_error)), mkstr(strdup(msg)));
    else if (!res)
      return __FAIL;
    else
      return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(magick,image_info,argc,argv)
{
  Image *img;
  if (argc == 1 && isobj(argv[0], type(Image), (void**)&img))
    return mktuplel(4, mkuint(img->columns), mkuint(img->rows),
		    mkuint(img->depth),
		    img->matte?mktrue:mkfalse);
  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(strdup(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(strdup(msg)));
    else
      return res?mktrue:mkfalse;
  } 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(strdup(msg)));
    else
      return res?mktrue:mkfalse;
  } 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(strdup(msg)));
    else
      return res?mktrue:mkfalse;
  } 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(strdup(msg)));
    else
      return res?mktrue:mkfalse;
  } 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) && isint(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 (size == 0) {
      m->size = 0;
      m->v = NULL;
      return mkobj(type(ByteStr), m);
    }
    if (!(m = malloc(sizeof(bstr_t))) || !(m->v = malloc(size))) {
      if (m) free(m);
      return __ERROR;
    }
    m->size = size;
    get_pixels(m->v, pixels, w*h);
    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) && isint(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->storage_class = DirectClass;
    if (SyncImagePixels(img))
      return mkvoid;
    else
      return __FAIL;
  } else
    return __FAIL;
}

FUNCTION(magick,get_image_alpha,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) && isint(xv[1], &h) &&
      (pixels = GetImagePixels(img, x, y, w, h))) {
    unsigned long size = w*h;
    bstr_t *m;
    if (ULONG_MAX/2 < w*h) return __ERROR;
    if (size == 0) {
      m->size = 0;
      m->v = NULL;
      return mkobj(type(ByteStr), m);
    }
    if (!(m = malloc(sizeof(bstr_t))) || !(m->v = malloc(size*2))) {
      if (m) free(m);
      return __ERROR;
    }
    m->size = size*2;
    get_alpha((unsigned short*)m->v, pixels, w*h);
    return mkobj(type(ByteStr), m);
  } else
    return __FAIL;
}

FUNCTION(magick,set_image_alpha,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) && isint(xv[1], &h) &&
      isobj(argv[3], type(ByteStr), (void**)&m) && m->size%2 == 0) {
    unsigned long size = w*h;
    if (ULONG_MAX/2 < w*h || 2*size != m->size)
      return __FAIL;
    else if (size == 0)
      return mkvoid;
    if (!(pixels = SetImagePixels(img, x, y, w, h)))
      return __FAIL;
    set_alpha(pixels, (unsigned short*)m->v, w*h);
    img->storage_class = DirectClass;
    if (SyncImagePixels(img))
      return mkvoid;
    else
      return __FAIL;
  } else
    return __FAIL;
}


--- NEW FILE: magick.q ---

/* magick.q: poor man's ImageMagick interface
   $Id: magick.q,v 1.1 2003/12/16 19:11:16 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. */

/* This module implements a simple interface to the ImageMagick C API
   (libMagick), a comprehensive library for image manipulation, see
   http://www.imagemagick.org/. Please note that this is still work in
   progress. The basic operations to create, load and save images, and to
   retrieve and change image pixels are already in place. TODO: additional
   options for write_image (compression etc.); blob conversion; image list
   handling (animations); image manipulation operations. */

import clib;

/* The Image type. Objects of this type are created with the create_image and
   read_image operations, and processed by the other operations of this
   module. */

public extern type Image;

public is_image X;

is_image IMG:Image	= true;
is_image _		= false otherwise;

/* Error handling. In case of failure, some operations use the following
   magick_error symbol to return a diagnostic message. You can define this
   symbol to perform error handling as appropriate for the application. */

public magick_error MSG;

/* ENCODING OF COLOR VALUES. Regardless of the internal representation of an
   image, pixel data is always encoded as a byte string of 16 bit RGBA
   values. A value of 0 in the RGB components denotes minimum, 0xffff maximum
   intensity. Similarly, an alpha value of 0 denotes a fully transparent,
   0xffff a fully opaque pixel. Note that this format matches the layout of
   GGI pixel values, which makes it easy to transfer pixel data between images
   and GGI visuals. */

/* The magick_pixel function returns the normalized RGBA color value, as a
   byte string, for a given color specification, which may be either a color
   name in the ImageMagick color database or an (R,G,B,A) tuple with values in
   the range 0..0xffff; the alpha value is optional and is assumed to be
   0xffff if it is missing. The function also packs a list of such values into
   a single byte string. The result of magick_pixel is suitable to be used as
   the DATA argument in a call to set_image_pixels (see below). */

public extern magick_pixel COLOR;

/* The magick_alpha function packs a single alpha value in the range 0..0xffff
   or a list of such values into a byte string, suitable as the DATA argument
   of set_image_alpha (see below). */

public extern magick_alpha ALPHA;

/* Operations to create, read and write an image. The create_image function
   creates a new image, given an INFO tuple of the form (WIDTH, HEIGHT, DEPTH,
   MATTE), where (WIDTH, HEIGHT) denotes the dimensions of the image, DEPTH is
   the bit depth of the color values (usually 8 or 16), and MATTE is a Bool
   value indicating whether the image has an alpha channel. All fields of the
   INFO tuple are optional; suitable defaults will be provided for fields
   which are omitted.

   The clone_image function creates an exact copy of the given image.

   The read_image function reads an image from the given source, which may
   also include a format prefix (such as "rgb:file.rgb") or indicate a special
   builtin image object (such as "logo:" or "xc:white"); see ImageMagick(1)
   for details. Additional image properties may optionally be specified in the
   INFO argument, which has the same form as for create_image. (Note that for
   raw image data you will have to specify at least the image type in the
   filename -- e.g., "rgb:file.rgb" for raw RGB data -- and the dimensions of
   the image in the INFO tuple.)

   The write_image function writes the given image to the given target,
   designated by a name in the same syntax as for read_image. */

public extern create_image INFO, clone_image IMG;
public extern read_image NAME INFO, write_image NAME IMG;

/* Retrieve the attributes of an image. The image_info function returns the
   attributes of an image encoded as an INFO tuple of the form (WIDTH, HEIGHT,
   DEPTH, MATTE). */

public extern image_info IMG;

/* Convenience functions to retrieve the different components of an image
   info structure. */

public image_width IMG, image_height IMG, image_depth IMG, image_matte IMG;

image_width IMG		= W where (W,H,D,M) = image_info IMG;
image_height IMG	= H where (W,H,D,M) = image_info IMG;
image_depth IMG		= D where (W,H,D,M) = image_info IMG;
image_matte IMG		= M where (W,H,D,M) = image_info IMG;

/* Retrieve various other useful information about an image. The count_image_
   colors function determines the number of unique colors in an image. The
   remaining functions check whether the image belongs to one of the following
   image classes: gray (all RGB intensities equal), monochrome (all RGB
   intensities equal *and* each RGB value is either zero or max), opaque (all
   alpha values max), and palette (pseudo class image with at most 256 unique
   colors). */

public extern count_image_colors IMG;
public extern is_gray_image IMG, is_monochrome_image IMG, is_opaque_image IMG,
  is_palette_image IMG;

/* Get and set the pixel data of an image. The affected area of the image is
   specified by its origin P = (X,Y) and dimension DIM = (W,H). All pixel data
   is encoded as a byte string of 16 bit RGBA values, as discussed above. */

public extern get_image_pixels IMG P DIM;
public extern set_image_pixels IMG P DIM DATA;

/* Get and set the alpha channel of an image. The data is encoded as a byte
   string of 16 bit alpha values. These functions can be used to transfer the
   alpha plane of an image to the alpha buffer of a GGI visual and vice
   versa. */

public extern get_image_alpha IMG P DIM;
public extern set_image_alpha IMG P DIM DATA;