adding traces in SpMorphicMillerAdapter to trace problems in CI

src/BaselineOfNewTools/BaselineOfNewTools.class.st

@@ -170,6 +170,59 @@ BaselineOfNewTools >> chest: spec [
 			loads: 'default' ]
 ]
 
+{ #category : 'actions' }
+BaselineOfNewTools >> compileRubTextSegmentMorph [
+
+	RubTextSegmentMorph compiler
+		source: 'computeStraightVertices
+
+	| firstCB lastCB firstLineIndex lastLineIndex firstLine lastLine verts lines textarea margins segmentGap textAreaLeft |
+	(''firstIndex := {1}'' format: { firstIndex }) traceCr.
+	(''lastIndex := {1}'' format: { lastIndex }) traceCr.
+	(''self lines := {1} '' format: { self lines }) traceCr.
+	self lines ifEmpty: [ ^ self ].
+	firstCB := self characterBlockForIndex: firstIndex.
+	(''firstCB := {1}'' format: { firstCB }) traceCr.
+	lastCB := self characterBlockForIndex: lastIndex.
+	(''lastCB := {1}'' format: { lastCB }) traceCr.
+	lines := self lines.
+	textarea := self textArea.
+	margins := self margins.
+	firstLineIndex := self lineIndexOfCharacterIndex: firstIndex.
+	lastLineIndex := self lineIndexOfCharacterIndex: lastIndex.
+	firstLine := lines at: firstLineIndex.
+	lastLine := lines at: lastLineIndex.
+	verts := OrderedCollection new.
+	segmentGap := 1 @ 0.
+	firstLine = lastLine
+		ifTrue: [
+			verts add: firstCB bottomLeft.
+			verts add: firstCB topLeft.
+			firstIndex ~= lastIndex ifTrue: [
+				verts add: lastCB topLeft.
+				verts add: lastCB bottomLeft.
+				verts add: firstCB bottomLeft ] ]
+		ifFalse: [
+			textAreaLeft := textArea left + margins left.
+			verts
+				add: firstCB bottomLeft - segmentGap;
+				add: firstCB topLeft - segmentGap.
+			firstLineIndex to: lastLineIndex - 1 do: [ :index |
+				| line |
+				line := lines at: index.
+				verts
+					add: line actualWidth + margins left @ line top + segmentGap;
+					add: line actualWidth + margins left @ line bottom + segmentGap ].
+
+			verts
+				add: lastCB topLeft + segmentGap;
+				add: lastCB bottomLeft + segmentGap;
+				add: textAreaLeft @ lastLine bottom - segmentGap;
+				add: textAreaLeft @ firstLine bottom - segmentGap ].
+	self setVertices: verts';
+		install
+]
+
 { #category : 'accessing' }
 BaselineOfNewTools >> packageRepositoryURLForSpec: spec [
 	| url |
@@ -187,7 +240,38 @@ BaselineOfNewTools >> packageRepositoryURLForSpec: spec [
 { #category : 'actions' }
 BaselineOfNewTools >> postload: loader package: packageSpec [
 
-	MCMethodDefinition initializersEnabled: initializersEnabled
+	MCMethodDefinition initializersEnabled: initializersEnabled.
+	SpMorphicMillerAdapter compiler
+		source: 'scrollToShowLastPage
+
+	self widget defer: [
+		| size firstMorphIndex |
+		size := innerWidget submorphs size.
+		(''size := {1}'' format: { size }) traceCr.
+		(''widget class := {1} '' format: { innerWidget class }) traceCr.
+		(''widget := {1} '' format: { innerWidget }) traceCr.
+		''widget submorphs classes := {1}'' format:
+			{ (innerWidget submorphs collect: [ :s | s class ]) }.
+		(''widget submorphs := {1}'' format: { innerWidget submorphs })
+			traceCr.
+
+		firstMorphIndex := size - self presenter visiblePages + 1.
+		(''self presenter := {1}'' format: { self presenter }) traceCr.
+		(''self presenter class := {1}'' format: { self presenter class })
+			traceCr.
+		(''self presenter visiblePages := {1}'' format:
+			 { self presenter visiblePages }) traceCr.
+		(''firstMorphIndex class := {1}'' format: { firstMorphIndex class })
+			traceCr.
+		(''firstMorphIndex := {1}'' format: { firstMorphIndex }) traceCr.
+		(''((firstMorphIndex max: 1) min: size) := {1}'' format:
+			 { ((firstMorphIndex max: 1) min: size) }) traceCr.
+		size > 0 ifTrue: [
+			self widget showMorph:
+				(innerWidget submorphs at: ((firstMorphIndex max: 1) min: size)) ] ]';
+		install.
+
+	self compileRubTextSegmentMorph
 ]
 
 { #category : 'actions' }