implemented the functions for scx.
This commit is contained in:
frese
parent
95d78bf9bb
commit
3a18c650e5
433
c/xlib/font.c
433
c/xlib/font.c
|
|
@ -1,299 +1,194 @@
|
|||
#include "xlib.h"
|
||||
#include "scheme48.h"
|
||||
|
||||
s48_value Sym_Char_Info;
|
||||
static s48_value Sym_Font_Info, Sym_Min, Sym_Max;
|
||||
|
||||
Generic_Predicate (Font)
|
||||
|
||||
static Font_Equal (x, y) s48_value x, y; {
|
||||
Font id1 = FONT(x)->id, id2 = FONT(y)->id;
|
||||
if (id1 && id2)
|
||||
return id1 == id2 && FONT(x)->dpy == FONT(y)->dpy;
|
||||
else
|
||||
return 0;
|
||||
s48_value Load_Font(s48_value Xdisplay, s48_value font_name) {
|
||||
return ENTER_FONTSTRUCT(XLoadQueryFont(EXTRACT_DISPLAY(Xdisplay),
|
||||
s48_extract_string(font_name)));
|
||||
}
|
||||
|
||||
Generic_Print (Font, "#[font %lu]", FONT(x)->id ? FONT(x)->id : POINTER(x))
|
||||
|
||||
static Font_Visit (fp, f) s48_value *fp; int (*f)(); {
|
||||
(*f)(&FONT(*fp)->name);
|
||||
s48_value Free_Font(s48_value Xdisplay, s48_value Xfontstruct) {
|
||||
XFreeFont(EXTRACT_DISPLAY(Xdisplay),
|
||||
EXTRACT_FONTSTRUCT(Xfontstruct));
|
||||
return S48_UNSPECIFIC;
|
||||
}
|
||||
|
||||
Generic_Get_Display (Font, FONT)
|
||||
|
||||
static s48_value Internal_Make_Font (finalize, dpy, name, id, info)
|
||||
Display *dpy; s48_value name; Font id; XFontStruct *info; {
|
||||
s48_value f;
|
||||
S48_DECLARE_GC_PROTECT(1);
|
||||
|
||||
S48_GC_PROTECT_1 (name);
|
||||
f = Alloc_Object (sizeof (struct S_Font), T_Font, 0);
|
||||
FONT(f)->dpy = dpy;
|
||||
if (TYPE(name) == T_Symbol)
|
||||
name = s48_extract_string(S48_SYMBOL_TO_STRING(name));
|
||||
FONT(f)->name = name;
|
||||
FONT(f)->id = id;
|
||||
FONT(f)->info = info;
|
||||
if (id)
|
||||
Register_Object (f, (GENERIC)dpy, finalize ? P_Close_Font : (PFO)0, 0);
|
||||
S48_GC_UNPROTECT;
|
||||
return f;
|
||||
s48_value Get_Xfont(s48_value Xfontstruct) {
|
||||
return ENTER_FONT((EXTRACT_FONTSTRUCT(Xfontstruct))->fid);
|
||||
}
|
||||
|
||||
/* Backwards compatibility: */
|
||||
s48_value Make_Font (dpy, name, id, info)
|
||||
Display *dpy; s48_value name; Font id; XFontStruct *info; {
|
||||
return Internal_Make_Font (1, dpy, name, id, info);
|
||||
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 Make_Font_Foreign (dpy, name, id, info)
|
||||
Display *dpy; s48_value name; Font id; XFontStruct *info; {
|
||||
return Internal_Make_Font (0, dpy, name, id, info);
|
||||
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;
|
||||
}
|
||||
|
||||
Font Get_Font (f) s48_value f; {
|
||||
Check_Type (f, T_Font);
|
||||
Open_Font_Maybe (f);
|
||||
return FONT(f)->id;
|
||||
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;
|
||||
}
|
||||
|
||||
static XFontStruct *Internal_Open_Font (d, name) Display *d; s48_value name; {
|
||||
register char *s;
|
||||
XFontStruct *p;
|
||||
Alloca_Begin;
|
||||
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);
|
||||
|
||||
Get_Strsym_Stack (name, s);
|
||||
Disable_Interrupts;
|
||||
if ((p = XLoadQueryFont (d, s)) == 0)
|
||||
Primitive_Error ("cannot open font: ~s", name);
|
||||
Enable_Interrupts;
|
||||
Alloca_End;
|
||||
return p;
|
||||
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;
|
||||
}
|
||||
|
||||
static s48_value P_Open_Font (d, name) s48_value d, name; {
|
||||
XFontStruct *p;
|
||||
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);
|
||||
|
||||
Check_Type (d, T_Display)
|
||||
p = Internal_Open_Font (DISPLAY(d)->dpy, name);
|
||||
return Make_Font (DISPLAY(d)->dpy, name, p->fid, p);
|
||||
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;
|
||||
}
|
||||
|
||||
void Open_Font_Maybe (f) s48_value f; {
|
||||
s48_value name;
|
||||
XFontStruct *p;
|
||||
|
||||
name = FONT(f)->name;
|
||||
if (!S48_TRUE_P (name))
|
||||
Primitive_Error ("invalid font");
|
||||
if (FONT(f)->id == 0) {
|
||||
p = Internal_Open_Font (FONT(f)->dpy, name);
|
||||
FONT(f)->id = p->fid;
|
||||
FONT(f)->info = p;
|
||||
Register_Object (f, (GENERIC)(FONT(f)->dpy), P_Close_Font, 0);
|
||||
}
|
||||
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 P_Close_Font (f) s48_value f; {
|
||||
Check_Type (f, T_Font);
|
||||
if (FONT(f)->id)
|
||||
XUnloadFont (FONT(f)->dpy, FONT(f)->id);
|
||||
FONT(f)->id = 0;
|
||||
Deregister_Object (f);
|
||||
return Void;
|
||||
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 P_Font_Name (f) s48_value f; {
|
||||
Check_Type (f, T_Font);
|
||||
return FONT(f)->name;
|
||||
}
|
||||
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);
|
||||
|
||||
static s48_value P_Gcontext_Font (g) s48_value g; {
|
||||
register struct S_Gc *p;
|
||||
register XFontStruct *info;
|
||||
|
||||
Check_Type (g, T_Gc);
|
||||
p = GCONTEXT(g);
|
||||
Disable_Interrupts;
|
||||
info = XQueryFont (p->dpy, XGContextFromGC (p->gc));
|
||||
Enable_Interrupts;
|
||||
return Make_Font_Foreign (p->dpy, S48_FALSE, (Font)0, info);
|
||||
}
|
||||
|
||||
static s48_value Internal_List_Fonts (d, pat, with_info) s48_value d, pat; {
|
||||
char **ret;
|
||||
int n;
|
||||
XFontStruct *iret;
|
||||
register i;
|
||||
s48_value f, v;
|
||||
Display *dpy;
|
||||
S48_DECLARE_GC_PROTECT(2);
|
||||
|
||||
Check_Type (d, T_Display);
|
||||
dpy = DISPLAY(d)->dpy;
|
||||
Disable_Interrupts;
|
||||
if (with_info)
|
||||
ret = XListFontsWithInfo (dpy, Get_Strsym (pat), 65535, &n, &iret);
|
||||
else
|
||||
ret = XListFonts (dpy, Get_Strsym (pat), 65535, &n);
|
||||
Enable_Interrupts;
|
||||
v = s48_make_vector (n, S48_NULL);
|
||||
f = S48_NULL;
|
||||
S48_GC_PROTECT_2 (f, v);
|
||||
for (i = 0; i < n; i++) {
|
||||
f = Make_String (ret[i], strlen (ret[i]));
|
||||
if (with_info)
|
||||
f = Make_Font (dpy, f, (Font)0, &iret[i]);
|
||||
S48_VECTOR_SET(v, i, f;)
|
||||
}
|
||||
S48_GC_UNPROTECT;
|
||||
if (with_info)
|
||||
XFreeFontInfo (ret, (XFontStruct *)0, 0);
|
||||
else
|
||||
XFreeFontNames (ret);
|
||||
return v;
|
||||
}
|
||||
|
||||
static s48_value P_List_Font_Names (d, pat) s48_value d, pat; {
|
||||
return Internal_List_Fonts (d, pat, 0);
|
||||
}
|
||||
|
||||
static s48_value P_List_Fonts (d, pat) s48_value d, pat; {
|
||||
return Internal_List_Fonts (d, pat, 1);
|
||||
}
|
||||
|
||||
static s48_value P_Font_Info (f) s48_value f; {
|
||||
Check_Type (f, T_Font);
|
||||
FI = *FONT(f)->info;
|
||||
return Record_To_Vector (Font_Info_Rec, Font_Info_Size,
|
||||
Sym_Font_Info, FONT(f)->dpy, ~0L);
|
||||
}
|
||||
|
||||
static s48_value P_Char_Info (f, index) s48_value f, index; {
|
||||
register t = TYPE(index);
|
||||
register unsigned i;
|
||||
register XCharStruct *cp;
|
||||
register XFontStruct *p;
|
||||
char *msg = "argument must be integer, character, 'min, or 'max";
|
||||
|
||||
Check_Type (f, T_Font);
|
||||
Open_Font_Maybe (f);
|
||||
p = FONT(f)->info;
|
||||
if (S48_FALSE_P(index))
|
||||
cp = &p->min_bounds;
|
||||
else if (S48_TRUE_P(index))
|
||||
cp = &p->max_bounds;
|
||||
if (t == T_Symbol) {
|
||||
if (S48_EQ_P(index, Sym_Min))
|
||||
cp = &p->min_bounds;
|
||||
else if (!S48_EQ_P(index, Sym_Max))
|
||||
Primitive_Error (msg);
|
||||
} else {
|
||||
if (t == T_Character)
|
||||
i = s48_extract_char(index);
|
||||
else if (t == T_Fixnum || t == T_Bignum)
|
||||
i = (unsigned)(int)s48_extract_integer (index);
|
||||
else
|
||||
Primitive_Error (msg);
|
||||
if (!p->min_byte1 && !p->max_byte1) {
|
||||
if (i < p->min_char_or_byte2 || i > p->max_char_or_byte2)
|
||||
Range_Error (index);
|
||||
i -= p->min_char_or_byte2;
|
||||
} else {
|
||||
register unsigned b1 = i & 0xff, b2 = (i >> 8) & 0xff;
|
||||
if (b1 < p->min_byte1 || b1 > p->max_byte1 ||
|
||||
b2 < p->min_char_or_byte2 || b2 > p->max_char_or_byte2)
|
||||
Range_Error (index);
|
||||
b1 -= p->min_byte1;
|
||||
b2 -= p->min_char_or_byte2;
|
||||
i = b1 * (p->max_char_or_byte2 - p->min_char_or_byte2 + 1) + b2;
|
||||
}
|
||||
if (p->per_char)
|
||||
cp = p->per_char + i;
|
||||
}
|
||||
CI = *cp;
|
||||
return Record_To_Vector (Char_Info_Rec, Char_Info_Size,
|
||||
Sym_Char_Info, FONT(f)->dpy, ~0L);
|
||||
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;
|
||||
}
|
||||
|
||||
static s48_value P_Font_Properties (f) s48_value f; {
|
||||
register i, n;
|
||||
s48_value v, a, val, x;
|
||||
S48_DECLARE_GC_PROTECT(4);
|
||||
|
||||
Check_Type (f, T_Font);
|
||||
n = FONT(f)->info->n_properties;
|
||||
v = s48_make_vector (n, S48_NULL);
|
||||
a = val = S48_NULL;
|
||||
S48_GC_PROTECT_4 (v, a, val, f);
|
||||
for (i = 0; i < n; i++) {
|
||||
register XFontProp *p = FONT(f)->info->properties+i;
|
||||
a = Make_Atom (p->name);
|
||||
val = s48_enter_integer ((unsigned long)p->card32);
|
||||
x = s48_cons (a, val);
|
||||
S48_VECTOR_SET(v, i, x;)
|
||||
}
|
||||
S48_GC_UNPROTECT;
|
||||
return v;
|
||||
}
|
||||
|
||||
static s48_value P_Font_Path (d) s48_value d; {
|
||||
s48_value v;
|
||||
int i, n;
|
||||
char **ret;
|
||||
S48_DECLARE_GC_PROTECT(1);
|
||||
|
||||
Check_Type (d, T_Display);
|
||||
Disable_Interrupts;
|
||||
ret = XGetFontPath (DISPLAY(d)->dpy, &n);
|
||||
Enable_Interrupts;
|
||||
v = s48_make_vector (n, S48_NULL);
|
||||
S48_GC_PROTECT_1 (v);
|
||||
for (i = 0; i < n; i++) {
|
||||
s48_value x;
|
||||
|
||||
x = Make_String (ret[i], strlen (ret[i]));
|
||||
S48_VECTOR_SET(v, i, x;)
|
||||
}
|
||||
S48_GC_UNPROTECT;
|
||||
XFreeFontPath (ret);
|
||||
return P_Vector_To_List (v);
|
||||
}
|
||||
|
||||
static s48_value P_Set_Font_Path (d, p) s48_value d, p; {
|
||||
register char **path;
|
||||
register i, n;
|
||||
s48_value c;
|
||||
Alloca_Begin;
|
||||
|
||||
Check_Type (d, T_Display);
|
||||
Check_List (p);
|
||||
n = Fast_Length (p);
|
||||
Alloca (path, char**, n * sizeof (char *));
|
||||
for (i = 0; i < n; i++, p = S48_CDR (p)) {
|
||||
c = S48_CAR (p);
|
||||
Get_Strsym_Stack (c, path[i]);
|
||||
}
|
||||
XSetFontPath (DISPLAY(d)->dpy, path, n);
|
||||
Alloca_End;
|
||||
return Void;
|
||||
}
|
||||
|
||||
elk_init_xlib_font () {
|
||||
Define_Symbol (&Sym_Font_Info, "font-info");
|
||||
Define_Symbol (&Sym_Char_Info, "char-info");
|
||||
Define_Symbol (&Sym_Min, "min");
|
||||
Define_Symbol (&Sym_Max, "max");
|
||||
T_Font = Define_Type (0, "font", NOFUNC, sizeof (struct S_Font),
|
||||
Font_Equal, Font_Equal, Font_Print, Font_Visit);
|
||||
Define_Primitive (P_Fontp, "font?", 1, 1, EVAL);
|
||||
Define_Primitive (P_Font_Display, "font-display", 1, 1, EVAL);
|
||||
Define_Primitive (P_Open_Font, "open-font", 2, 2, EVAL);
|
||||
Define_Primitive (P_Close_Font, "close-font", 1, 1, EVAL);
|
||||
Define_Primitive (P_Font_Name, "font-name", 1, 1, EVAL);
|
||||
Define_Primitive (P_Gcontext_Font, "gcontext-font", 1, 1, EVAL);
|
||||
Define_Primitive (P_List_Font_Names, "list-font-names", 2, 2, EVAL);
|
||||
Define_Primitive (P_List_Fonts, "list-fonts", 2, 2, EVAL);
|
||||
Define_Primitive (P_Font_Info, "xlib-font-info", 1, 1, EVAL);
|
||||
Define_Primitive (P_Char_Info, "xlib-char-info", 2, 2, EVAL);
|
||||
Define_Primitive (P_Font_Properties, "font-properties", 1, 1, EVAL);
|
||||
Define_Primitive (P_Font_Path, "font-path", 1, 1, EVAL);
|
||||
Define_Primitive (P_Set_Font_Path, "set-font-path!", 2, 2, EVAL);
|
||||
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);
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in New Issue