"

 COPYRIGHT (c) 1992 by Claus Gittinger

	      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:#Font

	instanceVariableNames:'device fontId replacementFont ascent descent width isFixedWidth

		minWidth maxWidth maxAscent maxDescent minCode maxCode direction'

	classVariableNames:'Replacements'

	poolDictionaries:''

	category:'Graphics-Support'

!

Object subclass:#DeviceFontHandle

	instanceVariableNames:'device fontId'

	classVariableNames:''

	poolDictionaries:''

	privateIn:Font

!

!Font class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1992 by Claus Gittinger

	      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

"

    Font represents fonts in a device independent manner; after being

    created using 'Font family:family face:face style:style size:size',

    the returned font is not associated to a specific device.

    (therefore, those fonts can be used to draw on any GC)

    To get a device font, any font can be sent the message

    'aFont on:aDevice' which returns an instance of Font which is

    associated to a device (it returns the receiver, if that is already

    associated to that device).

    For proper operation, each graphics operation working with fonts

    must get a device font before doing the draw.

    Most draw methods in DeviceDrawable do that automatically for you, 

    before doing the draw; so you do not have to care.

    However, some operations require explicit conversion to a device font

    before being allowed. For example, a query for a font's height (in device

    units) can only be done if the font being asked is associated to

    a device (which should be clear, since a 'courier-roman-12' font may

    have a different number of pixels on a 75dpi vs. a 120dpi display. And

    a totally different number of device units on a 600dpi laser printer.

    Thus, to query a font for its height (or ascent, or descent, or width),

    use something like:

        myFont := Font family:'courier' ... size:12.

            ...

        'want to know its height on the Display'

        h := (myFont on:Display) height.

        'want to know its height on a printer'

        h := (myFont on:aPrinter) height.

    there are alternative shortcuts for these operations:

        h := myFont heightOn:Display.

        h := myFont heightOn:Printer.

        or:

        a := myFont ascentOn:Display.

    Keep in mind, that each device is free to think in whatever units it

    likes - a display may return units of pixels, a postscript printer may

    think in (fractions of) inches, a dot matrix printer may think in dots.

    Also, notice that currently only graphic displays are really supported;

    printer devices are being developped and may or may not be in the current

    system.

    If a font cannot be represented on a device, a replacement

    font is chosen and kept in the replacementFont instance variable. 

    This is done to preserve the original font information, in case the image

    is restarted later on another display which has that font available.

    [Instance variables:]

      family          <String>        the font's family ('courier', 'helvetica' etc)

      face            <String>        the font's face ('bold', 'medium' etc)

      style           <String>        the font's style ('roman', 'italic', 'oblique')

      size            <String>        the font's size (not in pixels) 

      encoding        <Symbol>        the font's encoding (usually #iso8859)

      device          <Object>        the device the font is associated to, or nil

      fontId          <Object>        the id of the font on that device, or nil

      replacement     <Font>          the replacement font or nil

      ascent          <Integer>       the font's ascent in device units on device

      descent         <Integer>       the font's descent in device units on device

      width           <Integer>       the character width in device units on device

                                      (for variable fonts, its the width of a space)

      isFixedWidth    <Boolean>       true if font is a fixed width font

      minWidth        <Integer>       width of the smallest-width character in

                                      in device units on device

      maxWidth        <Integer>       width of the largest-width character in

                                      in device units on device

    [class variables:]

      Replacements    <Dictionary>    replacement fonts

    [see also:]

        DeviceWorkstation 

        DeviceDrawable GraphicsContext

        Cursor Color

        ( introduction to view programming :html: programming/viewintro.html#FONTS )

    [author:]

        Claus Gittinger

"

!

examples

"

    standard fonts:

        Font family:'courier' size:12

        Font 

             family:'helvetica' 

             face:'roman' 

             style:'bold' 

             size:16

        Font 

             family:'helvetica' 

             pixelSize:20

    special (non-portable displayType specific) fonts (typically: old X11 fonts):

        Font name:'6x10'

        Font name:'k14'

    setting the font of a button:

                                                                        [exBegin]

        |b|

        b := Button new.

        b label:'hello'.

        b font:(Font family:'helvetica' 

                     face:'medium' 

                     style:'roman' 

                     size:16).

        b open

                                                                        [exEnd]

    asking a font about a strings size in pixels, 

    if it was used on some device:

        aFont widthOf:'hello' on:Display

    asking about the ascent, if used on some device:

        aFont ascentOn:Display

    if the font has been associated to a device, the following are 

    a bit faster:

        |aFont|

        ...

        aFont := aFont on:aDevice.

        ...

        aFont widthOf:'hello'

        ...

        aFont ascent

        ...

"

! !

!Font class methodsFor:'initialization'!

initialize

    "initialize the font tracking array"

    Replacements isNil ifTrue:[

        Replacements := Dictionary new.

        Replacements 

            at:'serif'                  put:#('times' 'times new roman' 'palatino' 'bookman');

            at:'sans-serif'             put:#('arial' 'lucida' 'helvetica');

            at:'monospace'              put:#('courier new' 'courier' 'andale mono' 'lucidatypewriter' 'fixed').

        Replacements 

            at:'clean'                  put:#('courier new' 'courier');

            at:'fixed'                  put:#('courier new' 'courier');

            at:'new century schoolbook' put:#('times' 'times new roman');

            at:'arial'                  put:#('helvetica' 'lucida');

            at:'lucida'                 put:#('arial' 'helvetica');

            at:'lucidabright'           put:#('arial' 'helvetica');

            at:'lucidatypewriter'       put:#('courier' 'courier new');

            at:'courier'                put:#('courier new');

            at:'courier new'            put:#('courier');

            at:'charter'                put:#('times' 'times new roman');

            at:'times new roman'        put:#('times');

            at:'times'                  put:#('times new roman');

            at:'terminal'               put:#('courier' 'courier new');

            at:'helvetica'              put:#('arial' 'lucida').

    ].

! !

!Font class methodsFor:'instance creation'!

family:familyString face:faceString style:styleString size:sizeArgOrNil sizeUnit:sizeUnitArg encoding:encodingSym

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

     The returned font is not associated to a specific device."

    |family newFont|

    (familyString at:1) isUppercase ifTrue:[

        family := familyString asLowercase

    ] ifFalse:[

        family := familyString

    ].

    newFont := self basicNew 

                    setFamily:familyString

                    face:faceString

                    style:styleString

                    size:sizeArgOrNil

                    sizeUnit:sizeUnitArg

                    encoding:encodingSym

                    device:nil.

"/    "look if this font is already known on the default device (the most common case)"

"/ don't do this!!

"/ is incompatible with Xft fonts. If reenabled, check printing in document viewer with XFT fonts enabled.

"/

"/    Display notNil ifTrue:[

"/        Display deviceFonts do:[:aFont |

"/            (newFont sameDeviceFontAs:aFont) ifTrue:[

"/                "/ self assert:(aFont encoding = newFont encoding).

"/                ^ aFont

"/            ]

"/        ]

"/    ].

    ^ newFont

    "Modified: / 26.9.1999 / 13:49:45 / cg"

! !

!Font methodsFor:'accessing'!

device

    "return the device I am on.

     Obsolete - use #graphicsDevice"

    <resource:#obsolete>

    self obsoleteMethodWarning:'use #graphicsDevice (2013-07-25)'.

    ^ device

!

fontId

    "return the device-dependent font-id"

    replacementFont notNil ifTrue:[

        ^ replacementFont fontId

    ].

    ^ fontId

!

graphicsDevice

    "same as #device, for ST-80 compatibility naming.

     Return the device I am associated with."

    ^ device

    "Created: 28.5.1996 / 18:39:53 / cg"

! !

!Font methodsFor:'converting'!

asFontDescription

    ^ FontDescription 

        family:family

        face:face

        style:style

        size:size

        sizeUnit:(sizeUnit ? #pt)

        encoding:encoding

! !

!Font methodsFor:'copying'!

deepCopyUsing:aDictionary postCopySelector:postCopySelector

    ^ self

! !

!Font methodsFor:'displaying'!

displayString:aString from:index1 to:index2 x:x y:y in:aGC opaque:opaque

    "this is only called for fonts which have a nil fontId,

     and therefore use the replacementFont. Should never be called

     for non-replacement fonts."

    |prevFont|

    prevFont := aGC font.

    replacementFont isNil ifTrue:[

        fontId notNil ifTrue:[

            aGC basicFont:self.

            aGC displayString:aString from:index1 to:index2 x:x y:y opaque:opaque.

        ] ifFalse:[

            'Font: [warning]: no replacementFont. should not happen' errorPrintCR.

        ].

    ] ifFalse:[

        aGC basicFont:replacementFont.

        aGC displayString:aString from:index1 to:index2 x:x y:y opaque:opaque.

    ].

    aGC basicFont:prevFont.

    "Modified: 10.1.1997 / 17:51:17 / cg"

!

displayString:aString from:index1 to:index2 x:x y:y in:aGC opaque:opaque maxWidth:maxWindowWidth

    "this is only called for fonts which have a nil fontId,

     and therefore use the replacementFont. Should never be called

     for non-replacement fonts."

    |prevFont|

    prevFont := aGC font.

    replacementFont isNil ifTrue:[

        fontId notNil ifTrue:[

            aGC basicFont:self.

            aGC displayString:aString from:index1 to:index2 x:x y:y opaque:opaque maxWidth:maxWindowWidth.

        ] ifFalse:[

            'Font: [warning]: no replacementFont. should not happen' errorPrintCR.

        ].

    ] ifFalse:[

        aGC basicFont:replacementFont.

        aGC displayString:aString from:index1 to:index2 x:x y:y opaque:opaque maxWidth:maxWindowWidth.

    ].

    aGC basicFont:prevFont.

    "Modified: 10.1.1997 / 17:51:17 / cg"

! !

!Font methodsFor:'getting a device font'!

onDevice:aDevice

    "create a new Font representing the same font as

     myself on aDevice; if one already exists, return the one."

    |newFont rep|

    "if I am already assigned to that device ..."

    (device == aDevice) ifTrue:[^ self].

    (aDevice isNil and:[device notNil]) ifTrue:[

        ^ self

    ].

    aDevice deviceFonts do:[:aFont |

        (self sameDeviceFontAs:aFont) ifTrue:[

            ^ aFont

        ].

    ].

    newFont := self onDevice:aDevice ifAbsent:nil.

    newFont isNil ifTrue:[

        "oops did not work - (device has no such font)"

        aDevice isOpen ifFalse:[

            "/ the display device is not connected

            "/ (or has a broken connection).

            aDevice class drawingOnClosedDeviceSignal raiseRequestWith:aDevice.

            ^ self.

        ].

        "/ look for a replacement font

        rep := self replacementFontOnDevice:aDevice.

        device isNil ifTrue:[

            device := aDevice.

            replacementFont := rep.

            newFont := self.

        ] ifFalse:[

            newFont := self class basicNew.

            newFont

                setFamily:family 

                face:face 

                style:style 

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

                sizeUnit:sizeUnit 

                encoding:encoding 

                device:aDevice;

                isGenericFont:self isGenericFont;

                setReplacementFont:rep.

        ].

        aDevice registerFont:newFont.

    ].

    ^ newFont

    "

     (Font family:'fooXXXXXX' size:17) onDevice:Screen current

    "

    "Modified: 14.4.1997 / 18:22:31 / cg"

!

onDevice:aDevice ifAbsent:exceptionBlock 

    "create a new Font representing the same font as

     myself on aDevice. This does NOT try to look for existing

     or replacement fonts (i.e. can be used to get physical fonts)."

    |id|

    "receiver was not associated - do it now"

    device isNil ifTrue:[

        "ask that device for the font"

        id := aDevice 

                getFontWithFamily:family 

                face:face 

                style:style 

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

                sizeUnit:sizeUnit  

                encoding:encoding ? '*'.

        id isNil ifTrue:[

            "oops did not work - (device has no such font)"

            ^ exceptionBlock value

        ].

        device := aDevice.

        fontId := id.

        self getFontInfos.

        aDevice registerFont:self.

        ^ self

    ].

    "receiver was already associated to another device - need a new font"

    ^ super onDevice:aDevice ifAbsent:exceptionBlock

!

replacementFontOnDevice:aDevice

    "return a replacement font for the receiver - this is needed, if

     an image is restored on another type of display, or one which has

     a different set of fonts."

    |id f trySize alternatives alternateFamilyName useEncoding|

    "try font with smaller size - 

     but do not try this on scaled fonts (they have size == 0)"

    useEncoding := encoding ? #'iso10646-1'.

    alternateFamilyName := family.

    self isGenericFont ifFalse:[