/*
 * $Header: /home/campbell/Languages/Scheme/scm/x-scm/RCS/x.c,v 1.8 1992/08/18 00:43:02 campbell Beta $
 *
 * Author: Larry Campbell (campbell@redsox.bsw.com)
 *
 * Copyright 1992 by The Boston Software Works, Inc.
 * Permission to use for any purpose whatsoever granted, as long
 * as this copyright notice remains intact.  Please send bug fixes
 * or enhancements to the above email address.
 *
 * Generic X and Xlib functions for scm.
 * These functions do not depend on any toolkit.
 */

#include <assert.h>
#include <stdio.h>
#include <X11/X.h>
#include <X11/Xlib.h>
#include <X11/cursorfont.h>

#include "scm.h"
#include "x.h"

static char s_x_alloc_color[]		= "x:alloc-color";
static char s_x_alloc_color_cells[]	= "x:alloc-color-cells";
static char s_x_clear_area[]		= "x:clear-area";
static char s_x_copy_area[]		= "x:copy-area";
static char s_x_create_colormap[]	= "x:create-colormap";
static char s_x_create_gc[]		= "x:create-gc";
static char s_x_create_pixmap[]		= "x:create-pixmap";
static char s_x_default_colormap[]	= "x:default-colormap";
static char s_x_define_cursor[]		= "x:define-cursor";
static char s_x_display_cells[]		= "x:display-cells";
static char s_x_display_depth[]		= "x:display-depth";
static char s_x_display_height[]	= "x:display-height";
static char s_x_display_width[]		= "x:display-width";
static char s_x_draw_lines[]		= "x:draw-lines";
static char s_x_draw_points[]		= "x:draw-points";
static char s_x_fill_rectangle[]	= "x:fill-rectangle";
static char s_x_flush[]			= "x:flush";
static char s_x_free_colormap[]		= "x:free-colormap";
static char s_x_free_pixmap[]		= "x:free-pixmap";
static char s_x_install_colormap[]	= "x:install-colormap";
static char s_x_get_event_field[]	= "x:get-event-field";
static char s_x_root_window[]		= "x:root-window";
static char s_x_set_background[]	= "x:set-background";
static char s_x_set_foreground[]	= "x:set-foreground";
static char s_x_set_window_colormap[]	= "x:set-window-colormap";
static char s_x_store_color[]		= "x:store-color";
static char s_x_undefine_cursor[]	= "x:undefine-cursor";
static char s_x_x_scm_version[]		= "x:x-scm-version";

static char s_x__make_gc_values[]	= "internal function x__make_gc_values";


/*
 * These should really be defined similarly to ARG[1-5]...
 */

static char ARG6[] = "arg6";
static char ARG7[] = "arg7";
static char ARG8[] = "arg8";
static char ARG9[] = "arg9";


static struct {
  short id;
  char *name;
  SCM sym;
} cursor_table[] = {
  {XC_X_cursor,			"xc:x-cursor",			0},
  {XC_arrow,			"xc:arrow",			0},
  {XC_based_arrow_down,		"xc:based-arrow-down",		0},
  {XC_based_arrow_up,		"xc:based-arrow-up",		0},
  {XC_boat,			"xc:boat",			0},
  {XC_bogosity,			"xc:bogosity",			0},
  {XC_bottom_left_corner,	"xc:bottom-left-corner",	0},
  {XC_bottom_right_corner,	"xc:bottom-right-corner",	0},
  {XC_bottom_side,		"xc:bottom-side",		0},
  {XC_bottom_tee,		"xc:bottom-tee",		0},
  {XC_box_spiral,		"xc:box-spiral",		0},
  {XC_center_ptr,		"xc:center-ptr",		0},
  {XC_circle,			"xc:circle",			0},
  {XC_clock,			"xc:clock",			0},
  {XC_coffee_mug,		"xc:coffee-mug",		0},
  {XC_cross,			"xc:cross",			0},
  {XC_cross_reverse,		"xc:cross-reverse",		0},
  {XC_crosshair,		"xc:crosshair",			0},
  {XC_diamond_cross,		"xc:diamond-cross",		0},
  {XC_dot,			"xc:dot",			0},
  {XC_dotbox,			"xc:dotbox",			0},
  {XC_double_arrow,		"xc:double-arrow",		0},
  {XC_draft_large,		"xc:draft-large",		0},
  {XC_draft_small,		"xc:draft-small",		0},
  {XC_draped_box,		"xc:draped-box",		0},
  {XC_exchange,			"xc:exchange",			0},
  {XC_fleur,			"xc:fleur",			0},
  {XC_gobbler,			"xc:gobbler",			0},
  {XC_gumby,			"xc:gumby",			0},
  {XC_hand1,			"xc:hand1",			0},
  {XC_hand2,			"xc:hand2",			0},
  {XC_heart,			"xc:heart",			0},
  {XC_icon,			"xc:icon",			0},
  {XC_iron_cross,		"xc:iron-cross",		0},
  {XC_left_ptr,			"xc:left-ptr",			0},
  {XC_left_side,		"xc:left-side",			0},
  {XC_left_tee,			"xc:left-tee",			0},
  {XC_leftbutton,		"xc:leftbutton",		0},
  {XC_ll_angle,			"xc:ll-angle",			0},
  {XC_lr_angle,			"xc:lr-angle",			0},
  {XC_man,			"xc:man",			0},
  {XC_middlebutton,		"xc:middlebutton",		0},
  {XC_mouse,			"xc:mouse",			0},
  {XC_pencil,			"xc:pencil",			0},
  {XC_pirate,			"xc:pirate",			0},
  {XC_plus,			"xc:plus",			0},
  {XC_question_arrow,		"xc:question-arrow",		0},
  {XC_right_ptr,		"xc:right-ptr",			0},
  {XC_right_side,		"xc:right-side",		0},
  {XC_right_tee,		"xc:right-tee",			0},
  {XC_rightbutton,		"xc:rightbutton",		0},
  {XC_rtl_logo,			"xc:rtl-logo",			0},
  {XC_sailboat,			"xc:sailboat",			0},
  {XC_sb_down_arrow,		"xc:sb-down-arrow",		0},
  {XC_sb_h_double_arrow,	"xc:sb-h-double-arrow",		0},
  {XC_sb_left_arrow,		"xc:sb-left-arrow",		0},
  {XC_sb_right_arrow,		"xc:sb-right-arrow",		0},
  {XC_sb_up_arrow,		"xc:sb-up-arrow",		0},
  {XC_sb_v_double_arrow,	"xc:sb-v-double-arrow",		0},
  {XC_shuttle,			"xc:shuttle",			0},
  {XC_sizing,			"xc:sizing",			0},
  {XC_spider,			"xc:spider",			0},
  {XC_spraycan,			"xc:spraycan",			0},
  {XC_star,			"xc:star",			0},
  {XC_target,			"xc:target",			0},
  {XC_tcross,			"xc:tcross",			0},
  {XC_top_left_arrow,		"xc:top-left-arrow",		0},
  {XC_top_left_corner,		"xc:top-left-corner",		0},
  {XC_top_right_corner,		"xc:top-right-corner",		0},
  {XC_top_side,			"xc:top-side",			0},
  {XC_top_tee,			"xc:top-tee",			0},
  {XC_trek,			"xc:trek",			0},
  {XC_ul_angle,			"xc:ul-angle",			0},
  {XC_umbrella,			"xc:umbrella",			0},
  {XC_ur_angle,			"xc:ur-angle",			0},
  {XC_watch,			"xc:watch",			0},
  {XC_xterm,			"xc:xterm",			0},
};


/*
 * Scheme types defined in this module
 */

#undef XX
#define XX(name, mark, free)			\
long TOKEN_PASTE(tc16_,name);			\
static int TOKEN_PASTE(print_,name)();		\
static smobfuns TOKEN_PASTE(smob,name) =	\
    { mark, free, TOKEN_PASTE(print_,name) };

X_SMOBS


/*
 * GC mark function that just marks this cell and returns BOOL_F,
 * as there are no further objects off this one
 */

SCM mark_no_further(ptr)
SCM ptr;
{
  assert(TYP7(ptr) == tc7_smob);
  SETGC8MARK(ptr);
  return BOOL_F;
}


static SCM make_xcolormap(c)
Colormap c;
{
  SCM w;
  NEWCELL(w);
  DEFER_INTS;
  CAR(w) = tc16_xcolormap;
  SETCDR(w,c);
  ALLOW_INTS;
  return w;
}

SCM make_xevent(e)
XEvent *e;
{
  SCM w;
  XEvent *ec;

  ec = (XEvent *) must_malloc(sizeof(XEvent), "make_xevent");
  (void) memcpy(ec, e, sizeof(XEvent));
  NEWCELL(w);
  DEFER_INTS;
  CAR(w) = tc16_xevent;
  SETCDR(w,ec);
  ALLOW_INTS;
  return w;
}

SCM make_xdisplay(d)
Display *d;
{
  SCM w;
  NEWCELL(w);
  DEFER_INTS;
  CAR(w) = tc16_xdisplay;
  SETCDR(w,d);
  ALLOW_INTS;
  return w;
}

SCM make_xgc(gc)
GC gc;
{
  SCM g;
  NEWCELL(g);
  DEFER_INTS;
  CAR(g) = tc16_xgc;
  SETCDR(g,gc);
  ALLOW_INTS;
  return g;
}

SCM make_xpixmap()
{
  SCM p;
  NEWCELL(p);
  CAR(p) = tc16_xpixmap;
  CDR(p) = 0;
  return p;
}

SCM make_xwindow(w)
Window w;
{
  SCM sw;
  NEWCELL(sw);
  DEFER_INTS;
  CAR(sw) = tc16_xwindow;
  SETCDR(sw,w);
  ALLOW_INTS;
  return sw;
}

sizet x_free_xevent(ptr)
SCM ptr;
{
  free(CHARS(ptr));
  return sizeof(XEvent);
}

static void x__draw();
static void x__make_gc_values();

#define XDRAWABLEP(x) (XWINDOWP(x) || XPIXMAPP(x))

#define GET_NEXT_INT(result, args, err, rtn) \
	ASSERT(NIMP(args) && CONSP(args) && INUMP(CAR(args)), args, err, rtn); \
	result = INUM(CAR(args)); \
  	args = CDR(args);


SCM x_alloc_color(s_dpy, s_cmap, s_args)
SCM s_dpy, s_cmap, s_args;
{
  XColor xc;

  ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_alloc_color);
  ASSERT(NIMP(s_cmap) && XCOLORMAPP(s_cmap), s_cmap, ARG2, s_x_alloc_color);
  GET_NEXT_INT(xc.red, s_args, ARG3, s_x_alloc_color);
  GET_NEXT_INT(xc.green, s_args, ARG4, s_x_alloc_color);
  GET_NEXT_INT(xc.blue, s_args, ARG5, s_x_alloc_color);
  if (XAllocColor(XDISPLAY(s_dpy), XCOLORMAP(s_cmap), &xc))
    return MAKINUM(xc.pixel);
  else
    return BOOL_F;
}


SCM x_alloc_color_cells(s_dpy, s_cmap, s_args)
SCM s_dpy, s_cmap, s_args;
{
  SCM s;
  Bool contig;
  int nplanes, ncolors, i;
  unsigned long *planes, *colors;
  SCM s_planes, s_colors, result;

  ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_alloc_color_cells);
  ASSERT(NIMP(s_cmap) && XCOLORMAPP(s_cmap), s_cmap, ARG2, s_x_alloc_color_cells);
  ASSERT(NIMP(s_args) && CONSP(s_args), s_args, ARG3, s_x_alloc_color_cells);
  s = CAR(s_args);
  s_args = CDR(s_args);
  contig = !(FALSEP(s) || NULLP(s));
  GET_NEXT_INT(nplanes, s_args, ARG4, s_x_alloc_color_cells);
  GET_NEXT_INT(ncolors, s_args, ARG4, s_x_alloc_color_cells);
  ASSERT(ncolors > 0, ncolors, "must allocate >0 colors", s_x_alloc_color_cells);
  if (nplanes)
    planes = (unsigned long *) must_malloc(
      nplanes * sizeof(unsigned long), s_x_alloc_color_cells);
  colors = (unsigned long *) must_malloc(
    ncolors * sizeof(unsigned long), s_x_alloc_color_cells);

  if (!XAllocColorCells(XDISPLAY(s_dpy), XCOLORMAP(s_cmap), contig,
                        planes, nplanes, colors, ncolors)) {
    result = BOOL_F;
  } else {
    s_planes = EOL;
    s_colors = EOL;
    for (i = 0; i < nplanes; i++)
      s_planes = cons(MAKINUM(planes[i]), s_planes);
    for (i = 0; i < ncolors; i++)
      s_colors = cons(MAKINUM(colors[i]), s_colors);

    result = EOL;
    result = cons(s_colors, result);
    result = cons(s_planes, result);
  }

  free(colors);
  if (nplanes) free(planes);

  return result;
}


SCM x_clear_area(s_dpy, s_win, args)
SCM s_dpy, s_win, args;
{
  int x, y, width, height;
  Bool expose_flag;

  ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_clear_area);
  ASSERT(NIMP(s_win) && XWINDOWP(s_win), s_win, ARG2, s_x_clear_area);

  GET_NEXT_INT(x, args, ARG3, s_x_clear_area);
  GET_NEXT_INT(y, args, ARG4, s_x_clear_area);
  GET_NEXT_INT(width, args, ARG5, s_x_clear_area);
  GET_NEXT_INT(height, args, "arg6", s_x_clear_area);

  ASSERT(NIMP(args) && CONSP(args), args, "arg7", s_x_clear_area);
  expose_flag = (CAR(args) == BOOL_T);

  XClearArea(XDISPLAY(s_dpy), XWINDOW(s_win), x, y, width, height, expose_flag);

  return UNSPECIFIED;
}

SCM x_copy_area(s_dpy, s_src, args)
SCM s_dpy, s_src, args;
{
  Drawable src, dst;
  GC gc;
  SCM s;
  int src_x, src_y, width, height, dst_x, dst_y;

  ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_copy_area);
  ASSERT(NIMP(s_src) && XDRAWABLEP(s_src), s_src, ARG2, s_x_copy_area);
  src = XWINDOWP(s_src) ? XWINDOW(s_src) : XPIXMAP(s_src);

  ASSERT(NIMP(args) && CONSP(args), args, ARG3, s_x_copy_area);
  s = CAR(args); args = CDR(args);
  ASSERT(NIMP(s) && XDRAWABLEP(s), s, ARG3, s_x_copy_area);
  dst = XWINDOWP(s) ? XWINDOW(s) : XPIXMAP(s);

  ASSERT(NIMP(args) && CONSP(args), args, ARG4, s_x_copy_area);
  s = CAR(args); args = CDR(args);
  ASSERT(NIMP(s) && XGCP(s), s, ARG4, s_x_copy_area);
  gc = XGC(s);

  GET_NEXT_INT(src_x, args, ARG5, s_x_copy_area);
  GET_NEXT_INT(src_y, args, ARG6, s_x_copy_area);
  GET_NEXT_INT(width, args, ARG7, s_x_copy_area);
  GET_NEXT_INT(height, args, ARG8, s_x_copy_area);
  GET_NEXT_INT(dst_x, args, ARG9, s_x_copy_area);
  GET_NEXT_INT(dst_y, args, "arg10", s_x_copy_area);

  XCopyArea(XDISPLAY(s_dpy), src, dst, gc, src_x, src_y, width, height, dst_x, dst_y);

  return UNSPECIFIED;
}


SCM x_create_colormap(s_dpy, s_win, salloc)
SCM s_dpy, s_win, salloc;
{
  int alloc;
  ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_create_colormap);
  ASSERT(NIMP(s_win) && XWINDOWP(s_win), s_win, ARG2, s_x_create_colormap);
  ASSERT(INUMP(salloc), salloc, ARG3, s_x_create_colormap);
  alloc = INUM(salloc);
  ASSERT(alloc == AllocNone || alloc == AllocAll, salloc, "invalid alloc parameter",
         s_x_create_colormap);
  return make_xcolormap(XCreateColormap(
    XDISPLAY(s_dpy),
    XWINDOW(s_win),
    DefaultVisual(XDISPLAY(s_dpy), 0),
    alloc));
}


SCM x_create_gc(s_dpy, s_drwbl, args)
SCM s_dpy, s_drwbl, args;
{
  SCM sgc;
  Drawable drawable;
  XGCValues v;
  int mask;

  ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_create_gc);
  ASSERT(s_drwbl == EOL || (NIMP(s_drwbl) && XDRAWABLEP(s_drwbl)), s_drwbl, ARG2, s_x_create_gc);
  if (s_drwbl == EOL)
    drawable = DefaultRootWindow(XDISPLAY(s_dpy));
  else
    drawable = (Drawable) CDR(s_drwbl);
  x__make_gc_values(&v, &mask, args);
  sgc = make_xgc(XCreateGC(XDISPLAY(s_dpy), drawable, mask, &v));
  return sgc;
}

static void x__make_gc_values(valuep, maskp, args)
XGCValues *valuep;
int *maskp;
SCM args;
{
  SCM sbit;
  int bit;
  SCM svalue;
  int l;

  *maskp = 0;
  (void) memset((char *) valuep, 0, sizeof(XGCValues));
  l = ilength(args);
  if (l == 0) return;
  ASSERT(l > 0 && (! (l & 1)), args, WNA, s_x__make_gc_values);
  while (l) {
    ASSERT(NIMP(args) && CONSP(args), args, ARG1, s_x__make_gc_values);
    sbit = CAR(args);
    args = CDR(args);
    ASSERT(NIMP(args) && CONSP(args), args, ARG1, s_x__make_gc_values);
    svalue = CAR(args);
    args = CDR(args);
    bit = INUM(sbit);
    *maskp |= bit;
    switch (bit) {
      case GCFunction:		valuep->function = INUM(svalue);	break;
      case GCPlaneMask:		valuep->plane_mask = INUM(svalue);	break;
      case GCForeground:	valuep->foreground = INUM(svalue);	break;
      case GCBackground:	valuep->background = INUM(svalue);	break;
      case GCLineWidth:		valuep->line_width = INUM(svalue);	break;
      default:
	ASSERT(0, sbit, ARG1, s_x__make_gc_values);
    }
    l -= 2;
  }
}

SCM x_create_pixmap(s_dpy, s_drwbl, args)
SCM s_dpy, s_drwbl, args;
{
  unsigned int width, height, depth;
  Drawable drawable;
  Pixmap p;
  SCM sp;

  ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_create_pixmap);
  ASSERT(s_drwbl == EOL || (NIMP(s_drwbl) && XDRAWABLEP(s_drwbl)), s_drwbl, ARG2, s_x_create_pixmap);
  if (s_drwbl == EOL)
    drawable = DefaultRootWindow(XDISPLAY(s_dpy));
  else
    drawable = (Drawable) CDR(s_drwbl);
  GET_NEXT_INT(width, args, ARG3, s_x_create_pixmap);
  GET_NEXT_INT(height, args, ARG4, s_x_create_pixmap);
  GET_NEXT_INT(depth, args, ARG5, s_x_create_pixmap);

  p = XCreatePixmap(XDISPLAY(s_dpy), drawable, width, height, depth);
  sp = make_xpixmap();
  SETCDR(sp, p);

  return sp;
}


SCM x_default_colormap(s_dpy, s_screen)
SCM s_dpy, s_screen;
{
  ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_default_colormap);
  ASSERT(INUMP(s_screen), s_screen, ARG1, s_x_default_colormap);
  return make_xcolormap(DefaultColormap(XDISPLAY(s_dpy), INUM(s_screen)));
}


SCM x_define_cursor(s_dpy, s_win, scursor)
SCM s_dpy, s_win, scursor;
{
  int i;
  Cursor cursor;

  ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_define_cursor);
  ASSERT(NIMP(s_win) && XWINDOWP(s_win), s_win, ARG2, s_x_define_cursor);
  ASSERT(NIMP(scursor) && SYMBOLP(scursor), scursor, ARG3, s_x_define_cursor);
  for (i = 0; i < sizeof(cursor_table) / sizeof(cursor_table[0]); i++) {
    if (scursor == cursor_table[i].sym) {
      cursor = XCreateFontCursor(XDISPLAY(s_dpy), cursor_table[i].id);
      XDefineCursor(XDISPLAY(s_dpy), XWINDOW(s_win), cursor);
      return UNSPECIFIED;
    }
  }
  return UNSPECIFIED;
}


SCM x_undefine_cursor(s_dpy, s_win)
SCM s_dpy, s_win;
{
  ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_undefine_cursor);
  ASSERT(NIMP(s_win) && XWINDOWP(s_win), s_win, ARG2, s_x_undefine_cursor);

  XUndefineCursor(XDISPLAY(s_dpy), XWINDOW(s_win));
  return UNSPECIFIED;
}


SCM x_free_colormap(s_dpy, s_cmap)
SCM s_dpy, s_cmap;
{
  ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_free_colormap);
  ASSERT(NIMP(s_cmap) && XCOLORMAPP(s_cmap), s_cmap, ARG2, s_x_free_colormap);

  XFreeColormap(XDISPLAY(s_dpy), XPIXMAP(s_cmap));

  return UNSPECIFIED;
}


SCM x_free_pixmap(s_dpy, spixmap)
SCM s_dpy, spixmap;
{
  ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_free_pixmap);
  ASSERT(NIMP(spixmap) && XPIXMAPP(spixmap), spixmap, ARG2, s_x_free_pixmap);

  XFreePixmap(XDISPLAY(s_dpy), XPIXMAP(spixmap));

  return UNSPECIFIED;
}


SCM x_install_colormap(s_dpy, s_cmap)
SCM s_dpy, s_cmap;
{
  ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_install_colormap);
  ASSERT(NIMP(s_cmap) && XCOLORMAPP(s_cmap), s_cmap, ARG2, s_x_install_colormap);
  XInstallColormap(XDISPLAY(s_dpy), XCOLORMAP(s_cmap));
  return UNSPECIFIED;
}


SCM x_set_background(s_dpy, sgc, scolor)
SCM s_dpy, sgc, scolor;
{
  ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_set_background);
  ASSERT(NIMP(sgc) && XGCP(sgc), sgc, ARG2, s_x_set_background);
  ASSERT(INUMP(scolor), scolor, ARG3, s_x_set_background);

  XSetBackground(XDISPLAY(s_dpy), (GC) CDR(sgc), INUM(scolor));

  return UNSPECIFIED;
}

SCM x_set_foreground(s_dpy, sgc, scolor)
SCM s_dpy, sgc, scolor;
{
  ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_set_foreground);
  ASSERT(NIMP(sgc) && XGCP(sgc), sgc, ARG2, s_x_set_foreground);
  ASSERT(INUMP(scolor), scolor, ARG3, s_x_set_foreground);

  XSetForeground(XDISPLAY(s_dpy), (GC) CDR(sgc), INUM(scolor));

  return UNSPECIFIED;
}

SCM x_display_cells(sd, si)
SCM sd, si;
{
  ASSERT(NIMP(sd) && XDISPLAYP(sd), sd, ARG1, s_x_display_cells);
  ASSERT(INUMP(si), si, ARG2, s_x_display_cells);

  return MAKINUM(DisplayCells(XDISPLAY(sd), INUM(si)));
}

SCM x_display_depth(sd,si)
SCM sd, si;
{
  ASSERT(NIMP(sd) && XDISPLAYP(sd), sd, ARG1, s_x_display_depth);
  ASSERT(INUMP(si), si, ARG2, s_x_display_depth);

  return MAKINUM(DisplayPlanes(XDISPLAY(sd), INUM(si)));
}

SCM x_display_height(sd,si)
SCM sd, si;
{
  ASSERT(NIMP(sd) && XDISPLAYP(sd), sd, ARG1, s_x_display_height);
  ASSERT(INUMP(si), si, ARG2, s_x_display_height);

  return MAKINUM(DisplayHeight(XDISPLAY(sd), INUM(si)));
}

SCM x_display_width(sd,si)
SCM sd, si;
{
  ASSERT(NIMP(sd) && XDISPLAYP(sd), sd, ARG1, s_x_display_width);
  ASSERT(INUMP(si), si, ARG2, s_x_display_width);

  return MAKINUM(DisplayWidth(XDISPLAY(sd), INUM(si)));
}

SCM x_draw_lines(s_dpy, s_drwbl, args)
SCM s_dpy, s_drwbl, args;
{
  x__draw(s_dpy, s_drwbl, args, XDrawLines, s_x_draw_lines);
  return UNSPECIFIED;
}

SCM x_draw_points(s_dpy, s_drwbl, args)
SCM s_dpy, s_drwbl, args;
{
  x__draw(s_dpy, s_drwbl, args, XDrawPoints, s_x_draw_points);
  return UNSPECIFIED;
}

static void x__draw(s_dpy, s_drwbl, args, rtn, name)
SCM s_dpy, s_drwbl, args;
void (*rtn)();
char *name;
{
  Display *display;
  Drawable drawable;
  SCM sgc, spoint, item;
  GC gc;
  int x, y, mode, len, i;
  XPoint *p;

  ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, name);
  ASSERT(NIMP(s_drwbl) && XDRAWABLEP(s_drwbl), s_drwbl, ARG2, name);
  display = XDISPLAY(s_dpy);
  drawable = XWINDOWP(s_drwbl) ? XWINDOW(s_drwbl) : XPIXMAP(s_drwbl);

  ASSERT(NIMP(args) && CONSP(args), args, ARG3, name);
  sgc = CAR(args);
  args = CDR(args);
  ASSERT(NIMP(sgc) && XGCP(sgc), sgc, ARG3, name);
  gc = XGC(sgc);

  GET_NEXT_INT(mode, args, ARG4, name);

  len = ilength(args);
  ASSERT(len > 0, args, WNA, name);
  p = (XPoint *) must_malloc(len * sizeof(XPoint));

  for (i = 0; i < len; i++) {
    ASSERT(NIMP(args) && CONSP(args), args, "bad point list", name);
    item = CAR(args);
    args = CDR(args);
    ASSERT(NIMP(item) && CONSP(item) && INUMP(CAR(item)) && INUMP(CDR(item)),
      item, "bad point list", name);
    p[i].x = INUM(CAR(item));
    p[i].y = INUM(CDR(item));
  }

  rtn(display, drawable, gc, p, len, mode);
  free(p);
}

SCM x_fill_rectangle(s_dpy, s_drwbl, args)
SCM s_dpy, s_drwbl, args;
{
  Drawable drawable;
  SCM sgc;
  GC gc;
  int x, y, width, height;

  ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_fill_rectangle);
  ASSERT(NIMP(s_drwbl) && XDRAWABLEP(s_drwbl), s_drwbl, ARG2, s_x_fill_rectangle);
  drawable = (Drawable) CDR(s_drwbl);

  ASSERT(NIMP(args) && CONSP(args), args, ARG3, s_x_fill_rectangle);
  sgc = CAR(args);
  args = CDR(args);
  ASSERT(NIMP(sgc) && XGCP(sgc), sgc, ARG3, s_x_fill_rectangle);
  gc = (GC) CDR(sgc);

  GET_NEXT_INT(x, args, ARG4, s_x_fill_rectangle);
  GET_NEXT_INT(y, args, ARG5, s_x_fill_rectangle);
  GET_NEXT_INT(width, args, "arg6", s_x_fill_rectangle);
  GET_NEXT_INT(height, args, "arg7", s_x_fill_rectangle);

  XFillRectangle(XDISPLAY(s_dpy), drawable, gc, x, y, width, height);

  return UNSPECIFIED;
}

/* This function _is_ used, in xevent.h */

SCM x_make_bool(f)
Bool f;
{
  return f ? BOOL_F : BOOL_T;
}


SCM x_flush(sd)
SCM sd;
{
  ASSERT(NIMP(sd) && XDISPLAYP(sd), sd, ARG1, s_x_flush);
  XFlush(XDISPLAY(sd));
  return UNSPECIFIED;
}


SCM x_get_event_field(sevent, sfield)
SCM sevent, sfield;
{
  void *x;

  ASSERT(NIMP(sevent) && XEVENTP(sevent), sevent, ARG1, s_x_get_event_field);
  ASSERT(INUMP(sfield), sfield, ARG2, s_x_get_event_field);

  x = (void *) CHARS(sevent);
  switch (INUM(sfield)) {
#include "xevent.h"
    default:
      return BOOL_F;
  }
}


SCM x_root_window(sdpy, sscr)
SCM sdpy, sscr;
{
  ASSERT(NIMP(sdpy) && XDISPLAYP(sdpy), sdpy, ARG1, s_x_root_window);
  ASSERT(INUMP(sscr), sscr, ARG2, s_x_root_window);
  return make_xwindow(RootWindow(XDISPLAY(sdpy), INUM(sscr)));
}


SCM x_set_window_colormap(s_dpy, s_win, s_cmap)
SCM s_dpy, s_win, s_cmap;
{
  ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_set_window_colormap);
  ASSERT(NIMP(s_win) && XWINDOWP(s_win), s_win, ARG2, s_x_set_window_colormap);
  ASSERT(NIMP(s_cmap) && XCOLORMAPP(s_cmap), s_cmap, ARG3, s_x_set_window_colormap);
  XSetWindowColormap(XDISPLAY(s_dpy), XWINDOW(s_win), XCOLORMAP(s_cmap));
  return UNSPECIFIED;
}


SCM x_store_color(s_dpy, s_cmap, s_args)
SCM s_dpy, s_cmap, s_args;
{
  XColor color;

  ASSERT(NIMP(s_dpy) && XDISPLAYP(s_dpy), s_dpy, ARG1, s_x_store_color);
  ASSERT(NIMP(s_cmap) && XCOLORMAPP(s_cmap), s_cmap, ARG2, s_x_store_color);
  GET_NEXT_INT(color.pixel, s_args, ARG3, s_x_store_color);
  GET_NEXT_INT(color.red, s_args, ARG4, s_x_store_color);
  GET_NEXT_INT(color.green, s_args, ARG5, s_x_store_color);
  GET_NEXT_INT(color.blue, s_args, ARG6, s_x_store_color);
  color.flags = DoRed | DoGreen | DoBlue;
  XStoreColor(XDISPLAY(s_dpy), XCOLORMAP(s_cmap), &color);
  return UNSPECIFIED;
}

static struct {
  int type;
  char *name;
} event_names[] = {
  {KeyPress,		"KeyPress"},
  {KeyRelease,		"KeyRelease"},
  {ButtonPress,		"ButtonPress"},
  {ButtonRelease,	"ButtonRelease"},
  {MotionNotify,	"MotionNotify"},
  {EnterNotify,		"EnterNotify"},
  {LeaveNotify,		"LeaveNotify"},
  {FocusIn,		"FocusIn"},
  {FocusOut,		"FocusOut"},
  {KeymapNotify,	"KeymapNotify"},
  {Expose,		"Expose"},
  {GraphicsExpose,	"GraphicsExpose"},
  {NoExpose,		"NoExpose"},
  {VisibilityNotify,	"VisibilityNotify"},
  {CreateNotify,	"CreateNotify"},
  {DestroyNotify,	"DestroyNotify"},
  {UnmapNotify,		"UnmapNotify"},
  {MapNotify,		"MapNotify"},
  {MapRequest,		"MapRequest"},
  {ReparentNotify,	"ReparentNotify"},
  {ConfigureNotify,	"ConfigureNotify"},
  {ConfigureRequest,	"ConfigureRequest"},
  {GravityNotify,	"GravityNotify"},
  {ResizeRequest,	"ResizeRequest"},
  {CirculateNotify,	"CirculateNotify"},
  {CirculateRequest,	"CirculateRequest"},
  {PropertyNotify,	"PropertyNotify"},
  {SelectionClear,	"SelectionClear"},
  {SelectionRequest,	"SelectionRequest"},
  {SelectionNotify,	"SelectionNotify"},
  {ColormapNotify,	"ColormapNotify"},
  {ClientMessage,	"ClientMessage"},
  {MappingNotify,	"MappingNotify"},
};

static char *x__event_name(type)
int type;
{
  int i;

  for (i = 0; i < sizeof(event_names) / sizeof(event_names[0]); i++) {
    if (type == event_names[i].type)
      return event_names[i].name;
  }
  return "unknown";
}

static int print_xcolormap(exp, f, writing)
SCM exp;
FILE *f;
int writing;
{
  lputs("#<X colormap>", f);
  return 1;
}

static int print_xevent(exp, f, writing)
SCM exp;
FILE *f;
int writing;
{
  lputs("#<X event: ", f);
  lputs(x__event_name(XEVENT(exp)->type), f);
  lputc('>', f);
  return 1;
}

static int print_xdisplay(exp, f, writing)
SCM exp;
FILE *f;
int writing;
{
  lputs("#<X display \"", f);
  lputs(XDISPLAY(exp)->display_name, f);
  lputs("\">", f);
  return 1;
}

static int print_xgc(exp, f, writing)
SCM exp;
FILE *f;
int writing;
{
  lputs("#<X graphics context, ID #x", f);
  intprint((long) XGC(exp)->gid, 16, f);
  lputc('>', f);
  return 1;
}

static int print_xpixmap(exp, f, writing)
SCM exp;
FILE *f;
int writing;
{
  lputs("#<X pixmap #x", f);
  intprint((long) XPIXMAP(exp), 16, f);
  lputc('>', f);
  return 1;
}

static int print_xwindow(exp, f, writing)
SCM exp;
FILE *f;
int writing;
{
  lputs("#<X window #x", f);
  intprint((long) XWINDOW(exp), 16, f);
  lputc('>', f);
  return 1;
}


static void init_x_cursors()
{
  int i;
  SCM s;

  for (i = 0; i < sizeof(cursor_table)/sizeof(cursor_table[0]); i++) {
    s = sysintern(cursor_table[i].name, UNDEFINED);
    cursor_table[i].sym = CAR(s);
    CDR(s) = CAR(s);
  }
}


#include "version.h"

SCM x_x_scm_version()
{
  return makfromstr(X_SCM_VERSION, sizeof(X_SCM_VERSION) - 1);
}


iproc x_lsubr2s[] = {
  {s_x_alloc_color,		x_alloc_color},
  {s_x_alloc_color_cells,	x_alloc_color_cells},
  {s_x_clear_area,		x_clear_area},
  {s_x_copy_area,		x_copy_area},
  {s_x_create_gc,		x_create_gc},
  {s_x_create_pixmap,		x_create_pixmap},
  {s_x_draw_lines,		x_draw_lines},
  {s_x_draw_points,		x_draw_points},
  {s_x_fill_rectangle,		x_fill_rectangle},
  {s_x_store_color,		x_store_color},
  {0, 0}
};

iproc x_subr3s[] = {
  {s_x_create_colormap,		x_create_colormap},
  {s_x_define_cursor,		x_define_cursor},
  {s_x_set_background,		x_set_background},
  {s_x_set_foreground,		x_set_foreground},
  {s_x_set_window_colormap,	x_set_window_colormap},
  {0, 0}
};

iproc x_subr2s[] = {
  {s_x_default_colormap,	x_default_colormap},
  {s_x_display_cells,		x_display_cells},
  {s_x_display_depth,		x_display_depth},
  {s_x_display_height,		x_display_height},
  {s_x_display_width,		x_display_width},
  {s_x_free_pixmap,		x_free_pixmap},
  {s_x_get_event_field,		x_get_event_field},
  {s_x_install_colormap,	x_install_colormap},
  {s_x_root_window,		x_root_window},
  {s_x_undefine_cursor,		x_undefine_cursor},
  {0, 0}
};

iproc x_subr1s[] = {
  {s_x_flush,			x_flush},
  {0, 0}
};

iproc x_subr0s[] = {
  {s_x_x_scm_version,		x_x_scm_version},
  {0, 0}
};

#undef XX
#define XX(name, mark, free) TOKEN_PASTE(tc16_,name) = newsmob(&TOKEN_PASTE(smob,name));

void init_x()
{
  init_iprocs(x_lsubr2s, tc7_lsubr_2);
  init_iprocs(x_subr3s, tc7_subr_3);
  init_iprocs(x_subr2s, tc7_subr_2);
  init_iprocs(x_subr1s, tc7_subr_1);
  init_iprocs(x_subr0s, tc7_subr_0);
  X_SMOBS
  init_x_cursors();
}
