I have boiled it down to the fact that the TransformMorph in the PluggableTextMorphPlus in the Workspace is causing it. You can also trigger the issue by rotating an ordinary TextMorph which renders a Text with an embedded Form. If anyone has any spontaneous thoughts I am happy to hear about them. Otherwise I will look into it in more detail next week.
I have to add that there seems to be an interaction between the Workspace and the form rendering which renders the first example broken for now. It works if you create a TextMorph instead. I have to look into this which might take a few days.
>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,
[hidden email]>> 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) <>
>>> + 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@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@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@100.
>>> +
>>> + self assert: anchoredMorph position > (100@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!
>>>
>>>
>>>
>>
>
Locked
does not work:
