Button.st
author claus
Mon, 06 Mar 1995 20:29:54 +0100
changeset 97 cbf495fe3b64
parent 95 7535cfca9509
child 113 fdd18cfff57e
permissions -rw-r--r--
*** empty log message ***

"
 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
			      onLevel offLevel
			      disabledFgColor
			      activeFgColor activeBgColor
			      enteredFgColor enteredBgColor
			      isReturnButton
			      shadowForm lightForm
			      formColor formShadowColor formLightColor
			      edgeStyle halfShadowColor halfLightColor'

      classVariableNames:'ReturnForm ReturnLightForm ReturnShadowForm 
		DefaultFont DefaultActiveLevel
		DefaultPassiveLevel DefaultEdgeStyle DefaultBorderWidth
		DefaultForegroundColor DefaultBackgroundColor
		DefaultDisabledForegroundColor DefaultDisabledBackgroundColor
		DefaultEnteredForegroundColor DefaultEnteredBackgroundColor
		DefaultActiveForegroundColor DefaultActiveBackgroundColor
		DefaultReturnButtonHasImage DefaultReturnButtonHasBorder
		DefaultShadowColor DefaultLightColor
		DefaultHalfShadowColor DefaultHalfLightColor'
       poolDictionaries:''
       category:'Views-Interactors'
!

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

$Header: /cvs/stx/stx/libwidg/Button.st,v 1.18 1995-03-06 19:27:48 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.18 1995-03-06 19:27:48 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)
      onLevel                 <Integer>       level when pressed (3D only) (default: depends on style)
      offLevel                <Integer>       level when released (3D only) (default: depends on style)
      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)


    styleSheet parameters:

      buttonActiveLevel       <Integer>       level when on (ignored in 2D styles)
      buttonPassiveLevel      <Integer>       level when off (ignored in 2D styles)
      buttonBorderWidth       <Integer>       default borderwidth
      buttonEdgeStyle         <Symbol>        style of edges (currently #soft or nil)
      buttonFont              <Font>          font to use for textual labels
      buttonForegroundColor   <Color>         color to draw foreground pixels (i.e. the string)
      buttonBackgroundColor   <Color>         color to draw background pixels
      buttonDisabledForegroundColor <Color>   same when disabled
      buttonDisabledBackgroundColor <Color>   same when disabled
      buttonEnteredForegroundColor  <Color>   same when mouse pointer is in
      buttonEnteredBackgroundColor  <Color>   same when mouse pointer is in
      buttonActiveForegroundColor   <Color>   same when button is active
      buttonActiveBackgroundColor   <Color>   same when button is active
      buttonShadowColor             <Color>   shadow color for edgaes (ignored in 2D styles)
      buttonLightColor              <Color>   light color for edgaes (ignored in 2D styles)
      buttonHalfShadowColor         <Color>   half shadow color; for soft edges only
      buttonHalfLightColor          <Color>   half light color; for soft edges only

      buttonReturnButtonHasImage    <Boolean> if true, return-buttons draw a return-key image
      buttonReturnButtonHasBorder   <Boolean> if true, return-buttons show a border
"
!

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

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

    for buttons with a string-label,
    and:

	b := Button form:someImage in:aView.
	b action:[ .. things to do, when pressed ... ]

    for buttons with a bitmap label.

    Although you can specify a lot in a button,
    use the default in most applications.
    As you specify more things in your program, 
    the styleSheet settings are more and more ignored.
    Also, even though it might look fancy, colorful
    button panels are usually not a good GUI design;
    they will attract the users attention - possibly to things
    which are not worth it.

    default settings:

      |top b|

      top := StandardSystemView new.
      top extent:100@100.

      b := Button label:'hello' in:top.
      b action:[Transcript flash].
      top open.


    changing colors:

      |top b|

      top := StandardSystemView new.
      top extent:100@100.

      b := Button label:'hello' in:top.
      b action:[Transcript flash].
      b activeForegroundColor:(Color white).
      b activeBackgroundColor:(Color red).
      top open.


    changing more colors:

      |top b|

      top := StandardSystemView new.
      top extent:100@100.

      b := Button label:'hello' in:top.
      b action:[Transcript flash].
      b enteredForegroundColor:(Color red).
      b enteredBackgroundColor:(b backgroundColor).
      b activeForegroundColor:(Color white).
      b activeBackgroundColor:(Color red).
      top open.


    button with an image:

      |top b|

      top := StandardSystemView new.
      top extent:100@100.

      b := Button in:top.
      b form:(Image fromFile:'bitmaps/SBrowser.xbm').
      b action:[Transcript flash].
      b enteredForegroundColor:(Color green darkened).
      b enteredBackgroundColor:(b backgroundColor).
      b activeForegroundColor:(Color white).
      b activeBackgroundColor:(Color red).
      top open.


    changing the image:

      |top b|

      top := StandardSystemView new.
      top extent:100@100.

      b := Button in:top.
      b passiveLogo:(Image fromFile:'bitmaps/SBrowser.xbm').
      b activeLogo:(Image fromFile:'bitmaps/CBrowser.xbm').
      b action:[Transcript flash].
      b enteredForegroundColor:(Color red).
      b enteredBackgroundColor:(b backgroundColor).
      b activeForegroundColor:(Color white).
      b activeBackgroundColor:(Color red).
      top open.


    well, even that is possible (but you should never do it):
    (notice the changing size and the resulting problem when
     pressed near the bottom)

      |top b|

      top := StandardSystemView new.
      top extent:100@100.

      b := Button in:top.
      b passiveLogo:(Image fromFile:'bitmaps/SmalltalkX.xbm').
      b activeLogo:#('start') asStringCollection.
      b action:[Transcript flash].
      b enteredForegroundColor:(Color red).
      b enteredBackgroundColor:(b backgroundColor).
      b activeForegroundColor:(Color white).
      b activeBackgroundColor:(Color red).
      top open.


    same as above, with frozen size 
    (make certain, that the size is ok for all possible logos):

      |top b|

      top := StandardSystemView new.
      top extent:100@100.

      b := Button in:top.
      b passiveLogo:(Image fromFile:'bitmaps/SmalltalkX.xbm').
      b activeLogo:#('go') asStringCollection.
      b action:[Transcript flash].
      b enteredForegroundColor:(Color red).
      b enteredBackgroundColor:(b backgroundColor).
      b activeForegroundColor:(Color white).
      b activeBackgroundColor:(Color red).
      b sizeFixed:true.
      top open.


    more playing with colors:

      |top b|

      top := StandardSystemView new.
      top extent:100@100.

      b := Button in:top.
      b passiveLogo:(Image fromFile:'bitmaps/SmalltalkX.xbm').
      b action:[Transcript flash].
      b foregroundColor:(Color red:0 green:80 blue:20) darkened.
      b backgroundColor:(Color grey:10).
      b enteredBackgroundColor:(Color grey:20).
      b activeForegroundColor:(Color red).
      b activeBackgroundColor:(Color grey:20).
      top open.


    fire on press (buttons in scrollbars do this):

      |top b|

      top := StandardSystemView new.
      top extent:100@100.

      b := Button label:'hello' in:top.
      b controller beTriggerOnDown.
      b action:[Transcript flash].
      top open.


    To implement fun buttons (for games, show-demos etc.), you can
    access all internal parameters (and not take the viewStyle defaults)
    as in:

	|b granite light shadow|

	b := Button label:'a nice one ?'.
	granite := Image fromFile:'bitmaps/granite_small.tiff'.
	light := granite lightened.
	shadow := granite darkened.
	b backgroundColor:granite.
	b foregroundColor:Color white.
	b shadowColor:shadow.
	b lightColor:light.
	b enteredBackgroundColor:light.
	b onLevel:-3; offLevel:5.
	b extent:(200 @ 50).
	b open

    However, in your application, you may want to read those bitmaps only once
    during startup and cache them for later reuse in some class variable
    (reading, lightning & darkening of images is a bit slow)

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

!Button class methodsFor:'defaults'!

updateStyleCache
    |defaultLevel|

    StyleSheet is3D ifTrue:[
	defaultLevel := 1.
    ] ifFalse:[
	defaultLevel := 0
    ].
    DefaultActiveLevel := StyleSheet at:'buttonActiveLevel' default:(defaultLevel negated).
    DefaultPassiveLevel := StyleSheet at:'buttonPassiveLevel' default:defaultLevel.

    DefaultEdgeStyle := StyleSheet at:'buttonEdgeStyle'.
    DefaultFont := StyleSheet fontAt:'buttonFont'.
    DefaultBorderWidth := StyleSheet at:'buttonBorderWidth'.
    DefaultForegroundColor := StyleSheet colorAt:'buttonForegroundColor'.
    DefaultBackgroundColor := StyleSheet colorAt:'buttonBackgroundColor'.
    DefaultDisabledForegroundColor := StyleSheet colorAt:'buttonDisabledForegroundColor' default:Color grey.
    DefaultDisabledBackgroundColor := StyleSheet colorAt:'buttonDisabledBackgroundColor'.
    DefaultEnteredForegroundColor := StyleSheet colorAt:'buttonEnteredForegroundColor'.
    DefaultEnteredBackgroundColor := StyleSheet colorAt:'buttonEnteredBackgroundColor'.
    DefaultActiveForegroundColor := StyleSheet colorAt:'buttonActiveForegroundColor'.
    DefaultActiveBackgroundColor := StyleSheet colorAt:'buttonActiveBackgroundColor'.
    DefaultReturnButtonHasImage := StyleSheet at:'buttonReturnButtonHasImage' default:true.
    DefaultReturnButtonHasBorder := StyleSheet at:'buttonReturnButtonHasBorder' default:false.
    DefaultShadowColor := StyleSheet colorAt:'buttonShadowColor'.
    DefaultLightColor := StyleSheet colorAt:'buttonLightColor'.
    DefaultHalfShadowColor := StyleSheet colorAt:'buttonHalfShadowColor'.
    DefaultHalfLightColor := StyleSheet colorAt:'buttonHalfLightColor'.
!

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.

    isReturnButton := false.
!

initStyle
    |hasGreyscales nm|

    super initStyle.

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

    edgeStyle := DefaultEdgeStyle.
    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].

    DefaultShadowColor notNil ifTrue:[shadowColor := DefaultShadowColor on:device].
    DefaultLightColor notNil ifTrue:[lightColor := DefaultLightColor on:device].

    shadowColor isNil ifTrue:[
	shadowColor := Black.
    ].
    lightColor isNil ifTrue:[
	lightColor := White.
    ].

    hasGreyscales := device hasGreyscales.
    (edgeStyle == #soft) ifTrue:[
	DefaultHalfShadowColor notNil ifTrue:[halfShadowColor := DefaultHalfShadowColor on:device].
	DefaultHalfLightColor notNil ifTrue:[halfLightColor := DefaultHalfLightColor on:device].

	halfShadowColor isNil ifTrue:[
"/            hasGreyscales ifTrue:[
"/                halfShadowColor := Color darkGrey
"/            ] ifFalse:[
"/                halfShadowColor := shadowColor
"/            ]
	    halfShadowColor := shadowColor lightened
	]
    ].

    "
     actually, the stuf below should not be needed
     - the styleSheet should provide values for nonGreyscale displays too
    "
    nm := StyleSheet name asSymbol.
    (nm == #iris) ifTrue:[
	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:[
	    lightColor isNil ifTrue:[
		lightColor := bgColor lightened
	    ].
"/            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
		    ]
		]
	    ]
	]
    ].

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

initCursor
    "set up a hand cursor"

    cursor := Cursor hand
!

initEvents
    super initEvents.
    self enableEnterLeaveEvents
!

realize
    super realize.
    controller active:false.
    controller entered:false.

    fgColor := fgColor on:device.
    bgColor := bgColor on:device.
    formColor notNil ifTrue:[
	formColor := formColor on:device.
    ].
!

reinitialize
    super reinitialize.
    controller notNil ifTrue:[
	controller active:false.
	controller entered:false.
    ]
!

defaultControllerClass
    ^ ButtonController
! !

!Button methodsFor:'queries'!

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

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

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

    ^ isReturnButton
! !

!Button methodsFor:'accessing'!

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"

    controller disable.
!

enable
    "enable the button"

    controller enable
!

turnOffWithoutRedraw
    "turn the button off - no redraw"

    controller pressed:false.
    controller 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)"

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

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

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

pressAction
    "return the pressAction; thats the block which gets evaluated
     when the button is pressed (if non-nil)"

    ^ controller pressAction
!

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

    controller pressAction:aBlock
!

releaseAction
    "return the releaseAction; thats the block which gets evaluated
     when the button is relreased (if non-nil)"

    ^ controller releaseAction
!

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

    controller releaseAction:aBlock
!

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

    controller action:aBlock
!

autoRepeat
    "turn on autorepeat"

    controller autoRepeat
!

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

    ^ controller pressed
!

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

    onLevel := aNumber.
    controller 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.
    controller pressed ifFalse:[
	self level:offLevel.
	margin := onLevel abs max:offLevel abs.
	self redraw
    ]
!

offLevel
    "return the level of the button when released"

    ^ offLevel
!

edgeStyle:aSymbol
    "set the edgestyle - currently only #soft or nil"

    edgeStyle := aSymbol
!

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.
    controller 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.
    controller 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.
    self redrawIfPressed
!

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

    ^ activeBgColor
!

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

    activeBgColor := aColor.
    self redrawIfPressed
!

activeForegroundColor:fgColor backgroundColor:bgColor
    "set both fg and bg colors to be used when pressed"

    activeFgColor := fgColor.
    activeBgColor := bgColor.
    self redrawIfPressed
!

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) + ViewSpacing * 2.
	self is3D ifFalse:[
	    "add space for a frame around"
	    extra := extra + 2.
	].
	^ (labelWidth + extra) @ (labelHeight + extra)
    ].

    ^ super preferedExtent
! !

!Button methodsFor:'private'!

computeLabelOrigin
    "compute the origin of the text - if  I am a returnButton,
     shift it somwehat to the right (we have already allocated the
     real estate, since computeLabelSize returned some extra space
     before)."

    super computeLabelOrigin.
    (isReturnButton and:[shadowForm notNil]) ifTrue:[
	labelOriginX := labelOriginX + hSpace + hSpace.
    ]
!

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

    super computeLabelSize.
    (isReturnButton and:[shadowForm notNil]) ifTrue:[
	labelWidth := labelWidth + (hSpace * 2) + 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'!

drawEdges
    "draw all of my 3D edges"

    self drawEdgesForX:0 y:0 width:width height:height level:level 
		shadow:shadowColor 
		light:lightColor
		halfShadow:halfShadowColor 
		halfLight:halfLightColor
		style:edgeStyle 
!

drawLeftEdge
    "draw left 3D edge into window frame"

    self drawLeftEdgeLevel:level
		    shadow:shadowColor 
		     light:lightColor
		     halfShadow:halfShadowColor 
		     halfLight:halfLightColor
		     style:edgeStyle.
!

drawRightEdge
    "draw right 3D edge into window frame"

    self drawRightEdgeLevel:level
		     shadow:shadowColor 
		      light:lightColor
		      halfShadow:halfShadowColor 
		      halfLight:halfLightColor
		      style:edgeStyle.
!

drawTopEdge
    "draw top 3D edge into window frame"

    self drawTopEdgeLevel:level
		   shadow:shadowColor 
		   light:lightColor
		   halfShadow:halfShadowColor 
		   halfLight:halfLightColor
		   style:edgeStyle.
!

drawBottomEdge
    "draw bottom 3D edge into window frame"

    self drawBottomEdgeLevel:level
		      shadow:shadowColor 
		      light:lightColor
		      halfShadow:halfShadowColor 
		      halfLight:halfLightColor
		      style:edgeStyle.
!

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 as passive"

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

showActive
    "redraw myself as active"

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

redrawIfPressed
    "redraw the button, but only if visible and currently being pressed"

    shown ifTrue:[
	controller pressed ifTrue:[
	    self redraw
	]
    ]
!

redraw
    "redraw the button. 
     Thats like redrawing a label, but use different colors when pressed
     or entered."

    |fg bg entered|

    shown ifFalse:[^ self].
    controller active ifTrue:[^ self].

    fg := fgColor.
    bg := bgColor.
    controller enabled ifFalse:[
	fg := disabledFgColor
    ] ifTrue:[
	entered := controller entered.
	entered ifTrue:[
	    enteredFgColor notNil ifTrue:[fg := enteredFgColor].
	    enteredBgColor notNil ifTrue:[bg := enteredBgColor]
	].
	(controller pressed and:[entered or:[controller isTriggerOnDown]]) 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 .
		"
		 draw a rectangle around
		"
		self paint:fg.
		self displayRectangleX:0 y:0 width:width height:height.

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