The Trunk: Morphic-mt.949.mcz

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

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

Name: Morphic-mt.949
Author: mt
Time: 29 April 2015, 6:10:07.123 pm
UUID: ae7e2d05-a8ce-1b43-90d8-cfd0913be43b
Ancestors: Morphic-mt.948

Fixed minor glitches in buttons.

=============== Diff against Morphic-mt.948 ===============

Item was changed:
  ----- 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
- frameAndFillRoundRect: bounds
  radius: self class preferredCornerRadius
  fillStyle: fill
  borderWidth: 1
  borderColor: borderColor]
  ifFalse: [aCanvas
+ frameAndFillRectangle: self bounds
- frameAndFillRectangle: self innerBounds
  fillColor: fill asColor
  borderWidth: 1
  borderColor: borderColor darker;
+ fillRectangle: self innerBounds
- fillRectangle: (self innerBounds insetBy: 1)
  fillStyle: fill]!

Item was changed:
  ----- Method: PluggableButtonMorph>>drawLabelOn: (in category 'drawing') -----
  drawLabelOn: aCanvas
 
+ | fontToUse labelToUse labelWidth layoutBounds drawBlock |
- | fontToUse labelToUse labelWidth |
  self label ifNil: [^ self].
 
+ layoutBounds := self layoutBounds.
- self label isMorph ifTrue: [
- self label privateFullMoveBy: (self center - self label center).
- aCanvas fullDrawMorph: self label.
- ^ self].
-
  labelToUse := self label asString.
  fontToUse := self font.
 
+ "Support very narrow buttons. Shrink text to monogram then."
+ (layoutBounds width < self labelShrinkThreshold and: [labelToUse size > 3]) ifTrue: [
- "Support very narrow buttons."
- (self 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: Color black].
+
+ self clipSubmorphs
+ ifTrue: [aCanvas clipBy: layoutBounds during: drawBlock]
+ ifFalse: [drawBlock value: aCanvas]!
- aCanvas
- drawString: labelToUse
- at: (self center x - (labelWidth //2) max: (self left + 2)) @ (self center y - (fontToUse height //2))
- font: fontToUse
- color: Color black.!

Item was added:
+ ----- Method: PluggableButtonMorph>>drawMorphLabelOn: (in category 'drawing') -----
+ drawMorphLabelOn: aCanvas
+
+ | layoutBounds |
+ layoutBounds := self layoutBounds.
+
+ self label privateFullMoveBy: (layoutBounds center - self label center).
+
+ self clipSubmorphs
+ ifTrue: [aCanvas
+ clipBy: layoutBounds
+ during: [:c | c fullDrawMorph: self label]]
+ ifFalse: [aCanvas fullDrawMorph: self label].!

Item was changed:
  ----- Method: PluggableButtonMorph>>drawOn: (in category 'drawing') -----
  drawOn: aCanvas
 
  self drawBackgroundOn: aCanvas.
 
+ self label isMorph
+ ifTrue: [self drawMorphLabelOn: aCanvas]
+ ifFalse: [self drawLabelOn: aCanvas].!
- aCanvas
- clipBy: (self bounds insetBy: self layoutInset)
- during: [:c | self drawLabelOn: c].!

Item was changed:
  ----- Method: PluggableButtonMorph>>initialize (in category 'initialize-release') -----
  initialize
+
- "initialize the state of the receiver"
  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 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.
+
+ "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.!
- argumentsSelector := nil.
- self extent: 20 @ 15!

Item was changed:
  ----- 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)*3!
- ^ (self font widthOf: $m)*4!

Item was changed:
  (PackageInfo named: 'Morphic') postscript: '"Initialize the key bindings and menus"
  Editor initialize.
 
  "apply the new icons"
  MenuIcons initializeIcons.
  TheWorldMainDockingBar updateInstances.
 
  "Fix missing inset of open windows."
  SystemWindow allSubInstancesDo: [:ea |
  ea
  wantsPaneSplitters: true;
  layoutInset: ProportionalSplitterMorph gripThickness;
+ cellInset: ProportionalSplitterMorph gripThickness].
+
+ "Update minimum extents and clipping."
+ PluggableButtonMorph allSubInstancesDo: [:ea |
+ ea
+ clipSubmorphs: true;
+ updateMinimumExtent].'!
- cellInset: ProportionalSplitterMorph gripThickness].'!