The Trunk: Morphic-mt.1212.mcz

Marcel Taeumel uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-mt.1212.mcz

==================== Summary ====================

Name: Morphic-mt.1212
Author: mt
Time: 31 July 2016, 11:16:13.00249 am
UUID: 33cfd9c4-1799-954f-a7fd-b73579490169
Ancestors: Morphic-mt.1211

*** Widget Refactorings and UI Themes (Part 6 of 11) ***

Some fixes and refactorings for buttons including added support for UI theming.

=============== Diff against Morphic-mt.1211 ===============

Item was changed:
+ Morph subclass: #PluggableButtonMorph
+ instanceVariableNames: 'model label font getStateSelector actionSelector getLabelSelector getMenuSelector shortcutCharacter askBeforeChanging triggerOnMouseDown offColor onColor feedbackColor showSelectionFeedback allButtons arguments argumentsProvider argumentsSelector style hoverColor borderColor textColor labelOffset'
- AlignmentMorph subclass: #PluggableButtonMorph
- instanceVariableNames: 'model label font getStateSelector actionSelector getLabelSelector getMenuSelector shortcutCharacter askBeforeChanging triggerOnMouseDown offColor onColor feedbackColor showSelectionFeedback allButtons arguments argumentsProvider argumentsSelector style'
  classVariableNames: 'GradientButton RoundedButtonCorners'
  poolDictionaries: ''
  category: 'Morphic-Pluggable Widgets'!
 
  !PluggableButtonMorph commentStamp: '<historical>' prior: 0!
  A PluggableButtonMorph is a combination of an indicator for a boolean value stored in its model and an action button. The action of a button is often, but not always, to toggle the boolean value that it shows. Its pluggable selectors are:
 
  getStateSelector fetch a boolean value from the model
  actionSelector invoke this button's action on the model
  getLabelSelector fetch this button's lable from the model
  getMenuSelector fetch a pop-up menu for this button from the model
 
  Any of the above selectors can be nil, meaning that the model does not supply behavior for the given action, and the default behavior should be used. For example, if getStateSelector is nil, then this button shows the state of a read-only boolean that is always false.
 
  The model informs its view(s) of changes by sending #changed: to itself with getStateSelector as a parameter. The view tells the model when the button is pressed by sending actionSelector.
 
  If the actionSelector takes one or more arguments, then the following are relevant:
  arguments A list of arguments to provide when the actionSelector is called.
  argumentsProvider The object that is sent the argumentSelector to obtain arguments, if dynamic
  argumentsSelector The message sent to the argumentProvider to obtain the arguments.
 
  Options:
  askBeforeChanging have model ask user before allowing a change that could lose edits
  triggerOnMouseDown do this button's action on mouse down (vs. up) transition
  shortcutCharacter a place to record an optional shortcut key
  !

Item was changed:
  ----- Method: PluggableButtonMorph class>>gradientButton: (in category 'preferences') -----
  gradientButton: aBoolean
 
+ GradientButton = aBoolean ifTrue: [^ self].
+ GradientButton := aBoolean.
+
+ PluggableButtonMorph allSubInstancesDo: [:ea | ea updateFillStyle].!
- GradientButton := aBoolean.!

Item was added:
+ ----- Method: PluggableButtonMorph class>>themeProperties (in category 'preferences') -----
+ themeProperties
+
+ ^ super themeProperties, {
+ { #borderColor. 'Colors'. 'Color of the button''s border.' }.
+ { #borderWidth. 'Borders'. 'Width of the button''s border.' }.
+ { #borderStyle. 'Borders'. 'Whether to use a plain border, inset, or outset.' }.
+ { #color. 'Colors'. 'Background color of the button.' }.
+
+ { #font. 'Fonts'. 'Font for button title.' }.
+ { #textColor. 'Colors'. 'Color for the button title label.' }.
+ }!

Item was added:
+ ----- Method: PluggableButtonMorph>>applyUserInterfaceTheme (in category 'updating') -----
+ applyUserInterfaceTheme
+
+ super applyUserInterfaceTheme.
+ self setDefaultParameters.!

Item was removed:
- ----- Method: PluggableButtonMorph>>defaultBorderWidth (in category 'initialization') -----
- defaultBorderWidth
- "answer the default border width for the receiver"
- ^ 1!

Item was removed:
- ----- Method: PluggableButtonMorph>>defaultColor (in category 'initialization') -----
- defaultColor
- "answer the default color/fill style for the receiver"
- ^ Color gray: 0.7!

Item was removed:
- ----- Method: PluggableButtonMorph>>drawBackgroundOn: (in category 'drawing') -----
- drawBackgroundOn: aCanvas
- | cc gradient borderColor fill |
- cc := self color.
- cc isTransparent ifTrue:[cc := Color gray: 0.9].
- self enabled ifFalse:[cc := Color lightGray].
- cc brightness > 0.9 ifTrue:[cc := cc adjustBrightness: 0.9 - cc brightness].
- showSelectionFeedback ifTrue:[
- borderColor := cc muchDarker.
- gradient := GradientFillStyle ramp: {
- 0.0 -> cc muchDarker.
- 0.1-> (cc adjustBrightness: -0.2).
- 0.5 -> cc.
- 0.9-> (cc adjustBrightness: -0.1).
- 1 -> cc muchDarker}.
- cc := cc muchDarker.
- ] ifFalse:[
- borderColor := Color lightGray.
- gradient := GradientFillStyle ramp: {
- 0.0 -> Color white.
- 0.1-> (cc adjustBrightness: 0.05).
- 0.6 -> (cc darker)}.
- ].
- gradient origin: bounds topLeft.
- gradient direction: 0@self height.
-
- PluggableButtonMorph gradientButton
- ifFalse: [fill := SolidFillStyle color: cc]
- ifTrue: [fill := gradient].
-
- ^ self wantsRoundedCorners
- ifTrue: [aCanvas
- frameAndFillRoundRect: self bounds
- radius: self cornerRadius
- fillStyle: fill
- borderWidth: 1
- borderColor: borderColor]
- ifFalse: [aCanvas
- frameAndFillRectangle: self bounds
- fillColor: fill asColor
- borderWidth: 1
- borderColor: borderColor darker;
- fillRectangle: self innerBounds
- fillStyle: fill]!

Item was changed:
  ----- Method: PluggableButtonMorph>>drawLabelOn: (in category 'drawing') -----
  drawLabelOn: aCanvas
 
+ | fontToUse labelToUse colorToUse labelWidth layoutBounds drawBlock |
- | fontToUse labelToUse labelWidth layoutBounds drawBlock |
  self label ifNil: [^ self].
 
  layoutBounds := self layoutBounds.
  labelToUse := self label asString.
  fontToUse := self font.
+ colorToUse := self textColorToUse.
 
  "Support very narrow buttons. Shrink text to monogram then."
  (layoutBounds width < self labelShrinkThreshold and: [labelToUse size > 3]) ifTrue: [
  labelToUse := labelToUse first asString. "Show first character only."
  fontToUse := fontToUse emphasized: (TextEmphasis bold) emphasisCode].
 
  labelWidth := fontToUse widthOfString: labelToUse.
 
  drawBlock := [:c | c
  drawString: labelToUse
  at: (layoutBounds center x - (labelWidth // 2) max: (layoutBounds left))
  @ (layoutBounds center y - (fontToUse height // 2))
  font: fontToUse
+ color: colorToUse].
- color: Color black].
 
  self clipSubmorphs
  ifTrue: [aCanvas clipBy: layoutBounds during: drawBlock]
  ifFalse: [drawBlock value: aCanvas]!

Item was changed:
  ----- Method: PluggableButtonMorph>>drawOn: (in category 'drawing') -----
  drawOn: aCanvas
 
+ (self fillStyle isColor not and: [self fillStyle isGradientFill])
+ ifTrue: [self fillStyle origin: self topLeft; direction: 0@ self height].
+
+ super drawOn: aCanvas.
- self drawBackgroundOn: aCanvas.
 
+ aCanvas
+ translateBy: self labelOffset
+ during: [:c |
+ self label isMorph
+ ifTrue: [self drawMorphLabelOn: c]
+ ifFalse: [self drawLabelOn: c]].!
- self label isMorph
- ifTrue: [self drawMorphLabelOn: aCanvas]
- ifFalse: [self drawLabelOn: aCanvas].!

Item was added:
+ ----- Method: PluggableButtonMorph>>feedbackColor (in category 'accessing') -----
+ feedbackColor
+ ^ feedbackColor!

Item was changed:
+ ----- Method: PluggableButtonMorph>>initialize (in category 'initialization') -----
- ----- Method: PluggableButtonMorph>>initialize (in category 'initialize-release') -----
  initialize
 
  super initialize.
 
  "Layout properties."
  self
  extent: 20 @ 15;
  hResizing: #shrinkWrap;
  vResizing: #shrinkWrap;
  layoutInset: (4@0 corner: 4@0);
  clipSubmorphs: true;
  wrapCentering: #center;
  cellPositioning: #topCenter.
 
- "Visuals."
- self borderStyle: BorderStyle thinGray.
-
  "Initialize instance variables."
  model := nil.
  label := nil.
  getStateSelector := nil.
  actionSelector := nil.
  getLabelSelector := nil.
  getMenuSelector := nil.
  shortcutCharacter := nil.
  askBeforeChanging := false.
  triggerOnMouseDown := false.
- onColor := self color darker.
- offColor := self color.
- feedbackColor := Color red.
- showSelectionFeedback := false.
  allButtons := nil.
  argumentsProvider := nil.
+ argumentsSelector := nil.
+
+ self setDefaultParameters.
+ !
- argumentsSelector := nil.!

Item was changed:
  ----- Method: PluggableButtonMorph>>label: (in category 'accessing') -----
  label: aStringOrTextOrMorph
 
  label = aStringOrTextOrMorph ifTrue: [^ self].
+ label := aStringOrTextOrMorph isString
+ ifFalse: [aStringOrTextOrMorph asMorph]
+ ifTrue: [aStringOrTextOrMorph].
- label := aStringOrTextOrMorph isText
- ifTrue: [aStringOrTextOrMorph asMorph]
- ifFalse: [aStringOrTextOrMorph].
 
  self updateMinimumExtent.
  self changed.!

Item was added:
+ ----- Method: PluggableButtonMorph>>labelOffset (in category 'accessing') -----
+ labelOffset
+ ^ labelOffset ifNil: [0@0]!

Item was added:
+ ----- Method: PluggableButtonMorph>>labelOffset: (in category 'accessing') -----
+ labelOffset: aPoint
+ labelOffset := aPoint.!

Item was changed:
  ----- Method: PluggableButtonMorph>>mouseDown: (in category 'event handling') -----
  mouseDown: evt
  "Details: If this button is triggered on mouse down or the event is the menu gesture, handle it immediately. Otherwise, make a list of buttons (including the receiver) for mouseMove feedback. This allows a simple radio-button effect among the button submorphs of a given morph."
 
  allButtons := nil.
  evt yellowButtonPressed ifTrue: [^ self invokeMenu: evt].
  triggerOnMouseDown
  ifTrue: [self performAction]
  ifFalse: [
  allButtons := owner submorphs select: [:m | m class = self class].
+ self updateFillStyle: evt].
- self updateFeedbackForEvt: evt].
  !

Item was changed:
  ----- Method: PluggableButtonMorph>>mouseEnter: (in category 'event handling') -----
  mouseEnter: evt
 
+ self updateFillStyle: evt.!
- "0.09375 is exact in floating point so no cumulative rounding error will occur"
- self color: (self color adjustBrightness: -0.09375)!

Item was changed:
  ----- Method: PluggableButtonMorph>>mouseLeave: (in category 'event handling') -----
  mouseLeave: evt
 
+ self updateFillStyle: evt.!
- "0.09375 is exact in floating point so no cumulative rounding error will occur"
- self color: (self color adjustBrightness: 0.09375).
- self update: nil!

Item was changed:
  ----- Method: PluggableButtonMorph>>mouseMove: (in category 'event handling') -----
  mouseMove: evt
 
  allButtons ifNil: [^ self].
+ allButtons do: [:m | m updateFillStyle: evt].!
- allButtons do: [:m | m updateFeedbackForEvt: evt].
- !

Item was changed:
  ----- Method: PluggableButtonMorph>>mouseUp: (in category 'event handling') -----
  mouseUp: evt
 
+ self updateFillStyle: evt.
+
- showSelectionFeedback := false.
- borderColor isColor ifFalse:[borderColor := #raised].
  allButtons ifNil: [^ self].
  allButtons do: [:m |
  (m containsPoint: evt cursorPoint) ifTrue: [m performAction]].
  allButtons := nil.
  self changed.
  !

Item was changed:
  ----- Method: PluggableButtonMorph>>offColor: (in category 'accessing') -----
  offColor: colorWhenOff
  "Set the fill colors to be used when this button is off."
 
+ | cc |
+ cc := colorWhenOff isTransparent ifTrue: [(Color gray: 0.9) alpha: 0.5] ifFalse: [colorWhenOff].
+ self
+ onColor: ((self userInterfaceTheme selectionModifier ifNil: [ [:c | c adjustBrightness: -0.2] ]) value: cc)
+ offColor: cc
- self onColor: onColor offColor: colorWhenOff
  !

Item was changed:
+ ----- Method: PluggableButtonMorph>>on:getState:action:label:menu: (in category 'initialization') -----
- ----- Method: PluggableButtonMorph>>on:getState:action:label:menu: (in category 'initialize-release') -----
  on: anObject getState: getStateSel action: actionSel label: labelSel menu: menuSel
 
  self model: anObject.
  getStateSelector := getStateSel.
  actionSelector := actionSel.
  getLabelSelector := labelSel.
  getMenuSelector := menuSel.
+
  self update: labelSel.
+ self update: getStateSel.
+ self updateFillStyle.!
- !

Item was changed:
  ----- Method: PluggableButtonMorph>>onColor:offColor: (in category 'accessing') -----
  onColor: colorWhenOn offColor: colorWhenOff
  "Set the fill colors to be used when this button is on/off."
 
  onColor := colorWhenOn.
  offColor := colorWhenOff.
+
+ hoverColor := (self userInterfaceTheme hoverModifier ifNil: [ [:c | c adjustBrightness: -0.1] ]) value: offColor.
+ feedbackColor := (self userInterfaceTheme feedbackModifier ifNil: [ [:c | c adjustBrightness: -0.3] ]) value: offColor.
+
+ self updateFillStyle.!
- self update: nil.
- !

Item was added:
+ ----- Method: PluggableButtonMorph>>setDefaultParameters (in category 'initialization') -----
+ setDefaultParameters
+ "change the receiver's appareance parameters"
+
+ self
+ color: (self userInterfaceTheme color ifNil: [Color gray: 0.91]);
+ borderStyle: (self userInterfaceTheme borderStyle ifNil: [BorderStyle default]);
+ borderColor: (self userInterfaceTheme borderColor ifNil: [Color gray]);
+ borderWidth: (self userInterfaceTheme borderWidth ifNil: [1]);
+ font: (self userInterfaceTheme font ifNil: [TextStyle defaultFont]);
+ textColor: (self userInterfaceTheme textColor ifNil: [Color black]).
+
+ borderColor := self borderColor.
+ self offColor: self color.!

Item was added:
+ ----- Method: PluggableButtonMorph>>textColor (in category 'accessing') -----
+ textColor
+ ^ textColor ifNil: [Color black "old instances"]!

Item was added:
+ ----- Method: PluggableButtonMorph>>textColor: (in category 'accessing') -----
+ textColor: aColor
+ textColor := aColor.
+ self changed.!

Item was added:
+ ----- Method: PluggableButtonMorph>>textColorToUse (in category 'drawing') -----
+ textColorToUse
+
+ ^ self textColor!

Item was changed:
  ----- Method: PluggableButtonMorph>>update: (in category 'updating') -----
  update: aParameter
 
+ getLabelSelector ifNotNil: [:sel |
+ aParameter == sel ifTrue: [self label: (model perform: sel)]].
+ getStateSelector ifNotNil: [:sel |
+ aParameter == sel ifTrue: [self updateFillStyle]].!
- getLabelSelector ifNotNil: [
- aParameter == getLabelSelector ifTrue: [
- self label: (model perform: getLabelSelector)]].
- self getModelState
- ifTrue: [self color: onColor]
- ifFalse: [self color: offColor].
- !

Item was removed:
- ----- Method: PluggableButtonMorph>>updateFeedbackForEvt: (in category 'events') -----
- updateFeedbackForEvt: evt
-
- | newState |
- newState := self containsPoint: evt cursorPoint.
- newState = showSelectionFeedback ifFalse: [
- borderColor isColor
- ifTrue:[showSelectionFeedback := newState]
- ifFalse:[borderColor := newState ifTrue:[#inset] ifFalse:[#raised]].
- self changed].
- !

Item was added:
+ ----- Method: PluggableButtonMorph>>updateFillStyle (in category 'updating') -----
+ updateFillStyle
+
+ self
+ updateFillStylePressing: false
+ hovering: false.!

Item was added:
+ ----- Method: PluggableButtonMorph>>updateFillStyle: (in category 'updating') -----
+ updateFillStyle: evt
+
+ self
+ updateFillStylePressing: (evt redButtonPressed and: [self containsPoint: evt position])
+ hovering: (evt redButtonPressed not and: [self containsPoint: evt position]).!

Item was added:
+ ----- Method: PluggableButtonMorph>>updateFillStylePressing:hovering: (in category 'updating') -----
+ updateFillStylePressing: isPressing hovering: isHovering
+
+ | gradient cc |
+ "Migrate old instances."
+ hoverColor ifNil: [hoverColor := onColor darker].
+
+ self labelOffset: (isPressing ifTrue: [1@1] ifFalse: [0@0]).
+
+ self getModelState
+ ifTrue: [self color: onColor]
+ ifFalse: [self color: offColor].
+ self borderColor: borderColor.
+
+ self class gradientButton ifFalse: [
+ isPressing ifTrue: [
+ self color: feedbackColor.
+ self borderColor: feedbackColor muchDarker].
+ isHovering ifTrue: [
+ self color: hoverColor.
+ self borderColor: borderColor].
+ ^ self].
+
+ isPressing ifTrue: [
+ cc := feedbackColor.
+ self borderColor: feedbackColor muchDarker.
+ gradient := GradientFillStyle ramp: {
+ 0.0 -> cc muchDarker.
+ 0.1-> (cc adjustBrightness: -0.2).
+ 0.5 -> cc.
+ 0.9-> (cc adjustBrightness: -0.1).
+ 1 -> cc muchDarker}].
+ isHovering ifTrue: [
+ cc := hoverColor.
+ gradient := GradientFillStyle ramp: {
+ 0.0 -> Color white.
+ 0.1-> (cc adjustBrightness: 0.05).
+ 0.6 -> (cc darker)}].
+ gradient ifNil: [
+ cc := self color.
+ gradient := GradientFillStyle ramp: {
+ 0.0 -> Color white.
+ 0.1-> (cc adjustBrightness: 0.05).
+ 0.6 -> (cc darker)}].
+
+ gradient origin: bounds topLeft.
+ gradient direction: 0@self height.
+
+ self fillStyle: gradient.!

Item was changed:
  ----- Method: PluggableButtonMorph>>veryDeepInner: (in category 'copying') -----
  veryDeepInner: deepCopier
  "Copy all of my instance variables.  Some need to be not copied at all, but shared.   Warning!!!!  Every instance variable defined in this class must be handled.  We must also implement veryDeepFixupWith:.  See DeepCopier class comment."
 
  super veryDeepInner: deepCopier.
  "model := model. Weakly copied"
  label := label veryDeepCopyWith: deepCopier.
  "getStateSelector := getStateSelector. a Symbol"
  "actionSelector := actionSelector. a Symbol"
  "getLabelSelector := getLabelSelector. a Symbol"
  "getMenuSelector := getMenuSelector. a Symbol"
  shortcutCharacter := shortcutCharacter veryDeepCopyWith: deepCopier.
  askBeforeChanging := askBeforeChanging veryDeepCopyWith: deepCopier.
  triggerOnMouseDown := triggerOnMouseDown veryDeepCopyWith: deepCopier.
  offColor := offColor veryDeepCopyWith: deepCopier.
  onColor := onColor veryDeepCopyWith: deepCopier.
  feedbackColor := feedbackColor veryDeepCopyWith: deepCopier.
+ hoverColor := hoverColor veryDeepCopyWith: deepCopier.
+ borderColor := borderColor veryDeepCopyWith: deepCopier.
+ textColor := textColor veryDeepCopyWith: deepCopier.
+ labelOffset := labelOffset veryDeepCopyWith: deepCopier.
- showSelectionFeedback := showSelectionFeedback veryDeepCopyWith: deepCopier.
  allButtons := nil. "a cache"
  arguments := arguments veryDeepCopyWith: deepCopier.
  argumentsProvider := argumentsProvider veryDeepCopyWith: deepCopier.
  "argumentsSelector := argumentsSelector.   a Symbol"
  style := style.  "a Symbol"!