Christoph Thiede uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-ct.1907.mcz

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

Name: Morphic-ct.1907
Author: ct
Time: 24 February 2022, 6:22:54.203653 pm
UUID: a6a31081-eb65-4f42-b62f-208b5528328a
Ancestors: Morphic-ct.1906, Morphic-ct.1899

Merges Morphic-ct.1899 (making caret width in Morphic dpi-aware). This revision converts "// 1" -> "truncated". Thanks to Marcel for the review!

=============== Diff against Morphic-ct.1906 ===============

Item was changed:
  ----- Method: NewParagraph>>caretWidth (in category 'access') -----
  caretWidth
+ 	^ ((Editor dumbbellCursor
- 	^ Editor dumbbellCursor
  		ifTrue: [ 3 ]
+ 		ifFalse: [ 2 ]) "pixels" * RealEstateAgent scaleFactor) truncated!
- 		ifFalse: [ 2 ]!

Item was changed:
  ----- Method: NewParagraph>>displayDumbbellCursorOn:at:in: (in category 'display') -----
  displayDumbbellCursorOn: aCanvas at: leftX in: line
  
  	| w |
+ 	w := (3 "pixels" * (RealEstateAgent scaleFactor max: 1)) truncated.
- 	w := 2.
  	self focused ifFalse: [^ w].
  	
  	1 to: w
  		do: 
  			[:i | 
  			"Draw caret triangles at top and bottom"
  
  			aCanvas fillRectangle: ((leftX - w + i - 1) @ (line top + i - 1) 
  						extent: ((w - i) * 2 + 3) @ 1)
  				color: self caretColor.
  			aCanvas fillRectangle: ((leftX - w + i - 1) @ (line bottom - i) 
  						extent: ((w - i) * 2 + 3) @ 1)
  				color: self caretColor].
  	
  	aCanvas
+ 		fillRectangle: (leftX - (w // 4) @ line top rect: leftX + (w + 1 // 2) @ line bottom - 1)
- 		line: leftX @ line top
- 		to: leftX @ (line bottom-1)
  		color: self caretColor.
  	
  	^ w!

Item was changed:
  ----- Method: NewParagraph>>displaySelectionInLine:on: (in category 'display') -----
  displaySelectionInLine: line on: aCanvas 
  	| leftX rightX w |
  	selectionStart ifNil: [^self].	"No selection"
  	aCanvas isShadowDrawing ifTrue: [ ^self ].	"don't draw selection with shadow"
  	selectionStart = selectionStop 
  		ifTrue: 
  			["Only show caret on line where clicked"
  
  			selectionStart textLine ~= line ifTrue: [^self]]
  		ifFalse:
  			["Test entire selection before or after here"
  
  			(selectionStop stringIndex < line first 
  				or: [selectionStart stringIndex > (line last + 1)]) ifTrue: [^self].	"No selection on this line"
  			(selectionStop stringIndex = line first 
  				and: [selectionStop textLine ~= line]) ifTrue: [^self].	"Selection ends on line above"
  			(selectionStart stringIndex = (line last + 1) 
  				and: [selectionStop textLine ~= line]) ifTrue: [^self]].	"Selection begins on line below"
  	leftX := (selectionStart stringIndex <= line first 
  				ifTrue: [line ]
  				ifFalse: [selectionStart ])left.
  	rightX := (selectionStop stringIndex > (line last + 1) or: 
  					[selectionStop stringIndex = (line last + 1) 
  						and: [selectionStop textLine ~= line]]) 
  				ifTrue: [line right]
  				ifFalse: [selectionStop left].
  	selectionStart = selectionStop 
  		ifTrue: [
  			rightX := rightX + 1.
+ 			w := caretRect ifNotNil: [caretRect width] ifNil: [2] "sigh...".
+ 			caretRect := (leftX - (w // 2)) @ line top corner: (rightX + (w // 2)) @ line bottom.
- 			caretRect := (leftX-2) @ line top corner: (rightX+2)@ line bottom. "sigh..."
  			self showCaret ifFalse: [^self].
  			w := (Editor dumbbellCursor
  				ifTrue: [self displayDumbbellCursorOn: aCanvas at: leftX in: line]
  				ifFalse: [self displaySimpleCursorOn: aCanvas at: leftX in: line]).
  			caretRect := (leftX-w) @ line top corner: (rightX+w)@ line bottom]
  		ifFalse: [
  			caretRect := nil.
  			aCanvas fillRectangle: (leftX @ line top corner: rightX @ line bottom)
  				color: (self focused ifTrue: [self selectionColor] ifFalse: [self unfocusedSelectionColor])]!

Item was changed:
  ----- Method: NewParagraph>>displaySimpleCursorOn:at:in: (in category 'display') -----
  displaySimpleCursorOn: aCanvas at: leftX in: line
  
+ 	| width |
  	self focused ifFalse: [^ 1].
  	
+ 	width := (2 "pixels" * (RealEstateAgent scaleFactor max: 1)) truncated.
+ 	
  	aCanvas
+ 		fillRectangle: (leftX @ (line top + 1) rect: leftX + width @ line bottom - 1)
- 		line: leftX @ (line top+1)
- 		to: leftX @ (line bottom-1)
  		color: self caretColor.
+ 		
+ 	^ width!
- 
- 	aCanvas
- 		line: leftX+1 @ (line top+1)
- 		to: leftX+1 @ (line bottom-1)
- 		color: (self caretColor alpha: 0.3).
- 	
- 	^ 1!