scheme48/c/scx/xlib/font.c

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

#include "xlib.h"

s48_ref_t scx_Load_Font(s48_call_t call, s48_ref_t display, s48_ref_t font_name) {
  Font f;
  f = XLoadFont(scx_extract_display(call, display),
		s48_extract_string(call, font_name));
  return scx_enter_font(call, f);
}

s48_ref_t scx_Unload_Font(s48_call_t call, s48_ref_t display, s48_ref_t font) 
{
  XUnloadFont(scx_extract_display(call, display),
	      scx_extract_font(call, font));
  return s48_unspecific_2(call);
}

s48_ref_t scx_Query_Font(s48_call_t call, s48_ref_t display, s48_ref_t font) 
{
  XFontStruct* fs;
  
  fs = XQueryFont(scx_extract_display(call, display),
		  scx_extract_font(call, font));
  if (fs == NULL)
    return s48_false_2(call);
  else
    return scx_enter_fontstruct(call, fs);
}

s48_ref_t scx_Load_Query_Font(s48_call_t call, s48_ref_t display, 
            s48_ref_t font_name) {
  XFontStruct* fs;

  fs = XLoadQueryFont(scx_extract_display(call, display),
                      s48_extract_string(call, font_name));

  if (fs == NULL) {
    return s48_false_2(call);
  }
  else {
    return scx_enter_fontstruct(call, fs);
  }
}

s48_ref_t scx_Free_Font(s48_call_t call, s48_ref_t display, 
           s48_ref_t fontstruct) {
  XFreeFont(scx_extract_display(call, display),
	    scx_extract_fontstruct(call, fontstruct));
  return s48_unspecific_2(call);
}

s48_ref_t scx_List_Fonts(s48_call_t call, s48_ref_t display,
            s48_ref_t pattern, s48_ref_t max) {
  s48_ref_t res = s48_null_2(call);
  int i, count;
  char** fonts;

  fonts = XListFonts(scx_extract_display(call, display),
		     s48_extract_string(call, pattern),
		     s48_extract_long_2(call, max), &count);
  for (i = count; i > 0; i--)
    res = s48_cons_2(call, s48_enter_string(call, fonts[i-1]), res);
  XFreeFontNames(fonts);
  return res;
}

s48_ref_t scx_List_Fonts_With_Info(s48_call_t call, s48_ref_t display, 
            s48_ref_t pattern, s48_ref_t max) {
  s48_ref_t res = s48_null_2(call), cell = s48_null_2(call);
  int i, count;
  char** fonts;
  XFontStruct* infos;

  fonts = XListFontsWithInfo(scx_extract_display(call, display),
			     s48_extract_string(call, pattern),
			     s48_extract_long_2(call, max), &count,
			     &infos);
  for (i = count; i > 0; i--) {
    cell = scx_enter_fontstruct(call, &infos[i-1]);
    cell = s48_cons_2(call, s48_enter_string(call, fonts[i-1]), cell);
    res = s48_cons_2(call, cell, res);
  }
  XFreeFontNames(fonts); /* FontStructs have to be freed later */
  return res;
}

s48_ref_t scx_Set_Font_Path(s48_call_t call, s48_ref_t display, s48_ref_t dirs) {
  int i, n = s48_extract_long_2(call, s48_length_2(call, dirs));
  char* sa[n];
  s48_ref_t l = dirs;
  for (i = 0; i < n; i++) {
    s48_ref_t temp = l;
    sa[i] = s48_extract_string(call, s48_car_2(call, l));
    l = s48_cdr_2(call, l);
    s48_free_local_ref(call, temp);
  }
  XSetFontPath(scx_extract_display(call, display), sa, n);

  return s48_unspecific_2(call);
}
	       
s48_ref_t scx_Get_Font_Path(s48_call_t call, s48_ref_t display) {
  int n, i;
  char** sa;
  s48_ref_t res = s48_null_2(call);

  sa = XGetFontPath(scx_extract_display(call, display), &n);

  for (i = n; i > 0; i--)
    res = s48_cons_2(call, s48_enter_string(call, sa[i]), res);
  XFreeFontPath(sa);

  return res;
}

/* TODO:

s48_ref_t scx_Font_Properties(s48_call_t call, s48_ref_t Xfontstruct) {
  s48_ref_t v, t = S48_FALSE;
  int i,n;
  XFontStruct* fs = scx_extract_fontstruct(Xfontstruct);
  XFontProp* p;
  S48_DECLARE_GC_PROTECT(2);

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

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

  S48_GC_UNPROTECT();
  return v;
}

s48_ref_t scx_Font_Property(s48_call_t call, s48_ref_t Xfontstruct, s48_ref_t 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_ref_t scx_Font_Info(s48_call_t call, s48_ref_t Xfontstruct) {
  XFontStruct* fs = scx_extract_fontstruct(Xfontstruct);
  s48_ref_t v = s48_make_vector(9, S48_FALSE);
  S48_DECLARE_GC_PROTECT(1);
  S48_GC_PROTECT_1(v);
  
  S48_VECTOR_SET(v, 0, s48_enter_fixnum(fs->direction));
  S48_VECTOR_SET(v, 1, s48_enter_fixnum(fs->min_char_or_byte2));
  S48_VECTOR_SET(v, 2, s48_enter_fixnum(fs->max_char_or_byte2));
  S48_VECTOR_SET(v, 3, s48_enter_fixnum(fs->min_byte1));
  S48_VECTOR_SET(v, 4, s48_enter_fixnum(fs->max_byte1));
  S48_VECTOR_SET(v, 5, S48_ENTER_BOOLEAN(fs->all_chars_exist));
  S48_VECTOR_SET(v, 6, s48_enter_fixnum(fs->default_char));
  S48_VECTOR_SET(v, 7, s48_enter_fixnum(fs->ascent));
  S48_VECTOR_SET(v, 8, s48_enter_fixnum(fs->descent));

  S48_GC_UNPROTECT();
  return v;
}

s48_ref_t scx_Char_Info(s48_call_t call, s48_ref_t Xfontstruct, s48_ref_t index) {
  // index must be an integer, #f for 'min or #t for 'max
  XCharStruct* cp;
  XFontStruct* p = scx_extract_fontstruct(Xfontstruct);
  s48_ref_t 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_fixnum(cp->lbearing));
  S48_VECTOR_SET(v, 1, s48_enter_fixnum(cp->rbearing));
  S48_VECTOR_SET(v, 2, s48_enter_fixnum(cp->width));
  S48_VECTOR_SET(v, 3, s48_enter_fixnum(cp->ascent));
  S48_VECTOR_SET(v, 4, s48_enter_fixnum(cp->descent));
  S48_VECTOR_SET(v, 5, s48_enter_fixnum(cp->attributes));

  S48_GC_UNPROTECT();
  return v;
}
*/

void scx_init_font(void) {
  S48_EXPORT_FUNCTION(scx_Load_Font);
  S48_EXPORT_FUNCTION(scx_Unload_Font);
  S48_EXPORT_FUNCTION(scx_Query_Font);
  S48_EXPORT_FUNCTION(scx_Load_Query_Font);
  S48_EXPORT_FUNCTION(scx_Free_Font);
  S48_EXPORT_FUNCTION(scx_List_Fonts);
  S48_EXPORT_FUNCTION(scx_List_Fonts_With_Info);
  S48_EXPORT_FUNCTION(scx_Set_Font_Path);
  S48_EXPORT_FUNCTION(scx_Get_Font_Path);
}