scheme48/c/scx/xlib/window.c

/* Copyright 2001-2003 by Norbert Freudemann, David Frese */

#include "xlib.h"

s48_ref_t scx_set_window_attribute_binding = NULL;
#define scx_extract_set_window_attribute(c, x) \
  S48_EXTRACT_ENUM(c, x, scx_set_window_attribute_binding)

static unsigned long
scx_extract_set_window_attribute_alist(s48_call_t call, s48_ref_t attribs, 
				       XSetWindowAttributes* Xattrs) {
  unsigned long mask = 0;
  s48_ref_t v = s48_false_2(call);
  
  while (!s48_null_p_2(call, attribs)) {
    int mv = 
      scx_extract_set_window_attribute(call, 
		 s48_car_2(call, s48_car_2(call, attribs)));
    v = s48_cdr_2(call, s48_car_2(call, attribs));

    s48_ref_t temp = attribs;
    attribs = s48_cdr_2(call, attribs);
    s48_free_local_ref(call, temp);

    mask = mask | (1L << mv);
    switch (1L << mv) {
    case CWBackPixmap:
      Xattrs->background_pixmap = scx_extract_pixmap(call, v); break;
    case CWBackPixel:
      Xattrs->background_pixel = scx_extract_pixel(call, v); break;
    case CWBorderPixmap:
      Xattrs->border_pixmap = scx_extract_pixmap(call, v); break;
    case CWBorderPixel:
      Xattrs->border_pixel = scx_extract_pixel(call, v); break;
    case CWBitGravity:
      Xattrs->bit_gravity = scx_extract_bit_gravity(call, v); break;
    case CWWinGravity:
      Xattrs->win_gravity = scx_extract_win_gravity(call, v); break;
    case CWBackingStore:
      Xattrs->backing_store = scx_extract_backing_store(call, v); break;
    case CWBackingPlanes:
      Xattrs->backing_planes = s48_extract_long_2(call, v); break;
    case CWBackingPixel:
      Xattrs->backing_pixel = scx_extract_pixel(call, v); break;
    case CWOverrideRedirect:
      Xattrs->override_redirect = s48_extract_boolean_2(call, v); break;
    case CWSaveUnder:
      Xattrs->save_under = s48_extract_boolean_2(call, v); break;
    case CWEventMask:
      Xattrs->event_mask = scx_extract_event_mask(call, v); break;
    case CWDontPropagate:
      Xattrs->do_not_propagate_mask = scx_extract_event_mask(call, v); break;
    case CWColormap:
      Xattrs->colormap = scx_extract_colormap(call, v); break; 
    case CWCursor:
      Xattrs->cursor = scx_extract_cursor(call, v); break;
    }
  }
  return mask;
}

s48_ref_t scx_Create_Window (s48_call_t call, s48_ref_t display, 
			     s48_ref_t parent, 
			     s48_ref_t x, s48_ref_t y, 
			     s48_ref_t width, s48_ref_t height, 
			     s48_ref_t border_width, s48_ref_t depth, 
			     s48_ref_t class, s48_ref_t visual, 
			     s48_ref_t attribs) {
  Window win;
  XSetWindowAttributes Xattrs;
  unsigned long mask;

  mask = scx_extract_set_window_attribute_alist(call, attribs, &Xattrs);
  
  win = XCreateWindow(scx_extract_display(call, display), 
		      scx_extract_window(call, parent), 
		      (int)s48_extract_long_2(call, x),
		      (int)s48_extract_long_2(call, y),
		      (int)s48_extract_long_2(call, width),
		      (int)s48_extract_long_2(call, height), 
		      (int)s48_extract_long_2(call, border_width),
		      s48_extract_long_2(call, depth),
		      scx_extract_window(call, class),
		      scx_extract_visual(call, visual), mask, &Xattrs);
  return scx_enter_window(call, win);
}

s48_ref_t scx_Create_Simple_Window(s48_call_t call, s48_ref_t display, 
				   s48_ref_t parent,
				   s48_ref_t x, s48_ref_t y, 
				   s48_ref_t width, s48_ref_t height, 
				   s48_ref_t border_width, s48_ref_t border, 
				   s48_ref_t background) {
    
  Window win;

  win = XCreateSimpleWindow(scx_extract_display(call, display),
			    scx_extract_window(call, parent),
			    (int)s48_extract_long_2(call, x),
			    (int)s48_extract_long_2(call, y),
			    (int)s48_extract_long_2(call, width),
			    (int)s48_extract_long_2(call, height), 
			    (int)s48_extract_long_2(call, border_width),
			    s48_extract_long_2(call, border),
			    s48_extract_long_2(call, background));
  
  return scx_enter_window(call, win);
}

s48_ref_t scx_Change_Window_Attributes(s48_call_t call, s48_ref_t display, 
               s48_ref_t window, s48_ref_t attribs) {
  XSetWindowAttributes Xattrs;
  unsigned long mask;

  mask = scx_extract_set_window_attribute_alist(call, attribs, &Xattrs);
  XChangeWindowAttributes(scx_extract_display(call, display),
			  scx_extract_window(call, window), 
			  mask, &Xattrs);
  return s48_unspecific_2(call);
}

s48_ref_t scx_enter_window_changes(s48_call_t call, XWindowChanges* WC, 
            unsigned long mask) {
  s48_ref_t res = s48_null_2(call), t = s48_false_2(call);
  
  if (mask & CWX) {
    t = scx_enter_window_change(call, 0);
    t = s48_cons_2(call, t, s48_enter_long_2(call, WC->x));
    res = s48_cons_2(call, t, res);
  }
  if (mask & CWY) {
    t = scx_enter_window_change(call, 1);
    t = s48_cons_2(call, t, s48_enter_long_2(call, WC->y));
    res = s48_cons_2(call, t, res);
  }
  if (mask & CWWidth) {
    t = scx_enter_window_change(call, 2);
    t = s48_cons_2(call, t, s48_enter_long_2(call, WC->width));
    res = s48_cons_2(call, t, res);
  }
  if (mask & CWHeight) {
    t = scx_enter_window_change(call, 3);
    t = s48_cons_2(call, t, s48_enter_long_2(call, WC->height));
    res = s48_cons_2(call, t, res);
  }
  if (mask & CWBorderWidth) {
    t = scx_enter_window_change(call, 4);
    t = s48_cons_2(call, t, s48_enter_long_2(call, WC->border_width));
    res = s48_cons_2(call, t, res);
  }
  if (mask & CWSibling) {
    t = scx_enter_window_change(call, 5);
    t = s48_cons_2(call, t, scx_enter_window(call, WC->sibling));
    res = s48_cons_2(call, t, res);
  }
  if (mask & CWStackMode) {
    t = scx_enter_window_change(call, 6);
    t = s48_cons_2(call, t, scx_enter_stack_mode(call, WC->stack_mode));
    res = s48_cons_2(call, t, res);
  }

  return res;
}

unsigned long scx_extract_window_changes(s48_call_t call, s48_ref_t changes,
					 XWindowChanges* WC) {
  unsigned long mask = 0;
  s48_ref_t v = s48_false_2(call);

  while (!s48_null_p_2(call, changes)) {
    int mv = scx_extract_window_change(call, 
               s48_car_2(call, s48_car_2(call, changes)));
    v = s48_cdr_2(call, s48_car_2(call, changes));
    changes = s48_cdr_2(call, changes);
    mask = mask | (1L << mv);
    switch (1L << mv) {
    case CWX:
      WC->x = s48_extract_long_2(call, v); break;
    case CWY:
      WC->y = s48_extract_long_2(call, v); break;
    case CWWidth:
      WC->width = s48_extract_long_2(call, v); break;
    case CWHeight:
      WC->height = s48_extract_long_2(call, v); break;
    case CWBorderWidth:
      WC->border_width = s48_extract_long_2(call, v); break;
    case CWSibling:
      WC->sibling = scx_extract_window(call, v); break;
    case CWStackMode:
      WC->stack_mode = scx_extract_stack_mode(call, v); break;
    }
  }
  return mask;
}

s48_ref_t scx_Configure_Window(s48_call_t call, s48_ref_t display, 
			       s48_ref_t window, s48_ref_t changes) {
  XWindowChanges WC;
  unsigned long mask;
  mask = scx_extract_window_changes(call, changes, &WC);

  XConfigureWindow(scx_extract_display(call, display), 
                   scx_extract_window(call, window),
                   mask, &WC);
  return s48_unspecific_2(call);
}

s48_ref_t scx_window_attibutes_binding = NULL;

s48_ref_t scx_enter_window_attributes(s48_call_t call, XWindowAttributes* WA) {
  s48_ref_t v = s48_make_record_2(call, scx_window_attibutes_binding);

  s48_record_set_2(call, v, 0, s48_enter_long_2(call, WA->x));
  s48_record_set_2(call, v, 1, s48_enter_long_2(call, WA->y));
  s48_record_set_2(call, v, 2, s48_enter_long_2(call, WA->width));
  s48_record_set_2(call, v, 3, s48_enter_long_2(call, WA->height));
  s48_record_set_2(call, v, 4, s48_enter_long_2(call, WA->border_width));
  s48_record_set_2(call, v, 5, s48_enter_long_2(call, WA->depth));
  s48_record_set_2(call, v, 6, scx_enter_visual(call, WA->visual));
  s48_record_set_2(call, v, 7, scx_enter_window(call, WA->root));
  s48_record_set_2(call, v, 8, scx_enter_window_class(call, WA->class));
  s48_record_set_2(call, v, 9, scx_enter_bit_gravity(call, WA->bit_gravity));
  s48_record_set_2(call, v, 10, scx_enter_win_gravity(call, WA->win_gravity));
  s48_record_set_2(call, v, 11, scx_enter_backing_store(call, WA->backing_store));
  s48_record_set_2(call, v, 12, s48_enter_long_2(call, WA->backing_planes));
  s48_record_set_2(call, v, 13, scx_enter_pixel(call, WA->backing_pixel));
  s48_record_set_2(call, v, 14, s48_enter_boolean_2(call, WA->save_under));
  s48_record_set_2(call, v, 15, scx_enter_colormap(call, WA->colormap));
  s48_record_set_2(call, v, 16, s48_enter_boolean_2(call, WA->map_installed));
  s48_record_set_2(call, v, 17, scx_enter_map_state(call, WA->map_state));
  s48_record_set_2(call, v, 18, scx_enter_event_mask(call, WA->all_event_masks));
  s48_record_set_2(call, v, 19, scx_enter_event_mask(call, WA->your_event_mask));
  s48_record_set_2(call, v, 20, scx_enter_event_mask(call, WA->do_not_propagate_mask));
  s48_record_set_2(call, v, 21, s48_enter_boolean_2(call, WA->override_redirect));
  s48_record_set_2(call, v, 22, scx_enter_screen(call, WA->screen));
  return v;
}

s48_ref_t scx_Get_Window_Attributes(s48_call_t call, s48_ref_t display, 
				    s48_ref_t window) {
  XWindowAttributes WA;
  if (!XGetWindowAttributes(scx_extract_display(call, display),
			    scx_extract_window(call, window),
			    &WA))
    return s48_false_2(call);
  else
    return scx_enter_window_attributes(call, &WA);
}

s48_ref_t scx_Get_Geometry(s48_call_t call, s48_ref_t display, 
			   s48_ref_t drawable) {
  s48_ref_t v = s48_false_2(call);
  Window root;
  int x, y;
  unsigned int width, height, border_width, depth;

  if (!XGetGeometry(scx_extract_display(call, display),
		    scx_extract_drawable(call, drawable),
		    &root, &x, &y, &width, &height, &border_width, &depth))
    return s48_false_2(call);
  else {
    v = s48_make_vector_2(call, 7, s48_false_2(call));
    s48_vector_set_2(call, v, 0, scx_enter_window(call, root));
    s48_vector_set_2(call, v, 1, s48_enter_long_as_fixnum_2(call, x));
    s48_vector_set_2(call, v, 2, s48_enter_long_as_fixnum_2(call, y));
    s48_vector_set_2(call, v, 3, s48_enter_long_as_fixnum_2(call, width));
    s48_vector_set_2(call, v, 4, s48_enter_long_as_fixnum_2(call, height));
    s48_vector_set_2(call, v, 5, s48_enter_long_as_fixnum_2(call, border_width));
    s48_vector_set_2(call, v, 6, s48_enter_long_as_fixnum_2(call, depth));
    return v;
  }
}

s48_ref_t scx_Map_Window(s48_call_t call, s48_ref_t display, s48_ref_t window) {
  XMapWindow(scx_extract_display(call, display), 
	     scx_extract_window(call, window));
  return s48_unspecific_2(call);
}

s48_ref_t scx_Map_Raised(s48_call_t call, s48_ref_t display, s48_ref_t window) {
  XMapRaised(scx_extract_display(call, display), 
	     scx_extract_window(call, window));
  return s48_unspecific_2(call);
}

s48_ref_t scx_Map_Subwindows(s48_call_t call, s48_ref_t display, 
			     s48_ref_t window) {
  XMapSubwindows(scx_extract_display(call, display), 
		 scx_extract_window(call, window));
  return s48_unspecific_2(call);
}

s48_ref_t scx_Unmap_Window(s48_call_t call, s48_ref_t display, s48_ref_t window) {
  XUnmapWindow(scx_extract_display(call, display), 
	       scx_extract_window(call, window));
  return s48_unspecific_2(call);
}

s48_ref_t scx_Unmap_Subwindows(s48_call_t call, s48_ref_t display,
			       s48_ref_t window) {
  XUnmapSubwindows(scx_extract_display(call, display), 
		   scx_extract_window(call, window));
  return s48_unspecific_2(call);
}

s48_ref_t scx_Destroy_Window(s48_call_t call, s48_ref_t display, 
			     s48_ref_t window) {
  XDestroyWindow(scx_extract_display(call, display), 
		 scx_extract_window(call, window));
  return s48_unspecific_2(call);
}

s48_ref_t scx_Destroy_Subwindows(s48_call_t call, s48_ref_t display, 
				 s48_ref_t window) {
  XDestroySubwindows(scx_extract_display(call, display),
		     scx_extract_window(call, window));
  return s48_unspecific_2(call);
}

s48_ref_t scx_Raise_Window(s48_call_t call, s48_ref_t display, 
			   s48_ref_t window) {
  XRaiseWindow(scx_extract_display(call, display),
	       scx_extract_window(call, window));
  return s48_unspecific_2(call);
}

s48_ref_t scx_Lower_Window(s48_call_t call, s48_ref_t display,
			   s48_ref_t window) {
  XLowerWindow(scx_extract_display(call, display),
	       scx_extract_window(call, window));
  return s48_unspecific_2(call);
}

s48_ref_t scx_circulate_direction_binding = NULL;
#define scx_extract_direction(c, x) \
  S48_EXTRACT_ENUM(c, x, scx_circulate_direction_binding)

s48_ref_t scx_Circulate_Subwindows(s48_call_t call, s48_ref_t display, 
				   s48_ref_t window, s48_ref_t dir) {
  XCirculateSubwindows(scx_extract_display(call, display),
		       scx_extract_window(call, window), 
		       scx_extract_direction(call, dir));
  return s48_unspecific_2(call);
}

s48_ref_t scx_Restack_Windows(s48_call_t call, s48_ref_t display, 
			      s48_ref_t windows) {
  int i, n = s48_extract_long_2(call, s48_length_2(call, windows));
  
  Window wins[n];
  for (i = n-1; i >= 0; i--) {
    wins[i] = scx_extract_window(call, s48_car_2(call, windows));
    windows = s48_cdr_2(call, windows);
  }
  XRestackWindows(scx_extract_display(call, display),
		  wins, n);
  return s48_unspecific_2(call);
}

s48_ref_t scx_Clear_Area(s48_call_t call, s48_ref_t display, s48_ref_t window,
			 s48_ref_t x, s48_ref_t y,
			 s48_ref_t width, s48_ref_t height,
			 s48_ref_t exposures) {
  XClearArea(scx_extract_display(call, display), 
	     scx_extract_window(call, window),
	     s48_extract_long_2(call, x), s48_extract_long_2(call, y),
	     s48_extract_long_2(call, width), s48_extract_long_2(call, height),
	     s48_extract_boolean_2(call, exposures));
  return s48_unspecific_2(call);
}

s48_ref_t scx_Clear_Window(s48_call_t call, s48_ref_t display, s48_ref_t window) {
  XClearWindow(scx_extract_display(call, display),
	       scx_extract_window(call, window));
  return s48_unspecific_2(call);
}

s48_ref_t scx_Query_Tree(s48_call_t call, s48_ref_t display, s48_ref_t window) {
  Window root, parent, *children;
  int i;
  unsigned n;
  s48_ref_t c = s48_null_2(call), res = s48_null_2(call);
  
  if (! XQueryTree (scx_extract_display(call, display),
		    scx_extract_window(call, window), 
		    &root, &parent, &children, &n))
    return s48_false_2(call);

  for (i = 0; i < n; i++)
    c = s48_cons_2(call, scx_enter_window(call, children[i]), c);
  
  if (children != NULL) XFree(children);

  res = s48_cons_2(call, c, res);
  res = s48_cons_2(call, scx_enter_window(call, parent), res);
  res = s48_cons_2(call, scx_enter_window(call, root), res);

  return res;
}

s48_ref_t scx_Translate_Coordinates(s48_call_t call, s48_ref_t display, 
				    s48_ref_t src,
				    s48_ref_t dest,
				    s48_ref_t x, s48_ref_t y) {
  int rx, ry;
  Window child;
  s48_ref_t res = s48_null_2(call);

  if (!XTranslateCoordinates(scx_extract_display(call, display), 
			     scx_extract_window(call, src), 
			     scx_extract_window(call, dest),
			     (int)s48_extract_long_2(call, x), 
			     (int)s48_extract_long_2(call, y), 
			     &rx, &ry, &child))
    return s48_false_2(call);

  res = s48_cons_2(call, scx_enter_window(call, child), res);
  res = s48_cons_2(call, s48_enter_long_as_fixnum_2(call, ry), res);
  res = s48_cons_2(call, s48_enter_long_as_fixnum_2(call, rx), res);

  return res;
}

s48_ref_t scx_Query_Pointer(s48_call_t call, s48_ref_t display, 
			    s48_ref_t window) {
  s48_ref_t v = s48_false_2(call);
  Bool ret;
  Window root, child;
  int r_x, r_y, x, y;
  unsigned int mask;
  
  ret = XQueryPointer(scx_extract_display(call, display), 
          scx_extract_window(call, window),
		      &root, &child, &r_x, &r_y, &x, &y, &mask);

  v = s48_make_vector_2(call, 8, s48_false_2(call));

  s48_vector_set_2(call, v, 0, scx_enter_window(call, root));
  s48_vector_set_2(call, v, 1, scx_enter_window(call, child));
  s48_vector_set_2(call, v, 2, s48_enter_long_as_fixnum_2(call, r_x));
  s48_vector_set_2(call, v, 3, s48_enter_long_as_fixnum_2(call, r_y));
  s48_vector_set_2(call, v, 4, s48_enter_long_as_fixnum_2(call, x));
  s48_vector_set_2(call, v, 5, s48_enter_long_as_fixnum_2(call, y));
  s48_vector_set_2(call, v, 6, s48_enter_long_2(call, (unsigned long)mask));
  s48_vector_set_2(call, v, 7, ret ? s48_true_2(call) : s48_false_2(call));

  return v;
}

void scx_init_window(void) {
  scx_set_window_attribute_binding = 
    s48_get_imported_binding_2("scx-set-window-attribute");
  scx_window_attibutes_binding = 
    s48_get_imported_binding_2("scx-window-attributes");
  scx_circulate_direction_binding = 
    s48_get_imported_binding_2("scx-circulate-direction");

  S48_EXPORT_FUNCTION(scx_Create_Window);
  S48_EXPORT_FUNCTION(scx_Create_Simple_Window);
  S48_EXPORT_FUNCTION(scx_Change_Window_Attributes);
  S48_EXPORT_FUNCTION(scx_Configure_Window);
  S48_EXPORT_FUNCTION(scx_Get_Window_Attributes);
  S48_EXPORT_FUNCTION(scx_Get_Geometry);
  S48_EXPORT_FUNCTION(scx_Map_Window);
  S48_EXPORT_FUNCTION(scx_Map_Raised);
  S48_EXPORT_FUNCTION(scx_Map_Subwindows);
  S48_EXPORT_FUNCTION(scx_Unmap_Window);
  S48_EXPORT_FUNCTION(scx_Unmap_Subwindows);  
  S48_EXPORT_FUNCTION(scx_Destroy_Window);
  S48_EXPORT_FUNCTION(scx_Destroy_Subwindows);
  S48_EXPORT_FUNCTION(scx_Raise_Window);
  S48_EXPORT_FUNCTION(scx_Lower_Window);
  S48_EXPORT_FUNCTION(scx_Circulate_Subwindows);
  S48_EXPORT_FUNCTION(scx_Restack_Windows);
  S48_EXPORT_FUNCTION(scx_Clear_Area);
  S48_EXPORT_FUNCTION(scx_Clear_Window);
  S48_EXPORT_FUNCTION(scx_Query_Tree);
  S48_EXPORT_FUNCTION(scx_Translate_Coordinates);
  S48_EXPORT_FUNCTION(scx_Query_Pointer);
}