Marcel Taeumel uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-mt.1911.mcz

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

Name: Morphic-mt.1911
Author: mt
Time: 27 February 2022, 9:53:05.101069 am
UUID: a4978814-746a-4e4f-aff1-8508843ecebb
Ancestors: Morphic-tonyg.1910

Further tweaks text cursors for various scale factors.

=============== Diff against Morphic-tonyg.1910 ===============

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

Item was changed:
  ----- Method: NewParagraph>>displayDumbbellCursorOn:at:in: (in category 'display') -----
  displayDumbbellCursorOn: aCanvas at: leftX in: line
+ 	"Draw a dumbbell-shaped cursor. Draw lines instead of a polygon to hopefully be faster."
  
+ 	| w wHalf b |
+ 	w := caretRect width.
+ 	wHalf := w // 2.
+ 	b := wHalf - 1.
+ 	b even ifTrue: [b := b - 1].
+ 	b := b max: 1.
- 	| w |
- 	w := (2 "pixels" * (RealEstateAgent scaleFactor max: 1)) truncated.
- 	self focused ifFalse: [^ w].
- 	
- 	1 to: w
- 		do: 
- 			[:i | 
- 			"Draw caret triangles at top and bottom"
  
+ 	1 to: wHalf+1 do: [:i | "Draw caret triangles at top and bottom"
+ 		aCanvas
+ 			line: leftX + i - 1 @ (line top + i - 1)
+ 			to: leftX + w - i @ (line top + i - 1)
+ 			color: self caretColor.
+ 		aCanvas
+ 			line: leftX + i - 1 @ (line bottom - i)
+ 			to: leftX + w - i @ (line bottom - i)
+ 			color: self caretColor].
- 			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].
  	
+ 	b = 1
+ 		ifTrue: [
+ 			aCanvas
+ 				line: leftX + wHalf @ line top
+ 				to: leftX + wHalf @ (line bottom-1)
+ 				color: self caretColor]
+ 		ifFalse: [ | o |
+ 			o := leftX + wHalf - (b//2).
+ 			aCanvas
+ 				fillRectangle: (o @ line top corner: o + b @ line bottom)
+ 				color: self caretColor]!
- 	aCanvas
- 		fillRectangle: (leftX - (w // 4) @ line top rect: leftX + (w + 1 / 2) ceiling @ line bottom - 1)
- 		color: self caretColor.
- 	
- 	^ w!

Item was changed:
  ----- Method: NewParagraph>>displaySelectionInLine:on: (in category 'display') -----
  displaySelectionInLine: line on: aCanvas 
+ 	| leftX rightX |
- 	| 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: [ | w pos |
+ 			w := caretRect ifNotNil: [caretRect width] ifNil: [self caretWidth].
+ 			pos := leftX - (w // 2).
+ 			caretRect := pos @ line top corner: (pos + w) @ line bottom.
+ 			self showCaret ifFalse: [^ self "e.g., not #focused"].
+ 			Editor dumbbellCursor
+ 				ifTrue: [self displayDumbbellCursorOn: aCanvas at: pos in: line]
+ 				ifFalse: [self displaySimpleCursorOn: aCanvas at: pos in: line]]
- 		ifTrue: [
- 			rightX := rightX + 1.
- 			w := caretRect ifNotNil: [caretRect width] ifNil: [2] "sigh...".
- 			caretRect := (leftX - (w // 2)) @ line top corner: (rightX + (w // 2)) @ line bottom.
- 			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
  
+ 	| w aa |
+ 	w := caretRect width // 2 max: 1.
+ 	aa := caretRect width - w.
+ 
+ 	w = 1
+ 		ifFalse: [
+ 			aCanvas
+ 				fillRectangle: (leftX @ line top corner: leftX + w @ line bottom)
+ 				color: self caretColor]
+ 		ifTrue: [
+ 			aCanvas
+ 				line: leftX @ line top
+ 				to: leftX @ (line bottom-1)
+ 				color: self caretColor].
+ 
+ 	aa > 0 ifTrue: [
+ 		aa = 1
+ 			ifFalse: [
+ 				aCanvas
+ 					fillRectangle: (leftX+w @ line top rect: leftX+w +aa @ line bottom)
+ 					color: (self caretColor alpha: 0.3)]
- 	| scale width |
- 	self focused ifFalse: [^ 1].
- 	
- 	scale := RealEstateAgent scaleFactor.
- 	width := 1.7 "pixels" * (scale max: 1).
- 	
- 	aCanvas
- 		fillRectangle: (leftX @ (line top + 1) rect: leftX + width truncated @ (line bottom - 1))
- 		color: self caretColor.
- 	"Manual anti-aliasing for smaller scales"
- 	(width < 3
- 		and: [scale >= 1 "but not for tiny scales where every pixel counts"]
- 		and: [width fractionPart > 0])
  			ifTrue: [
  				aCanvas
+ 					line: leftX+w @ line top
+ 					to: leftX+w @ (line bottom-1)
+ 					color: (self caretColor alpha: 0.3)]].!
- 					line: leftX + width truncated @ (line top + 1)
- 					to: leftX + width truncated @ (line bottom - 2)
- 					color: (self caretColor alpha: 1 - width fractionPart)].
- 	
- 	^ width ceiling!