"
 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
			     DownArrowFormFile UpArrowFormFile 
			     LeftArrowFormFile RightArrowFormFile'
	 poolDictionaries:''
	 category:'Views-Interactors'
!

ArrowButton comment:'
COPYRIGHT (c) 1993 by Claus Gittinger
	      All Rights Reserved

$Header: /cvs/stx/stx/libwidg/Attic/ArrButton.st,v 1.9 1994-11-21 16:45:22 claus Exp $
'!

!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/Attic/ArrButton.st,v 1.9 1994-11-21 16:45:22 claus 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
"
!

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.

    DefaultBackgroundColor := StyleSheet colorAt:'arrowButtonBackgroundColor'.
    DefaultForegroundColor := StyleSheet colorAt:'arrowButtonForegroundColor'.
    DefaultActiveBackgroundColor := StyleSheet colorAt:'arrowButtonActiveBackgroundColor'.
    DefaultActiveForegroundColor := StyleSheet colorAt:'arrowButtonActiveForegroundColor'.
    DefaultEnteredBackgroundColor := StyleSheet colorAt:'arrowButtonEnteredBackgroundColor'.
    DefaultEnteredForegroundColor := StyleSheet colorAt:'arrowButtonEnteredForegroundColor'.

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

    UpArrowFormFile := StyleSheet at:'arrowButtonUpFormFile' default:'ScrollUp.xbm'.
    DownArrowFormFile := StyleSheet at:'arrowButtonDownFormFile' default:'ScrollDn.xbm'.
    LeftArrowFormFile := StyleSheet at:'arrowButtonLeftFormFile' default:'ScrollLt.xbm'.
    RightArrowFormFile := StyleSheet at:'arrowButtonRightFormFile' default:'ScrollRt.xbm'.

    "
     self updateStyleCache
    "
!

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

    "
     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:[
	form := Form fromFile:UpArrowFormFile resolution:100 on: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 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
    ].

    "
     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:[
	form := Form fromFile:DownArrowFormFile resolution:100 on: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 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
    ].

    "
     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:[
	form := Form fromFile:LeftArrowFormFile resolution:100 on: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 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
    ].

    "
     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:[
	form := Form fromFile:RightArrowFormFile resolution:100 on: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 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:2 y:0 toX:6 y:4.
	    form displayLineFromX:6 y:4 toX:2 y:8 
	] ifFalse:[
	    form := 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]
			 on:aDevice
	].
    ].
    form := form on:aDevice.

    "
     remember form for next use
    "
    (aDevice == Display) ifTrue:[
	CachedStyle := style.
	RightArrowForm := form
    ].

    ^ form
! !

!ArrowButton class methodsFor:'instance creation'!

upIn:aView
    ^ (super in:aView) direction:#up
!

downIn:aView
    ^ (super in:aView) direction:#down
!

leftIn:aView
    ^ (super in:aView) direction:#left
!

rightIn:aView
    ^ (super in:aView) direction:#right
! !

!ArrowButton methodsFor:'accessing'!

direction:aDirectionSymbol
    |form|

    aDirectionSymbol == #up ifTrue:[
	form := (self class upArrowButtonForm:arrowStyle on:device).
	name := 'upButton'.
    ].
    aDirectionSymbol == #down ifTrue:[
	form := (self class downArrowButtonForm:arrowStyle on:device).
	name := 'downButton'.
    ].
    aDirectionSymbol == #left ifTrue:[
	form := (self class leftArrowButtonForm:arrowStyle on:device).
	name := 'leftButton'.
    ].
    aDirectionSymbol == #right ifTrue:[
	form := (self class rightArrowButtonForm:arrowStyle on:device).
	name := 'rightButton'.
    ].
    self form:form
! !

!ArrowButton methodsFor:'initialization'!

initialize
    super initialize.
    actionWhenPressed := true.
!

initStyle
    super initStyle.

    DefaultBackgroundColor notNil ifTrue:[
	bgColor := DefaultBackgroundColor on:device
    ].
    DefaultForegroundColor notNil ifTrue:[
	fgColor := DefaultForegroundColor on:device
    ].
    DefaultActiveForegroundColor notNil ifTrue:[
	activeFgColor := DefaultActiveForegroundColor on:device
    ].
    DefaultActiveBackgroundColor notNil ifTrue:[
	activeBgColor := DefaultActiveBackgroundColor on:device
    ].
    DefaultEnteredForegroundColor notNil ifTrue:[
	enteredFgColor := DefaultEnteredForegroundColor on:device
    ].
    DefaultEnteredBackgroundColor notNil ifTrue:[
	enteredBgColor := DefaultEnteredBackgroundColor on:device
    ].
    arrowStyle := DefaultArrowStyle.

    "
     special treatment for motif arrows 
     - they do not really fit into the general (bitmap) scheme ...
    "
    arrowStyle == #motif ifTrue:[
	onLevel := 0.
	offLevel := 0.
	self level:0.
    ]
! !

!ArrowButton methodsFor:'redrawing'!

drawWith:fg and:bg
    "this is a q&d hack for motif ..."

    |topLeft botRight noColor allColor|

    arrowStyle ~~ #motif ifTrue:[
	^ super drawWith:fg and:bg.
    ].

    "
     the code below does a lot of bitmap drawing, but allows
     to 3D-ify any logo (it draws it displaced by some pixels
     to the upper left in one-color and displaced to the 
     lower right in the other color). It should be rewritten to
     cache the result for later drawing operations.
    "
    logo notNil ifTrue:[
	shadowColor := shadowColor on:device.
	lightColor := lightColor on:device.

	pressed ifTrue:[
	    topLeft := shadowColor.
	    botRight := lightColor
	] ifFalse:[
	    topLeft := lightColor.
	    botRight := shadowColor
	].

	self paint:bg.
	self fillRectangleX:0 y:0 width:width height:height.

	noColor := Color noColor.
	allColor := Color allColor.

	self paint:topLeft.
	#(-1 0 -1) with:#(-1 -1 0) do:[:dX :dY |
	    self displayForm:logo x:labelOriginX+dX  y:labelOriginY+dY.
	].

	self paint:botRight.
	#(1 1 0) with:#(0 1 1) do:[:dX :dY |
	    self displayForm:logo x:labelOriginX+dX y:labelOriginY+dY.
	].

	"
	 finally, the form itself
	"
	self paint:fg.
	self displayForm:logo x:labelOriginX  y:labelOriginY.
    ]
! !