"

 COPYRIGHT (c) 1993 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' }"

Button subclass:#ArrowButton

	instanceVariableNames:'arrowStyle direction'

	classVariableNames:'DownArrowForm UpArrowForm LeftArrowForm RightArrowForm

		DisabledDownArrowForm DisabledUpArrowForm DisabledLeftArrowForm

		DisabledRightArrowForm ActiveDownArrowForm ActiveUpArrowForm

		ActiveLeftArrowForm ActiveRightArrowForm EnteredDownArrowForm

		EnteredUpArrowForm EnteredLeftArrowForm EnteredRightArrowForm

		CachedStyle DefaultArrowStyle DefaultBackgroundColor

		DefaultForegroundColor DefaultActiveBackgroundColor

		DefaultActiveForegroundColor DefaultEnteredBackgroundColor

		DefaultEnteredForegroundColor DefaultDisabledForegroundColor

		DefaultArrowButtonActiveLevel DefaultArrowButtonPassiveLevel'

	poolDictionaries:''

	category:'Views-Interactors'

!

!ArrowButton class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1993 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

"

    ArrowButtons display an arrow as their label; they are mainly

    used for scrollbars, but can be useful on their own in some applications.

    Beside the contents, their default behavior is to perform their action

    when pressed - not (as is the default for normal buttons) when released.

    Indivdual ArrowButtons can be created by sending one of:

            ArrowButton upIn:aView /downIn: / leftIn: or rightIn:

    passing the parent view as argument.

    See examples.

    [styleSheet parameters:]

        arrowButtonStyle            <Symbol>        the style of the button;

                                                    #motif, #st80 or nil (default)

        arrowButtonForegroundColor  <nil | Color>   foregroundColor 

        arrowButtonBackgroundColor  <nil | Color>   backgroundColor 

        arrowButtonActiveForegroundColor            foregroundColor when pressed

        arrowButtonActiveBackgroundColor            backgroundColor when pressed

        arrowButtonEnteredForegroundColor           foregroundColor when mouse pointer entered

        arrowButtonEnteredBackgroundColor           backgroundColor when mouse pointer entered

    [author:]

        Claus Gittinger

    [See also:]

         Button  Toggle CheckToggle CheckBox

         ScrollBar

"

!

examples 

"

    example1:

                                                                        [exBegin]

        |v p b1 b2 b3 b4|

        v := StandardSystemView extent:200@200.

        p := HorizontalPanelView origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:v.

        b1 := ArrowButton upIn:p.

        b2 := ArrowButton downIn:p.

        b3 := ArrowButton leftIn:p.

        b4 := ArrowButton rightIn:p.

        b1 action:['whatEver you like here ...'].

        b2 action:['whatEver you like here ...'].

        b3 action:['whatEver you like here ...'].

        b4 action:['whatEver you like here ...'].

        v open

                                                                        [exEnd]

    example2:

                                                                        [exBegin]

        |v p b1 b2 b3 b4|

        v := StandardSystemView extent:200@200.

        p := HorizontalPanelView origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:v.

        b1 := (ArrowButton upIn:p) extent:30@30.

        b2 := (ArrowButton downIn:p) extent:30@30.

        b3 := (ArrowButton leftIn:p) extent:30@30.

        b4 := (ArrowButton rightIn:p) extent:30@30.

        b1 action:['whatEver you like here ...'].

        b2 action:['whatEver you like here ...'].

        b3 action:['whatEver you like here ...'].

        b4 action:['whatEver you like here ...'].

        v open

                                                                        [exEnd]

    example3:

                                                                        [exBegin]

        |v p b1 b2 b3 b4|

        v := StandardSystemView extent:200@200.

        p := View origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:v.

        b1 := (ArrowButton upIn:p) origin:(0.33 @ 0.0) corner:(0.67 @ 0.33).

        b3 := (ArrowButton leftIn:p) origin:(0.0 @ 0.33) corner:(0.33 @ 0.67).

        b4 := (ArrowButton rightIn:p) origin:(0.67 @ 0.33) corner:(1.0 @ 0.67).

        b2 := (ArrowButton downIn:p) origin:(0.33 @ 0.67) corner:(0.67 @ 1.0).

        b1 action:['whatEver you like here ...'].

        b2 action:['whatEver you like here ...'].

        b3 action:['whatEver you like here ...'].

        b4 action:['whatEver you like here ...'].

        v open

                                                                        [exEnd]

    example4 (not good coding style, to explicitely use a particular style,

              just a demonstration how it looks ..):

                                                                        [exBegin]

        |v p b1 b2 b3 b4 oldStyle|

        oldStyle := View defaultStyle.

        View defaultStyle:#motif.

        v := StandardSystemView extent:100@100.

        p := View origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:v.

        b1 := (ArrowButton upIn:p) origin:(0.33 @ 0.0) corner:(0.67 @ 0.33).

        b3 := (ArrowButton leftIn:p) origin:(0.0 @ 0.33) corner:(0.33 @ 0.67).

        b4 := (ArrowButton rightIn:p) origin:(0.67 @ 0.33) corner:(1.0 @ 0.67).

        b2 := (ArrowButton downIn:p) origin:(0.33 @ 0.67) corner:(0.67 @ 1.0).

        b1 action:['whatEver you like here ...'].

        b2 action:['whatEver you like here ...'].

        b3 action:['whatEver you like here ...'].

        b4 action:['whatEver you like here ...'].

        View defaultStyle:oldStyle.

        v open

                                                                        [exEnd]

"

! !

!ArrowButton class methodsFor:'instance creation'!

downIn:aView

    "create and return a new down-button in aView"

    ^ (super in:aView) direction:#down

    "Modified: 22.1.1997 / 11:59:08 / cg"

!

leftIn:aView

    "create and return a new left-button in aView"

    ^ (super in:aView) direction:#left

    "Modified: 22.1.1997 / 11:59:14 / cg"

!

new

    "return a new arrowButton - direction defaults to #up"

    ^ super new direction:#up

!

rightIn:aView

    "create and return a new right-button in aView"

    ^ (super in:aView) direction:#right

    "Modified: 22.1.1997 / 11:59:21 / cg"

!

upIn:aView

    "create and return a new up-button in aView"

    ^ (super in:aView) direction:#up

    "Modified: 22.1.1997 / 11:59:27 / cg"

! !

!ArrowButton class methodsFor:'defaults'!

DownArrowForm

    ^DownArrowForm

!

LeftArrowForm

    ^LeftArrowForm

!

RightArrowForm

    ^RightArrowForm

!

UpArrowForm

    ^UpArrowForm

!

downArrowButtonForm:styleSymbol on:aDevice

    "return the form used for the scrollDown Button"

    ^ self arrowButtonFormForStyle:styleSymbol direction:#down on:aDevice

!

leftArrowButtonForm:styleSymbol on:aDevice

    "return the form used for the scrollLeft Button"

    ^ self arrowButtonFormForStyle:styleSymbol direction:#left on:aDevice

!

rightArrowButtonForm:styleSymbol on:aDevice

    "return the form used for the scrollRight Button"

    ^ self arrowButtonFormForStyle:styleSymbol direction:#right on:aDevice

!

upArrowButtonForm:styleSymbol on:aDevice

    "return the form used for the scrollUp Button"

    ^ self arrowButtonFormForStyle:styleSymbol direction:#up on:aDevice

!

updateStyleCache

    "extract values from the styleSheet and cache them in class variables"

    <resource: #style (#'arrowButton.style' 

                       #'arrowButton.activeLevel' #'arrowButton.passiveLevel'

                       #'arrowButton.backgroundColor' #'arrowButton.foregroundColor'

                       #'arrowButton.activeBackgroundColor' #'arrowButton.activeForegroundColor'

                       #'arrowButton.enteredBackgroundColor' #'arrowButton.enteredForegroundColor'

                       #'arrowButton.disabledForegroundColor' 

                       #'arrowButton.downForm'     #'arrowButton.upForm'

                       #'arrowButton.leftForm'     #'arrowButton.rightForm'

                       #'arrowButton.disabledDownForm'     #'arrowButton.disabledUpForm'

                       #'arrowButton.disabledLeftForm'     #'arrowButton.disabledRightForm'

                       #'arrowButton.activeDownForm'     #'arrowButton.activeUpForm'

                       #'arrowButton.activeLeftForm'     #'arrowButton.activeRightForm'

                       #'arrowButton.enteredDownForm'     #'arrowButton.enteredUpForm'

                       #'arrowButton.enteredLeftForm'     #'arrowButton.enteredRightForm'

                )>

    |styleSheet defaultScreen|

    styleSheet := StyleSheet.

    DefaultArrowStyle := styleSheet at:#'arrowButton.style' default:styleSheet name.

    DefaultArrowStyle := DefaultArrowStyle asSymbol.

    DefaultArrowButtonActiveLevel := styleSheet at:#'arrowButton.activeLevel'.

    DefaultArrowButtonPassiveLevel := styleSheet at:#'arrowButton.passiveLevel'.

    DefaultBackgroundColor := styleSheet colorAt:#'arrowButton.backgroundColor'.

    DefaultForegroundColor := styleSheet colorAt:#'arrowButton.foregroundColor'.

    DefaultActiveBackgroundColor := styleSheet colorAt:#'arrowButton.activeBackgroundColor'.

    DefaultActiveForegroundColor := styleSheet colorAt:#'arrowButton.activeForegroundColor'.

    DefaultEnteredBackgroundColor := styleSheet colorAt:#'arrowButton.enteredBackgroundColor'.

    DefaultEnteredForegroundColor := styleSheet colorAt:#'arrowButton.enteredForegroundColor'.

    DefaultDisabledForegroundColor := styleSheet colorAt:#'arrowButton.disabledForegroundColor'.

    DownArrowForm  := styleSheet at:#'arrowButton.downForm'.

    UpArrowForm    := styleSheet at:#'arrowButton.upForm'.

    LeftArrowForm  := styleSheet at:#'arrowButton.leftForm'.

    RightArrowForm := styleSheet at:#'arrowButton.rightForm'.

    ActiveDownArrowForm := styleSheet at:#'arrowButton.activeDownForm'.

    ActiveUpArrowForm := styleSheet at:#'arrowButton.activeUpForm'.

    ActiveLeftArrowForm := styleSheet at:#'arrowButton.activeLeftForm'.

    ActiveRightArrowForm := styleSheet at:#'arrowButton.activeRightForm'.

    EnteredDownArrowForm := styleSheet at:#'arrowButton.enteredDownForm'.

    EnteredUpArrowForm := styleSheet at:#'arrowButton.enteredUpForm'.

    EnteredLeftArrowForm := styleSheet at:#'arrowButton.enteredLeftForm'.

    EnteredRightArrowForm := styleSheet at:#'arrowButton.enteredRightForm'.

    defaultScreen := Screen default.

    DownArrowForm := UpArrowForm := LeftArrowForm := RightArrowForm := nil.

    DownArrowForm := self arrowButtonFormForStyle:DefaultArrowStyle direction:#down on:defaultScreen.

    UpArrowForm := self arrowButtonFormForStyle:DefaultArrowStyle direction:#up on:defaultScreen.

    LeftArrowForm := self arrowButtonFormForStyle:DefaultArrowStyle direction:#left on:defaultScreen.

    RightArrowForm := self arrowButtonFormForStyle:DefaultArrowStyle direction:#right on:defaultScreen.

    DisabledDownArrowForm := DisabledUpArrowForm := DisabledLeftArrowForm := DisabledRightArrowForm := nil.

    DisabledDownArrowForm := self disabledArrowButtonFormForStyle:DefaultArrowStyle direction:#down on:defaultScreen.

    DisabledUpArrowForm := self disabledArrowButtonFormForStyle:DefaultArrowStyle direction:#up on:defaultScreen.

    DisabledLeftArrowForm := self disabledArrowButtonFormForStyle:DefaultArrowStyle direction:#left on:defaultScreen.

    DisabledRightArrowForm := self disabledArrowButtonFormForStyle:DefaultArrowStyle direction:#right on:defaultScreen.

    ActiveDownArrowForm := ActiveUpArrowForm := ActiveLeftArrowForm := ActiveRightArrowForm := nil.

    ActiveDownArrowForm := self activeArrowButtonFormForStyle:DefaultArrowStyle direction:#down on:defaultScreen.

    ActiveUpArrowForm := self activeArrowButtonFormForStyle:DefaultArrowStyle direction:#up on:defaultScreen.

    ActiveLeftArrowForm := self activeArrowButtonFormForStyle:DefaultArrowStyle direction:#left on:defaultScreen.

    ActiveRightArrowForm := self activeArrowButtonFormForStyle:DefaultArrowStyle direction:#right on:defaultScreen.

    EnteredDownArrowForm := EnteredUpArrowForm := EnteredLeftArrowForm := EnteredRightArrowForm := nil.

    EnteredDownArrowForm := self enteredArrowButtonFormForStyle:DefaultArrowStyle direction:#down on:defaultScreen.

    EnteredUpArrowForm := self enteredArrowButtonFormForStyle:DefaultArrowStyle direction:#up on:defaultScreen.

    EnteredLeftArrowForm := self enteredArrowButtonFormForStyle:DefaultArrowStyle direction:#left on:defaultScreen.

    EnteredRightArrowForm := self enteredArrowButtonFormForStyle:DefaultArrowStyle direction:#right on:defaultScreen.

    "

     self updateStyleCache

    "

    "Modified: 31.8.1995 / 03:01:14 / claus"

    "Modified: 20.10.1997 / 13:50:57 / cg"

! !

!ArrowButton class methodsFor:'defaults-helpers'!

activeArrowButtonFormForStyle:styleSymbol direction:direction on:aDevice

    <resource: #style (

                       #'arrowButton.activeDownForm'

                       #'arrowButton.activeUpForm'

                       #'arrowButton.activeLeftForm'

                       #'arrowButton.activeRightForm'   

                       #'arrowButton.activeDownFormFile'

                       #'arrowButton.activeUpFormFile'

                       #'arrowButton.activeLeftFormFile'

                       #'arrowButton.activeRightFormFile'   

                      )>

    |formVariableName styleSheetName styleSheetFileName|

    direction = #left ifTrue:[

        formVariableName := #ActiveLeftArrowForm.

        styleSheetName := #'arrowButton.activeLeftForm'.

        styleSheetFileName := #'arrowButton.activeLeftFormFile'.

    ].

    direction = #right ifTrue:[

        formVariableName := #ActiveRightArrowForm.

        styleSheetName := #'arrowButton.activeRightForm'.

        styleSheetFileName := #'arrowButton.activeRightFormFile'.

    ].

    direction = #up ifTrue:[

        formVariableName := #ActiveUpArrowForm.

        styleSheetName := #'arrowButton.activeUpForm'.

        styleSheetFileName := #'arrowButton.activeUpFormFile'.

    ].

    direction = #down ifTrue:[

        formVariableName := #ActiveDownArrowForm.

        styleSheetName := #'arrowButton.activeDownForm'.

        styleSheetFileName := #'arrowButton.activeDownFormFile'.

    ].

    formVariableName isNil ifTrue:[

        ^ nil

    ].

    ^ self

        arrowButtonFormForStyle:styleSymbol 

        nameKey:styleSheetName fileNameKey:styleSheetFileName variableName:formVariableName 

        direction:direction useDefault:false on:aDevice

!

arrowButtonFormForStyle:styleSymbol direction:direction on:aDevice

    "return the form used for the scrollDown Button"

    <resource: #style (

                       #'arrowButton.downForm'

                       #'arrowButton.upForm'

                       #'arrowButton.leftForm'

                       #'arrowButton.rightForm'   

                       #'arrowButton.downFormFile'

                       #'arrowButton.upFormFile'

                       #'arrowButton.leftFormFile'

                       #'arrowButton.rightFormFile'   

                      )>

    |formVariableName styleSheetName styleSheetFileName|

    direction = #left ifTrue:[

        formVariableName := #LeftArrowForm.

        styleSheetName := #'arrowButton.leftForm'.

        styleSheetFileName := #'arrowButton.leftFormFile'.

    ].

    direction = #right ifTrue:[

        formVariableName := #RightArrowForm.

        styleSheetName := #'arrowButton.rightForm'.

        styleSheetFileName := #'arrowButton.rightFormFile'.

    ].

    direction = #up ifTrue:[

        formVariableName := #UpArrowForm.

        styleSheetName := #'arrowButton.upForm'.

        styleSheetFileName := #'arrowButton.upFormFile'.

    ].

    direction = #down ifTrue:[

        formVariableName := #DownArrowForm.

        styleSheetName := #'arrowButton.downForm'.

        styleSheetFileName := #'arrowButton.downFormFile'.

    ].

    formVariableName isNil ifTrue:[

        ^ nil

    ].

    ^ self

        arrowButtonFormForStyle:styleSymbol 

        nameKey:styleSheetName fileNameKey:styleSheetFileName variableName:formVariableName 

        direction:direction useDefault:true on:aDevice

!

arrowButtonFormForStyle:styleSymbol nameKey:styleSheetName fileNameKey:styleSheetFileName variableName:formVariableName direction:direction useDefault:useDefault on:aDevice

    "return the form used for the scrollDown Button"

    |form formFile|

    "

     use cached form, if device is appropriate

    "

    CachedStyle ~~ styleSymbol ifTrue:[

        self classVarAt:formVariableName put:nil

    ].

    form := self classVarAt:formVariableName.

    (form notNil and:[form device == aDevice]) ifTrue:[

        ^ form

    ].

    form := StyleSheet at:styleSheetName default:nil.

    form isNil ifTrue:[

        formFile := StyleSheet at:styleSheetFileName default:nil.

        formFile notNil ifTrue:[

            form := Smalltalk imageFromFileNamed:formFile forClass:self.

            form isNil ifTrue:[

                'ArrowButton [info]: no bitmapFile: ' infoPrint. formFile infoPrintCR.

            ] ifFalse:[

                form := form onDevice:aDevice.

            ]

        ].

        "

         form to use as a fallback, if no bitmap file is present

         (actually not really needed - just to show something useful, in case of a bad installation)

        "

        (form isNil and:[useDefault]) ifTrue:[

            form := self defaultArrowButtonFormForStyle:styleSymbol direction:direction onDevice:aDevice.

            form isNil ifTrue:[^ nil].

        ].

    ].

    "

     remember form for next use

    "

    CachedStyle := styleSymbol.

    self classVarAt:formVariableName put:form.

    ^ form