XftFontDescription.st
author matilk
Wed, 13 Sep 2017 09:40:34 +0200
changeset 8174 2704c965b97b
parent 8018 2bd8a65110aa
child 8177 481a5ef90d18
permissions -rw-r--r--
#BUGFIX by Maren class: DeviceGraphicsContext changed: #displayDeviceOpaqueForm:x:y: nil check

"
 COPYRIGHT (c) 2013 by Jan Vrany
 COPYRIGHT (c) 2013 by Claus Gittinger / eXept Software AG
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
"{ Package: 'stx:libview' }"

"{ NameSpace: Smalltalk }"

FontDescription subclass:#XftFontDescription
	instanceVariableNames:'device fontId width minCode maxCode ascent descent height
		fixedWidth'
	classVariableNames:'FC_FAMILY FC_STYLE FC_SLANT FC_WEIGHT FC_SIZE FC_ASPECT
		FC_PIXEL_SIZE FC_SPACING FC_FOUNDRY FC_ANTIALIAS FC_HINTING
		FC_HINT_STYLE FC_VERTICAL_LAYOUT FC_AUTOHINT FC_WIDTH FC_FILE
		FC_INDEX FC_FT_FACE FC_RASTERIZER FC_OUTLINE FC_SCALABLE FC_SCALE
		FC_DPI FC_RGBA FC_MINSPACE FC_SOURCE FC_CHARSET FC_LANG
		FC_FONTVERSION FC_FULLNAME FC_FAMILYLANG FC_STYLELANG
		FC_FULLNAMELANG FC_CAPABILITY FC_FONTFORMAT FC_EMBOLDEN
		FC_EMBEDDED_BITMAP FC_DECORATIVE FC_LCD_FILTER FC_NAMELANG
		FC_CHAR_WIDTH FC_CHAR_HEIGHT FC_MATRIX FC_WEIGHT_THIN
		FC_WEIGHT_EXTRALIGHT FC_WEIGHT_ULTRALIGHT FC_WEIGHT_LIGHT
		FC_WEIGHT_BOOK FC_WEIGHT_REGULAR FC_WEIGHT_NORMAL
		FC_WEIGHT_MEDIUM FC_WEIGHT_DEMIBOLD FC_WEIGHT_SEMIBOLD
		FC_WEIGHT_BOLD FC_WEIGHT_EXTRABOLD FC_WEIGHT_ULTRABOLD
		FC_WEIGHT_BLACK FC_WEIGHT_HEAVY FC_WEIGHT_EXTRABLACK
		FC_WEIGHT_ULTRABLACK FC_SLANT_ROMAN FC_SLANT_ITALIC
		FC_SLANT_OBLIQUE FC_WIDTH_ULTRACONDENSED FC_WIDTH_EXTRACONDENSED
		FC_WIDTH_CONDENSED FC_WIDTH_SEMICONDENSED FC_WIDTH_NORMAL
		FC_WIDTH_SEMIEXPANDED FC_WIDTH_EXPANDED FC_WIDTH_EXTRAEXPANDED
		FC_WIDTH_ULTRAEXPANDED FC_PROPORTIONAL FC_DUAL FC_MONO
		FC_CHARCELL FC_RGBA_UNKNOWN FC_RGBA_RGB FC_RGBA_BGR FC_RGBA_VRGB
		FC_RGBA_VBGR FC_RGBA_NONE FC_HINT_NONE FC_HINT_SLIGHT
		FC_HINT_MEDIUM FC_HINT_FULL FC_LCD_NONE FC_LCD_DEFAULT
		FC_LCD_LIGHT FC_LCD_LEGACY StXFace2FCWeightMap
		StXStyle2FCSlantMap FirstTimeCalled CachedFontList'
	poolDictionaries:''
	category:'Graphics-Support'
!

Object subclass:#FCFontListParser
	instanceVariableNames:'pipeStream lineStream currentDescription'
	classVariableNames:''
	poolDictionaries:''
	privateIn:XftFontDescription
!

ExternalAddress subclass:#FCPatternHandle
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	privateIn:XftFontDescription
!

ExternalAddress subclass:#XftDrawHandle
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	privateIn:XftFontDescription
!

ExternalAddress subclass:#XftFontHandle
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	privateIn:XftFontDescription
!

!XftFontDescription primitiveDefinitions!
%{
/*
 * includes, defines, structure definitions
 * and typedefs come here.
 */

#undef True
#undef False
#undef Time
#define Time XTime

#ifdef XFT

extern OBJ __GLOBAL_GET_BY_NAME(char *);

# define __HANDLE_VAL(type, externalAddress) \
	((type)__externalAddressVal(externalAddress))

# define __HANDLE_NEW(ptr, __cls)                    \
	({                                           \
	    OBJ handle = __MKEXTERNALADDRESS(ptr);   \
	    OBJ clsObj = __GLOBAL_GET_BY_NAME(__cls);\
	    __InstPtr(handle)->o_class = clsObj;     \
	    __STORE(handle, clsObj);                 \
	    handle;                                  \
	})

# define DISPLAY(x)    __HANDLE_VAL(Display*, x)
# define SCREEN(x)     ((int)(__intVal(x)))
# define DRAWABLE(x)   __HANDLE_VAL(Drawable, x)
# define GC(x)         __HANDLE_VAL(GC, x)
# define VISUAL(x)     __HANDLE_VAL(Visual*, x)
# define COLORMAP(x)   __HANDLE_VAL(Colormap, x)

/* FontConfig objects */
# define FC_PATTERN(x)                  __HANDLE_VAL(XftPattern*, x)
# define FC_PATTERN_HANDLE_NEW(x)       __HANDLE_NEW(x, "XftFontDescription::FCPatternHandle")

/* Xft Objects */

# define XFT_FONT(x)            __HANDLE_VAL(XftFont*, x)
# define XFT_FONT_HANDLE_NEW(x) __HANDLE_NEW(x, "XftFontDescription::XftFontHandle")

# define XFT_DRAW(x)            __HANDLE_VAL(XftDraw*, x)
# define XFT_DRAW_HANDLE_NEW(x) __HANDLE_NEW(x, "XftFontDescription::XftDrawHandle")

# include <X11/Xft/Xft.h>
#endif
%}
! !

!XftFontDescription class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 2013 by Jan Vrany
 COPYRIGHT (c) 2013 by Claus Gittinger / eXept Software AG
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.

"
!

documentation
"
    WARNING: Unfinished.

    Experimental implementation of custom font rendered using
    Xft library (UNIX / X Window only), To actually use it,
    add following definitions to the end of stx/configurations/myConf
    (works on Ubuntu 12.10)

    --- snip ---
    XDEFS+=-DXFT
    XINCLUDE+=$(shell pkg-config --cflags xft)
    LIB_XFT=-l:libXft.so.2 -l:libfontconfig.so.1
    --- snip --

    NOTE: This class should be named XftFont, however then
    there would be a name clash with XftFont structure
    defined in Xft.h - therefore the class is named
    XftFontDescription to avoid that name clash.


    [author:]
	Jan Vrany <jan.vrany@fit.cvut.cz>

    [instance variables:]

    [class variables:]

    [see also:]

"
! !

!XftFontDescription class methodsFor:'initialization'!

flushListOfAvailableFonts
    CachedFontList := nil.

    "
     XftFontDescription flushListOfAvailableFonts
    "
!

initialize
    "Invoked at system start or when the class is dynamically loaded."

    " Taken from fontconfig,h "

    FC_FAMILY               := 'family'.            "/* String */
    FC_STYLE                := 'style'.             "/* String */
    FC_SLANT                := 'slant'.             "/* Int */
    FC_WEIGHT               := 'weight'.            "/* Int */
    FC_SIZE                 := 'size'.              "/* Double */
    FC_ASPECT               := 'aspect'.            "/* Double */
    FC_PIXEL_SIZE           := 'pixelsize'.         "/* Double */
    FC_SPACING              := 'spacing'.           "/* Int */
    FC_FOUNDRY              := 'foundry'.           "/* String */
    FC_ANTIALIAS            := 'antialias'.         "/* Bool (depends) */
    FC_HINTING              := 'hinting'.           "/* Bool (true) */
    FC_HINT_STYLE           := 'hintstyle'.         "/* Int */
    FC_VERTICAL_LAYOUT      := 'verticallayout'.    "/* Bool (false) */
    FC_AUTOHINT             := 'autohint'.          "/* Bool (false) */
    FC_WIDTH                := 'width'.             "/* Int */
    FC_FILE                 := 'file'.              "/* String */
    FC_INDEX                := 'index'.             "/* Int */
    FC_FT_FACE              := 'ftface'.            "/* FT_Face */
    FC_RASTERIZER           := 'rasterizer'.        "/* String */
    FC_OUTLINE              := 'outline'.           "/* Bool */
    FC_SCALABLE             := 'scalable'.          "/* Bool */
    FC_SCALE                := 'scale'.             "/* double */
    FC_DPI                  := 'dpi'.               "/* double */
    FC_RGBA                 := 'rgba'.              "/* Int */
    FC_MINSPACE             := 'minspace'.          "/* Bool use minimum line spacing */
    FC_SOURCE               := 'source'.            "/* String (deprecated) */
    FC_CHARSET              := 'charset'.           "/* CharSet */
    FC_LANG                 := 'lang'.              "/* String RFC 3066 langs */
    FC_FONTVERSION          := 'fontversion'.       "/* Int from 'head'.table */
    FC_FULLNAME             := 'fullname'.          "/* String */
    FC_FAMILYLANG           := 'familylang'.        "/* String RFC 3066 langs */
    FC_STYLELANG            := 'stylelang'.         "/* String RFC 3066 langs */
    FC_FULLNAMELANG         := 'fullnamelang'.      "/* String RFC 3066 langs */
    FC_CAPABILITY           := 'capability'.        "/* String */
    FC_FONTFORMAT           := 'fontformat'.        "/* String */
    FC_EMBOLDEN             := 'embolden'.          "/* Bool - true if emboldening needed*/
    FC_EMBEDDED_BITMAP      := 'embeddedbitmap'.    "/* Bool - true to enable embedded bitmaps */
    FC_DECORATIVE           := 'decorative'.        "/* Bool - true if style is a decorative variant */
    FC_LCD_FILTER           := 'lcdfilter'.         "/* Int */
    FC_NAMELANG             := 'namelang'.          "/* String RFC 3866 langs */


    "Adjust outline rasterizer"
    FC_CHAR_WIDTH           := 'charwidth'.     "/* Int */
    FC_CHAR_HEIGHT          := 'charheight'.    "/* Int */
    FC_MATRIX               := 'matrix'.        "/* FcMatrix */

    FC_WEIGHT_THIN          := 0.
    FC_WEIGHT_EXTRALIGHT    := 40.
    FC_WEIGHT_ULTRALIGHT    := FC_WEIGHT_EXTRALIGHT.
    FC_WEIGHT_LIGHT         := 50.
    FC_WEIGHT_BOOK          := 75.
    FC_WEIGHT_REGULAR       := 80.
    FC_WEIGHT_NORMAL        := FC_WEIGHT_REGULAR.
    FC_WEIGHT_MEDIUM        := 100.
    FC_WEIGHT_DEMIBOLD      := 180.
    FC_WEIGHT_SEMIBOLD      := FC_WEIGHT_DEMIBOLD.
    FC_WEIGHT_BOLD          := 200.
    FC_WEIGHT_EXTRABOLD     := 205.
    FC_WEIGHT_ULTRABOLD     := FC_WEIGHT_EXTRABOLD.
    FC_WEIGHT_BLACK         := 210.
    FC_WEIGHT_HEAVY         := FC_WEIGHT_BLACK.
    FC_WEIGHT_EXTRABLACK    := 215.
    FC_WEIGHT_ULTRABLACK    := FC_WEIGHT_EXTRABLACK.

    FC_SLANT_ROMAN          := 0.
    FC_SLANT_ITALIC         := 100.
    FC_SLANT_OBLIQUE        := 110.

    FC_WIDTH_ULTRACONDENSED := 50.
    FC_WIDTH_EXTRACONDENSED := 63.
    FC_WIDTH_CONDENSED      := 75.
    FC_WIDTH_SEMICONDENSED  := 87.
    FC_WIDTH_NORMAL         := 100.
    FC_WIDTH_SEMIEXPANDED   := 113.
    FC_WIDTH_EXPANDED       := 125.
    FC_WIDTH_EXTRAEXPANDED  := 150.
    FC_WIDTH_ULTRAEXPANDED  := 200.

    FC_PROPORTIONAL         := 0.
    FC_DUAL                 := 90.
    FC_MONO                 := 100.
    FC_CHARCELL             := 110.

    "sub-pixel order"
    FC_RGBA_UNKNOWN         := 0.
    FC_RGBA_RGB             := 1.
    FC_RGBA_BGR             := 2.
    FC_RGBA_VRGB            := 3.
    FC_RGBA_VBGR            := 4.
    FC_RGBA_NONE            := 5.

    "hinting style"
    FC_HINT_NONE            := 0.
    FC_HINT_SLIGHT          := 1.
    FC_HINT_MEDIUM          := 2.
    FC_HINT_FULL            := 3.

    "LCD filter"
    FC_LCD_NONE             := 0.
    FC_LCD_DEFAULT          := 1.
    FC_LCD_LIGHT            := 2.
    FC_LCD_LEGACY           := 3.

    StXFace2FCWeightMap :=
	Dictionary withKeysAndValues:{
	    #thin.       FC_WEIGHT_THIN.
	    #extralight. FC_WEIGHT_EXTRALIGHT.
	    #ultralight. FC_WEIGHT_ULTRALIGHT.
	    #light.      FC_WEIGHT_LIGHT.
	    #book.       FC_WEIGHT_BOOK.
	    #regular.    FC_WEIGHT_REGULAR.
	    #normal.     FC_WEIGHT_NORMAL.
	    #medium.     FC_WEIGHT_MEDIUM.
	    #demibold.   FC_WEIGHT_DEMIBOLD.
	    #semibold.   FC_WEIGHT_SEMIBOLD.
	    #bold.       FC_WEIGHT_BOLD.
	    #extrabold.  FC_WEIGHT_EXTRABOLD.
	    #ultrabold.  FC_WEIGHT_ULTRABOLD.
	    #black.      FC_WEIGHT_BLACK.
	    #heavy.      FC_WEIGHT_HEAVY.
	    #extrablack. FC_WEIGHT_EXTRABLACK.
	    #ultrablack. FC_WEIGHT_ULTRABLACK.
	}.

    StXStyle2FCSlantMap :=
	Dictionary withKeysAndValues:{
	    #roman.    FC_SLANT_ROMAN.
	    #italic.   FC_SLANT_ITALIC.
	    #oblique.  FC_SLANT_OBLIQUE.
	}.

    "Modified: / 30-12-2013 / 19:48:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!XftFontDescription class methodsFor:'instance creation'!

for:aFontOrFontDescription
    ^ self
	family:aFontOrFontDescription family
	face:aFontOrFontDescription face
	style:aFontOrFontDescription style
	size:aFontOrFontDescription size
	sizeUnit:#pt
	encoding:aFontOrFontDescription encoding
!

new
    ^ self basicNew initialize.
! !

!XftFontDescription class methodsFor:'change & update'!

aboutToDestroyViewWithDevice:aDevice id:aWindowId
    "a view is going to be destroyed.
     Have to disassociate the XftDrawId from  the drawableId aWindowId"

"/ no longer used...
"/    Lobby do:[:eachXftFont|
"/        eachXftFont graphicsDevice == aDevice ifTrue:[
"/            eachXftFont disassociateXftDrawableFrom:aWindowId.
"/        ].
"/    ].
! !

!XftFontDescription class methodsFor:'examples'!

example1
    "
    XftFontDescription example1
    "
    |top textView|

    top := StandardSystemView new.
    top extent:300@200.

    textView := EditTextView new.
    textView origin:0.0 @ 0.0 corner:1.0 @ 1.0.
    textView basicFont: (XftFontDescription family: 'DejaVu Sans' size: 16).

    top addSubView:textView.

    textView contents:('/etc/hosts' asFilename contentsOfEntireFile asText).

    top open.

    "Created: / 20-12-2013 / 00:04:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 30-12-2013 / 19:11:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

example2
    "
    XftFontDescription example2
    "
    |top textView|

    top := StandardSystemView new.
    top extent:300@200.

    textView := EditTextView new.
    textView origin:0.0 @ 0.0 corner:1.0 @ 1.0.
    textView basicFont: (XftFontDescription family: 'DejaVu Sans' size: 30) asItalic.

    top addSubView:textView.

    textView contents:('/etc/hosts' asFilename contentsOfEntireFile).

    top open.

    "Created: / 30-12-2013 / 19:49:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

example3
    "
    XftFontDescription example2
    "
    |top textView|

    top := StandardSystemView new.
    top extent:300@200.

    textView := EditTextView new.
    textView origin:0.0 @ 0.0 corner:1.0 @ 1.0.
    textView basicFont: (XftFontDescription family: 'Indie Flower' size: 30).

    top addSubView:textView.

    textView contents:('/etc/hosts' asFilename contentsOfEntireFile).

    top open.

    "Created: / 30-12-2013 / 19:49:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!XftFontDescription class methodsFor:'primitives'!

xftAvailable
%{
#ifdef XFT
    RETURN ( true )
#endif
%}.
    ^ false

    "Created: / 20-12-2013 / 21:10:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

xftFontClose:fontIdArg displayId:displayId
    | error |

%{ /* STACK: 64000 */
#ifdef XFT
    if ( ! __isExternalAddressLike(fontIdArg) ) {
	error = @symbol(BadArg1);
	goto err;
    }
    if ( ! __isExternalAddressLike(displayId) ) {
	error = @symbol(BadArg2);
	goto err;
    }
    XftFontClose (DISPLAY(displayId), XFT_FONT(fontIdArg));
    RETURN(self);
err:;
#endif
%}.
    self primitiveFailed: error
!

xftFontGetAscent: fontIdArg
    | error |

%{ /* STACK: 64000 */
#ifdef XFT
    if ( ! __isExternalAddressLike(fontIdArg) ) {
	error = @symbol(BadArg1);
	goto err;
    }
    RETURN ( __MKINT( XFT_FONT(fontIdArg)->ascent ) );
    err:;
#endif
%}.
    self primitiveFailed: error

    "Created: / 21-12-2013 / 00:56:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

xftFontGetDescent:fontIdArg
    | error |

%{ /* STACK: 64000 */
#ifdef XFT
    if ( ! __isExternalAddressLike(fontIdArg) ) {
	error = @symbol(BadArg1);
	goto err;
    }
    RETURN ( __MKINT( XFT_FONT(fontIdArg)->descent ) );
    err:;
#endif
%}.
    self primitiveFailed: error

    "Created: / 21-12-2013 / 00:56:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

xftFontGetHeight: fontIdArg
    | error |

%{ /* STACK: 64000 */
#ifdef XFT
    if ( ! __isExternalAddressLike(fontIdArg) ) {
	error = @symbol(BadArg1);
	goto err;
    }
    RETURN ( __MKINT( XFT_FONT(fontIdArg)->height ) );
    err:;
#endif
%}.
    self primitiveFailed: error

    "Created: / 21-12-2013 / 00:56:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

xftFontGetMaxAdvanceWidth: fontIdArg
    | error |

%{ /* STACK: 64000 */
#ifdef XFT
    if ( ! __isExternalAddressLike(fontIdArg) ) {
	error = @symbol(BadArg1);
	goto err;
    }
    RETURN ( __MKINT( XFT_FONT(fontIdArg)->max_advance_width ) );
    err:;
#endif
%}.
    self primitiveFailed: error

    "Created: / 30-12-2013 / 20:02:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

xftFontGetPattern: fontIdArg
    | error |

%{ /* STACK: 64000 */
#ifdef XFT
    XftPattern* p;
    if ( ! __isExternalAddressLike(fontIdArg) ) {
	error = @symbol(BadArg1);
	goto err;
    }
    p = XFT_FONT(fontIdArg)->pattern;
    if (p == NULL) {
	RETURN ( nil );
    } else {
	RETURN ( FC_PATTERN_HANDLE_NEW ( p ) );
    }
    err:;
#endif
%}.
    self primitiveFailed: error

    "Created: / 21-12-2013 / 00:55:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!XftFontDescription class methodsFor:'queries'!

listOfAvailableFonts
    "uses fc-list to get a list of available fontDescriptions"

    CachedFontList isNil ifTrue:[
	CachedFontList := FCFontListParser new listOfAvailableFonts
    ].
    ^ CachedFontList

    "
     XftFontDescription flushListOfAvailableFonts.
     XftFontDescription listOfAvailableFonts
    "
! !

!XftFontDescription methodsFor:'accessing'!

encoding
    ^ encoding ? #'iso10646-1'
!

face
    ^ face ? ''
!

fullName
    ^ name ? (self userFriendlyName)
!

graphicsDevice
    ^ device

    "Created: / 02-01-2014 / 23:22:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

maxCode
    ^ maxCode ? 16rFFFF
!

maxCode:something
    maxCode := something.
!

minCode
    ^ minCode ? 0
!

minCode:something
    minCode := something.
!

style
    ^ style ? ''
!

weight:aNumber
    "set the weight. The face is the string representation of weight."

    self assert:(self fontId isNil). "/ cannot change an instantiated font

    weight := aNumber.

    aNumber == FC_WEIGHT_THIN ifTrue:[ face := #thin. ^ self].
    aNumber == FC_WEIGHT_EXTRALIGHT ifTrue:[ face := #extralight. ^ self].
    aNumber == FC_WEIGHT_LIGHT ifTrue:[ face := #light. ^ self].
    aNumber == FC_WEIGHT_BOOK ifTrue:[ face := #book. ^ self].
    aNumber == FC_WEIGHT_REGULAR ifTrue:[ face := #regular. ^ self].
    aNumber == FC_WEIGHT_MEDIUM ifTrue:[ face := #medium. ^ self].
    aNumber == FC_WEIGHT_DEMIBOLD ifTrue:[ face := #demibold. ^ self].
    aNumber == FC_WEIGHT_BOLD ifTrue:[ face := #bold. ^ self].
    aNumber == FC_WEIGHT_EXTRABOLD ifTrue:[ face := #extrabold. ^ self].
    aNumber == FC_WEIGHT_BLACK ifTrue:[ face := #black. ^ self].
    aNumber == FC_WEIGHT_EXTRABLACK ifTrue:[ face := #extrablack. ^ self].

    aNumber <= (FC_WEIGHT_EXTRALIGHT + FC_WEIGHT_LIGHT // 2) ifTrue:[
	face := #extralight.
	^ self.
    ].
    aNumber <= (FC_WEIGHT_LIGHT + FC_WEIGHT_BOOK // 2) ifTrue:[
	face := #light.
	^ self.
    ].
    aNumber <= (FC_WEIGHT_MEDIUM + FC_WEIGHT_DEMIBOLD // 2) ifTrue:[
	face := #medium.
	^ self.
    ].
    aNumber <= (FC_WEIGHT_DEMIBOLD + FC_WEIGHT_BOLD // 2) ifTrue:[
	face := #demibold.
	^ self.
    ].
    aNumber <= (FC_WEIGHT_BOLD + FC_WEIGHT_BLACK // 2) ifTrue:[
	face := #bold.
	^ self.
    ].
    face := #extrabold.
    ^ self

"/    FC_WEIGHT_THIN          := 0.
"/    FC_WEIGHT_EXTRALIGHT    := 40.
"/    FC_WEIGHT_ULTRALIGHT    := FC_WEIGHT_EXTRALIGHT.
"/    FC_WEIGHT_LIGHT         := 50.
"/    FC_WEIGHT_BOOK          := 75.
"/    FC_WEIGHT_REGULAR       := 80.
"/    FC_WEIGHT_NORMAL        := FC_WEIGHT_REGULAR.
"/    FC_WEIGHT_MEDIUM        := 100.
"/    FC_WEIGHT_DEMIBOLD      := 180.
"/    FC_WEIGHT_SEMIBOLD      := FC_WEIGHT_DEMIBOLD.
"/    FC_WEIGHT_BOLD          := 200.
"/    FC_WEIGHT_EXTRABOLD     := 205.
"/    FC_WEIGHT_ULTRABOLD     := FC_WEIGHT_EXTRABOLD.
"/    FC_WEIGHT_BLACK         := 210.
"/    FC_WEIGHT_HEAVY         := FC_WEIGHT_BLACK.
"/    FC_WEIGHT_EXTRABLACK    := 215.
"/    FC_WEIGHT_ULTRABLACK    := FC_WEIGHT_EXTRABLACK.
! !

!XftFontDescription methodsFor:'accessing-private'!

getXftFontId
    ^ fontId

    "Created: / 02-01-2014 / 23:29:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

setFontId:fontIdArg
    fontId := fontIdArg.
! !

!XftFontDescription methodsFor:'converting'!

asNonXftFont
    "in some situations, we do not want an Xft font..."

    |newFont|

    newFont := Font
		    family:family
		    face:face
		    style:style
		    size:(sizeUnit == #px ifTrue:[pixelSize] ifFalse:[size])
		    sizeUnit:sizeUnit
		    encoding:encoding.
    newFont isForceNonXFTFont:true.
    ^ newFont

   "
    |view1 view2|

    view1 := TextView new openAndWait.
    view2 := TextView new openAndWait.
    view1 font:(Button defaultFont).
    view1 contents:'Hello world'.
    view2 font:(Button defaultFont asNonXftFont onDevice:Display).
    view2 contents:'Hello world'.
   "

    "Modified (comment): / 12-02-2017 / 22:14:47 / cg"
! !

!XftFontDescription methodsFor:'error reporting'!

primitiveFailed
    <resource: #skipInDebuggersWalkBack>

    self class xftAvailable ifFalse:[
	super primitiveFailed:'Xft support is not configured'.
    ].
    super primitiveFailed
!

primitiveFailed:errorString
    <resource: #skipInDebuggersWalkBack>

    self class xftAvailable ifFalse:[
	super primitiveFailed:'Xft support is not configured'.
    ].
    super primitiveFailed:errorString
! !

!XftFontDescription methodsFor:'finalization'!

finalize
    self releaseFromDevice
! !

!XftFontDescription methodsFor:'getting a device font'!

installInDeviceForGCId:aGCId
    "install the font for aGCId"

    (device isNil or:[fontId isNil]) ifTrue:[
	Logger error:'no device font for: %1' with:self.
	^ nil.
    ].
    "nothing to install"
!

onDevice:aGraphicsDevice
    "Create a new XftFont representing the closes font as
     myself on aDevice; if one already exists, return the one."

    ^ self onDevice:aGraphicsDevice ifAbsent:self
!

onDevice:aGraphicsDevice ifAbsent:aBlock
    "Create a new XftFont representing the closest font as
     myself on aDevice; if one already exists, return the one."

    |displayId myPatternHandle closestPatternHandle newFontId computedWeight deviceFont|

    (device == aGraphicsDevice) ifTrue:[
	"I am already assigned to that device ..."
	^ self
    ].
    aGraphicsDevice isNil ifTrue:[
	^ self
    ].
    aGraphicsDevice supportsXftFonts ifFalse:[
	^ self asNonXftFont onDevice:aGraphicsDevice.
    ].

    deviceFont := aGraphicsDevice deviceFonts detect:[:eachFont | self sameDeviceFontAs:eachFont] ifNone:[].
    deviceFont notNil ifTrue:[
	^ deviceFont.
    ].

    computedWeight := weight.
    computedWeight isNil ifTrue:[
	computedWeight := StXFace2FCWeightMap at:(face ? '') asLowercase ifAbsent:[FC_WEIGHT_REGULAR].
    ].

    (OperatingSystem isMAClike and:[FirstTimeCalled ~~ false]) ifTrue:[
	"Slow font matching is a MAC-only feature"
	Logger info:'XFT: matching font (this may take a long time, if the system''s font cache needs to be filled first. Be patient...'.
	FirstTimeCalled := false.
    ].

    [
	myPatternHandle := FCPatternHandle create.
	myPatternHandle
	    add:FC_FOUNDRY value:manufacturer;
	    add:FC_FAMILY value:family;
	    add:FC_WEIGHT value:computedWeight;
	    add:FC_SLANT  value:(StXStyle2FCSlantMap at:(style ? '') asLowercase ifAbsent:[FC_SLANT_ROMAN]).
	sizeUnit = #px ifTrue:[
	    myPatternHandle add:FC_PIXEL_SIZE value:(pixelSize isNil ifTrue:[nil] ifFalse:[pixelSize rounded]).
	] ifFalse:[
	    myPatternHandle add:FC_SIZE value:(size isNil ifTrue:[nil] ifFalse:[size rounded]).
	].

	displayId := aGraphicsDevice displayId.
	closestPatternHandle := myPatternHandle matchFontOnDisplayId:displayId screen:aGraphicsDevice screen.
	closestPatternHandle notNil ifTrue:[
	    newFontId := closestPatternHandle getFontOnDisplayId:displayId.
	    newFontId notNil ifTrue:[
		"/ Good, this font exists!!
		device isNil ifTrue:[
		    deviceFont := self.
		] ifFalse:[
		    deviceFont := self copy.
		].
		closestPatternHandle := nil.
		deviceFont setDevice:aGraphicsDevice patternId:nil fontId:newFontId.
		aGraphicsDevice registerFont:deviceFont.
		^ deviceFont.
	    ].
	].
    ] ensure:[
	myPatternHandle notNil ifTrue:[myPatternHandle destroy].
	closestPatternHandle notNil ifTrue:[closestPatternHandle destroy].
    ].
    ^ aBlock value

    "
     (XftFontDescription family:'monospace' size:16) onDevice:Screen current
    "

    "Modified: / 14-04-1997 / 18:22:31 / cg"
    "Modified: / 02-01-2014 / 23:43:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!XftFontDescription methodsFor:'initialization'!

initialize
    "Invoked when a new instance is created."

    super initialize.
    size := 0.
    encoding := #'iso10646-1'.
!

isScaledFont
    ^ true
!

setDevice: deviceArg patternId: patternIdArg fontId: fontIdArg
    device := deviceArg.
    fontId := fontIdArg.
    patternIdArg notNil ifTrue:[
	family  := patternIdArg get: FC_FAMILY index: 0.
	size    := patternIdArg get: FC_SIZE index: 0.
	weight  := patternIdArg get: FC_WEIGHT index: 0.
	face    := StXFace2FCWeightMap keyAtValue: weight.
	slant   := patternIdArg get: FC_SLANT index: 0.
	style   := StXStyle2FCSlantMap keyAtValue: slant.

	"/ name := patternIdArg get: 'fullname' index: 0.
	"/ encoding:= patternIdArg get: 'encoding' index: 0.
    ].
    size isNil ifTrue:[
	size := 0.
    ].
    encoding isNil ifTrue:[
	encoding := #'iso10646-1'.
    ].

    "Created: / 21-12-2013 / 00:46:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 30-12-2013 / 12:49:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!XftFontDescription methodsFor:'primitives'!

xftTextExtents:displayIdArg string:aString from:start to:stop into:extentsArrayOrNil
    "get the extents of aString.
     Answer thr width of aString (in reality the xOff).
     If extentArrayOrNil is an Array, fill is with the extent info:
	#(width height x y xOff yOff ascent descent)."

    |error bytesPerCharacter|

    bytesPerCharacter := aString bytesPerCharacter.

%{ /* STACK: 64000 */
#ifdef XFT
    XGlyphInfo info;
    char *string;
    int len;
    int __bytesPerCharacter = __intVal(bytesPerCharacter);
    OBJ fontIdArg = __INST(fontId);

    if ( ! __isExternalAddressLike(displayIdArg) ) {
	error = @symbol(BadArg1);
	goto err;
    }
    if ( ! __isSmallInteger(start) ) {
	error = @symbol(BadArg3);
	goto err;
    }
    if ( ! __isSmallInteger(stop) ) {
	error = @symbol(BadArg4);
	goto err;
    }
    if ( ! __isExternalAddressLike(fontIdArg) ) {
	error = @symbol(BadFontId);
	goto err;
    }

    string = __stringVal(aString) + ((__intVal(start) - 1) * __bytesPerCharacter);
    len = __intVal(stop) - __intVal(start) + 1;

    switch (__bytesPerCharacter) {
	case 1:
	    XftTextExtents8(DISPLAY(displayIdArg), XFT_FONT(fontIdArg), (FcChar8*)string, len, &info);
	    break;
	case 2:
	    XftTextExtents16(DISPLAY(displayIdArg), XFT_FONT(fontIdArg), (FcChar16*)string, len, &info);
	    break;
	case 4:
	    XftTextExtents32(DISPLAY(displayIdArg), XFT_FONT(fontIdArg), (FcChar32*)string, len, &info);
	    break;
	default:
	    error = @symbol(BadArg2);
	    goto err;
    }

    if (extentsArrayOrNil != nil && __isArray(extentsArrayOrNil)) {
	switch (__arraySize(extentsArrayOrNil)) {
	    case 8:
		__arrayVal(extentsArrayOrNil)[7] = __MKSMALLINT(XFT_FONT(fontIdArg)->descent);
		// fall into
	    case 7:
		__arrayVal(extentsArrayOrNil)[6] = __MKSMALLINT(XFT_FONT(fontIdArg)->ascent);
		// fall into
	    case 6:
		__arrayVal(extentsArrayOrNil)[5] = __MKSMALLINT(info.yOff);
		// fall into
	    case 5:
		__arrayVal(extentsArrayOrNil)[4] = __MKSMALLINT(info.xOff);
		// fall into
	    case 4:
		__arrayVal(extentsArrayOrNil)[3] = __MKSMALLINT(info.y);
		// fall into
	    case 3:
		__arrayVal(extentsArrayOrNil)[2] = __MKSMALLINT(info.x);
		// fall into
	    case 2:
		{
		    int height;

		    height = info.height;
#if 0
		    height = XFT_FONT(fontIdArg)->descent + XFT_FONT(fontIdArg)->ascent;
#endif
		    __arrayVal(extentsArrayOrNil)[1] = __MKSMALLINT(height);
		}
		// fall into
	    case 1:
		__arrayVal(extentsArrayOrNil)[0] = __MKSMALLINT(info.width);
		// fall into
	    case 0:
		break;
	}
    }

    RETURN(__MKSMALLINT(info.xOff));

    err:;
#endif
%}.
    error notNil ifTrue:[
	self primitiveFailed: error.
	^ nil.
    ].

    "Created: / 21-12-2013 / 10:42:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 30-12-2013 / 20:00:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!XftFontDescription methodsFor:'printing & storing'!

storeOn:aStream
    "append a character sequence to the argument, aStream from which the
     receiver can be reconstructed using readFrom:."

    aStream nextPutAll:'(XftFontDescription family:'. family storeOn:aStream.
    aStream nextPutAll:' face:'.        face storeOn:aStream.
    aStream nextPutAll:' style:'.       style storeOn:aStream.
    aStream nextPutAll:' size:'.        size storeOn:aStream.
    aStream nextPutAll:' encoding:'.    encoding storeOn:aStream.
    aStream nextPut:$)

    "
     (XftFontDescription family: 'DejaVu Sans' size: 8) storeString
    "
! !

!XftFontDescription methodsFor:'queries-dimensions'!

ascent
    "return the ascent - the number of pixels above the baseLine."
    ascent isNil ifTrue:[
	ascent := self class xftFontGetAscent: fontId
    ].
    ^ ascent

    "Created: / 21-12-2013 / 01:19:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

descent
    "return the descent - the number of pixels below the baseLine."

    descent isNil ifTrue:[
	 descent := self class xftFontGetDescent: fontId
    ].
    ^ descent

    "Created: / 21-12-2013 / 01:20:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

getFontMetrics
    |info|

    info := DeviceWorkstation::DeviceFontMetrics new.
    info
      ascent:self ascent
      descent:self descent
      maxAscent:self maxAscent
      maxDescent:self maxDescent
      minWidth:self maxWidth
      maxWidth:self maxWidth
      avgWidth:self maxWidth
      minCode:self minCode
      maxCode:self maxCode
      direction:#LeftToRight.
    ^ info
!

getFontResolution
    device isNil ifTrue:[ ^ 72 @ 72 ].
    ^ device resolution
!

height
    "return the height - the number of pixels above plus below the baseLine."

    height isNil ifTrue:[
	false ifTrue:[
	    height := self ascent + self descent.
	] ifFalse:[
	    height := self class xftFontGetHeight: fontId
	].
    ].
    ^ height

    "Created: / 21-12-2013 / 01:20:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

isFixedWidth
    "return true, if this is a fixed pitch font
     (i.e. all characters are of the same width).
     Also called monospaced fonts"

    fixedWidth isNil ifTrue:[
	fontId isNil ifTrue:[
	    ^ false     "we don't know yet"
	].
	"/ take some obviously different chars
	width := self widthOf:' '.
	fixedWidth := (self widthOf:'i') == width
			    and:[(self widthOf:'W') == width
			    and:[(self widthOf:'.') == width]]
    ].
    ^ fixedWidth.

    "Created: / 21-12-2013 / 10:38:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

maxAscent
    "return the font's maximum-ascent (i.e. the maximum of all characters);
     That is the number of units (usually pixels) above the baseline."

    ^ self ascent

    "Created: / 30-12-2013 / 20:01:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

maxDescent
    "return the font's maximum-descent (i.e. the maximum of all characters);
     That is the number of units (usually pixels) below the baseline."

    ^ self descent

    "Created: / 30-12-2013 / 20:01:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

maxWidth
    "return the font's maximum-width character (i.e. the maximum of all characters);
     That is a number of units (usually pixels)."

    self isFixedWidth ifTrue:[
	^ width
    ].
    ^ self class xftFontGetMaxAdvanceWidth: fontId

    "Created: / 30-12-2013 / 20:02:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

patternStringForId:patternIdArg
    |name family size pixelSize face style encoding foundry width|

    patternIdArg notNil ifTrue:[
	foundry  := patternIdArg get: FC_FOUNDRY index: 0.
	family  := patternIdArg get: FC_FAMILY index: 0.
	size    := patternIdArg get: FC_SIZE index: 0.
	pixelSize := patternIdArg get: FC_PIXEL_SIZE index: 0.
	face    := patternIdArg get: FC_WEIGHT index: 0.
	face    := StXFace2FCWeightMap keyAtValue: face.
	style   := patternIdArg get: FC_SLANT index: 0.
	style   := StXStyle2FCSlantMap keyAtValue: style.
	width   := patternIdArg get: FC_WIDTH index: 0.

	name:= patternIdArg get: 'fullname' index: 0.

	encoding:= patternIdArg get: 'encoding' index: 0.
    ].

    ^ '%8-%1-%2-%3-%4pt/%5px-%6-%9 (%7)' bindWith:family with:face with:style with:size with:pixelSize with:encoding with:name
					 with:foundry with:width.
!

width
    "return the font's characters width;
     That is a number of units (usually pixels).
     For variable pitch fonts, the width of the space character is returned.
     For fixed fonts, this is the same as minWidth or maxWidth (or any character).
     The receiver must be associated to a device, for this query to be legal."

    width isNil ifTrue:[
	width := self widthOf:' '.
    ].
    ^ width
!

widthOf:aString from:start to:stop
    "return the width of a sub string"

    (stop < start) ifTrue:[^ 0].
    fixedWidth == true ifTrue:[
	^ width * (stop - start + 1)
    ].
    device isNil ifTrue:[
	self errorNoDevice.
    ].
    ^ self xftTextExtents:device displayId string:aString from:start to:stop into:nil.

    "Created: / 21-12-2013 / 10:42:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 29-12-2013 / 21:16:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!XftFontDescription methodsFor:'release'!

releaseFromDevice
    "I am no longer available on the device"

    (device notNil and:[fontId notNil]) ifTrue:[
	self class xftFontClose:fontId displayId:device displayId.
	device := nil.
	fontId := nil.
	width := nil.
    ].
! !

!XftFontDescription methodsFor:'testing'!

isAlienFont
    "my GraphicsContext knows how to disply strings in my font.
     Alien fonts are eg. Hershey or Bitmap fonts, which are drawn by st/x itself."

    ^ false

    "Modified (comment): / 12-02-2017 / 22:03:39 / cg"
!

isXftFont
    "anwer true, if this is an Xft font.
     Sure, I am"

    ^ true

    "Modified (comment): / 12-02-2017 / 22:04:23 / cg"
! !

!XftFontDescription::FCFontListParser class methodsFor:'api'!

listOfAvailableFonts
    ^ self new listOfAvailableFonts

    "
       self listOfAvailableFonts
    "
! !

!XftFontDescription::FCFontListParser class methodsFor:'documentation'!

documentation
"
    parses fc-list output to get a list of XftFontDescriptions

    [author:]
	cg

    [instance variables:]

    [class variables:]

    [see also:]

"
! !

!XftFontDescription::FCFontListParser methodsFor:'api'!

listOfAvailableFonts
    |readEntry list fcListProg|

    list := OrderedCollection new.

    readEntry := [
	    |key line|

	    [
		line := pipeStream nextLine.
	    ] doUntil:[(line startsWith:'Pattern has') or:[Transcript showCR:line. false]].

	    currentDescription := XftFontDescription new.
	    [line := pipeStream nextLine. line notEmptyOrNil] whileTrue:[
		"/ Transcript showCR:l.
		lineStream := line readStream. lineStream skipSeparators.
		key := ('fc_', (lineStream upTo:$:)) asSymbolIfInterned.
		(
		    #(fc_family fc_style fc_slant fc_weight fc_width
		      fc_pixelsize fc_spacing fc_foundry fc_antialias
		      fc_file fc_outline fc_scalable fc_charset fc_lang
		      fc_fontversion fc_fontformat fc_decorative fc_index
		      fc_outline fc_familylang fc_stylelang fc_fullname
		      fc_fullnamelang fc_capability fc_hash fc_postscriptname
		      fc_symbol fc_color
		    ) includesIdentical:key
		) ifTrue:[
		    self perform:key.
		] ifFalse:[
		    Transcript show:'Xft ignored line: '; showCR:line.
		].
	    ].
	    list add:currentDescription
	].

    fcListProg := #('/usr/bin/fc-list' '/usr/X11/bin/fc-list') detect:[:eachProg|
			eachProg asFilename isExecutableProgram
		    ] ifNone:[
			'XftFontDescription [warning]: fc-list program not found - no XFT fonts' errorPrintCR.
			^ list.
		    ].

    pipeStream := PipeStream readingFrom:fcListProg, ' -v'.
    [
	[pipeStream atEnd] whileFalse:[
	    readEntry value.
	]
    ] ensure:[
	pipeStream close
    ].
    ^ list

    "
     FCFontListParser new listOfAvailableFonts
    "
! !

!XftFontDescription::FCFontListParser methodsFor:'font list keywords'!

fc_antialias
    "helper for font listing"

    currentDescription isAntialiasedFont:(self getBoolean).
!

fc_charset
    "helper for font listing"

    |page bits l min max minCode maxCode|

    [ l := pipeStream nextLine. l notEmpty ] whileTrue:[
	"/ Transcript show:'->'; showCR:l.
	(l startsWith:Character tab) ifFalse:[
	    (l startsWith:'(') ifFalse:[self halt].
	    currentDescription minCode:minCode; maxCode:maxCode.
	    ^ self.
	].

	lineStream := l readStream.
	lineStream skipSeparators.
	page := Integer readFrom:(lineStream upTo:$:) radix:16.
	lineStream next.
	bits := 0 to:7 collect:[:i|
	    lineStream skipSeparators.
	    Integer readFrom:(lineStream upToSeparator) radix:16.
	].
	min := (page * 256 + 0).
	max := (page * 256 + 255).
	minCode isNil ifTrue:[
	    minCode := min.
	    maxCode := max.
	] ifFalse:[
	    minCode := minCode min:min.
	    maxCode := maxCode max:max.
	].
    ].
    "/ currentDescription characterSet:(self getString).
    currentDescription minCode:minCode; maxCode:maxCode.
!

fc_decorative
    "helper for font listing"

    currentDescription isDecorativeFont:(self getBoolean).
!

fc_family
    "helper for font listing"

    currentDescription family:(self getString).
!

fc_file
    "helper for font listing"

    currentDescription file:(self getString).
!

fc_fontformat
    "helper for font listing"

    currentDescription fontFormat:(self getString).
!

fc_fontversion
    "helper for font listing"

    currentDescription fontVersion:(self getInteger).
!

fc_foundry
    "helper for font listing"

    |foundry|

    foundry := self getString.
    foundry ~= 'unknown' ifTrue:[
	currentDescription foundry:foundry.
    ].
!

fc_fullname
    "helper for font listing"

    currentDescription name:self getString.
!

fc_outline
    "helper for font listing"

    currentDescription isOutlineFont:(self getBoolean).
!

fc_pixelsize
    "helper for font listing"

    currentDescription setPixelSize:(self getInteger).
    currentDescription setSizeUnit:#px.
    "/ currentDescription setSize:(self getInteger).
    "/ currentDescription setSizeUnit:#pt.
!

fc_scalable
    "helper for font listing"

    currentDescription isScalableFont:self getBoolean.
!

fc_slant
    "helper for font listing"

    currentDescription slant:(self getInteger).
!

fc_spacing
    "helper for font listing"

    currentDescription spacing:(self getInteger).
!

fc_style
    "helper for font listing"

    |xftStyle|

    xftStyle := self getString asLowercase.
    (xftStyle includesString:'italic') ifTrue:[
	currentDescription style:#italic.
	^ self.
    ].
    (xftStyle includesString:'oblique') ifTrue:[
	currentDescription style:#oblique.
	^ self.
    ].
    currentDescription style:#roman.
!

fc_weight
    "helper for font listing"

    currentDescription weight:(self getInteger).
!

fc_width
    "helper for font listing"

    currentDescription width:(self getInteger).
! !

!XftFontDescription::FCFontListParser methodsFor:'font list keywords - ignored'!

fc_capability
    "helper for font listing"

    "currentDescription capability:" (self getString).
!

fc_color
    "helper for font listing - ignored for now"

    "currentDescription isColorFont:"(self getBoolean).
!

fc_familylang
    "helper for font listing"

    "currentDescription familylang:" (self getString).
!

fc_fullnamelang
    "helper for font listing"

    "currentDescription fullnamelang:" (self getString).
!

fc_hash
    "helper for font listing"

    "currentDescription hash:" self getString.
!

fc_index
    "helper for font listing"

    "currentDescription index:" (self getInteger).
!

fc_lang
    "helper for font listing"

    "/ currentDescription characterSet:(self getString).
!

fc_postscriptname
    "helper for font listing"

    "currentDescription postscriptname:" self getString.
!

fc_stylelang
    "helper for font listing"

    "currentDescription stylelang:" (self getString).
!

fc_symbol
    "helper for font listing - ignored for now"

    "currentDescription isSymbolFont:"(self getBoolean).
! !

!XftFontDescription::FCFontListParser methodsFor:'helpers'!

getBoolean
    "helper for font listing"

    |s|

    lineStream skipSeparators.
    s := lineStream nextAlphaNumericWord.
    ^ (s indexOfSubCollection:'True') ~~ 0.     "/ match at least 'True' and 'FCTrue'

    "
	'xxFalse' indexOfSubCollection:'True'
	'FcTrue' indexOfSubCollection:'True'
    "
!

getInteger
    "helper for font listing"

    lineStream skipSeparators.
    ^ Integer readFrom:lineStream.
!

getString
    "helper for font listing"

    lineStream skipThrough:$".
    ^ lineStream upTo:$".
! !

!XftFontDescription::FCPatternHandle class methodsFor:'instance creation'!

create
    ^ self new create

    "
	self new create destroy
    "
! !

!XftFontDescription::FCPatternHandle methodsFor:'primitives'!

add:attribute value: value
    "Add a value to the specified pattern element after existing values"

    ^ self add: attribute value: value append: true.
!

add:attribute value: value append: append
    "Add a value to the specified pattern element.  If 'append' is true, the value
     is added after existing values, otherwise it is added before them."

    | error |

%{ /* STACK: 64000 */
#ifdef XFT
    XftValue v;
    Bool b;

    if (__INST(address_) == 0) {
	error = @symbol(NullReceiver);
	goto err;
    }
    if ( ! __isStringLike ( attribute ) ) {
	error = @symbol(BadArg1);
	goto err;
    }
    if ( append != true && append != false ) {
	error = @symbol(BadArg3);
	goto err;
    }
    if ( __isStringLike ( value ) ) {
	v.type = FcTypeString;
	/* Passing pointer inside Smalltalk should be safe,
	 * Xft/FontConfig libraries seem to allocate and store
	 * a __copy__ of the string (if I understood the code correctly)
	 */
	v.u.s = __stringVal( value);
    } else if ( __isSmallInteger( value ) ) {
	v.type = XftTypeInteger;
	v.u.i = (int)__intVal( value );
    } else if ( value == true || value == false ) {
	v.type = XftTypeBool;
	v.u.b = value == true ? True : False;
    } else if ( __isFloat ( value ) ) {
	v.type = XftTypeDouble;
	v.u.d = __floatVal( value );
    } else if ( value == nil ) {
	v.type = XftTypeVoid;
	v.u.f = NULL;
    } else {
	error = @symbol(BadArg2);
	goto err;
    }
    b = XftPatternAdd((XftPattern*)__INST(address_), __stringVal(attribute), v, append == true ? True : False );
    RETURN ( b == True ? true : false );

    err:;
#endif
%}.
    self primitiveFailed: error

    "Created: / 20-12-2013 / 21:50:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

create
%{
#ifdef XFT
    __INST(address_) = (void *)XftPatternCreate();
#endif
%}.
!

delete: pattern attribute: attribute
    | error |
%{ /* STACK: 64000 */
#ifdef XFT
    if (__INST(address_) == 0) {
	error = @symbol(BadHandle);
	goto err;
    }
    if ( ! __isStringLike ( attribute ) ) {
	error = @symbol(BadArg1);
	goto err;
    }
    XftPatternDel( (XftPattern*)__INST(address_), __stringVal ( attribute ) );
    RETURN ( self );

    err:;
#endif
%}.
    self primitiveFailed: error
!

destroy
%{ /* STACK: 64000 */
#ifdef XFT
    if (__INST(address_) != 0) {
	XftPatternDestroy((XftPattern*)__INST(address_));
	__INST(address_) = 0;
	RETURN ( self );
    }
#endif
%}.
    self primitiveFailed.
!

duplicate
    | error |
%{
#ifdef XFT
    if (__INST(address_) != 0) {
	RETURN (FC_PATTERN_HANDLE_NEW((XftPattern*)__INST(address_)));
	RETURN ( self );
    }
#endif
%}.
    self primitiveFailed
!

get:attribute index: index
    "Return a value from the specified element -- multiple values can be indexed
     with 'index' starting at zero."

    | error |

%{ /* STACK: 64000 */
#ifdef XFT
    XftValue v;
    XftResult r;

    if (__INST(address_) == 0) {
	error = @symbol(NullReceiver);
	goto err;
    }
    if ( ! __isStringLike ( attribute ) ) {
	error = @symbol(BadArg1);
	goto err;
    }
    if ( ! __isSmallInteger( index ) ) {
	error = @symbol(BadArg2);
	goto err;
    }
    r = XftPatternGet((XftPattern*)__INST(address_), __stringVal( attribute ), __intVal( index ), &v);
    if ( r != XftResultMatch) {
	RETURN ( nil );
    }
    if ( v.type == XftTypeString) {
	RETURN ( __MKSTRING(v.u.s) );
    } else if ( v.type == XftTypeInteger ) {
	RETURN ( __MKINT (v.u.i) );
    } else if ( v.type == XftTypeBool ) {
	RETURN ( v.u.b == True ? true : false );
    } else if ( v.type == XftTypeDouble ) {
	RETURN ( __MKFLOAT (v.u.d) );
    } else if ( v.type == XftTypeVoid ) {
	RETURN ( nil );
    } else {
	error = @symbol(UnssuportedTypeValue);
	goto err;
    }
    err:;
#endif
%}.
    self primitiveFailed: error
!

getFontOnDisplayId:displayId
    "Note: the pattern is destroyed when the font is closed"

    | error |

%{ /* STACK: 64000 */
#ifdef XFT
    XftFont* f;
    if (!__isExternalAddressLike(displayId) ) {
	error = @symbol(BadArg1);
	goto err;
    }
    if (__INST(address_) == 0) {
	error = @symbol(BadHandle);
	goto err;
    }

    f = XftFontOpenPattern(DISPLAY(displayId), (XftPattern*)__INST(address_));
    if (f == NULL) {
	RETURN (nil);
    } else {
	RETURN (XFT_FONT_HANDLE_NEW(f));
    }
    err:;
#endif
%}.
    self primitiveFailed: error

    "Created: / 20-12-2013 / 23:53:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

matchFontOnDisplayId:displayId screen:screen
    | error |

%{ /* STACK: 64000 */
#ifdef XFT
    XftPattern *p;
    XftResult r;

    if (!__isExternalAddressLike(displayId)) {
	error = @symbol(BadArg1);
	goto err;
    }
    if (!__isSmallInteger( screen) ) {
	error = @symbol(BadArg2);
	goto err;
    }
    if (__INST(address_) == 0) {
	error = @symbol(BadHandle);
	goto err;
    }

// Already done in match:
//    XftConfigSubstitute(FC_PATTERN( patternId ));
//    XftDefaultSubstitute(DISPLAY(displayId), SCREEN( screen ), FC_PATTERN( patternId ));
    p = XftFontMatch(DISPLAY(displayId), SCREEN(screen), (XftPattern*)__INST(address_), &r);
    if (p) {
	RETURN (FC_PATTERN_HANDLE_NEW(p) );
    } else {
	error = @symbol(XftFontMatchReturnedNull);
    }
    err:;
#endif
%}.
    self primitiveFailed: error

    "Created: / 21-12-2013 / 00:08:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!XftFontDescription::XftDrawHandle class methodsFor:'instance creation'!

createForDisplayId:displayId screen:screen drawable:drawableId
    ^ self new createForDisplayId:displayId screen:screen drawable:drawableId
! !

!XftFontDescription::XftDrawHandle methodsFor:'primitives'!

createForDisplayId:displayId screen:screen drawable:drawableId
    | error |

%{ /* STACK: 64000 */
#ifdef XFT
    if ( ! __isExternalAddressLike(displayId) ) {
	error = @symbol(BadArg1);
	goto err;
    }
    if ( ! __isSmallInteger(screen) ) {
	error = @symbol(BadArg2);
	goto err;
    }
    if ( ! __isExternalAddressLike(drawableId) ) {
	error = @symbol(BadArg3);
	goto err;
    }
    __INST(address_) = (void *) XftDrawCreate ( DISPLAY(displayId) ,
						   DRAWABLE(drawableId) ,
						   DefaultVisual(DISPLAY(displayId), SCREEN (screen)) ,
						   DefaultColormap(DISPLAY(displayId), SCREEN (screen)));
    err:;
#endif
%}.
    self primitiveFailed: error

    "Created: / 21-12-2013 / 21:12:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

destroy
%{ /* STACK: 64000 */
#ifdef XFT
    if (__INST(address_) != 0) {
	XftDrawDestroy((XftDraw*)__INST(address_));
	__INST(address_) = 0;
	RETURN ( self );
    }
#endif
%}.
    self primitiveFailed.
!

disassociateFrom:drawableId
    "Disassociate the XftDrawable from drawableId.
     This mist be done before the drawable is destroyed,
     otherwise the XftDrawable is destroyed together with the drawable,
     and X11 errors will be signaled."

    | error |

%{ /* STACK: 64000 */
#ifdef XFT
    if (__INST(address_) == 0) {
	// nothing to disasassociate from...
	RETURN(self);
    }
    if (!__isExternalAddressLike(drawableId)) {
	error = @symbol(BadArg);
	goto err;
    }
    if (XftDrawDrawable((XftDraw*)__INST(address_)) == DRAWABLE(drawableId)) {
	XftDrawChange((XftDraw*)__INST(address_), None);
    }
    RETURN(self);
err:;
#endif
%}.
    self primitiveFailed: error

    "Created: / 26-12-2013 / 12:17:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

drawChange:drawableId
    | error |

%{ /* STACK: 64000 */
#ifdef XFT
    if (drawableId == nil) {
	XftDrawChange((XftDraw*)__INST(address_), None);
	RETURN (self);
    }
    if (!__isExternalAddressLike(drawableId)) {
	error = @symbol(BadArg1);
	goto err;
    }
    if (XftDrawDrawable((XftDraw*)__INST(address_)) != DRAWABLE( drawableId)) {
	XftDrawChange((XftDraw*)__INST(address_), DRAWABLE( drawableId));
    }
    RETURN (self);
err:;
#endif
%}.
    self primitiveFailed: error

    "Created: / 26-12-2013 / 12:17:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

drawRectWithColor:aColor x:x y:y width:w height:h
    | error r g b a pix |

    aColor isColor ifFalse:[^self primitiveFailed: #BadArg1].

    r := aColor scaledRed.
    g := aColor scaledGreen.
    b := aColor scaledBlue.
    a := aColor alpha * 65535.
    r isNil ifTrue:[
	"/ when drawing into a pixmap...
	aColor colorId == 0 ifTrue:[
	    r := g := b := 0.
	] ifFalse:[
	    r := g := b := 16rFFFF.
	]
    ].
    pix := aColor colorId.
%{ /* STACK: 64000 */
#ifdef XFT
    XftColor clr;

    if (__INST(address_) == 0) {
	error = @symbol(BadHandle);
	goto err;
    }
    if (!__isSmallInteger(pix)) {
	error = @symbol(BadColorId);
	goto err;
    }
    if (!__isSmallInteger(x)) {
	error = @symbol(BadArg2);
	goto err;
    }
    if (! __isSmallInteger(y)) {
	error = @symbol(BadArg3);
	goto err;
    }
    if (!__isSmallInteger(w)) {
	error = @symbol(BadArg4);
	goto err;
    }
    if (!__isSmallInteger(h)) {
	error = @symbol(BadArg5);
	goto err;
    }
    clr.pixel = (unsigned long)__intVal(pix);
    clr.color.red = __intVal(r);
    clr.color.green = __intVal(g);
    clr.color.blue = __intVal(b);
    clr.color.alpha = __intVal(a);

    XftDrawRect((XftDraw*)__INST(address_), &clr,
			__intVal(x), __intVal(y), __intVal(w) ,__intVal(h));

    RETURN (self);
    err:;
#endif
%}.
    self primitiveFailed: error.

    "Created: / 28-12-2013 / 23:35:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 31-12-2013 / 00:37:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

drawString:aString color:aColor font:fontIdArg x:x y:y from:start to:stop
    | error r g b a pix |

    aColor isColor ifFalse:[^self primitiveFailed: #BadArg2].

    pix := aColor colorId.
    r := aColor scaledRed.
    r isNil ifTrue:[
	"/ when drawing into a pixmap...
	pix == 0 ifTrue:[
	    r := g := b := a := 0.
	] ifFalse:[
	    r := g := b := a := 16rFFFF.
	]
    ] ifFalse:[
	g := aColor scaledGreen.
	b := aColor scaledBlue.
	a := aColor alpha * 65535.
    ].
%{ /* STACK: 64000 */
#ifdef XFT
    int _start, _stop;
    int __x, __y;
    XftColor clr;

    if (__INST(address_) == 0) {
	error = @symbol(BadHandle);
	goto err;
    }
    if ( ! __isSmallInteger(pix) ) {
	error = @symbol(BadColorId);
	goto err;
    }
    if ( ! __isSmallInteger(x) ) {
	error = @symbol(BadArg4);
	goto err;
    }
    __x = __intVal(x);
    if ( ! __isSmallInteger(y) ) {
	error = @symbol(BadArg5);
	goto err;
    }
    __y = __intVal(y);


    if ( ! __isSmallInteger(start) ) {
	error = @symbol(BadArg6);
	goto err;
    }
    _start = __intVal(start);
    if ( ! __isSmallInteger(stop) ) {
	error = @symbol(BadArg7);
	goto err;
    }
    _stop = __intVal(stop);

    clr.pixel = (unsigned long)__intVal(pix);
    clr.color.red = __intVal(r);
    clr.color.green = __intVal(g);
    clr.color.blue = __intVal(b);
    clr.color.alpha = __intVal(a);

    if ( __isStringLike(aString) ) {
	XftDrawString8((XftDraw*)__INST(address_), &clr, XFT_FONT(fontIdArg),
			__x, __y,
			__stringVal(aString) + (_start - 1), _stop - _start + 1);
	RETURN ( self );
    } else {
	error = @symbol(BadArg1);
	goto err;
    }
    err:;
#endif
%}.
    self primitiveFailed: error.

    "Created: / 28-12-2013 / 12:32:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 30-12-2013 / 20:00:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

setClipRect:rect
    | error xObj yObj wObj hObj  |

    rect notNil ifTrue:[
	xObj := rect left.
	yObj := rect top.
	wObj := rect width.
	hObj := rect height.
    ].
%{ /* STACK: 64000 */
#ifdef XFT
    if (__INST(address_) == 0) {
	error = @symbol(BadHandle);
	goto err;
    }
    if (rect != nil) {
	XRectangle r;

	r.x = __intVal(xObj);
	r.y = __intVal(yObj);
	r.width = __intVal(wObj);
	r.height = __intVal(hObj);
	XftDrawSetClipRectangles((XftDraw*)__INST(address_), 0, 0, &r, 1);
    } else {
	XftDrawSetClipRectangles((XftDraw*)__INST(address_), 0, 0, (XRectangle*)NULL, 0);
    }
    RETURN ( self );
    err:;
#endif
%}.
    self primitiveFailed: error.

    "Created: / 31-12-2013 / 01:24:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!XftFontDescription class methodsFor:'documentation'!

version
    ^ '$Header$'
!

version_CVS
    ^ '$Header$'
! !


XftFontDescription initialize!