scx/c/xlib/font.c

#include "xlib.h"
#include "scheme48.h"


s48_value scx_Load_Font(s48_value Xdisplay, s48_value font_name) {
  return SCX_ENTER_FONTSTRUCT(XLoadQueryFont(SCX_EXTRACT_DISPLAY(Xdisplay),
					 s48_extract_string(font_name)));
}

s48_value scx_Free_Font(s48_value Xdisplay, s48_value Xfontstruct) {
  XFreeFont(SCX_EXTRACT_DISPLAY(Xdisplay),
	    SCX_EXTRACT_FONTSTRUCT(Xfontstruct));
  return S48_UNSPECIFIC;
}

s48_value scx_Get_Xfont(s48_value Xfontstruct) {
  return SCX_ENTER_FONT((SCX_EXTRACT_FONTSTRUCT(Xfontstruct))->fid);
}

s48_value scx_GContext_Font(s48_value Xdisplay, s48_value Xgcontext) {
  GContext gc = XGContextFromGC(SCX_EXTRACT_GCONTEXT(Xgcontext));
  Display* dpy = SCX_EXTRACT_DISPLAY(Xdisplay);
  return SCX_ENTER_FONTSTRUCT(XQueryFont(dpy, gc));
}

s48_value scx_Font_Path(s48_value Xdisplay) {
  int n, i;
  char** sa;
  s48_value ret = S48_FALSE;
  S48_DECLARE_GC_PROTECT(1);  

  // Enable/Disable Interrupts ??
  sa = XGetFontPath(SCX_EXTRACT_DISPLAY(Xdisplay), &n);
  ret = s48_make_vector(n, S48_FALSE);
  S48_GC_PROTECT_1(ret);
  for (i = 0; i < n; i++) {
    S48_VECTOR_SET(ret, i, s48_enter_string(sa[i]));
  }
  S48_GC_UNPROTECT();
  XFreeFontPath(sa);

  return ret;
}

s48_value scx_Set_Font_Path(s48_value Xdisplay, s48_value path) {
  int i, n = S48_VECTOR_LENGTH(path);
  char* sa[n];
  
  for (i = 0; i < n; i++) {
    sa[i] = s48_extract_string(S48_VECTOR_REF(path, i));
  }
  XSetFontPath(SCX_EXTRACT_DISPLAY(Xdisplay), sa, n);

  return S48_UNSPECIFIC;
}
	       
s48_value scx_List_Font_Names(s48_value Xdisplay, s48_value pattern) {
  char** sa;
  int i,n;
  s48_value v = S48_FALSE;
  S48_DECLARE_GC_PROTECT(1);

  XListFonts(SCX_EXTRACT_DISPLAY(Xdisplay), 
	     s48_extract_string(pattern),
	     65535,
	     &n);
  
  v = s48_make_vector(n, S48_FALSE);
  S48_GC_PROTECT_1(v);
  for (i = 0; i < n; i++) {
    S48_VECTOR_SET(v, i, s48_enter_string(sa[i]));
  }
  S48_GC_UNPROTECT();
  XFreeFontNames(sa);

  return v;
}

s48_value scx_List_Fonts(s48_value Xdisplay, s48_value pattern) {
  char** sa;
  XFontStruct* fsa;
  int i,n;
  s48_value v = S48_FALSE;
  S48_DECLARE_GC_PROTECT(1);

  XListFontsWithInfo(SCX_EXTRACT_DISPLAY(Xdisplay), 
		     s48_extract_string(pattern),
		     65535,
		     &n,
		     &fsa);
  
  v = s48_make_vector(n, S48_FALSE);
  S48_GC_PROTECT_1(v);
  for (i = 0; i < n; i++) {
    S48_VECTOR_SET(v, i, s48_cons(s48_enter_string(sa[i]),
				  SCX_ENTER_FONTSTRUCT(&fsa[i])));
  }
  S48_GC_UNPROTECT();
  XFreeFontNames(sa);

  return v;
}

s48_value scx_Font_Properties(s48_value Xfontstruct) {
  s48_value v = S48_FALSE;
  int i,n;
  XFontStruct* fs = SCX_EXTRACT_FONTSTRUCT(Xfontstruct);
  XFontProp* p;
  S48_DECLARE_GC_PROTECT(1);

  n = fs->n_properties;
  v = s48_make_vector(n, S48_FALSE);
  S48_GC_PROTECT_1(v);

  for (i = 0; i < n; i++) {
    p = fs->properties+i;
    S48_VECTOR_SET(v, i, s48_cons( SCX_ENTER_ATOM(p->name),
				   s48_enter_integer(p->card32) ));
  }
  S48_GC_UNPROTECT();
  return v;
}

s48_value scx_Font_Property(s48_value Xfontstruct, s48_value Xatom) {
  unsigned long val;
  if (XGetFontProperty(SCX_EXTRACT_FONTSTRUCT(Xfontstruct),
		       SCX_EXTRACT_ATOM(Xatom),
		       &val))
    return s48_enter_integer(val);
  else
    return S48_FALSE;
}

s48_value scx_Font_Info(s48_value Xfontstruct) {
  XFontStruct* fs = SCX_EXTRACT_FONTSTRUCT(Xfontstruct);
  s48_value v = s48_make_vector(9, S48_FALSE);
  S48_DECLARE_GC_PROTECT(1);
  S48_GC_PROTECT_1(v);
  
  S48_VECTOR_SET(v, 0, Bit_To_Symbol(fs->direction, Direction_Syms));
  S48_VECTOR_SET(v, 1, s48_enter_integer(fs->min_char_or_byte2));
  S48_VECTOR_SET(v, 2, s48_enter_integer(fs->max_char_or_byte2));
  S48_VECTOR_SET(v, 3, s48_enter_integer(fs->min_byte1));
  S48_VECTOR_SET(v, 4, s48_enter_integer(fs->max_byte1));
  S48_VECTOR_SET(v, 5, S48_ENTER_BOOLEAN(fs->all_chars_exist));
  S48_VECTOR_SET(v, 6, s48_enter_integer(fs->default_char));
  S48_VECTOR_SET(v, 7, s48_enter_integer(fs->ascent));
  S48_VECTOR_SET(v, 8, s48_enter_integer(fs->descent));

  S48_GC_UNPROTECT();
  return v;
}

s48_value scx_Char_Info(s48_value Xfontstruct, s48_value index) {
  // index must be an integer, #f for 'min or #t for 'max
  XCharStruct* cp;
  XFontStruct* p = SCX_EXTRACT_FONTSTRUCT(Xfontstruct);
  s48_value v = S48_FALSE;
  S48_DECLARE_GC_PROTECT(1);

  if (S48_FALSE_P(index))
    cp = &p->min_bounds;
  else if (S48_TRUE_P(index))
    cp = &p->max_bounds;
  else
    cp = &(p->per_char[s48_extract_integer(index)]); // calculated in scheme
  
  v = s48_make_vector(6, S48_FALSE);
  S48_GC_PROTECT_1(v);
  S48_VECTOR_SET(v, 0, s48_enter_integer(cp->lbearing));
  S48_VECTOR_SET(v, 1, s48_enter_integer(cp->rbearing));
  S48_VECTOR_SET(v, 2, s48_enter_integer(cp->width));
  S48_VECTOR_SET(v, 3, s48_enter_integer(cp->ascent));
  S48_VECTOR_SET(v, 4, s48_enter_integer(cp->descent));
  S48_VECTOR_SET(v, 5, s48_enter_integer(cp->attributes));

  S48_GC_UNPROTECT();
  return v;
}

void scx_init_font(void) {
  S48_EXPORT_FUNCTION(scx_Load_Font);
  S48_EXPORT_FUNCTION(scx_Free_Font);
  S48_EXPORT_FUNCTION(scx_Get_Xfont);
  S48_EXPORT_FUNCTION(scx_GContext_Font);
  S48_EXPORT_FUNCTION(scx_Font_Path);
  S48_EXPORT_FUNCTION(scx_Set_Font_Path);
  S48_EXPORT_FUNCTION(scx_Font_Property);
  S48_EXPORT_FUNCTION(scx_Font_Properties);
  S48_EXPORT_FUNCTION(scx_List_Fonts);
  S48_EXPORT_FUNCTION(scx_List_Font_Names);
  S48_EXPORT_FUNCTION(scx_Font_Info);
  S48_EXPORT_FUNCTION(scx_Char_Info);
}