initial checkin
authorClaus Gittinger <cg@exept.de>
Tue, 30 Mar 1999 19:41:58 +0200
changeset 2546 6443abc93415
parent 2545 829790f194cc
child 2547 7d6695ce3833
initial checkin
CompoundFont.st
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/CompoundFont.st	Tue Mar 30 19:41:58 1999 +0200
@@ -0,0 +1,309 @@
+FontDescription subclass:#CompoundFont
+	instanceVariableNames:'baseFont characterToFontMapping maxAscent maxDescent'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'Graphics-Support'
+!
+
+!CompoundFont class methodsFor:'documentation'!
+
+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:10).
+    #($a $e $i $o $u) do:[:char |
+        font glyphAt:char putFont:(Font family:'times' size:10).
+    ].
+    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]
+
+
+    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:(baseFont widthOf:'e') 
+                    height:16 
+                    fromArray:#( 
+                                2r00000000 2r00000000
+                                2r00000000 2r00000000
+                                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
+                               ).
+    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 := nil.
+
+! !
+
+!CompoundFont methodsFor:'displaying'!
+
+displayOpaqueString:aString from:index1 to:index2 x:x0 y:y0 in:aGC
+    "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 |
+            font displayOpaqueString:s from:i1 to:i2 x:x y:y in:aGC.
+            x := x + (font widthOf:aString from:i1 to:i2).
+        ].
+
+
+
+!
+
+displayString:aString from:index1 to:index2 x:x0 y:y0 in:aGC
+    "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 |
+            font displayString:s from:i1 to:i2 x:x y:y in:aGC.
+            x := x + (font widthOf:aString from:i1 to:i2).
+        ].
+
+
+
+! !
+
+!CompoundFont methodsFor:'private'!
+
+computeMaxBounds
+    maxAscent := baseFont ascent.
+    maxDescent := baseFont descent.
+    characterToFontMapping notNil ifTrue:[
+        characterToFontMapping keysAndValuesDo:[:char :aFont |
+            maxAscent := maxAscent max:aFont ascent.
+            maxDescent := maxDescent max:aFont descent.
+        ]
+    ].
+!
+
+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
+    maxAscent isNil ifTrue:[
+        self computeMaxBounds
+    ].
+    ^ maxAscent
+!
+
+descent
+    maxDescent isNil ifTrue:[
+        self computeMaxBounds
+    ].
+    ^ maxDescent
+!
+
+isFixedWidth
+    "return true, if this is a fixed pitch font (i.e. all characters
+     are of the same width)"
+
+    baseFont isFixedWidth ifFalse:[^ false].
+    characterToFontMapping keysAndValuesDo:[:char :font |
+        font isFixedWidth ifFalse:[^ false].    
+    ].
+    ^ true
+
+!
+
+maxAscent
+    ^ self ascent
+!
+
+maxDescent
+    ^ self descent
+!
+
+on:aDevice
+    "return a device representation of the receiver.
+     Since I am device independent, return the receiver."
+
+    |newFonts|
+
+    baseFont := baseFont onDevice:aDevice.
+    newFonts := Dictionary new.
+    characterToFontMapping keysAndValuesDo:[:char :font |
+        newFonts at:char put:(font onDevice:aDevice)
+    ].
+    characterToFontMapping := newFonts
+
+!
+
+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: /cvs/stx/stx/libview/CompoundFont.st,v 1.1 1999-03-30 17:41:58 cg Exp $'
+! !