Merge branch 'master' into release_base

OpenPonk · Nov 15, 2024 · 5cc65f2 · 5cc65f2
2 parents c46404e + 99434f8
commit 5cc65f2
Show file tree

Hide file tree

Showing 134 changed files with 1,737 additions and 767 deletions.
diff --git a/.smalltalk.ston b/.smalltalk.ston
@@ -10,14 +10,13 @@ SmalltalkCISpec {
 		}
 	],
 	#testing : {
+		#packages : [
+			'OpenPonk*'
+		],
 		#coverage : { 
 			#packages: [ 
 				'OpenPonk*' 
 			] 
-		},
-		#packages : [
-			'OpenPonk*',
-			'SynchronizedLinks*'
-		]
+		}
 	}
 }
diff --git a/repository/BaselineOfOpenPonk/BaselineOfOpenPonk.class.st b/repository/BaselineOfOpenPonk/BaselineOfOpenPonk.class.st
@@ -25,7 +25,7 @@ BaselineOfOpenPonk >> baseline: spec [
 			package: 'OpenPonk-Morphic';
 			package: 'OpenPonk-Spec' with: [
 				spec requires:
-						#( 'NewTools' 'Magritte' 'SynchronizedLinks' 'OpenPonk-Morphic' ) ];
+						#( 'NewTools' 'Magritte' 'OpenPonkSynchronizedLinks' 'OpenPonk-Morphic' ) ];
 			package: 'OpenPonk-Releaser'.
 		spec
 			group: 'default'
@@ -43,7 +43,7 @@ BaselineOfOpenPonk >> externalProjectsBaseline: spec [
 
 	spec baseline: 'Magritte' with: [
 		spec
-			repository: 'github://JanBliznicenko/magritte:master';
+			repository: 'github://JanBliznicenko/magritte:6d92c9d';
 			loads: #( Core 'Magritte-Morph' ) ].
 
 	spec
@@ -63,20 +63,20 @@ BaselineOfOpenPonk >> externalProjectsBaseline: spec [
 	spec
 		baseline: 'RoassalExporters'
 		with: [
-		spec repository: 'github://pharo-graphics/RoassalExporters:v1.02' ]
+		spec repository: 'github://pharo-graphics/RoassalExporters:v1.02' ].
+
+	spec baseline: 'NewTools' with: [
+		spec
+			repository: 'github://pharo-spec/NewTools:Pharo12';
+			loads: #( FileBrowser ) ]
 ]
 
 { #category : 'baselines' }
 BaselineOfOpenPonk >> internalProjectsBaseline: spec [
 
-	spec baseline: 'NewTools' with: [ 
-		spec
-			repository: 'github://pharo-spec/NewTools:Pharo12';
-			loads: #( FileBrowser ) ].
 	spec
-		baseline: 'SynchronizedLinks'
-		with: [ 
-		spec repository: 'github://openponk/synchronized-links:v4.0.x' ]
+		baseline: 'OpenPonkSynchronizedLinks'
+		with: [ spec repository: 'github://openponk/synchronized-links:v4.1.x' ]
 ]
 
 { #category : 'baselines' }

diff --git a/...penPonk-Core/OPAbstractShapeTest.class.st → ...ore/OPAbstractDiagramElementTest.class.st b/...penPonk-Core/OPAbstractShapeTest.class.st → ...ore/OPAbstractDiagramElementTest.class.st
@@ -1,40 +1,62 @@
 Class {
-	#name : 'OPAbstractShapeTest',
+	#name : 'OPAbstractDiagramElementTest',
 	#superclass : 'TestCase',
 	#instVars : [
 		'canvas',
-		'shape'
+		'shape',
+		'model'
 	],
 	#category : 'OpenPonk-Core-Tests',
 	#package : 'OpenPonk-Core',
 	#tag : 'Tests'
 }
 
 { #category : 'testing' }
-OPAbstractShapeTest class >> isAbstract [
+OPAbstractDiagramElementTest class >> isAbstract [
 	^ self name includesSubstring: 'Abstract'
 ]
 
 { #category : 'instance creation' }
-OPAbstractShapeTest >> newShapeInstance [
+OPAbstractDiagramElementTest >> modelClass [
+
+	^ self subclassResponsibility
+]
+
+{ #category : 'instance creation' }
+OPAbstractDiagramElementTest >> newModelInstance [
+
+	^ self modelClass new
+]
+
+{ #category : 'instance creation' }
+OPAbstractDiagramElementTest >> newShapeInstance [
 	^ self shapeClass new
 ]
 
 { #category : 'running' }
-OPAbstractShapeTest >> setUp [
+OPAbstractDiagramElementTest >> setUp [
 
 	super setUp.
 	shape := self newShapeInstance.
+	model := self newModelInstance.
+	shape modelElement: model.
 	canvas := RSCanvas new
 ]
 
 { #category : 'hooks' }
-OPAbstractShapeTest >> shapeClass [
+OPAbstractDiagramElementTest >> shapeClass [
 	^ self subclassResponsibility
 ]
 
+{ #category : 'running' }
+OPAbstractDiagramElementTest >> testEmpty [
+
+	self assert: shape modelElement equals: model.
+	self assertCollection: shape modelElements hasSameElements: { model }
+]
+
 { #category : 'tests' }
-OPAbstractShapeTest >> testRenderSimplifiedForController [
+OPAbstractDiagramElementTest >> testRenderSimplifiedForController [
 
 	| diagramController controller |
 	canvas := RSCanvas new.

diff --git a/repository/OpenPonk-Core/OPAbstractEdgeTest.class.st b/repository/OpenPonk-Core/OPAbstractEdgeTest.class.st
@@ -1,6 +1,6 @@
 Class {
 	#name : 'OPAbstractEdgeTest',
-	#superclass : 'OPAbstractShapeTest',
+	#superclass : 'OPAbstractDiagramElementTest',
 	#category : 'OpenPonk-Core-Tests',
 	#package : 'OpenPonk-Core',
 	#tag : 'Tests'

diff --git a/repository/OpenPonk-Core/OPAbstractLabelTest.class.st b/repository/OpenPonk-Core/OPAbstractLabelTest.class.st
@@ -1,6 +1,6 @@
 Class {
 	#name : 'OPAbstractLabelTest',
-	#superclass : 'OPAbstractShapeTest',
+	#superclass : 'OPAbstractNodeTest',
 	#category : 'OpenPonk-Core-Tests',
 	#package : 'OpenPonk-Core',
 	#tag : 'Tests'

diff --git a/repository/OpenPonk-Core/OPAbstractNodeTest.class.st b/repository/OpenPonk-Core/OPAbstractNodeTest.class.st
@@ -0,0 +1,51 @@
+Class {
+	#name : 'OPAbstractNodeTest',
+	#superclass : 'OPAbstractDiagramElementTest',
+	#category : 'OpenPonk-Core-Tests',
+	#package : 'OpenPonk-Core',
+	#tag : 'Tests'
+}
+
+{ #category : 'tests' }
+OPAbstractNodeTest >> testDoesNotMoveOnShapeCreation [
+
+	| diagram originalRoassalPosition movedRoassalPosition newShape |
+	diagram := OPDiagram new.
+	diagram renderIn: canvas.
+	shape owningElement: diagram.
+	shape modelElement: model.
+	shape renderIn: canvas.
+	shape isPositionableByUser ifFalse: [ ^ self ].
+	originalRoassalPosition := shape roassalShape position.
+	shape updateFromRender.
+	self assert: shape bounds position equals: originalRoassalPosition.
+	shape roassalShape translateBy: 100 @ 50.
+	movedRoassalPosition := shape roassalShape position.
+	self
+		assert: movedRoassalPosition
+		equals: originalRoassalPosition + (100 @ 50).
+	self assert: shape bounds position equals: originalRoassalPosition.
+	newShape := OPTestLabel in: diagram.
+	newShape renderIn: canvas.
+	self assert: shape bounds position equals: originalRoassalPosition.
+	self assert: shape roassalShape position equals: movedRoassalPosition
+]
+
+{ #category : 'tests' }
+OPAbstractNodeTest >> testUpdateFromRender [
+
+	| originalBounds movedBounds |
+	self assert: shape bounds equals: nil.
+	shape modelElement: model.
+	shape renderIn: canvas.
+	shape updateFromRender.
+	shape isPositionableByUser ifFalse: [ ^ self ].
+	originalBounds := shape bounds veryDeepCopy.
+	shape roassalShape translateBy: 100 @ 50.
+	self assert: shape bounds position equals: originalBounds position.
+	shape updateFromRender.
+	movedBounds := shape bounds veryDeepCopy.
+	self deny: movedBounds position equals: originalBounds position.
+	self assert: movedBounds position equals: originalBounds position + (100 @ 50).
+
+]
diff --git a/repository/OpenPonk-Core/OPBoundNode.class.st b/repository/OpenPonk-Core/OPBoundNode.class.st
@@ -103,7 +103,7 @@ OPBoundNode >> renderIn: aCanvas [
 { #category : 'as yet unclassified' }
 OPBoundNode >> updateFromRender [
 
-	self isResizableByUser | self isPositionableByUser ifTrue: [
+	(self isResizableByUser or: [ self isPositionableByUser ]) ifTrue: [
 		self bounds: (OPNodeBounds new
 				 position: roassalShape position
 				 extent: roassalShape extent) ].

diff --git a/repository/OpenPonk-Core/OPBoundary.class.st b/repository/OpenPonk-Core/OPBoundary.class.st
@@ -1,6 +1,8 @@
 Class {
 	#name : 'OPBoundary',
 	#superclass : 'OPDiagramOnlyShapeWithText',
+	#traits : 'OPTColoredAsFillAndBorderColoredAsStroke',
+	#classTraits : 'OPTColoredAsFillAndBorderColoredAsStroke classTrait',
 	#instVars : [
 		'name'
 	],
@@ -24,11 +26,23 @@ OPBoundary >> addSelectionDraggableInteraction [
 	@ OPRSSelectionDraggableBorder thatAlsoDragsContainedShapes
 ]
 
+{ #category : 'accessing' }
+OPBoundary >> defaultFillColor [
+
+	^ Color transparent
+]
+
 { #category : 'accessing' }
 OPBoundary >> defaultHeight [
 	^ 400
 ]
 
+{ #category : 'accessing' }
+OPBoundary >> defaultStrokeColor [
+
+	^ Color gray slightlyDarker
+]
+
 { #category : 'accessing' }
 OPBoundary >> defaultWidth [
 	^ 500
@@ -64,21 +78,17 @@ OPBoundary >> printOn: aStream [
 		nextPutAll: ''')'
 ]
 
-{ #category : 'creating - subelements' }
+{ #category : 'rendering' }
 OPBoundary >> renderBasicShape [
 
 	^ RSBox new
-		  color: Color transparent;
 		  width: self defaultWidth;
 		  height: self defaultHeight;
-		  borderDo: [ :border | 
-			  border
-				  color: Color gray;
-				  dashArray: #( 4 ) ];
+		  borderDo: [ :border | border dashArray: #( 4 ) ];
 		  yourself
 ]
 
-{ #category : 'creating - subelements' }
+{ #category : 'interactions' }
 OPBoundary >> selectableInteraction [
 
 	^ OPRSSelectable

diff --git a/repository/OpenPonk-Core/OPCommonElementController.class.st b/repository/OpenPonk-Core/OPCommonElementController.class.st
@@ -45,6 +45,12 @@ OPCommonElementController >> isCommon [
 	^ true
 ]
 
+{ #category : 'testing' }
+OPCommonElementController >> isHideable [
+
+	^ false
+]
+
 { #category : 'accessing' }
 OPCommonElementController >> model [
 

diff --git a/repository/OpenPonk-Core/OPController.class.st b/repository/OpenPonk-Core/OPController.class.st
@@ -5,9 +5,9 @@ Class {
 	#name : 'OPController',
 	#superclass : 'Object',
 	#instVars : [
-		'model',
 		'diagramController',
-		'diagramElement'
+		'diagramElement',
+		'adapter'
 	],
 	#category : 'OpenPonk-Core-Controllers',
 	#package : 'OpenPonk-Core',
@@ -106,7 +106,7 @@ OPController >> diagramController: aDiagramController [
 { #category : 'accessing' }
 OPController >> diagramElement [
 
-	^ diagramElement ifNil: [ diagramElement := OPNoShape new ]
+	^ diagramElement ifNil: [ OPNoShape instance ]
 ]
 
 { #category : 'accessing' }
@@ -163,6 +163,7 @@ OPController >> internalUnsubscribeFrom: aModel [
 
 { #category : 'testing' }
 OPController >> isHideable [
+
 	^ false
 ]
 
@@ -186,7 +187,8 @@ OPController >> linkDiagramElementToModel [
 
 { #category : 'accessing' }
 OPController >> model [
-	^ model
+
+	^ adapter ifNotNil: [ :existingAdapter | existingAdapter model ]
 ]
 
 { #category : 'accessing' }
@@ -195,9 +197,9 @@ OPController >> model: aModel [
 	aModel ifNotNil: [ 
 		aModel uuid ifNil: [ 
 			self error: 'All model objects must have a uuid to be used by OP' ] ].
-	model ifNotNil: [ :m | self internalUnsubscribeFrom: m ].
-	model := aModel.
-	model ifNotNil: [ :m | self internalSubscribeTo: m ]
+	self model ifNotNil: [ :m | self internalUnsubscribeFrom: m ].
+	adapter := OPModelAdapter forModel: aModel.
+	self model ifNotNil: [ :m | self internalSubscribeTo: m ]
 ]
 
 { #category : 'announcements' }
@@ -274,14 +276,14 @@ OPController >> removeControllerAndDiagramElement [
 { #category : 'destruction' }
 OPController >> removeControllerAndModel [
 
-	self removeDependent.
+	self removeDependentConrollersAndModels.
 	self removeControllerAndDiagramElement.
 	self removeModel.
 	self model: nil
 ]
 
 { #category : 'destruction' }
-OPController >> removeDependent [
+OPController >> removeDependentConrollersAndModels [
 	self dependentControllers
 		do: [ :each | 
 			self diagramController controllers
@@ -311,7 +313,7 @@ OPController >> removeDependentControllersAndDiagramElements [
 OPController >> removeDiagramElement [
 
 	self diagramElement remove.
-	self diagramElement: OPNoShape new
+	self diagramElement: nil
 ]
 
 { #category : 'destruction' }