diff -r 2a930154be83 -r b313547fe799 FontPanel.st --- 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 $' ! !