"
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.
"
FontDescription subclass:#Font
instanceVariableNames:'device fontId replacementFont
ascent descent height width isFixedWidth
minWidth maxWidth'
classVariableNames:'Lobby Replacements'
poolDictionaries:''
category:'Graphics-Support'
!
Font comment:'
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
$Header: /cvs/stx/stx/libview/Font.st,v 1.19 1995-05-19 13:39:33 claus Exp $
'!
!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.
"
!
version
"
$Header: /cvs/stx/stx/libview/Font.st,v 1.19 1995-05-19 13:39:33 claus Exp $
"
!
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.
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.
However, some operations require explicit conversion to a device font
before being allowed. For example, a query for a fonts 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 total 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.
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.
Sometimes, a font cannot be represented on a device, then a replacement
font is chosen and kept in the replacementFont instance variable.
Instance variables:
family <String> the fonts family ('courier', 'helvetica' etc)
face <String> the fonts face ('bold', 'medium' etc)
style <String> the fonts style ('roman', 'italic', 'oblique')
size <String> the fonts size (not in pixels)
encoding <Symbol> the fonts 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 fonts ascent in device units on device
descent <Integer> the fonts descent in device units on device
height <Integer> the fonts height 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:
Lobby <Registry> keeps track of all known fonts
Replacements <Dictionary> replacement fonts
"
! !
!Font class methodsFor:'initialization'!
initialize
"initialize the font tracking array"
Lobby isNil ifTrue:[
Lobby := Registry new.
"
want to be informed when returning from snapshot
"
ObjectMemory addDependent:self.
"
replacement handling is not yet finished
"
Replacements := Dictionary new.
Replacements at:'clean' put:'courier'.
Replacements at:'fixed' put:'courier'.
Replacements at:'new century schoolbook' put:'times'.
Replacements at:'lucida' put:'helvetica'.
Replacements at:'lucidabright' put:'helvetica'.
Replacements at:'lucidatypewriter' put:'courier'.
Replacements at:'charter' put:'times'.
Replacements at:'terminal' put:'courier'.
]
!
flushDeviceFonts
"unassign all fonts from their device"
Lobby do:[:aFont |
aFont restored.
Lobby changed:aFont
]
!
update:something
(something == #restarted) ifTrue:[
"
this is sent by ObjectMemory when restarting from
an image. All device specific information (especially device
handles) are now invalid and have to be flushed
"
self flushDeviceFonts
]
! !
!Font class methodsFor:'instance creation'!
family:familyString face:faceString style:styleString size:sizeNum 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
].
"look if this font is already known"
Lobby do:[:aFont |
(aFont family = family) ifTrue:[
(aFont face = faceString) ifTrue:[
(aFont style = styleString) ifTrue:[
(aFont size == sizeNum) ifTrue:[
(encodingSym isNil or:[aFont encoding == encodingSym]) ifTrue:[
^ aFont
]
]
]
]
]
].
newFont := self basicNew setFamily:familyString
face:faceString
style:styleString
size:sizeNum
encoding:encodingSym
device:nil.
Lobby register:newFont.
^ newFont
! !
!Font methodsFor:'instance release'!
shallowCopyForFinalization
|aCopy|
aCopy := self class basicNew.
aCopy setDevice:device fontId:fontId.
^ aCopy
!
disposed
"some Font has been collected - tell it to the x-server"
fontId notNil ifTrue:[
device releaseFont:fontId.
fontId := nil
]
! !
!Font methodsFor:'getting a device font'!
on:aDevice
"create a new Font representing the same font as
myself on aDevice; if one already exists, return the one."
|newFont id rep|
"if I am already assigned to that device ..."
(device == aDevice) ifTrue:[^ self].
"first look if not already there"
Lobby do:[:aFont |
(aDevice == aFont device) ifTrue:[
(size == aFont size) ifTrue:[
(family = aFont family) ifTrue:[
(face = aFont face) ifTrue:[
(style = aFont style) ifTrue:[
(encoding isNil or:[encoding == aFont encoding]) ifTrue:[
^ aFont
]
]
]
]
]
]
].
"ask that device for the font"
id := aDevice getFontWithFamily:family face:face style:style size:size encoding:encoding.
id isNil ifTrue:[
"oops did not work - (device has no such font)"
rep := self replacementFontOn:aDevice.
device isNil ifTrue:[
device := aDevice.
replacementFont := rep.
Lobby changed:self.
^ self
].
newFont := (self class basicNew)
setFamily:family face:face style:style size:size encoding:encoding device:aDevice.
newFont setReplacementFont:rep.
Lobby register:newFont.
^ newFont
].
"receiver was not associated - do it now"
device isNil ifTrue:[
device := aDevice.
fontId := id.
self getFontInfos.
Lobby changed:self.
^ self
].
"receiver was already associated to another device - need a new font"
newFont := (self class basicNew) setFamily:family
face:face
style:style
size:size
encoding:encoding
device:aDevice.
newFont setFontId:id.
newFont getFontInfos.
Lobby register:newFont.
^ newFont
!
replacementFontOn: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 alternative|
alternative := Replacements at:family ifAbsent:nil.
alternative notNil ifTrue:[
id := aDevice getFontWithFamily:alternative
face:face
style:style
size:size
encoding:encoding.
].
id notNil ifTrue:[
('replaced ' , family , '- with ' , alternative , '-font') print.
] ifFalse:[
id := aDevice getDefaultFont.
('replaced ' , family , '- with default-font') print.
].
id isNil ifTrue:[
"oops did not work - this is a serious an error"
self error:'cannot get default font'.
^ nil
].
f := self class basicNew.
f setDevice:aDevice fontId:id.
f getFontInfos.
Lobby register:f.
^ f
! !
!Font methodsFor:'private'!
setFamily:familyString face:faceString style:styleString size:sizeNum encoding:encodingSym device:aDevice
family := familyString.
face := faceString.
style := styleString.
size := sizeNum.
encoding := encodingSym.
device := aDevice
!
restored
device := nil.
fontId := nil.
replacementFont := nil
!
setReplacementFont:aFont
replacementFont := aFont
!
setDevice:aDevice
device := aDevice
!
setFontId:aFontId
fontId := aFontId
!
setDevice:aDevice fontId:aFontId
device := aDevice.
fontId := aFontId
!
getFontInfos
replacementFont isNil ifTrue:[
ascent := device ascentOf:fontId.
descent := device descentOf:fontId.
height := descent + ascent.
width := device widthOf:' ' inFont:fontId.
minWidth := device minWidthOfFont:fontId.
maxWidth := device maxWidthOfFont:fontId.
] ifFalse:[
ascent := replacementFont ascent.
descent := replacementFont descent.
height := descent + ascent.
width := replacementFont width.
minWidth := replacementFont minWidth.
maxWidth := replacementFont maxWidth.
].
isFixedWidth := minWidth == maxWidth
! !
!Font methodsFor:'accessing'!
fontId
"return the device-dependent font-id"
^ fontId
!
device
"return the device I am on"
^ device
! !
!Font methodsFor:'queries'!
isFixedWidth
"return true, if all characters have same width (as in courier"
device isNil ifTrue:[
self errorNoDevice
].
replacementFont notNil ifTrue:[
^ replacementFont isFixedWidth
].
^ isFixedWidth
!
height
"return the characters maximum height;
That is the number of units (usually pixels) on the device"
device isNil ifTrue:[
self errorNoDevice
].
replacementFont notNil ifTrue:[
^ replacementFont height
].
^ height
!
width
"return the characters width;
That is the number of units (usually pixels) on the device.
For variable pitch fonts, the width of the space character is returned"
device isNil ifTrue:[
self errorNoDevice
].
replacementFont notNil ifTrue:[
^ replacementFont width
].
^ width
!
minWidth
"return the width of the smallest character;
if the receiver is a fixed width font its the width of every character"
device isNil ifTrue:[
self errorNoDevice
].
replacementFont notNil ifTrue:[
^ replacementFont minWidth
].
^ minWidth
!
maxWidth
"return the width of the widest character;
if the receiver is a fixed width font its the width of every character"
device isNil ifTrue:[
self errorNoDevice
].
replacementFont notNil ifTrue:[
^ replacementFont maxWidth
].
^ maxWidth
!
ascent
"return the font-ascent i.e. the maximum of all characters;
That is the number of units (usually pixels) above the baseline"
device isNil ifTrue:[
self errorNoDevice
].
replacementFont notNil ifTrue:[
^ replacementFont ascent
].
^ ascent
!
descent
"return the font-descent i.e. the maximum of all characters;
That is the number of units (usually pixels) below the baseline"
device isNil ifTrue:[
self errorNoDevice
].
replacementFont notNil ifTrue:[
^ replacementFont descent
].
^ descent
!
widthOf:textOrString
"return the width (device specific) of the argument;
the argument may be a String or some Text;
in the later case the width of the longest line in the text is returned"
|this max|
device isNil ifTrue:[
self errorNoDevice.
^ 0
].
replacementFont notNil ifTrue:[
^ replacementFont widthOf:textOrString
].
(textOrString isString) ifTrue:[
isFixedWidth ifFalse:[
^ device widthOf:textOrString inFont:fontId
].
^ width * textOrString size
].
max := 0.
isFixedWidth ifFalse:[
textOrString do:[:line |
line notNil ifTrue:[
this := device widthOf:line inFont:fontId.
(this > max) ifTrue:[max := this]
]
].
^ max
].
textOrString do:[:lineString |
this := lineString size.
(this > max) ifTrue:[max := this]
].
^ max * width
!
widthOf:aString from:start to:stop
"return the width of a substring"
device isNil ifTrue:[
self errorNoDevice.
^ 0
].
replacementFont notNil ifTrue:[
^ replacementFont widthOf:aString from:start to:stop
].
(stop < start) ifTrue:[^ 0].
isFixedWidth ifFalse:[
^ device widthOf:aString from:start to:stop inFont:fontId
].
^ (stop - start + 1) * width
! !
!Font methodsFor:'displaying'!
displayString:aString x:x y:y in:aGC
"this is only called for fonts which have a nil fontId,
and therefore use the replacementFont"
replacementFont isNil ifTrue:[
'FONT: oops should not happen' errorPrintNL.
^ self
].
aGC font:replacementFont.
aGC displayString:aString x:x y:y
!
displayString:aString from:index1 to:index2 x:x y:y in:aGC
"this is only called for fonts which have a nil fontId,
and therefore use the replacementFont"
replacementFont isNil ifTrue:[
'FONT: oops should not happen' errorPrintNL.
^ self
].
aGC font:replacementFont.
aGC displayString:aString from:index1 to:index2 x:x y:y
! !
!Font methodsFor:'st-80 queries'!
fixedWidth
"return true, if this font is a fixed width font -
for st-80 compatibility"
^ self isFixedWidth
!
pixelSize
"return the height of the font in pixels -
for st-80 compatibility"
^ self height
! !
!Font methodsFor:'printing & storing'!
printOn:aStream
face isNil ifTrue:[
aStream nextPutAll:('a ' , family , '-Font')
].
aStream nextPutAll:('a ' , family , '-' ,
face , '-' ,
style , '-' ,
size printString , '-Font')
!
storeOn:aStream
"append a character sequence to the argument, aStream from which the
receiver can be reconstructed using readFrom:."
aStream nextPutAll:'(Font 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:$)
"
(Font family:'helvetica' size:10) storeString
"
! !
!Font methodsFor: 'binary storage'!
readBinaryContentsFrom: stream manager: manager
"tell the newly restored Font about restoration"
super readBinaryContentsFrom: stream manager: manager.
self restored
! !