"
 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.8 1995-03-09 02:11:38 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'!

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:'The quick brown fox\jumps over the lazy dog\1234567890\!!@#$%^&*(){}[]:"~;,./<>?' withCRs.
    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:'The quick brown fox\jumps over the lazy dog\1234567890\!!@#$%^&*(){}[]:"~;,./<>?' withCRs.
    ]
!

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