"

 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 listOfEncodings familyList faceList sizeList

		revertButton currentFamily currentFace currentStyle

		currentFaceAndStyle currentSize currentEncoding selectedFont

		nameLabel encodingFilter 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.

    Notice: 

        this is a very old dialog; 

        it was written before the UI-framework was available and is completely

        setup manually (initialize method).

        Therefore, it desperately asks to be rewritten using the UIPainter...

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

defaultAsciiSampleString

    ^ (self sampleStringWithAllLetters) , '

ABCDEFGHIJKLMNOPQRSTUVWXYZ

abcdefghijklmnopqrstuvwxyz

1234567890    !!@#$%^&*(){}[]:"~;,./<>?

'

!

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 * (150 @ 100)) rounded

    "Modified: 22.4.1996 / 23:36:19 / cg"

!

defaultJIS0201SampleString

    "return the sample jis preview text"

    ^ (self defaultLatin1SampleString).

!

defaultJISSampleString

    "return the sample jis preview text"

    ^ 

'The quick brown fox

jumps over the lazy dog.

' , #(16r65E5 16r672C 16r8A9E) asUnicodeString

!

defaultLatin1SampleString

    "return the sample latin1 preview text"

    ^ (self defaultAsciiSampleString) , 'äöüÄÖÜßéèêå©'

!

defaultSampleStringForEncoding:enc

    |string lines|

    enc notNil ifTrue:[    

        ((enc startsWith:'unicode') or:[enc startsWith:'iso10646-']) ifTrue:[

            ^ self defaultUnicodeSampleString.

        ].

        (enc startsWith:'ms-ansi') ifTrue:[

            ^ self defaultUnicodeSampleString.

        ].

        (enc startsWith:'jis') ifTrue:[

            (enc includesString:'0201') ifTrue:[

                string := self defaultJIS0201SampleString    

            ] ifFalse:[

                string := self defaultJISSampleString

            ]

        ] ifFalse:[

        ]

    ].

    string isNil ifTrue:[

        string := self defaultLatin1SampleString.

    ].

    lines := string asStringCollection.

    Error handle:[:ex |

    ] do:[

        lines := lines encodeFrom:#unicode into:enc

    ].

    ^ lines.

!

defaultUnicodeSampleString

    "return the sample unicode preview text"

    |t|

    t := (self defaultAsciiSampleString) , '

diaresis: äöüÄÖÜß

accent: éèêåÅ

cyrillic: ' , 

#(16r440 16r443 16r441 16r441 16r43A 16r438 16r439 16r20 16r44F 16r437 16r44B 16r43A) asUnicodeString , '

greek: ' ,

#(16r395 16r3BB 16r3BB 16r3B7 16r3BD 16r3B9 16r3BA 16r3AC) asUnicodeString ,

'

japanese: ' ,

#(16r65E5 16r672C 16r8A9E) asUnicodeString ,

'

'.

    ^ t

    "Modified: 29.4.1996 / 09:46:19 / cg"

!

sampleStringWithAllLetters

    ^ (self classResources at:'CHARSET_TEST_SENTENCE' ifAbsent:'The quick brown fox jumps over the lazy dog') withCRs

! !

!FontPanel class methodsFor:'menu specs'!

previewMenu

    "This resource specification was automatically generated

     by the MenuEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the MenuEditor may not be able to read the specification."

    "

     MenuEditor new openOnClass:FontPanel andSelector:#previewMenu

     (Menu new fromLiteralArrayEncoding:(FontPanel previewMenu)) startUp

    "

    <resource: #menu>

    ^ 

     #(Menu

        (

         (MenuItem

            label: 'Copy'

            itemValue: previewCopySelection

            translateLabel: true

          )

         (MenuItem

            label: '-'

          )

         (MenuItem

            label: 'Show Character Set'

            itemValue: previewShowCharacterSet

            translateLabel: true

          )

         (MenuItem

            label: 'Show Character Set (Using xfd)'

            itemValue: previewShowCharacterSetUsingXFD

            translateLabel: true

            isVisible: false

          )

         (MenuItem

            label: '-'

          )

         (MenuItem

            label: 'Inspect Font'

            itemValue: previewInspectFont

            translateLabel: true

          )

         )

        nil

        nil

      )

! !

!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:initialFont title:someTitle filter:aFilterBlock

    "open a fontPanel with title and font-filter

     and return the selected font, or nil if abort is pressed"

    ^ self fontFromUserInitial:initialFont title:someTitle filter:aFilterBlock encoding:nil

    "

     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"

!

fontFromUserInitial:initialFont title:someTitle filter:aFilterBlock encoding:encoding

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

    initialFont notNil ifTrue:[

        fontPanel initialFont:initialFont.

    ].

    encoding notNil ifTrue:[

        fontPanel encoding:encoding.

    ] ifFalse:[

        initialFont notNil ifTrue:[

            fontPanel encoding:initialFont encoding

        ].

    ].

    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.

    encodingFilter contents:encoding.

    self encodingFilterSelected:encoding.

    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.

    familyList list:nil.

    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"

    |encoding|

    selectedFont := aFont.

    encoding := aFont encoding.    

"/ self halt.

    encodingFilter contents:encoding.

    self encodingFilterSelected:encoding.

    self showSelectedFont.

    "Modified: 23.2.1996 / 00:51:32 / cg"

! !

!FontPanel methodsFor:'initialization'!

initialize

    |familyLabel faceLabel sizeLabel panel fontBrowserView v1 v2 v3

     mm fH eH l box showFontNameLabel|

    super initialize.

    showFontNameLabel := device platformName ~= 'WIN32'.

    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) 

                        + (showFontNameLabel ifTrue:24 ifFalse:0) ).

    label := resources string:'Font dialog'.

    box := HorizontalPanelView in:panel.

    box horizontalLayout:#leftFit.

    box origin:0.0@1.0 corner:0.6@1.0.

    l := Label label:(resources string:'Encoding:') in:box.

    l borderWidth:0.

    l adjust:#left.

    encodingFilter := ComboBoxView in:box.

    "/ encodingFilter font:l font.

    encodingFilter level:-1.

    encodingFilter contents:'*'.

    encodingFilter list:(self listOfEncodingsInFilterCombo).

    encodingFilter action:[:pattern | self encodingFilterSelected:pattern].

    encodingFilter immediateAccept:true.

    "/ encodingFilter editor font:l font.

    eH := encodingFilter preferredExtent y.

    box topInset:(eH negated-4); horizontalInset:mm.

"/    encodingFilter acceptOnReturn:true.

"/    encodingFilter acceptOnTab:true.

"/    encodingFilter acceptOnLeave:true.

"/    encodingFilter acceptOnLostFocus:true.

"/    encodingFilter acceptOnPointerLeave:true.

    encodingLabel := Label label:' ' in:panel.

    "/ eH := encodingLabel preferredExtent y.

    encodingLabel origin:0.6@1.0 corner:1.0@1.0.

    encodingLabel topInset:(eH negated); horizontalInset:mm.

    encodingLabel level:0; adjust:#left.

    encodingLabel adjust:#right.

    showFontNameLabel ifTrue:[

        nameLabel := Label label:'' in:self.

        nameLabel origin:0.0@1.0 corner:1.0@1.0.

        nameLabel bottomInset:(buttonPanel preferredExtent y + (mm*2)).

        nameLabel topInset:(buttonPanel preferredExtent y + (mm*2) + 24) negated; horizontalInset:mm.

        nameLabel level:0; adjust:#left.

        nameLabel font:(FontDescription family:'helvetica' face:'medium' style:'roman' size:9).

    ].

    previewField := HVScrollableView for:TextView in:panel.

    previewField origin:0.0@0.0 corner:1.0@0.4.

    previewField autoHideScrollBars:true.

    previewField := previewField scrolledView.

    previewField inset:mm.