"

 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.

"

Button subclass:#ArrowButton

	instanceVariableNames:'arrowStyle direction'

	classVariableNames:'DownArrowForm UpArrowForm LeftArrowForm RightArrowForm

		CachedStyle DefaultArrowStyle DefaultBackgroundColor

		DefaultForegroundColor DefaultActiveBackgroundColor

		DefaultActiveForegroundColor DefaultEnteredBackgroundColor

		DefaultEnteredForegroundColor DefaultDisabledForegroundColor

		DefaultArrowButtonActiveLevel DefaultArrowButtonPassiveLevel

		DownArrowFormFile UpArrowFormFile LeftArrowFormFile

		RightArrowFormFile'

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

defaultDownArrowButtonForm

    "return the default form used for the scrollDown Button 

     (if no styleSheet value is defined, and no form can be constructed)"

    <resource: #image>

    ^ Form width:16 height:16 

                  fromArray:#[2r00000000 2r00000000

                              2r00001111 2r11110000

                              2r00001000 2r00010000

                              2r00001000 2r00010000

                              2r00001000 2r00010000

                              2r00001000 2r00010000

                              2r00001000 2r00010000

                              2r01111000 2r00011110

                              2r01000000 2r00000010

                              2r00100000 2r00000100

                              2r00010000 2r00001000

                              2r00001000 2r00010000

                              2r00000100 2r00100000

                              2r00000010 2r01000000

                              2r00000001 2r10000000

                              2r00000000 2r00000000]

    "

     self defaultDownArrowButtonForm

    "

!

defaultLeftArrowButtonForm

    "return the default form used for the scrollLeft Button

     (if no styleSheet value is defined, and no form can be constructed)"

    <resource: #image>

    ^ Form width:16 height:16 

                     fromArray:#[2r00000000 2r00000000

                                 2r00000001 2r10000000

                                 2r00000010 2r10000000

                                 2r00000100 2r10000000

                                 2r00001000 2r11111110

                                 2r00010000 2r00000010

                                 2r00100000 2r00000010

                                 2r01000000 2r00000010

                                 2r01000000 2r00000010

                                 2r00100000 2r00000010

                                 2r00010000 2r00000010

                                 2r00001000 2r11111110

                                 2r00000100 2r10000000

                                 2r00000010 2r10000000

                                 2r00000001 2r10000000

                                 2r00000000 2r00000000]

    "

     self defaultLeftArrowButtonForm

    "

!

defaultRightArrowButtonForm

    "return the default form used for the scrollRight Button 

     (if no styleSheet value is defined, and no form can be constructed)"

    <resource: #image>

    ^ Form width:16 height:16 

                     fromArray:#[2r00000000 2r00000000

                                 2r00000001 2r10000000

                                 2r00000001 2r01000000

                                 2r00000001 2r00100000

                                 2r01111111 2r00010000

                                 2r01000000 2r00001000

                                 2r01000000 2r00000100

                                 2r01000000 2r00000010

                                 2r01000000 2r00000010

                                 2r01000000 2r00000100

                                 2r01000000 2r00001000

                                 2r01111111 2r00010000

                                 2r00000001 2r00100000

                                 2r00000001 2r01000000

                                 2r00000001 2r10000000

                                 2r00000000 2r00000000]

    "

     self defaultRightArrowButtonForm

    "

!

defaultUpArrowButtonForm

    "return the default form used for the scrollUp Button 

     (if no styleSheet value is defined, and no form can be constructed)"

    <resource: #image>

    ^ Form width:16 height:16 

                     fromArray:#[2r00000000 2r00000000

                                 2r00000001 2r10000000

                                 2r00000010 2r01000000

                                 2r00000100 2r00100000

                                 2r00001000 2r00010000

                                 2r00010000 2r00001000

                                 2r00100000 2r00000100

                                 2r01000000 2r00000010

                                 2r01111000 2r00011110

                                 2r00001000 2r00010000

                                 2r00001000 2r00010000

                                 2r00001000 2r00010000

                                 2r00001000 2r00010000

                                 2r00001000 2r00010000

                                 2r00001111 2r11110000

                                 2r00000000 2r00000000]

    "

     self defaultUpArrowButtonForm

    "

!

downArrowButtonForm:styleSymbol on:aDevice

    "return the form used for the scrollDown Button"

    <resource: #style (#'arrowButton.downForm')>

    |form|

    "

     use cached form, if device is appropriate

    "

    CachedStyle ~~ styleSymbol ifTrue:[

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

    ].

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

        ^ form

    ].

    form := DownArrowForm := StyleSheet at:'arrowButton.downForm' default:nil.

    form notNil ifTrue:[^ form].

    "

     special treatment for st80 arrows 

     - they do not really fit into the general (bitmap) scheme ...

     (i.e. they are computed instead of drawn from a bitmap)

    "

    styleSymbol ~~ #st80 ifTrue:[

        DownArrowFormFile notNil ifTrue:[

            form := Image fromFile:DownArrowFormFile resolution:100 on:aDevice.

            form isNil ifTrue:[

                form := Image fromFile:('bitmaps/' , DownArrowFormFile) resolution:100 on:aDevice.

                form isNil ifTrue:[

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

                ]

            ]

        ]

    ].

    "

     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 ifTrue:[

        styleSymbol == #st80 ifTrue:[

            form := Form width:9 height:9 depth:1 on:Display.

            form isNil ifTrue:[^ nil].

            form clear.

            form lineWidth:2.

            form capStyle:#round.

            form paint:(Color colorId:1).

            form displayLineFromX:0 y:2 toX:4 y:6.

            form displayLineFromX:4 y:6 toX:8 y:2.

            form beImmediateForm.

        ] ifFalse:[

            form  := self defaultDownArrowButtonForm onDevice:aDevice.

            form isNil ifTrue:[^ nil].

        ].

    ].

    "

     remember form for next use

    "

    CachedStyle := styleSymbol.

    DownArrowForm := form.

    ^ form

    "Modified: / 26.10.1997 / 17:01:54 / cg"

!

leftArrowButtonForm:styleSymbol on:aDevice

    "return the form used for the scrollLeft Button"

    <resource: #style (#'arrowButton.leftForm')>

    |form|

    "

     use cached form, if device is appropriate

    "

    CachedStyle ~~ styleSymbol ifTrue:[

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

    ].

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

        ^ form

    ].

    form := LeftArrowForm := StyleSheet at:'arrowButton.leftForm' default:nil.

    form notNil ifTrue:[^ form].

    "

     special treatment for st80 arrows 

     - they do not really fit into the general (bitmap) scheme ...

     (i.e. they are computed instead of drawn from a bitmap)

    "

    styleSymbol ~~ #st80 ifTrue:[

        LeftArrowFormFile notNil ifTrue:[

            form := Image fromFile:LeftArrowFormFile resolution:100 on:aDevice.

            form isNil ifTrue:[

                form := Image fromFile:'bitmaps/' , LeftArrowFormFile resolution:100 on:aDevice.

                form isNil ifTrue:[

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

                ]

            ]

        ]

    ].

    "

     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 ifTrue:[

        styleSymbol == #st80 ifTrue:[

            form := Form width:9 height:9 depth:1 on:Display.

            form isNil ifTrue:[^ nil].

            form clear.

            form lineWidth:2.

            form capStyle:#round.

            form paint:(Color colorId:1).

            form displayLineFromX:6 y:0 toX:2 y:4.

            form displayLineFromX:2 y:4 toX:6 y:8.

            form beImmediateForm.

        ] ifFalse:[

            form  := self defaultLeftArrowButtonForm onDevice:aDevice.

            form isNil ifTrue:[^ nil].

        ].

    ].

    "

     remember form for next use

    "

    CachedStyle := styleSymbol.

    LeftArrowForm := form.

    ^ form

    "Modified: / 26.10.1997 / 17:01:47 / cg"

!

rightArrowButtonForm:styleSymbol on:aDevice

    "return the form used for the scrollRight Button"

    <resource: #style (#'arrowButton.rightForm')>

    |form|

    "

     use cached form, if device is appropriate

    "

    CachedStyle ~~ styleSymbol ifTrue:[

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