Context Navigation

Back to Ticket #24

Ticket #24: XftFontDescription.st

File XftFontDescription.st, 52.4 KB (added by Jan Vrany, 9 years ago)

Line
1	'From Smalltalk/X, Version:6.2.3.0 on 01-04-2014 at 15:41:10' !
2
3	"{ Package: 'stx:libview' }"
4
5	FontDescription subclass:#XftFontDescription
6	instanceVariableNames:'device fontId sharedDrawId closestFont minCode maxCode'
7	classVariableNames:'FC_FAMILY FC_STYLE FC_SLANT FC_WEIGHT FC_SIZE FC_ASPECT
8	FC_PIXEL_SIZE FC_SPACING FC_FOUNDRY FC_ANTIALIAS FC_HINTING
9	FC_HINT_STYLE FC_VERTICAL_LAYOUT FC_AUTOHINT FC_WIDTH FC_FILE
10	FC_INDEX FC_FT_FACE FC_RASTERIZER FC_OUTLINE FC_SCALABLE FC_SCALE
11	FC_DPI FC_RGBA FC_MINSPACE FC_SOURCE FC_CHARSET FC_LANG
12	FC_FONTVERSION FC_FULLNAME FC_FAMILYLANG FC_STYLELANG
13	FC_FULLNAMELANG FC_CAPABILITY FC_FONTFORMAT FC_EMBOLDEN
14	FC_EMBEDDED_BITMAP FC_DECORATIVE FC_LCD_FILTER FC_NAMELANG
15	FC_CHAR_WIDTH FC_CHAR_HEIGHT FC_MATRIX FC_WEIGHT_THIN
16	FC_WEIGHT_EXTRALIGHT FC_WEIGHT_ULTRALIGHT FC_WEIGHT_LIGHT
17	FC_WEIGHT_BOOK FC_WEIGHT_REGULAR FC_WEIGHT_NORMAL
18	FC_WEIGHT_MEDIUM FC_WEIGHT_DEMIBOLD FC_WEIGHT_SEMIBOLD
19	FC_WEIGHT_BOLD FC_WEIGHT_EXTRABOLD FC_WEIGHT_ULTRABOLD
20	FC_WEIGHT_BLACK FC_WEIGHT_HEAVY FC_WEIGHT_EXTRABLACK
21	FC_WEIGHT_ULTRABLACK FC_SLANT_ROMAN FC_SLANT_ITALIC
22	FC_SLANT_OBLIQUE FC_WIDTH_ULTRACONDENSED FC_WIDTH_EXTRACONDENSED
23	FC_WIDTH_CONDENSED FC_WIDTH_SEMICONDENSED FC_WIDTH_NORMAL
24	FC_WIDTH_SEMIEXPANDED FC_WIDTH_EXPANDED FC_WIDTH_EXTRAEXPANDED
25	FC_WIDTH_ULTRAEXPANDED FC_PROPORTIONAL FC_DUAL FC_MONO
26	FC_CHARCELL FC_RGBA_UNKNOWN FC_RGBA_RGB FC_RGBA_BGR FC_RGBA_VRGB
27	FC_RGBA_VBGR FC_RGBA_NONE FC_HINT_NONE FC_HINT_SLIGHT
28	FC_HINT_MEDIUM FC_HINT_FULL FC_LCD_NONE FC_LCD_DEFAULT
29	FC_LCD_LIGHT FC_LCD_LEGACY StXFace2FCWeightMap
30	StXStyle2FCSlantMap CachedFontList SimpleViewUnusedSlotIndex'
31	poolDictionaries:''
32	category:'Graphics-Support'
33	!
34
35	Object subclass:#FCFontListParser
36	instanceVariableNames:'pipeStream lineStream currentDescription'
37	classVariableNames:''
38	poolDictionaries:''
39	privateIn:XftFontDescription
40	!
41
42	ExternalAddress subclass:#FCPatternHandle
43	instanceVariableNames:''
44	classVariableNames:''
45	poolDictionaries:''
46	privateIn:XftFontDescription
47	!
48
49	ExternalAddress subclass:#XftDrawHandle
50	instanceVariableNames:''
51	classVariableNames:''
52	poolDictionaries:''
53	privateIn:XftFontDescription
54	!
55
56	ExternalAddress subclass:#XftFontHandle
57	instanceVariableNames:''
58	classVariableNames:''
59	poolDictionaries:''
60	privateIn:XftFontDescription
61	!
62
63	!XftFontDescription primitiveDefinitions!
64	%{
65	/*
66	* includes, defines, structure definitions
67	* and typedefs come here.
68	*/
69
70	#undef True
71	#undef False
72	#undef Time
73	#define Time XTime
74
75	#ifdef XFT
76
77	extern OBJ __GLOBAL_GET_BY_NAME();
78
79	# define __HANDLE_VAL(type, externalAddress) \
80	((type)__externalAddressVal(externalAddress))
81	#define __HANDLE_NEW(ptr, __cls) \
82	({ \
83	OBJ handle; \
84	handle = __MKEXTERNALADDRESS(ptr); \
85	__InstPtr(handle)->o_class = \
86	__GLOBAL_GET_BY_NAME(__cls); \
87	handle; \
88	})
89
90
91
92	# define DISPLAY(x) __HANDLE_VAL(Display*, x)
93	# define SCREEN(x) ((int)(__intVal(x)))
94	# define DRAWABLE(x) __HANDLE_VAL(Drawable, x)
95	# define GC(x) __HANDLE_VAL(GC, x)
96	# define VISUAL(x) __HANDLE_VAL(Visual*, x)
97	# define COLORMAP(x) __HANDLE_VAL(Colormap, x)
98
99
100
101
102	/* FontConfig objects */
103	# define FC_PATTERN(x) __HANDLE_VAL(XftPattern*, x)
104	# define FC_PATTERN_HANDLE_NEW(x) __HANDLE_NEW(x, "XftFontDescription::FCPatternHandle")
105
106	/* Xft Objects */
107
108	# define XFT_FONT(x) __HANDLE_VAL(XftFont*, x)
109	# define XFT_FONT_HANDLE_NEW(x) __HANDLE_NEW(x, "XftFontDescription::XftFontHandle")
110
111	# define XFT_DRAW(x) __HANDLE_VAL(XftDraw*, x)
112	# define XFT_DRAW_HANDLE_NEW(x) __HANDLE_NEW(x, "XftFontDescription::XftDrawHandle")
113
114
115	# include <X11/Xft/Xft.h>
116	# include <X11/Xft/XftCompat.h>
117
118	#endif
119
120	%}
121	! !
122
123	!XftFontDescription class methodsFor:'documentation'!
124
125	documentation
126	"
127	WARNING: Unfinished.
128
129	Experimental implementation of custom font rendered using
130	Xft library (UNIX / X Window only), To actually use it,
131	add following definitions to the end of stx/configurations/myConf
132	(works on Ubuntu 12.10)
133
134	--- snip ---
135	XDEFS+=-DXFT
136	XINCLUDE+=$(shell pkg-config --cflags xft)
137	LIB_XFT=-l:libXft.so.2 -l:libfontconfig.so.1
138	--- snip --
139
140	NOTE: This class should be named XftFont, however then
141	there would be a name clash with XftFont structure
142	defined in Xft.h - therefore the class is named
143	XftFontDescription to avoid that name clash.
144
145
146	[author:]
147	Jan Vrany <jan.vrany@fit.cvut.cz>
148
149	[instance variables:]
150
151	[class variables:]
152
153	[see also:]
154
155	"
156	! !
157
158	!XftFontDescription class methodsFor:'initialization'!
159
160	flushListOfAvailableFonts
161	CachedFontList := nil.
162
163	"
164	XftFontDescription flushListOfAvailableFonts
165	"
166	!
167
168	initialize
169	"Invoked at system start or when the class is dynamically loaded."
170
171	" Taken from fontconfig,h "
172
173	FC_FAMILY := 'family'. "/* String */
174	FC_STYLE := 'style'. "/* String */
175	FC_SLANT := 'slant'. "/* Int */
176	FC_WEIGHT := 'weight'. "/* Int */
177	FC_SIZE := 'size'. "/* Double */
178	FC_ASPECT := 'aspect'. "/* Double */
179	FC_PIXEL_SIZE := 'pixelsize'. "/* Double */
180	FC_SPACING := 'spacing'. "/* Int */
181	FC_FOUNDRY := 'foundry'. "/* String */
182	FC_ANTIALIAS := 'antialias'. "/* Bool (depends) */
183	FC_HINTING := 'hinting'. "/* Bool (true) */
184	FC_HINT_STYLE := 'hintstyle'. "/* Int */
185	FC_VERTICAL_LAYOUT := 'verticallayout'. "/* Bool (false) */
186	FC_AUTOHINT := 'autohint'. "/* Bool (false) */
187	FC_WIDTH := 'width'. "/* Int */
188	FC_FILE := 'file'. "/* String */
189	FC_INDEX := 'index'. "/* Int */
190	FC_FT_FACE := 'ftface'. "/* FT_Face */
191	FC_RASTERIZER := 'rasterizer'. "/* String */
192	FC_OUTLINE := 'outline'. "/* Bool */
193	FC_SCALABLE := 'scalable'. "/* Bool */
194	FC_SCALE := 'scale'. "/* double */
195	FC_DPI := 'dpi'. "/* double */
196	FC_RGBA := 'rgba'. "/* Int */
197	FC_MINSPACE := 'minspace'. "/* Bool use minimum line spacing */
198	FC_SOURCE := 'source'. "/* String (deprecated) */
199	FC_CHARSET := 'charset'. "/* CharSet */
200	FC_LANG := 'lang'. "/* String RFC 3066 langs */
201	FC_FONTVERSION := 'fontversion'. "/* Int from 'head'.table */
202	FC_FULLNAME := 'fullname'. "/* String */
203	FC_FAMILYLANG := 'familylang'. "/* String RFC 3066 langs */
204	FC_STYLELANG := 'stylelang'. "/* String RFC 3066 langs */
205	FC_FULLNAMELANG := 'fullnamelang'. "/* String RFC 3066 langs */
206	FC_CAPABILITY := 'capability'. "/* String */
207	FC_FONTFORMAT := 'fontformat'. "/* String */
208	FC_EMBOLDEN := 'embolden'. "/* Bool - true if emboldening needed*/
209	FC_EMBEDDED_BITMAP := 'embeddedbitmap'."/* Bool - true to enable embedded bitmaps */
210	FC_DECORATIVE := 'decorative'. "/* Bool - true if style is a decorative variant */
211	FC_LCD_FILTER := 'lcdfilter'. "/* Int */
212	FC_NAMELANG := 'namelang'. "/* String RFC 3866 langs */
213
214
215	"Adjust outline rasterizer"
216	FC_CHAR_WIDTH := 'charwidth'."/* Int */
217	FC_CHAR_HEIGHT := 'charheight'."/* Int */
218	FC_MATRIX := 'matrix'. "/* FcMatrix */
219
220	FC_WEIGHT_THIN := 0.
221	FC_WEIGHT_EXTRALIGHT := 40.
222	FC_WEIGHT_ULTRALIGHT := FC_WEIGHT_EXTRALIGHT.
223	FC_WEIGHT_LIGHT := 50.
224	FC_WEIGHT_BOOK := 75.
225	FC_WEIGHT_REGULAR := 80.
226	FC_WEIGHT_NORMAL := FC_WEIGHT_REGULAR.
227	FC_WEIGHT_MEDIUM := 100.
228	FC_WEIGHT_DEMIBOLD := 180.
229	FC_WEIGHT_SEMIBOLD := FC_WEIGHT_DEMIBOLD.
230	FC_WEIGHT_BOLD := 200.
231	FC_WEIGHT_EXTRABOLD := 205.
232	FC_WEIGHT_ULTRABOLD := FC_WEIGHT_EXTRABOLD.
233	FC_WEIGHT_BLACK := 210.
234	FC_WEIGHT_HEAVY := FC_WEIGHT_BLACK.
235	FC_WEIGHT_EXTRABLACK := 215.
236	FC_WEIGHT_ULTRABLACK := FC_WEIGHT_EXTRABLACK.
237
238	FC_SLANT_ROMAN := 0.
239	FC_SLANT_ITALIC := 100.
240	FC_SLANT_OBLIQUE := 110.
241
242	FC_WIDTH_ULTRACONDENSED := 50.
243	FC_WIDTH_EXTRACONDENSED := 63.
244	FC_WIDTH_CONDENSED := 75.
245	FC_WIDTH_SEMICONDENSED := 87.
246	FC_WIDTH_NORMAL := 100.
247	FC_WIDTH_SEMIEXPANDED := 113.
248	FC_WIDTH_EXPANDED := 125.
249	FC_WIDTH_EXTRAEXPANDED := 150.
250	FC_WIDTH_ULTRAEXPANDED := 200.
251
252	FC_PROPORTIONAL := 0.
253	FC_DUAL := 90.
254	FC_MONO := 100.
255	FC_CHARCELL := 110.
256
257	"sub-pixel order"
258	FC_RGBA_UNKNOWN := 0.
259	FC_RGBA_RGB := 1.
260	FC_RGBA_BGR := 2.
261	FC_RGBA_VRGB := 3.
262	FC_RGBA_VBGR := 4.
263	FC_RGBA_NONE := 5.
264
265	"hinting style"
266	FC_HINT_NONE := 0.
267	FC_HINT_SLIGHT := 1.
268	FC_HINT_MEDIUM := 2.
269	FC_HINT_FULL := 3.
270
271	"LCD filter"
272	FC_LCD_NONE := 0.
273	FC_LCD_DEFAULT := 1.
274	FC_LCD_LIGHT := 2.
275	FC_LCD_LEGACY := 3.
276
277	StXFace2FCWeightMap := Dictionary withKeysAndValues:{
278	'regular'. FC_WEIGHT_REGULAR.
279	'medium'. FC_WEIGHT_MEDIUM.
280	'bold'. FC_WEIGHT_BOLD.
281	}.
282	StXStyle2FCSlantMap := Dictionary withKeysAndValues:{
283	'roman'. FC_SLANT_ROMAN.
284	'italic'. FC_SLANT_ITALIC.
285	'oblique'. FC_SLANT_OBLIQUE.
286	}.
287
288	SimpleViewUnusedSlotIndex := SimpleView instVarIndexFor: #unused.
289
290	"Modified: / 01-04-2014 / 15:33:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
291	! !
292
293	!XftFontDescription class methodsFor:'instance creation'!
294
295	family:familyString face:faceString style:styleString size:size sizeUnit:sizeUnit encoding:encoding
296	"returns a font for given family, face, style, size and the specified encoding.
297	The returned font is not associated to a specific device"
298
299	\|proto\|
300
301	CachedFontList notNil ifTrue:[
302	proto := CachedFontList
303	detect:[:fn \|
304	fn family = familyString
305	and:[ fn face = faceString
306	and:[ (fn style = styleString
307	or:[ (fn style = 'oblique' and:[styleString = 'italic'])
308	or:[ (fn style = 'italic' and:[styleString = 'oblique']) ]]) ]]]
309	ifNone:nil.
310	proto notNil ifTrue:[
311	^ (proto shallowCopy)
312	setDevice: nil patternId: nil fontId: nil;
313	family:familyString face:faceString style:styleString size:size sizeUnit:sizeUnit encoding:encoding
314	].
315	].
316	^ super
317	family:familyString face:faceString style:styleString size:size sizeUnit:sizeUnit encoding:encoding
318	!
319
320	new
321	"/ self halt.
322	^ super new.
323	! !
324
325	!XftFontDescription class methodsFor:'examples'!
326
327	example1
328	"
329	XftFontDescription example1
330	"
331	\|top textView\|
332
333	top := StandardSystemView new.
334	top extent:300@200.
335
336	textView := EditTextView new.
337	textView origin:0.0 @ 0.0 corner:1.0 @ 1.0.
338	textView basicFont: (XftFontDescription family: 'DejaVu Sans' size: 16).
339
340	top addSubView:textView.
341
342	textView contents:('/etc/hosts' asFilename contentsOfEntireFile asText).
343
344	top open.
345
346	"Created: / 20-12-2013 / 00:04:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
347	"Modified: / 30-12-2013 / 19:11:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
348	!
349
350	example2
351	"
352	XftFontDescription example2
353	"
354	\|top textView\|
355
356	top := StandardSystemView new.
357	top extent:300@200.
358
359	textView := EditTextView new.
360	textView origin:0.0 @ 0.0 corner:1.0 @ 1.0.
361	textView basicFont: (XftFontDescription family: 'DejaVu Sans' size: 30) asItalic.
362
363	top addSubView:textView.
364
365	textView contents:('/etc/hosts' asFilename contentsOfEntireFile).
366
367	top open.
368
369	"Created: / 30-12-2013 / 19:49:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
370	! !
371
372	!XftFontDescription class methodsFor:'queries'!
373
374	listOfAvailableFonts
375	"uses fc-list to get a list of available fontDescriptions"
376
377	CachedFontList isNil ifTrue:[
378	CachedFontList := FCFontListParser new listOfAvailableFonts
379	].
380	^ CachedFontList
381
382	"
383	XftFontDescription flushListOfAvailableFonts.
384	XftFontDescription listOfAvailableFonts
385	"
386	! !
387
388	!XftFontDescription methodsFor:'accessing'!
389
390	encoding
391	^ encoding ? 'iso10646-1'
392	!
393
394	face
395	^ face ? ''
396	!
397
398	fullName
399	^ name ? (self userFriendlyName)
400	!
401
402	graphicsDevice
403	^ device
404
405	"Created: / 02-01-2014 / 23:22:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
406	!
407
408	maxCode
409	^ maxCode ? 16rFFFF
410	!
411
412	maxCode:something
413	maxCode := something.
414	!
415
416	minCode
417	^ minCode ? 0
418	!
419
420	minCode:something
421	minCode := something.
422	!
423
424	size
425	^ size ? 0
426	!
427
428	style
429	^ style ? ''
430	! !
431
432	!XftFontDescription methodsFor:'accessing-private'!
433
434	getFontId
435	^ fontId
436
437	"Created: / 02-01-2014 / 23:29:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
438	! !
439
440	!XftFontDescription methodsFor:'displaying'!
441
442	displayString:aString from:index1 to:index2Arg x:xArg y:yArg in:aGC opaque:opaque
443	"display a partial string at some position in aGC."
444
445	\|index2 bytesPerCharacter transformation isView clipR clipX clipY clipW clipH fg fgR fgG fgB fgA fgPixel bg bgR bgG bgB bgA bgPixel drawX drawY displayId screen drawableId drawIdToUse error stringLen\|
446
447	"limit the string len, otherwise bad output is generated"
448	stringLen := index2Arg - index1.
449	stringLen > 8000 ifTrue:[
450	index2 := index2Arg - (stringLen - 8000).
451	] ifFalse:[
452	index2 := index2Arg.
453	].
454	bytesPerCharacter := aString bitsPerCharacter // 8.
455	transformation := aGC transformation.
456
457	clipR := aGC clippingBoundsOrNil.
458	clipR notNil ifTrue:[
459	clipX := clipR left.
460	clipY := clipR top.
461	clipW := clipR width.
462	clipH := clipR height.
463	].
464
465	transformation isNil ifTrue:[
466	drawX := xArg.
467	drawY := yArg.
468	] ifFalse:[
469	drawX := transformation applyToX:xArg.
470	drawY := transformation applyToY:yArg.
471	clipR notNil ifTrue:[
472	clipX := transformation applyToX:clipX.
473	clipY := transformation applyToY:clipY.
474	clipW := transformation applyScaleX:clipW.
475	clipH := transformation applyScaleY:clipH.
476	].
477	].
478
479	fg := aGC paint.
480	fgPixel := fg colorId.
481	"/ fgPixel notNil ifTrue:[
482	fgR := fg scaledRed.
483	fgG := fg scaledGreen.
484	fgB := fg scaledBlue.
485	fgA := (fg alpha * 65535) rounded.
486	"/].
487	fgR isNil ifTrue:[
488	"/ when drawing into a pixmap...
489	fg colorId == 0 ifTrue:[
490	fgR := fgG := fgB := 0.
491	] ifFalse:[
492	fgR := fgG := fgB := 16rFFFF.
493	]
494	].
495
496	opaque ifTrue:[
497	bg := aGC backgroundPaint.
498	bgPixel := bg colorId.
499	"/bgPixel notNil ifTrue:[
500	bgR := bg scaledRed.
501	bgG := bg scaledGreen.
502	bgB := bg scaledBlue.
503	bgA := (bg alpha * 65535) rounded.
504	"/].
505	bgR isNil ifTrue:[
506	"/ when drawing into a pixmap...
507	bg colorId == 0 ifTrue:[
508	bgR := bgG := bgB := 0.
509	] ifFalse:[
510	bgR := bgG := bgB := 16rFFFF.
511	]
512	].
513	].
514	displayId := device displayIdOrErrorIfBroken.
515	displayId isNil ifTrue:[
516	^ self.
517	].
518	screen := device screen.
519	drawableId := aGC drawableId.
520	isView := aGC isKindOf: SimpleView.
521	SimpleViewUnusedSlotIndex := SimpleView instVarIndexFor: #unused.
522
523	%{
524	#ifdef XFT
525	XftFont *font;
526	XftDraw *draw;
527	XftColor color;
528	XGlyphInfo extents;
529	XRectangle clipRX;
530	char* string;
531	int len;
532	int __bytesPerCharacter;
533
534	if (!(__bothSmallInteger(drawX, drawY)
535	&& __bothSmallInteger(index1, index2)
536	&& __isSmallInteger(bytesPerCharacter)
537	&& (__isSmallInteger(fgPixel) \|\| (__bothSmallInteger(fgR, fgG) && __bothSmallInteger(fgB, fgA)))
538	&& (opaque == false \|\| __isSmallInteger(bgPixel) \|\| (__bothSmallInteger(bgR, bgG) && __bothSmallInteger(bgB, bgA)))
539	&& __isNonNilObject(aString)
540	)) {
541	goto err;
542	}
543
544	__bytesPerCharacter = __intVal(bytesPerCharacter);
545
546	if (1 && (isView == true)) {
547	int unusedSlotIndex = __intVal(@global(XftFontDescription:SimpleViewUnusedSlotIndex)) - 1;
548	drawIdToUse = __InstPtr(aGC)->i_instvars[unusedSlotIndex];
549	if (drawIdToUse == nil) {
550	drawIdToUse = XFT_DRAW_HANDLE_NEW ( XftDrawCreate ( DISPLAY( displayId ) ,
551	DRAWABLE( drawableId ) ,
552	DefaultVisual( DISPLAY( displayId), SCREEN (screen) ) ,
553	DefaultColormap( DISPLAY( displayId), SCREEN (screen) ) ) );
554	__InstPtr(aGC)->i_instvars[unusedSlotIndex] = drawIdToUse;
555	__STORE(aGC, drawIdToUse);
556	}
557	} else {
558	if ( __INST(sharedDrawId) == nil ) {
559	__INST(sharedDrawId) = XFT_DRAW_HANDLE_NEW ( XftDrawCreate ( DISPLAY( displayId ) ,
560	DRAWABLE( drawableId ) ,
561	DefaultVisual( DISPLAY( displayId), SCREEN (screen) ) ,
562	DefaultColormap( DISPLAY( displayId), SCREEN (screen) ) ) );
563	__STORE(self, __INST(sharedDrawId));
564	}
565	if ( XftDrawDrawable ( XFT_DRAW ( __INST(sharedDrawId) ) ) != DRAWABLE( drawableId ) ) {
566	XftDrawChange( XFT_DRAW( __INST(sharedDrawId) ) , DRAWABLE( drawableId ) );
567	}
568	drawIdToUse = __INST(sharedDrawId);
569	}
570
571	string = __stringVal( aString ) + (( __intVal(index1) - 1 ) * __bytesPerCharacter);
572	len = __intVal(index2) - __intVal(index1) + 1;
573
574	if (clipR != nil) {
575	clipRX.x = __intVal(clipX);
576	clipRX.y = __intVal(clipY);
577	clipRX.width = __intVal(clipW);
578	clipRX.height = __intVal(clipH);
579	XftDrawSetClipRectangles( XFT_DRAW( drawIdToUse ) , 0, 0, &clipRX, 1);
580	} else {
581	XftDrawSetClip( XFT_DRAW( drawIdToUse ) , 0);
582	}
583
584	if (opaque == true) {
585	if (bgPixel != nil) {
586	color.pixel = (unsigned long)__intVal(bgPixel);
587	}
588	// else {
589	color.color.red = __intVal(bgR);
590	color.color.green = __intVal(bgG);
591	color.color.blue = __intVal(bgB);
592	color.color.alpha = __intVal(bgA);
593	// }
594	switch (__bytesPerCharacter) {
595	case 1:
596	XftTextExtents8( DISPLAY( displayId ), XFT_FONT( __INST( fontId ) ), (FcChar8*)string, len, &extents);
597	break;
598	case 2:
599	XftTextExtents16( DISPLAY( displayId ), XFT_FONT( __INST( fontId ) ), (FcChar16*)string, len, &extents);
600	break;
601	case 4:
602	XftTextExtents32( DISPLAY( displayId ), XFT_FONT( __INST( fontId ) ), (FcChar32*)string, len, &extents);
603	break;
604	}
605	XftDrawRect( XFT_DRAW ( drawIdToUse ), &color, __intVal(drawX) - extents.x, __intVal(drawY) - XFT_FONT( __INST( fontId ) )->ascent, extents.width, XFT_FONT(__INST (fontId ) )->height);
606	}
607	if (fgPixel != nil) {
608	color.pixel = (unsigned long)__intVal(fgPixel);
609	}
610	// else {
611	color.color.red = __intVal(fgR);
612	color.color.green = __intVal(fgG);
613	color.color.blue = __intVal(fgB);
614	color.color.alpha = __intVal(fgA);
615	// }
616	switch (__bytesPerCharacter) {
617	case 1:
618	XftDrawString8( XFT_DRAW ( drawIdToUse ), &color, XFT_FONT( __INST( fontId ) ),
619	__intVal(drawX),
620	__intVal(drawY),
621	(FcChar8*)string,
622	len);
623	RETURN ( self );
624	break;
625	case 2:
626	XftDrawString16( XFT_DRAW ( drawIdToUse ), &color, XFT_FONT( __INST( fontId ) ),
627	__intVal(drawX),
628	__intVal(drawY),
629	(FcChar16*)string,
630	len);
631	RETURN ( self );
632	break;
633	case 4:
634	XftDrawString32( XFT_DRAW ( drawIdToUse ), &color, XFT_FONT( __INST( fontId ) ),
635	__intVal(drawX),
636	__intVal(drawY),
637	(FcChar32*)string,
638	len);
639	RETURN ( self );
640	break;
641	}
642	err:;
643	#endif
644	%}.
645	self primitiveFailed: error.
646
647	"Created: / 21-12-2013 / 21:11:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
648	"Modified: / 01-04-2014 / 15:40:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
649	! !
650
651	!XftFontDescription methodsFor:'error reporting'!
652
653	primitiveFailed
654	<resource: #skipInDebuggersWalkBack>
655	%{
656	#ifndef XFT
657	%}.
658	super primitiveFailed:'Xft support is not configured'.
659	%{
660	#endif
661	%}.
662	super primitiveFailed
663	!
664
665	primitiveFailed:errorString
666	<resource: #skipInDebuggersWalkBack>
667	%{
668	#ifndef XFT
669	%}.
670	super primitiveFailed:'Xft support is not configured'.
671	%{
672	#endif
673	%}.
674	super primitiveFailed:errorString
675	! !
676
677	!XftFontDescription methodsFor:'getting a device font'!
678
679	onDevice:aGraphicsDevice
680	"Create a new XftFont representing the closes font as
681	myself on aDevice; if one already exists, return the one."
682
683	\| myPatternId closestPatternId1 closestPatternId2 newFontId \|
684
685	"if I am already assigned to that device ..."
686	(device == aGraphicsDevice) ifTrue:[^ self].
687
688	(aGraphicsDevice isNil and:[device notNil]) ifTrue:[
689	^ self
690	].
691
692	(closestFont notNil and:[closestFont graphicsDevice == aGraphicsDevice]) ifTrue:[
693	^ closestFont onDevice: aGraphicsDevice.
694	].
695
696	aGraphicsDevice deviceFonts do:[:aFont \|
697	((aFont class == self class) and:[self sameDeviceFontAs:aFont]) ifTrue:[
698	^ aFont
699	].
700	].
701
702	[
703	myPatternId := self xftPatternCreate.
704	self xftPatternAdd: myPatternId attribute: FC_FAMILY value: family.
705	pixelSize notNil ifTrue:[
706	self xftPatternAdd: myPatternId attribute: FC_PIXEL_SIZE value: pixelSize.
707	] ifFalse:[
708	self xftPatternAdd: myPatternId attribute: FC_SIZE value: size.
709	].
710	self xftPatternAdd: myPatternId attribute: FC_WEIGHT value: (StXFace2FCWeightMap at: (face ? 'regular')).
711	self xftPatternAdd: myPatternId attribute: FC_SLANT value: (StXStyle2FCSlantMap at: (style ? 'roman') ifAbsent:[StXStyle2FCSlantMap at: (style ? 'roman') asLowercase]).
712
713	newFontId := self xftFontOpenPattern: aGraphicsDevice displayId pattern: myPatternId.
714	newFontId notNil ifTrue:[
715	"/ Good, this font exists!!
716	fontId := newFontId.
717	device := aGraphicsDevice.
718	aGraphicsDevice registerFont:self.
719	^ self.
720	] ifFalse:[
721	closestPatternId1 := self xftFontMatch: aGraphicsDevice displayId screen: aGraphicsDevice screen pattern: myPatternId.
722	closestPatternId1 isNil ifTrue:[
723	self error: 'No font matches'.
724	].
725	"
726	self xftPatternGet: closestPatternId attribute: 'family' index: 0.
727	self xftPatternGet: closestPatternId attribute: 'size' index: 0.
728	"
729	closestPatternId2 := self xftPatternDuplicate: closestPatternId1.
730	newFontId := self xftFontOpenPattern: aGraphicsDevice displayId pattern: closestPatternId1.
731	"/ !!!!!!!! closestPatternId is no longer valid !!!!!!!!
732	closestPatternId1 := nil.
733	newFontId isNil ifTrue:[
734	self error: 'Pattern matched, but font could not be opened (should not happen)'.
735	].
736	"/ Search for existing registered font. Note, that XftFont instances
737	"/ are shared (and refcounted) so newFontId = aFont getFontId is enough
738	"/ to check whether some other font instance represents the same font...
739	aGraphicsDevice deviceFonts do:[:aFont \|
740	((self class == aFont class) and:[newFontId = aFont getFontId]) ifTrue:[
741	closestFont := aFont.
742	^ closestFont
743	].
744	].
745
746	closestFont := self shallowCopy
747	setDevice: aGraphicsDevice patternId: closestPatternId2 fontId: newFontId;
748	yourself.
749	aGraphicsDevice registerFont: closestFont.
750	^ closestFont
751	].
752	] ensure:[
753	self xftPatternDestroy: myPatternId.
754	self xftPatternDestroy: closestPatternId1.
755	self xftPatternDestroy: closestPatternId2.
756	].
757
758	"
759	(XftFontDescription family:'monospace' size:16) onDevice:Screen current
760	"
761
762	"Modified: / 14-04-1997 / 18:22:31 / cg"
763	"Modified: / 02-01-2014 / 23:43:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
764	!
765
766	onDevice:aWorkstation ifAbsent:aBlock
767	"Create a new XftFont representing the same font as
768	myself on aWorkstation. This does NOT try to look for existing
769	or replacement fonts (i.e. can be used to get physical fonts)."
770
771	"/ Apparently, this is not needed.
772	self shouldImplement
773
774	"Modified: / 02-01-2014 / 23:15:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
775	"Modified (comment): / 04-01-2014 / 02:06:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
776	! !
777
778	!XftFontDescription methodsFor:'initialization'!
779
780	setDevice: deviceArg patternId: patternIdArg fontId: fontIdArg
781	device := deviceArg.
782	fontId := fontIdArg.
783	patternIdArg notNil ifTrue:[
784	family := self xftPatternGet: patternIdArg attribute: FC_FAMILY index: 0.
785	size := self xftPatternGet: patternIdArg attribute: FC_SIZE index: 0.
786	face := self xftPatternGet: patternIdArg attribute: FC_WEIGHT index: 0.
787	face := StXFace2FCWeightMap keyAtValue: face.
788	style := self xftPatternGet: patternIdArg attribute: FC_SLANT index: 0.
789	style := StXStyle2FCSlantMap keyAtValue: style.
790
791	name:= self xftPatternGet: patternIdArg attribute: 'fullname' index: 0.
792
793	encoding:= self xftPatternGet: patternIdArg attribute: 'encoding' index: 0.
794	].
795
796	"Created: / 21-12-2013 / 00:46:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
797	"Modified: / 30-12-2013 / 12:49:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
798	! !
799
800	!XftFontDescription methodsFor:'primitives'!
801
802	xftAvailable
803	%{
804	#ifdef XFT
805	RETURN ( true )
806	#endif
807	%}.
808	^ false
809
810	"Created: / 20-12-2013 / 21:10:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
811	!
812
813	xftDrawChange: xftDrawId drawable: drawableId
814	\| error \|
815
816	%{
817	#ifdef XFT
818	if ( ! __isExternalAddressLike(xftDrawId) ) {
819	error = @symbol(BadArg1);
820	goto err;
821	}
822	if ( ! __isExternalAddressLike(drawableId) ) {
823	error = @symbol(BadArg2);
824	goto err;
825	}
826	if (XftDrawDrawable( XFT_DRAW(xftDrawId) ) != DRAWABLE( drawableId ) ) {
827	XftDrawChange( XFT_DRAW(xftDrawId) , DRAWABLE( drawableId ) );
828	}
829	RETURN ( self );
830	err:;
831	#endif
832	%}.
833	self primitiveFailed: error
834
835	"Created: / 26-12-2013 / 12:17:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
836	!
837
838	xftDrawCreate: displayId screen: screen drawable: drawableId
839	\| error \|
840
841	%{
842	#ifdef XFT
843	if ( ! __isExternalAddressLike(displayId) ) {
844	error = @symbol(BadArg1);
845	goto err;
846	}
847	if ( ! __isSmallInteger(screen) ) {
848	error = @symbol(BadArg2);
849	goto err;
850	}
851	if ( ! __isExternalAddressLike(drawableId) ) {
852	error = @symbol(BadArg3);
853	goto err;
854	}
855	RETURN ( XFT_DRAW_HANDLE_NEW ( XftDrawCreate ( DISPLAY( displayId ) ,
856	DRAWABLE( drawableId ) ,
857	DefaultVisual( DISPLAY( displayId), SCREEN (screen) ) ,
858	DefaultColormap( DISPLAY( displayId), SCREEN (screen) ) ) ) );
859	err:;
860	#endif
861	%}.
862	self primitiveFailed: error
863
864	"Created: / 21-12-2013 / 21:12:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
865	!
866
867	xftDrawRect: drawIdArg color: aColor x: x y: y width: w height: h
868	\| error r g b a pix \|
869
870	aColor isColor ifFalse:[^self primitiveFailed: #BadArg2].
871
872	r := aColor scaledRed.
873	g := aColor scaledGreen.
874	b := aColor scaledBlue.
875	a := aColor alpha * 65535.
876	r isNil ifTrue:[
877	"/ when drawing into a pixmap...
878	aColor colorId == 0 ifTrue:[
879	r := g := b := 0.
880	] ifFalse:[
881	r := g := b := 16rFFFF.
882	]
883	].
884	pix := aColor colorId.
885	%{
886	#ifdef XFT
887	XftColor clr;
888	if ( ! __isExternalAddressLike(drawIdArg) ) {
889	error = @symbol(BadArg1);
890	goto err;
891	}
892	if ( ! __isSmallInteger(pix) ) {
893	error = @symbol(BadColorId);
894	goto err;
895	}
896	if ( ! __isSmallInteger(x) ) {
897	error = @symbol(BadArg3);
898	goto err;
899	}
900	if ( ! __isSmallInteger(y) ) {
901	error = @symbol(BadArg4);
902	goto err;
903	}
904	if ( ! __isSmallInteger(w) ) {
905	error = @symbol(BadArg5);
906	goto err;
907	}
908	if ( ! __isSmallInteger(h) ) {
909	error = @symbol(BadArg6);
910	goto err;
911	}
912	clr.pixel = (unsigned long)__intVal(pix);
913	clr.color.red = __intVal(r);
914	clr.color.green = __intVal(g);
915	clr.color.blue = __intVal(b);
916	clr.color.alpha = __intVal(a);
917
918	XftDrawRect(XFT_DRAW(drawIdArg), &clr,
919	__intVal(x), __intVal(y), __intVal(w) ,__intVal(h));
920
921	RETURN ( self );
922	err:;
923	#endif
924	%}.
925	self primitiveFailed: error.
926
927	"Created: / 28-12-2013 / 23:35:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
928	"Modified: / 31-12-2013 / 00:37:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
929	!
930
931	xftDrawSetClip: drawIdArg rectangle: rect
932	\| error xObj yObj wObj hObj \|
933
934	rect notNil ifTrue:[
935	xObj := rect left.
936	yObj := rect top.
937	wObj := rect width.
938	hObj := rect height.
939	].
940	%{
941	#ifdef XFT
942	XRectangle r;
943	if ( ! __isExternalAddressLike(drawIdArg) ) {
944	error = @symbol(BadArg1);
945	goto err;
946	}
947	if (rect != nil) {
948	r.x = __intVal(xObj);
949	r.y = __intVal(yObj);
950	r.width = __intVal(wObj);
951	r.height = __intVal(hObj);
952	XftDrawSetClipRectangles( XFT_DRAW(drawIdArg) , 0, 0, &r, 1);
953	} else {
954	XftDrawSetClipRectangles( XFT_DRAW(drawIdArg) , 0, 0, (XRectangle*)NULL, 0);
955	}
956	RETURN ( self );
957	err:;
958	#endif
959	%}.
960	self primitiveFailed: error.
961
962	"Created: / 31-12-2013 / 01:24:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
963	!
964
965	xftDrawString: drawIdArg color: aColor font: fontIdArg x: x y: y string: text from: start to: stop
966	\| error r g b a pix \|
967
968	aColor isColor ifFalse:[^self primitiveFailed: #BadArg2].
969
970	r := aColor scaledRed.
971	g := aColor scaledGreen.
972	b := aColor scaledBlue.
973	a := aColor alpha * 65535.
974	r isNil ifTrue:[
975	"/ when drawing into a pixmap...
976	aColor colorId == 0 ifTrue:[
977	r := g := b := 0.
978	] ifFalse:[
979	r := g := b := 16rFFFF.
980	]
981	].
982	pix := aColor colorId.
983	%{
984	#ifdef XFT
985	int _start, _stop;
986	int _x, _y;
987	XftColor clr;
988	if ( ! __isExternalAddressLike(drawIdArg) ) {
989	error = @symbol(BadArg1);
990	goto err;
991	}
992	if ( ! __isSmallInteger(pix) ) {
993	error = @symbol(BadColorId);
994	goto err;
995	}
996	if ( ! __isSmallInteger(x) ) {
997	error = @symbol(BadArg4);
998	goto err;
999	}
1000	_x = __intVal(x);
1001	if ( ! __isSmallInteger(y) ) {
1002	error = @symbol(BadArg5);
1003	goto err;
1004	}
1005	_y = __intVal(y);
1006
1007
1008	if ( ! __isSmallInteger(start) ) {
1009	error = @symbol(BadArg6);
1010	goto err;
1011	}
1012	_start = __intVal(start);
1013	if ( ! __isSmallInteger(stop) ) {
1014	error = @symbol(BadArg7);
1015	goto err;
1016	}
1017	_stop = __intVal(stop);
1018
1019	clr.pixel = (unsigned long)__intVal(pix);
1020	clr.color.red = __intVal(r);
1021	clr.color.green = __intVal(g);
1022	clr.color.blue = __intVal(b);
1023	clr.color.alpha = __intVal(a);
1024
1025	if ( __isStringLike(text) ) {
1026	XftDrawString8(XFT_DRAW(drawIdArg), &clr, XFT_FONT(fontIdArg),
1027	_x, _y,
1028	__stringVal(text) + (_start - 1), _stop - _start + 1);
1029	RETURN ( self );
1030	} else {
1031	error = @symbol(BadArg5);
1032	goto err;
1033	}
1034	err:;
1035	#endif
1036	%}.
1037	self primitiveFailed: error.
1038
1039	"Created: / 28-12-2013 / 12:32:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1040	"Modified: / 30-12-2013 / 20:00:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1041	!
1042
1043	xftFontGetAscent: fontIdArg
1044	\| error \|
1045
1046	%{
1047	#ifdef XFT
1048	int v;
1049	if ( ! __isExternalAddressLike(fontIdArg) ) {
1050	error = @symbol(BadArg1);
1051	goto err;
1052	}
1053	v = XFT_FONT(fontIdArg)->ascent;
1054	RETURN ( __MKINT( v ) );
1055	err:;
1056	#endif
1057	%}.
1058	self primitiveFailed: error
1059
1060	"Created: / 21-12-2013 / 00:56:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1061	!
1062
1063	xftFontGetDescent:fontIdArg
1064	\| error \|
1065
1066	%{
1067	#ifdef XFT
1068	int v;
1069	if ( ! __isExternalAddressLike(fontIdArg) ) {
1070	error = @symbol(BadArg1);
1071	goto err;
1072	}
1073	v = XFT_FONT(fontIdArg)->descent;
1074	RETURN ( __MKINT( v ) );
1075	err:;
1076	#endif
1077	%}.
1078	self primitiveFailed: error
1079
1080	"Created: / 21-12-2013 / 00:56:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1081	!
1082
1083	xftFontGetHeight: fontIdArg
1084	\| error \|
1085
1086	%{
1087	#ifdef XFT
1088	int v;
1089	if ( ! __isExternalAddressLike(fontIdArg) ) {
1090	error = @symbol(BadArg1);
1091	goto err;
1092	}
1093	v = XFT_FONT(fontIdArg)->height;
1094	RETURN ( __MKINT( v ) );
1095	err:;
1096	#endif
1097	%}.
1098	self primitiveFailed: error
1099
1100	"Created: / 21-12-2013 / 00:56:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1101	!
1102
1103	xftFontGetMaxAdvanceWidth: fontIdArg
1104	\| error \|
1105
1106	%{
1107	#ifdef XFT
1108	int v;
1109	if ( ! __isExternalAddressLike(fontIdArg) ) {
1110	error = @symbol(BadArg1);
1111	goto err;
1112	}
1113	v = XFT_FONT(fontIdArg)->max_advance_width;
1114	RETURN ( __MKINT( v ) );
1115	err:;
1116	#endif
1117	%}.
1118	self primitiveFailed: error
1119
1120	"Created: / 30-12-2013 / 20:02:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1121	!
1122
1123	xftFontGetPattern: fontIdArg
1124	\| error \|
1125
1126	%{
1127	#ifdef XFT
1128	XftPattern* p;
1129	if ( ! __isExternalAddressLike(fontIdArg) ) {
1130	error = @symbol(BadArg1);
1131	goto err;
1132	}
1133	p = XFT_FONT(fontIdArg)->pattern;
1134	if (p == NULL) {
1135	RETURN ( nil );
1136	} else {
1137	RETURN ( FC_PATTERN_HANDLE_NEW ( p ) );
1138	}
1139	err:;
1140	#endif
1141	%}.
1142	self primitiveFailed: error
1143
1144	"Created: / 21-12-2013 / 00:55:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1145	!
1146
1147	xftFontMatch: displayId screen: screen pattern: patternId
1148	\| error \|
1149
1150	%{
1151	#ifdef XFT
1152	XftPattern* p;
1153	XftResult r;
1154
1155	if ( ! __isExternalAddressLike(displayId) ) {
1156	error = @symbol(BadArg1);
1157	goto err;
1158	}
1159	if ( ! __isSmallInteger( screen ) ) {
1160	error = @symbol(BadArg2);
1161	goto err;
1162	}
1163	if ( ! __isExternalAddressLike(patternId) ) {
1164	error = @symbol(BadArg3);
1165	goto err;
1166	}
1167
1168	XftConfigSubstitute(FC_PATTERN( patternId ));
1169	XftDefaultSubstitute(DISPLAY(displayId) , SCREEN( screen ), FC_PATTERN( patternId ));
1170	p = XftFontMatch( DISPLAY(displayId) , SCREEN( screen ), FC_PATTERN( patternId ), &r );
1171	if (p) {
1172	RETURN ( FC_PATTERN_HANDLE_NEW ( p ) );
1173	} else {
1174	error = @symbol(XftFontMatchReturnedNull);
1175	}
1176	err:;
1177	#endif
1178	%}.
1179	self primitiveFailed: error
1180
1181	"Created: / 21-12-2013 / 00:08:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1182	!
1183
1184	xftFontOpenPattern: displayId pattern: patternId
1185	\| error \|
1186
1187	%{
1188	#ifdef XFT
1189	XftFont* f;
1190	if ( ! __isExternalAddressLike(displayId) ) {
1191	error = @symbol(BadArg1);
1192	goto err;
1193	}
1194	if ( ! __isExternalAddressLike(patternId) ) {
1195	error = @symbol(BadArg2);
1196	goto err;
1197	}
1198
1199	f = XftFontOpenPattern( DISPLAY(displayId) , FC_PATTERN( patternId ) );
1200	if (f == NULL) {
1201	RETURN ( nil );
1202	} else {
1203	RETURN ( XFT_FONT_HANDLE_NEW ( f ) );
1204	}
1205	err:;
1206	#endif
1207	%}.
1208	self primitiveFailed: error
1209
1210	"Created: / 20-12-2013 / 23:53:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1211	!
1212
1213	xftPatternAdd: pattern attribute: attribute value: value
1214	"Add a value to the specified pattern element after existing values"
1215
1216	^ self xftPatternAdd: pattern attribute: attribute value: value append: true.
1217
1218	"Created: / 20-12-2013 / 23:43:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1219	!
1220
1221	xftPatternAdd: pattern attribute: attribute value: value append: append
1222	"Add a value to the specified pattern element. If 'append' is true, the value
1223	is added after existing values, otherwise it is added before them."
1224
1225	\| error \|
1226
1227	%{
1228	#ifdef XFT
1229	XftValue v;
1230	Bool b;
1231
1232	if ( ! __isExternalAddressLike ( pattern ) ) {
1233	error = @symbol(BadArg1);
1234	goto err;
1235	}
1236	if ( ! __isStringLike ( attribute ) ) {
1237	error = @symbol(BadArg2);
1238	goto err;
1239	}
1240	if ( append != true && append != false ) {
1241	error = @symbol(BadArg4);
1242	goto err;
1243	}
1244	if ( __isStringLike ( value ) ) {
1245	v.type = FcTypeString;
1246	/* Passing pointer inside Smalltalk should be safe,
1247	* Xft/FontConfig libraries seem to allocate and store
1248	* a __copy__ of the string (if I understood the code correctly)
1249	*/
1250	v.u.s = __stringVal( value);
1251	} else if ( __isSmallInteger( value ) ) {
1252	v.type = XftTypeInteger;
1253	v.u.i = (int)__intVal( value );
1254	} else if ( value == true \|\| value == false ) {
1255	v.type = XftTypeBool;
1256	v.u.b = value == true ? True : False;
1257	} else if ( __isFloat ( value ) ) {
1258	v.type = XftTypeDouble;
1259	v.u.d = __floatVal( value );
1260	} else if ( value == nil ) {
1261	v.type = XftTypeVoid;
1262	v.u.f = NULL;
1263	} else {
1264	error = @symbol(BadArg3);
1265	goto err;
1266	}
1267	b = XftPatternAdd( FC_PATTERN(pattern), __stringVal(attribute), v, append == true ? True : False );
1268	RETURN ( b == True ? true : false );
1269
1270	err:;
1271	#endif
1272	%}.
1273	self primitiveFailed: error
1274
1275	"Created: / 20-12-2013 / 21:50:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1276	!
1277
1278	xftPatternCreate
1279	%{
1280	#ifdef XFT
1281	RETURN ( FC_PATTERN_HANDLE_NEW ( XftPatternCreate() ) );
1282	#endif
1283	%}.
1284	self primitiveFailed.
1285
1286	"Created: / 20-12-2013 / 21:19:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1287	!
1288
1289	xftPatternDel: pattern attribute: attribute
1290	\| error \|
1291	%{
1292	#ifdef XFT
1293	if ( ! __isExternalAddressLike ( pattern ) ) {
1294	error = @symbol(BadArg1);
1295	goto err;
1296	}
1297	if ( ! __isStringLike ( attribute ) ) {
1298	error = @symbol(BadArg2);
1299	goto err;
1300	}
1301	XftPatternDel( FC_PATTERN(pattern), __stringVal ( attribute ) );
1302	RETURN ( self );
1303
1304	err:;
1305	#endif
1306	%}.
1307	self primitiveFailed: error
1308
1309	"Created: / 20-12-2013 / 21:33:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1310	!
1311
1312	xftPatternDestroy: addr
1313	\| error \|
1314
1315	addr isNil ifTrue:[ ^ self ].
1316
1317	%{
1318	#ifdef XFT
1319	if ( ! __isExternalAddressLike(addr) ) {
1320	error = @symbol(BadArg1);
1321	goto err;
1322	}
1323	XftPatternDestroy( FC_PATTERN(addr) );
1324	RETURN ( self );
1325
1326	err:;
1327	#endif
1328	%}.
1329	self primitiveFailed: error
1330
1331	"Created: / 20-12-2013 / 21:33:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1332	"Modified: / 20-12-2013 / 23:48:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1333	!
1334
1335	xftPatternDuplicate: addr
1336	\| error \|
1337
1338	addr isNil ifTrue:[ ^ self ].
1339
1340	%{
1341	#ifdef XFT
1342	if ( ! __isExternalAddressLike(addr) ) {
1343	error = @symbol(BadArg1);
1344	goto err;
1345	}
1346	RETURN ( FC_PATTERN_HANDLE_NEW ( XftPatternDuplicate( FC_PATTERN(addr) ) ) );
1347	err:;
1348	#endif
1349	%}.
1350	self primitiveFailed: error
1351
1352	"Created: / 21-12-2013 / 01:14:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1353	!
1354
1355	xftPatternGet: pattern attribute: attribute index: index
1356	"Return a value from the specified element -- multiple values can be indexed
1357	with 'index' starting at zero."
1358
1359	\| error \|
1360
1361	%{
1362	#ifdef XFT
1363	XftValue v;
1364	XftResult r;
1365
1366	if ( ! __isExternalAddressLike ( pattern ) ) {
1367	error = @symbol(BadArg1);
1368	goto err;
1369	}
1370	if ( ! __isStringLike ( attribute ) ) {
1371	error = @symbol(BadArg2);
1372	goto err;
1373	}
1374	if ( ! __isSmallInteger( index ) ) {
1375	error = @symbol(BadArg3);
1376	goto err;
1377	}
1378	r = XftPatternGet(FC_PATTERN(pattern), __stringVal( attribute ), __intVal( index ), &v);
1379	if ( r != XftResultMatch) {
1380	RETURN ( nil );
1381	}
1382	if ( v.type == XftTypeString) {
1383	RETURN ( __MKSTRING(v.u.s) );
1384	} else if ( v.type == XftTypeInteger ) {
1385	RETURN ( __MKINT (v.u.i) );
1386	} else if ( v.type == XftTypeBool ) {
1387	RETURN ( v.u.b == True ? true : false );
1388	} else if ( v.type == XftTypeDouble ) {
1389	RETURN ( __MKFLOAT (v.u.d) );
1390	} else if ( v.type == XftTypeVoid ) {
1391	RETURN ( nil );
1392	} else {
1393	error = @symbol(UnssuportedTypeValue);
1394	goto err;
1395	}
1396	err:;
1397	#endif
1398	%}.
1399	self primitiveFailed: error
1400
1401	"Created: / 20-12-2013 / 21:50:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1402	"Modified: / 21-12-2013 / 01:06:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1403	!
1404
1405	xftTextExtents: displayIdArg font: fontIdArg string: text from: start to: stop
1406	\| error extents bitsPerCharacter \|
1407
1408	extents := Array new: 6.
1409	bitsPerCharacter := text bitsPerCharacter.
1410	%{
1411	#ifdef XFT
1412	XGlyphInfo info;
1413	int bytesPerCharacter;
1414	char *string;
1415	int len;
1416
1417	bytesPerCharacter = __intVal(bitsPerCharacter) / 8;
1418
1419	if ( ! __isExternalAddressLike(displayIdArg) ) {
1420	error = @symbol(BadArg1);
1421	goto err;
1422	}
1423	if ( ! __isExternalAddressLike(fontIdArg) ) {
1424	error = @symbol(BadArg2);
1425	goto err;
1426	}
1427	if ( ! __isSmallInteger(start) ) {
1428	error = @symbol(BadArg4);
1429	goto err;
1430	}
1431	if ( ! __isSmallInteger(stop) ) {
1432	error = @symbol(BadArg5);
1433	goto err;
1434	}
1435
1436	string = __stringVal( text ) + (( __intVal(start) - 1 ) * bytesPerCharacter);
1437	len = __intVal(stop) - __intVal(start) + 1;
1438
1439
1440	switch (bytesPerCharacter) {
1441	case 1:
1442	XftTextExtents8(DISPLAY(displayIdArg), XFT_FONT(fontIdArg), (FcChar8*)string, len, &info);
1443	break;
1444	case 2:
1445	XftTextExtents16(DISPLAY(displayIdArg), XFT_FONT(fontIdArg), (FcChar16*)string, len, &info);
1446	break;
1447	case 4:
1448	XftTextExtents32(DISPLAY(displayIdArg), XFT_FONT(fontIdArg), (FcChar32*)string, len, &info);
1449	break;
1450	}
1451	__ArrayInstPtr(extents)->a_element[0] = __MKSMALLINT(info.width);
1452	__ArrayInstPtr(extents)->a_element[1] = __MKSMALLINT(info.height);
1453	__ArrayInstPtr(extents)->a_element[2] = __MKSMALLINT(info.x);
1454	__ArrayInstPtr(extents)->a_element[3] = __MKSMALLINT(info.y);
1455	__ArrayInstPtr(extents)->a_element[4] = __MKSMALLINT(info.xOff);
1456	__ArrayInstPtr(extents)->a_element[5] = __MKSMALLINT(info.yOff);
1457	error = nil;
1458	err:;
1459	#endif
1460	%}.
1461	error notNil ifTrue:[
1462	self primitiveFailed: error.
1463	^ nil.
1464	].
1465	^ extents
1466
1467	"Created: / 21-12-2013 / 10:42:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1468	"Modified: / 30-12-2013 / 20:00:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1469	! !
1470
1471	!XftFontDescription methodsFor:'printing & storing'!
1472
1473	storeOn:aStream
1474	"append a character sequence to the argument, aStream from which the
1475	receiver can be reconstructed using readFrom:."
1476
1477	aStream nextPutAll:'(XftFontDescription family:'. family storeOn:aStream.
1478	aStream nextPutAll:' face:'. face storeOn:aStream.
1479	aStream nextPutAll:' style:'. style storeOn:aStream.
1480	aStream nextPutAll:' size:'. size storeOn:aStream.
1481	aStream nextPutAll:' encoding:'. encoding storeOn:aStream.
1482	aStream nextPut:$)
1483
1484	"
1485	(XftFontDescription family: 'DejaVu Sans' size: 8) storeString
1486	"
1487	! !
1488
1489	!XftFontDescription methodsFor:'queries-dimensions'!
1490
1491	ascent
1492	"return the ascent - the number of pixels above the baseLine."
1493
1494	^ self xftFontGetAscent: fontId
1495
1496	"Created: / 21-12-2013 / 01:19:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1497	!
1498
1499	descent
1500	"return the descent - the number of pixels below the baseLine."
1501
1502	^ self xftFontGetDescent: fontId
1503
1504	"Created: / 21-12-2013 / 01:20:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1505	!
1506
1507	getFontMetrics
1508	\|info\|
1509
1510	info := DeviceWorkstation::DeviceFontMetrics new.
1511	info
1512	ascent:self ascent
1513	descent:self descent
1514	maxAscent:self maxAscent
1515	maxDescent:self maxDescent
1516	minWidth:self maxWidth
1517	maxWidth:self maxWidth
1518	avgWidth:self maxWidth
1519	minCode:self minCode
1520	maxCode:self maxCode
1521	direction:#LeftToRight.
1522	^ info
1523	!
1524
1525	height
1526	"return the height - the number of pixels above plus below the baseLine."
1527
1528	^ self xftFontGetHeight: fontId
1529
1530	"Created: / 21-12-2013 / 01:20:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1531	!
1532
1533	isFixedWidth
1534	"return true, if this is a fixed pitch font (i.e. all characters
1535	are of the same width)"
1536
1537	^ false "/ How to check?
1538
1539	"Created: / 21-12-2013 / 10:38:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1540	!
1541
1542	maxAscent
1543	"return the fonts maximum-ascent (i.e. the maximum of all characters);
1544	That is the number of units (usually pixels) above the baseline."
1545
1546	^ self ascent
1547
1548	"Created: / 30-12-2013 / 20:01:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1549	!
1550
1551	maxDescent
1552	"return the fonts maximum-descent (i.e. the maximum of all characters);
1553	That is the number of units (usually pixels) below the baseline."
1554
1555	^ self descent
1556
1557	"Created: / 30-12-2013 / 20:01:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1558	!
1559
1560	maxWidth
1561	"return the fonts maximum-width character (i.e. the maximum of all characters);
1562	That is a number of units (usually pixels)."
1563
1564	^ self xftFontGetMaxAdvanceWidth: fontId
1565
1566	"Created: / 30-12-2013 / 20:02:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1567	!
1568
1569	widthOf:aString from:start to:stop
1570	"return the width of a sub string"
1571
1572	\| extents \|
1573
1574	(stop < start) ifTrue:[^ 0].
1575	extents := self xftTextExtents: device displayId font: fontId string: aString from: start to: stop.
1576	"/ extents --> #(width height x y xOff yOff)
1577	^ extents fifth.
1578
1579	"Created: / 21-12-2013 / 10:42:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1580	"Modified: / 29-12-2013 / 21:16:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1581	! !
1582
1583	!XftFontDescription methodsFor:'release'!
1584
1585	releaseDrawIfAssociatedWith: view
1586	\| drawableId \|
1587
1588	view isNil ifTrue:[ ^ self ].
1589	drawableId := view id.
1590	drawableId isNil ifTrue: [ ^ self ].
1591	%{
1592	#ifdef XFT
1593	if ( __INST(sharedDrawId) != nil ) {
1594	if (XftDrawDrawable(XFT_DRAW(__INST(sharedDrawId))) == DRAWABLE(drawableId)) {
1595	XftDrawDestroy(XFT_DRAW(__INST(sharedDrawId)));
1596	__INST(sharedDrawId) = nil;
1597	}
1598	}
1599	RETURN (self);
1600	#endif
1601	%}.
1602	self primitiveFailed
1603
1604	"Created: / 12-01-2014 / 19:48:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1605	"Modified: / 12-01-2014 / 22:09:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1606	!
1607
1608	releaseFromDevice
1609	"I am no longer available on the device"
1610
1611	device := nil.
1612	fontId := nil.
1613	sharedDrawId := nil.
1614	closestFont := nil
1615	! !
1616
1617	!XftFontDescription methodsFor:'testing'!
1618
1619	isUsed
1620	^ sharedDrawId notNil
1621	!
1622
1623	isXftFont
1624	^ true
1625	! !
1626
1627	!XftFontDescription::FCFontListParser class methodsFor:'documentation'!
1628
1629	documentation
1630	"
1631	parses fc-list output to get a list of XftFontDescriptions
1632
1633	[author:]
1634	cg
1635
1636	[instance variables:]
1637
1638	[class variables:]
1639
1640	[see also:]
1641
1642	"
1643	! !
1644
1645	!XftFontDescription::FCFontListParser methodsFor:'api'!
1646
1647	listOfAvailableFonts
1648	\|readEntry list l fcListProg\|
1649
1650	list := OrderedCollection new.
1651
1652	readEntry :=
1653	[
1654	\|key\|
1655
1656	[l startsWith:'Pattern has'] whileFalse:[
1657	l := pipeStream nextLine. Transcript showCR:l.
1658	].
1659
1660	currentDescription := XftFontDescription new.
1661	[ l := pipeStream nextLine. l notEmptyOrNil ] whileTrue:[
1662	"/ Transcript showCR:l.
1663	lineStream := l readStream. lineStream skipSeparators.
1664	key := lineStream upToSeparator.
1665	(
1666	#('family:' 'style:' 'slant:' 'weight:' 'width:'
1667	'pixelsize:' 'spacing:' 'foundry:' 'antialias:'
1668	'file:' 'outline' 'scalable:' 'charset:' 'lang:'
1669	'fontversion:' 'fontformat:' 'decorative:' 'index:'
1670	'outline:' 'familylang:' 'stylelang:' 'fullname:'
1671	'fullnamelang:' 'capability:' 'hash:' 'postscriptname:'
1672	) includes:key
1673	) ifTrue:[
1674	self perform:('fc_',(key allButLast)) asSymbol
1675	] ifFalse:[
1676	Transcript show:'Xft ignored line: '; showCR:l.
1677	self breakPoint:#cg.
1678	].
1679	].
1680	list add:currentDescription
1681	].
1682
1683	fcListProg := #('/usr/bin/fc-list' '/usr/X11/bin/fc-list') detect:[:eachProg\|
1684	eachProg asFilename isExecutableProgram
1685	] ifNone:[
1686	'fc-list program not found - no XFT fonts' infoPrintCR.
1687	^ list.
1688	].
1689
1690	pipeStream := PipeStream readingFrom:fcListProg, ' -v'.
1691	[
1692	[pipeStream atEnd] whileFalse:[
1693	l := pipeStream nextLine.
1694	readEntry value.
1695	]
1696	] ensure:[
1697	pipeStream close
1698	].
1699	^ list
1700
1701	"
1702	FCFontListParser new listOfAvailableFonts
1703	"
1704	! !
1705
1706	!XftFontDescription::FCFontListParser methodsFor:'font list keywords'!
1707
1708	fc_antialias
1709	"helper for font listing"
1710
1711	currentDescription isAntialiasedFont:(self getBoolean).
1712	!
1713
1714	fc_capability
1715	"helper for font listing"
1716
1717	"currentDescription capability:" (self getString).
1718	!
1719
1720	fc_charset
1721	"helper for font listing"
1722
1723	\|page bits l min max minCode maxCode\|
1724
1725	[ l := pipeStream nextLine. l notEmpty ] whileTrue:[
1726	"/ Transcript show:'->'; showCR:l.
1727	(l startsWith:Character tab) ifFalse:[
1728	(l startsWith:'(') ifFalse:[self halt].
1729	currentDescription minCode:minCode.
1730	currentDescription maxCode:maxCode.
1731	^ self.
1732	].
1733
1734	lineStream := l readStream.
1735	lineStream skipSeparators.
1736	page := Integer readFrom:(lineStream upTo:$:) radix:16.
1737	lineStream next.
1738	bits := 0 to:7 collect:[:i\|
1739	lineStream skipSeparators.
1740	Integer readFrom:(lineStream upToSeparator) radix:16.
1741	].
1742	min := (page * 256 + 0).
1743	max := (page * 256 + 255).
1744	minCode isNil ifTrue:[
1745	minCode := min.
1746	maxCode := max.
1747	] ifFalse:[
1748	minCode := minCode min:min.
1749	maxCode := maxCode max:max.
1750	].
1751	].
1752	"/ currentDescription characterSet:(self getString).
1753	currentDescription minCode:minCode.
1754	currentDescription maxCode:maxCode.
1755	!
1756
1757	fc_decorative
1758	"helper for font listing"
1759
1760	currentDescription isDecorativeFont:(self getBoolean).
1761	!
1762
1763	fc_family
1764	"helper for font listing"
1765
1766	currentDescription family:(self getString).
1767	!
1768
1769	fc_familylang
1770	"helper for font listing"
1771
1772	"currentDescription familylang:" (self getString).
1773	!
1774
1775	fc_file
1776	"helper for font listing"
1777
1778	currentDescription file:(self getString).
1779	!
1780
1781	fc_fontformat
1782	"helper for font listing"
1783
1784	currentDescription fontFormat:(self getString).
1785	!
1786
1787	fc_fontversion
1788	"helper for font listing"
1789
1790	currentDescription fontVersion:(self getInteger).
1791	!
1792
1793	fc_foundry
1794	"helper for font listing"
1795
1796	currentDescription foundry:(self getString).
1797	!
1798
1799	fc_fullname
1800	"helper for font listing"
1801
1802	"currentDescription fullname:" (self getString).
1803	!
1804
1805	fc_fullnamelang
1806	"helper for font listing"
1807
1808	"currentDescription fullnamelang:" (self getString).
1809	!
1810
1811	fc_hash
1812	"helper for font listing"
1813
1814	"currentDescription hash:" self getString.
1815	!
1816
1817	fc_index
1818	"helper for font listing"
1819
1820	"currentDescription index:" (self getInteger).
1821	!
1822
1823	fc_lang
1824	"helper for font listing"
1825
1826	"/ currentDescription characterSet:(self getString).
1827	!
1828
1829	fc_outline
1830	"helper for font listing"
1831
1832	currentDescription isOutlineFont:(self getBoolean).
1833	!
1834
1835	fc_pixelsize
1836	"helper for font listing"
1837
1838	currentDescription setPixelSize:(self getInteger).
1839	currentDescription setSizeUnit:#px.
1840	"/ currentDescription setSize:(self getInteger).
1841	"/ currentDescription setSizeUnit:#pt.
1842	!
1843
1844	fc_postscriptname
1845	"helper for font listing"
1846
1847	"currentDescription postscriptname:" self getString.
1848	!
1849
1850	fc_scalable
1851	"helper for font listing"
1852
1853	currentDescription isScalableFont:(self getBoolean).
1854	!
1855
1856	fc_slant
1857	"helper for font listing"
1858
1859	currentDescription slant:(self getInteger).
1860	!
1861
1862	fc_spacing
1863	"helper for font listing"
1864
1865	currentDescription spacing:(self getInteger).
1866	!
1867
1868	fc_style
1869	"helper for font listing"
1870
1871	\|xftStyle\|
1872
1873	xftStyle := self getString.
1874	(xftStyle includesString:'Bold') ifTrue:[
1875	currentDescription face:'bold'.
1876	currentDescription style:'roman'.
1877	^ self.
1878	].
1879	(xftStyle includesString:'Italic') ifTrue:[
1880	currentDescription face:'medium'.
1881	currentDescription style:'italic'.
1882	^ self.
1883	].
1884	(xftStyle includesString:'Oblique') ifTrue:[
1885	currentDescription face:'medium'.
1886	currentDescription style:'italic'.
1887	^ self.
1888	].
1889	"/ self halt.
1890	currentDescription face:'medium'.
1891	currentDescription style:'roman'.
1892	!
1893
1894	fc_stylelang
1895	"helper for font listing"
1896
1897	"currentDescription stylelang:" (self getString).
1898	!
1899
1900	fc_weight
1901	"helper for font listing"
1902
1903	currentDescription weight:(self getInteger).
1904	!
1905
1906	fc_width
1907	"helper for font listing"
1908
1909	currentDescription width:(self getInteger).
1910	! !
1911
1912	!XftFontDescription::FCFontListParser methodsFor:'helpers'!
1913
1914	getBoolean
1915	"helper for font listing"
1916
1917	\|s\|
1918
1919	lineStream skipSeparators.
1920	s := lineStream nextAlphaNumericWord.
1921	^ s = 'FcTrue'.
1922	!
1923
1924	getInteger
1925	"helper for font listing"
1926
1927	lineStream skipSeparators.
1928	^ Integer readFrom:lineStream.
1929	!
1930
1931	getString
1932	"helper for font listing"
1933
1934	lineStream skipSeparators.
1935	lineStream peekFor:$".
1936	^ (lineStream upTo:$").
1937	! !
1938
1939	!XftFontDescription class methodsFor:'documentation'!
1940
1941	version
1942	^ '$Header: /cvs/stx/stx/libview/XftFontDescription.st,v 1.44 2014/04/01 13:26:51 vrany Exp $'
1943	!
1944
1945	version_CVS
1946	^ '$Header: /cvs/stx/stx/libview/XftFontDescription.st,v 1.44 2014/04/01 13:26:51 vrany Exp $'
1947	! !
1948
1949
1950	XftFontDescription initialize!

Download in other formats:

Original Format