Merge pull request #510 from pharo-graphics/493-Need-to-draw-a-border…

…-to-a-BlRopedTExt Add border text attribute and fix #514
pharo-graphics · May 17, 2024 · 1c824d3 · 1c824d3
2 parents fdd167d + 722add8
commit 1c824d3
Show file tree

Hide file tree

Showing 14 changed files with 256 additions and 4 deletions.
diff --git a/src/Bloc-Alexandrie-Tests/BATextMeasurerTest.class.st b/src/Bloc-Alexandrie-Tests/BATextMeasurerTest.class.st
@@ -18,10 +18,13 @@ BATextMeasurerTest >> testIndexAtBetweenAllCharactersInRealPointWithDot [
 	aParagraph text: self pointWithDotText.
 	aParagraph measureOn: self realMeasurer.
 
-	theIndices := (0 to: aParagraph text size) collect: [ :anIndex |
-		              | aPoint |
-		              aPoint := aParagraph positionAt: anIndex.
-		              aParagraph indexAtPosition: aPoint ].
+	theIndices :=
+		(0 to: aParagraph text size)
+			collect: [ :anIndex |
+				| aPoint |
+				aPoint := aParagraph positionAt: anIndex.
+				aParagraph indexAtPosition: aPoint ceiling ].
+
 	self assert: theIndices equals: (0 to: aParagraph text size) asArray
 ]
 

diff --git a/src/Bloc-Alexandrie-Tests/BlSpaceFixture.class.st b/src/Bloc-Alexandrie-Tests/BlSpaceFixture.class.st
@@ -1354,6 +1354,125 @@ BlSpaceFixture >> buildTextTransformationsCustomizedWith: aBlock [
 	builder space root allChildrenDepthFirstDo: aBlock
 ]
 
+{ #category : #fixtures }
+BlSpaceFixture >> buildTextWithBorder [
+	"Each character has different border attribute."
+
+	| aText |
+	builder spaceExtent: 90 @ 40.
+
+	aText := 'BLOC' asRopedText.
+
+	1 to: aText size do: [ :index |
+		(aText from: index to: index)
+			fontSize: 40 - (index * 3);
+			foreground: builder nextColor muchLighter;
+			background: builder nextColor;
+			border: (BlBorder
+				paint: builder nextColor muchDarker
+				width: index * 1.5) ].
+
+	(builder addTextToRoot: aText)
+		padding: (BlInsets all: 5)
+
+]
+
+{ #category : #fixtures }
+BlSpaceFixture >> buildTextWithBorderAbove [
+	"Text border can be drawn above or below the text."
+
+	| aText |
+	builder spaceExtent: 60 @ 100.
+
+	aText :=
+		'll' asRopedText
+			fontSize: 110;
+			foreground: (Color blue alpha: 0.5);
+			yourself.
+
+	(aText from: 1 to: 1)
+		border: (BlBorder paint: Color red width: 8)
+		above: false.
+
+	(aText from: 2 to: 2)
+		border: (BlBorder paint: Color red width: 8)
+		above: true.
+
+	(builder addTextToRoot: aText) padding: (BlInsets all: 10)
+]
+
+{ #category : #fixtures }
+BlSpaceFixture >> buildTextWithDashedBorder [
+	"Each character has a different dashes on its attribute."
+
+	| aText |
+	builder spaceExtent: 90 @ 100.
+
+	aText := 'iii' asRopedText
+		fontSize: 110;
+		foreground: (Color yellow alpha: 0.5);
+		yourself.
+
+	(aText from: 1 to: 1)
+		border: (BlBorder builder
+			paint: Color blue;
+			width: 6;
+			dashArray: #(0 7);
+			dashOffset: 1;
+			capSquare;
+			joinBevel;
+			build).
+
+	(aText from: 2 to: 2)
+		border: (BlBorder builder
+			paint: Color blue;
+			width: 6;
+			dashArray: #(1 1);
+			dashOffset: 1;
+			capButt;
+			joinMiter;
+			miterLimit: 1.5;
+			build).
+
+	(aText from: 3 to: 3)
+		border: (BlBorder builder
+			paint: Color blue;
+			width: 6;
+			dashArray: #(0 7);
+			dashOffset: 1;
+			capRound;
+			joinRound;
+			build).
+
+	(builder addTextToRoot: aText)
+		padding: (BlInsets all: 10)
+
+]
+
+{ #category : #fixtures }
+BlSpaceFixture >> buildTextWithOverlappingBorder [
+	"First subrope 'Bloc' is rendered behind the border of the second subrope."
+
+	| aText |
+	builder spaceExtent: 80 @ 25.
+
+	aText := 'BlocBloc' asRopedText.
+	aText fontSize: 15.
+	aText foreground: Color blue.
+
+	(aText from: 1 to: 4)
+		border: (BlBorder
+			paint: Color red
+			width: 10).
+	(aText from: 5 to: 8)
+		border: (BlBorder
+			paint: Color green
+			width: 10).
+
+	(builder addTextToRoot: aText)
+		padding: (BlInsets all: 5)
+]
+
 { #category : #fixtures }
 BlSpaceFixture >> buildTransformRotate [
 

diff --git a/src/Bloc-Alexandrie/BATextParagraphSpan.class.st b/src/Bloc-Alexandrie/BATextParagraphSpan.class.st
@@ -27,6 +27,12 @@ BATextParagraphSpan >> aeDrawOn: aeCanvas [
 			anAttribute aeDrawAboveOn: aeCanvas span: self ] ]
 ]
 
+{ #category : #drawing }
+BATextParagraphSpan >> appendPathOn: aeCanvas [
+
+	aeCanvas appendGlyphsPath: cairoGlyphsArray font: cairoScaledFont
+]
+
 { #category : #building }
 BATextParagraphSpan >> measure [
 

diff --git a/src/Bloc-Alexandrie/BlTextBorderAttribute.extension.st b/src/Bloc-Alexandrie/BlTextBorderAttribute.extension.st
@@ -0,0 +1,45 @@
+Extension { #name : #BlTextBorderAttribute }
+
+{ #category : #'*Bloc-Alexandrie' }
+BlTextBorderAttribute >> aeDrawAboveOn: aeCanvas span: aBASpan [
+
+	isAbove ifFalse: [ ^ self ].
+	self aeDrawOn: aeCanvas span: aBASpan
+]
+
+{ #category : #'*Bloc-Alexandrie' }
+BlTextBorderAttribute >> aeDrawBelowOn: aeCanvas span: aBASpan [
+
+	isAbove ifTrue: [ ^ self ].
+	self aeDrawOn: aeCanvas span: aBASpan
+]
+
+{ #category : #'*Bloc-Alexandrie' }
+BlTextBorderAttribute >> aeDrawOn: aeCanvas span: aBASpan [
+
+	aeCanvas
+		restoreContextAfterPaintAlpha: border opacity
+		with: [
+			aeCanvas pathFactory: [ :cairoContext |
+				aBASpan appendPathOn: aeCanvas ].
+
+			aeCanvas setBackgroundOff.
+			aeCanvas setOutskirtsCentered.
+			aeCanvas setBorderBlock: [
+				border paint aeApplyTo: aeCanvas.
+
+				border style dashArray ifNotEmpty: [ :da |
+					aeCanvas
+						setDashes: da
+						offset: border style dashOffset ].
+
+				border style lineJoin
+					aeApplyTo: aeCanvas
+					style: border style.
+
+				border style lineCap aeApplyTo: aeCanvas.
+
+				aeCanvas setBorderWidth: border width ].
+
+			aeCanvas drawFigure ]
+]
diff --git a/src/Bloc-Text/BlTextBorderAttribute.class.st b/src/Bloc-Text/BlTextBorderAttribute.class.st
@@ -0,0 +1,66 @@
+Class {
+	#name : #BlTextBorderAttribute,
+	#superclass : #BlTextAttribute,
+	#instVars : [
+		'border',
+		'isAbove'
+	],
+	#category : #'Bloc-Text-Text-Attributes'
+}
+
+{ #category : #'instance creation' }
+BlTextBorderAttribute class >> border: aBlBorder above: aBoolean [
+
+	^ self new
+		border: aBlBorder;
+		above: aBoolean;
+		yourself
+]
+
+{ #category : #testing }
+BlTextBorderAttribute >> above: aBoolean [
+
+	isAbove := aBoolean
+]
+
+{ #category : #accessing }
+BlTextBorderAttribute >> border [
+
+	^ border
+]
+
+{ #category : #accessing }
+BlTextBorderAttribute >> border: aBlBorder [
+
+	border := aBlBorder
+]
+
+{ #category : #comparing }
+BlTextBorderAttribute >> equals: anotherAttribute [
+
+	^ border = anotherAttribute border and: [ isAbove = anotherAttribute isAbove ]
+]
+
+{ #category : #initialization }
+BlTextBorderAttribute >> initialize [
+
+	super initialize.
+
+	isAbove := false
+]
+
+{ #category : #testing }
+BlTextBorderAttribute >> isAbove [
+
+	^ isAbove
+]
+
+{ #category : #printing }
+BlTextBorderAttribute >> printOn: aStream [
+
+	aStream nextPutAll: (isAbove
+		ifTrue: [ 'border-above: ' ]
+		ifFalse: [ 'border-below: ' ]).
+
+	aStream print: border
+]
diff --git a/src/Bloc-Text/TBlTextStyleable.trait.st b/src/Bloc-Text/TBlTextStyleable.trait.st
@@ -30,6 +30,19 @@ TBlTextStyleable >> bold [
 	self attributesBuilder attribute: BlFontWeightAttribute bold
 ]
 
+{ #category : #'api - text style' }
+TBlTextStyleable >> border: aBlBorder [
+
+	self border: aBlBorder above: false
+]
+
+{ #category : #'api - text style' }
+TBlTextStyleable >> border: aBlBorder above: aBoolean [
+
+	self attributesBuilder attribute:
+		(BlTextBorderAttribute border: aBlBorder above: aBoolean)
+]
+
 { #category : #'api - text decoration' }
 TBlTextStyleable >> decorationDo: aBlock [
 	| anAttribute |

diff --git a/tests/hit/buildTextWithBorder.png b/tests/hit/buildTextWithBorder.png
diff --git a/tests/hit/buildTextWithBorderAbove.png b/tests/hit/buildTextWithBorderAbove.png
diff --git a/tests/hit/buildTextWithDashedBorder.png b/tests/hit/buildTextWithDashedBorder.png
diff --git a/tests/hit/buildTextWithOverlappingBorder.png b/tests/hit/buildTextWithOverlappingBorder.png
diff --git a/tests/render/buildTextWithBorder.png b/tests/render/buildTextWithBorder.png
diff --git a/tests/render/buildTextWithBorderAbove.png b/tests/render/buildTextWithBorderAbove.png
diff --git a/tests/render/buildTextWithDashedBorder.png b/tests/render/buildTextWithDashedBorder.png
diff --git a/tests/render/buildTextWithOverlappingBorder.png b/tests/render/buildTextWithOverlappingBorder.png