"
COPYRIGHT (c) 1989-93 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:'pressActionBlock releaseActionBlock
enabled pressed active
autoRepeat repeatBlock
onLevel offLevel
initialDelay repeatDelay
disabledFgColor
activeFgColor activeBgColor
enteredFgColor enteredBgColor
isReturnButton
shadowForm lightForm
formColor formShadowColor formLightColor'
classVariableNames:'returnForm returnLightForm returnShadowForm'
poolDictionaries:''
category:'Views-Interactors'
!
Button comment:'
COPYRIGHT (c) 1989-93 by Claus Gittinger
All Rights Reserved
%W% %E%
written spring/summer 89 by claus
'!
!Button class methodsFor:'documentation'!
documentation
"
Buttons are Labels which do something when pressed/released.
Instance variables:
pressActionBlock <Block> block to evaluate when pressed
releaseActionBlock <Block> block to evaluate when released
enabled <Boolean> pressing is allowed
active <Boolean> true during action evaluation (internal)
pressed <Boolean> true if currently pressed
autoRepeat <Boolean> allows auto-repeat when pressed long enough
repeatBlock <Block> block evaluated for auto-repeat
onLevel <Number> level when pressed (3D only)
offLevel <Number> level when released (3D only)
initialDelay <Number> seconds till first auto-repeat
repeatDelay <Number> seconds of repeat intervall
disabledFgColor <Color> color used to draw logo when disabled
activeFgColor <Color> color to draw logo when pressed
activeBgColor <Color> bg color when pressed
enteredFgColor <Color> color to draw logo when cursor entered
enteredBgColor <Color> bg color when cursor entered
isReturnButton <Boolean> true if this button is also activated by the
return key
shadowForm <Form> form to display in addition to buttons label
lightForm <Form> light part of shadowForm
formColor <Color> color to draw form with
formShadowColor <Color> color for shadowing the form (3D only)
formLightColor <Color> color for lighting the form (3D only)
"
! !
!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
!
returnFormOn:aDevice
"return the form used for the return arrow in non-3D;
cache the one for Display for the next round."
|f|
((aDevice == Display) and:[returnForm notNil]) 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
].
(aDevice == Display) ifTrue:[
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|
((aDevice == Display) and:[returnShadowForm notNil]) 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
].
(aDevice == Display) ifTrue:[
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|
((aDevice == Display) and:[returnLightForm notNil]) 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
].
(aDevice == Display) ifTrue:[
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
! !
!Button methodsFor:'initialization'!
initialize
super initialize.
enabled := true.
active := false.
autoRepeat := false.
initialDelay := self class defaultInitialDelay.
repeatDelay := self class defaultRepeatDelay.
pressed := false.
isReturnButton := false.
self initStyle
!
initStyle
super initStyle.
onLevel := -1.
offLevel := 1.
disabledFgColor := Color grey.
enteredFgColor := fgColor.
enteredBgColor := bgColor.
(style == #next) ifTrue:[
softEdge := true.
onLevel := 1.
offLevel := 2.
device hasGreyscales ifTrue:[
activeFgColor := Black.
activeBgColor := White.
enteredFgColor := fgColor.
enteredBgColor := Color lightGrey.
halfShadowColor := Color darkGrey.
shadowColor := Black.
]
] ifFalse:[
(style == #openwin) ifTrue:[
device hasGreyscales ifTrue:[
activeFgColor := Black.
activeBgColor := Color grey
]
] ifFalse:[
(style == #mswindows) ifTrue:[
disabledFgColor := Color darkGrey.
device hasGreyscales ifTrue:[
offLevel := 3.
onLevel := -1.
softEdge := true.
fgColor := Black.
bgColor := Grey.
halfShadowColor := Color darkGrey.
shadowColor := Black.
activeFgColor := fgColor.
activeBgColor := bgColor
]
] ifFalse:[
(style == #iris) ifTrue:[
offLevel := 3.
onLevel := -1.
softEdge := true.
halfShadowColor := Color darkGrey.
shadowColor := Black.
disabledFgColor := Color darkGrey.
enteredFgColor := fgColor.
device hasGreyscales ifTrue:[
enteredBgColor := Color lightGrey.
activeBgColor := enteredBgColor.
activeFgColor := enteredFgColor.
] ifFalse:[
enteredBgColor := Color veryLightGrey.
activeBgColor := Black.
activeFgColor := White.
].
] ifFalse:[
device hasColors ifTrue:[
activeFgColor := Color red:100 green:100 blue:0 "yellow"
] ifFalse:[
activeFgColor := White
].
device hasGreyscales ifTrue:[
activeBgColor := bgColor
] ifFalse:[
activeBgColor := Black
]
]
]
]
].
"default for mono-displays and non-3D"
activeFgColor isNil ifTrue:[
activeFgColor := White.
activeBgColor := Black
].
self level:offLevel.
margin := (onLevel abs) max:(offLevel abs).
self is3D 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.
fgColor := fgColor on:device.
bgColor := bgColor on:device.
activeFgColor := activeFgColor on:device.
activeBgColor := activeBgColor on:device.
enteredFgColor := enteredFgColor on:device.
enteredBgColor := enteredBgColor on:device.
formColor := formColor on:device.
!
reinitialize
super reinitialize.
active := false
! !
!Button methodsFor:'accessing'!
is3D
"return true, if the receiver is a 3D style view"
style == #mswindows ifTrue:[^ true].
^ super is3D
!
isReturnButton:aBoolean
"show/dont show a return-key image after the label"
isReturnButton ~~ aBoolean ifTrue:[
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.
self is3D ifTrue:[
"do not use super level:offLevel
- that one redraws the edges.
Shure, 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:aBlock
"define the action to be performed on press"
pressActionBlock := aBlock
!
releaseAction:aBlock
"define the action to be performed on release"
releaseActionBlock := aBlock
!
action:aBlock
"convenient method: define the press-action clear any release-action"
releaseActionBlock := nil.
pressActionBlock := aBlock
!
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
!
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:'private'!
computeLabelSize
"compute the extent needed to hold the label plus the return form"
super computeLabelSize.
isReturnButton 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.
self is3D ifFalse:[
(logo isKindOf:Form) ifFalse:[
"add space for a frame 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|
super drawWith:fg and:bg. "this draws the text"
isReturnButton ifTrue:[
y := (height - shadowForm height) // 2.
x := width - shadowForm width - (hSpace // 2).
self is3D ifFalse:[
self paint:fg on:bg.
self background:bg.
self drawOpaqueForm:shadowForm x:x y:y
] ifTrue:[
((formShadowColor colorId notNil)
and:[(formLightColor colorId notNil)
and:[formColor colorId notNil]])
ifTrue:[
self foreground:formColor background:(Color noColor) function:#xor.
self drawOpaqueForm:shadowForm x:x y:y.
self foreground:formShadowColor function:#or.
self drawOpaqueForm:shadowForm x:x y:y.
self foreground:formColor function:#xor.
self drawOpaqueForm:lightForm x:x y:y.
self foreground:formLightColor function:#or.
self drawOpaqueForm:lightForm x:x y:y.
self foreground:fg background:bg function:#copy
]
]
]
!
redraw
"like redrawing a label, but hilight when pressed
(lolight when disabled)"
|fg bg|
shown ifTrue:[
fg := fgColor.
bg := bgColor.
active ifFalse:[
self is3D ifTrue:[
enabled ifFalse:[
fg := disabledFgColor
] ifTrue:[
pressed ifTrue:[
fg := activeFgColor.
bg := activeBgColor
]
].
self drawWith:fg and:bg
] ifFalse:[
enabled ifFalse:[
fg := disabledFgColor.
self drawWith:fg and:bg
] ifTrue:[
pressed ifTrue:[
self drawWith:bgColor and:fgColor.
(logo isKindOf:Form) ifFalse:[
self paint:bg.
self drawRectangleX:0 y:0 width:width height:height
]
] ifFalse:[
super redraw
]
]
]
]
]
! !
!Button methodsFor:'event handling'!
buttonPress:button x:x y:y
"button was pressed - if enabled, perform pressaction"
button == 1 ifFalse:[
^ super buttonPress:button x:x y:y
].
pressed ifFalse:[
enabled ifTrue:[
pressed := true.
self level:onLevel.
self redraw.
active := true.
pressActionBlock notNil ifTrue:[device synchronizeOutput.
pressActionBlock value].
active := false.
device synchronizeOutput.
autoRepeat ifTrue:[
device addTimedBlock:repeatBlock after: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 ifFalse:[
^ super buttonRelease:button x:x y:y
].
pressed ifTrue:[
autoRepeat ifTrue:[
device removeTimedBlock:repeatBlock
].
pressed := false.
self level:offLevel.
self redraw.
enabled ifTrue:[
active := true.
releaseActionBlock notNil ifTrue:[device synchronizeOutput.
releaseActionBlock value].
active := false.
enteredFgColor notNil ifTrue:[
self drawWith:enteredFgColor and:enteredBgColor
]
]
]
!
pointerLeave:state
"redraw with normal colors if they differ from enteredColors"
pressed ifTrue:[
autoRepeat ifTrue:[
device removeTimedBlock:repeatBlock
]
] ifFalse:[
enabled ifTrue:[
enteredFgColor notNil ifTrue:[
(enteredFgColor ~~ fgColor
or:[enteredBgColor ~~ bgColor]) ifTrue:[
self drawWith:fgColor and:bgColor
]
]
]
]
!
pointerEnter:state x:x y:y
"redraw with enteredColors if they differ from the normal colors"
pressed ifTrue:[
enabled ifTrue:[
autoRepeat ifTrue:[
device addTimedBlock:repeatBlock after:initialDelay
]
]
] ifFalse:[
enabled ifTrue:[
enteredFgColor notNil ifTrue:[
(enteredFgColor ~~ fgColor
or:[enteredBgColor ~~ bgColor]) ifTrue:[
self drawWith:enteredFgColor and:enteredBgColor
]
]
]
]
!
repeat
"this is sent from the autorepeat-block, when the button has been pressed long
enough; it simulates a release-press, thereby retriggering action."
pressed ifTrue:[
enabled ifTrue:[
active ifFalse:[
active := true.
releaseActionBlock notNil ifTrue:[releaseActionBlock value].
pressActionBlock notNil ifTrue:[pressActionBlock value].
active := false.
device synchronizeOutput.
autoRepeat ifTrue:[
device addTimedBlock:repeatBlock after:repeatDelay
]
]
]
]
! !