/* $Id: ggi.c,v 1.21 2004/10/01 03:55:25 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 <stdlib.h>
#endif

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

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

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

#if defined(HAVE_FT_INIT_FREETYPE) && !defined(HAVE_FT2)
#define HAVE_FT2 1
#endif

#include <libq.h>
#include <ggi/ggi.h>
#include <ggi/gii.h>
#ifdef HAVE_FT2
#include <ft2build.h>
#include FT_FREETYPE_H
#include FT_GLYPH_H
#if FREETYPE_MAJOR != 2
#error "This module needs FreeType2, sorry."
#endif
#if FREETYPE_MINOR < 1
#define FT_KERNING_DEFAULT ft_kerning_default
#define FT_RENDER_MODE_NORMAL ft_render_mode_normal
#define FT_RENDER_MODE_MONO ft_render_mode_mono
#endif
#endif

#include "ggilib.h"

MODULE(ggi)

static int init = 0, ft2init = 0;
#ifdef HAVE_FT2
static FT_Library library;
#endif

INIT(ggi)
{
  init = ggiInit() == 0;
  if (init) giiMTInit();
#ifdef HAVE_FT2
  if (init && !FT_Init_FreeType(&library))
    ft2init = 1;
#endif
}

FINI(ggi)
{
  if (init) {
    ggiExit();
#ifdef HAVE_FT2
    if (ft2init)
      FT_Done_FreeType(library);
#endif
  }
}

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

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

#ifndef HAVE_FT2
#define FT_FACE_FLAG_SCALABLE 0
#define FT_FACE_FLAG_FIXED_SIZES 0
#define FT_FACE_FLAG_FIXED_WIDTH 0
#define FT_FACE_FLAG_SFNT 0
#define FT_FACE_FLAG_HORIZONTAL 0
#define FT_FACE_FLAG_VERTICAL 0
#define FT_FACE_FLAG_KERNING 0
#define FT_FACE_FLAG_FAST_GLYPHS 0
#define FT_FACE_FLAG_MULTIPLE_MASTERS 0
#define FT_FACE_FLAG_GLYPH_NAMES 0
#define FT_FACE_FLAG_EXTERNAL_STREAM 0
#define FT_STYLE_FLAG_ITALIC 0
#define FT_STYLE_FLAG_BOLD 0
#endif

FUNCTION(ggi,ggi_vars,argc,argv)
{
  if (argc != 0) return __FAIL;
  return mktuplel
    (94,
     mkuint(GGIFLAG_ASYNC),
     /* events */
     mkuint(evNothing), mkuint(evCommand), mkuint(evInformation),
     mkuint(evExpose), mkuint(evKeyPress), mkuint(evKeyRelease),
     mkuint(evKeyRepeat),
     mkuint(evPtrRelative), mkuint(evPtrAbsolute), mkuint(evPtrButtonPress),
     mkuint(evPtrButtonRelease), mkuint(evValRelative), mkuint(evValAbsolute),
     /* event masks */
     mkuint(emCommand), mkuint(emInformation), mkuint(emExpose),
     mkuint(emKeyPress), mkuint(emKeyRelease), mkuint(emKeyRepeat),
     mkuint(emKey),
     mkuint(emPtrRelative), mkuint(emPtrAbsolute), mkuint(emPtrButtonPress),
     mkuint(emPtrButtonRelease), mkuint(emPtrMove), mkuint(emPtrButton),
     mkuint(emPointer),
     mkuint(emValRelative), mkuint(emValAbsolute), mkuint(emValuator),
     mkuint(emAll), mkuint(emNothing),
     /* special event origins and targets */
     mkuint(GII_EV_ORIGIN_NONE), mkuint(GII_EV_ORIGIN_SENDEVENT),
     mkuint(GII_EV_TARGET_QUEUE), mkuint(GII_EV_TARGET_ALL),
     /* modifiers */
     mkuint(GII_MOD_SHIFT), mkuint(GII_MOD_CTRL), mkuint(GII_MOD_ALT),
     mkuint(GII_MOD_META),
     mkuint(GII_MOD_SUPER), mkuint(GII_MOD_HYPER), mkuint(GII_MOD_ALTGR),
     mkuint(GII_MOD_CAPS), mkuint(GII_MOD_NUM),
     mkuint(GII_MOD_SCROLL),
     /* mouse buttons */
     mkuint(GII_PBUTTON_LEFT), mkuint(GII_PBUTTON_MIDDLE),
     mkuint(GII_PBUTTON_RIGHT),
     /* command codes and flags */
     mkuint(GII_CMDCODE_EVENTLOST), mkuint(GII_CMDCODE_PREFER_ABSPTR),
     mkuint(GII_CMDCODE_PREFER_RELPTR), mkuint(GII_CMDCODE_GETDEVINFO),
     mkuint(GII_CMDCODE_GETVALINFO),
     mkuint(GII_CMDFLAG_NODATA), mkuint(GII_CMDFLAG_PRIVATE),
     mkuint(GII_CMDFLAG_EXTERNAL),
     /* valuator types */
     mkuint(GII_PT_UNKNOWN), mkuint(GII_PT_TIME), mkuint(GII_PT_FREQUENCY),
     mkuint(GII_PT_LENGTH),
     mkuint(GII_PT_VELOCITY), mkuint(GII_PT_ACCELERATION),
     mkuint(GII_PT_ANGLE), mkuint(GII_PT_ANGVELOCITY),
     mkuint(GII_PT_ANGACCELERATION), mkuint(GII_PT_AREA),
     mkuint(GII_PT_VOLUME), mkuint(GII_PT_MASS),
     mkuint(GII_PT_FORCE), mkuint(GII_PT_PRESSURE), mkuint(GII_PT_TORQUE),
     mkuint(GII_PT_ENERGY),
     mkuint(GII_PT_POWER), mkuint(GII_PT_TEMPERATURE), mkuint(GII_PT_CURRENT),
     mkuint(GII_PT_VOLTAGE),
     mkuint(GII_PT_RESISTANCE), mkuint(GII_PT_CAPACITY),
     mkuint(GII_PT_INDUCTIVITY),
     /* font properties */
     mkuint(FT_FACE_FLAG_SCALABLE),
     mkuint(FT_FACE_FLAG_FIXED_SIZES),
     mkuint(FT_FACE_FLAG_FIXED_WIDTH),
     mkuint(FT_FACE_FLAG_SFNT),
     mkuint(FT_FACE_FLAG_HORIZONTAL),
     mkuint(FT_FACE_FLAG_VERTICAL),
     mkuint(FT_FACE_FLAG_KERNING),
     mkuint(FT_FACE_FLAG_FAST_GLYPHS),
     mkuint(FT_FACE_FLAG_MULTIPLE_MASTERS),
     mkuint(FT_FACE_FLAG_GLYPH_NAMES),
     mkuint(FT_FACE_FLAG_EXTERNAL_STREAM),
     mkuint(FT_STYLE_FLAG_ITALIC),
     mkuint(FT_STYLE_FLAG_BOLD));
}

/* visual type */

typedef struct {
  /* public fields; make sure these come first, some external modules depend
     on it! */
  ggi_visual_t vis;
  void *abuf;
  unsigned char asz;
  unsigned short afg, abg;
  int stride, lines;
  /* private stuff */
#ifdef HAVE_FT2
  FT_Face face;
  FT_Matrix *matrix;
  FT_Vector *vect;
  unsigned char aa;
#endif
} visual_t;

/* check whether graphic mode has been set on a visual */

static inline int vis_check(ggi_visual_t vis)
{
  int w, h;
  return !ggiGetCharSize(vis, &w, &h);
}

/* FIXME: Here we assume that ggi_color already has the proper storage
   layout. */

/* parse pixel value to color */

static inline int iscolor(expr x, ggi_color **c)
{
  bstr_t *m;
  if (isobj(x, type(ByteStr), (void**)&m) && m->size == sizeof(ggi_color)) {
    *c = (ggi_color*)m->v;
    return 1;
  } else
    return 0;
}

/* parse pixel byte string to color sequence */

static inline int iscolors(expr x, ggi_color **c, int *n)
{
  bstr_t *m;
  if (isobj(x, type(ByteStr), (void**)&m) && m->size%8 == 0) {
    *c = (ggi_color*)m->v;
    *n = m->size/sizeof(ggi_color);
    return 1;
  } else
    return 0;
}

/* create pixel value from color */

static inline expr mkcolor(ggi_color *c)
{
  bstr_t *m;
  ggi_color *v;
  if (!(m = malloc(sizeof(bstr_t)))) return __ERROR;
  if (!(m->v = malloc(sizeof(ggi_color)))) { free(m); return __ERROR; }
  v = (ggi_color*)m->v;
  *v = *c;
  m->size = sizeof(ggi_color);
  return mkobj(type(ByteStr), m);
}

/* create a pixel byte string from a sequence of color values (reuse the color
   buffer for efficiency) */

static inline expr *mkcolors(ggi_color *c, int n)
{
  bstr_t *m;
  if (!(m = malloc(sizeof(bstr_t)))) return __ERROR;
  m->size = n*sizeof(ggi_color);
  m->v = (char*)c;
  return mkobj(type(ByteStr), m);
}

/* parse pixel value to pixel and alpha */

static inline int ispixel(expr x, ggi_visual_t vis, ggi_pixel *pixel,
			  unsigned short *alpha)
{
  ggi_color *c;
  if (vis_check(vis) && iscolor(x, &c)) {
    *pixel = ggiMapColor(vis, c);
    *alpha = c->a;
    return 1;
  } else
    return 0;
}

/* create pixel value from pixel and alpha */

static inline expr mkpixel(ggi_visual_t vis, ggi_pixel pixel,
			   unsigned short alpha)
{
  ggi_color c;
  if (ggiUnmapPixel(vis, pixel, &c)) return __FAIL;
  c.a = alpha;
  return mkcolor(&c);
}

/* calculate the size of a pixel pack */

static inline int pack_size(ggi_visual_t vis, int n)
{
  int bpp, r;
  ggi_mode m;
  if (ggiGetMode(vis, &m))
    return -1;
  bpp = GT_SIZE(m.graphtype);
  if (n > INT_MAX / bpp)
    return -1;
  r = ((bpp*n)%8>0)?1:0;
  return (bpp*n)/8+r;
}

DESTRUCTOR(ggi,GGIVisual,ptr)
{
  visual_t *v = (visual_t*)ptr;
  if (v->vis) {
    if (v->abuf) free(v->abuf);
#ifdef HAVE_FT2
    if (v->face) FT_Done_Face(v->face);
    if (v->matrix) free(v->matrix);
    if (v->vect) free(v->vect);
#endif
    ggiClose(v->vis);
  }
  free(v);
}

FUNCTION(ggi,ggi_open,argc,argv)
{
  char *dpy = NULL;
  if (init && argc == 1 && (isstr(argv[0], &dpy) || isvoid(argv[0]))) {
    visual_t *v = malloc(sizeof(visual_t));
    if (!v)
      return __ERROR;
    else if ((v->vis = ggiOpen(dpy, NULL))) {
      v->abuf = NULL; v->asz = 0; v->afg = v->abg = 0;
      v->stride = v->lines = 0;
#ifdef HAVE_FT2
      v->face = NULL;
      v->matrix = NULL;
      v->vect = NULL;
      v->aa = 1;
#endif
      return mkobj(type(GGIVisual), v);
    } else {
      free(v);
      return __FAIL;
    }
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_close,argc,argv)
{
  visual_t *v;
  if (init && argc == 1 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis) {
    if (v->abuf) free(v->abuf);
#ifdef HAVE_FT2
    if (v->face) FT_Done_Face(v->face);
    if (v->matrix) free(v->matrix);
    if (v->vect) free(v->vect);
    v->face = NULL;
    v->matrix = NULL;
    v->vect = NULL;
    v->aa = 1;
#endif
    ggiClose(v->vis);
    v->abuf = NULL; v->asz = 0; v->afg = v->abg = 0;
    v->stride = v->lines = 0;
    v->vis = NULL;
    return mkvoid;
  } else
    return __FAIL;
}

static int parse_mode(char *mode, ggi_mode *m,
		      unsigned *adepth)
{
  char buf[1000], *p, *q, *r = NULL;
  *adepth = 0;
  strcpy(buf, mode);
  p = strtok(buf, ".");
  while (p) {
    if (r > buf) r[-1] = '.';
    if (*p != 'A') {
      r = p;
      p = strtok(NULL, ".");
    } else {
      if (*p == 'A') {
	long val = strtol(p+1, &q, 10);
	if (!*q && val > 0 && val <= 32)
	  *adepth = (unsigned)val;
	else
	  return -1;
	p = strtok(NULL, ".");
      }
      if (p) return -1;
    }
  }
  if (!r)
    *buf = 0;
  else if (r > buf)
    r[-1] = '.';
  return ggiParseMode(buf, m);
}

static int print_mode(char *buf, ggi_mode *m,
		      unsigned adepth)
{
  int ret = ggiSPrintMode(buf, m);
  if (ret >= 0) {
    int l = strlen(buf);
    if (adepth)
      sprintf(buf+l, "%sA%u", l?".":"", adepth);
  }
  return ret;
}

FUNCTION(ggi,ggi_check_mode,argc,argv)
{
  visual_t *v;
  char *mode = "";
  ggi_mode m;
  unsigned adepth;
  if (init && argc == 2 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis &&
      (isstr(argv[1], &mode) || isvoid(argv[1])) &&
      !parse_mode(mode, &m, &adepth)) {
    char buf[1000];
    ggiCheckMode(v->vis, &m);
    if (adepth != 0 && adepth != 8 && adepth != 16) {
      adepth = (adepth+7)/8*8;
      if (adepth > 16) adepth = 16;
    }
    if (print_mode(buf, &m, adepth) >= 0)
      return mkstr(strdup(buf));
    else
      return __FAIL;
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_set_mode,argc,argv)
{
  visual_t *v;
  char *mode = "";
  ggi_mode m;
  unsigned adepth;
  int ret;
  if (init && argc == 2 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis &&
      (isstr(argv[1], &mode) || isvoid(argv[1])) &&
      !parse_mode(mode, &m, &adepth) &&
      (adepth == 0 || adepth == 8 || adepth == 16)) {
    if (ggiSetMode(v->vis, &m))
      return __FAIL;
    else {
      int size;
      void *abuf = NULL;
      ggiGetMode(v->vis, &m);
      size = m.virt.x*m.virt.y*(adepth/8);
      if (size > 0)
	abuf = malloc(size);
      if (size < 0 || size > 0 && !abuf)
	return __ERROR;
      if (v->abuf) free(v->abuf);
      v->asz = adepth/8;
      v->abuf = abuf;
      v->afg = v->abg = (adepth==0)?0:(adepth==8)?0xff:0xffff;
      if (v->abuf) memset(v->abuf, 0xff, size);
      v->stride = m.virt.x;
      v->lines = m.virt.y;
      return mkvoid;
    }
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_get_mode,argc,argv)
{
  visual_t *v;
  if (init && argc == 1 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis) {
    ggi_mode m;
    char buf[1000];
    if (ggiGetMode(v->vis, &m))
      return __FAIL;
    else if (print_mode(buf, &m, v->asz*8) >= 0)
      return mkstr(strdup(buf));
    else
      return __FAIL;
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_set_flags,argc,argv)
{
  visual_t *v;
  unsigned long flags;
  if (init && argc == 2 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && isuint(argv[1], &flags)) {
    if (ggiSetFlags(v->vis, (ggi_flags)flags))
      return __FAIL;
    else
      return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_get_flags,argc,argv)
{
  visual_t *v;
  if (init && argc == 1 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis)
    return mkuint((unsigned long)ggiGetFlags(v->vis));
  else
    return __FAIL;
}

FUNCTION(ggi,ggi_set_display_frame,argc,argv)
{
  visual_t *v;
  long frame;
  if (init && argc == 2 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && isint(argv[1], &frame)) {
    if (ggiSetDisplayFrame(v->vis, (int)frame))
      return __FAIL;
    else
      return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_get_display_frame,argc,argv)
{
  visual_t *v;
  if (init && argc == 1 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis)
    return mkint((long)ggiGetDisplayFrame(v->vis));
  else
    return __FAIL;
}

FUNCTION(ggi,ggi_set_read_frame,argc,argv)
{
  visual_t *v;
  long frame;
  if (init && argc == 2 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && isint(argv[1], &frame)) {
    if (ggiSetReadFrame(v->vis, (int)frame))
      return __FAIL;
    else
      return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_get_read_frame,argc,argv)
{
  visual_t *v;
  if (init && argc == 1 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis)
    return mkint((long)ggiGetReadFrame(v->vis));
  else
    return __FAIL;
}

FUNCTION(ggi,ggi_set_write_frame,argc,argv)
{
  visual_t *v;
  long frame;
  if (init && argc == 2 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && isint(argv[1], &frame)) {
    if (ggiSetWriteFrame(v->vis, (int)frame))
      return __FAIL;
    else
      return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_get_write_frame,argc,argv)
{
  visual_t *v;
  if (init && argc == 1 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis)
    return mkint((long)ggiGetWriteFrame(v->vis));
  else
    return __FAIL;
}

FUNCTION(ggi,ggi_set_clip,argc,argv)
{
  visual_t *v;
  expr *xv;
  int n;
  long x1, y1, x2, y2;
  if (init && argc == 2 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && istuple(argv[1], &n, &xv) && n == 4 &&
      isint(xv[0], &x1) && isint(xv[1], &y1) &&
      isint(xv[2], &x2) && isint(xv[3], &y2)) {
    if (ggiSetGCClipping(v->vis, (int)x1, (int)y1, (int)x2, (int)y2))
      return __FAIL;
    else
      return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_get_clip,argc,argv)
{
  visual_t *v;
  int x1, y1, x2, y2;
  if (init && argc == 1 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && !ggiGetGCClipping(v->vis, &x1, &y1, &x2, &y2))
    return mktuplel(4, mkint((long)x1), mkint((long)y1),
		    mkint((long)x2), mkint((long)y2));
  else
    return __FAIL;
}

FUNCTION(ggi,ggi_set_orig,argc,argv)
{
  visual_t *v;
  expr *xv;
  int n;
  long x, y;
  if (init && argc == 2 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && istuple(argv[1], &n, &xv) && n == 2 &&
      isint(xv[0], &x) && isint(xv[1], &y)) {
    if (ggiSetOrigin(v->vis, (int)x, (int)y))
      return __FAIL;
    else
      return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_get_orig,argc,argv)
{
  visual_t *v;
  int x, y;
  if (init && argc == 1 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && !ggiGetOrigin(v->vis, &x, &y))
    return mktuplel(2, mkint((long)x), mkint((long)y));
  else
    return __FAIL;
}

FUNCTION(ggi,ggi_set_foreground,argc,argv)
{
  visual_t *v;
  ggi_pixel pixel;
  unsigned short alpha;
  if (init && argc == 2 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && ispixel(argv[1], v->vis, &pixel, &alpha)) {
    if (ggiSetGCForeground(v->vis, pixel))
      return __FAIL;
    if (v->abuf)
      v->afg = (v->asz == 1)?(alpha/0x101):alpha;
    return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_get_foreground,argc,argv)
{
  visual_t *v;
  ggi_pixel pixel;
  unsigned short alpha = 0xffff;
  if (init && argc == 1 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && !ggiGetGCForeground(v->vis, &pixel)) {
    if (v->abuf)
      alpha = (v->asz == 1)?(v->afg*0x101):v->afg;
    return mkpixel(v->vis, pixel, alpha);
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_set_background,argc,argv)
{
  visual_t *v;
  ggi_pixel pixel;
  unsigned short alpha;
  if (init && argc == 2 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && ispixel(argv[1], v->vis, &pixel, &alpha)) {
    if (ggiSetGCBackground(v->vis, pixel))
      return __FAIL;
    if (v->abuf)
      v->abg = (v->asz == 1)?(alpha/0x101):alpha;
    return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_get_background,argc,argv)
{
  visual_t *v;
  ggi_pixel pixel;
  unsigned short alpha = 0xffff;
  if (init && argc == 1 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && !ggiGetGCBackground(v->vis, &pixel)) {
    if (v->abuf)
      alpha = (v->asz == 1)?(v->abg*0x101):v->abg;
    return mkpixel(v->vis, pixel, alpha);
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_pixel,argc,argv)
{
  unsigned long r, g, b, a = 0xffff;
  expr *xv;
  int n;
  if (init && argc == 1)
    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) {
      ggi_color c;
      c.r = (unsigned)r; c.g = (unsigned)g; c.b = (unsigned)b;
      c.a = (unsigned)a;
      return mkcolor(&c);
    } else {
      /* if we come here then the argument is in list form */
      ggi_color *c;
      expr x, hd, tl;
      int i;
      for (i = 0, x = argv[0]; iscons(x, &hd, &tl); x = tl) {
	a = 0xffff;
	if (i >= INT_MAX)
	  return __ERROR;
	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)
	  i++;
	else
	  return __FAIL;
      }
      if (!isnil(x)) return __FAIL;
      if (i == 0)
	c = NULL;
      else {
	if (!(c = malloc(i*sizeof(ggi_color)))) return __ERROR;
	for (i = 0, x = argv[0]; iscons(x, &hd, &tl); x = tl) {
	  a = 0xffff;
	  istuple(hd, &n, &xv) &&
	    isuint(xv[0], &r) && isuint(xv[1], &g) && isuint(xv[2], &b) &&
	    (n == 3 || isuint(xv[3], &a));
	  c[i].r = r; c[i].g = g; c[i].b = b; c[i].a = a;
	  i++;
	}
      }
      return mkcolors(c, i);
    }
  else
    return __FAIL;
}

FUNCTION(ggi,ggi_color,argc,argv)
{
  bstr_t m;
  ggi_color *c;
  int i, n;
  if (init && argc == 1)
    if (iscolor(argv[0], &c))
      return mktuplel(4, mkuint((unsigned long)c->r),
		      mkuint((unsigned long)c->g),
		      mkuint((unsigned long)c->b),
		      mkuint((unsigned long)c->a));
    else if (iscolors(argv[0], &c, &n)) {
      expr x = mknil;
      for (i = n-1; x && i >= 0; i--)
	x = mkcons(mktuplel(4, mkuint((unsigned long)c[i].r),
			    mkuint((unsigned long)c[i].g),
			    mkuint((unsigned long)c[i].b),
			    mkuint((unsigned long)c[i].a)),
		   x);
      return x;
    }
  else
    return __FAIL;
}

FUNCTION(ggi,ggi_set_default_font,argc,argv)
{
  visual_t *v;
  if (init && argc == 1 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis) {
#ifdef HAVE_FT2
    if (v->face) FT_Done_Face(v->face);
    v->face = NULL;
#endif
    return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_set_font,argc,argv)
{
#ifdef HAVE_FT2
  visual_t *v;
  char *name;
  long index;
  if (init && ft2init && argc == 3 &&
      isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && isstr(argv[1], &name) && isint(argv[2], &index)) {
    FT_Face face;
    if (FT_New_Face(library, name, index, &face))
      return __FAIL;
    if (v->face) FT_Done_Face(v->face);
    if (v->matrix) free(v->matrix);
    if (v->vect) free(v->vect);
    v->face = face;
    v->matrix = NULL;
    v->vect = NULL;
    v->aa = 1;
    return mkvoid;
  } else
#endif
    return __FAIL;
}

FUNCTION(ggi,ggi_set_font_metrics,argc,argv)
{
#ifdef HAVE_FT2
  visual_t *v;
  char *name;
  if (init && argc == 2 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && v->face && isstr(argv[1], &name) &&
      !FT_Attach_File(v->face, name))
    return mkvoid;
  else
#endif
    return __FAIL;
}

#ifdef HAVE_FT2

static int iscoord(expr x, FT_F26Dot6 *size)
{
  long ival;
  double fval;
  /* parse a 26.6 pixel coordinate */
  if (isint(x, &ival)) {
    *size = ival*0x40;
    return 1;
  } else if (isfloat(x, &fval)) {
    ival = (int)(fval*64.0);
    *size = ival;
    return 1;
  } else
    return 0;
}

#endif

FUNCTION(ggi,ggi_set_char_size,argc,argv)
{
#ifdef HAVE_FT2
  visual_t *v;
  FT_F26Dot6 width, height;
  unsigned long horiz, vert;
  expr *xv;
  int n;
  if (init && argc == 3 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && v->face &&
      (istuple(argv[1], &n, &xv) && n == 2 &&
       iscoord(xv[0], &width) && iscoord(xv[0], &height) ||
       iscoord(argv[1], &width) && (height = width, 1)) &&
      (istuple(argv[2], &n, &xv) && n == 2 &&
       isuint(xv[0], &horiz) && isuint(xv[0], &vert) ||
       isuint(argv[2], &horiz) && (vert = horiz, 1)) &&
      !FT_Set_Char_Size(v->face, width, height, horiz, vert))
    return mkvoid;
  else
#endif
    return __FAIL;
}

FUNCTION(ggi,ggi_set_antialias,argc,argv)
{
#ifdef HAVE_FT2
  visual_t *v;
  if (init && argc == 2 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && v->face) {
    if (istrue(argv[1]))
      v->aa = 1;
    else if (isfalse(argv[1]))
      v->aa = 0;
    else
      return __FAIL;
    return mkvoid;
  } else
#endif
    return __FAIL;
}

FUNCTION(ggi,ggi_get_antialias,argc,argv)
{
#ifdef HAVE_FT2
  visual_t *v;
  if (init && argc == 1 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && v->face) {
    if (v->aa)
      return mktrue;
    else
      return mkfalse;
  } else
#endif
    return __FAIL;
}

FUNCTION(ggi,ggi_set_transform,argc,argv)
{
#ifdef HAVE_FT2
  visual_t *v;
  double x, y, xx, xy, yx, yy;
  expr *xv;
  int n;
  if (init && argc == 3 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && v->face &&
      istuple(argv[1], &n, &xv) && n == 2 &&
      (isfloat(xv[0], &x) || ismpz_float(xv[0], &x)) &&
      (isfloat(xv[1], &y) || ismpz_float(xv[1], &y)) &&
      istuple(argv[2], &n, &xv) && n == 4 &&
      (isfloat(xv[0], &xx) || ismpz_float(xv[0], &xx)) &&
      (isfloat(xv[1], &xy) || ismpz_float(xv[1], &xy)) &&
      (isfloat(xv[2], &yx) || ismpz_float(xv[2], &yx)) &&
      (isfloat(xv[3], &yy) || ismpz_float(xv[3], &yy))) {
    if (x == 0.0 && y == 0.0 &&
	xx == 1.0 && xy == 0.0 && yx == 0.0 && yy == 1.0) {
      /* identity transform: remove any existing transform from the visual */
      if (v->vect) free(v->vect);
      if (v->matrix) free(v->matrix);
      v->vect = NULL;
      v->matrix = NULL;
    } else {
      FT_Matrix *matrix = malloc(sizeof(FT_Matrix));
      FT_Vector *vect = malloc(sizeof(FT_Vector));
      if (!matrix || !vect) {
	if (matrix) free(matrix);
	if (vect) free(vect);
	return __ERROR;
      }
      vect->x = (FT_Pos)(x*0x40);
      vect->y = (FT_Pos)(y*0x40);
      matrix->xx = (FT_Fixed)(xx*0x10000L);
      matrix->xy = (FT_Fixed)(xy*0x10000L);
      matrix->yx = (FT_Fixed)(yx*0x10000L);
      matrix->yy = (FT_Fixed)(yy*0x10000L);
      if (v->vect) free(v->vect);
      if (v->matrix) free(v->matrix);
      v->vect = vect;
      v->matrix = matrix;
    }
    return mkvoid;
  } else
#endif
    return __FAIL;
}

FUNCTION(ggi,ggi_get_transform_vector,argc,argv)
{
#ifdef HAVE_FT2
  visual_t *v;
  if (init && argc == 1 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && v->face) {
    if (v->vect)
      return mktuplel(2, mkfloat(((double)v->vect->x)/0x40),
		      mkfloat(((double)v->vect->y)/0x40));
    else
      return mktuplel(2, mkfloat(0.0), mkfloat(0.0));
  } else
#endif
    return __FAIL;
}

FUNCTION(ggi,ggi_get_transform_matrix,argc,argv)
{
#ifdef HAVE_FT2
  visual_t *v;
  if (init && argc == 1 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && v->face) {
    if (v->matrix)
      return mktuplel(4, mkfloat(((double)v->matrix->xx)/0x10000L),
		      mkfloat(((double)v->matrix->xy)/0x10000L),
		      mkfloat(((double)v->matrix->yx)/0x10000L),
		      mkfloat(((double)v->matrix->yy)/0x10000L));
    else
      return mktuplel(4, mkfloat(1.0), mkfloat(0.0), mkfloat(0.0),
		      mkfloat(1.0));
  } else
#endif
    return __FAIL;
}

FUNCTION(ggi,ggi_get_font_info,argc,argv)
{
#ifdef HAVE_FT2
  visual_t *v;
  if (init && argc == 1 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && v->face) {
    expr *sizes = NULL;
    int i, n = v->face->num_fixed_sizes;
    if (n > 0 && !(sizes = malloc(n*sizeof(expr)))) return __ERROR;
    for (i = 0; i < n; i++)
      sizes[i] = mktuplel(2, mkint(v->face->available_sizes[i].width),
			  mkint(v->face->available_sizes[i].height));
    if (FT_IS_SCALABLE(v->face))
      return mktuplel(18, mkint(v->face->num_faces),
		      mkint(v->face->face_index),
		      mkuint(v->face->face_flags),
		      mkuint(v->face->style_flags),
		      mkstr(strdup(v->face->family_name)),
		      mkstr(strdup(v->face->style_name)),
		      mklistv(n, sizes),
		      mkuint(v->face->units_per_EM),
		      mkuint(v->face->size->metrics.x_ppem),
		      mkuint(v->face->size->metrics.y_ppem),
		      mktuplel(4, mkint(v->face->bbox.xMin),
			       mkint(v->face->bbox.xMax),
			       mkint(v->face->bbox.yMin),
			       mkint(v->face->bbox.yMax)),
		      mkint(v->face->ascender),
		      mkint(v->face->descender),
		      mkint(v->face->height),
		      mkint(v->face->max_advance_width),
		      mkint(v->face->max_advance_height),
		      mkint(v->face->underline_position),
		      mkint(v->face->underline_thickness));
    else
      return mktuplel(7, mkint(v->face->num_faces),
		      mkint(v->face->face_index),
		      mkuint(v->face->face_flags),
		      mkuint(v->face->style_flags),
		      mkstr(strdup(v->face->family_name)),
		      mkstr(strdup(v->face->style_name)),
		      mklistv(n, sizes));
  } else
#endif
    return __FAIL;
}

FUNCTION(ggi,ggi_clear,argc,argv)
{
  visual_t *v;
  ggi_pixel back, fore;
  if (init && argc == 1 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && !ggiGetGCBackground(v->vis, &back) &&
      !ggiGetGCForeground(v->vis, &fore)) {
    int ret;
    ggiSetGCForeground(v->vis, back);
    ret = !ggiFillscreen(v->vis) && (!v->abuf || !clear_alpha_buffer(v));
    ggiSetGCForeground(v->vis, fore);
    if (ret)
      return mkvoid;
    else
      return __FAIL;
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_clear_alpha,argc,argv)
{
  visual_t *v;
  if (init && argc == 1 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && v->abuf && !clear_alpha_buffer(v))
    return mkvoid;
  else
    return __FAIL;
}

FUNCTION(ggi,ggi_draw_pixel,argc,argv)
{
  visual_t *v;
  expr *xv;
  int n;
  long x, y;
  if (init && argc == 2 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && istuple(argv[1], &n, &xv) && n == 2 &&
      isint(xv[0], &x) && isint(xv[1], &y)) {
    if ((n = draw_box(v, x, y, 1, 1)) < 0)
      return __ERROR;
    else if (n == 0)
      return __FAIL;
    else
      return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_draw_hline,argc,argv)
{
  visual_t *v;
  expr *xv;
  int n;
  long x, y, w;
  if (init && argc == 3 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && istuple(argv[1], &n, &xv) && n == 2 &&
      isint(xv[0], &x) && isint(xv[1], &y) &&
      isint(argv[2], &w)) {
    if ((n = draw_box(v, x, y, w, 1)) < 0)
      return __ERROR;
    else if (n == 0)
      return __FAIL;
    else
      return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_draw_vline,argc,argv)
{
  visual_t *v;
  expr *xv;
  int n;
  long x, y, h;
  if (init && argc == 3 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && istuple(argv[1], &n, &xv) && n == 2 &&
      isint(xv[0], &x) && isint(xv[1], &y) &&
      isint(argv[2], &h)) {
    if ((n = draw_box(v, x, y, 1, h)) < 0)
      return __ERROR;
    else if (n == 0)
      return __FAIL;
    else
      return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_draw_line,argc,argv)
{
  visual_t *v;
  expr *xv;
  int n;
  long x1, y1, x2, y2;
  if (init && argc == 3 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && istuple(argv[1], &n, &xv) && n == 2 &&
      isint(xv[0], &x1) && isint(xv[1], &y1) &&
      istuple(argv[2], &n, &xv) && n == 2 &&
      isint(xv[0], &x2) && isint(xv[1], &y2) &&
      !draw_line(v, (int)x1, (int)y1, (int)x2, (int)y2))
    return mkvoid;
  else
    return __FAIL;
}

FUNCTION(ggi,ggi_draw_box,argc,argv)
{
  visual_t *v;
  expr *xv;
  int n;
  long x, y, w, h;
  if (init && argc == 3 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && istuple(argv[1], &n, &xv) && n == 2 &&
      isint(xv[0], &x) && isint(xv[1], &y) &&
      istuple(argv[2], &n, &xv) && n == 2 &&
      isint(xv[0], &w) && isint(xv[1], &h)) {
    if ((n = draw_box(v, x, y, w, h)) < 0)
      return __ERROR;
    else if (n == 0)
      return __FAIL;
    else
      return mkvoid;
  } else
    return __FAIL;
}

#ifdef HAVE_FT2

/* render characters using FreeType; this stuff is mostly pilfered straight
   from the FT2 Turtorial, Part II */

/* struct used to keep glyph info */

typedef struct TGlyph_ {
  FT_UInt index; /* glyph index */
  FT_Vector pos; /* glyph origin on the baseline */
  FT_Glyph image; /* glyph image */
} TGlyph, *PGlyph;

/* the renderer */

static int render(visual_t *v, char *s, int x, int y)
{
  ggi_visual_t vis = v->vis;
  FT_Face face = v->face;
  FT_Bool use_kerning;
  FT_UInt previous;
  int pen_x, pen_y, wd, ht, dim, n, m, l = strlen(s), error;
  PGlyph glyphs = l?malloc(l*sizeof(TGlyph)):NULL; /* glyphs table */
  PGlyph glyph; /* current glyph in table */
  FT_BBox bbox; /* bounding box */
  FT_Vector pen;
  ggi_color fgcol, bgcol, *col = NULL;
  ggi_pixel pix;
  unsigned fgalpha = 0xffff, bgalpha = 0xffff;

  if (!glyphs) return (l==0);

  /* load the glyph sequence */

  /* NOTE: we assume a left-to-right script like Latin here */

  pen_x = 0;
  pen_y = 0;

  use_kerning = FT_HAS_KERNING(face);
  previous = 0;

  glyph = glyphs;
  for (n = 0; n < l; n++) {
    glyph->index = FT_Get_Char_Index(face, s[n]);
    /* apply kerning if available */
    if (use_kerning && previous && glyph->index) {
      FT_Vector delta;
      FT_Get_Kerning(face, previous, glyph->index, FT_KERNING_DEFAULT,
		     &delta);
      pen_x += delta.x;
    }
    /* store current pen position */
    glyph->pos.x = pen_x;
    glyph->pos.y = pen_y;
    error = FT_Load_Glyph(face, glyph->index, FT_LOAD_DEFAULT);
    if (error) continue;
    error = FT_Get_Glyph(face->glyph, &glyph->image);
    if (error) continue;
    /* translate the glyph image now */
    FT_Glyph_Transform(glyph->image, 0, &glyph->pos);
    pen_x += face->glyph->advance.x;
    previous = glyph->index;
    /* increment number of glyphs */
    glyph++;
  }
  /* count number of glyphs loaded */
  m = glyph - glyphs;

  /* transform glyphs */

  if (v->vect || v->matrix)
    for (n = 0; n < m; n++)
      FT_Glyph_Transform(glyphs[n].image, v->matrix, v->vect);

  /* compute the bounding box */

  bbox.xMin = bbox.yMin = 32000;
  bbox.xMax = bbox.yMax = -32000;
  for (n = 0; n < m; n++) {
    FT_BBox glyph_bbox;
    FT_Glyph_Get_CBox(glyphs[n].image, ft_glyph_bbox_pixels, &glyph_bbox);
    if (glyph_bbox.xMin < bbox.xMin) bbox.xMin = glyph_bbox.xMin;
    if (glyph_bbox.yMin < bbox.yMin) bbox.yMin = glyph_bbox.yMin;
    if (glyph_bbox.xMax > bbox.xMax) bbox.xMax = glyph_bbox.xMax;
    if (glyph_bbox.yMax > bbox.yMax) bbox.yMax = glyph_bbox.yMax;
  }
  if ( bbox.xMin > bbox.xMax ) {
    bbox.xMin = 0; bbox.yMin = 0; bbox.xMax = 0; bbox.yMax = 0;
  }

  /* now actually render the glyphs */

  /* compute string dimensions in integer pixels */
  wd = bbox.xMax - bbox.xMin;
  ht = bbox.yMax - bbox.yMin;
  dim = wd*ht;

  if (dim == 0) {
    free(glyphs);
    for (n = 0; n < m; n++)
      FT_Done_Glyph(glyphs[n].image);
    return 1;
  }

  if (v->abuf)
    if (v->asz == 1) {
      fgalpha = v->afg*0x101;
      bgalpha = v->abg*0x101;
    } else {
      fgalpha = v->afg;
      bgalpha = v->abg;
    }
  if (ggiGetGCForeground(vis, &pix) || ggiUnmapPixel(vis, pix, &fgcol))
    goto errout;
  fgcol.a = fgalpha;
  if (ggiGetGCBackground(vis, &pix) || ggiUnmapPixel(vis, pix, &bgcol))
    goto errout;
  bgcol.a = bgalpha;
  if (wd > INT_MAX/ht ||
      !(col = malloc(dim*sizeof(ggi_color))))
    goto errout;
  for (n = 0; n < dim; n++)
    col[n] = bgcol;

  pen.x = 0;
  pen.y = 0;
  for (n = 0; n < m; n++) {
    FT_Glyph image;
    image = glyphs[n].image;
    if (v->aa) {
      error = FT_Glyph_To_Bitmap(&image, FT_RENDER_MODE_NORMAL, &pen, 1);
      if (!error) {
	FT_BitmapGlyph bit = (FT_BitmapGlyph)image;
	FT_Bitmap *bitmap = &bit->bitmap;
	unsigned char *buf = bitmap->buffer, *bufp;
	int p, q, r, w = bitmap->width, h = bitmap->rows,
	  pitch = bitmap->pitch,
	  startx = bit->left - bbox.xMin, starty = bbox.yMax - bit->top;
	for (bufp = buf, r = starty*wd+startx, q = 0;  q < h;
	     bufp += pitch, r += wd, q++)
	  for (p = 0; p < w; p++) {
	    int i = r+p;
	    if (bufp[p]) {
	      /* blend fg with bg color -- this looks odd with some fg/bg
		 combinations, is there a better way to do this? */
	      col[i].r = (((long)fgcol.r)*bufp[p]+
			  ((long)bgcol.r)*(0xff-bufp[p]))/0xff;
	      col[i].g = (((long)fgcol.g)*bufp[p]+
			  ((long)bgcol.g)*(0xff-bufp[p]))/0xff;
	      col[i].b = (((long)fgcol.b)*bufp[p]+
			  ((long)bgcol.b)*(0xff-bufp[p]))/0xff;
	      col[i].a = (((long)fgcol.a)*bufp[p]+
			  ((long)bgcol.a)*(0xff-bufp[p]))/0xff;
	    }

	  }
	FT_Done_Glyph(image);
      }
    } else {
      error = FT_Glyph_To_Bitmap(&image, FT_RENDER_MODE_MONO, &pen, 1);
      if (!error) {
	FT_BitmapGlyph bit = (FT_BitmapGlyph)image;
	FT_Bitmap *bitmap = &bit->bitmap;
	unsigned char *buf = bitmap->buffer, *bufp;
	int p, q, r, w = bitmap->width, h = bitmap->rows,
	  pitch = bitmap->pitch,
	  startx = bit->left - bbox.xMin, starty = bbox.yMax - bit->top;
	for (bufp = buf, r = starty*wd+startx, q = 0;  q < h;
	     bufp += pitch, r += wd, q++)
	  for (p = 0; p < w; p++) {
	    int i = r+p;
	    int j = p>>3, k = 7-(p&7);
	    if (bufp[j] & (1<<k))
	      col[i] = fgcol;
	  }
	FT_Done_Glyph(image);
      }
    }
  }

  free(glyphs);

  /* blit the rendered string to the visual */

  if (!error)
    error = put_box(v, x, y, wd, ht, col) < 0;
  free(col);

  return !error;

 errout:
  if (col) free(col);
  for (n = 0; n < m; n++)
    FT_Done_Glyph(glyphs[n].image);
  free(glyphs);
  return 0;
}

/* compute the bounding box of a rendered string */

static int bbox(visual_t *v, char *s,
		int *xmin, int *xmax,
		int *ymin, int *ymax)
{
  ggi_visual_t vis = v->vis;
  FT_Face face = v->face;
  FT_Bool use_kerning;
  FT_UInt previous;
  int pen_x, pen_y, n, m, l = strlen(s), error;
  PGlyph glyphs = l?malloc(l*sizeof(TGlyph)):NULL; /* glyphs table */
  PGlyph glyph; /* current glyph in table */
  FT_BBox bbox; /* bounding box */

  *xmin = *xmax = *ymin = *ymax = 0;
  if (!glyphs) return (l==0);

  pen_x = 0;
  pen_y = 0;

  use_kerning = FT_HAS_KERNING(face);
  previous = 0;

  glyph = glyphs;
  for (n = 0; n < l; n++) {
    glyph->index = FT_Get_Char_Index(face, s[n]);
    if (use_kerning && previous && glyph->index) {
      FT_Vector delta;
      FT_Get_Kerning(face, previous, glyph->index, FT_KERNING_DEFAULT,
		     &delta);
      pen_x += delta.x;
    }
    glyph->pos.x = pen_x;
    glyph->pos.y = pen_y;
    error = FT_Load_Glyph(face, glyph->index, FT_LOAD_DEFAULT);
    if (error) continue;
    error = FT_Get_Glyph(face->glyph, &glyph->image);
    if (error) continue;
    FT_Glyph_Transform(glyph->image, 0, &glyph->pos);
    pen_x += face->glyph->advance.x;
    previous = glyph->index;
    glyph++;
  }
  m = glyph - glyphs;

  if (v->vect || v->matrix)
    for (n = 0; n < m; n++)
      FT_Glyph_Transform(glyphs[n].image, v->matrix, v->vect);

  bbox.xMin = bbox.yMin = 32000;
  bbox.xMax = bbox.yMax = -32000;
  for (n = 0; n < m; n++) {
    FT_BBox glyph_bbox;
    FT_Glyph_Get_CBox(glyphs[n].image, ft_glyph_bbox_pixels, &glyph_bbox);
    if (glyph_bbox.xMin < bbox.xMin) bbox.xMin = glyph_bbox.xMin;
    if (glyph_bbox.yMin < bbox.yMin) bbox.yMin = glyph_bbox.yMin;
    if (glyph_bbox.xMax > bbox.xMax) bbox.xMax = glyph_bbox.xMax;
    if (glyph_bbox.yMax > bbox.yMax) bbox.yMax = glyph_bbox.yMax;
  }
  if ( bbox.xMin > bbox.xMax ) {
    bbox.xMin = 0; bbox.yMin = 0; bbox.xMax = 0; bbox.yMax = 0;
  }
  for (n = 0; n < m; n++)
    FT_Done_Glyph(glyphs[n].image);
  free(glyphs);
  *xmin = bbox.xMin;
  *xmax = bbox.xMax;
  *ymin = bbox.yMin;
  *ymax = bbox.yMax;
  return 1;
}

#endif

FUNCTION(ggi,ggi_get_string_bbox,argc,argv)
{
  visual_t *v;
  int xmin, xmax, ymin, ymax;
  char *s;
  if (init && argc == 2 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && isstr(argv[1], &s))
#ifdef HAVE_FT2
    if (v->face)
      if (bbox(v, s, &xmin, &xmax, &ymin, &ymax))
	return mktuplel(4, mkint(xmin), mkint(xmax), mkint(ymin), mkint(ymax));
      else
	return __FAIL;
    else
#endif
      if (ggiGetCharSize(v->vis, &xmax, &ymax))
	return __FAIL;
      else
	return mktuplel(4, mkint(0), mkint(xmax*strlen(s)), mkint(0),
			mkint(ymax));
  else
    return __FAIL;
}

FUNCTION(ggi,ggi_puts,argc,argv)
{
  visual_t *v;
  expr *xv;
  int n;
  long x, y;
  char *s;
  if (init && argc == 3 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && istuple(argv[1], &n, &xv) && n == 2 &&
      isint(xv[0], &x) && isint(xv[1], &y) &&
      isstr(argv[2], &s)) {
#ifdef HAVE_FT2
    if (v->face)
      if (render(v, s, (int)x, (int)y))
	return mkvoid;
      else
	return __FAIL;
    else
#endif
      /* FIXME: alpha blending */
      if (ggiPuts(v->vis, (int)x, (int)y, s) >= 0)
	return mkvoid;
      else
	return __FAIL;
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_putc,argc,argv)
{
  visual_t *v;
  expr *xv;
  int n;
  long x, y;
  char *s;
  if (init && argc == 3 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && istuple(argv[1], &n, &xv) && n == 2 &&
      isint(xv[0], &x) && isint(xv[1], &y) &&
      isstr(argv[2], &s) && s[0] && !s[1]) {
#ifdef HAVE_FT2
    if (v->face)
      if (render(v, s, (int)x, (int)y))
	return mkvoid;
      else
	return __FAIL;
    else
#endif
      /* FIXME: alpha blending */
      if (!ggiPutc(v->vis, (int)x, (int)y, s[0]))
	return mkvoid;
      else
	return __FAIL;
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_get_pixel,argc,argv)
{
  visual_t *v;
  expr *xv;
  int n;
  long x, y;
  ggi_pixel pixel;
  unsigned alpha = 0xffff;
  if (init && argc == 2 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && istuple(argv[1], &n, &xv) && n == 2 &&
      isint(xv[0], &x) && isint(xv[1], &y)) {
    ggi_color *c;
    if ((n = get_box(v, x, y, 1, 1, &c)) < 0)
      return __ERROR;
    else if (n == 0)
      return __FAIL;
    else
      return mkcolors(c, n);
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_put_pixel,argc,argv)
{
  visual_t *v;
  expr *xv;
  int n;
  long x, y;
  ggi_color *c;
  if (init && argc == 3 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && istuple(argv[1], &n, &xv) && n == 2 &&
      isint(xv[0], &x) && isint(xv[1], &y) &&
      iscolor(argv[2], &c)) {
    if ((n = put_box(v, x, y, 1, 1, c)) < 0)
      return __ERROR;
    else if (n == 0)
      return __FAIL;
    else
      return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_get_hline,argc,argv)
{
  visual_t *v;
  expr *xv;
  int n;
  long x, y, w;
  if (init && argc == 3 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && vis_check(v->vis) && istuple(argv[1], &n, &xv) && n == 2 &&
      isint(xv[0], &x) && isint(xv[1], &y) &&
      isint(argv[2], &w)) {
    ggi_color *c;
    if (w <= 0)
      return mkcolors(NULL, 0);
    else if ((n = get_box(v, x, y, w, 1, &c)) < 0)
      return __ERROR;
    else if (n == 0)
      return __FAIL;
    else
      return mkcolors(c, n);
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_put_hline,argc,argv)
{
  visual_t *v;
  expr *xv;
  int n;
  long x, y, w;
  ggi_color *c;
  if (init && argc == 4 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && vis_check(v->vis) && istuple(argv[1], &n, &xv) && n == 2 &&
      isint(xv[0], &x) && isint(xv[1], &y) &&
      isint(argv[2], &w) &&
      iscolors(argv[3], &c, &n)) {
    if (w != n) return __FAIL;
    if (n <= 0) return mkvoid;
    if ((n = put_box(v, x, y, w, 1, c)) < 0)
      return __ERROR;
    else if (n == 0)
      return __FAIL;
    else
      return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_get_vline,argc,argv)
{
  visual_t *v;
  expr *xv;
  int n;
  long x, y, h;
  if (init && argc == 3 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && vis_check(v->vis) && istuple(argv[1], &n, &xv) && n == 2 &&
      isint(xv[0], &x) && isint(xv[1], &y) &&
      isint(argv[2], &h)) {
    ggi_color *c;
    if (h <= 0)
      return mkcolors(NULL, 0);
    else if ((n = get_box(v, x, y, 1, h, &c)) < 0)
      return __ERROR;
    else if (n == 0)
      return __FAIL;
    else
      return mkcolors(c, n);
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_put_vline,argc,argv)
{
  visual_t *v;
  expr *xv;
  int n;
  long x, y, h;
  ggi_color *c;
  if (init && argc == 4 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && vis_check(v->vis) && istuple(argv[1], &n, &xv) && n == 2 &&
      isint(xv[0], &x) && isint(xv[1], &y) &&
      isint(argv[2], &h) &&
      iscolors(argv[3], &c, &n)) {
    if (h != n) return __FAIL;
    if (n <= 0) return mkvoid;
    if ((n = put_box(v, x, y, 1, h, c)) < 0)
      return __ERROR;
    else if (n == 0)
      return __FAIL;
    else
      return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_get_box,argc,argv)
{
  visual_t *v;
  expr *xv;
  int n;
  long x, y, w, h;
  if (init && argc == 3 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && vis_check(v->vis) && istuple(argv[1], &n, &xv) && n == 2 &&
      isint(xv[0], &x) && isint(xv[1], &y) &&
      istuple(argv[2], &n, &xv) && n == 2 &&
      isint(xv[0], &w) && isint(xv[1], &h)) {
    ggi_color *c;
    if (w <= 0 || h <= 0)
      return mkcolors(NULL, 0);
    else if ((n = get_box(v, x, y, w, h, &c)) < 0)
      return __ERROR;
    else if (n == 0)
      return __FAIL;
    else
      return mkcolors(c, n);
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_put_box,argc,argv)
{
  visual_t *v;
  expr *xv;
  int n;
  long x, y, w, h;
  ggi_color *c;
  if (init && argc == 4 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && vis_check(v->vis) && istuple(argv[1], &n, &xv) && n == 2 &&
      isint(xv[0], &x) && isint(xv[1], &y) &&
      istuple(argv[2], &n, &xv) && n == 2 &&
      isint(xv[0], &w) && isint(xv[1], &h) &&
      iscolors(argv[3], &c, &n)) {
    if (w*h != n) return __FAIL;
    if (n <= 0) return mkvoid;
    if ((n = put_box(v, x, y, w, h, c)) < 0)
      return __ERROR;
    else if (n == 0)
      return __FAIL;
    else
      return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_flush,argc,argv)
{
  visual_t *v;
  if (init && argc == 1 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis) {
    ggiFlush(v->vis);
    return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_flush_region,argc,argv)
{
  visual_t *v;
  expr *xv;
  int n;
  long x, y, w, h;
  if (init && argc == 3 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && istuple(argv[1], &n, &xv) && n == 2 &&
      isint(xv[0], &x) && isint(xv[1], &y) &&
      istuple(argv[2], &n, &xv) && n == 2 &&
      isint(xv[0], &w) && isint(xv[1], &h)) {
    ggiFlushRegion(v->vis, (int)x, (int)y, (int)w, (int)h);
    return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_devices,argc,argv)
{
  visual_t *v;
  if (init && argc == 1 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis) {
    gii_input_t inp = ggiGetInput(v->vis);
    unsigned n, origin;
    gii_cmddata_getdevinfo info;
    expr *xv;
    for (n = 0; !giiQueryDeviceInfoByNumber(inp, n, &origin, &info); n++)
      ;
    if (!(xv = malloc(n*sizeof(expr)))) return __ERROR;
    for (n = 0; !giiQueryDeviceInfoByNumber(inp, n, &origin, &info); n++)
      xv[n] = mkuint(origin);
    return mklistv(n, xv);
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_device_info,argc,argv)
{
  visual_t *v;
  unsigned long origin;
  if (init && argc == 2 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && isuint(argv[1], &origin)) {
    gii_input_t inp = ggiGetInput(v->vis);
    gii_cmddata_getdevinfo info;
    if (giiQueryDeviceInfo(inp, origin, &info))
      return __FAIL;
    else
      return mktuplel(5, mkstr(strdup(info.longname)),
		      mkstr(strdup(info.shortname)),
		      mkuint((unsigned long)info.can_generate),
		      mkint((unsigned long)info.num_buttons),
		      mkint((unsigned long)info.num_axes));
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_val_info,argc,argv)
{
  visual_t *v;
  unsigned long origin, n;
  if (init && argc == 3 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && isuint(argv[1], &origin) && isuint(argv[2], &n)) {
    gii_input_t inp = ggiGetInput(v->vis);
    gii_cmddata_getvalinfo info;
    if (giiQueryValInfo(inp, origin, n, &info))
      return __FAIL;
    else
      return mktuplel(10, mkstr(strdup(info.longname)),
		      mkstr(strdup(info.shortname)),
		      mkint((long)info.range.min),
		      mkint((long)info.range.center),
		      mkint((long)info.range.max),
		      mkint((long)info.phystype),
		      mkint((long)info.SI_add),
		      mkint((long)info.SI_mul),
		      mkint((long)info.SI_div),
		      mkint((long)info.SI_shift));
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_set_mask,argc,argv)
{
  visual_t *v;
  unsigned long mask;
  if (init && argc == 2 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && isuint(argv[1], &mask)) {
    if (ggiSetEventMask(v->vis, (gii_event_mask)mask))
      return __FAIL;
    else
      return mkvoid;
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_get_mask,argc,argv)
{
  visual_t *v;
  if (init && argc == 1 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis)
    return mkuint((unsigned long)ggiGetEventMask(v->vis));
  else
    return __FAIL;
}

FUNCTION(ggi,ggi_poll,argc,argv)
{
  visual_t *v;
  unsigned long mask;
  if (init && argc == 3 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && isuint(argv[1], &mask)) {
    ggi_event_mask ret;
    struct timeval tv, *timeout = NULL;
    long ti;
    double tf;
    if (isint(argv[2], &ti))
      if (ti >= 0) {
	tv.tv_sec = ti;
	tv.tv_usec = 0;
	timeout = &tv;
      } else
	return __FAIL;
    else if (isfloat(argv[2], &tf))
      if (tf >= 0.0) {
	double ip, fp;
	if (tf > LONG_MAX) tf = LONG_MAX;
	fp = modf(tf, &ip);
	tv.tv_sec = (unsigned long)ip;
	tv.tv_usec = (unsigned long)(fp*1e6);
	timeout = &tv;
      } else
	return __FAIL;
    else if (!isvoid(argv[2]))
      return __FAIL;
    if ((ret = ggiEventPoll(v->vis, (gii_event_mask)mask, timeout)) >= 0)
      return mkuint((unsigned long)ret);
    else
      return __FAIL;
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_queued,argc,argv)
{
  visual_t *v;
  unsigned long mask;
  if (init && argc == 2 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && isuint(argv[1], &mask)) {
    if (ggiEventsQueued(v->vis, (gii_event_mask)mask))
      return mktrue;
    else
      return mkfalse;
  } else
    return __FAIL;
}

static expr decode_event(gii_event *e)
{
  gii_any_event *any = &e->any;
  expr x = mksym(sym(ggi_event));
  /* common parameters */
  x = mkapp(x, mkuint((unsigned long)any->type));
  x = mkapp(x, mkint((long)any->error));
  x = mkapp(x, mkuint((unsigned long)any->origin));
  x = mkapp(x, mkuint((unsigned long)any->target));
  x = mkapp(x, mkfloat(((double)any->time.tv_sec)+
		       ((double)any->time.tv_usec)*1e-6));
  /* specific parameters */
  switch (any->type) {
  case evKeyPress:
  case evKeyRelease:
  case evKeyRepeat:
    {
      gii_key_event *key = &e->key;
      x = mkapp(x, mktuplel(4, mkuint((unsigned long)key->modifiers),
			    mkuint((unsigned long)key->sym),
			    mkuint((unsigned long)key->label),
			    mkuint((unsigned long)key->button)));
    }
    break;
  case evPtrRelative:
  case evPtrAbsolute:
    {
      gii_pmove_event *pmove = &e->pmove;
      x = mkapp(x, mktuplel(4, mkint((long)pmove->x),
			    mkint((long)pmove->y),
			    mkint((long)pmove->z),
			    mkint((long)pmove->wheel)));
    }
    break;
  case evPtrButtonPress:
  case evPtrButtonRelease:
    {
      gii_pbutton_event *pbutton = &e->pbutton;
      x = mkapp(x, mkuint((unsigned long)pbutton->button));
    }
    break;
  case evCommand:
  case evInformation:
    {
      gii_cmd_event *cmd = &e->cmd;
      if (cmd->code & GII_CMDFLAG_NODATA)
	x = mkapp(x, mkuint((unsigned long)cmd->code));
      else {
	bstr_t *m = malloc(sizeof(bstr_t));
	if (!m || !(m->v = malloc(GII_CMD_DATA_MAX))) {
	  if (m) free(m);
	  dispose(x);
	  return __ERROR;
	}
	memcpy(m->v, cmd->data, GII_CMD_DATA_MAX);
	m->size = GII_CMD_DATA_MAX;
	x = mkapp(x, mktuplel(2, mkuint((unsigned long)cmd->code),
			      mkobj(type(ByteStr), (void*)m)));
      }
    }
    break;
  case evValRelative:
  case evValAbsolute:
    {
      gii_val_event *val = &e->val;
      expr *xv = malloc((val->count+1)*sizeof(expr));
      int i;
      if (!xv) {
	dispose(x);
	return __ERROR;
      }
      xv[0] = mkuint((unsigned long)val->first);
      for (i = 0; i < val->count; i++)
	xv[i+1] = mkint((long)val->value[i]);
      x = mkapp(x, mktuplev(val->count+1, xv));
    }
    break;
  case evExpose:
    {
      gii_expose_event *expose = &e->expose;
      x = mkapp(x, mktuplel(4, mkuint((unsigned long)expose->x),
			    mkuint((unsigned long)expose->y),
			    mkuint((unsigned long)expose->h),
			    mkuint((unsigned long)expose->w)));
    }
    break;
  default:
    x = mkapp(x, mkvoid);
    break;
  }
  return x;
}

FUNCTION(ggi,ggi_read,argc,argv)
{
  visual_t *v;
  unsigned long mask;
  if (init && argc == 2 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && isuint(argv[1], &mask)) {
    ggi_event e;
    if (ggiEventRead(v->vis, &e, (gii_event_mask)mask))
      return decode_event(&e);
    else
      return __FAIL;
  } else
    return __FAIL;
}

static int encode_event(expr x, gii_event *e)
{
  expr y, params, arg;
  unsigned long type, origin, target;
  long error;
  struct timeval tv;
  if (isapp(x, &y, &params))
    x = y;
  else
    return 0;
  if (isapp(x, &y, &arg)) {
    long ti;
    double tf;
    if (isint(arg, &ti))
      if (ti >= 0) {
	tv.tv_sec = ti;
	tv.tv_usec = 0;
      } else
	return 0;
    else if (isfloat(arg, &tf))
      if (tf >= 0.0) {
	double ip, fp;
	if (tf > LONG_MAX) tf = LONG_MAX;
	fp = modf(tf, &ip);
	tv.tv_sec = (unsigned long)ip;
	tv.tv_usec = (unsigned long)(fp*1e6);
      } else
	return 0;
    else
      return 0;
    x = y;
  } else
    return 0;
  if (isapp(x, &y, &arg) && isuint(arg, &target))
    x = y;
  else
    return 0;
  if (isapp(x, &y, &arg) && isuint(arg, &origin))
    x = y;
  else
    return 0;
  if (isapp(x, &y, &arg) && isint(arg, &error))
    x = y;
  else
    return 0;
  if (isapp(x, &y, &arg) && issym(y, sym(ggi_event)) &&
      isuint(arg, &type)) {
    gii_any_event *any = &e->any;
    any->type = type;
    any->error = error;
    any->origin = origin;
    any->target = target;
    any->time = tv;
    switch (type) {
    case evKeyPress:
    case evKeyRelease:
    case evKeyRepeat:
      {
	gii_key_event *key = &e->key;
	int n;
	expr *xv;
	unsigned long modifiers, sym, label, button;
	if (istuple(params, &n, &xv) && n == 4 &&
	    isuint(xv[0], &modifiers) &&
	    isuint(xv[1], &sym) &&
	    isuint(xv[2], &label) &&
	    isuint(xv[3], &button)) {
	  key->modifiers = modifiers;
	  key->sym = sym;
	  key->label = label;
	  key->button = button;
	  key->size = sizeof(gii_key_event);
	  return 1;
	} else
	  return 0;
      }
    case evPtrRelative:
    case evPtrAbsolute:
      {
	gii_pmove_event *pmove = &e->pmove;
	int n;
	expr *xv;
	long x, y, z, wheel;
	if (istuple(params, &n, &xv) && n == 4 &&
	    isint(xv[0], &x) &&
	    isint(xv[1], &y) &&
	    isint(xv[2], &z) &&
	    isint(xv[3], &wheel)) {
	  pmove->x = x;
	  pmove->y = y;
	  pmove->z = z;
	  pmove->wheel = wheel;
	  pmove->size = sizeof(gii_pmove_event);
	  return 1;
	} else
	  return 0;
      }
    case evPtrButtonPress:
    case evPtrButtonRelease:
      {
	gii_pbutton_event *pbutton = &e->pbutton;
	unsigned long button;
	if (isuint(params, &button)) {
	  pbutton->button = button;
	  pbutton->size = sizeof(gii_pbutton_event);
	  return 1;
	} else
	  return 0;
      }
    case evCommand:
    case evInformation:
      {
	gii_cmd_event *cmd = &e->cmd;
	unsigned long code;
	bstr_t *m;
	int n;
	expr *xv;
	if (isuint(params, &code)) {
	  int i;
	  cmd->code = code;
	  for (i = 0; i < GII_CMD_DATA_MAX; i++) cmd->data[i] = 0;
	  cmd->size = sizeof(gii_cmd_nodata_event);
	  return 1;
	} else if (istuple(params, &n, &xv) && n == 2 &&
		   isuint(xv[0], &code) &&
		   isobj(xv[1], type(ByteStr), (void**)&m) &&
		   m->size <= GII_CMD_DATA_MAX) {
	  int i;
	  cmd->code = code;
	  for (i = 0; i < GII_CMD_DATA_MAX; i++) cmd->data[i] = m->v[i];
	  for (i = m->size; i < GII_CMD_DATA_MAX; i++) cmd->data[i] = 0;
	  cmd->size = sizeof(gii_cmd_event);
	  return 1;
	} else
	  return 0;
      }
    case evValRelative:
    case evValAbsolute:
      {
	gii_val_event *val = &e->val;
	unsigned long first;
	int n;
	expr *xv;
	if (istuple(params, &n, &xv) && n > 0 && n-1 <= 32 &&
	    isuint(xv[0], &first)) {
	  int i;
	  long value;
	  val->first = first;
	  val->count = n-1;
	  for (i = 0; i < n-1; i++)
	    if (isint(xv[i+1], &value))
	      val->value[i] = value;
	    else
	      return 0;
	  for (i = n-1; i < 32; i++) val->value[i] = 0;
	  val->size = sizeof(gii_val_event);
	  return 1;
	} else
	  return 0;
      }
    case evExpose:
      {
	gii_expose_event *expose = &e->expose;
	int n;
	expr *xv;
	unsigned long x, y, h, w;
	if (istuple(params, &n, &xv) && n == 4 &&
	    isuint(xv[0], &x) &&
	    isuint(xv[1], &y) &&
	    isuint(xv[2], &h) &&
	    isuint(xv[3], &w)) {
	  expose->x = x;
	  expose->y = y;
	  expose->h = h;
	  expose->w = w;
	  expose->size = sizeof(gii_expose_event);
	  return 1;
	} else
	  return 0;
      }
    default:
      if (isvoid(params)) {
	any->size = sizeof(gii_any_event);
	return 1;
      } else
	return 0;
    }
  } else
    return 0;
}

FUNCTION(ggi,ggi_send,argc,argv)
{
  visual_t *v;
  ggi_event e;
  if (init && argc == 2 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis && encode_event(argv[1], &e) && !ggiEventSend(v->vis, &e))
    return mkvoid;
  else
    return __FAIL;
}

FUNCTION(ggi,ggi_kbhit,argc,argv)
{
  visual_t *v;
  if (init && argc == 1 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis) {
    return ggiKbhit(v->vis)?mktrue:mkfalse;
  } else
    return __FAIL;
}

FUNCTION(ggi,ggi_getc,argc,argv)
{
  visual_t *v;
  if (init && argc == 1 && isobj(argv[0], type(GGIVisual), (void**)&v) &&
      v->vis)
    return mkint(ggiGetc(v->vis));
  else
    return __FAIL;
}