--- a/FontPanel.st Wed Nov 26 21:15:34 2014 +0100
+++ b/FontPanel.st Thu Nov 27 00:21:40 2014 +0100
@@ -12,12 +12,12 @@
"{ Package: 'stx:libwidg' }"
DialogBox subclass:#FontPanel
- instanceVariableNames:'previewField listOfEncodings familyList faceList sizeList
- revertButton currentFamily currentFace currentStyle
- currentFaceAndStyle currentSize sizeUnit currentEncoding
- selectedFont nameLabel encodingFilter encodingLabel filter
- combinedFilter encoding sizeLabelHolder pixelPointSwitch
- xftFontsOnlyHolder'
+ instanceVariableNames:'previewField listOfEncodings allFonts fontsPerFamily familyList
+ faceList sizeList revertButton currentFamily currentFace
+ currentStyle currentFaceAndStyle currentSize sizeUnit
+ currentEncoding selectedFont nameLabel encodingFilter
+ encodingLabel filter combinedFilter encoding sizeLabelHolder
+ pixelPointSwitch xftFontsOnlyHolder'
classVariableNames:''
poolDictionaries:''
category:'Views-DialogBoxes'
@@ -481,22 +481,26 @@
initialFont:aFont
"set the font to be selected initially"
- |encoding|
+ |fontEncoding|
selectedFont := aFont.
currentFamily := aFont family.
currentFace := aFont face.
currentStyle := aFont style.
- currentSize := aFont size.
currentFaceAndStyle := currentFace,'-',currentStyle.
self xftFontsOnlyHolder value:(aFont isXftFont).
- encoding := aFont encoding.
+ fontEncoding := aFont encoding.
sizeUnit := aFont sizeUnit.
+ sizeUnit = #px ifTrue:[
+ currentSize := aFont size asString , 'px'.
+ ] ifFalse:[
+ currentSize := aFont size asString.
+ ].
"/ self halt.
- encodingFilter contents:encoding.
- self encodingFilterSelected:encoding.
+ encodingFilter contents:fontEncoding.
+ self encodingFilterSelected:fontEncoding.
self showSelectedFont.
"Modified: 23.2.1996 / 00:51:32 / cg"
@@ -661,8 +665,7 @@
familyList := familyList scrolledView.
self makeTabable:familyList.
- v2 := View origin:0.4@0.0 corner:0.8@1.0
- in:fontBrowserView.
+ v2 := View origin:0.4@0.0 corner:0.8@1.0 in:fontBrowserView.
faceLabel := Label label:(resources string:'Typeface') in:v2.
faceLabel borderWidth:0.
@@ -814,88 +817,206 @@
fontForPreview
"get the preview font"
- |font allFonts fonts|
+ |fontShown fonts sz szUnitUsed|
currentSize isNil ifTrue:[
^ nil.
].
+ sz := Integer readFrom:currentSize.
+ szUnitUsed := sizeUnit.
+ (currentSize endsWith:'px') ifTrue:[
+ szUnitUsed := #px.
+ ].
- font :=
- ((Screen current supportsXFTFonts and:[self xftFontsOnlyHolder value])
- ifTrue:[XftFontDescription]
- ifFalse:[Font])
- family:currentFamily
- face:currentFace
- style:currentStyle
- size:currentSize
- sizeUnit:sizeUnit
- encoding:encoding.
-
- font notNil ifTrue:[^ font].
+ fonts := (fontsPerFamily at:currentFamily)
+ select:[:fntDescr |
+ fntDescr face = currentFace
+ and:[ fntDescr style = currentStyle
+ and:[ (szUnitUsed == #px)
+ ifTrue:[ (fntDescr pixelSize = sz) or:[ fntDescr isScaledFont] ]
+ ifFalse:[ (fntDescr size = sz) or:[ fntDescr isScaledFont] ]]]
+ ].
- allFonts := self graphicsDevice
- fontsInFamily:(currentFamily ? '*')
- face:(currentFace ? '*')
- style:(currentStyle ? '*')
- filtering:combinedFilter.
+ fonts size > 1 ifTrue:[
+ 'FontPanel [info]: huh - multiple entries: ' infoPrint. fonts infoPrintCR.
+ ].
+ fontShown := fonts first.
+ fontShown isScaledFont ifTrue:[
+ szUnitUsed == #px ifTrue:[
+ fontShown := fontShown asPixelSize:sz
+ ] ifFalse:[
+ fontShown := fontShown asSize:sz
+ ].
+ ].
+ ^ fontShown onDevice:self graphicsDevice
- sizeUnit == #px ifTrue:[
- fonts := allFonts select:[:f | f pixelSize = currentSize].
- ] ifFalse:[
- fonts := allFonts select:[:f | f size = currentSize].
- ].
- fonts notEmpty ifTrue:[
- font := fonts anElement.
- ] ifFalse:[
- "/ mhmh:
- "/ size=0 is returned for scalable fonts.
- "/ Any size is possible.
- "/
- fonts := allFonts select:[:f | f size = 0].
- fonts notEmpty ifTrue:[
- font := Font family:currentFamily
- face:currentFace
- style:currentStyle
- size:currentSize
- sizeUnit:sizeUnit
- encoding:(fonts anElement encoding).
- ]
- ].
- ^ font
+"/ fontShown :=
+"/ ((Screen current supportsXFTFonts and:[selectedFont isXftFont "self xftFontsOnlyHolder value" ])
+"/ ifTrue:[XftFontDescription]
+"/ ifFalse:[Font])
+"/ family:currentFamily
+"/ face:currentFace
+"/ style:currentStyle
+"/ size:currentSize
+"/ sizeUnit:sizeUnit
+"/ encoding:encoding.
+"/
+"/ fontShown notNil ifTrue:[^ fontShown].
+"/
+"/ allFonts := self graphicsDevice
+"/ fontsInFamily:(currentFamily ? '*')
+"/ face:(currentFace ? '*')
+"/ style:(currentStyle ? '*')
+"/ filtering:combinedFilter.
+"/
+"/ sizeUnit == #px ifTrue:[
+"/ fonts := allFonts select:[:f | f pixelSize = currentSize].
+"/ ] ifFalse:[
+"/ fonts := allFonts select:[:f | f size = currentSize].
+"/ ].
+"/ fonts notEmpty ifTrue:[
+"/ fontShown := fonts anElement.
+"/ ] ifFalse:[
+"/ "/ mhmh:
+"/ "/ size=0 is returned for scalable fonts.
+"/ "/ Any size is possible.
+"/ "/
+"/ fonts := allFonts select:[:f | f size = 0].
+"/ fonts notEmpty ifTrue:[
+"/ fontShown := Font family:currentFamily
+"/ face:currentFace
+"/ style:currentStyle
+"/ size:currentSize
+"/ sizeUnit:sizeUnit
+"/ encoding:(fonts anElement encoding).
+"/ ]
+"/ ].
+"/ ^ fontShown
!
getFacesForFamily:aFamilyName filtering:filter
"the list of font faces for a given family"
- ^ self graphicsDevice facesInFamily:aFamilyName filtering:filter.
+ |familyFonts|
+
+ familyFonts := fontsPerFamily at:aFamilyName ifAbsent:nil.
+ familyFonts isEmptyOrNil ifTrue:[^ nil].
+
+ ^ familyFonts
+ select:[:fntDescr |
+ (filter isNil or:[filter value:fntDescr])
+ ]
+ thenCollect:[:fntDescr |
+ fntDescr face.
+ ]
+
+"/ ^ self graphicsDevice facesInFamily:aFamilyName filtering:filter.
!
getFamilyList
"the list of font families"
- ^ self graphicsDevice fontFamiliesFiltering:combinedFilter.
+ |d|
+
+ allFonts := self graphicsDevice listOfAvailableFonts.
+ allFonts isNil ifTrue:[^ nil].
+
+ d := Dictionary new.
+ allFonts do:[:fntDescr |
+ |family|
+
+ (combinedFilter isNil or:[combinedFilter value:fntDescr]) ifTrue:[
+ family := fntDescr family.
+ family isNil ifTrue:[
+ family := font name ? 'unnamed'
+ ].
+ (d at:family ifAbsentPut:[Set new]) add:fntDescr
+ ]
+ ].
+ fontsPerFamily := d.
+ ^ d keys asOrderedCollection sort
+"/
+"/ ^ self graphicsDevice fontFamiliesFiltering:combinedFilter.
!
getSizesInFamily:aFamilyName face:face style:style filtering:filter
- sizeUnit == #px ifTrue:[
- ^ self graphicsDevice
- pixelSizesInFamily:(currentFamily ? '*')
- face:(currentFace ? '*')
- style:(currentStyle ? '*')
- filtering:filter.
- ] ifFalse:[
- ^ self graphicsDevice
- sizesInFamily:(currentFamily ? '*')
- face:(currentFace ? '*')
- style:(currentStyle ? '*')
- filtering:filter.
+ |familyFonts faceAndStyleFonts sizes hasScalableFont|
+
+ familyFonts := fontsPerFamily at:aFamilyName ifAbsent:nil.
+ familyFonts isEmptyOrNil ifTrue:[^ nil].
+
+ hasScalableFont := false.
+
+ faceAndStyleFonts :=
+ familyFonts
+ select:[:fntDescr |
+ (filter isNil or:[filter value:fntDescr])
+ and:[ fntDescr face = face
+ and:[ fntDescr style = style ]]
+ ].
+
+ sizes :=
+ faceAndStyleFonts
+ collect:[:fntDescr |
+ fntDescr isScaledFont ifTrue:[
+ hasScalableFont := true.
+ ].
+ sizeUnit == #px
+ ifTrue:[ fntDescr pixelSize ]
+ ifFalse:[ fntDescr size ]
+ ].
+
+ hasScalableFont ifTrue:[
+ sizeUnit == #px ifTrue:[
+ ^ #(10 16 20 24 28 32 48 56 64 72 80 92 128)
+ ].
+ ^ #(4 5 6 7 8 9 10 11 12 14 16 18 20 22 24 28 32 48 64 72 96 144 192 288)
].
+ (sizes size == 1 and:[sizes first == 0]) ifTrue:[
+ "/ some font may only be available in certain pixel sizes...
+ sizeUnit == #pt ifTrue:[
+ ^ (faceAndStyleFonts collect:[:fontDescr | fontDescr pixelSize]) asOrderedCollection
+ sort collect:[:sz | sz asString , 'px' ].
+ ].
+ ^ (faceAndStyleFonts collect:[:fontDescr | fontDescr size]) asOrderedCollection
+ sort collect:[:sz | sz asString , 'pt' ].
+ ].
+
+ ^ sizes asOrderedCollection sort.
+
+"/ sizeUnit == #px ifTrue:[
+"/ ^ self graphicsDevice
+"/ pixelSizesInFamily:(currentFamily ? '*')
+"/ face:(currentFace ? '*')
+"/ style:(currentStyle ? '*')
+"/ filtering:filter.
+"/ ] ifFalse:[
+"/ ^ self graphicsDevice
+"/ sizesInFamily:(currentFamily ? '*')
+"/ face:(currentFace ? '*')
+"/ style:(currentStyle ? '*')
+"/ filtering:filter.
+"/ ].
!
getStylesInFamily:aFamilyName face:aFace filtering:filter
"the list of font styles for a given family-face"
- ^ self graphicsDevice stylesInFamily:aFamilyName face:aFace filtering:filter.
+ |familyFonts|
+
+ familyFonts := fontsPerFamily at:aFamilyName ifAbsent:nil.
+ familyFonts isEmptyOrNil ifTrue:[^ nil].
+
+ ^ familyFonts
+ select:[:fntDescr |
+ (filter isNil or:[filter value:fntDescr])
+ and:[fntDescr face = aFace]
+ ]
+ thenCollect:[:fntDescr |
+ fntDescr style.
+ ]
+
+"/ ^ self graphicsDevice stylesInFamily:aFamilyName face:aFace filtering:filter.
!
showPreview
@@ -1004,21 +1125,28 @@
currentSize == 0 ifTrue:[
currentSize := oldSize
].
- currentSize notNil ifTrue:[
- (sizes includes:currentSize) ifFalse:[
- sizes add:currentSize
+"/ currentSize notNil ifTrue:[
+"/ (sizes includes:currentSize) ifFalse:[
+"/ sizes add:currentSize
+"/ ].
+"/ ].
+ ].
+ "/ sizes sort.
+
+ sizeStrings := sizes collect:[:entry | entry asString].
+ sizeList list:sizeStrings.
+ currentSize notNil ifTrue:[
+ (sizeStrings includes:(currentSize asString)) ifTrue:[
+ sizeList setSelectElement:currentSize asString.
+ ] ifFalse:[
+ sizeStrings notEmpty ifTrue:[
+ sizeList setSelectElement:sizeStrings first.
+ currentSize := sizeStrings first.
+ ] ifFalse:[
+ currentSize := nil
].
].
].
- sizes sort.
-
- sizeStrings := sizes collect:[:entry | entry printString].
- sizeList list:sizeStrings.
- currentSize notNil ifTrue:[
- (sizeStrings includes:(currentSize printString)) ifTrue:[
- sizeList setSelectElement:currentSize printString.
- ]
- ].
!
xftFontsOnlyChanged
@@ -1250,6 +1378,14 @@
"ok was pressed; hide myself and evaluate the okAction, passing
family, face, style and size as arguments"
+ |sz szUnitUsed|
+
+ szUnitUsed := (sizeUnit ? #pt).
+ sz := Number readFrom:currentSize.
+ (currentSize endsWith:'px') ifTrue:[
+ szUnitUsed := #px
+ ].
+
self hide.
okAction notNil ifTrue:[
currentFamily notNil ifTrue:[
@@ -1260,8 +1396,8 @@
family:currentFamily
face:currentFace
style:currentStyle
- size:currentSize
- sizeUnit:(sizeUnit ? #pt)
+ size:sz
+ sizeUnit:szUnitUsed
encoding:(currentEncoding ? encoding)).
]
]
@@ -1296,11 +1432,10 @@
sizeSelected:aNumberOrString showPreview:showPreview
"a size was selected; update preview"
- aNumberOrString isNumber ifTrue:[
- currentSize := aNumberOrString
- ] ifFalse:[
- currentSize := Number readFromString:aNumberOrString onError:nil
- ].
+ currentSize := aNumberOrString.
+"/ aNumberOrString isNumber ifFalse:[
+"/ currentSize := Number readFromString:aNumberOrString onError:nil
+"/ ].
showPreview ifTrue:[self showPreview]
"Modified: 29.4.1996 / 09:43:23 / cg"
@@ -1319,10 +1454,10 @@
!FontPanel class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libwidg/FontPanel.st,v 1.129 2014-11-26 16:02:19 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libwidg/FontPanel.st,v 1.130 2014-11-26 23:21:40 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libwidg/FontPanel.st,v 1.129 2014-11-26 16:02:19 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libwidg/FontPanel.st,v 1.130 2014-11-26 23:21:40 cg Exp $'
! !