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

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

Name: Morphic-mt.794
Author: mt
Time: 31 March 2015, 11:38:42.253 am
UUID: 765a2201-af4c-0948-b90d-72414d335160
Ancestors: Morphic-mt.793

New-style balloon morph added and used. Can be switched back to old-style balloon morphs via preferences.

New-style balloon morphs support:
- text (not only strings)
- layouting via text paragraph (not hard-cutted via: #noLineLongerThan:)
- positioning at current hand position (if not supplied with other reference point)

In general, new-style balloon morphs have an improved readability.

=============== Diff against Morphic-mt.793 ===============

Item was changed:
  ----- Method: BalloonMorph class>>string:for:corner: (in category 'instance creation') -----
  string: str for: morph corner: cornerName 
  	"Make up and return a balloon for morph. Find the quadrant that 
  	clips the text the least, using cornerName as a tie-breaker. tk 9/12/97"
  	| tm vertices |
+ 	tm := self
+ 		getTextMorph: (str asString withNoLineLongerThan: Preferences maxBalloonHelpLineLength)
+ 		for: morph.
- 	tm := self getTextMorph: str for: morph.
  	vertices := self getVertices: tm bounds.
  	vertices := self
  				getBestLocation: vertices
  				for: morph
  				corner: cornerName.
  	^ self new color: morph balloonColor;
  		 setVertices: vertices;
  		 addMorph: tm;
  		 setTarget: morph!

Item was changed:
  ----- Method: MenuMorph>>showKeyboardHelp (in category 'keystroke helpers') -----
  showKeyboardHelp
  
  	| help |
+ 	help := self balloonMorphClass 
+ 		string: 'Enter text to narrow selection\down to matching items ' withCRs
- 	help := BalloonMorph 
- 		string: 'Enter text to\narrow selection down\to matching items ' withCRs 
  		for: self 
  		corner: #topLeft.
+ 	help popUpAt: self topCenter forHand: self activeHand!
- 	help popUpForHand: self activeHand!

Item was added:
+ ----- Method: Morph>>balloonMorphClass (in category 'halos and balloon help') -----
+ balloonMorphClass
+ 
+ 	^ NewBalloonMorph useNewBalloonMorph
+ 		ifTrue: [NewBalloonMorph]
+ 		ifFalse: [BalloonMorph]!

Item was changed:
  ----- Method: Morph>>showBalloon:hand: (in category 'halos and balloon help') -----
  showBalloon: msgString hand: aHand
  	"Pop up a balloon containing the given string,
  	first removing any existing BalloonMorphs in the world."
  
  	| w balloon h |
  	(w := self world) ifNil: [^ self].
  	h := aHand.
  	h ifNil:[
  		h := w activeHand].
+ 	balloon := self balloonMorphClass
+ 		string: msgString
- 	balloon := BalloonMorph
- 		string: (msgString asString withNoLineLongerThan: Preferences maxBalloonHelpLineLength)
  		for: self balloonHelpAligner.
  	balloon popUpFor: self hand: h.!

Item was added:
+ Morph subclass: #NewBalloonMorph
+ 	instanceVariableNames: 'balloonOwner textMorph maximumWidth orientation hasTail'
+ 	classVariableNames: 'UseNewBalloonMorph'
+ 	poolDictionaries: ''
+ 	category: 'Morphic-Widgets'!
+ 
+ !NewBalloonMorph commentStamp: 'mt 3/31/2015 10:15' prior: 0!
+ A balloon is a bubble with an optional tail. It contains rich text, which describes something about its balloon-owner.!

Item was added:
+ ----- Method: NewBalloonMorph class>>string:for: (in category 'instance creation') -----
+ string: str for: morph
+ 
+ 	^ self string: str for: morph corner: #bottomLeft!

Item was added:
+ ----- Method: NewBalloonMorph class>>string:for:corner: (in category 'instance creation') -----
+ string: message for: morph corner: symbol
+ 
+ 	^ self new
+ 		balloonOwner: morph;
+ 		setText: message;
+ 		orientation: symbol;
+ 		yourself!

Item was added:
+ ----- Method: NewBalloonMorph class>>useNewBalloonMorph (in category 'preferences') -----
+ useNewBalloonMorph
+ 
+ 	<preference: 'Use new-style balloon morphs'
+ 		category: #Morphic
+ 		description: 'The new-style balloon morphs are improved for better reading quality and support rich text.'
+ 		type: #Boolean>
+ 	^ UseNewBalloonMorph ifNil: [true]!

Item was added:
+ ----- Method: NewBalloonMorph class>>useNewBalloonMorph: (in category 'preferences') -----
+ useNewBalloonMorph: aBoolean
+ 
+ 	UseNewBalloonMorph := aBoolean.!

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

Item was added:
+ ----- Method: NewBalloonMorph>>balloonOwner: (in category 'accessing') -----
+ balloonOwner: aMorph
+ 
+ 	balloonOwner := aMorph.!

Item was added:
+ ----- Method: NewBalloonMorph>>bubbleBounds (in category 'geometry') -----
+ bubbleBounds
+ 
+ 	^ self bounds insetBy: (0 @ self tailHeight corner: 0 @ self tailHeight)!

Item was added:
+ ----- Method: NewBalloonMorph>>bubbleInset (in category 'geometry') -----
+ bubbleInset
+ 
+ 	^ 5 at 2!

Item was added:
+ ----- Method: NewBalloonMorph>>defaultBorderColor (in category 'initialization') -----
+ defaultBorderColor
+ 	
+ 	^ self defaultColor muchDarker"Color black"!

Item was added:
+ ----- Method: NewBalloonMorph>>defaultBorderWidth (in category 'initialization') -----
+ defaultBorderWidth
+ 
+ 	^ 1!

Item was added:
+ ----- Method: NewBalloonMorph>>defaultColor (in category 'initialization') -----
+ defaultColor
+ 
+ 	^ BalloonMorph balloonColor!

Item was added:
+ ----- Method: NewBalloonMorph>>drawDropShadowOn: (in category 'drawing') -----
+ drawDropShadowOn: aCanvas
+ 
+ 	aCanvas 
+ 		translateBy: self shadowOffset 
+ 		during: [ :shadowCanvas |
+ 			(shadowCanvas isVisible: self bubbleBounds) ifTrue: [
+ 				self wantsRoundedCorners
+ 					ifTrue: [shadowCanvas fillRoundRect: self bubbleBounds radius: self class preferredCornerRadius fillStyle: self shadowColor]
+ 					ifFalse: [shadowCanvas fillRectangle: self bubbleBounds fillStyle: self shadowColor]].
+ 				
+ 				self hasTail ifTrue: [
+ 					shadowCanvas
+ 						drawPolygon: self verticesForTail
+ 						fillStyle: self shadowColor]].
+ 
+ !

Item was added:
+ ----- Method: NewBalloonMorph>>drawOn: (in category 'drawing') -----
+ drawOn: aCanvas
+ 
+ 	"Bubble."
+ 	self wantsRoundedCorners
+ 		ifTrue: [aCanvas
+ 			frameAndFillRoundRect: self bubbleBounds
+ 			radius: self class preferredCornerRadius fillStyle: self fillStyle borderWidth: self borderStyle width borderColor: self borderStyle color]
+ 		ifFalse: [aCanvas
+ 			fillRectangle: self bubbleBounds
+ 			fillStyle: self fillStyle borderStyle: self borderStyle].
+ 
+ 	"Tail."
+ 	self hasTail ifTrue: [
+ 		self verticesForTail in: [:points |
+ 			| pixelOffset |
+ 			pixelOffset := points first y < points second y
+ 				ifFalse: [points first x < points second x
+ 					ifTrue: [self borderStyle width negated @ self borderStyle width] "bottomLeft"
+ 					ifFalse: [self borderStyle width @ self borderStyle width]] "bottomRight"
+ 				ifTrue: [points first x < points second x
+ 					ifTrue: [self borderStyle width negated @ self borderStyle width negated] "topLeft"
+ 					ifFalse: [self borderStyle width @ self borderStyle width negated]]. "topRight"
+ 
+ 			aCanvas
+ 				drawPolygon: points
+ 				fillStyle: self fillStyle.
+ 			aCanvas
+ 				line: points first
+ 				to: points second + pixelOffset
+ 				width: self borderStyle width
+ 				color: self borderStyle color.
+ 			aCanvas
+ 				line: points first
+ 				to: points third + pixelOffset
+ 				width: self borderStyle width
+ 				color: self borderStyle color]]!

Item was added:
+ ----- Method: NewBalloonMorph>>hasTail (in category 'accessing') -----
+ hasTail
+ 
+ 	^ hasTail ifNil: [true]!

Item was added:
+ ----- Method: NewBalloonMorph>>hasTail: (in category 'accessing') -----
+ hasTail: aBoolean
+ 
+ 	hasTail := aBoolean.!

Item was added:
+ ----- Method: NewBalloonMorph>>initialize (in category 'initialization') -----
+ initialize
+ 
+ 	super initialize.
+ 	
+ 	self
+ 		borderWidth: self defaultBorderWidth;
+ 		borderColor: self defaultBorderColor;
+ 		color: (self defaultColor alpha: 1.0); "no alpha due to drop shadow"
+ 		hasDropShadow: true;
+ 		shadowOffset: 1 at 1;
+ 		shadowColor: (self color muchDarker muchDarker alpha: 0.333);
+ 		orientation: #bottomLeft.
+ 		
+ 	MenuMorph roundedMenuCorners
+ 		ifTrue: [self cornerStyle: #rounded].
+ 
+ 	textMorph := TextMorph new
+ 		wrapFlag: false;
+ 		lock;
+ 		yourself.
+ 	
+ 	self addMorph: textMorph.!

Item was added:
+ ----- Method: NewBalloonMorph>>maximumWidth (in category 'accessing') -----
+ maximumWidth
+ 
+ 	^ maximumWidth ifNil: [
+ 		maximumWidth := (self balloonOwner balloonFont widthOf: $m) * Preferences maxBalloonHelpLineLength]!

Item was added:
+ ----- Method: NewBalloonMorph>>maximumWidth: (in category 'accessing') -----
+ maximumWidth: anInteger
+ 
+ 	maximumWidth := anInteger.!

Item was added:
+ ----- Method: NewBalloonMorph>>morphicLayerNumber (in category 'WiW support') -----
+ morphicLayerNumber
+ 
+ 	"helpful for insuring some morphs always appear in front of or behind others.
+ 	smaller numbers are in front"
+ 
+ 	^5		"Balloons are very front-like things"!

Item was added:
+ ----- Method: NewBalloonMorph>>move: (in category 'geometry') -----
+ move: targetPoint
+ 
+ 	self perform: (self orientation, #:) asSymbol with: targetPoint.!

Item was added:
+ ----- Method: NewBalloonMorph>>orientation (in category 'accessing') -----
+ orientation
+ 	"Encodes the position of the tail. #topLeft, #topRight, #bottomLeft, #bottomRight"
+ 	
+ 	^ orientation!

Item was added:
+ ----- Method: NewBalloonMorph>>orientation: (in category 'accessing') -----
+ orientation: aSymbol
+ 
+ 	orientation := aSymbol.
+ 	self changed.!

Item was added:
+ ----- Method: NewBalloonMorph>>popUpAt:forHand: (in category 'initialization') -----
+ popUpAt: point forHand: aHand
+ 	"Pop up the receiver as balloon help for the given hand"
+ 
+ 	#(bottomLeft bottomRight topLeft topRight) detect: [:nextOrientation |
+ 		self orientation: nextOrientation.
+ 		self move: point.
+ 		self bounds: (self bounds translatedToBeWithin: aHand world bounds).
+ 		(self bounds perform: self orientation) = point] ifNone: ["Keep last try."].
+ 		
+ 	aHand world addMorphFront: self.
+ 	aHand balloonHelp: self.!

Item was added:
+ ----- Method: NewBalloonMorph>>popUpFor:hand: (in category 'initialization') -----
+ popUpFor: aMorph hand: aHand
+ 	"Pop up the receiver as balloon help for the given hand"
+ 
+ 	self balloonOwner: aMorph.
+ 	self popUpForHand: aHand.!

Item was added:
+ ----- Method: NewBalloonMorph>>popUpForHand: (in category 'initialization') -----
+ popUpForHand: aHand
+ 
+ 	self popUpAt: aHand position forHand: aHand.!

Item was added:
+ ----- Method: NewBalloonMorph>>setText: (in category 'initialization') -----
+ setText: stringOrText
+ 
+ 	| text |
+ 	text := stringOrText asText.
+ 	text addAttribute: (TextFontReference toFont: (self balloonOwner ifNil: [BalloonMorph]) balloonFont).
+ 	
+ 	self textMorph wrapFlag: false.
+ 	self textMorph newContents: text.
+ 	self textMorph fullBounds.
+ 	
+ 	(self maximumWidth > 0 and: [self textMorph width > self maximumWidth])
+ 		ifTrue: [
+ 			self textMorph
+ 				wrapFlag: true;
+ 				width: self maximumWidth].
+ 		
+ 	self updateLayout.!

Item was added:
+ ----- Method: NewBalloonMorph>>tailHeight (in category 'geometry') -----
+ tailHeight
+ 	
+ 	^ 8!

Item was added:
+ ----- Method: NewBalloonMorph>>tailPosition (in category 'geometry') -----
+ tailPosition
+ 
+ 	^ self innerBounds perform: self orientation!

Item was added:
+ ----- Method: NewBalloonMorph>>tailWidth (in category 'geometry') -----
+ tailWidth
+ 	
+ 	^ 15!

Item was added:
+ ----- Method: NewBalloonMorph>>textMorph (in category 'accessing - ui') -----
+ textMorph
+ 
+ 	^ textMorph!

Item was added:
+ ----- Method: NewBalloonMorph>>updateLayout (in category 'layout') -----
+ updateLayout
+ 
+ 	self textMorph fullBounds.
+ 	self extent: self textMorph extent + (2* self bubbleInset) +  (0 @ (2*self tailHeight)).
+ 	self textMorph center: self center.!

Item was added:
+ ----- Method: NewBalloonMorph>>verticesForTail (in category 'drawing') -----
+ verticesForTail
+ 
+ 	| offset factorX factorY tpos bpos |
+ 	offset := 5 + (self wantsRoundedCorners
+ 		ifTrue: [self class preferredCornerRadius]
+ 		ifFalse: [0]).
+ 	tpos := self tailPosition.
+ 	factorX := tpos x < self center x ifTrue: [1] ifFalse: [-1].
+ 	factorY := tpos y > self center y ifTrue: [1] ifFalse: [-1].
+ 	bpos := self bubbleBounds perform: self orientation.
+ 		
+ 	^ {
+ 		tpos.
+ 		bpos + (((offset + self tailWidth) * factorX) @ (self borderStyle width negated * factorY)).
+ 		bpos + ((offset * factorX) @ (self borderStyle width negated * factorY)).}!