"
COPYRIGHT (c) 1991 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.
"
DialogBox subclass:#FontPanel
instanceVariableNames:'previewField familyList faceList sizeList revertButton
currentFamily currentFace currentStyle currentFaceAndStyle
currentSize selectedFont nameLabel encodingLabel filter encoding'
classVariableNames:''
poolDictionaries:''
category:'Views-DialogBoxes'
!
!FontPanel class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1991 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.
"
!
documentation
"
this class implements a font chooser.
[author:]
Claus Gittinger
[see also:]
Font FontDescription
View Dialog
"
!
examples
"
very simple:
[exBegin]
|font|
font := FontPanel fontFromUser.
Transcript showCR:font
[exEnd]
with initial font:
[exBegin]
|font|
font := FontPanel
fontFromUserInitial:(Font
family:'courier'
size:12).
Transcript showCR:font
[exEnd]
with initial font & title:
[exBegin]
|font|
font := FontPanel
fontFromUserInitial:(Font
family:'courier'
size:12)
title:'select a fooBar font'.
Transcript showCR:font
[exEnd]
full setup; setting a filter to only present iso fonts
and callBack action:
[exBegin]
|panel|
panel := FontPanel new.
panel label:'hi there - which iso font ?'.
panel filter:[:fd | fd encoding notNil
and:[fd encoding startsWith:'iso']].
panel action:[:family :face :style :size |
Transcript showCR:'family:' , family.
Transcript showCR:'face:' , face.
Transcript showCR:'style:' , style.
Transcript showCR:'size:' , size printString.
].
panel open
[exEnd]
"
! !
!FontPanel class methodsFor:'defaults'!
defaultExtent
"return the default extent of my instances.
The value returned here is usually ignored, and
the value from preferredExtent taken instead."
^ (Screen current pixelPerMillimeter * (120 @ 100)) rounded
"Modified: 22.4.1996 / 23:36:19 / cg"
!
defaultJISSampleString
"return the sample jis preview text"
^ ('The quick brown fox
jumps over the lazy dog
1234567890
!!@#$%^&*(){}[]:"~;,./<>?
\e$B$$$i$C$7$c$$$^$;\e(J \e$B@$4V\e(J
' withEscapes decodeFrom:#jis7)
"Modified: 29.4.1996 / 09:46:11 / cg"
!
defaultRomanSampleString
"return the sample roman preview text"
^ 'The quick brown fox
jumps over the lazy dog
1234567890
!!@#$%^&*(){}[]:"~;,./<>?
' ,
(Character value:16rE4) asString , "/ umlaut a
(Character value:16rF6) asString , "/ umlaut o
(Character value:16rFC) asString , "/ umlaut u
(Character value:16rC4) asString , "/ umlaut A
(Character value:16rD6) asString , "/ umlaut O
(Character value:16rDC) asString , "/ umlaut U
(Character value:16rDF) asString , "/ sz
(Character value:233) asString , "/ e-degu
(Character value:232) asString , "/ e-grave
(Character value:234) asString , "/ e-circonflex
(Character value:197) asString , "/ A
(Character value:169) asString "/ copyright
"Modified: 29.4.1996 / 09:46:19 / cg"
! !
!FontPanel class methodsFor:'startup'!
fontFromUser
"open a fontPanel and return the selected font, or nil
if abort is pressed"
^ self fontFromUserInitial:nil
"
FontPanel fontFromUser
"
"Modified: 27.2.1996 / 00:51:59 / cg"
!
fontFromUserInitial:aFont
"open a fontPanel showing aFont initially,
and return the selected font, or nil if abort is pressed"
^ self fontFromUserInitial:aFont title:nil
"
FontPanel fontFromUserInitial:(Font family:'courier' size:12)
"
"Created: 27.2.1996 / 00:51:44 / cg"
"Modified: 29.4.1996 / 09:45:52 / cg"
!
fontFromUserInitial:aFont title:someTitle
"open a fontPanel with title and return the selected font,
or nil if abort is pressed"
^ self fontFromUserInitial:aFont title:someTitle filter:nil
"
FontPanel fontFromUserInitial:(Font family:'courier' size:12) title:'select some font'
"
"Created: 27.2.1996 / 00:59:46 / cg"
"Modified: 29.4.1996 / 09:45:34 / cg"
!
fontFromUserInitial:aFont title:someTitle filter:aFilterBlock
"open a fontPanel with title and font-filter
and return the selected font, or nil if abort is pressed"
|fontPanel selectedFont|
fontPanel := FontPanel new.
fontPanel filter:aFilterBlock.
someTitle notNil ifTrue:[
fontPanel label:someTitle
].
fontPanel action:[:aFontDescription | selectedFont := aFontDescription].
aFont notNil ifTrue:[
fontPanel initialFont:aFont.
].
fontPanel showAtPointer.
fontPanel destroy.
^ selectedFont
"
FontPanel fontFromUserInitial:(Font family:'courier' size:12) title:'select some font'
"
"Created: 27.2.1996 / 00:59:46 / cg"
"Modified: 10.4.1997 / 09:53:03 / cg"
! !
!FontPanel methodsFor:'accessing'!
action:aFourArgBlock
"set the action to be evaluated on ok.
The block will be evaluated with family, face, style, size and encoding."
okAction := aFourArgBlock
"Modified: 10.4.1997 / 09:49:58 / cg"
!
encoding:aPattern
"set the encoding goal"
encoding := aPattern.
shown ifTrue:[
self updateFamilyList
].
"Created: 29.2.1996 / 04:05:31 / cg"
"Modified: 29.4.1996 / 09:40:18 / cg"
!
filter:aOneArgBlock
"set a filter; if non-nil, only fonts for which the filterBlock
returns true will be offered"
filter := aOneArgBlock.
shown ifTrue:[
self updateFamilyList
].
"Created: 27.2.1996 / 01:40:08 / cg"
"Modified: 29.4.1996 / 09:40:49 / cg"
!
initialFont:aFont
"set the font to be selected initially"
selectedFont := aFont.
self showSelectedFont.
self showPreview
"Modified: 23.2.1996 / 00:51:32 / cg"
! !
!FontPanel methodsFor:'initialization'!
initialize
|familyLabel faceLabel sizeLabel panel fontBrowserView v1 v2 v3
mm fH eH|
super initialize.
mm := ViewSpacing.
self addAbortAndOkButtons.
panel := View origin:0.0@0.0 corner:1.0@1.0 in:self.
panel bottomInset:(buttonPanel preferredExtent y + (mm*3)).
label := resources string:'Font dialog'.
encodingLabel := Label label:' ' in:panel.
eH := encodingLabel preferredExtent y.
encodingLabel origin:0.7@1.0 corner:1.0@1.0.
encodingLabel topInset:(eH negated); horizontalInset:mm.
encodingLabel level:-1; adjust:#left.
"/ nameLabel := Label label:' ' in:panel.
"/ nameLabel origin:0.0@1.0 corner:0.7@1.0.
"/ nameLabel topInset:(eH negated); horizontalInset:mm.
"/ nameLabel level:-1; adjust:#left.
previewField := TextView origin:0.0@0.0 corner:1.0@0.4 in:panel.
previewField inset:mm.
"/ previewField contents:self class defaultSampleString.
self is3D ifTrue:[
previewField level:-1.
] ifFalse:[
previewField borderWidth:1.
].
fontBrowserView := View origin:0.0@0.4 corner:1.0@1.0 in:panel.
fontBrowserView bottomInset:(eH + mm).
v1 := View origin:0.0@0.0 corner:0.4@1.0 in:fontBrowserView.
familyLabel := Label label:'Family' in:v1.
familyLabel borderWidth:0.
familyLabel origin:(0.0 @ 0.0) extent:(1.0 @ nil).
fH := familyLabel preferredExtent y.
familyList := ScrollableView for:SelectionInListView in:v1.
familyList origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
familyList inset:mm.
familyList topInset:fH.
familyList := familyList scrolledView.
self makeTabable:familyList.
v2 := View origin:0.4@0.0 corner:0.8@1.0
in:fontBrowserView.
faceLabel := Label label:'Typeface' in:v2.
faceLabel borderWidth:0.
faceLabel origin:(0.0 @ 0.0) extent:(1.0 @ nil).
faceList := ScrollableView for:SelectionInListView in:v2.
faceList origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
faceList inset:mm.
faceList topInset:fH.
faceList := faceList scrolledView.
self makeTabable:faceList.
v3 := View origin:0.8@0.0 corner:1.0@1.0
in:fontBrowserView.
sizeLabel := Label label:'Size' in:v3.
sizeLabel borderWidth:0.
sizeLabel origin:(0.0 @ 0.0)extent:(1.0 @ nil).
sizeList := ScrollableView for:SelectionInListView in:v3.
sizeList origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
sizeList inset:mm.
sizeList topInset:fH.
sizeList := sizeList scrolledView.
self makeTabable:sizeList.
familyList action:[:lineNr | self familySelected:(familyList selectionValue)].
faceList action:[:lineNr | self faceSelected:(faceList selectionValue)].
sizeList action:[:lineNr | self sizeSelected:(sizeList selectionValue)].
"
FontPanel new showAtPointer
"
"Modified: 31.5.1996 / 22:01:45 / cg"
!
postRealize
"kludge for sco - xlsfont fails sometimes - try again here"
self updateFamilyList.
super postRealize
"Modified: 27.2.1996 / 01:40:47 / cg"
"Created: 24.7.1997 / 18:12:42 / cg"
!
updateFamilyList
"kludge for sco - xlsfont fails sometimes - try again here"
|families|
familyList list isNil ifTrue:[
families := device fontFamiliesFiltering:filter.
families notNil ifTrue:[
families := families asOrderedCollection
].
familyList list:families
].
selectedFont notNil ifTrue:[
self showSelectedFont
].
"Modified: 27.2.1996 / 01:39:42 / cg"
"Created: 27.2.1996 / 01:40:37 / cg"
! !
!FontPanel methodsFor:'private'!
clearPreview
"clear the preview subview"
shown ifTrue:[
previewField contents:nil.
encodingLabel label:''.
].
"Created: 17.4.1996 / 15:19:16 / cg"
"Modified: 11.8.1997 / 03:01:42 / cg"
!
extractFaceAndStyleFrom:aString
"given a string, extract currentFace and currentStyle"
|index|
index := aString indexOf:$-.
(index ~~ 0) ifTrue:[
currentFaceAndStyle := aString.
currentFace := aString copyTo:(index - 1).
currentStyle := aString copyFrom:(index + 1)
]
"Modified: 29.4.1996 / 09:41:47 / cg"
!
showPreview
"show the preview text"
|f enc s all fonts|
self clearPreview.
"
show a wait cursor: for some fonts (kanji etc) the
X-server needs quites some time to load the font
"
self withWaitCursorDo:[
all := fonts := device
fontsInFamily:(currentFamily ? '*')
face:(currentFace ? '*')
style:(currentStyle ? '*')
filtering:filter.
fonts := fonts select:[:f | f size == currentSize].
fonts notEmpty ifTrue:[
f := fonts anElement.
] ifFalse:[
"/ mhmh
"/ X returns size0 for scalable fonts. Any size is possible.
"/
fonts := all select:[:f | f size == 0].
fonts notEmpty ifTrue:[
f := Font family:currentFamily
face:currentFace
style:currentStyle
size:currentSize
encoding:(fonts anElement encoding).
] ifFalse:[
^ self
]
].
f := f on:device.
previewField font:f.
enc := f encoding.
enc isNil ifTrue:[enc := 'ascii ?'].
encodingLabel label:enc.
nameLabel notNil ifTrue:[nameLabel label:(f fullName)].
(enc notNil and:[enc startsWith:'jis']) ifTrue:[
s := self class defaultJISSampleString
] ifFalse:[
s := self class defaultRomanSampleString.
].
previewField contents:s.
]
"Modified: 30.6.1997 / 17:26:22 / cg"
!
showSelectedFont
|fam face style sz|
fam := selectedFont family.
fam notNil ifTrue:[
self familySelected:fam.
face := selectedFont face.
face notNil ifTrue:[
style := selectedFont style.
style notNil ifTrue:[
self faceSelected:(face , '-' , style).
sz := selectedFont size.
sz notNil ifTrue:[
self sizeSelected:sz
]
]
]
]
! !
!FontPanel methodsFor:'queries'!
preferredExtent
"return the boxes preferredExtent"
"/ If I have an explicit preferredExtent ..
preferredExtent notNil ifTrue:[
^ preferredExtent
].
^ 400@350
"Modified: 19.7.1996 / 20:44:08 / cg"
! !
!FontPanel methodsFor:'user interaction'!
faceSelected:aFaceAndStyleName
"a fonts face was seleted; find available sizes and update lists"
|sizes|
aFaceAndStyleName notNil ifTrue:[
self extractFaceAndStyleFrom:aFaceAndStyleName.
].
sizes := device
sizesInFamily:(currentFamily ? '*')
face:(currentFace ? '*')
style:(currentStyle ? '*')
filtering:filter.
(sizes isNil or:[sizes isEmpty]) ifTrue:[
sizeList list:nil.
currentSize := nil.
self showPreview.
^ self
].
self clearPreview.
sizes := (sizes asOrderedCollection sort) collect:[:entry | entry printString].
sizeList list:sizes.
currentSize notNil ifTrue:[
(sizes includes:(currentSize printString)) ifTrue:[
sizeList setSelectElement:currentSize.
self showPreview
]
]
"Modified: 30.6.1997 / 17:25:46 / cg"
!
familySelected:aFamilyName
"a fonts family was seleted; find available faces and update lists"
|faces styles list|
familyList setSelectElement:aFamilyName.
currentFamily := aFamilyName.
faces := device facesInFamily:aFamilyName filtering:filter.
(faces isNil or:[faces isEmpty]) ifTrue:[
currentFace := currentStyle := currentFaceAndStyle := nil.
faceList list:nil.
self faceSelected:nil.
^ self.
].
list := OrderedCollection new.
faces do:[:aFace |
styles := device stylesInFamily:aFamilyName face:aFace filtering:filter.
styles do:[:aStyle |
list add:(aFace , '-' , aStyle)
]
].
faceList list:list.
currentFaceAndStyle notNil ifTrue:[
(list includes:currentFaceAndStyle) ifTrue:[
faceList setSelectElement:currentFaceAndStyle.
self faceSelected:currentFaceAndStyle.
^ self
]
].
sizeList list:nil.
self clearPreview.
"Modified: 26.5.1996 / 15:04:29 / cg"
!
okPressed
"ok was pressed; hide myself and evaluate the okAction, passing
family, face, style and size as arguments"
self hide.
okAction notNil ifTrue:[
currentFamily notNil ifTrue:[
okAction value:(FontDescription
family:currentFamily
face:currentFace
style:currentStyle
size:currentSize
encoding:encoding).
"/ okAction
"/ value:currentFamily
"/ value:currentFace
"/ value:currentStyle
"/ value:currentSize
]
]
"Modified: 10.4.1997 / 09:51:31 / cg"
!
sizeSelected:aNumberOrString
"a size was seleted; update preview"
aNumberOrString isNumber ifTrue:[
currentSize := aNumberOrString
] ifFalse:[
currentSize := Number readFromString:aNumberOrString
].
self showPreview
"Modified: 29.4.1996 / 09:43:23 / cg"
! !
!FontPanel class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libwidg/FontPanel.st,v 1.44 1999-03-06 02:14:14 cg Exp $'
! !