"

 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.

"

"{ Package: 'stx:libwidg' }"

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"

    |t|

    Smalltalk language == #de ifTrue:[

        t := 'Franz jagt im komplett verwahrlosten Taxi

quer durch Bayern'.

    ] ifFalse:[

        t := 'The quick brown fox

jumps over the lazy dog'.

    ].

    t := t , '

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

    ^ t

    "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).

            ]    

        ].