Update of /cvsroot/scsh/scx/c/xlib
In directory usw-pr-cvs1:/tmp/cvs-serv6209
Modified Files:
font.c
Log Message:
implemented the functions for scx.
Index: font.c
===================================================================
RCS file: /cvsroot/scsh/scx/c/xlib/font.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
*** font.c 2001/05/14 13:48:37 1.2
--- font.c 2001/07/18 15:44:41 1.3
***************
*** 1,299 ****
#include "xlib.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;
! }
!
! 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);
! }
!
! 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;
! }
!
! /* 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 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);
! }
!
! Font Get_Font (f) s48_value f; {
! Check_Type (f, T_Font);
! Open_Font_Maybe (f);
! return FONT(f)->id;
! }
!
! static XFontStruct *Internal_Open_Font (d, name) Display *d; s48_value name; {
! register char *s;
! XFontStruct *p;
! Alloca_Begin;
!
! 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;
! }
!
! static s48_value P_Open_Font (d, name) s48_value d, name; {
! XFontStruct *p;
!
! Check_Type (d, T_Display)
! p = Internal_Open_Font (DISPLAY(d)->dpy, name);
! return Make_Font (DISPLAY(d)->dpy, name, p->fid, p);
! }
!
! 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 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;
! }
!
! static s48_value P_Font_Name (f) s48_value f; {
! Check_Type (f, T_Font);
! return FONT(f)->name;
! }
!
! 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;
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);
! }
!
! 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);
}
--- 1,194 ----
#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);
}
|