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

    usage:

	|panel|

	panel := FontPanel new.
	panel action:[:aFont | Transcript showCR:'the font is' , aFont printString].
	panel show

    or simply:

	font := FontPanel fontFromUser
"

! !

!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
    ^ ('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: 23.2.1996 / 23:33:37 / cg"
!

defaultRomanSampleString
    ^ '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: 24.2.1996 / 22:45:16 / 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 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: 27.2.1996 / 01:00:03 / cg"
!

fontFromUserInitial:aFont title:someTitle
    "open a fontPanel 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: 27.2.1996 / 01:00:12 / cg"
!

fontFromUserInitial:aFont title:someTitle filter:aFilterBlock
    "open a fontPanel and return the selected font, or nil
     if abort is pressed"

    |fontPanel|

    fontPanel := FontPanel new.
    fontPanel filter:aFilterBlock.
    someTitle notNil ifTrue:[
        fontPanel label:someTitle
    ].
    fontPanel action:[:family :face :style :size |
        ^ (Font family:family
                  face:face
                  style:style
                   size:size)
    ].
    aFont notNil ifTrue:[
        fontPanel initialFont:aFont.
    ].

    fontPanel showAtPointer.
    ^ nil

    "
     FontPanel fontFromUserInitial:(Font family:'courier' size:12) title:'select some font'
    "

    "Created: 27.2.1996 / 00:59:46 / cg"
    "Modified: 27.2.1996 / 01:00:12 / cg"
! !

!FontPanel methodsFor:'accessing'!

action:aBlock
    okAction := aBlock
!

encoding:aPattern
    encoding := aPattern.
    shown ifTrue:[
        self updateFamilyList
    ].

    "Modified: 27.2.1996 / 01:41:33 / cg"
    "Created: 29.2.1996 / 04:05:31 / cg"
!

filter:aOneArgBlock
    filter := aOneArgBlock.
    shown ifTrue:[
        self updateFamilyList
    ].

    "Created: 27.2.1996 / 01:40:08 / cg"
    "Modified: 27.2.1996 / 01:41:33 / 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'!

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
!

initialize
    |familyLabel faceLabel sizeLabel panel fontBrowserView v1 v2 v3
     mm fH eH|

    super initialize.

    mm := ViewSpacing.

    self addAbortButton.
    self addOkButton.

    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.

    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.

    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.

    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: 23.2.1996 / 23:36:01 / cg"
!

realize
    "kludge for sco - xlsfont fails sometimes - try again here"

    self updateFamilyList.
    super realize

    "Modified: 27.2.1996 / 01:40:47 / 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
    shown ifTrue:[
        previewField clear.
        encodingLabel label:''.
    ].

    "Created: 17.4.1996 / 15:19:16 / cg"
    "Modified: 17.4.1996 / 15:20:56 / cg"
!

extractFaceAndStyleFrom:aString
    |index|

    index := aString indexOf:$-.
    (index ~~ 0) ifTrue:[
	currentFaceAndStyle := aString.
	currentFace := aString copyTo:(index - 1).
	currentStyle := aString copyFrom:(index + 1)
    ]

!

showPreview
    |f enc s all fonts scalable|

    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: 17.4.1996 / 15:19:29 / 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
    "compute the boxes preferredExtent"

    ^ 400@350

    "Modified: 23.4.1996 / 00:14:40 / cg"
! !

!FontPanel methodsFor:'user interaction'!

faceSelected:aFaceAndStyleName
    |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 selectElement:currentSize.
            self showPreview
        ]
    ]

    "Modified: 17.4.1996 / 15:20:20 / cg"
!

familySelected:aFamilyName
    |faces styles list|

    familyList selectElement: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 selectElement:currentFaceAndStyle.
            self faceSelected:currentFaceAndStyle.
            ^ self
        ]
    ].
    sizeList list:nil.
    self clearPreview.

    "Modified: 17.4.1996 / 15:20:04 / cg"
!

okPressed
    self hide.
    okAction notNil ifTrue:[
        currentFamily notNil ifTrue:[
            okAction value:currentFamily
                 value:currentFace
                 value:currentStyle
                 value:currentSize
        ]
    ]

    "Modified: 27.2.1996 / 00:50:19 / cg"
!

sizeSelected:aNumberOrString
    aNumberOrString isNumber ifTrue:[
	currentSize := aNumberOrString
    ] ifFalse:[
	currentSize := Number readFromString:aNumberOrString
    ].
    self showPreview
! !

!FontPanel class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libwidg/FontPanel.st,v 1.31 1996-04-22 22:20:22 cg Exp $'
! !