"

 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'

	 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.

"

!

version

    ^ '$Header: /cvs/stx/stx/libwidg/ArrowButton.st,v 1.18 1995-11-11 16:18:56 cg Exp $'

!

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.

    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

    See examples.

    See also: Button  Toggle  CheckToggle  CheckBox

	      ScrollBar

"

!

examples 

"

    example1:

	|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

    example2:

	|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

    example3:

	|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

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

	      just a demonstration how it looks ..):

	|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

"

! !

!ArrowButton class methodsFor:'defaults'!

updateStyleCache

    DefaultArrowStyle := StyleSheet at:'arrowButtonStyle' default:StyleSheet name.

    DefaultArrowStyle := DefaultArrowStyle asSymbol.

    DefaultArrowButtonActiveLevel := StyleSheet at:'arrowButtonActiveLevel' default:nil.

    DefaultArrowButtonPassiveLevel := StyleSheet at:'arrowButtonPassiveLevel' default:nil.

    DefaultBackgroundColor := StyleSheet colorAt:'arrowButtonBackgroundColor'.

    DefaultForegroundColor := StyleSheet colorAt:'arrowButtonForegroundColor'.

    DefaultActiveBackgroundColor := StyleSheet colorAt:'arrowButtonActiveBackgroundColor'.

    DefaultActiveForegroundColor := StyleSheet colorAt:'arrowButtonActiveForegroundColor'.

    DefaultEnteredBackgroundColor := StyleSheet colorAt:'arrowButtonEnteredBackgroundColor'.

    DefaultEnteredForegroundColor := StyleSheet colorAt:'arrowButtonEnteredForegroundColor'.

    DefaultDisabledForegroundColor := StyleSheet colorAt:'arrowButtonDisabledForegroundColor'.

    DownArrowForm := StyleSheet at:'arrowButtonDownForm' default:nil.

    UpArrowForm := StyleSheet at:'arrowButtonUpForm' default:nil.

    LeftArrowForm := StyleSheet at:'arrowButtonLeftForm' default:nil.

    RightArrowForm := StyleSheet at:'arrowButtonRightForm' default:nil.

    UpArrowFormFile := DownArrowFormFile := LeftArrowFormFile := RightArrowFormFile := nil.

    UpArrowForm isNil ifTrue:[

	UpArrowFormFile := StyleSheet at:'arrowButtonUpFormFile' default:'ScrollUp.xbm'.

    ].

    DownArrowForm isNil ifTrue:[

	DownArrowFormFile := StyleSheet at:'arrowButtonDownFormFile' default:'ScrollDn.xbm'.

    ].

    LeftArrowForm isNil ifTrue:[

	LeftArrowFormFile := StyleSheet at:'arrowButtonLeftFormFile' default:'ScrollLt.xbm'.

    ].

    RightArrowForm isNil ifTrue:[

	RightArrowFormFile := StyleSheet at:'arrowButtonRightFormFile' default:'ScrollRt.xbm'.

    ].

    "

     self updateStyleCache

    "

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

!

upArrowButtonForm:style on:aDevice

    "return the form used for the scrollUp Button"

    |form|

    "

     use cached form, if device is appropriate

    "

    CachedStyle ~~ style ifTrue:[

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

    ].

    ((aDevice == Display) and:[UpArrowForm notNil]) ifTrue:[

	^ UpArrowForm

    ].

    UpArrowForm := StyleSheet at:'arrowButtonUpForm' default:nil.

    UpArrowForm notNil ifTrue:[

	^ UpArrowForm

    ].

    "

     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)

    "

    style ~~ #st80 ifTrue:[

	UpArrowFormFile notNil ifTrue:[

	    form := Form fromFile:UpArrowFormFile resolution:100 on:aDevice.

	    form isNil ifTrue:[

		'ARRBUTTON: no bitmapFile: ' infoPrint. UpArrowFormFile infoPrintNL.

	    ]

	]

    ].

    "

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

	style == #st80 ifTrue:[

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

	    form clear.

	    form lineWidth:2.

	    form capStyle:#round.

	    form paint:(Color colorId:1).

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

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

	] ifFalse:[

	    form := 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]

			 on:aDevice

	].

    ].

    form := form on:aDevice.

    "

     remember form for next use

    "

    (aDevice == Display) ifTrue:[

	CachedStyle := style.

	UpArrowForm := form

    ].

    ^ form

!

downArrowButtonForm:style on:aDevice

    "retun the form used for the scrollDown Button"

    |form|

    "

     use cached form, if device is appropriate

    "

    CachedStyle ~~ style ifTrue:[

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

    ].

    ((aDevice == Display) and:[DownArrowForm notNil]) ifTrue:[

	^ DownArrowForm

    ].

    DownArrowForm := StyleSheet at:'arrowButtonDownForm' default:nil.

    DownArrowForm notNil ifTrue:[

	^ DownArrowForm

    ].

    "

     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)

    "

    style ~~ #st80 ifTrue:[

	DownArrowFormFile notNil ifTrue:[

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

	    form isNil ifTrue:[

		'ARRBUTTON: no bitmapFile: ' infoPrint. DownArrowFormFile infoPrintNL.

	    ]

	]

    ].

    "

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

	style == #st80 ifTrue:[

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

	    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 

	] ifFalse:[

	    form  := 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]

			 on:aDevice

	].

    ].

    form := form on:aDevice.

    "

     remember form for next use

    "

    (aDevice == Display) ifTrue:[

	CachedStyle := style.

	DownArrowForm := form

    ].

    ^ form

!

leftArrowButtonForm:style on:aDevice

    "retun the form used for the scrollLeft Button"

    |form|

    "

     use cached form, if device is appropriate

    "

    CachedStyle ~~ style ifTrue:[

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

    ].

    ((aDevice == Display) and:[LeftArrowForm notNil]) ifTrue:[

	^ LeftArrowForm

    ].

    LeftArrowForm := StyleSheet at:'arrowButtonLeftForm' default:nil.

    LeftArrowForm notNil ifTrue:[

	^ LeftArrowForm

    ].

    "

     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)

    "

    style ~~ #st80 ifTrue:[

	LeftArrowFormFile notNil ifTrue:[

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

	    form isNil ifTrue:[

		'ARRBUTTON: no bitmapFile: ' infoPrint. LeftArrowFormFile infoPrintNL.

	    ]

	]

    ].

    "

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

	style == #st80 ifTrue:[

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

	    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.

	] ifFalse:[

	    form := 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]

			 on:aDevice

	].

    ].

    form := form on:aDevice.

    "

     remember form for next use

    "

    (aDevice == Display) ifTrue:[

	CachedStyle := style.

	LeftArrowForm := form

    ].

    ^ form

!

rightArrowButtonForm:style on:aDevice

    "retun the form used for the scrollRight Button"

    |form|

    "

     use cached form, if device is appropriate

    "

    CachedStyle ~~ style ifTrue:[

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

    ].

    ((aDevice == Display) and:[RightArrowForm notNil]) ifTrue:[

	^ RightArrowForm

    ].

    RightArrowForm := StyleSheet at:'arrowButtonRightForm' default:nil.

    RightArrowForm notNil ifTrue:[

	^ RightArrowForm

    ].

    "

     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)

    "

    style ~~ #st80 ifTrue:[

	RightArrowFormFile notNil ifTrue:[

	    form := Form fromFile:RightArrowFormFile resolution:100 on:aDevice.

	    form isNil ifTrue:[

		'ARRBUTTON: no bitmapFile: ' infoPrint. RightArrowFormFile infoPrintNL.

	    ]

	]