[squeak-dev] The Trunk: MorphicTests-pre.53.mcz

patrick.rein at hpi.uni-potsdam.de patrick.rein at hpi.uni-potsdam.de
Fri Oct 4 14:05:47 UTC 2019


Hi Hannes,

yes that needs to be updated. Thanks for checking it out! I will upload a change in a few minutes.

(In the future, it would be nice If TextAnchor would work like shown in the comment. But for now we have to use the special character...)

Bests
Patrick

>The example given in the class comment of TextAnchor does not work.
>
>Workspace new
>		contents: (Text withAll: 'foo') , (Text string: '*' attribute:
>(TextAnchor new anchoredMorph: EllipseMorph new)) , (Text withAll:
>'bar');
>		openLabel: 'Text with Morph'.
>
>(Squeak 5.3-19046)
>
>Does it need to be updated?
>
>--Hannes
>
>On Fri, 4 Oct 2019 09:22:22 0000, commits at source.squeak.org
><commits at source.squeak.org> wrote:
>> 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!
>>
>>
>>
>


More information about the Squeak-dev mailing list