The Trunk: Morphic-pre.1554.mcz

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

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

Name: Morphic-pre.1554
Author: pre
Time: 4 October 2019, 11:21:20.163303 am
UUID: c669571c-ae48-b84f-b6da-efffc8b20250
Ancestors: Morphic-pre.1553

Adds new text anchor properties, redos the menu for Morphs to configure text anchors, adds examples for text anchor alignments

=============== Diff against Morphic-pre.1553 ===============

Item was changed:
  ----- Method: Morph>>addTextAnchorMenuItems:hand: (in category 'text-anchor') -----
  addTextAnchorMenuItems: topMenu hand: aHand
+
+ ^ self textAnchorProperties
+ addTextAnchorMenuItems: topMenu
+ hand: aHand
+ for: self!
- | aMenu |
- aMenu := MenuMorph new defaultTarget: self.
- aMenu addUpdating: #hasInlineAnchorString action: #changeInlineAnchor.
- aMenu addUpdating: #hasParagraphAnchorString action: #changeParagraphAnchor.
- aMenu addUpdating: #hasDocumentAnchorString action: #changeDocumentAnchor.
- topMenu ifNotNil:[topMenu add: 'text anchor' subMenu: aMenu].
- ^aMenu!

Item was removed:
- ----- Method: Morph>>changeDocumentAnchor (in category 'text-anchor') -----
- changeDocumentAnchor
- "Change the anchor from/to document anchoring"
-
- | newType |
- newType := self textAnchorType == #document
- ifTrue: [#paragraph]
- ifFalse: [ #document].
- owner isTextMorph
- ifTrue:
- [owner
- anchorMorph: self
- at: self position
- type: newType]!

Item was removed:
- ----- Method: Morph>>changeInlineAnchor (in category 'text-anchor') -----
- changeInlineAnchor
- "Change the anchor from/to line anchoring"
-
- | newType |
- newType := self textAnchorType == #inline
- ifTrue: [#paragraph]
- ifFalse: [#inline].
- owner isTextMorph
- ifTrue:
- [owner
- anchorMorph: self
- at: self position
- type: newType]!

Item was removed:
- ----- Method: Morph>>changeParagraphAnchor (in category 'text-anchor') -----
- changeParagraphAnchor
- "Change the anchor from/to paragraph anchoring"
-
- | newType |
- newType := self textAnchorType == #paragraph
- ifTrue: [#document]
- ifFalse: [#paragraph].
- owner isTextMorph
- ifTrue:
- [owner
- anchorMorph: self
- at: self position
- type: newType]!

Item was removed:
- ----- Method: Morph>>hasDocumentAnchorString (in category 'text-anchor') -----
- hasDocumentAnchorString
- ^ (self textAnchorType == #document
- ifTrue: ['<on>']
- ifFalse: ['<off>'])
- , 'Document' translated!

Item was removed:
- ----- Method: Morph>>hasInlineAnchorString (in category 'text-anchor') -----
- hasInlineAnchorString
- ^ (self textAnchorType == #inline
- ifTrue: ['<on>']
- ifFalse: ['<off>'])
- , 'Inline' translated!

Item was removed:
- ----- Method: Morph>>hasParagraphAnchorString (in category 'text-anchor') -----
- hasParagraphAnchorString
- ^ (self textAnchorType == #paragraph
- ifTrue: ['<on>']
- ifFalse: ['<off>'])
- , 'Paragraph' translated!

Item was removed:
- ----- Method: Morph>>relativeTextAnchorPosition (in category 'text-anchor') -----
- relativeTextAnchorPosition
- ^self valueOfProperty: #relativeTextAnchorPosition!

Item was removed:
- ----- Method: Morph>>relativeTextAnchorPosition: (in category 'text-anchor') -----
- relativeTextAnchorPosition: aPoint
- ^self setProperty: #relativeTextAnchorPosition toValue: aPoint!

Item was added:
+ ----- Method: Morph>>textAnchorProperties (in category 'text-anchor') -----
+ textAnchorProperties
+
+ ^ self valueOfProperty: #textAnchorProperties ifAbsentPut: [TextAnchorProperties new]!

Item was removed:
- ----- Method: Morph>>textAnchorType (in category 'text-anchor') -----
- textAnchorType
- ^self valueOfProperty: #textAnchorType ifAbsent:[#document]!

Item was removed:
- ----- Method: Morph>>textAnchorType: (in category 'text-anchor') -----
- textAnchorType: aSymbol
- aSymbol == #document
- ifTrue:[^self removeProperty: #textAnchorType]
- ifFalse:[^self setProperty: #textAnchorType toValue: aSymbol].!

Item was added:
+ ----- Method: TextAnchor class>>alignmentExamples (in category 'examples') -----
+ alignmentExamples
+ "self alignmentExamples"
+ | anchoredMorph textMorph text demoMorph |
+ demoMorph := Morph new
+ changeTableLayout;
+ color: Color white;
+ hResizing: #shrinkWrap;
+ vResizing: #shrinkWrap;
+ yourself.
+ #(top center bottom) do: [:morphAlignment |
+ #(top center baseline bottom) do: [:textAlignment |
+ anchoredMorph := Morph new.
+ anchoredMorph textAnchorProperties verticalAlignment: {morphAlignment . textAlignment}.
+ anchoredMorph textAnchorProperties padding: (anchoredMorph textAnchorProperties padding top: 10).
+ text := Text streamContents: [ :stream |
+ stream
+ nextPutAll: ('Here is an {1}, {2} example: ' format: {morphAlignment . textAlignment});
+ nextPutAll: (Text
+ string: Character startOfHeader asString
+ attributes: {TextAnchor new anchoredMorph: anchoredMorph.
+ TextColor color: Color transparent});
+ nextPutAll: ' with the morph in the text.'].
+ textMorph := text asMorph.
+ textMorph height: 100.
+ demoMorph addMorph: textMorph]].
+ demoMorph openInWorld!

Item was changed:
  ----- Method: TextAnchor>>emphasizeScanner: (in category 'visiting') -----
  emphasizeScanner: scanner
+ "Do nothing for emphasizing the scanner - if the anchor is valid, a #embeddedObject will be encountered by the scanner and do the real thing"!
- "Do nothing for emphasizing the scanner - if the anchor is valid a #embeddedObject will be encountered by the scanner and do the real thing"!

Item was added:
+ ----- Method: TextAnchor>>shoutShouldPreserve (in category 'testing') -----
+ shoutShouldPreserve
+
+ ^ true!

Item was added:
+ Object subclass: #TextAnchorProperties
+ instanceVariableNames: 'padding verticalAlignmentLine verticalAlignmentMorph consumesHorizontalSpace relativePosition anchorLayout positionInDocument morphBaselineGetter'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Morphic-Text Support'!
+
+ !TextAnchorProperties commentStamp: 'pre 6/27/2019 18:29' prior: 0!
+ A TextAnchorProperties describes the positioning of a morph in a text document included through a TextAnchor. The properties describe:
+ - general alignment of the morph (e.g. within the line or relative to the document)
+ - vertical alignment within a line
+ - padding applied in addition to the vertical alignment
+ - whether it consumes horizontal space when layouted inline
+ !

Item was added:
+ ----- Method: TextAnchorProperties>>addTextAnchorMenuItems:hand:for: (in category 'menu') -----
+ addTextAnchorMenuItems: topMenu hand: aHand for: aMorph
+
+ | layoutTypeMenu anchorMenu morphAlignmentMenu lineAlignmentMenu |
+ layoutTypeMenu := MenuMorph new defaultTarget: self.
+ layoutTypeMenu
+ addUpdating: #hasInlineAnchorString
+ target: self
+ selector: #toggleInlineAnchorIn:
+ argumentList: {aMorph}.
+ layoutTypeMenu
+ addUpdating: #hasDocumentAnchorString
+ target: self
+ selector: #toggleDocumentAnchorIn:
+ argumentList: {aMorph}.
+
+ morphAlignmentMenu := MenuMorph new defaultTarget: self.
+ #(morphAlignmentIsBottomString #bottom
+ morphAlignmentIsBaselineString #baseline
+ morphAlignmentIsCenterString #center  
+ morphAlignmentIsTopString #top) pairsDo: [:labelGetter :alignment |
+ morphAlignmentMenu
+ addUpdating: labelGetter
+ target: self
+ selector: #changeMorphAlignmentFor:to:
+ argumentList: {aMorph . alignment}].
+
+ lineAlignmentMenu := MenuMorph new defaultTarget: self.
+ #(lineAlignmentIsBottomString #bottom
+ lineAlignmentIsBaselineString #baseline
+ lineAlignmentIsCenterString #center  
+ lineAlignmentIsTopString #top) pairsDo: [:labelGetter :alignment |
+ lineAlignmentMenu
+ addUpdating: labelGetter
+ target: self
+ selector: #changeLineAlignmentFor:to:
+ argumentList: {aMorph . alignment}].
+
+ anchorMenu := MenuMorph new defaultTarget: self.
+ anchorMenu add: 'layout type' translated subMenu: layoutTypeMenu.
+ anchorMenu add: 'morph vertical alignment' translated subMenu: morphAlignmentMenu.
+ anchorMenu add: 'line vertical alignment' translated subMenu: lineAlignmentMenu.
+
+ topMenu ifNotNil: [topMenu add: 'text anchor' translated subMenu: anchorMenu].
+ ^ anchorMenu!

Item was added:
+ ----- Method: TextAnchorProperties>>anchorLayout (in category 'accessing') -----
+ anchorLayout
+ "See anchorLayout:"
+
+ ^ anchorLayout ifNil: [self defaultAnchorLayout]!

Item was added:
+ ----- Method: TextAnchorProperties>>anchorLayout: (in category 'accessing') -----
+ anchorLayout: aSymbolOrNil
+ "Anchor layout determines how the morph is embedded into the text.
+
+ document: The morph is placed relative to the complete document.
+ The relative position is in relation to the document topLeft.
+ inline: The moph is layouted inline. The position of the morph is
+ determined through verticalAlignment and consumesHorizontalSpace."
+
+ self assert: (#(document inline nil) includes: aSymbolOrNil).
+ ^ anchorLayout := aSymbolOrNil!

Item was added:
+ ----- Method: TextAnchorProperties>>assertValidAlignment: (in category 'private') -----
+ assertValidAlignment: aSymbol
+ ^ #(top center baseline bottom) includes: aSymbol!

Item was added:
+ ----- Method: TextAnchorProperties>>changeLineAlignmentFor:to: (in category 'menu') -----
+ changeLineAlignmentFor: aMorph to: aSymbol
+
+ self verticalAlignmentLine: aSymbol.
+ self updateOwnerOf: aMorph.!

Item was added:
+ ----- Method: TextAnchorProperties>>changeMorphAlignmentFor:to: (in category 'menu') -----
+ changeMorphAlignmentFor: aMorph to: aSymbol
+
+ self verticalAlignmentMorph: aSymbol.
+ self updateOwnerOf: aMorph.!

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

Item was added:
+ ----- Method: TextAnchorProperties>>consumesHorizontalSpace: (in category 'accessing') -----
+ consumesHorizontalSpace: aBoolean
+
+ ^ consumesHorizontalSpace := aBoolean!

Item was added:
+ ----- Method: TextAnchorProperties>>defaultAnchorLayout (in category 'accessing') -----
+ defaultAnchorLayout
+
+ ^ #inline!

Item was added:
+ ----- Method: TextAnchorProperties>>defaultVerticalAlignment (in category 'default values') -----
+ defaultVerticalAlignment
+
+ ^ #(center center)!

Item was added:
+ ----- Method: TextAnchorProperties>>hasDocumentAnchorString (in category 'menu') -----
+ hasDocumentAnchorString
+
+ ^ (self anchorLayout == #document
+ ifTrue: ['<on>']
+ ifFalse: ['<off>'])
+ , 'document' translated!

Item was added:
+ ----- Method: TextAnchorProperties>>hasInlineAnchorString (in category 'menu') -----
+ hasInlineAnchorString
+
+ ^ (self anchorLayout == #inline
+ ifTrue: ['<on>']
+ ifFalse: ['<off>'])
+ , 'inline' translated!

Item was added:
+ ----- Method: TextAnchorProperties>>hasPositionInDocument (in category 'testing') -----
+ hasPositionInDocument
+
+ ^ self positionInDocument notNil!

Item was added:
+ ----- Method: TextAnchorProperties>>horizontalPadding (in category 'accessing - padding') -----
+ horizontalPadding
+
+ ^ self padding left + self padding right!

Item was added:
+ ----- Method: TextAnchorProperties>>lineAlignmentIsBaselineString (in category 'menu') -----
+ lineAlignmentIsBaselineString
+
+ ^ (self verticalAlignmentLine = #baseline
+ ifTrue: ['<on>']
+ ifFalse: ['<off>'])
+ , 'baseline' translated!

Item was added:
+ ----- Method: TextAnchorProperties>>lineAlignmentIsBottomString (in category 'menu') -----
+ lineAlignmentIsBottomString
+
+ ^ (self verticalAlignmentLine = #bottom
+ ifTrue: ['<on>']
+ ifFalse: ['<off>'])
+ , 'bottom' translated!

Item was added:
+ ----- Method: TextAnchorProperties>>lineAlignmentIsCenterString (in category 'menu') -----
+ lineAlignmentIsCenterString
+
+ ^ (self verticalAlignmentLine = #center
+ ifTrue: ['<on>']
+ ifFalse: ['<off>'])
+ , 'center' translated!

Item was added:
+ ----- Method: TextAnchorProperties>>lineAlignmentIsTopString (in category 'menu') -----
+ lineAlignmentIsTopString
+
+ ^ (self verticalAlignmentLine = #top
+ ifTrue: ['<on>']
+ ifFalse: ['<off>'])
+ , 'top' translated!

Item was added:
+ ----- Method: TextAnchorProperties>>morphAlignmentIsBaselineString (in category 'menu') -----
+ morphAlignmentIsBaselineString
+
+ ^ (self verticalAlignmentMorph = #baseline
+ ifTrue: ['<on>']
+ ifFalse: ['<off>'])
+ , 'baseline' translated!

Item was added:
+ ----- Method: TextAnchorProperties>>morphAlignmentIsBottomString (in category 'menu') -----
+ morphAlignmentIsBottomString
+
+ ^ (self verticalAlignmentMorph = #bottom
+ ifTrue: ['<on>']
+ ifFalse: ['<off>'])
+ , 'bottom' translated!

Item was added:
+ ----- Method: TextAnchorProperties>>morphAlignmentIsCenterString (in category 'menu') -----
+ morphAlignmentIsCenterString
+
+ ^ (self verticalAlignmentMorph = #center
+ ifTrue: ['<on>']
+ ifFalse: ['<off>'])
+ , 'center' translated!

Item was added:
+ ----- Method: TextAnchorProperties>>morphAlignmentIsTopString (in category 'menu') -----
+ morphAlignmentIsTopString
+
+ ^ (self verticalAlignmentMorph = #top
+ ifTrue: ['<on>']
+ ifFalse: ['<off>'])
+ , 'top' translated!

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

Item was added:
+ ----- Method: TextAnchorProperties>>morphBaselineGetter: (in category 'accessing') -----
+ morphBaselineGetter: aSymbol
+ "This sets the callback send to the anchored morph to determine the baseline
+ of the morph. The baseline should be the distance from the top of the anchored
+ morph. This can be used, e.g. when having formula morphs inside a text."
+
+ morphBaselineGetter := aSymbol!

Item was added:
+ ----- Method: TextAnchorProperties>>padding (in category 'accessing - padding') -----
+ padding
+
+ ^ padding ifNil: [0@0 corner: 0@0]!

Item was added:
+ ----- Method: TextAnchorProperties>>padding: (in category 'accessing - padding') -----
+ padding: numberOrPointOrRectangle
+
+ | newPadding |
+ newPadding := numberOrPointOrRectangle.
+ newPadding isPoint ifTrue: [
+ newPadding := newPadding corner: newPadding].
+ newPadding isNumber ifTrue: [
+ newPadding := newPadding@newPadding corner: newPadding@newPadding].
+ ^ padding := newPadding!

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

Item was added:
+ ----- Method: TextAnchorProperties>>positionInDocument: (in category 'accessing') -----
+ positionInDocument: aPoint
+ "See anchorLayout:"
+
+ ^ positionInDocument := aPoint!

Item was added:
+ ----- Method: TextAnchorProperties>>toggleDocumentAnchorIn: (in category 'menu') -----
+ toggleDocumentAnchorIn: aMorph
+ "Change the anchor from/to document anchoring"
+
+ | newType |
+ newType := self anchorLayout == #document
+ ifTrue: [#inline]
+ ifFalse: [ #document].
+ self anchorLayout: newType.
+ self updateOwnerOf: aMorph.
+ !

Item was added:
+ ----- Method: TextAnchorProperties>>toggleInlineAnchorIn: (in category 'menu') -----
+ toggleInlineAnchorIn: aMorph
+ "Change the anchor from/to line anchoring"
+
+ | newType |
+ newType := self anchorLayout == #inline
+ ifTrue: [#document]
+ ifFalse: [#inline].
+ self anchorLayout: newType.
+ self updateOwnerOf: aMorph.!

Item was added:
+ ----- Method: TextAnchorProperties>>updateOwnerOf: (in category 'private') -----
+ updateOwnerOf: aMorph
+
+ aMorph owner isTextMorph ifTrue: [
+ aMorph owner
+ anchorMorph: aMorph
+ at: aMorph position
+ type: self anchorLayout] !

Item was added:
+ ----- Method: TextAnchorProperties>>verticalAlignment: (in category 'accessing') -----
+ verticalAlignment: symbolOrTuple
+ "This method accepts tuples in which the first element designates
+ which part of the morph is aligned to which part of the text line which
+ the second element designates.
+
+ morph baseline allows for the morph to set its own baseline (see morphBaselineGetter:)"
+ symbolOrTuple isSymbol
+ ifTrue:
+ [ self
+ verticalAlignmentMorph: symbolOrTuple;
+ verticalAlignmentLine: symbolOrTuple ]
+ ifFalse:
+ [  self
+ verticalAlignmentMorph: symbolOrTuple first ;
+ verticalAlignmentLine: symbolOrTuple second ]!

Item was added:
+ ----- Method: TextAnchorProperties>>verticalAlignmentLine (in category 'accessing') -----
+ verticalAlignmentLine
+ "The vertical position within the line of text where the anchor point of the morph, specified by #verticalAlignmentMorph, should be attached."
+
+ ^ verticalAlignmentLine ifNil: [ #center ]!

Item was added:
+ ----- Method: TextAnchorProperties>>verticalAlignmentLine: (in category 'accessing') -----
+ verticalAlignmentLine: aSymbol
+ "The vertical position within the line of text where the anchor point of the morph, specified by #verticalAlignmentMorph, should be attached."
+
+ self assertValidAlignment: aSymbol.
+ verticalAlignmentLine := aSymbol!

Item was added:
+ ----- Method: TextAnchorProperties>>verticalAlignmentMorph (in category 'accessing') -----
+ verticalAlignmentMorph
+ "The vertical position of the embedded Morph where it anchors to a line of text, its position within that line specified by #verticalAlignmentLine.."
+
+ ^ verticalAlignmentMorph ifNil: [ #center ]!

Item was added:
+ ----- Method: TextAnchorProperties>>verticalAlignmentMorph: (in category 'accessing') -----
+ verticalAlignmentMorph: aSymbol
+ "The vertical position of the embedded Morph where it anchors to a line of text, its position within that line specified by #verticalAlignmentLine.."
+
+ self assertValidAlignment: aSymbol.
+ verticalAlignmentMorph := aSymbol!

Item was added:
+ ----- Method: TextAnchorProperties>>verticalPadding (in category 'accessing - padding') -----
+ verticalPadding
+
+ self verticalAlignmentMorph = #top ifTrue: [^ self padding top].
+ self verticalAlignmentMorph = #bottom ifTrue: [^ self padding bottom].
+ ^ 0!

Item was changed:
  ----- Method: TextMorph>>addMorphFront:fromWorldPosition: (in category 'submorphs-add/remove') -----
  addMorphFront: aMorph fromWorldPosition: wp
  "Overridden for more specific re-layout and positioning"
+ aMorph textAnchorProperties anchorLayout == #document
+ ifFalse:[^ self
+ anchorMorph: aMorph
+ at: wp
+ type: aMorph textAnchorProperties anchorLayout].
- aMorph textAnchorType == #document
- ifFalse:[^self anchorMorph: aMorph at: wp type: aMorph textAnchorType].
  self addMorphFront: aMorph.
  !

Item was changed:
  ----- Method: TextMorph>>anchorMorph:at:type: (in category 'anchors') -----
  anchorMorph: aMorph at: aPoint type: anchorType
+
  | relPt index newText block |
  aMorph owner == self ifTrue:[self removeMorph: aMorph].
- aMorph textAnchorType: nil.
- aMorph relativeTextAnchorPosition: nil.
  self addMorphFront: aMorph.
+
- aMorph textAnchorType: anchorType.
- aMorph relativeTextAnchorPosition: nil.
- anchorType == #document ifTrue:[^self].
  relPt := self transformFromWorld globalPointToLocal: aPoint.
  index := (self paragraph characterBlockAtPoint: relPt) stringIndex.
+ newText := Text string: Character startOfHeader asString attribute: (TextAnchor new anchoredMorph: aMorph).
- newText := Text string: (String value: 1) attribute: (TextAnchor new anchoredMorph: aMorph).
  anchorType == #inline ifTrue:[
+ self paragraph replaceFrom: index to: index-1 with: newText displaying: false].
+ anchorType == #document ifTrue: [
+ index := index min: paragraph text size.
+ index := paragraph text string lastIndexOf: Character cr startingAt: index.
+ block := paragraph characterBlockForIndex: index+1.
+ aMorph textAnchorProperties positionInDocument: (relPt x - bounds left) @ (relPt y - block top).
+ self paragraph replaceFrom: index+1 to: index with: newText displaying: false].
+
- self paragraph replaceFrom: index to: index-1 with: newText displaying: false.
- ] ifFalse:[
- index := index min: paragraph text size.
- index := paragraph text string lastIndexOf: Character cr startingAt: index.
- block := paragraph characterBlockForIndex: index+1.
- aMorph relativeTextAnchorPosition: (relPt x - bounds left) @ (relPt y - block top ).
- self paragraph replaceFrom: index+1 to: index with: newText displaying: false.
- ].
  self fit.!

Item was changed:
  ----- Method: TextMorph>>removedMorph: (in category 'private') -----
  removedMorph: aMorph
  | range |
  range := text find: (TextAnchor new anchoredMorph: aMorph).
+ range ifNotNil: [
+ self paragraph
+ replaceFrom: range first
+ to: range last
+ with: Text new
+ displaying: false.
- range ifNotNil:
- [self paragraph replaceFrom: range first to: range last
- with: Text new displaying: false.
  self fit].
- aMorph textAnchorType: nil.
- aMorph relativeTextAnchorPosition: nil.
  super removedMorph: aMorph.!