"{ Package: 'stx:libview' }"

"{ NameSpace: Smalltalk }"

FontDescription subclass:#XftFontDescription

	instanceVariableNames:'device fontId closestFont minCode maxCode ascent descent height

		fixedWidth'

	classVariableNames:'CachedFontList RecentlyUsedFonts Lobby'

	poolDictionaries:'FcConstants'

	category:'Graphics-Support'

!

Object subclass:#FCFontListParser

	instanceVariableNames:'pipeStream lineStream currentDescription'

	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

#  ifndef HAVE_FONTCONFIG

#    error "XFT defined but not HAVE_FONTCONFIG. Xft fonts cannot be used without FontConfig support"

#  endif

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, "FcPattern")

/* 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>

# include <X11/Xft/XftCompat.h>

#endif

%}

! !

!XftFontDescription class methodsFor:'documentation'!

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."

    Lobby isNil ifTrue:[

        Lobby := Registry new.

    ].

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

! !

!XftFontDescription class methodsFor:'instance creation'!

family:familyString face:faceString style:styleString size:size sizeUnit:sizeUnit encoding:encoding

    "returns a font for given family, face, style, size and the specified encoding.

     The returned font is not associated to a specific device"

    |proto|

    RecentlyUsedFonts notNil ifTrue:[

        proto := RecentlyUsedFonts

                detect:[:fn |

                    fn sameFamily: familyString 

                             face: faceString

                            style: styleString 

                             size: size 

                             unit: sizeUnit 

                        pixelSize: nil

                         encoding: encoding]

                ifNone:[ nil ].

        proto notNil ifTrue:[

            ^ proto

        ].

    ].

    CachedFontList notNil ifTrue:[

        proto := CachedFontList

                detect:[:fn |

                    fn sameFamily: familyString 

                             face: faceString

                            style: styleString 

                             size: size 

                             unit: sizeUnit 

                        pixelSize: nil

                         encoding: encoding]

                ifNone:[ nil ].

        proto notNil ifTrue:[

            ^ (proto shallowCopy)

                setDevice: nil patternId: nil fontId: nil;

                family:familyString face:faceString style:styleString size:size sizeUnit:sizeUnit encoding:encoding

        ].

    ].

    ^ super

        family:familyString face:faceString style:styleString size:size sizeUnit:sizeUnit encoding:encoding

    "Modified: / 29-02-2016 / 08:34:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

for:aFontOrFontDescription

    ^ self

        family:aFontOrFontDescription family

        face:aFontOrFontDescription face 

        style:aFontOrFontDescription style 

        size:aFontOrFontDescription size 

        sizeUnit:#pt 

        encoding:aFontOrFontDescription encoding

!

named: aString

    ^ self new setName: aString

    "Created: / 05-03-2015 / 05:20:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

new

    "return an initialized instance"

    ^ self basicNew initialize.

! !

!XftFontDescription class methodsFor:'* uncategorized *'!

aboutToDestroyViewWithDevice:aGLXWorkstation id:anExternalAddress

    "Created: / 11-10-2015 / 11:32:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!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

    <resource: #obsolete>

    ^ ConfigurableFeatures hasXFT

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

    "Modified (format): / 22-02-2016 / 08:15:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

xftDrawDestroy: xftDrawId

%{

#ifdef XFT

    if (__isExternalAddressLike(xftDrawId)) {

        XftDraw *xftDraw = XFT_DRAW(xftDrawId);        

        XftDrawDestroy(xftDraw);

    }

    RETURN (self);

#endif

%}.

    self primitiveFailed.

! !

!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'

!

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.

!

size

    ^ size ? 0

!

weight:aNumber

    "set the 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'!

getFontId

    ^ fontId

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

! !

!XftFontDescription methodsFor:'converting'!

asNonXftFont

    |newFont|

    newFont := Font

                    family:family

                    face:face

                    style:style

                    size:(sizeUnit == #px ifTrue:[pixelSize] ifFalse:[size])

                    sizeUnit:sizeUnit

                    encoding:encoding.

    ^ newFont

! !

!XftFontDescription methodsFor:'displaying'!

displayString:aString from:index1 to:index2Arg x:xArg y:yArg in:aGC opaque:opaque

    "display a partial string at some position in aGC."

    |index2 bytesPerCharacter transformation

     clipOrg clipCorn clipRect clipX clipY clipW clipH clipPnt

     fg fgR fgG fgB fgA fgPixel bg bgR bgG bgB bgA bgPixel

     drawX drawY drawPnt displayId screen drawableId error stringLen drawId drawIdIsShared

            "/ Using XFT font to draw in bitmap is not allowed. In theory it could

            "/ work if XFT would just turn gray into either black or white. But XFT

            "/ doesn't do it and simply draw nothing without failing in any way. 

            "/ 

            "/ To prevent this silent failures, forbid drawing XFT onto bitmaps

            "/ (depth-1 pixmaps). After all, the while point of XFT is to use

            "/ anti-aliased fonts.

            self error: 'XFT font cannot be used with bitmaps'.

            ^self

        ].

    ].

    "limit the string len, otherwise bad output is generated"

    stringLen := index2Arg - index1 + 1.

    stringLen > 1000 "8000" ifTrue:[

	index2 := index1 + 1000 "8000" - 1.

    ]  ifFalse:[

        stringLen <= 0 ifTrue:[^ self].

        index2 := index2Arg.