"

 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'

	 classVariableNames:''

	 poolDictionaries:''

	 category:'Views-DialogBoxes'

!

!FontPanel class methodsFor:'documentation'!

version

"

$Header: /cvs/stx/stx/libwidg/FontPanel.st,v 1.9 1995-03-25 22:20:15 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

    ^ (Display 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

    |family face style size|

    family := aFont family.

    face := aFont face.

    style := aFont style.

    size := aFont size.

    family notNil ifTrue:[

	self familySelected:family.

	face notNil ifTrue:[

	    style notNil ifTrue:[

		self faceSelected:(face , '-' , style).

		size notNil ifTrue:[

		    self sizeSelected:size

		]

	    ]

	]

    ]

!

action:aBlock

    okAction := aBlock

! !

!FontPanel methodsFor:'queries'!

preferedExtent

    ^ 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

    ].

    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 preferedExtent 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.

    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.

    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.

    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'!

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

! !