Faculty of Information Technology
Software Engineering Group

Ticket #24: XftFontDescription.st

File XftFontDescription.st, 52.4 KB (added by Jan Vrany, 7 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
5FontDescription 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
35Object subclass:#FCFontListParser
36        instanceVariableNames:'pipeStream lineStream currentDescription'
37        classVariableNames:''
38        poolDictionaries:''
39        privateIn:XftFontDescription
40!
41
42ExternalAddress subclass:#FCPatternHandle
43        instanceVariableNames:''
44        classVariableNames:''
45        poolDictionaries:''
46        privateIn:XftFontDescription
47!
48
49ExternalAddress subclass:#XftDrawHandle
50        instanceVariableNames:''
51        classVariableNames:''
52        poolDictionaries:''
53        privateIn:XftFontDescription
54!
55
56ExternalAddress 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
77extern 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
125documentation
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
160flushListOfAvailableFonts
161    CachedFontList := nil.
162
163    "
164     XftFontDescription flushListOfAvailableFonts
165    "
166!
167
168initialize
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
295family: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
320new
321"/    self halt.
322    ^ super new.
323! !
324
325!XftFontDescription class methodsFor:'examples'!
326
327example1
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
350example2
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
374listOfAvailableFonts
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
390encoding
391    ^ encoding ? 'iso10646-1'
392!
393
394face
395    ^ face ? ''
396!
397
398fullName
399    ^ name ? (self userFriendlyName)
400!
401
402graphicsDevice
403    ^ device
404
405    "Created: / 02-01-2014 / 23:22:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
406!
407
408maxCode
409    ^ maxCode ? 16rFFFF
410!
411
412maxCode:something
413    maxCode := something.
414!
415
416minCode
417    ^ minCode ? 0
418!
419
420minCode:something
421    minCode := something.
422!
423
424size
425    ^ size ? 0
426!
427
428style
429    ^ style ? ''
430! !
431
432!XftFontDescription methodsFor:'accessing-private'!
433
434getFontId
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
442displayString: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
653primitiveFailed
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
665primitiveFailed: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
679onDevice: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
766onDevice: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
780setDevice: 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
802xftAvailable
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
813xftDrawChange: 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
838xftDrawCreate: 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
867xftDrawRect: 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
931xftDrawSetClip: 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
965xftDrawString: 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
1043xftFontGetAscent: 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
1063xftFontGetDescent: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
1083xftFontGetHeight: 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
1103xftFontGetMaxAdvanceWidth: 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
1123xftFontGetPattern: 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
1147xftFontMatch: 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
1184xftFontOpenPattern: 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
1213xftPatternAdd: 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
1221xftPatternAdd: 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
1278xftPatternCreate
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
1289xftPatternDel: 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
1312xftPatternDestroy: 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
1335xftPatternDuplicate: 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
1355xftPatternGet: 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
1405xftTextExtents: 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
1473storeOn: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
1491ascent
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
1499descent
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
1507getFontMetrics
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
1525height
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
1533isFixedWidth
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
1542maxAscent
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
1551maxDescent
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
1560maxWidth
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
1569widthOf: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
1585releaseDrawIfAssociatedWith: 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
1608releaseFromDevice
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
1619isUsed
1620    ^ sharedDrawId notNil
1621!
1622
1623isXftFont
1624    ^ true
1625! !
1626
1627!XftFontDescription::FCFontListParser class methodsFor:'documentation'!
1628
1629documentation
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
1647listOfAvailableFonts
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
1708fc_antialias
1709    "helper for font listing"
1710
1711    currentDescription isAntialiasedFont:(self getBoolean).
1712!
1713
1714fc_capability
1715    "helper for font listing"
1716
1717    "currentDescription capability:" (self getString).
1718!
1719
1720fc_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
1757fc_decorative
1758    "helper for font listing"
1759
1760    currentDescription isDecorativeFont:(self getBoolean).
1761!
1762
1763fc_family
1764    "helper for font listing"
1765
1766    currentDescription family:(self getString).
1767!
1768
1769fc_familylang
1770    "helper for font listing"
1771
1772    "currentDescription familylang:" (self getString).
1773!
1774
1775fc_file
1776    "helper for font listing"
1777
1778    currentDescription file:(self getString).
1779!
1780
1781fc_fontformat
1782    "helper for font listing"
1783
1784    currentDescription fontFormat:(self getString).
1785!
1786
1787fc_fontversion
1788    "helper for font listing"
1789
1790    currentDescription fontVersion:(self getInteger).
1791!
1792
1793fc_foundry
1794    "helper for font listing"
1795
1796    currentDescription foundry:(self getString).
1797!
1798
1799fc_fullname
1800    "helper for font listing"
1801
1802    "currentDescription fullname:" (self getString).
1803!
1804
1805fc_fullnamelang
1806    "helper for font listing"
1807
1808    "currentDescription fullnamelang:" (self getString).
1809!
1810
1811fc_hash
1812    "helper for font listing"
1813
1814    "currentDescription hash:" self getString.
1815!
1816
1817fc_index
1818    "helper for font listing"
1819
1820    "currentDescription index:" (self getInteger).
1821!
1822
1823fc_lang
1824    "helper for font listing"
1825
1826    "/ currentDescription characterSet:(self getString).
1827!
1828
1829fc_outline
1830    "helper for font listing"
1831
1832    currentDescription isOutlineFont:(self getBoolean).
1833!
1834
1835fc_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
1844fc_postscriptname
1845    "helper for font listing"
1846
1847    "currentDescription postscriptname:" self getString.
1848!
1849
1850fc_scalable
1851    "helper for font listing"
1852
1853    currentDescription isScalableFont:(self getBoolean).
1854!
1855
1856fc_slant
1857    "helper for font listing"
1858
1859    currentDescription slant:(self getInteger).
1860!
1861
1862fc_spacing
1863    "helper for font listing"
1864
1865    currentDescription spacing:(self getInteger).
1866!
1867
1868fc_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
1894fc_stylelang
1895    "helper for font listing"
1896
1897    "currentDescription stylelang:" (self getString).
1898!
1899
1900fc_weight
1901    "helper for font listing"
1902
1903    currentDescription weight:(self getInteger).
1904!
1905
1906fc_width
1907    "helper for font listing"
1908
1909    currentDescription width:(self getInteger).
1910! !
1911
1912!XftFontDescription::FCFontListParser methodsFor:'helpers'!
1913
1914getBoolean
1915    "helper for font listing"
1916
1917    |s|
1918
1919    lineStream skipSeparators.
1920    s := lineStream nextAlphaNumericWord.
1921    ^ s = 'FcTrue'.
1922!
1923
1924getInteger
1925    "helper for font listing"
1926
1927    lineStream skipSeparators.
1928    ^ Integer readFrom:lineStream.
1929!
1930
1931getString
1932    "helper for font listing"
1933
1934    lineStream skipSeparators.
1935    lineStream peekFor:$".
1936    ^ (lineStream upTo:$").
1937! !
1938
1939!XftFontDescription class methodsFor:'documentation'!
1940
1941version
1942    ^ '$Header: /cvs/stx/stx/libview/XftFontDescription.st,v 1.44 2014/04/01 13:26:51 vrany Exp $'
1943!
1944
1945version_CVS
1946    ^ '$Header: /cvs/stx/stx/libview/XftFontDescription.st,v 1.44 2014/04/01 13:26:51 vrany Exp $'
1947! !
1948
1949
1950XftFontDescription initialize!