"
 COPYRIGHT (c) 1991-93 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.
"

ModalBox subclass:#FontPanel
         instanceVariableNames:'previewField familyList faceList sizeList
                                applyButton abortButton
                                revertButton okAction abortAction
                                currentFamily currentFace
                                currentStyle currentFaceAndStyle currentSize'
         classVariableNames:''
         poolDictionaries:''
         category:'Views-Interactors'
!

FontPanel comment:'

COPYRIGHT (c) 1991-93 by Claus Gittinger
              All Rights Reserved

this class implements a font chooser

$Header: /cvs/stx/stx/libwidg/FontPanel.st,v 1.2 1993-10-13 01:02:05 claus Exp $
written fall 91 by claus
'!

!FontPanel class methodsFor:'defaults'!

defaultExtent
    ^ (Display pixelPerMillimeter * (120 @ 100)) rounded
! !

!FontPanel class methodsFor:'startup'!

fontFromUser
    |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:'initializing'!

initialize
    |buttonWidth buttonHeight space2 space3 space4 innerWidth
     familyLabel faceLabel sizeLabel bw|

    super initialize.

    space2 := ViewSpacing * 2.
    space3 := ViewSpacing * 3.
    space4 := ViewSpacing * 4.

    previewField := EditField in:self.
    previewField contents:'The quick brown fox\jumps over the lazy dog\1234567890\!!@#$%^&*(){}[]:"~;,./<>?' withCRs.
    bw := previewField borderWidth.

    innerWidth := width - space2.

    previewField origin:(ViewSpacing @ ViewSpacing)
                 extent:((innerWidth - (2 * bw)) @ (height // 4)).
    previewField origin:(ViewSpacing @ ViewSpacing)
                 extent:[(width - space2 - (2 * bw)) @ (height // 4)].

    familyLabel := Label in:self.
    familyLabel origin:(ViewSpacing
                       @ 
                       (previewField origin y +
                        previewField height +
                        ViewSpacing))
               extent:(((width - space4) // 5 * 2)
                       @
                       (familyLabel height)).
    familyLabel origin:[ViewSpacing
                       @ 
                       (previewField origin y +
                        previewField height +
                        ViewSpacing)]
               extent:[((width - space4) // 5 * 2)
                       @
                       (familyLabel height)].
    familyLabel label:'Family'.

    familyList := ScrollableView for:SelectionInListView in:self.
    familyList origin:(ViewSpacing
                       @ 
                       (familyLabel origin y + familyLabel height + ViewSpacing))
               extent:(((width - space4) // 5 * 2)
                       @
                       (height // 2)).
    familyList origin:[ViewSpacing
                       @ 
                       (familyLabel origin y + familyLabel height + ViewSpacing)]
               extent:[((width - space4) // 5 * 2)
                       @
                       (height // 2)].

    faceLabel := Label in:self.
    faceLabel origin:((familyList origin x +
                      familyList width +
                      ViewSpacing)
                     @
                     (previewField origin y +
                      previewField height +
                      ViewSpacing))
               extent:(((width - space4) // 5 * 2) @
                       (faceLabel height)).
    faceLabel origin:[(familyList origin x +
                      familyList width +
                      ViewSpacing)
                     @
                     (previewField origin y +
                      previewField height +
                      ViewSpacing)]
               extent:[((width - space4) // 5 * 2) @
                       (faceLabel height)].
    faceLabel label:'Typeface'.

    faceList := ScrollableView for:SelectionInListView in:self.
    faceList origin:((faceLabel origin x)
                     @
                     (faceLabel origin y + faceLabel height + ViewSpacing))
               extent:(((width - space4) // 5 * 2) @
                       (height // 2)).
    faceList origin:[(faceLabel origin x)
                     @
                     (faceLabel origin y + faceLabel height + ViewSpacing)]
               extent:[((width - space4) // 5 * 2) @
                       (height // 2)].

    sizeLabel := Label in:self.
    sizeLabel origin:((faceList origin x +
                      faceList width +
                      ViewSpacing)
                     @
                     (previewField origin y +
                      previewField height +
                      ViewSpacing))
               extent:(((width - space4) // 5 - sizeLabel borderWidth) @
                       (sizeLabel height)).
    sizeLabel origin:[(faceList origin x +
                      faceList width +
                      ViewSpacing)
                     @
                     (previewField origin y +
                      previewField height +
                      ViewSpacing)]
               extent:[((width - space4) // 5 - sizeLabel borderWidth) @
                       (sizeLabel height)].
    sizeLabel label:'Size'.

    sizeList := ScrollableView for:SelectionInListView in:self.
    sizeList origin:((sizeLabel origin x)
                     @
                     (sizeLabel origin y + sizeLabel height + ViewSpacing))
               extent:(((width - space4) // 5 - sizeList borderWidth) @
                       (height // 2)).
    sizeList origin:[(sizeLabel origin x)
                     @
                     (sizeLabel origin y + sizeLabel height + ViewSpacing)]
               extent:[((width - space4) // 5 - sizeList borderWidth) @
                       (height // 2)].

    applyButton := Button label:(resources at:'ok')
                      action:[
                                applyButton turnOffWithoutRedraw.
                                self okPressed
                             ]
                          in:self.
    applyButton isReturnButton:true.

    abortButton := Button label:(resources at:'abort')
                         action:[
                                    abortButton turnOffWithoutRedraw.
                                    self abortPressed
                                ]
                          in:self.

    buttonHeight := abortButton height.
    buttonWidth := (width - space3) // 2.
    abortButton extent:(buttonWidth @ buttonHeight).
    abortButton origin:[ViewSpacing @ (height - buttonHeight - space2)]
                extent:[((width - space3) // 2) @ buttonHeight].

    applyButton extent:(buttonWidth @ buttonHeight).
    applyButton origin:[((width + ViewSpacing) // 2) @ (height - buttonHeight - space2)]
             extent:[((width - space3) // 2) @ buttonHeight].

    familyList action:[:lineNr | self familySelected:(familyList selectionValue)].
    faceList action:[:lineNr | self faceSelected:(faceList selectionValue)].
    sizeList action:[:lineNr | self sizeSelected:(sizeList selectionValue)].

    familyList list:(device fontFamilies asOrderedCollection)

    "FontPanel new showAtPointer"
!

realize
    "kludge for sco - xlsfont fails sometimes - try again here"
    familyList list isNil ifTrue:[familyList list:(device fontFamilies)].
    super realize


! !

!FontPanel methodsFor:'user interaction'!

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

abortPressed
    self hide

!

familySelected:aFamilyName
    |faces styles list|

    familyList selectElement:aFamilyName.

    list := Text new.
    currentFamily := aFamilyName.
    faces := device facesInFamily:aFamilyName.
    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|

    sizes := Text new.
    self extractFaceAndStyleFrom:aFaceAndStyleName.
    sizes := device sizesInFamily:currentFamily face:currentFace style:currentStyle.
    sizes := sizes asOrderedCollection.
    sizes sort.
    sizeList list:sizes.
    currentSize notNil ifTrue:[
        (sizes includes:(currentSize printString)) ifTrue:[
            sizeList selectElement:currentSize.
            self showPreview
        ]
    ]
!

sizeSelected:aNumberOrString
    (aNumberOrString isKindOf:Number) ifTrue:[
        currentSize := aNumberOrString
    ] ifFalse:[
        currentSize := Number readFromString:aNumberOrString
    ].
    self showPreview
! !

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

showPreview
    previewField font:(Font family:currentFamily
                              face:currentFace
                             style:currentStyle
                              size:currentSize)
!

extractFaceAndStyleFrom:aString
    |index|

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

! !