[Pkg] The Trunk: MorphicTests-pre.53.mcz

[commits at source.squeak.org]

Patrick Rein uploaded a new version of MorphicTests to project The Trunk:
http://source.squeak.org/trunk/MorphicTests-pre.53.mcz

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

Name: MorphicTests-pre.53
Author: pre
Time: 4 October 2019, 11:22:21.819303 am
UUID: d1d84e3f-afe5-624c-a1be-287b3465240e
Ancestors: MorphicTests-mt.52

Adds Test for the placement of text anchors

=============== Diff against MorphicTests-mt.52 ===============

Item was changed:
  SystemOrganization addCategory: #'MorphicTests-Basic'!
+ SystemOrganization addCategory: #'MorphicTests-Events'!
  SystemOrganization addCategory: #'MorphicTests-Kernel'!
  SystemOrganization addCategory: #'MorphicTests-Layouts'!
  SystemOrganization addCategory: #'MorphicTests-Support'!
  SystemOrganization addCategory: #'MorphicTests-Text Support'!
  SystemOrganization addCategory: #'MorphicTests-ToolBuilder'!
  SystemOrganization addCategory: #'MorphicTests-Widgets'!
  SystemOrganization addCategory: #'MorphicTests-Worlds'!
- SystemOrganization addCategory: #'MorphicTests-Events'!

Item was changed:
+ TestCase subclass: #TextAnchorTest
+ 	instanceVariableNames: 'anchoredMorph anchorAttribute text textMorph'
- HashAndEqualsTestCase subclass: #TextAnchorTest
- 	instanceVariableNames: ''
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'MorphicTests-Text Support'!

Item was added:
+ ----- Method: TextAnchorTest>>after:paddingChangesTo: (in category 'utility') -----
+ after: aBlock paddingChangesTo: assertBlock
+ 
+ 	anchoredMorph := TextAnchorTestMorph new.
+ 	anchorAttribute anchoredMorph: anchoredMorph.
+ 	aBlock value.
+ 	self prepareTextMorph.
+ 	assertBlock value: (textMorph paragraph lines first).	!

Item was added:
+ ----- Method: TextAnchorTest>>prepareTextMorph (in category 'utility') -----
+ prepareTextMorph
+ 
+ 	textMorph := text asMorph.
+ 	self refreshTextMorph.!

Item was added:
+ ----- Method: TextAnchorTest>>refreshTextMorph (in category 'utility') -----
+ refreshTextMorph
+ 
+ 	textMorph changed; imageForm. "This triggers a redraw and thereby positions the embedded morphs."!

Item was changed:
+ ----- Method: TextAnchorTest>>setUp (in category 'running') -----
- ----- Method: TextAnchorTest>>setUp (in category 'initialize-release') -----
  setUp
+ 
  	super setUp.
+ 	anchoredMorph := TextAnchorTestMorph new.
+ 	anchorAttribute := TextAnchor new anchoredMorph: anchoredMorph. 
+ 	text := Text streamContents: [:stream | 
+ 		stream
+ 			nextPutAll: 'Here is a contrived example ';
+ 			nextPutAll: (Text
+ 				string: Character startOfHeader asString
+ 				attributes: {
+ 					anchorAttribute. 
+ 					TextColor color: Color transparent});
+ 			nextPutAll: ' whose morph is in the center.' ].
+ 	self prepareTextMorph.!
- 	prototypes
- 		add: (TextAnchor new anchoredMorph: RectangleMorph new initialize);
- 		
- 		add: (TextAnchor new anchoredMorph: EllipseMorph new initialize) !

Item was changed:
+ ----- Method: TextAnchorTest>>testBeginWithAnAnchor (in category 'tests') -----
- ----- Method: TextAnchorTest>>testBeginWithAnAnchor (in category 'initialize-release') -----
  testBeginWithAnAnchor
+ 	
+ 	text := Text streamContents: [:stream | 
+ 		stream 
+ 			nextPutAll: (Text
+ 				string: Character startOfHeader asString
+ 				attributes: {
+ 					anchorAttribute. 
- 	| text morph model |
- 	text := Text streamContents:
- 		[ : stream | stream
- 			 nextPutAll:
- 			(Text
- 				string: (String value: 1)
- 				attributes: {TextAnchor new anchoredMorph: Morph new. 
  					TextColor color: Color transparent}) ;
+ 			nextPutAll: ' should be able to begin with an embedded object. '].
+ 	self prepareTextMorph.
+ 	self 
+ 		assert: (anchoredMorph ownerChain includes: textMorph);
+ 		assert: anchoredMorph topLeft >= textMorph topLeft.!
- 			 nextPutAll: ' should be able to begin with an embedded object. ' ].
- 	model := text -> nil.
- 	morph := PluggableTextMorph
- 		on: model
- 		text: #key
- 		accept: nil.
- 	[ morph openInWorld ] ensure: [ morph delete ]!

Item was added:
+ ----- Method: TextAnchorTest>>testHavingADocumentAnchorAndRelativeTextAnchorPosition (in category 'tests') -----
+ testHavingADocumentAnchorAndRelativeTextAnchorPosition
+ 	
+ 	anchoredMorph := Morph new.
+ 	anchoredMorph textAnchorProperties 
+ 		positionInDocument: 20 @ 10;
+ 		anchorLayout: #document.
+ 	anchorAttribute anchoredMorph: anchoredMorph.
+ 	self prepareTextMorph.
+ 	
+ 	self
+ 		assert: (anchoredMorph ownerChain includes: textMorph);
+ 		 assert: anchoredMorph topLeft >= textMorph topLeft;
+ 		 assert: anchoredMorph top > textMorph top!

Item was added:
+ ----- Method: TextAnchorTest>>testHavingADocumentAnchorShouldNotAffectTheLineHeight (in category 'tests') -----
+ testHavingADocumentAnchorShouldNotAffectTheLineHeight
+ 	
+ 	| firstLine |
+ 	anchoredMorph := Morph new.
+ 	anchoredMorph height: 50.
+ 	anchoredMorph textAnchorProperties 
+ 		positionInDocument: 20 @ 10;
+ 		anchorLayout: #document.
+ 	anchorAttribute anchoredMorph: anchoredMorph.
+ 	self prepareTextMorph.
+ 	 
+ 	firstLine := textMorph paragraph lines first.
+ 	self	
+ 		assert: (firstLine bottom - firstLine top) < 25 
+ 		description: '#document layouted anchor should not affect line height'.
+ 	!

Item was added:
+ ----- Method: TextAnchorTest>>testHavingAMultilineDocumentAnchorAndRelativeTextAnchorPosition (in category 'tests') -----
+ testHavingAMultilineDocumentAnchorAndRelativeTextAnchorPosition
+ 	
+ 	| secondLine |
+ 	text := Text streamContents: [ :stream | 
+ 		stream
+ 			nextPutAll: 'Example with more than one line.
+ Here is an example ';
+ 			nextPutAll: (Text
+ 				string: Character startOfHeader asString
+ 				attributes: {anchorAttribute});
+ 			nextPutAll: ' without a morph in the center.' ].
+ 	anchoredMorph := Morph new
+ 		height: 50;
+ 		yourself.
+ 	anchoredMorph textAnchorProperties 
+ 		positionInDocument: 20 @ 10;
+ 		anchorLayout: #document.
+ 	anchorAttribute anchoredMorph: anchoredMorph.
+ 	self prepareTextMorph.
+ 
+ 	secondLine := textMorph paragraph lines second.
+ 	self
+ 		assert: (anchoredMorph ownerChain includes: textMorph);
+ 		assert: anchoredMorph topLeft >= textMorph topLeft;
+ 		assert: anchoredMorph top > textMorph top;
+ 		assert: anchoredMorph top > secondLine top.!

Item was added:
+ ----- Method: TextAnchorTest>>testHavingAnAnchorCanBeAlignedDifferently (in category 'tests') -----
+ testHavingAnAnchorCanBeAlignedDifferently
+ 
+ 	| line |
+ 	anchoredMorph textAnchorProperties verticalAlignment: #(top baseline).
+ 	anchoredMorph textAnchorProperties padding. 1.
+ 	self prepareTextMorph.
+ 	line := textMorph paragraph lines first.
+ 	self assert: anchoredMorph top = (line top + line baseline).!

Item was added:
+ ----- Method: TextAnchorTest>>testHavingAnAnchorInTheCenter (in category 'tests') -----
+ testHavingAnAnchorInTheCenter
+ 	
+ 	self 
+ 		assert: (anchoredMorph ownerChain includes: textMorph);
+ 		assert: anchoredMorph topLeft > textMorph topLeft!

Item was added:
+ ----- Method: TextAnchorTest>>testHavingAnAnchorInTheCenterWithHorizontalPadding (in category 'tests') -----
+ testHavingAnAnchorInTheCenterWithHorizontalPadding
+ 
+ 	anchoredMorph textAnchorProperties padding. 30 at 0.
+ 	
+ 	self 
+ 		assert: (anchoredMorph ownerChain includes: textMorph);
+ 		assert: (anchoredMorph topLeft > textMorph topLeft)!

Item was added:
+ ----- Method: TextAnchorTest>>testHavingAnInlineAnchorAndRelativeTextAnchorPosition (in category 'tests') -----
+ testHavingAnInlineAnchorAndRelativeTextAnchorPosition
+ 	
+ 	| positionWithRelativePosition positionWithoutRelativePosition |
+ 	anchoredMorph textAnchorProperties 
+ 		positionInDocument: 20 at 10;
+ 		anchorLayout: #inline.  
+ 	self refreshTextMorph.
+ 	positionWithRelativePosition := anchoredMorph topLeft.
+ 	
+ 	anchoredMorph textAnchorProperties positionInDocument: nil.  
+ 	self refreshTextMorph.
+ 	positionWithoutRelativePosition := anchoredMorph topLeft.
+ 	
+ 	self	assert: positionWithRelativePosition = positionWithoutRelativePosition!

Item was added:
+ ----- Method: TextAnchorTest>>testLayoutingSetsTheMorphPosition (in category 'tests') -----
+ testLayoutingSetsTheMorphPosition
+ 	
+ 	anchoredMorph := Morph new.
+ 	anchoredMorph textAnchorProperties
+ 		anchorLayout: #inline.
+ 	anchorAttribute anchoredMorph: anchoredMorph.
+ 	self prepareTextMorph.
+ 	
+ 	textMorph position: 100 at 100.
+ 	
+ 	self assert: anchoredMorph position > (100 at 100).!

Item was added:
+ ----- Method: TextAnchorTest>>testPaddingBottom (in category 'tests-padding') -----
+ testPaddingBottom
+ 
+ 	self 
+ 		after: [
+ 			anchoredMorph height: 20.
+ 			anchoredMorph textAnchorProperties verticalAlignment: #(bottom baseline).
+ 			anchoredMorph textAnchorProperties padding: (anchoredMorph textAnchorProperties padding bottom: 10)]
+ 		paddingChangesTo: [:line | 
+ 			self assert: anchoredMorph bottom + 10 = line baseline ]!

Item was added:
+ ----- Method: TextAnchorTest>>testPaddingBottomAndBottom (in category 'tests-padding') -----
+ testPaddingBottomAndBottom
+ 
+ 	self 
+ 		after: [
+ 			anchoredMorph height: 20.
+ 			anchoredMorph textAnchorProperties verticalAlignment: #(bottom bottom).
+ 			anchoredMorph textAnchorProperties padding: (anchoredMorph textAnchorProperties padding bottom: 10)]
+ 		paddingChangesTo: [:line | 
+ 			self assert: anchoredMorph bottom + 10 = line bottom ]!

Item was added:
+ ----- Method: TextAnchorTest>>testPaddingBottomAndBottomWithConvenienceAlignment (in category 'tests-padding') -----
+ testPaddingBottomAndBottomWithConvenienceAlignment
+ 
+ 	self 
+ 		after: [
+ 			anchoredMorph height: 20.
+ 			anchoredMorph textAnchorProperties verticalAlignment: #bottom.
+ 			anchoredMorph textAnchorProperties padding: (anchoredMorph textAnchorProperties padding bottom: 10)]
+ 		paddingChangesTo: [:line | 
+ 			self assert: anchoredMorph bottom + 10 = line bottom ]!

Item was added:
+ ----- Method: TextAnchorTest>>testPaddingTop (in category 'tests-padding') -----
+ testPaddingTop
+ 
+ 	self
+ 		after: [
+ 			anchoredMorph height: 20.
+ 			anchoredMorph textAnchorProperties verticalAlignment: #(top baseline).
+ 			anchoredMorph textAnchorProperties padding: (anchoredMorph textAnchorProperties padding top: 10)]
+ 		paddingChangesTo: [:line | | anchoredMorphTop |
+  			anchoredMorphTop := anchoredMorph top - textMorph top.
+  			self assert: anchoredMorphTop - 10 = line baseline ]!

Item was added:
+ ----- Method: TextAnchorTest>>testPaddingTopAndBottom (in category 'tests-padding') -----
+ testPaddingTopAndBottom
+ 	
+ 	self
+ 		after: [
+ 			anchoredMorph height: 30.
+ 			anchoredMorph textAnchorProperties verticalAlignment: #(#bottom #bottom).
+ 			anchoredMorph textAnchorProperties padding: (anchoredMorph textAnchorProperties padding bottom: 10).
+ 			anchoredMorph textAnchorProperties padding: (anchoredMorph textAnchorProperties padding top: 10).]
+ 		paddingChangesTo: [:line | 
+ 			self assert: anchoredMorph bottom + 10 = line bottom.
+ 			self deny: anchoredMorph top - 10= line top description: 'We only apply padding to the morph position'.]!

Item was added:
+ ----- Method: TextAnchorTest>>testPaddingTopAndTop (in category 'tests-padding') -----
+ testPaddingTopAndTop
+ 
+ 	self
+ 		after: [
+ 			anchoredMorph height: 20.
+ 			anchoredMorph textAnchorProperties verticalAlignment: #(top baseline).
+ 			anchoredMorph textAnchorProperties padding: (anchoredMorph textAnchorProperties padding top: 10)]
+ 		paddingChangesTo: [:line | | anchoredMorphTop |
+  			anchoredMorphTop := anchoredMorph top - textMorph top.
+  			self assert: anchoredMorphTop - 10 = line baseline ]!

Item was added:
+ ----- Method: TextAnchorTest>>testTextAnchorWithAForm (in category 'tests') -----
+ testTextAnchorWithAForm
+ 
+ 	anchorAttribute anchoredMorph: (Form dotOfSize: 60).
+ 	self prepareTextMorph.
+ 	
+ 	self 
+ 		assert: textMorph paragraph lines first baseline > 20;
+ 		assert: textMorph submorphs isEmpty!

Item was added:
+ ----- Method: TextAnchorTest>>testTextAnchorWithMorphDefiningItsOwnBaseline (in category 'tests') -----
+ testTextAnchorWithMorphDefiningItsOwnBaseline
+ 
+ 	self
+ 		after: [
+ 			anchoredMorph textAnchorProperties 
+ 				morphBaselineGetter: #myBaseline;
+ 				verticalAlignment: #(baseline baseline).
+ 			anchoredMorph height: 20]
+ 		paddingChangesTo: [:line |
+  			self assert: anchoredMorph top + 5 = line baseline ]!

Item was added:
+ ----- Method: TextAnchorTest>>testTextAnchorsDoNotBreakNormalRendering (in category 'tests') -----
+ testTextAnchorsDoNotBreakNormalRendering
+ 	
+ 	text := Text streamContents: [ :stream | 
+ 		stream
+ 			nextPutAll: 'Here is an example ';
+ 			nextPutAll: (Text
+ 				string: Character startOfHeader asString
+ 				attributes: {});
+ 			nextPutAll: ' without a morph in the center. ' ].
+ 	
+ 	[self 
+ 		shouldnt: [
+ 			self prepareTextMorph.
+ 			textMorph openInWorld] 
+ 		raise: Error] ensure: [ textMorph delete ]!

Item was added:
+ Morph subclass: #TextAnchorTestMorph
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'MorphicTests-Text Support'!

Item was added:
+ ----- Method: TextAnchorTestMorph>>initialize (in category 'initialization') -----
+ initialize
+ 
+ 	super initialize.
+ 	self height: 20.!

Item was added:
+ ----- Method: TextAnchorTestMorph>>myBaseline (in category 'text-anchor') -----
+ myBaseline
+ 
+ 	^ 5!