The Trunk: Morphic-mt.894.mcz

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

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

Name: Morphic-mt.894
Author: mt
Time: 17 April 2015, 3:27:41.107 pm
UUID: 74790657-56d4-bb48-a3b6-b594a4da87a4
Ancestors: Morphic-mt.893

Improved implementation of pluggable buttons in terms of speed and code.

If #spaceFill, buttons may now shrink to a very narrow size. This supports low screen resolutions.

=============== Diff against Morphic-mt.893 ===============

Item was changed:
  ----- Method: PluggableButtonMorph>>drawLabelOn: (in category 'drawing') -----
  drawLabelOn: aCanvas
 
  | fontToUse labelToUse labelWidth |
+ self label ifNil: [^ self].
- label ifNil: [^ self].
 
+ self label isMorph ifTrue: [
+ self label privateFullMoveBy: (self center - self label center).
+ aCanvas fullDrawMorph: self label.
- label isMorph ifTrue: [
- label privateFullMoveBy: (self center - label center).
- aCanvas fullDrawMorph: label.
  ^ self].
 
+ labelToUse := self label asString.
+ fontToUse := self font.
- labelToUse := label asString.
- fontToUse := font ifNil: [Preferences standardButtonFont].
 
  "Support very narrow buttons."
+ (self width < self labelShrinkThreshold and: [labelToUse size > 3]) ifTrue: [
+ labelToUse := labelToUse first asString. "Show first character only."
- (self width < ((fontToUse widthOf: $m)*4) and: [labelToUse size > 3]) ifTrue: [
- labelToUse := label first asString. "Show first character only."
  fontToUse := fontToUse emphasized: (TextEmphasis bold) emphasisCode].
 
  labelWidth := fontToUse widthOfString: labelToUse.
 
  aCanvas
  drawString: labelToUse
  at: (self center x - (labelWidth //2) max: (self left + 2)) @ (self center y - (fontToUse height //2))
  font: fontToUse
+ color: Color black.!
- color: Color black.
- !

Item was changed:
  ----- Method: PluggableButtonMorph>>drawOn: (in category 'drawing') -----
  drawOn: aCanvas
 
  self drawBackgroundOn: aCanvas.
 
  aCanvas
+ clipBy: (self bounds insetBy: self layoutInset)
- clipBy: (self bounds insetBy: (2@0 corner: 2@0))
  during: [:c | self drawLabelOn: c].!

Item was added:
+ ----- Method: PluggableButtonMorph>>font (in category 'accessing') -----
+ font
+
+ ^ font ifNil: [Preferences standardButtonFont]!

Item was added:
+ ----- Method: PluggableButtonMorph>>font: (in category 'accessing') -----
+ font: aFont
+
+ font = aFont ifTrue: [^ self].
+ font := aFont.
+ self extent: self minExtent.!

Item was changed:
  ----- Method: PluggableButtonMorph>>initialize (in category 'initialize-release') -----
  initialize
  "initialize the state of the receiver"
  super initialize.
  ""
  self listDirection: #topToBottom.
  self hResizing: #shrinkWrap.
  "<--so naked buttons work right"
  self vResizing: #shrinkWrap.
+ self layoutInset: 2.
  self wrapCentering: #center;
  cellPositioning: #topCenter.
  self borderStyle: BorderStyle thinGray.
  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 extent: 20 @ 15!

Item was changed:
  ----- Method: PluggableButtonMorph>>label (in category 'accessing') -----
  label
  "Answer the DisplayObject used as this button's label."
 
+ ^ label ifNil: ['']
- ^ label
  !

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

Item was changed:
  ----- Method: PluggableButtonMorph>>label:font: (in category 'accessing') -----
  label: aStringOrTextOrMorph font: aFont
- "Label this button with the given string or morph."
 
+ self label: aStringOrTextOrMorph.
+ self font: aFont. !
- font := aFont.
- label := aStringOrTextOrMorph isText
- ifTrue: [aStringOrTextOrMorph asMorph]
- ifFalse: [aStringOrTextOrMorph].
- self changed.
- !

Item was added:
+ ----- Method: PluggableButtonMorph>>labelShrinkThreshold (in category 'drawing') -----
+ labelShrinkThreshold
+ "Determines the minimum width for labels not to be shrunk down to their first character."
+
+ ^ (self font widthOf: $m)*4!

Item was changed:
  ----- Method: PluggableButtonMorph>>minExtent (in category 'geometry') -----
  minExtent
 
+ | hMin vMin |
+ self label isMorph
+ ifTrue: [^ super minExtent max: self label minExtent].
+
+ hMin := vMin := 16.
+ self hResizing == #shrinkWrap
+ ifTrue: [hMin := (self font widthOfString: self label) max: self labelShrinkThreshold].
+ self vResizing == #shrinkWrap
+ ifTrue: [vMin := self font height].
+
+ ^ super minExtent max: ((0@0 corner: hMin @ vMin) outsetBy: self layoutInset) extent!
- ^ label isMorph
- ifTrue: [label minExtent]
- ifFalse: [16@16]!