.
"
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.
"
'From Smalltalk/X, Version:2.10.4 on 28-dec-1994 at 9:11:51 pm'!
DialogBox subclass:#FontPanel
instanceVariableNames:'previewField familyList faceList sizeList revertButton
currentFamily currentFace currentStyle currentFaceAndStyle
currentSize selectedFont'
classVariableNames:''
poolDictionaries:''
category:'Views-DialogBoxes'
!
!FontPanel class methodsFor:'documentation'!
version
"
$Header: /cvs/stx/stx/libwidg/FontPanel.st,v 1.12 1995-06-27 02:23:01 claus Exp $
"
!
documentation
"
this class implements a font chooser.
usage:
|panel|
panel := FontPanel new.
panel action:[:aFont | Transcript showCR:'the font is' , aFont printString].
panel show
or simply:
font := FontPanel fontFromUser
"
!
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.
"
! !
!FontPanel class methodsFor:'defaults'!
defaultSampleString
^ 'The quick brown fox
jumps over the lazy dog
1234567890
!!@#$%^&*(){}[]:"~;,./<>?
' ,
(Character value:16rE4) asString ,
(Character value:16rF6) asString ,
(Character value:16rFC) asString ,
(Character value:16rC4) asString ,
(Character value:16rD6) asString ,
(Character value:16rDC) asString ,
(Character value:16rDF) asString
!
defaultExtent
^ (Screen current pixelPerMillimeter * (120 @ 100)) rounded
! !
!FontPanel class methodsFor:'startup'!
fontFromUser
"open a fontPanel and return the selected font, or nil
if abort is pressed"
|fontPanel|
fontPanel := FontPanel new.
fontPanel action:[:family :face :style :size |
^ (Font family:family
face:face
style:style
size:size)
].
fontPanel showAtPointer.
^ nil
"
FontPanel fontFromUser
"
! !
!FontPanel methodsFor:'accessing'!
initialFont:aFont
"set the font to be selected initially"
selectedFont := aFont.
self showSelectedFont
!
action:aBlock
okAction := aBlock
! !
!FontPanel methodsFor:'queries'!
preferredExtent
^ 400@350
! !
!FontPanel methodsFor:'initialization'!
realize
"kludge for sco - xlsfont fails sometimes - try again here"
|families|
familyList list isNil ifTrue:[
families := device fontFamilies.
families notNil ifTrue:[
families := families asOrderedCollection
].
familyList list:families
].
selectedFont notNil ifTrue:[
self showSelectedFont
].
super realize
!
initialize
|familyLabel faceLabel sizeLabel panel fontBrowserView v1 v2 v3|
super initialize.
self addAbortButton.
self addOkButton.
panel := View origin:0.0@0.0 corner:1.0@1.0
in:self.
panel bottomInset:(buttonPanel preferredExtent y + (ViewSpacing*3)).
label := 'Font dialog'.
previewField := TextView origin:0.0@0.0 corner:1.0@0.3 in:panel.
previewField inset:ViewSpacing.
previewField contents:self class defaultSampleString.
self is3D ifTrue:[
previewField level:-1.
] ifFalse:[
previewField borderWidth:1.
].
fontBrowserView := View origin:0.0@0.3 corner:1.0@1.0 in:panel.
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).
familyList := ScrollableView for:SelectionInListView in:v1.
familyList origin:(0.0
@
(familyLabel origin y + familyLabel height "+ ViewSpacing"))
corner:(1.0 @ 1.0).
familyList inset:ViewSpacing.
familyList := familyList scrolledView.
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
@
(faceLabel origin y + faceLabel height "+ ViewSpacing"))
corner:(1.0 @ 1.0).
faceList inset:ViewSpacing.
faceList := faceList scrolledView.
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
@
(sizeLabel origin y + sizeLabel height "+ ViewSpacing"))
corner:(1.0 @ 1.0).
sizeList inset:ViewSpacing.
sizeList := sizeList scrolledView.
familyList action:[:lineNr | self familySelected:(familyList selectionValue)].
faceList action:[:lineNr | self faceSelected:(faceList selectionValue)].
sizeList action:[:lineNr | self sizeSelected:(sizeList selectionValue)].
"
FontPanel new showAtPointer
"
!
focusSequence
|a|
a := Array new:5.
a at:1 put:familyList.
a at:2 put:faceList.
a at:3 put:sizeList.
a at:4 put:abortButton.
a at:5 put:okButton.
^ a
! !
!FontPanel methodsFor:'private'!
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
]
]
]
]
!
showPreview
shown ifTrue:[
previewField clear.
].
"
show a wait cursor: for some fonts (kanji etc) the
X-server needs quites some time to load the font
"
self withCursor:Cursor wait do:[
previewField font:(Font family:currentFamily
face:currentFace
style:currentStyle
size:currentSize).
previewField contents:self class defaultSampleString.
]
!
extractFaceAndStyleFrom:aString
|index|
index := aString indexOf:$-.
(index ~~ 0) ifTrue:[
currentFaceAndStyle := aString.
currentFace := aString copyTo:(index - 1).
currentStyle := aString copyFrom:(index + 1)
]
! !
!FontPanel methodsFor:'user interaction'!
familySelected:aFamilyName
|faces styles list|
familyList selectElement:aFamilyName.
currentFamily := aFamilyName.
faces := device facesInFamily:aFamilyName.
(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.
styles do:[:aStyle |
list add:(aFace , '-' , aStyle)
]
].
faceList list:list.
currentFaceAndStyle notNil ifTrue:[
(list includes:currentFaceAndStyle) ifTrue:[
faceList selectElement:currentFaceAndStyle.
self faceSelected:currentFaceAndStyle.
^ self
]
].
sizeList list:nil
!
faceSelected:aFaceAndStyleName
|sizes|
aFaceAndStyleName notNil ifTrue:[
self extractFaceAndStyleFrom:aFaceAndStyleName.
].
sizes := device
sizesInFamily:currentFamily
face:currentFace
style:currentStyle.
(sizes isNil or:[sizes isEmpty]) ifTrue:[
sizeList list:nil.
currentSize := nil.
self showPreview.
^ self
].
sizes := sizes asOrderedCollection sort.
sizeList list:sizes.
currentSize notNil ifTrue:[
(sizes includes:(currentSize printString)) ifTrue:[
sizeList selectElement:currentSize.
self showPreview
]
]
!
okPressed
self hide.
okAction notNil ifTrue:[
okAction value:currentFamily
value:currentFace
value:currentStyle
value:currentSize
]
!
sizeSelected:aNumberOrString
aNumberOrString isNumber ifTrue:[
currentSize := aNumberOrString
] ifFalse:[
currentSize := Number readFromString:aNumberOrString
].
self showPreview
! !