195 lines
5.1 KiB
C
195 lines
5.1 KiB
C
#include "xlib.h"
|
|
#include "scheme48.h"
|
|
|
|
|
|
s48_value Load_Font(s48_value Xdisplay, s48_value font_name) {
|
|
return ENTER_FONTSTRUCT(XLoadQueryFont(EXTRACT_DISPLAY(Xdisplay),
|
|
s48_extract_string(font_name)));
|
|
}
|
|
|
|
s48_value Free_Font(s48_value Xdisplay, s48_value Xfontstruct) {
|
|
XFreeFont(EXTRACT_DISPLAY(Xdisplay),
|
|
EXTRACT_FONTSTRUCT(Xfontstruct));
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
s48_value Get_Xfont(s48_value Xfontstruct) {
|
|
return ENTER_FONT((EXTRACT_FONTSTRUCT(Xfontstruct))->fid);
|
|
}
|
|
|
|
s48_value GContext_Font(s48_value Xdisplay, s48_value Xgcontext) {
|
|
GContext gc = XGContextFromGC(EXTRACT_GCONTEXT(Xgcontext));
|
|
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
|
|
return ENTER_FONTSTRUCT(XQueryFont(dpy, gc));
|
|
}
|
|
|
|
s48_value Font_Path(s48_value Xdisplay) {
|
|
int n, i;
|
|
char** sa;
|
|
s48_value ret;
|
|
S48_DECLARE_GC_PROTECT(1);
|
|
|
|
// Enable/Disable Interrupts ??
|
|
sa = XGetFontPath(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 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(EXTRACT_DISPLAY(Xdisplay), sa, n);
|
|
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
s48_value List_Font_Names(s48_value Xdisplay, s48_value pattern) {
|
|
char** sa;
|
|
int i,n;
|
|
s48_value v;
|
|
S48_DECLARE_GC_PROTECT(1);
|
|
|
|
XListFonts(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 List_Fonts(s48_value Xdisplay, s48_value pattern) {
|
|
char** sa;
|
|
XFontStruct* fsa;
|
|
int i,n;
|
|
s48_value v;
|
|
S48_DECLARE_GC_PROTECT(1);
|
|
|
|
XListFontsWithInfo(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]),
|
|
ENTER_FONTSTRUCT(&fsa[i])));
|
|
}
|
|
S48_GC_UNPROTECT();
|
|
XFreeFontNames(sa);
|
|
|
|
return v;
|
|
}
|
|
|
|
s48_value Font_Properties(s48_value Xfontstruct) {
|
|
s48_value v;
|
|
int i,n;
|
|
XFontStruct* fs = 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( ENTER_ATOM(p->name),
|
|
s48_enter_integer(p->card32) ));
|
|
}
|
|
S48_GC_UNPROTECT();
|
|
return v;
|
|
}
|
|
|
|
s48_value Font_Property(s48_value Xfontstruct, s48_value Xatom) {
|
|
unsigned long val;
|
|
if (XGetFontProperty(EXTRACT_FONTSTRUCT(Xfontstruct),
|
|
EXTRACT_ATOM(Xatom),
|
|
&val))
|
|
return s48_enter_integer(val);
|
|
else
|
|
return S48_FALSE;
|
|
}
|
|
|
|
s48_value Font_Info(s48_value Xfontstruct) {
|
|
XFontStruct* fs = 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;
|
|
}
|
|
|
|
static s48_value Char_Info(s48_value Xfontstruct, s48_value index) {
|
|
// index must be an integer, #f for 'min or #t for 'max
|
|
XCharStruct* cp;
|
|
XFontStruct* p = EXTRACT_FONTSTRUCT(Xfontstruct);
|
|
s48_value v;
|
|
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;
|
|
}
|
|
|
|
s48_init_font() {
|
|
S48_EXPORT_FUNCTION(Load_Font);
|
|
S48_EXPORT_FUNCTION(Free_Font);
|
|
S48_EXPORT_FUNCTION(Get_Xfont);
|
|
S48_EXPORT_FUNCTION(GContext_Font);
|
|
S48_EXPORT_FUNCTION(Font_Path);
|
|
S48_EXPORT_FUNCTION(Set_Font_Path);
|
|
S48_EXPORT_FUNCTION(Font_Property);
|
|
S48_EXPORT_FUNCTION(Font_Properties);
|
|
S48_EXPORT_FUNCTION(List_Fonts);
|
|
S48_EXPORT_FUNCTION(List_Font_Names);
|
|
S48_EXPORT_FUNCTION(Font_Info);
|
|
S48_EXPORT_FUNCTION(Char_Info);
|
|
}
|