"
 COPYRIGHT (c) 1999 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.

 This is a demo example:

 THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTOR ``AS IS'' AND
 ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 ARE DISCLAIMED.  IN NO EVENT SHALL THE CONTRIBUTOR BE LIABLE
 FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
 OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
 HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 SUCH DAMAGE.
"
"{ Package: 'stx:libview' }"

"{ NameSpace: Smalltalk }"

FontDescription subclass:#CompoundFont
	instanceVariableNames:'baseFont characterToFontMapping maxAscent maxDescent maxHeight
		device'
	classVariableNames:''
	poolDictionaries:''
	category:'Graphics-Support'
!

!CompoundFont class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1999 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.

 This is a demo example:

 THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTOR ``AS IS'' AND
 ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 ARE DISCLAIMED.  IN NO EVENT SHALL THE CONTRIBUTOR BE LIABLE
 FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
 OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
 HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 SUCH DAMAGE.
"
!

documentation
"
    a CompountFont is a font which consists of character glyphs from multiple
    other (base-)fonts; for each character code, an individual font may be given.

    This has been mostly added to allow for non-EURO fonts to be used with ST/X,
    by defining a mixedFont, which has an EURO-glyph at the desired character
    position.
    Do not hardCode usage of MixedFonts into your application, since they
    might disappear in the future (when Unicode support has been fully 
    implemented in ST/X, and Unicode fonts are generally available under X).
    I.e. to use these fonts, add appropriate setup to the styleSheet,
    or private.rc and use those fonts transparently.

    [Instance variables:]

      baseFont                  <Font>          fallback (default-) font
      characterToFontMapping    <Dictionary>    maps characters to a fonts

    [class variables:]

    [see also:]
        Font BitmapFont
        DeviceDrawable GraphicsContext

    [author:]
        Claus Gittinger
"


!

examples
"
    a mixed font; all vowels are displayed in times;
    the rest in helvetica.
                                                                        [exBegin]
    |font top list|

    font := CompoundFont basedOn:(Font family:'courier' size:18).
    #($a $e $i $o $u) do:[:char |
        font glyphAt:char putFont:(Font family:'times' size:18).
    ].
    top := ScrollableView forView:(list := EditTextView new).
    list font:font.
    list list:#('a' 'z' 'aaa' 'zzz' 'azaz' 'zaza' 'aa' 'az' 'za' 'hello' 'abcdef' 'xyz').
    top extent:200@200.
    top open.
                                                                        [exEnd]

                                                                        [exBegin]
    |font font2 top list|

    font := CompoundFont basedOn:(Font family:'courier' size:18).
    font2 := Font family:'times' size:24.

    #($a $e $i $o $u $j) do:[:char |
        font glyphAt:char putFont:font2.
        font glyphAt:char asUppercase putFont:font2.
    ].
    top := ScrollableView forView:(list := EditTextView new).
    list font:font.
    list list:#('hello' 'abcdefghijklmnopqrstuvwxyz' 'xyz'
                'HELLO' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'XYZ').
    top extent:200@200.
    top open.
                                                                        [exEnd]

    a mixed font; the dollar character is replaced by the european
    EURO symbol; the rest is helvetica
    (this is a hack - we really need a resizable font for this):

                                                                        [exBegin]
    |font baseFont euroGlyph glyphs euroFont top list|

    baseFont := Font family:'helvetica' size:12.
    baseFont := baseFont onDevice:Display.
    glyphs := Array new:256.
    euroGlyph := Form 
                    width:12 
                    height:16 
                    fromArray:#( 
                                2r00000000 2r00000000
                                2r00000000 2r00000000
                                2r00000000 2r00000000
                                2r00000111 2r11000000
                                2r00001000 2r00100000
                                2r00010000 2r00000000
                                2r01111111 2r10000000
                                2r00010000 2r00000000
                                2r01111111 2r10000000
                                2r00010000 2r00000000
                                2r00001000 2r00100000
                                2r00000111 2r11000000
                                2r00000000 2r00000000
                                2r00000000 2r00000000
                                2r00000000 2r00000000
                                2r00000000 2r00000000
                               ).
    glyphs at:($$ asciiValue+1) put:euroGlyph.

    euroFont := BitmapFont new glyphs:glyphs.
    euroFont setAscent:(baseFont ascent).
    euroFont setDescent:(baseFont descent).

    font := CompoundFont basedOn:baseFont.
    font glyphAt:$$ putFont:euroFont.

    top := ScrollableView forView:(list := EditTextView new).
    list font:font.
    list list:#('100 $' '193 DM').
    top extent:200@200.
    top open.
                                                                        [exEnd]
"
! !

!CompoundFont class methodsFor:'instance creation'!

basedOn:aRealFont
    ^ self new baseFont:aRealFont
! !

!CompoundFont methodsFor:'accessing'!

baseFont
    "return the value of the instance variable 'baseFont' (automatically generated)"

    ^ baseFont
!

baseFont:something
    "set the value of the instance variable 'baseFont' (automatically generated)"

    baseFont := something.
    maxAscent := maxDescent := nil.
!

glyphAt:char putFont:aFont
    characterToFontMapping isNil ifTrue:[
        characterToFontMapping := Dictionary new.
    ].

    characterToFontMapping at:char put:aFont.
    maxAscent := maxDescent := maxHeight := nil.
!

graphicsDevice
    "return the device I am on"

    ^ device
! !

!CompoundFont methodsFor:'displaying'!

displayString:aString from:index1 to:index2 x:x0 y:y0 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."

    |x y|

    x := x0.
    y := y0.

    self 
        substringPartsOf:aString from:index1 to:index2 
        do:[:s :i1 :i2 :font |
            |wString|

            wString := font widthOf:aString from:i1 to:i2.
            opaque ifTrue:[
"/                (font ascent < maxAscent 
"/                or:[font descent < maxDescent]) 
"/                ifTrue:[       
                    aGC 
                        fillRectangleX:x 
                        y:y-maxAscent      
                        width:wString 
                        height:maxAscent+maxDescent 
                        color:aGC backgroundPaint.
"/                ].
            ].
            font displayString:s from:i1 to:i2 x:x y:y in:aGC opaque:opaque.
            x := x + wString.
        ].
! !

!CompoundFont methodsFor:'printing'!

userFriendlyName
    ^ 'CompoundFont(baseFont: ', baseFont userFriendlyName, ')'
! !

!CompoundFont methodsFor:'private'!

computeMaxBounds
    maxAscent := baseFont maxAscent.
    maxDescent := baseFont maxDescent.
    maxHeight := baseFont maxHeight.
    characterToFontMapping notNil ifTrue:[
        characterToFontMapping keysAndValuesDo:[:char :aFont |
            maxAscent := maxAscent max:aFont maxAscent.
            maxDescent := maxDescent max:aFont maxDescent.
            maxHeight := maxHeight max:aFont maxHeight.
        ]
    ].
!

substringPartsOf:aString from:index1 to:index2 do:aBlock
    "helper - evaluate aBlock for parts of a string, which use the same font.
     aBlock is invoked for consecutive substrings, passing the string,
     the startIndex, endIndex and the font as arguments."

    |i1 i2 fn char currentFont|

    index2 < index1 ifTrue:[^ self].

    i1 := index1.
    currentFont := characterToFontMapping at:(aString at:i1) ifAbsent:baseFont.
    i2 := i1 + 1.

    [i2 <= index2] whileTrue:[
        char := aString at:i2.
        fn := characterToFontMapping at:char ifAbsent:baseFont.
        fn ~~ currentFont ifTrue:[
            aBlock value:aString value:i1 value:(i2-1) value:currentFont.
            currentFont := fn.
            i1 := i2.
        ].
        i2 := i2 + 1.
    ].

    i1 < i2 ifTrue:[
        aBlock value:aString value:i1 value:(i2-1) value:currentFont.
    ].

    "
     |f|

     f := self new.
     f baseFont:#baseFont.
     f fontAt:$$ put:#font2.
     f substringPartsOf:'ae$a' from:1 to:8 
       do:[:s :i1 :i2 :f |
             Transcript 
                     show:i1; space;
                     show:i2; space;
                     showCR:f
          ]
    "
! !

!CompoundFont methodsFor:'queries'!

ascent
    ^ self maxAscent
!

descent
    ^ self maxDescent
!

height
    maxHeight isNil ifTrue:[
        self computeMaxBounds
    ].
    ^ maxHeight.
!

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

    |w|

    baseFont isFixedWidth ifFalse:[^ false].
    w := baseFont width.

    characterToFontMapping keysAndValuesDo:[:char :font |
        font isFixedWidth ifFalse:[^ false].
        font width ~~ w ifTrue:[^ false].
    ].
    ^ true
!

maxAscent
    maxAscent isNil ifTrue:[
        self computeMaxBounds
    ].
    ^ maxAscent
!

maxDescent
    maxDescent isNil ifTrue:[
        self computeMaxBounds
    ].
    ^ maxDescent
!

onDevice:aDevice
    "return a device representation of the receiver.
     Since I am device independent, return the receiver."

    |newFonts lastFont lastDeviceFont newFont|

    aDevice == device ifTrue:[ ^ self ].

    baseFont := baseFont onDevice:aDevice.
    newFonts := Dictionary new.
    characterToFontMapping keysAndValuesDo:[:char :font |
        font == lastFont ifTrue:[
            newFont := lastDeviceFont
        ] ifFalse:[
            newFont := font onDevice:aDevice.
            lastFont := font.
            lastDeviceFont := newFont.
        ].
        newFonts at:char put:newFont
    ].
    characterToFontMapping := newFonts.
    device := aDevice.
!

widthOf:aString from:index1 to:index2
    |w|

    w := 0.
    self 
        substringPartsOf:aString from:index1 to:index2 
        do:[:s :i1 :i2 :f |
             w := w + (f widthOf:s from:i1 to:i2)
           ].
    ^ w

! !

!CompoundFont class methodsFor:'documentation'!

version
    ^ '$Header$'
! !