Merge pull request #7 from LinqLover/radial-baseline

Radial baseline (ArcRingMorph + discrete radial menu)

src/ColorContextMenu-Core.package/ArcRingMorph.class/README.md

@@ -0,0 +1,6 @@
+I am a specilization of EllipseMorph that used to draw an arc (ellipse segment) or a ring or a combination of both instead of a full ellipse. So much for my strengths, here are my weaknesses:
+
+I'm image-rendered only at the moment. This makes me inappropriate for fancy 3D-shooter games with high FPS numbers (>= 1 FPS). Apart from this, I lack an appropriate TextOnCurve support as of today. Furthermore, I don't support translucent fillStyles at the moment - my drawing methods should probably only use horizontal or vertical lines to tackle this issue.
+Other open points include:
+- drop shadows should be circular as well (probably implement this in superclass?)
+- #drawKeyboardFocusIndicationOn: should be circular as well (probably implement this in superclass?)

src/ColorContextMenu-Core.package/ArcRingMorph.class/instance/borderCorrectionOffset.st

@@ -0,0 +1,5 @@
+geometry - layout
+borderCorrectionOffset
+	"Drawing of borders is a bit inaccurate, see drawing implementation ..."
+
+	^ 3

src/ColorContextMenu-Core.package/ArcRingMorph.class/instance/changed.st

@@ -0,0 +1,5 @@
+updating
+changed
+
+	"See the hack in #outerBounds. Not necessarily a long-term solution."
+	self invalidRect: self outerBounds.

src/ColorContextMenu-Core.package/ArcRingMorph.class/instance/containsAngle..st

@@ -0,0 +1,5 @@
+geometry testing
+containsAngle: angle
+
+	self isArc ifFalse: [^ true].
+	^ self stopAngle - self startAngle \\ (Float pi * 2) >= (angle - self startAngle \\ (Float pi * 2))

src/ColorContextMenu-Core.package/ArcRingMorph.class/instance/containsPoint..st

@@ -0,0 +1,10 @@
+geometry testing
+containsPoint: aPoint
+
+	(self bounds containsPoint: aPoint) ifFalse: [^ false].
+
+	(aPoint closeTo: self center) ifTrue: [^ self innerFraction <= 0].
+	(self innerRadius isZero not and: [(aPoint - self center / self innerRadius) squared < 1]) ifTrue: [^ false].
+	(aPoint - self center / self outerRadius) squared > 1 ifTrue: [^ false].
+
+	^ self containsAngle: (aPoint - self center / self extent) leftRotated theta negated

src/ColorContextMenu-Core.package/ArcRingMorph.class/instance/drawCircleOn..st

@@ -0,0 +1,65 @@
+drawing
+drawCircleOn: aCanvas
+	"Draw the receiver on aCanvas. Midpoint circle algorithm adaption."
+
+	| isArc radius minOctant maxOctant min max d x y |
+	isArc := self isArc.
+	radius := self radius x min: self radius y.
+	minOctant := (self startAngle / (Float pi * 2) * 8 \\ 8) floor.
+	maxOctant := (self stopAngle / (Float pi * 2) * 8 \\ 8 - 1) ceiling.
+	self stopAngle - self startAngle > Float epsilon ifFalse: [
+		maxOctant := maxOctant + 8].
+	min := self startAngle sinCos * radius.
+	max := self stopAngle sinCos * radius.
+
+	x := 0.
+	y := radius.
+	d := 1 - radius.
+	aCanvas asBalloonCanvas translateBy: self center during: [:canvas |
+		"Central midpoint loop."
+		[x <= y] whileTrue: [
+			minOctant to: maxOctant do: [:octant |
+				(octant \\ 8 caseOf: {
+					[0] -> [((octant = minOctant ==> [x >= min x])
+						and: [octant = maxOctant ==> [x <= max x]])
+							ifTrue: [x @ y]].
+					[1] -> [((octant = minOctant ==> [x <= min y])
+						and: [octant = maxOctant ==> [x >= max y]])
+							ifTrue: [y @ x]].
+					[2] -> [((octant = minOctant ==> [x negated <= min y])
+						and: [octant = maxOctant ==> [x negated >= max y]])
+							ifTrue: [y @ x negated]].
+					[3] -> [((octant = minOctant ==> [x <= min x])
+						and: [octant = maxOctant ==> [x >= max x]])
+							ifTrue: [x @ y negated]].
+					[4] -> [((octant = minOctant ==> [x negated <= min x])
+						and: [octant = maxOctant ==> [x negated >= max x]])
+							ifTrue: [x negated @ y negated]].
+					[5] -> [((octant = minOctant ==> [x negated >= min y])
+						and: [octant = maxOctant ==> [x negated <= max y]])
+							ifTrue: [y negated @ x negated]].
+					[6] -> [((octant = minOctant ==> [x >= min y])
+						and: [octant = maxOctant ==> [x <= max y]])
+							ifTrue: [y negated @ x]].
+					[7] -> [((octant = minOctant ==> [x negated >= min x])
+						and: [octant = maxOctant ==> [x negated <= max x]])
+							ifTrue: [x negated @ y]]
+				}) ifNotNil: [:p |
+					canvas line: (p * innerFraction) rounded to: (p * outerFraction) rounded width: self borderCorrectionOffset color: self color.
+					self borderWidth > 0 ifTrue: [
+						innerFraction > 0 ifTrue: [
+							canvas fillOval: (self borderWidth asPoint + self borderCorrectionOffset center: p * innerFraction) color: self borderColor].
+						canvas fillOval: (self borderWidth asPoint + self borderCorrectionOffset center: p * outerFraction) color: self borderColor]]].
+			d <= 0
+				ifFalse: [
+					d := d + (x - y * 2) + 5.
+					y := y - 1]
+				ifTrue: [
+					d := d + (x * 2) + 3].
+			 x := x + 1].
+
+		"Draw arc lines if approriate."
+		isArc ifTrue: [
+			canvas
+				line: min * innerFraction to: min * outerFraction width: self borderWidth color: self borderColor;
+				line: max * innerFraction to: max * outerFraction width: self borderWidth color: self borderColor]].

src/ColorContextMenu-Core.package/ArcRingMorph.class/instance/drawEllipseOn..st

@@ -0,0 +1,90 @@
+drawing
+drawEllipseOn: aCanvas
+	"Draw the receiver on aCanvas. Midpoint ellipse algorithm adaption."
+
+	| radius minQuadrant maxQuadrant min max d x y |
+	radius := self radius.
+	minQuadrant := (self startAngle / (Float pi * 2) * 4 \\ 4) floor.
+	maxQuadrant := (self stopAngle / (Float pi * 2) * 4 \\ 4 - 1) ceiling.
+	self stopAngle - self startAngle > Float epsilon ifFalse: [
+		maxQuadrant := maxQuadrant + 4].
+	min := self startAngle sinCos * radius.
+	max := self stopAngle sinCos * radius.
+
+	x := 0.
+	y := radius y.
+	d := x @ y * (radius y squared @ radius x squared) * 2.
+	aCanvas asBalloonCanvas translateBy: self center during: [:canvas |
+		| d1 d2 |
+		"Region 1."
+		d1 := radius y squared + (0.25 - radius y * radius x squared).
+		[d x < d y] whileTrue: [
+			minQuadrant to: maxQuadrant do: [:quadrant |
+				(quadrant \\ 4 caseOf: {
+					[0] -> [((quadrant = minQuadrant ==> [x >= min x])
+						and: [quadrant = maxQuadrant ==> [x <= max x]])
+							ifTrue: [x @ y]].
+					[1] -> [((quadrant = minQuadrant ==> [x <= min x])
+						and: [quadrant = maxQuadrant ==> [x >= max x]])
+							ifTrue: [x @ y negated]].
+					[2] -> [((quadrant = minQuadrant ==> [x negated <= min x])
+						and: [quadrant = maxQuadrant ==> [x negated >= max x]])
+							ifTrue: [x negated @ y negated]].
+					[3] -> [((quadrant = minQuadrant ==> [x negated >= min x])
+						and: [quadrant = maxQuadrant ==> [x negated <= max x]])
+							ifTrue: [x negated @ y]].
+				}) ifNotNil: [:p |
+					canvas line: (p * innerFraction) rounded to: (p * outerFraction) rounded width: self borderCorrectionOffset color: self color.
+					self borderWidth > 0 ifTrue: [
+						innerFraction > 0 ifTrue: [
+							canvas fillOval: (self borderWidth asPoint + self borderCorrectionOffset center: p * innerFraction) color: self borderColor].
+						canvas fillOval: (self borderWidth asPoint + self borderCorrectionOffset center: p * outerFraction) color: self borderColor]]].
+			x := x + 1.
+			d1 < 0
+				ifTrue: [
+					d := d + (radius y squared * 2 @ 0).
+					d1 := d1 + d x + radius y squared]
+				ifFalse: [
+					y := y - 1.
+					d := d + (radius y squared @ radius x squared negated * 2).
+					d1 := d1 + d x - d y + radius y squared]].
+
+		"Region 2."
+		d2 := (radius y squared * (x + 0.5) squared) + (radius x squared * (y - 1) squared) - (radius x squared * radius y squared).
+		[y >= 0] whileTrue: [
+			minQuadrant to: maxQuadrant do: [:quadrant |
+				(quadrant \\ 4 caseOf: {
+					[0] -> [((quadrant = minQuadrant ==> [x >= min x])
+						and: [quadrant = maxQuadrant ==> [x <= max x]])
+							ifTrue: [x @ y]].
+					[1] -> [((quadrant = minQuadrant ==> [x <= min x])
+						and: [quadrant = maxQuadrant ==> [x >= max x]])
+							ifTrue: [x @ y negated]].
+					[2] -> [((quadrant = minQuadrant ==> [x negated <= min x])
+						and: [quadrant = maxQuadrant ==> [x negated >= max x]])
+							ifTrue: [x negated @ y negated]].
+					[3] -> [((quadrant = minQuadrant ==> [x negated >= min x])
+						and: [quadrant = maxQuadrant ==> [x negated <= max x]])
+							ifTrue: [x negated @ y]].
+				}) ifNotNil: [:p |
+					canvas line: (p * innerFraction) rounded to: (p * outerFraction) rounded width: self borderCorrectionOffset color: self color.
+					self borderWidth > 0 ifTrue: [
+						innerFraction > 0 ifTrue: [
+							canvas
+								fillOval: (self borderWidth asPoint + self borderCorrectionOffset center: p * innerFraction) color: self borderColor].
+						canvas fillOval: (self borderWidth asPoint + self borderCorrectionOffset center: p * outerFraction) color: self borderColor]]].
+			y := y - 1.
+			d2 > 0
+				ifTrue: [
+					d := d - (0 @ radius x squared * 2).
+					d2 := d2 - d y + radius x squared]
+				ifFalse: [
+					x := x + 1.
+					d := d + (radius y squared @ radius x squared negated * 2).
+					d2 := d2 + d x - d y + radius x squared]].
+
+		"Draw arc lines if approriate."
+		(self startAngle closeTo: self stopAngle) ifFalse: [
+			canvas
+				line: min * innerFraction to: min * outerFraction width: self borderWidth color: self borderColor;
+				line: max * innerFraction to: max * outerFraction width: self borderWidth color: self borderColor]].

src/ColorContextMenu-Core.package/ArcRingMorph.class/instance/drawOn..st

@@ -0,0 +1,7 @@
+drawing
+drawOn: aCanvas
+	"Draw the receiver on aCanvas. Midpoint circle algorithm adaption."
+
+	self isCircle
+		ifTrue: [self drawCircleOn: aCanvas "optimized."]
+		ifFalse: [self drawEllipseOn: aCanvas].

src/ColorContextMenu-Core.package/ArcRingMorph.class/instance/effectiveBounds.st

@@ -0,0 +1,12 @@
+geometry - layout
+effectiveBounds
+	"Answer the bounds that are actualy occluded by the visible arc."
+
+	| rect |
+	rect := self startAngle sinCos rect: self stopAngle sinCos.
+	(0 to: 3) * Float pi / 2 do: [:angle |
+		(self containsAngle: angle) ifTrue: [
+			rect := rect encompass: angle sinCos]].
+	^ (((rect scaleBy: self innerRadius) merge: (rect scaleBy: self radius))
+		translateBy: self center)
+			outsetBy: self borderCorrectionOffset

src/ColorContextMenu-Core.package/ArcRingMorph.class/instance/initialize.st

@@ -0,0 +1,8 @@
+initialization
+initialize
+
+	super initialize.
+
+	startAngle := stopAngle := 0.
+	innerFraction := 0.
+	outerFraction := 1.

src/ColorContextMenu-Core.package/ArcRingMorph.class/instance/initializeToStandAlone.st

@@ -0,0 +1,11 @@
+initialization
+initializeToStandAlone
+
+	super initializeToStandAlone.
+
+	self
+		startAngle: 0
+		stopAngle: Float pi * 2 * (3 / 4).
+	self
+		innerFraction: 0.25
+		outerFraction: 0.75.

src/ColorContextMenu-Core.package/ArcRingMorph.class/instance/innerFraction..st

@@ -0,0 +1,4 @@
+accessing
+innerFraction: fractionNumber
+
+	^ self innerFraction: fractionNumber outerFraction: self outerFraction

src/ColorContextMenu-Core.package/ArcRingMorph.class/instance/innerFraction.outerFraction..st

@@ -0,0 +1,10 @@
+accessing
+innerFraction: innerFractionNumber outerFraction: outerFractionNumber
+
+	self assert: [innerFractionNumber between: 0 and: 1].
+	self assert: [outerFractionNumber between: 0 and: 1].
+
+	innerFraction := innerFractionNumber.
+	outerFraction := outerFractionNumber.
+
+	self layoutChanged; changed.

src/ColorContextMenu-Core.package/ArcRingMorph.class/instance/innerFraction.st

@@ -0,0 +1,4 @@
+accessing
+innerFraction
+
+	^ innerFraction

src/ColorContextMenu-Core.package/ArcRingMorph.class/instance/innerRadius.st

@@ -0,0 +1,4 @@
+accessing
+innerRadius
+
+	^ self radius * self innerFraction

src/ColorContextMenu-Core.package/ArcRingMorph.class/instance/isArc.st

@@ -0,0 +1,4 @@
+testing
+isArc
+
+	^ (self startAngle closeTo: self stopAngle) not

src/ColorContextMenu-Core.package/ArcRingMorph.class/instance/isCircle.st

@@ -0,0 +1,4 @@
+testing
+isCircle
+
+	^ self width = self height

src/ColorContextMenu-Core.package/ArcRingMorph.class/instance/outerBounds.st

@@ -0,0 +1,5 @@
+geometry - layout
+outerBounds
+	"Drawing of borders is a bit inaccurate, make sure to invalidate every trace."
+
+	^ super outerBounds outsetBy: self borderWidth + self borderCorrectionOffset

src/ColorContextMenu-Core.package/ArcRingMorph.class/instance/outerFraction..st

@@ -0,0 +1,4 @@
+accessing
+outerFraction: fractionNumber
+
+	^ self innerFraction: self innerFraction outerFraction: fractionNumber

src/ColorContextMenu-Core.package/ArcRingMorph.class/instance/outerFraction.st

@@ -0,0 +1,4 @@
+accessing
+outerFraction
+
+	^ outerFraction

src/ColorContextMenu-Core.package/ArcRingMorph.class/instance/outerRadius.st

@@ -0,0 +1,4 @@
+accessing
+outerRadius
+
+	^ self radius * self outerFraction

src/ColorContextMenu-Core.package/ArcRingMorph.class/instance/radius.st

@@ -0,0 +1,4 @@
+accessing
+radius
+
+	^ self width @ self height / 2

src/ColorContextMenu-Core.package/ArcRingMorph.class/instance/startAngle..st

@@ -0,0 +1,4 @@
+accessing
+startAngle: radialNumber
+
+	^ self startAngle: radialNumber stopAngle: self stopAngle

src/ColorContextMenu-Core.package/ArcRingMorph.class/instance/startAngle.st

@@ -0,0 +1,4 @@
+accessing
+startAngle
+
+	^ startAngle

src/ColorContextMenu-Core.package/ArcRingMorph.class/instance/startAngle.stopAngle..st

@@ -0,0 +1,7 @@
+accessing
+startAngle: radialNumberStart stopAngle: radialNumberStop
+
+	startAngle := radialNumberStart \\ (Float pi * 2).
+	stopAngle := radialNumberStop \\ (Float pi * 2).
+
+	self layoutChanged; changed.

src/ColorContextMenu-Core.package/ArcRingMorph.class/instance/stopAngle..st

@@ -0,0 +1,4 @@
+accessing
+stopAngle: radialNumber
+
+	^ self startAngle: self startAngle stopAngle: radialNumber

src/ColorContextMenu-Core.package/ArcRingMorph.class/instance/stopAngle.st

@@ -0,0 +1,4 @@
+accessing
+stopAngle
+
+	^ stopAngle

src/ColorContextMenu-Core.package/ArcRingMorph.class/instance/worldBoundsForHalo.st

@@ -0,0 +1,11 @@
+geometry - misc
+worldBoundsForHalo
+
+	| r |
+	Preferences haloEnclosesFullBounds ifTrue: [
+		^ super worldBoundsForHalo].
+
+	r := self bounds: self effectiveBounds in: self world.
+	^ Preferences showBoundsInHalo
+		ifTrue: [r outsetBy: self borderCorrectionOffset]
+		ifFalse: [r]

src/ColorContextMenu-Core.package/ArcRingMorph.class/methodProperties.json

@@ -0,0 +1,31 @@
+{
+	"class" : {
+		 },
+	"instance" : {
+		"borderCorrectionOffset" : "ct 2/7/2021 21:20",
+		"changed" : "ct 2/7/2021 19:16",
+		"containsAngle:" : "ct 2/5/2021 19:45",
+		"containsPoint:" : "ct 2/7/2021 19:14",
+		"drawCircleOn:" : "ct 2/7/2021 21:19",
+		"drawEllipseOn:" : "ct 2/7/2021 21:19",
+		"drawOn:" : "ct 1/31/2021 18:56",
+		"effectiveBounds" : "ct 2/7/2021 19:14",
+		"initialize" : "ct 2/5/2021 18:45",
+		"initializeToStandAlone" : "ct 2/7/2021 19:40",
+		"innerFraction" : "ct 1/31/2021 00:40",
+		"innerFraction:" : "ct 2/7/2021 19:39",
+		"innerFraction:outerFraction:" : "ct 2/7/2021 19:59",
+		"innerRadius" : "ct 1/31/2021 00:53",
+		"isArc" : "ct 2/5/2021 19:44",
+		"isCircle" : "ct 1/31/2021 18:51",
+		"outerBounds" : "ct 2/7/2021 19:11",
+		"outerFraction" : "ct 1/31/2021 00:40",
+		"outerFraction:" : "ct 2/7/2021 19:40",
+		"outerRadius" : "ct 1/31/2021 00:55",
+		"radius" : "ct 1/31/2021 18:50",
+		"startAngle" : "ct 1/31/2021 00:32",
+		"startAngle:" : "ct 2/7/2021 19:38",
+		"startAngle:stopAngle:" : "ct 2/7/2021 19:59",
+		"stopAngle" : "ct 1/31/2021 00:33",
+		"stopAngle:" : "ct 2/7/2021 19:38",
+		"worldBoundsForHalo" : "ct 2/7/2021 19:12" } }