1 /* font.c
2 *
3 * $Id$
4 *
5 * Copyright 1990, 1991, 1992, 1993, 1994, 1995, Oliver Laumann, Berlin
6 * Copyright 2002, 2003 Sam Hocevar <sam@hocevar.net>, Paris
7 *
8 * This software was derived from Elk 1.2, which was Copyright 1987, 1988,
9 * 1989, Nixdorf Computer AG and TELES GmbH, Berlin (Elk 1.2 has been written
10 * by Oliver Laumann for TELES Telematic Services, Berlin, in a joint project
11 * between TELES and Nixdorf Microprocessor Engineering, Berlin).
12 *
13 * Oliver Laumann, TELES GmbH, Nixdorf Computer AG and Sam Hocevar, as co-
14 * owners or individual owners of copyright in this software, grant to any
15 * person or company a worldwide, royalty free, license to
16 *
17 * i) copy this software,
18 * ii) prepare derivative works based on this software,
19 * iii) distribute copies of this software or derivative works,
20 * iv) perform this software, or
21 * v) display this software,
22 *
23 * provided that this notice is not removed and that neither Oliver Laumann
24 * nor Teles nor Nixdorf are deemed to have made any representations as to
25 * the suitability of this software for any purpose nor are held responsible
26 * for any defects of this software.
27 *
28 * THERE IS ABSOLUTELY NO WARRANTY FOR THIS SOFTWARE.
29 */
30
31 #include "xlib.h"
32
33 #include <string.h>
34
35 Object Sym_Char_Info;
36 static Object Sym_Font_Info, Sym_Min, Sym_Max;
37
Generic_Predicate(Font)38 Generic_Predicate (Font)
39
40 static int Font_Equal (Object x, Object y) {
41 Font id1 = FONT(x)->id, id2 = FONT(y)->id;
42 if (id1 && id2)
43 return id1 == id2 && FONT(x)->dpy == FONT(y)->dpy;
44 else
45 return 0;
46 }
47
48 Generic_Print (Font, "#[font %lu]", FONT(x)->id ? FONT(x)->id
49 : (unsigned int)FIXNUM(x))
50
Font_Visit(Object * fp,int (* f)())51 static int Font_Visit (Object *fp, int (*f)()) {
52 (*f)(&FONT(*fp)->name);
53 return 0;
54 }
55
Generic_Get_Display(Font,FONT)56 Generic_Get_Display (Font, FONT)
57
58 static Object Internal_Make_Font (int finalize, Display *dpy, Object name,
59 Font id, XFontStruct *info) {
60 Object f;
61 GC_Node;
62
63 GC_Link (name);
64 f = Alloc_Object (sizeof (struct S_Font), T_Font, 0);
65 FONT(f)->dpy = dpy;
66 if (TYPE(name) == T_Symbol)
67 name = SYMBOL(name)->name;
68 FONT(f)->name = name;
69 FONT(f)->id = id;
70 FONT(f)->info = info;
71 if (id)
72 Register_Object (f, (GENERIC)dpy, finalize ? P_Close_Font : (PFO)0, 0);
73 GC_Unlink;
74 return f;
75 }
76
77 /* Backwards compatibility: */
Make_Font(Display * dpy,Object name,Font id,XFontStruct * info)78 Object Make_Font (Display *dpy, Object name, Font id, XFontStruct *info) {
79 return Internal_Make_Font (1, dpy, name, id, info);
80 }
81
Make_Font_Foreign(Display * dpy,Object name,Font id,XFontStruct * info)82 Object Make_Font_Foreign (Display *dpy, Object name, Font id,
83 XFontStruct *info) {
84 return Internal_Make_Font (0, dpy, name, id, info);
85 }
86
Get_Font(Object f)87 Font Get_Font (Object f) {
88 Check_Type (f, T_Font);
89 Open_Font_Maybe (f);
90 return FONT(f)->id;
91 }
92
Internal_Open_Font(Display * d,Object name)93 static XFontStruct *Internal_Open_Font (Display *d, Object name) {
94 register char *s;
95 XFontStruct *p;
96 Alloca_Begin;
97
98 Get_Strsym_Stack (name, s);
99 Disable_Interrupts;
100 if ((p = XLoadQueryFont (d, s)) == 0)
101 Primitive_Error ("cannot open font: ~s", name);
102 Enable_Interrupts;
103 Alloca_End;
104 return p;
105 }
106
P_Open_Font(Object d,Object name)107 static Object P_Open_Font (Object d, Object name) {
108 XFontStruct *p;
109
110 Check_Type (d, T_Display)
111 p = Internal_Open_Font (DISPLAY(d)->dpy, name);
112 return Make_Font (DISPLAY(d)->dpy, name, p->fid, p);
113 }
114
Open_Font_Maybe(Object f)115 void Open_Font_Maybe (Object f) {
116 Object name;
117 XFontStruct *p;
118
119 name = FONT(f)->name;
120 if (!Truep (name))
121 Primitive_Error ("invalid font");
122 if (FONT(f)->id == 0) {
123 p = Internal_Open_Font (FONT(f)->dpy, name);
124 FONT(f)->id = p->fid;
125 FONT(f)->info = p;
126 Register_Object (f, (GENERIC)(FONT(f)->dpy), P_Close_Font, 0);
127 }
128 }
129
P_Close_Font(Object f)130 Object P_Close_Font (Object f) {
131 Check_Type (f, T_Font);
132 if (FONT(f)->id)
133 XUnloadFont (FONT(f)->dpy, FONT(f)->id);
134 FONT(f)->id = 0;
135 Deregister_Object (f);
136 return Void;
137 }
138
P_Font_Name(Object f)139 static Object P_Font_Name (Object f) {
140 Check_Type (f, T_Font);
141 return FONT(f)->name;
142 }
143
P_Gcontext_Font(Object g)144 static Object P_Gcontext_Font (Object g) {
145 register struct S_Gc *p;
146 register XFontStruct *info;
147
148 Check_Type (g, T_Gc);
149 p = GCONTEXT(g);
150 Disable_Interrupts;
151 info = XQueryFont (p->dpy, XGContextFromGC (p->gc));
152 Enable_Interrupts;
153 return Make_Font_Foreign (p->dpy, False, (Font)0, info);
154 }
155
Internal_List_Fonts(Object d,Object pat,int with_info)156 static Object Internal_List_Fonts (Object d, Object pat, int with_info) {
157 char **ret;
158 int n;
159 XFontStruct *iret;
160 register int i;
161 Object f, v;
162 Display *dpy;
163 GC_Node2;
164
165 Check_Type (d, T_Display);
166 dpy = DISPLAY(d)->dpy;
167 Disable_Interrupts;
168 if (with_info)
169 ret = XListFontsWithInfo (dpy, Get_Strsym (pat), 65535, &n, &iret);
170 else
171 ret = XListFonts (dpy, Get_Strsym (pat), 65535, &n);
172 Enable_Interrupts;
173 v = Make_Vector (n, Null);
174 f = Null;
175 GC_Link2 (f, v);
176 for (i = 0; i < n; i++) {
177 f = Make_String (ret[i], strlen (ret[i]));
178 if (with_info)
179 f = Make_Font (dpy, f, (Font)0, &iret[i]);
180 VECTOR(v)->data[i] = f;
181 }
182 GC_Unlink;
183 if (with_info)
184 XFreeFontInfo (ret, (XFontStruct *)0, 0);
185 else
186 XFreeFontNames (ret);
187 return v;
188 }
189
P_List_Font_Names(Object d,Object pat)190 static Object P_List_Font_Names (Object d, Object pat) {
191 return Internal_List_Fonts (d, pat, 0);
192 }
193
P_List_Fonts(Object d,Object pat)194 static Object P_List_Fonts (Object d, Object pat) {
195 return Internal_List_Fonts (d, pat, 1);
196 }
197
P_Font_Info(Object f)198 static Object P_Font_Info (Object f) {
199 Check_Type (f, T_Font);
200 FI = *FONT(f)->info;
201 return Record_To_Vector (Font_Info_Rec, Font_Info_Size,
202 Sym_Font_Info, FONT(f)->dpy, ~0L);
203 }
204
P_Char_Info(Object f,Object index)205 static Object P_Char_Info (Object f, Object index) {
206 register int t = TYPE(index);
207 register unsigned int i;
208 register XCharStruct *cp;
209 register XFontStruct *p;
210 char *msg = "argument must be integer, character, 'min, or 'max";
211
212 Check_Type (f, T_Font);
213 Open_Font_Maybe (f);
214 p = FONT(f)->info;
215 cp = &p->max_bounds;
216 if (t == T_Symbol) {
217 if (EQ(index, Sym_Min))
218 cp = &p->min_bounds;
219 else if (!EQ(index, Sym_Max))
220 Primitive_Error (msg);
221 } else {
222 if (t == T_Character)
223 i = CHAR(index);
224 else if (t == T_Fixnum || t == T_Bignum)
225 i = (unsigned)Get_Integer (index);
226 else
227 Primitive_Error (msg);
228 if (!p->min_byte1 && !p->max_byte1) {
229 if (i < p->min_char_or_byte2 || i > p->max_char_or_byte2)
230 Range_Error (index);
231 i -= p->min_char_or_byte2;
232 } else {
233 register unsigned int b1 = i & 0xff, b2 = (i >> 8) & 0xff;
234 if (b1 < p->min_byte1 || b1 > p->max_byte1 ||
235 b2 < p->min_char_or_byte2 || b2 > p->max_char_or_byte2)
236 Range_Error (index);
237 b1 -= p->min_byte1;
238 b2 -= p->min_char_or_byte2;
239 i = b1 * (p->max_char_or_byte2 - p->min_char_or_byte2 + 1) + b2;
240 }
241 if (p->per_char)
242 cp = p->per_char + i;
243 }
244 CI = *cp;
245 return Record_To_Vector (Char_Info_Rec, Char_Info_Size,
246 Sym_Char_Info, FONT(f)->dpy, ~0L);
247 }
248
P_Font_Properties(Object f)249 static Object P_Font_Properties (Object f) {
250 register int i, n;
251 Object v, a, val, x;
252 GC_Node4;
253
254 Check_Type (f, T_Font);
255 n = FONT(f)->info->n_properties;
256 v = Make_Vector (n, Null);
257 a = val = Null;
258 GC_Link4 (v, a, val, f);
259 for (i = 0; i < n; i++) {
260 register XFontProp *p = FONT(f)->info->properties+i;
261 a = Make_Atom (p->name);
262 val = Make_Unsigned_Long ((unsigned long)p->card32);
263 x = Cons (a, val);
264 VECTOR(v)->data[i] = x;
265 }
266 GC_Unlink;
267 return v;
268 }
269
P_Font_Path(Object d)270 static Object P_Font_Path (Object d) {
271 Object v;
272 int i, n;
273 char **ret;
274 GC_Node;
275
276 Check_Type (d, T_Display);
277 Disable_Interrupts;
278 ret = XGetFontPath (DISPLAY(d)->dpy, &n);
279 Enable_Interrupts;
280 v = Make_Vector (n, Null);
281 GC_Link (v);
282 for (i = 0; i < n; i++) {
283 Object x;
284
285 x = Make_String (ret[i], strlen (ret[i]));
286 VECTOR(v)->data[i] = x;
287 }
288 GC_Unlink;
289 XFreeFontPath (ret);
290 return P_Vector_To_List (v);
291 }
292
P_Set_Font_Path(Object d,Object p)293 static Object P_Set_Font_Path (Object d, Object p) {
294 register char **path;
295 register int i, n;
296 Object c;
297 Alloca_Begin;
298
299 Check_Type (d, T_Display);
300 Check_List (p);
301 n = Fast_Length (p);
302 Alloca (path, char**, n * sizeof (char *));
303 for (i = 0; i < n; i++, p = Cdr (p)) {
304 c = Car (p);
305 Get_Strsym_Stack (c, path[i]);
306 }
307 XSetFontPath (DISPLAY(d)->dpy, path, n);
308 Alloca_End;
309 return Void;
310 }
311
elk_init_xlib_font()312 void elk_init_xlib_font () {
313 Define_Symbol (&Sym_Font_Info, "font-info");
314 Define_Symbol (&Sym_Char_Info, "char-info");
315 Define_Symbol (&Sym_Min, "min");
316 Define_Symbol (&Sym_Max, "max");
317 T_Font = Define_Type (0, "font", NOFUNC, sizeof (struct S_Font),
318 Font_Equal, Font_Equal, Font_Print, Font_Visit);
319 Define_Primitive (P_Fontp, "font?", 1, 1, EVAL);
320 Define_Primitive (P_Font_Display, "font-display", 1, 1, EVAL);
321 Define_Primitive (P_Open_Font, "open-font", 2, 2, EVAL);
322 Define_Primitive (P_Close_Font, "close-font", 1, 1, EVAL);
323 Define_Primitive (P_Font_Name, "font-name", 1, 1, EVAL);
324 Define_Primitive (P_Gcontext_Font, "gcontext-font", 1, 1, EVAL);
325 Define_Primitive (P_List_Font_Names, "list-font-names", 2, 2, EVAL);
326 Define_Primitive (P_List_Fonts, "list-fonts", 2, 2, EVAL);
327 Define_Primitive (P_Font_Info, "xlib-font-info", 1, 1, EVAL);
328 Define_Primitive (P_Char_Info, "xlib-char-info", 2, 2, EVAL);
329 Define_Primitive (P_Font_Properties, "font-properties", 1, 1, EVAL);
330 Define_Primitive (P_Font_Path, "font-path", 1, 1, EVAL);
331 Define_Primitive (P_Set_Font_Path, "set-font-path!", 2, 2, EVAL);
332 }
333