fixed loading self-loops from file

OpenPonk · Nov 22, 2023 · cc943ba · cc943ba
1 parent 03ffc3a
commit cc943ba
Show file tree

Hide file tree

Showing 3 changed files with 68 additions and 13 deletions.
diff --git a/repository/OpenPonk-Roassal/OPRSDraggableCPController.class.st b/repository/OpenPonk-Roassal/OPRSDraggableCPController.class.st
@@ -89,15 +89,27 @@ OPRSDraggableCPController >> innerControlPointsFor: aLine [
 
 	"self-loop"
 
-	oldShapeEncompassingRectangle := aLine
-		                                 propertyAt: self class
-		                                 ifAbsent: [
-		                                 ^ self
-			                                   defaultInnerSelfControlPointsFor:
-			                                   aLine ].
-
-	newShapeEncompassingRectangle := aLine from encompassingRectangle.
-	aLine propertyAt: self class put: newShapeEncompassingRectangle copy.
+	newShapeEncompassingRectangle := aLine from encompassingRectangle
+		                                 copy.
+	oldShapeEncompassingRectangle := oldInnerCPs
+		                                 ifEmpty: [
+			                                 aLine
+				                                 propertyAt: self class
+				                                 put:
+				                                 newShapeEncompassingRectangle.
+			                                 ^ self
+				                                   defaultInnerSelfControlPointsFor:
+				                                   aLine ]
+		                                 ifNotEmpty: [
+			                                 aLine
+				                                 propertyAt: self class
+				                                 ifAbsent: [
+				                                 newShapeEncompassingRectangle ] ].
+
+	aLine propertyAt: self class put: newShapeEncompassingRectangle.
+
+	oldShapeEncompassingRectangle = newShapeEncompassingRectangle
+		ifTrue: [ ^ oldInnerCPs ].
 
 	^ oldInnerCPs collect: [ :each |
 		  each + (Point

diff --git a/repository/OpenPonk-Roassal/OPRSDraggableCPControllerTest.class.st b/repository/OpenPonk-Roassal/OPRSDraggableCPControllerTest.class.st
@@ -0,0 +1,43 @@
+Class {
+	#name : #OPRSDraggableCPControllerTest,
+	#superclass : #TestCase,
+	#instVars : [
+		'controller',
+		'boxFrom',
+		'selfLine'
+	],
+	#category : #'OpenPonk-Roassal-Tests'
+}
+
+{ #category : #running }
+OPRSDraggableCPControllerTest >> setUp [
+
+	super setUp.
+
+	boxFrom := RSBox new.
+	selfLine := RSPolyline new.
+	controller := OPRSDraggableCPController new.
+	selfLine controlPointsController: controller.
+	selfLine
+		from: boxFrom;
+		to: boxFrom
+]
+
+{ #category : #tests }
+OPRSDraggableCPControllerTest >> testSelfLoopInitial [
+
+	selfLine update.
+	self assert: selfLine controlPoints size equals: 5
+]
+
+{ #category : #tests }
+OPRSDraggableCPControllerTest >> testSelfLoopPreset [
+
+	selfLine controlPoints: {
+			boxFrom encompassingRectangle topCenter.
+			(boxFrom encompassingRectangle topCenter - (0 @ 100)).
+			(boxFrom encompassingRectangle rightCenter + (100 @ 0)).
+			boxFrom encompassingRectangle rightCenter }.
+	selfLine update.
+	self assert: selfLine controlPoints size equals: 4
+]
diff --git a/repository/OpenPonk-Roassal/OPRSDraggableControlPoints.class.st b/repository/OpenPonk-Roassal/OPRSDraggableControlPoints.class.st
@@ -70,13 +70,13 @@ OPRSDraggableControlPoints >> promoteFor: aLine handle: aMidpointHandle [
 	 3. Do full reload."
 	newPoint := aMidpointHandle shape position.
 	aLine from = aMidpointHandle from
-		ifTrue: [ 
-			aLine controlPoints: { 
+		ifTrue: [
+			aLine controlPoints: {
 					aLine controlPoints first.
 					newPoint } , aLine controlPoints allButFirst ]
-		ifFalse: [ 
+		ifFalse: [
 			| indexOfMidpointHandle |
-			indexOfMidpointHandle := handles detectIndex: [ :each | 
+			indexOfMidpointHandle := handles detectIndex: [ :each |
 				                         each shape = aMidpointHandle from ].
 			aLine controlPoints:
 				(aLine controlPoints first: indexOfMidpointHandle + 1)