"

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

              All Rights Reserved

this class implements a font chooser

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)

    ]

! !