The Trunk: Morphic-mt.1219.mcz

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

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

Name: Morphic-mt.1219
Author: mt
Time: 1 August 2016, 5:14:54.536106 pm
UUID: d7730709-869a-b847-adaa-ee09107f7cdd
Ancestors: Morphic-mt.1218

Fixes a bug in the pluggable button label drawing code.

Theme the three-phase button, too.

=============== Diff against Morphic-mt.1218 ===============

Item was changed:
  ----- Method: ImageMorph>>extent: (in category 'geometry') -----
  extent: aPoint
+
+ super extent: self preferredExtent.!
- "Do nothing; my extent is determined by my image Form."
- !

Item was changed:
  ----- Method: ImageMorph>>image: (in category 'accessing') -----
  image: anImage
  self changed.
  image := anImage depth = 1
  ifTrue: [ColorForm mappingWhiteToTransparentFrom: anImage]
  ifFalse: [anImage].
+ super extent: self preferredExtent!
- super extent: image extent!

Item was added:
+ ----- Method: ImageMorph>>preferredExtent (in category 'accessing') -----
+ preferredExtent
+ ^ image ifNil: [0@0] ifNotNil: [image extent]!

Item was changed:
  ----- Method: PluggableButtonMorph>>drawLabelOn: (in category 'drawing') -----
  drawLabelOn: aCanvas
 
  | fontToUse labelToUse colorToUse 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: [self hResizing ~~ #shrinkWrap])
+ and: [labelToUse size > 3]) ifTrue: [
+ labelToUse := labelToUse first asString. "Show first character only."
+ fontToUse := fontToUse emphasized: (TextEmphasis bold) emphasisCode].
- (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].
 
  self clipSubmorphs
  ifTrue: [aCanvas clipBy: layoutBounds during: drawBlock]
  ifFalse: [drawBlock value: aCanvas]!

Item was changed:
  ImageMorph subclass: #ThreePhaseButtonMorph
+ instanceVariableNames: 'offImage pressedImage state target actionSelector arguments actWhen label font textColor'
- instanceVariableNames: 'offImage pressedImage state target actionSelector arguments actWhen'
  classVariableNames: 'AuthorModeOwner'
  poolDictionaries: ''
  category: 'Morphic-Widgets'!
 
  !ThreePhaseButtonMorph commentStamp: '<historical>' prior: 0!
  A button morph with separate images for on, off, and pressed with the mouse.
 
  When the event actWhen occurs, send actionSelector with 'arguments' to target.  For other events, default to my eventHandler.  The current event is not supplied in the arguments to the actionSelector.  
 
  image (a.k.a. onImage) may not be nil.  offImage and pressedImage may be nil.  nil there means be transparent and show the underlying object.  
 
  Tools for debugging:
  Display the images momentarily under program control (for positioning) (self is an instance).
  self state: #on.  self state: #off.
  self state: #pressed.  self state: #off.
  Display a rectangle where the button is.
  Display fillWithColor: bounds + (self world viewBox origin).
  self invalidRect: bounds.!

Item was changed:
  ----- Method: ThreePhaseButtonMorph class>>checkBox (in category 'instance creation') -----
  checkBox
  "Answer a button pre-initialized with checkbox images."
  | f |
  ^self new
  onImage: (f := ScriptingSystem formAtKey: 'CheckBoxOn');
  pressedImage: (ScriptingSystem formAtKey: 'CheckBoxPressed');
  offImage: (ScriptingSystem formAtKey: 'CheckBoxOff');
  extent: f extent + (2@0);
+ setDefaultParameters;
  yourself
  !

Item was changed:
  ----- Method: ThreePhaseButtonMorph class>>radioButton (in category 'instance creation') -----
  radioButton
  "Answer a button pre-initialized with radiobutton images."
  | f |
  ^self new
  onImage: (f := ScriptingSystem formAtKey: 'RadioButtonOn');
  pressedImage: (ScriptingSystem formAtKey: 'RadioButtonPressed');
  offImage: (ScriptingSystem formAtKey: 'RadioButtonOff');
  extent: f extent + (2@0);
+ setDefaultParameters;
  yourself
  !

Item was added:
+ ----- Method: ThreePhaseButtonMorph class>>themeProperties (in category 'preferences') -----
+ themeProperties
+
+ ^ super themeProperties, {
+ { #color. 'Colors'. 'Color of the button.' }.
+ { #font. 'Fonts'. 'Font for button title.' }.
+ { #textColor. 'Colors'. 'Color for the button title label.' }.
+ }!

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

Item was added:
+ ----- Method: ThreePhaseButtonMorph>>color: (in category 'accessing') -----
+ color: c
+
+ self onImage ifNotNil: [:form |
+ self onImage: ((form asFormOfDepth: 32) collectColors: [:col | c alpha: col alpha])].
+ self offImage ifNotNil: [:form |
+ self offImage: ((form asFormOfDepth: 32) collectColors: [:col | c alpha: col alpha])].
+ self pressedImage ifNotNil: [:form |
+ self pressedImage: ((form asFormOfDepth: 32) collectColors: [:col | c alpha: col alpha])].
+
+ ^ super color: c!

Item was added:
+ ----- Method: ThreePhaseButtonMorph>>currentImage (in category 'accessing') -----
+ currentImage
+
+ state == #off ifTrue: [^ offImage].
+ state == #pressed ifTrue: [^ pressedImage].
+ state == #on ifTrue: [^ image].
+ ^ image!

Item was changed:
  ----- Method: ThreePhaseButtonMorph>>drawOn: (in category 'drawing') -----
  drawOn: aCanvas
 
+ | imageToUse |
+
+ imageToUse := self currentImage.
+
+ imageToUse ifNotNil: [aCanvas translucentImage: imageToUse at: bounds origin].
+
+ self label ifNotNil: [:lbl |
+ aCanvas
+ drawString: lbl
+ at: bounds origin + (imageToUse ifNil: [0@0] ifNotNil: [:form | (form width @ 0) + (3@0)])
+ font: self font
+ color: self textColor].!
- state == #off ifTrue: [
- offImage ifNotNil: [aCanvas translucentImage: offImage at: bounds origin]].
- state == #pressed ifTrue: [
- pressedImage ifNotNil: [aCanvas translucentImage: pressedImage at: bounds origin]].
- state == #on ifTrue: [
- image ifNotNil: [aCanvas translucentImage: image at: bounds origin]].!

Item was added:
+ ----- Method: ThreePhaseButtonMorph>>font (in category 'accessing') -----
+ font
+ ^ font ifNil: [TextStyle defaultFont]!

Item was added:
+ ----- Method: ThreePhaseButtonMorph>>font: (in category 'accessing') -----
+ font: aFont
+ font := aFont.
+ super extent: self preferredExtent.!

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

Item was added:
+ ----- Method: ThreePhaseButtonMorph>>label: (in category 'accessing') -----
+ label: aString
+ label := aString.
+ super extent: self preferredExtent.!

Item was added:
+ ----- Method: ThreePhaseButtonMorph>>preferredExtent (in category 'accessing') -----
+ preferredExtent
+
+ | iw ih lw lh |
+ iw := self currentImage width.
+ ih := self currentImage height.
+ lw := self font widthOfString: (self label ifNil: ['']).
+ lh := self font height.
+ ^ (iw + 3 + lw) @ (ih max: lh)!

Item was added:
+ ----- Method: ThreePhaseButtonMorph>>setDefaultParameters (in category 'initialization') -----
+ setDefaultParameters
+
+ self
+ color: (self userInterfaceTheme color ifNil: [Color black]);
+ font: (self userInterfaceTheme font ifNil: [TextStyle defaultFont]);
+ textColor: (self userInterfaceTheme textColor ifNil: [Color black]).!

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

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