"
 COPYRIGHT (c) 1989 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.
"

Label subclass:#Button
       instanceVariableNames:'activeLogo passiveLogo
			      pressActionBlock releaseActionBlock
			      actionWhenPressed  
			      enabled pressed active entered
			      autoRepeat repeatBlock
			      onLevel offLevel
			      initialDelay repeatDelay
			      disabledFgColor
			      activeFgColor activeBgColor
			      enteredFgColor enteredBgColor
			      isReturnButton
			      shadowForm lightForm
			      formColor formShadowColor formLightColor'
      classVariableNames:'ReturnForm ReturnLightForm ReturnShadowForm 
		DefaultFont DefaultActiveLevel
		DefaultPassiveLevel DefaultSoftEdge DefaultFont
		DefaultForegroundColor DefaultBackgroundColor
		DefaultDisabledForegroundColor DefaultDisabledBackgroundColor
		DefaultEnteredForegroundColor DefaultEnteredBackgroundColor
		DefaultActiveForegroundColor DefaultActiveBackgroundColor
		DefaultReturnButtonHasImage DefaultReturnButtonHasBorder'
       poolDictionaries:''
       category:'Views-Interactors'
!

Button comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
	      All Rights Reserved

$Header: /cvs/stx/stx/libwidg/Button.st,v 1.10 1994-10-10 03:00:38 claus Exp $
'!

!Button class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1989 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/Button.st,v 1.10 1994-10-10 03:00:38 claus Exp $
"
!

documentation
"
    Buttons are Labels which do something when pressed/released.

    Instance variables:

      activeLogo              <StringOrImage> logo to show when active (pressed)
      passiveLogo             <StringOrImage> logo to show when passive (released)
					      default is nil for both, so the normal logo is used
					      (see superclass: Label)
      pressActionBlock        <Block>         block to evaluate when pressed (default: noop)
      releaseActionBlock      <Block>         block to evaluate when released (default: noop)
      actionWhenPressed       <Boolean>       controls if the action should be executed on
					      press or on release (default: on release).
      enabled                 <Boolean>       pressing is allowed (default: true)
      pressed                 <Boolean>       true if currently pressed (read-only)
      entered                 <Boolean>       true if the cursor is currently in this view
      autoRepeat              <Boolean>       auto-repeats when pressed long enough (default: false)
      onLevel                 <Integer>       level when pressed (3D only) (default: depends on style)
      offLevel                <Integer>       level when released (3D only) (default: depends on style)
      initialDelay            <Number>        seconds till first auto-repeat (default: 0.2)
      repeatDelay             <Number>        seconds of repeat intervall (default: 0.025)
      disabledFgColor         <Color>         color used to draw logo when disabled (default: depends on style)
      activeFgColor           <Color>         color to draw logo when pressed (default: depends on style)
      activeBgColor           <Color>         bg color when pressed (default: depends on style)
      enteredFgColor          <Color>         fg color to draw logo when cursor entered (default: depends on style)
      enteredBgColor          <Color>         bg color when cursor entered (default: depends on style)

      isReturnButton          <Boolean>       true if this button is also activated by the
					      return key - if true, it will draw a return-bitmap 
					      in addition to the logo (default: false)

      shadowForm              <Form>          form to display in addition to buttons label (returnbutton only)
      lightForm               <Form>          light part of shadowForm (returnbutton only)

      formColor               <Color>         color to draw form with (returnbutton only)
      formShadowColor         <Color>         color for shadowing the form (3D only & return)
      formLightColor          <Color>         color for lighting the form (3D only)

      repeatBlock             <Block>         block evaluated for auto-repeat (internal)
      active                  <Boolean>       true during action evaluation (internal)

    You dont have to normally care for all these internals 
    (they allow many variations though). The typical use is:

	b := Button label:'some logo' in:aView.
	b action:[ .. things to do, when pressed ... ]

    see 'doc/coding-examples' and 'doc/misc/quick_view_intro.doc' for more variations.
"
! !

!Button class methodsFor:'defaults'!

defaultInitialDelay
    "when autorepeat is enabled, and button is not released,
     start repeating after initialDelay seconds"

    ^ 0.2
!

defaultRepeatDelay
    "when autorepeat is enabled, and button is not released,
     repeat every repeatDelay seconds"

    ^ 0.025
!

updateStyleCache
    StyleSheet is3D ifTrue:[
	DefaultActiveLevel := StyleSheet at:'buttonActiveLevel' default:-1.
	DefaultPassiveLevel := StyleSheet at:'buttonPassiveLevel' default:1.
    ] ifFalse:[
	DefaultActiveLevel := StyleSheet at:'buttonActiveLevel' default:0.
	DefaultPassiveLevel := StyleSheet at:'buttonPassiveLevel' default:0.
    ].
    DefaultSoftEdge := StyleSheet at:'buttonSoftEdge' default:false.
    DefaultFont := StyleSheet at:'buttonFont'.
    DefaultForegroundColor := StyleSheet at:'buttonForegroundColor'.
    DefaultBackgroundColor := StyleSheet at:'buttonBackgroundColor'.
    DefaultDisabledForegroundColor := StyleSheet at:'buttonDisabledForegroundColor' default:Color grey.
    DefaultDisabledBackgroundColor := StyleSheet at:'buttonDisabledBackgroundColor'.
    DefaultEnteredForegroundColor := StyleSheet at:'buttonEnteredForegroundColor'.
    DefaultEnteredBackgroundColor := StyleSheet at:'buttonEnteredBackgroundColor'.
    DefaultActiveForegroundColor := StyleSheet at:'buttonActiveForegroundColor'.
    DefaultActiveBackgroundColor := StyleSheet at:'buttonActiveBackgroundColor'.
    DefaultReturnButtonHasImage := StyleSheet at:'buttonReturnButtonHasImage' default:true.
    DefaultReturnButtonHasBorder := StyleSheet at:'buttonReturnButtonHasBorder' default:false.
    DefaultFont := StyleSheet at:'buttonFont'.
    DefaultFont notNil ifTrue:[
	DefaultFont := DefaultFont on:Display
    ].
!

returnFormOn:aDevice
    "return the form used for the return arrow in non-3D;
     cache the one for Display for the next round."

    |f|

    (ReturnForm notNil and:[aDevice == ReturnForm device]) ifTrue:[
	^ ReturnForm
    ].
    f := Form fromFile:'Return.xbm' resolution:100 on:aDevice.
    f isNil ifTrue:[
	f := Form width:24 height:16 fromArray:#[2r00000000 2r00000000 2r00000000
						 2r00000000 2r00000000 2r00000000
						 2r00000000 2r00000000 2r00000000
						 2r00000000 2r00000011 2r11100000
						 2r00000001 2r10000011 2r11100000
						 2r00000011 2r10000011 2r11100000
						 2r00000111 2r11111111 2r11100000
						 2r00001111 2r11111111 2r11100000
						 2r00011111 2r11111111 2r11100000
						 2r00001111 2r11111111 2r11100000
						 2r00000111 2r11111111 2r11100000
						 2r00000011 2r10000000 2r00000000
						 2r00000001 2r10000000 2r00000000
						 2r00000000 2r00000000 2r00000000
						 2r00000000 2r00000000 2r00000000
						 2r00000000 2r00000000 2r00000000]
					      on:aDevice
    ].
    ReturnForm := f.
    ^ f
!

returnShadowFormOn:aDevice
    "return the form used for the return arrow shadow pixels (3D only);
     cache the one for Display for the next round."

    |f|

    (ReturnShadowForm notNil and:[aDevice == ReturnShadowForm device]) ifTrue:[
	^ ReturnShadowForm
    ].
    f := Form fromFile:'ReturnShadow.xbm' resolution:100 on:aDevice.
    f isNil ifTrue:[
	f := Form width:24 height:16 fromArray:#[2r00000000 2r00000000 2r00000000
						 2r00000000 2r00000000 2r00000000
						 2r00000000 2r00000000 2r00000000
						 2r00000000 2r00000011 2r11100000
						 2r00000001 2r10000010 2r00000000
						 2r00000010 2r10000010 2r00000000
						 2r00000100 2r11111110 2r00000000
						 2r00001000 2r00000000 2r00000000
						 2r00010000 2r00000000 2r00000000
						 2r00001000 2r00000000 2r00000000
						 2r00000100 2r00000000 2r00000000
						 2r00000010 2r00000000 2r00000000
						 2r00000001 2r00000000 2r00000000
						 2r00000000 2r00000000 2r00000000
						 2r00000000 2r00000000 2r00000000
						 2r00000000 2r00000000 2r00000000]
					      on:aDevice
    ].
    ReturnShadowForm := f.
    ^ f
!

returnLightFormOn:aDevice
    "return the form used for the return arrow light pixels (3D only);
     cache the one for Display for the next round"

    |f|

    (ReturnLightForm notNil and:[aDevice == ReturnLightForm device]) ifTrue:[
	^ ReturnLightForm
    ].
    f := Form fromFile:'ReturnLight.xbm' resolution:100 on:aDevice.
    f isNil ifTrue:[
	f := Form width:24 height:16 fromArray:#[2r00000000 2r00000000 2r00000000
						 2r00000000 2r00000000 2r00000000
						 2r00000000 2r00000000 2r00000000
						 2r00000000 2r00000000 2r00000000
						 2r00000000 2r00000000 2r00100000
						 2r00000000 2r00000000 2r00100000
						 2r00000000 2r00000000 2r00100000
						 2r00000000 2r00000000 2r00100000
						 2r00000000 2r00000000 2r00100000
						 2r00000000 2r00000000 2r00100000
						 2r00000000 2r11111111 2r11100000
						 2r00000000 2r10000000 2r00000000
						 2r00000000 2r10000000 2r00000000
						 2r00000000 2r00000000 2r00000000
						 2r00000000 2r00000000 2r00000000
						 2r00000000 2r00000000 2r00000000]
					      on:aDevice
    ].
    ReturnLightForm := f.
    ^ f
! !

!Button class methodsFor:'instance creation'!

label:aLabel action:aBlock in:aView
    "create and return a new Button with text-label, aString
     and pressAction, aBlock.  Button is placed into aView."

    ^ ((self in:aView) label:aLabel) action:aBlock
!

form:aForm action:aBlock in:aView
    "create and return a new Button with icon-label, aForm
     and pressAction, aBlock.  Button is placed into aView."

    ^ ((self in:aView) form:aForm) action:aBlock
!

okButtonIn:aView
    "since ok-buttons are very common, here is a convenient
     method to create one ..."

    |aButton|

    aButton := Button 
		    label:(self classResources at:'ok')
		    in:aView.
    aButton cursor:(Cursor thumbsUp).
    aButton isReturnButton:true.
    ^ aButton
!

abortButtonIn:aView
    "since abort-buttons are very common, here is a convenient
     method to create one ..."

    |aButton|

    aButton := Button 
		    label:(self classResources at:'abort')
		    in:aView.
    aButton cursor:(Cursor thumbsDown).
    ^ aButton
! !

!Button methodsFor:'initialization'!

initialize
    super initialize.

    actionWhenPressed := false.
    enabled := true.
    active := false.
    pressed := false.
    entered := false.
    autoRepeat := false.
    initialDelay := self class defaultInitialDelay.
    repeatDelay := self class defaultRepeatDelay.
    isReturnButton := false.
!

initStyle
    |hasGreyscales nm|

    super initStyle.

    DefaultFont notNil ifTrue:[
	font := DefaultFont on:device
    ].

    DefaultFont notNil ifTrue:[font := DefaultFont on:device].
    DefaultForegroundColor notNil ifTrue:[fgColor := DefaultForegroundColor on:device].
    DefaultBackgroundColor notNil ifTrue:[bgColor := DefaultBackgroundColor on:device].

    softEdge := DefaultSoftEdge.

    onLevel := DefaultActiveLevel.
    offLevel := DefaultPassiveLevel.

    DefaultDisabledForegroundColor notNil ifTrue:[
	disabledFgColor := DefaultDisabledForegroundColor on:device
    ] ifFalse:[
	disabledFgColor := fgColor
    ].

    DefaultEnteredForegroundColor notNil ifTrue:[enteredFgColor := DefaultEnteredForegroundColor on:device].
    DefaultEnteredBackgroundColor notNil ifTrue:[enteredBgColor := DefaultEnteredBackgroundColor on:device].
    DefaultActiveForegroundColor notNil ifTrue:[activeFgColor := DefaultActiveForegroundColor on:device].
    DefaultActiveBackgroundColor notNil ifTrue:[activeBgColor := DefaultActiveBackgroundColor on:device].

    halfShadowColor := shadowColor := nil.

    shadowColor := Black.

    hasGreyscales := device hasGreyscales.
    softEdge ifTrue:[
	hasGreyscales ifTrue:[
	    halfShadowColor := Color darkGrey
	]
    ].

    nm := StyleSheet name asSymbol.

    (nm == #mswindows) ifTrue:[
    ] ifFalse:[
	(nm == #iris) ifTrue:[
	    enteredFgColor := fgColor.
	    hasGreyscales ifTrue:[
		DefaultEnteredBackgroundColor isNil ifTrue:[
		    enteredBgColor := bgColor lightened "Color lightGrey".
		].
		DefaultActiveBackgroundColor isNil ifTrue:[
		    activeBgColor := enteredBgColor.
		].
		DefaultActiveForegroundColor isNil ifTrue:[
		    activeFgColor := enteredFgColor.
		].
	    ] ifFalse:[
		DefaultEnteredBackgroundColor isNil ifTrue:[
		    enteredBgColor := Color veryLightGrey.
		].
		DefaultActiveBackgroundColor isNil ifTrue:[
		    activeBgColor := Black.
		].
		DefaultActiveForegroundColor isNil ifTrue:[
		    activeFgColor := White.
		].
	    ].
	] ifFalse:[
	    nm == #motif ifTrue:[
		hasGreyscales ifTrue:[
		    lightColor := Color lightGrey
		]
	    ] ifFalse:[
		nm == #st80 ifTrue:[
		    hasGreyscales ifTrue:[
			DefaultActiveForegroundColor isNil ifTrue:[
			    activeFgColor := fgColor.
			].
			DefaultActiveBackgroundColor isNil ifTrue:[
			    activeBgColor := bgColor darkened.
			].
		    ] ifFalse:[
			DefaultActiveForegroundColor isNil ifTrue:[
			    activeFgColor := White.
			].
			DefaultActiveBackgroundColor isNil ifTrue:[
			    activeBgColor := Black
			].
		    ]
		]
	    ]
	]
    ].

    activeFgColor isNil ifTrue:[
	activeFgColor := bgColor
    ].
    activeBgColor isNil ifTrue:[
	activeBgColor := fgColor
    ].

    offLevel ~~ level ifTrue:[
	self level:offLevel.
	margin := (onLevel abs) max:(offLevel abs).
    ].

    DefaultReturnButtonHasImage ifTrue:[
	(StyleSheet is3D and:[hasGreyscales]) ifTrue:[
	    shadowForm := self class returnShadowFormOn:device.
	    lightForm := self class returnLightFormOn:device.
	    formColor := viewBackground.
	    formShadowColor := shadowColor.
	    formLightColor := lightColor
	] ifFalse:[
	    shadowForm := self class returnFormOn:device.
	    formColor := Black
	].
    ].
!

XXinitStyle
    |hasGreyscales|

    super initStyle.

    onLevel := -1.
    offLevel := 1.
    softEdge := false.

    disabledFgColor := Color grey.
    enteredFgColor := fgColor.
    enteredBgColor := bgColor.
    activeFgColor := activeBgColor := nil.
    enteredFgColor := enteredBgColor := nil.
    halfShadowColor := shadowColor := nil.

    shadowColor := Black.

    hasGreyscales := device hasGreyscales.

    (style == #next) ifTrue:[
	softEdge := true.
	onLevel := 1.
	offLevel := 2.
	hasGreyscales ifTrue:[
	    activeFgColor := Black.
	    activeBgColor := White.
	    enteredFgColor := fgColor.
	    enteredBgColor := Color lightGrey.
	    halfShadowColor := Color darkGrey.
	]
    ] ifFalse:[
	(style == #openwin) ifTrue:[
	    hasGreyscales ifTrue:[
		activeFgColor := Black.
		activeBgColor := Color grey
	    ]
	] ifFalse:[
	    (style == #mswindows) ifTrue:[
		disabledFgColor := Color darkGrey.
		hasGreyscales ifTrue:[
		    offLevel := 3.
		    onLevel := -1.
		    softEdge := true.
		    fgColor := Black.
		    bgColor := Color lightGrey "Grey".
		    halfShadowColor := Color darkGrey.
		    activeFgColor := fgColor.
		    activeBgColor := bgColor
		]
	    ] ifFalse:[
		(style == #iris) ifTrue:[
		    offLevel := 3.
		    onLevel := -1.
		    softEdge := true.
		    halfShadowColor := Color darkGrey.
		    disabledFgColor := Color darkGrey.
		    enteredFgColor := fgColor.
		    hasGreyscales ifTrue:[
			enteredBgColor := bgColor lightened "Color lightGrey".
			activeBgColor := enteredBgColor.
			activeFgColor := enteredFgColor.
		    ] ifFalse:[
			enteredBgColor := Color veryLightGrey.
			activeBgColor := Black.
			activeFgColor := White.
		    ].
		] ifFalse:[
		    style == #motif ifTrue:[
			offLevel := 2.
			onLevel := -2.
			hasGreyscales ifTrue:[
			    activeFgColor := fgColor.
			    activeBgColor := bgColor.
			    lightColor := Color lightGrey
			]
		    ] ifFalse:[
			style == #st80 ifTrue:[
			    hasGreyscales ifTrue:[
				activeFgColor := fgColor.
				activeBgColor := bgColor darkened.
			    ] ifFalse:[
				activeFgColor := White.
				activeBgColor := Black
			    ]
			] ifFalse:[
			    device hasColors ifTrue:[
				activeFgColor := Color yellow
			    ] ifFalse:[
				activeFgColor := White
			    ].
			    hasGreyscales ifTrue:[
				activeBgColor := bgColor
			    ] ifFalse:[
				activeBgColor := Black
			    ]
			]
		    ]
		]
	    ]
	]
    ].

    "default for mono-displays and non-3D"
    activeFgColor isNil ifTrue:[
	activeFgColor := bgColor.
	activeBgColor := fgColor
    ].
"/    enteredFgColor isNil ifTrue:[
"/        enteredFgColor := fgColor.
"/    ].
"/    enteredBgColor isNil ifTrue:[
"/        enteredBgColor := bgColor.
"/    ].

    self level:offLevel.
    margin := (onLevel abs) max:(offLevel abs).

    ((style ~~ #normal) and:[hasGreyscales]) ifTrue:[
	shadowForm := self class returnShadowFormOn:device.
	lightForm := self class returnLightFormOn:device.
	formColor := viewBackground.
	formShadowColor := shadowColor.
	formLightColor := lightColor
    ] ifFalse:[
	shadowForm := self class returnFormOn:device.
	formColor := Black
    ].
!

initCursor
    "set up a hand cursor"

    cursor := Cursor hand
!

initEvents
    super initEvents.
    self enableButtonEvents.
    self enableEnterLeaveEvents
!

realize
    super realize.
    active := false.
    entered := false.

    fgColor := fgColor on:device.
    bgColor := bgColor on:device.
    activeFgColor notNil ifTrue:[
	activeFgColor := activeFgColor on:device.
    ].
    activeBgColor notNil ifTrue:[
	activeBgColor := activeBgColor on:device.
    ].
    enteredFgColor notNil ifTrue:[
	enteredFgColor := enteredFgColor on:device.
    ].
    enteredBgColor notNil ifTrue:[
	enteredBgColor := enteredBgColor on:device.
    ].
    formColor notNil ifTrue:[
	formColor := formColor on:device.
    ].
!

reinitialize
    super reinitialize.
    active := false.
    entered := false
! !

!Button methodsFor:'accessing'!

is3D
    "return true, if the receiver is a 3D style view"

    style == #mswindows ifTrue:[^ true].
    ^ super is3D
!

isReturnButton
    "return true, if this is a return button"

    ^ isReturnButton
!

isReturnButton:aBoolean
    "show/dont show a return-key image after the label"

    isReturnButton ~~ aBoolean ifTrue:[
	DefaultReturnButtonHasBorder ifTrue:[
	    self borderWidth:(aBoolean ifTrue:[1] ifFalse:[0])
	].
	isReturnButton := aBoolean.
	self newLayout
    ]
!
    
disable
    "disable the button"

    enabled ifTrue:[
	enabled := false.
	self redraw
    ]
!

enable
    "enable the button"

    enabled ifFalse:[
	enabled := true.
	self redraw
    ]
!

turnOffWithoutRedraw
    "turn the button off - no redraw"

    pressed := false.
    active := false.

    "do not use super level:offLevel
     - because that one does redraw the edges.
     Sure, this is no good coding style"
    level := offLevel.
    margin := level abs
!

turnOff
    "turn the button off (if not already off)"

    pressed ifTrue:[
	active := false.
	pressed := false.
	self level:offLevel.
	self redraw
    ]
!

turnOn
    "turn the button on (if not already on)"

    pressed ifFalse:[
	pressed := true.
	self level:onLevel.
	self redraw
    ]
!

pressAction
    ^ pressActionBlock
!

pressAction:aBlock
    "define the action to be performed on press"

    pressActionBlock := aBlock
!

releaseAction
    ^ releaseActionBlock
!

releaseAction:aBlock
    "define the action to be performed on release"

    releaseActionBlock := aBlock
!

action:aBlock
    "convenient method: depending on the setting of actionWhenPressed,
     either set the press-action clear any release-action or
     vice versa, set the release-action and clear the press-action."

    actionWhenPressed ifTrue:[
	releaseActionBlock := nil.
	pressActionBlock := aBlock
    ] ifFalse:[
	releaseActionBlock := aBlock.
	pressActionBlock := nil
    ]
!

autoRepeat
    "turn on autorepeat"

    autoRepeat := true.
    repeatBlock := [self repeat]
!

isOn
    "return true, if this button is currently pressed"

    ^ pressed
!

onLevel:aNumber
    "set the level of the button when pressed (i.e. how deep)"

    onLevel := aNumber.
    pressed ifTrue:[
	self level:onLevel.
	margin := onLevel abs max:offLevel abs.
	self redraw
    ]
!

onLevel
    "return the level of the button when pressed"

    ^ onLevel
!

offLevel:aNumber
    "set the level of the button when not pressed (i.e. how high)"

    offLevel := aNumber.
    pressed ifFalse:[
	self level:offLevel.
	margin := onLevel abs max:offLevel abs.
	self redraw
    ]
!

offLevel
    "return the level of the button when released"

    ^ offLevel
!

activeLogo:anImageOrString
    "define the logo to be displayed while active -
     this is optional; the default is to display the same
     (logo) in both pressed and released states."

    activeLogo := anImageOrString.
    pressed ifTrue:[
	self logo:anImageOrString
    ]
!

passiveLogo:anImageOrString
    "define the logo to be displayed while inactive -
     this is optional; the default is to display the same
     (logo) in both pressed and released states."

    passiveLogo := anImageOrString.
    pressed ifFalse:[
	self logo:anImageOrString
    ]
!

activeForegroundColor
    "return the foreground color to be used when pressed"

    ^ activeFgColor
!

activeForegroundColor:aColor
    "set the foreground color to be used when pressed"

    activeFgColor := aColor.
    pressed ifTrue:[
	self redraw
    ]
!

activeBackgroundColor
    "return the background color to be used when pressed"

    ^ activeBgColor
!

activeBackgroundColor:aColor
    "set the background color to be used when pressed"

    activeBgColor := aColor.
    pressed ifTrue:[
	self redraw
    ]
!

activeForegroundColor:fgColor backgroundColor:bgColor
    "set the colors to be used when pressed"

    activeFgColor := fgColor.
    activeBgColor := bgColor.
    pressed ifTrue:[
	self redraw
    ]
!

enteredForegroundColor
    "return the foreground color to be used when the mouse
     pointer enters the button area"

    ^ enteredFgColor
!

enteredForegroundColor:aColor
    "set the foreground color to be used when the mouse
     pointer enters the button area"

    enteredFgColor := aColor
!

enteredBackgroundColor
    "return the background color to be used when the mouse
     pointer enters the button area"

    ^ enteredBgColor
!

enteredBackgroundColor:aColor
    "set the background color to be used when the mouse
     pointer enters the button area"

    enteredBgColor := aColor
! !

!Button methodsFor:'queries'!

preferedExtent
    "return my prefered extent - this is the minimum size I would like to have"

    |extra|

    logo notNil ifTrue:[
	extra := (onLevel abs max:offLevel abs) * 2.
	self is3D ifFalse:[
"/            (logo isKindOf:Form) ifFalse:[
		"add space for a frame around"
		extra := extra + 2.
"/            ]
	].
	^ (labelWidth + extra) @ (labelHeight + extra)
    ].

    ^ super preferedExtent
! !

!Button methodsFor:'private'!

computeLabelSize
    "compute the extent needed to hold the label plus the return form"

    super computeLabelSize.
    (isReturnButton and:[shadowForm notNil]) ifTrue:[
	labelWidth := labelWidth + hSpace + shadowForm width.
	labelHeight := labelHeight max: (shadowForm height + vSpace)
    ]
!

resize
    "resize myself to make logo fit into myself.
     Redefined, since we add space for a frame around text when non-3D"

    |extra|

    logo isNil ifFalse:[
	self computeLabelOrigin.
	(relativeExtent isNil and:[extentRule isNil]) ifTrue:[
	    extra := (onLevel abs max:offLevel abs) * 2.
	    StyleSheet is3D ifFalse:[
"/                (logo isKindOf:Form) ifFalse:[
		    "add space for a rectangle around"
		    extra := extra + 2
"/                ]
	    ].
	    self extent:(labelWidth + extra) @ (labelHeight + extra)
	]
    ]
! !

!Button methodsFor:'redrawing'!

drawWith:fg and:bg
    "redraw myself with fg/bg. Use super to draw the label, add
     the return-arrow here."

    |x y sColor lColor|

    shown ifFalse:[^ self].
    super drawWith:fg and:bg.   "this draws the text"

    (isReturnButton and:[shadowForm notNil]) ifTrue:[
	y := (height - shadowForm height) // 2.
	x := width - shadowForm width - (hSpace // 2).

	formShadowColor isNil ifTrue:[
	    self paint:fg on:bg.
	    self background:bg.
	    self displayOpaqueForm:shadowForm x:x y:y.
	    ^ self
	].

	"
	 drawing form in 3d-style (i.e. with shadow and light)
	"
	(formShadowColor isColor and:[formShadowColor colorId notNil
	 and:[formLightColor isColor and:[formLightColor colorId notNil
	 and:[formColor isColor and:[formColor colorId notNil]]]]])
	ifTrue:[
	    sColor := formShadowColor.
	    lColor := formLightColor.
	] ifFalse:[
	    sColor := Black.
	    lColor := White.
	].
	self foreground:sColor.
	self displayForm:shadowForm x:x y:y.

	lightForm notNil ifTrue:[
	    self foreground:lColor.
	    self displayForm:lightForm x:x y:y.
	].
	self paint:fg.
    ]
!

showPassive
    "redraw myself passive"

    offLevel ~~ level ifTrue:[
	self level:offLevel.
    ].
    (passiveLogo notNil and:[passiveLogo ~~ logo]) ifTrue:[
	self logo:passiveLogo
    ].
    self redraw.
!

showActive
    "redraw myself active"

    onLevel ~~ level ifTrue:[
	self level:onLevel.
    ].
    (activeLogo notNil and:[activeLogo ~~ logo]) ifTrue:[
	self logo:activeLogo
    ].
    self redraw.
!

redraw
    "like redrawing a label, but hilight when pressed
     (lolight when disabled)"

    |fg bg|

    shown ifTrue:[
	active ifFalse:[
	    fg := fgColor.
	    bg := bgColor.
	    enabled ifFalse:[
		fg := disabledFgColor
	    ] ifTrue:[
		entered ifTrue:[
		    enteredFgColor notNil ifTrue:[fg := enteredFgColor].
		    enteredBgColor notNil ifTrue:[bg := enteredBgColor]
		].
		(pressed and:[entered or:[actionWhenPressed]]) ifTrue:[
		    activeFgColor isNil ifTrue:[
			onLevel == offLevel ifTrue:[
			    fg := bgColor
			]
		    ] ifFalse:[
			fg := activeFgColor.
		    ].
		    activeBgColor isNil ifTrue:[
			onLevel == offLevel ifTrue:[
			    bg := fgColor
			]
		    ] ifFalse:[
			bg := activeBgColor
		    ].
		    self is3D ifFalse:[
			self drawWith:fg and:bg .
"/                        (logo isKindOf:Form) ifFalse:[       
			    "
			     draw a rectangle around
			    "
			    self paint:fg.
			    self displayRectangleX:0 y:0 width:width height:height.
"/                        ].                                    

			^ self
		    ].
		].
	    ].
	    self drawWith:fg and:bg
	]
    ]
! !

!Button methodsFor:'event handling'!

buttonPress:button x:x y:y
    "button was pressed - if enabled, perform pressaction"

    (button == 1 or:[button == #select]) ifFalse:[
	^ super buttonPress:button x:x y:y
    ].
    pressed ifFalse:[
	enabled ifTrue:[
	    pressed := true.
	    self showActive.

	    (pressActionBlock notNil or:[model notNil]) ifTrue:[
		"
		 force output - so that button is drawn correctly in case
		 of any long-computation (at high priority)
		"
		device synchronizeOutput.
	    ].

	    active := true.

	    pressActionBlock notNil ifTrue:[
		pressActionBlock value
	    ].

	    actionWhenPressed ifTrue:[
		"the ST-80 way of doing things"
		(model notNil and:[changeSymbol notNil]) ifTrue:[
		    model perform:changeSymbol
		].
	    ].

	    active := false.

	    autoRepeat ifTrue:[
		Processor addTimedBlock:repeatBlock afterSeconds:initialDelay
	    ]
	]
    ]
!

buttonMultiPress:button x:x y:y
    ^ self buttonPress:button x:x y:y
!

buttonRelease:button x:x y:y
    "button was released - if enabled, perform releaseaction"

    (button == 1 or:[button == #select]) ifFalse:[
	^ super buttonRelease:button x:x y:y
    ].
    pressed ifTrue:[
	autoRepeat ifTrue:[
	    Processor removeTimedBlock:repeatBlock
	].
	pressed := false.
	self showPassive.
	enabled ifTrue:[
	    "
	     only perform action if released within myself
	    "
	    ((x >= 0) 
	    and:[x <= width
	    and:[y >= 0
	    and:[y <= height]]]) ifTrue:[

		(releaseActionBlock notNil or:[model notNil]) ifTrue:[
		    "
		     force output - so that button is drawn correctly in case
		     of any long-computation (at high priority)
		    "
		    device synchronizeOutput.
		].

		active := true.

		releaseActionBlock notNil ifTrue:[
		    releaseActionBlock value
		].
		actionWhenPressed ifFalse:[
		    "the ST-80 way of doing things"
		    (model notNil and:[changeSymbol notNil]) ifTrue:[
			model perform:changeSymbol
		    ].
		].

		active := false.

		enteredFgColor notNil ifTrue:[
		    self drawWith:enteredFgColor and:enteredBgColor
		]
	    ]
	]
    ]
!

pointerLeave:state
    "redraw with normal colors if they differ from enteredColors"

    entered := false.
    pressed ifTrue:[
	"
	 leave with mouse-button down;
	 stop autorepeating and/or if I am a button with
	 action on release, show passive
	"
	autoRepeat ifTrue:[
	    Processor removeTimedBlock:repeatBlock
	].
	actionWhenPressed ifFalse:[
	    self showPassive.
	]
    ] ifFalse:[
	enabled ifTrue:[
	    ((enteredFgColor notNil and:[enteredFgColor ~~ fgColor])
	    or:[enteredBgColor notNil and:[enteredBgColor ~~ bgColor]]) ifTrue:[
		self redraw
	    ]
	]
    ]
!

pointerEnter:state x:x y:y
    "redraw with enteredColors if they differ from the normal colors"

    entered := true.
    pressed ifTrue:[
	"
	 reentered after a leave with mouse-button down;
	 restart autorepeating and/or if I am a button with
	 actionWhenReleased, show active again.
	"
	enabled ifTrue:[
	    autoRepeat ifTrue:[
		Processor addTimedBlock:repeatBlock afterSeconds:initialDelay
	    ].
	    actionWhenPressed ifFalse:[
		self showActive.
	    ]
	]
    ] ifFalse:[
	enabled ifTrue:[
	    ((enteredFgColor notNil and:[enteredFgColor ~~ fgColor])
	    or:[enteredBgColor notNil and:[enteredBgColor ~~ bgColor]]) ifTrue:[
		self redraw
	    ]
	]
    ]
!

repeat
    "this is sent from the autorepeat-block, when the button has been pressed long
     enough; it simulates a release-press, by evaluating both release
     and press actions."

    pressed ifTrue:[
	enabled ifTrue:[
	    active ifFalse:[
		active := true.
		releaseActionBlock notNil ifTrue:[releaseActionBlock value].
		pressActionBlock notNil ifTrue:[pressActionBlock value].
		active := false.
"/                device synchronizeOutput.

		autoRepeat ifTrue:[
		    Processor addTimedBlock:repeatBlock afterSeconds:repeatDelay
		]
	    ]
	]
    ]
! !