The Trunk: Graphics-pre.418.mcz

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

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

Name: Graphics-pre.418
Author: pre
Time: 4 October 2019, 11:16:04.703303 am
UUID: a8c151ab-580e-0549-9897-7fdbf1fa10c2
Ancestors: Graphics-pre.412, Graphics-nice.417

Adds infrastructure for layouting morphs (and forms) inline in text by using TextAnchor TextAttributes.

=============== Diff against Graphics-nice.417 ===============

Item was removed:
- ----- Method: BitBltDisplayScanner>>displayEmbeddedForm: (in category 'displaying') -----
- displayEmbeddedForm: aForm
- aForm
- displayOn: bitBlt destForm
- at: destX @ (lineY + line baseline - aForm height)
- clippingBox: bitBlt clipRect
- rule: Form blend
- fillColor: Color white !

Item was added:
+ ----- Method: BitBltDisplayScanner>>displayEmbeddedForm:at: (in category 'displaying') -----
+ displayEmbeddedForm: aForm at: aPoint
+
+ aForm
+ displayOn: bitBlt destForm
+ at: aPoint + (aForm extent / 2)
+ clippingBox: bitBlt clipRect
+ rule: Form blend
+ fillColor: Color white !

Item was removed:
- ----- Method: CharacterBlockScanner>>placeEmbeddedObject: (in category 'private') -----
- placeEmbeddedObject: anchoredMorph
- "Workaround: The following should really use #textAnchorType"
- | w |
- anchoredMorph relativeTextAnchorPosition ifNotNil:[^true].
- w := anchoredMorph width.
- specialWidth := w.
- (destX + w > characterPoint x) ifTrue: [^false].
- destX := destX + w + kern.
- ^ true!

Item was added:
+ ----- Method: CharacterBlockScanner>>placeEmbeddedObjectFrom: (in category 'private') -----
+ placeEmbeddedObjectFrom: aTextAttribute
+
+ | width anchoredMorphOrForm textAnchorProperties |
+ anchoredMorphOrForm := aTextAttribute anchoredMorph.
+ textAnchorProperties := self textAnchorPropertiesFor: anchoredMorphOrForm.
+
+ textAnchorProperties anchorLayout == #document ifTrue: [^ true].
+ width := textAnchorProperties consumesHorizontalSpace
+ ifTrue: [anchoredMorphOrForm width + textAnchorProperties horizontalPadding]
+ ifFalse: [0].
+
+ lastCharacterWidth := width.
+
+ (destX + width > characterPoint x) ifTrue: [^false].
+ destX := destX + width + kern.
+ ^ true!

Item was changed:
  ----- Method: CharacterBlockScanner>>retrieveLastCharacterWidth (in category 'private') -----
  retrieveLastCharacterWidth
  | lastCharacter |
  lastIndex > text size ifTrue: [^lastCharacterWidth := 0].
- specialWidth ifNotNil: [^lastCharacterWidth := specialWidth].
  lastCharacter := text at: lastIndex.
  (lastCharacter charCode >= 256 or: [(stopConditions at: lastCharacter charCode + 1) isNil])
  ifTrue: [lastCharacterWidth := font widthOf: (text at: lastIndex)].
  "if last character was a stop condition, then the width is already set"
  ^lastCharacterWidth!

Item was changed:
  ----- Method: CharacterBlockScanner>>setFont (in category 'stop conditions') -----
  setFont
- specialWidth := nil.
  super setFont!

Item was changed:
  ----- Method: CharacterScanner>>embeddedObject (in category 'stop conditions') -----
  embeddedObject
+
  pendingKernX := 0.
+ ((text attributesAt: lastIndex) reject: [:each | each anchoredMorph isNil])
+ ifNotEmpty: [:attributes | attributes do: [:attr |
- text attributesAt: lastIndex do:[:attr|
- attr anchoredMorph ifNotNil:[
  "Try to placeEmbeddedObject: - if it answers false, then there's no place left"
+ (self placeEmbeddedObjectFrom: attr) ifFalse: [^ self crossedX]]].
+  
- (self placeEmbeddedObject: attr anchoredMorph) ifFalse:[^self crossedX]]].
  "Note: if ever several objects are embedded on same character, only indent lastIndex once"
  lastIndex := lastIndex + 1.
  ^false!

Item was removed:
- ----- Method: CharacterScanner>>placeEmbeddedObject: (in category 'private') -----
- placeEmbeddedObject: anchoredMorph
- "Place the anchoredMorph or return false if it cannot be placed"
- ^ true!

Item was added:
+ ----- Method: CharacterScanner>>placeEmbeddedObjectFrom: (in category 'private') -----
+ placeEmbeddedObjectFrom: aTextAttribute
+ "Place the anchoredMorph or return false if it cannot be placed"
+ ^ true!

Item was added:
+ ----- Method: CharacterScanner>>textAnchorPropertiesFor: (in category 'private-text-anchor') -----
+ textAnchorPropertiesFor: aMorphOrForm
+
+ ^ aMorphOrForm isForm
+ ifTrue: [TextAnchorProperties new]
+ ifFalse: [aMorphOrForm textAnchorProperties]!

Item was added:
+ ----- Method: CompositionScanner>>alignmentMorphOffsetFor:of: (in category 'private') -----
+ alignmentMorphOffsetFor: textAnchorProperties of: aMorphOrForm
+
+ ^ textAnchorProperties verticalAlignmentMorph caseOf: {
+ [#top] -> [textAnchorProperties padding top].
+ [#center] -> [(aMorphOrForm height / 2) floor].
+ [#baseline] -> [textAnchorProperties morphBaselineGetter
+ ifNil: [0]
+ ifNotNil: [:s | aMorphOrForm perform: s]].
+ [#bottom] -> [aMorphOrForm height + textAnchorProperties padding bottom]}!

Item was added:
+ ----- Method: CompositionScanner>>baselineAdjustmentFor: (in category 'private') -----
+ baselineAdjustmentFor: textAnchorProperties
+
+ ^ textAnchorProperties verticalAlignmentLine caseOf: {
+ [#top] -> [font ascent].
+ [#center] -> [(font ascent / 2) floor].
+ [#baseline] -> [0].
+ [#bottom] -> [font descent negated]}.
+
+ !

Item was added:
+ ----- Method: CompositionScanner>>lineHeightForMorphOfHeight:aligned:to: (in category 'private') -----
+ lineHeightForMorphOfHeight: aMorphHeight aligned: morphPosition to: linePosition
+
+ ^ self
+ lineHeightForMorphOfHeight: aMorphHeight
+ aligned: morphPosition
+ to: linePosition
+ paddedWith: 0
+ andOptionalMorphBaseline: 0!

Item was added:
+ ----- Method: CompositionScanner>>lineHeightForMorphOfHeight:aligned:to:paddedWith:andOptionalMorphBaseline: (in category 'private') -----
+ lineHeightForMorphOfHeight: aMorphHeight aligned: morphPosition to: linePosition paddedWith: verticalPadding andOptionalMorphBaseline: morphBaseline
+ "The idea here is to first compute the total height and then subtract the overlapping area."
+
+ | adjustedLineHeight morphHeight total |
+ morphHeight := aMorphHeight + verticalPadding.
+ total := font height + morphHeight.
+ adjustedLineHeight := 0.
+
+ morphPosition = #top ifTrue: [
+ linePosition = #top ifTrue: [adjustedLineHeight := total - font height].
+ linePosition = #center ifTrue: [adjustedLineHeight := total - (font descent + (font ascent / 2))].
+ linePosition = #baseline ifTrue: [adjustedLineHeight := total - font descent].
+ linePosition = #bottom ifTrue: [adjustedLineHeight := total].].
+ morphPosition = #center ifTrue: [ | upperMorphHalf lowerMorphHalf |
+ "The overlapping area of a morph aligned at the center position can be determined by splitting
+ the morph into a top half which is aligned at the bottom and a lower half aligned at the top."
+ upperMorphHalf := self
+ lineHeightForMorphOfHeight: aMorphHeight / 2
+ aligned: #bottom to: linePosition.
+ lowerMorphHalf := self
+ lineHeightForMorphOfHeight: aMorphHeight / 2
+ aligned: #top to: linePosition.
+ adjustedLineHeight := upperMorphHalf + lowerMorphHalf - font height].
+ morphPosition = #baseline ifTrue: [ | upperMorphHalf lowerMorphHalf |
+ "We use the same trick as we used with the center position but with different proportions of the morph."
+ upperMorphHalf := self
+ lineHeightForMorphOfHeight: morphBaseline
+ aligned: #bottom to: linePosition.
+ lowerMorphHalf := self
+ lineHeightForMorphOfHeight: aMorphHeight - morphBaseline
+ aligned: #top to: linePosition.
+ adjustedLineHeight := upperMorphHalf + lowerMorphHalf - font height].
+ morphPosition = #bottom ifTrue: [
+ linePosition = #top ifTrue: [adjustedLineHeight := total].
+ linePosition = #center ifTrue: [adjustedLineHeight := total - (font ascent / 2)].
+ linePosition = #baseline ifTrue: [adjustedLineHeight := total - font ascent].
+ linePosition = #bottom ifTrue: [adjustedLineHeight := total - font height].].
+
+ ^ lineHeight max: adjustedLineHeight !

Item was removed:
- ----- Method: CompositionScanner>>placeEmbeddedObject: (in category 'private') -----
- placeEmbeddedObject: anchoredMorph
- | w descent |
- "Workaround: The following should really use #textAnchorType"
- anchoredMorph relativeTextAnchorPosition ifNotNil:[^true].
- w := anchoredMorph width.
- (destX + w > rightMargin and: [(leftMargin + w) <= rightMargin or: [lastIndex > line first]])
- ifTrue: ["Won't fit, but would on next line"
- ^ false].
- destX := destX + w + kern.
- descent := lineHeight - baseline.
- baseline := baseline max: anchoredMorph height.
- lineHeight := baseline + descent.
- ^ true!

Item was added:
+ ----- Method: CompositionScanner>>placeEmbeddedObjectFrom: (in category 'private') -----
+ placeEmbeddedObjectFrom: aTextAttribute
+
+ | width anchoredMorphOrForm textAnchorProperties |
+ anchoredMorphOrForm := aTextAttribute anchoredMorph.
+ textAnchorProperties := self textAnchorPropertiesFor: anchoredMorphOrForm.
+
+ textAnchorProperties anchorLayout == #document ifTrue: [^ true].
+ "If it is not anchored at the document, we assume that it is inline."
+ width := anchoredMorphOrForm width + textAnchorProperties horizontalPadding.
+ (textAnchorProperties consumesHorizontalSpace and: [destX + width > rightMargin and: [(leftMargin + width) <= rightMargin or: [lastIndex > line first]]])
+ ifTrue: ["Won't fit, but would on next line"
+ ^ false].
+
+ "The width had to be set beforehand to determine line wrapping.
+ We can now re-use and reset it as it might not be necessary anymore. --pre"
+ width := textAnchorProperties consumesHorizontalSpace
+ ifTrue: [anchoredMorphOrForm width + textAnchorProperties horizontalPadding]
+ ifFalse: [0].
+ destX := destX + width + kern.
+
+ baseline := baseline max:
+ (self alignmentMorphOffsetFor: textAnchorProperties of: anchoredMorphOrForm)
+ + (self baselineAdjustmentFor: textAnchorProperties).
+ lineHeight := self
+ lineHeightForMorphOfHeight: anchoredMorphOrForm height
+ aligned: textAnchorProperties verticalAlignmentMorph
+ to: textAnchorProperties verticalAlignmentLine
+ paddedWith: textAnchorProperties verticalPadding
+ andOptionalMorphBaseline: (textAnchorProperties morphBaselineGetter
+ ifNotNil: [:getter | anchoredMorphOrForm perform: getter] ifNil: [0]).
+ ^ true!

Item was removed:
- ----- Method: DisplayScanner>>displayEmbeddedForm: (in category 'displaying') -----
- displayEmbeddedForm: aForm
- self subclassResponsibility!

Item was added:
+ ----- Method: DisplayScanner>>displayEmbeddedForm:at: (in category 'displaying') -----
+ displayEmbeddedForm: aForm at: aPoint
+ self subclassResponsibility!

Item was added:
+ ----- Method: DisplayScanner>>embeddedObject (in category 'stop conditions') -----
+ embeddedObject
+
+ "TODO: document the reason for this decrement --pre"
+ lastDisplayableIndex := lastIndex - 1.
+ ^ super embeddedObject!

Item was added:
+ ----- Method: DisplayScanner>>embeddedObject:shouldBePlacedInDocumentGiven: (in category 'private') -----
+ embeddedObject: anchoredMorphOrForm shouldBePlacedInDocumentGiven: textAnchorProperties
+
+ ^ textAnchorProperties hasPositionInDocument
+ and: [textAnchorProperties anchorLayout == #document]
+ and: [anchoredMorphOrForm isMorph]!

Item was removed:
- ----- Method: DisplayScanner>>placeEmbeddedObject: (in category 'private') -----
- placeEmbeddedObject: anchoredMorphOrForm
- anchoredMorphOrForm relativeTextAnchorPosition ifNotNil:[:relativeTextAnchorPosition |
- anchoredMorphOrForm position:
- relativeTextAnchorPosition +
- (anchoredMorphOrForm owner textBounds origin x @ (lineY - morphicOffset y)).
- ^true
- ].
- (anchoredMorphOrForm isMorph or: [anchoredMorphOrForm isPrimitiveCostume]) ifTrue: [
- anchoredMorphOrForm position: (destX@(lineY + line baseline - anchoredMorphOrForm height)) - morphicOffset
- ] ifFalse: [
- self displayEmbeddedForm: anchoredMorphOrForm
- ].
- destX := destX + anchoredMorphOrForm width + kern.
- ^ true!

Item was added:
+ ----- Method: DisplayScanner>>placeEmbeddedObject:inlineGiven: (in category 'private') -----
+ placeEmbeddedObject: anchoredMorphOrForm inlineGiven: textAnchorProperties
+
+ | alignedPositionY position |
+ alignedPositionY := self verticallyAlignEmbeddedObject: anchoredMorphOrForm given: textAnchorProperties.
+ position := ((destX + textAnchorProperties padding left) @ alignedPositionY) - morphicOffset.
+ anchoredMorphOrForm isMorph
+ ifTrue: [ anchoredMorphOrForm position: position]
+ ifFalse: ["we assume this to be a form"
+ self displayEmbeddedForm: anchoredMorphOrForm at: position].
+ !

Item was added:
+ ----- Method: DisplayScanner>>placeEmbeddedObjectFrom: (in category 'private') -----
+ placeEmbeddedObjectFrom: aTextAttribute
+
+ | width anchoredMorphOrForm textAnchorProperties |
+ anchoredMorphOrForm := aTextAttribute anchoredMorph.
+ textAnchorProperties := self textAnchorPropertiesFor: anchoredMorphOrForm.
+
+ (self embeddedObject: anchoredMorphOrForm shouldBePlacedInDocumentGiven: textAnchorProperties)
+ ifTrue: [^ self placeEmbeddedObjectInDocument: anchoredMorphOrForm].
+ .self placeEmbeddedObject: anchoredMorphOrForm inlineGiven: textAnchorProperties.
+
+ width := textAnchorProperties consumesHorizontalSpace
+ ifTrue: [anchoredMorphOrForm width + textAnchorProperties horizontalPadding]
+ ifFalse: [0].
+ destX := destX + width + kern.
+
+ ^ true!

Item was added:
+ ----- Method: DisplayScanner>>placeEmbeddedObjectInDocument: (in category 'private') -----
+ placeEmbeddedObjectInDocument: anchoredMorphOrForm
+
+ anchoredMorphOrForm position:
+ anchoredMorphOrForm textAnchorProperties positionInDocument +
+ (anchoredMorphOrForm owner textBounds origin x @ (lineY - morphicOffset y)).
+ ^ true!

Item was added:
+ ----- Method: DisplayScanner>>verticallyAlignEmbeddedObject:given: (in category 'private') -----
+ verticallyAlignEmbeddedObject: aMorphOrForm given: textAnchorProperties
+
+ | alignedPositionY positionInLine morphPosition padding morphBaselineGetter |
+ alignedPositionY := lineY + line baseline.
+ positionInLine := textAnchorProperties verticalAlignmentLine.
+ positionInLine = #top ifTrue: [alignedPositionY := alignedPositionY - font ascent].
+ positionInLine = #center ifTrue: [alignedPositionY := (alignedPositionY - (font ascent / 2)) floor].
+ positionInLine = #bottom ifTrue: [alignedPositionY := alignedPositionY + font descent].
+ "#baseline does not require adjustments"
+
+ padding := textAnchorProperties padding.
+ morphBaselineGetter := textAnchorProperties morphBaselineGetter.
+ morphPosition := textAnchorProperties verticalAlignmentMorph.
+ morphPosition = #top ifTrue: [alignedPositionY := alignedPositionY + padding top].
+ morphPosition = #center ifTrue: [alignedPositionY := (alignedPositionY - (aMorphOrForm height / 2)) floor].
+ morphPosition = #baseline ifTrue: [
+ alignedPositionY := alignedPositionY - (morphBaselineGetter ifNotNil: [:getter |
+ aMorphOrForm perform: getter] ifNil: [0])].
+ morphPosition = #bottom ifTrue: [alignedPositionY := (alignedPositionY - aMorphOrForm height) - padding bottom].
+ "We only apply padding to the position the morph is aligned to."
+
+ ^ alignedPositionY!