reworked RS interactions

OpenPonk · Oct 15, 2023 · ed5df1c · ed5df1c
1 parent b5e51a5
commit ed5df1c
Show file tree

Hide file tree

Showing 11 changed files with 226 additions and 42 deletions.
diff --git a/repository/OpenPonk-Core/OPBoundary.class.st b/repository/OpenPonk-Core/OPBoundary.class.st
@@ -20,6 +20,13 @@ OPBoundary class >> stonAllInstVarNames [
 	^ super stonAllInstVarNames , #( #name )
 ]
 
+{ #category : #'creating - subelements' }
+OPBoundary >> addSelectionDraggableInteraction [
+
+	roassalShape
+	@ OPRSSelectionDraggableBorder thatAlsoDragsContainedShapes
+]
+
 { #category : #accessing }
 OPBoundary >> defaultHeight [
 	^ 400
@@ -73,14 +80,15 @@ OPBoundary >> renderBasicShape [
 OPBoundary >> renderShapeDetails [
 
 	super renderShapeDetails.
-
-	roassalShape
-		@ OPRSSelectable;
-		@ OPRSSelectionDraggableBorder thatAlsoDragsContainedShapes;
-		@ OPRSResizable.
 	self renderLabel
 ]
 
+{ #category : #'creating - subelements' }
+OPBoundary >> selectableInteraction [
+
+	^ OPRSSelectable
+]
+
 { #category : #'creating - subelements' }
 OPBoundary >> setupLabelLocation: aLocation [
 
@@ -90,6 +98,18 @@ OPBoundary >> setupLabelLocation: aLocation [
 		inner
 ]
 
+{ #category : #interactions }
+OPBoundary >> shouldBePositionableByUser [
+
+	^ true
+]
+
+{ #category : #interactions }
+OPBoundary >> shouldBeResizableByUser [
+
+	^ true
+]
+
 { #category : #hooks }
 OPBoundary >> text [
 	^ self name

diff --git a/repository/OpenPonk-Core/OPDiagramElement.class.st b/repository/OpenPonk-Core/OPDiagramElement.class.st
@@ -62,6 +62,71 @@ OPDiagramElement class >> stonAllInstVarNames [
 	     #sharedStyle #localStyle #ownedElements )
 ]
 
+{ #category : #interactions }
+OPDiagramElement >> addDraggableInteraction [
+
+	roassalShape @ RSDraggable
+]
+
+{ #category : #interactions }
+OPDiagramElement >> addEventForwardingFrom: anOriginalRoassalShape to: aTargetRoassalShape [
+
+	| forward |
+	forward := [ :event | aTargetRoassalShape announce: event ].
+	anOriginalRoassalShape
+		when: RSMouseClick do: forward for: self;
+		when: RSMouseDragStart do: forward for: self;
+		when: RSMouseDragEnd do: forward for: self;
+		when: RSMouseDragging do: forward for: self
+]
+
+{ #category : #interactions }
+OPDiagramElement >> addEventForwardingToOwner [
+
+	| ownerRoassalShape |
+	ownerRoassalShape := self owningElement
+		                     ifNil: [ ^ self ]
+		                     ifNotNil: [ :owner |
+		                     owner roassalShape ifNil: [ ^ self ] ].
+	self addEventForwardingFrom: roassalShape to: ownerRoassalShape
+]
+
+{ #category : #interactions }
+OPDiagramElement >> addInteractions [
+
+	self shouldBeResizableByUser ifTrue: [ self addResizableInteraction ].
+
+	self shouldBeSelectable ifTrue: [
+		self addSelectableInteraction.
+		self shouldBePositionableByUser ifTrue: [
+			self addSelectionDraggableInteraction ].
+		^ self ].
+
+	self shouldBePositionableByUser ifTrue: [
+		self addDraggableInteraction.
+		^ self ].
+
+	self addEventForwardingToOwner
+]
+
+{ #category : #interactions }
+OPDiagramElement >> addResizableInteraction [
+
+	self resizableInteractionTarget @ OPRSResizable
+]
+
+{ #category : #interactions }
+OPDiagramElement >> addSelectableInteraction [
+
+	roassalShape @ self selectableInteraction
+]
+
+{ #category : #interactions }
+OPDiagramElement >> addSelectionDraggableInteraction [
+
+	roassalShape @ OPRSSelectionDraggable
+]
+
 { #category : #'as yet unclassified' }
 OPDiagramElement >> addedByMouseClickTo: aPoint [
 
@@ -321,6 +386,7 @@ OPDiagramElement >> renderIn: aCanvas [
 	self isRendered ifTrue: [ ^ self ].
 	self renderBasicShapeIn: aCanvas.
 	self renderShapeDetails.
+	self addInteractions.
 	self createOwnedElementsWithoutController.
 	self ownedElements do: [ :each | each renderIn: aCanvas ].
 	self updateRenderFromModel.
@@ -340,6 +406,12 @@ OPDiagramElement >> renderShapeDetails [
 
 ]
 
+{ #category : #interactions }
+OPDiagramElement >> resizableInteractionTarget [
+
+	^ roassalShape
+]
+
 { #category : #serialization }
 OPDiagramElement >> resolveAllModelElements: aDictionary [
 
@@ -361,6 +433,12 @@ OPDiagramElement >> roassalShape [
 	^ roassalShape
 ]
 
+{ #category : #interactions }
+OPDiagramElement >> selectableInteraction [
+
+	^ OPRSNoInteraction
+]
+
 { #category : #accessing }
 OPDiagramElement >> sharedStyle [
 	^ sharedStyle ifNil: [ self owningElement ifNotNil: #sharedStyle ]
@@ -374,6 +452,25 @@ OPDiagramElement >> sharedStyle: aStyle [
 	self styleChanged.
 ]
 
+{ #category : #interactions }
+OPDiagramElement >> shouldBePositionableByUser [
+
+	^ false
+]
+
+{ #category : #interactions }
+OPDiagramElement >> shouldBeResizableByUser [
+
+	^ false
+]
+
+{ #category : #interactions }
+OPDiagramElement >> shouldBeSelectable [
+
+	^ self selectableInteraction ~= OPRSNoInteraction and: [
+		  self selectableInteraction class ~= OPRSNoInteraction ]
+]
+
 { #category : #accessing }
 OPDiagramElement >> sourceEdges [
 	^ sourceEdges

diff --git a/repository/OpenPonk-Core/OPEdge.class.st b/repository/OpenPonk-Core/OPEdge.class.st
@@ -63,12 +63,9 @@ OPEdge >> remove [
 ]
 
 { #category : #rendering }
-OPEdge >> renderShapeDetails [
+OPEdge >> selectableInteraction [
 
-	| selectable |
-	selectable := OPRSSelectable new.
-	selectable highlightColor: Color blue.
-	roassalShape @ selectable
+	^ OPRSSelectable highlightColorBlue
 ]
 
 { #category : #accessing }

diff --git a/repository/OpenPonk-Core/OPEdgeLabel.class.st b/repository/OpenPonk-Core/OPEdgeLabel.class.st
@@ -4,12 +4,6 @@ Class {
 	#category : #'OpenPonk-Core-DiagramInterchange'
 }
 
-{ #category : #adding }
-OPEdgeLabel >> addInteractions [
-
-	roassalShape @ RSDraggable
-]
-
 { #category : #adding }
 OPEdgeLabel >> anchorToEdge [
 
@@ -35,11 +29,15 @@ OPEdgeLabel >> defaultMinDistance [
 OPEdgeLabel >> renderShapeDetails [
 
 	super renderShapeDetails.
-
-	self addInteractions.
 	self anchorToEdge
 ]
 
+{ #category : #interactions }
+OPEdgeLabel >> shouldBePositionableByUser [
+
+	^ true
+]
+
 { #category : #'as yet unclassified' }
 OPEdgeLabel >> updateFromRender [
 

diff --git a/repository/OpenPonk-Core/OPNode.class.st b/repository/OpenPonk-Core/OPNode.class.st
@@ -31,7 +31,7 @@ OPNode >> height [
 { #category : #testing }
 OPNode >> isPositionableByUser [
 
-	^ self isRendered not or: [
+	^ self isRendered and: [
 		  self roassalShape isSelectionDraggable or: [
 			  self roassalShape hasInteraction: RSDraggable ] ]
 ]

diff --git a/repository/OpenPonk-Core/OPNote.class.st b/repository/OpenPonk-Core/OPNote.class.st
@@ -178,10 +178,6 @@ OPNote >> renderShapeDetails [
 	self createOwnedFillBoxes.
 	self createOwnedCornerTriangle.
 	self createOwnedBorderLines.
-	roassalShape
-		@ OPRSSelectable;
-		@ OPRSSelectionDraggable;
-		@ OPRSResizable.
 	self updateOwnedElements.
 	self roassalShape
 		when: RSPositionChangedEvent
@@ -193,6 +189,24 @@ OPNote >> renderShapeDetails [
 	self renderLabel
 ]
 
+{ #category : #interactions }
+OPNote >> selectableInteraction [
+
+	^ OPRSSelectable
+]
+
+{ #category : #'creating - subelements' }
+OPNote >> shouldBePositionableByUser [
+
+	^ true
+]
+
+{ #category : #interactions }
+OPNote >> shouldBeResizableByUser [
+
+	^ true
+]
+
 { #category : #accessing }
 OPNote >> text [
 	^ text

diff --git a/repository/OpenPonk-Roassal3/OPRSDraggableControlPointHandle.class.st b/repository/OpenPonk-Roassal3/OPRSDraggableControlPointHandle.class.st
@@ -33,10 +33,10 @@ OPRSDraggableControlPointHandle >> constraint [
 	| moveBlock |
 	moveBlock := [ self updatePosition ].
 	moveBlock value.
-	line from when: RSPositionChangedEvent do: moveBlock.
-	line to when: RSPositionChangedEvent do: moveBlock.
-	line from when: RSExtentChangedEvent do: moveBlock.
-	line to when: RSExtentChangedEvent do: moveBlock
+	line from when: RSPositionChangedEvent do: moveBlock for: self.
+	line to when: RSPositionChangedEvent do: moveBlock for: self.
+	line from when: RSExtentChangedEvent do: moveBlock for: self.
+	line to when: RSExtentChangedEvent do: moveBlock for: self
 ]
 
 { #category : #'as yet unclassified' }
@@ -112,7 +112,8 @@ OPRSDraggableControlPointHandle >> render [
 
 	shape
 		when: RSPositionChangedEvent
-		do: [ :event | self changedPositionBy: event ].
+		do: [ :event | self changedPositionBy: event ]
+		for: self.
 
 	(line from ~= line to or: [ line controlPoints size > 4 ]) ifTrue: [
 		shape @ (RSMenuActivable new menuDo: [ :menu :box |
@@ -125,7 +126,7 @@ OPRSDraggableControlPointHandle >> render [
 				 target: self
 				 selector: #straightenConnection
 				 argument: #(  ) ]) ].
-	clickBox when: RSMouseDragEnd do: [ self onDragEnd ]
+	clickBox when: RSMouseDragEnd do: [ self onDragEnd ] for: self
 ]
 
 { #category : #accessing }

diff --git a/repository/OpenPonk-Roassal3/OPRSNoInteraction.class.st b/repository/OpenPonk-Roassal3/OPRSNoInteraction.class.st
@@ -0,0 +1,10 @@
+Class {
+	#name : #OPRSNoInteraction,
+	#superclass : #RSInteraction,
+	#category : #'OpenPonk-Roassal3-Interactions'
+}
+
+{ #category : #hooks }
+OPRSNoInteraction >> onShape: aShape [
+	"do nothing"
+]
diff --git a/repository/OpenPonk-Roassal3/OPRSSelectable.class.st b/repository/OpenPonk-Roassal3/OPRSSelectable.class.st
@@ -4,6 +4,42 @@ Class {
 	#category : #'OpenPonk-Roassal3-Interactions'
 }
 
+{ #category : #accessing }
+OPRSSelectable class >> highlightAdornments: aBlock [
+
+	^ self new
+		  highlightAdornments: aBlock;
+		  yourself
+]
+
+{ #category : #accessing }
+OPRSSelectable class >> highlightBorderColor: aColor [
+
+	^ self new
+		  highlightBorderColor: aColor;
+		  yourself
+]
+
+{ #category : #accessing }
+OPRSSelectable class >> highlightBorderColorBlue [
+
+	^ self highlightBorderColor: Color blue
+]
+
+{ #category : #accessing }
+OPRSSelectable class >> highlightColor: aColor [
+
+	^ self new
+		  highlightColor: aColor;
+		  yourself
+]
+
+{ #category : #accessing }
+OPRSSelectable class >> highlightColorBlue [
+
+	^ self highlightColor: Color blue
+]
+
 { #category : #announcer }
 OPRSSelectable >> announceHighlight: shape source: shapeOrCanvas [