Merge pull request #97 from OpenSmock/Issue_0059_pharo11

Fix for the group command (#59)

src/Pyramid-Bloc/PyramidGroupCommand.class.st

@@ -14,6 +14,14 @@ PyramidGroupCommand >> canBeUsedFor: anObject [
 			  anObject allSatisfy: [ :each | each parent = parent ] ] ]
 ]
 
+{ #category : #'as yet unclassified' }
+PyramidGroupCommand >> cleanUpRoots: roots forGroup: groupElement [
+
+	(roots includesAny: groupElement children) ifFalse: [ ^ self ].
+	roots removeAll: groupElement children.
+	roots add: groupElement.
+]
+
 { #category : #'as yet unclassified' }
 PyramidGroupCommand >> commandInverse [
 
@@ -26,6 +34,38 @@ PyramidGroupCommand >> makeGroupElement [
 	^ BlElement new id: #group; clipChildren: false; yourself
 ]
 
+{ #category : #'as yet unclassified' }
+PyramidGroupCommand >> makeGroupElementFor: aCollection [
+
+	| parent groupElement |
+	"Remove any element from their parent. Add them to a ""group"" element. Then add the ""group"" to the parent."
+	parent := aCollection first parent.
+	parent ifNotNil: [ parent removeChildren: aCollection ].
+	groupElement := self makeGroupElement.
+	groupElement addChildren: aCollection.
+	parent ifNotNil: [ parent addChild: groupElement ].
+
+	^ groupElement
+]
+
+{ #category : #'as yet unclassified' }
+PyramidGroupCommand >> positionGroupElement: groupElement [
+
+	| currentTop currentLeft |
+	currentTop := groupElement children first constraints position y.
+	currentLeft := groupElement children first constraints position x.
+	groupElement childrenDo: [ :child |
+		| childTop childLeft |
+		childTop := child constraints position y.
+		childLeft := child constraints position x.
+		currentTop := currentTop min: childTop.
+		currentLeft := currentLeft min: childLeft ].
+	groupElement position: currentLeft @ currentTop.
+	groupElement childrenDo: [ :child |
+		child position:
+			child constraints position - (currentLeft @ currentTop) ]
+]
+
 { #category : #'as yet unclassified' }
 PyramidGroupCommand >> saveStatesOf: aCollection with: arguments [
 
@@ -61,14 +101,13 @@ PyramidGroupCommand >> saveStatesWithCommandInverseOf: aCollection with: argumen
 { #category : #'as yet unclassified' }
 PyramidGroupCommand >> setValueFor: aCollection with: roots [
 
-	| parent groupElement |
-	parent := aCollection first parent.
-	parent ifNotNil: [ parent removeChildren: aCollection ].
-	groupElement := self makeGroupElement.
-	groupElement addChildren: aCollection.
-	parent ifNotNil: [ parent addChild: groupElement ].
+	| groupElement |
+	"Remove any element from their parent. Add them to a ""group"" element. Then add the ""group"" to the parent."
+	groupElement := self makeGroupElementFor: aCollection.
+
+	"update the position of the group to the most top/left element. Update all position by removing the group position to the element position"
+self positionGroupElement: groupElement.
 
-	(roots includesAny: aCollection) ifFalse: [ ^ self ].
-	roots removeAll: aCollection.
-	roots add: groupElement
+	"remove any roots elements from the roots collection and add the group insteed."
+	self cleanUpRoots: roots forGroup: groupElement
 ]

src/Pyramid-Bloc/PyramidGroupInverseCommand.class.st

@@ -29,6 +29,7 @@ PyramidGroupInverseCommand >> setValueFor: aCollection with: roots [
 	elements := groupElement children asArray.
 	(roots includesAny: elements) ifTrue: [ ^ self ].
 	groupElement removeChildren.
+	elements do: [ :each | each position: each constraints position + groupElement constraints position ].
 
 	groupElement hasParent ifTrue: [
 		groupElement parent addChildren: elements.

src/Pyramid-Tests/PyramidGroupCommandTest.class.st

@@ -192,5 +192,29 @@ PyramidGroupCommandTest >> testSetValueForWith [
 	self deny: parent equals: e1.
 	selection do: [ :each | self assert: each parent equals: parent ].
 	self deny: (roots includesAny: selection).
-	self assert: (roots includes: parent)
+	self assert: (roots includes: parent).
+
+	"parent is nil. elements are not roots. element are not 0@0"
+	e1 := BlElement new position: (40@40); yourself.
+	e2 := BlElement new position: (60@60); yourself.
+	e3 := BlElement new position: (70@70); yourself.
+	e4 := BlElement new position: (100@100); yourself.
+
+	selection := {
+		             e1.
+		             e2.
+		             e3.
+		             e4 }.
+	roots := OrderedCollection new.
+
+	selection do: [ :each | self assert: each parent equals: nil ].
+	self command setValueFor: selection with: roots.
+	parent := selection first parent.
+	self assert: parent isNotNil.
+	self assert: parent constraints position equals: 40 @ 40.
+	self assert: e1 constraints position equals: 0 @ 0.
+	self assert: e2 constraints position equals: 20 @ 20.
+	self assert: e3 constraints position equals: 30 @ 30.
+	self assert: e4 constraints position equals: 60 @ 60.
+	selection do: [ :each | self assert: each parent equals: parent ].
 ]

src/Pyramid-Tests/PyramidGroupInverseCommandTest.class.st

@@ -167,5 +167,29 @@ PyramidGroupInverseCommandTest >> testSetValueForWith [
 	self deny: parent equals: e1.
 	selection do: [ :each | self assert: each parent equals: parent ].
 	self deny: (roots includes: e1).
-	self assert: (roots includesAll: selection)
+	self assert: (roots includesAll: selection).
+
+"parent is nil. elements are not roots. element are not 0@0"
+	e1 := BlElement new position: (40@40); yourself.
+	e2 := BlElement new position: (60@60); yourself.
+	e3 := BlElement new position: (70@70); yourself.
+	e4 := BlElement new position: (100@100); yourself.
+
+
+	selection := {
+		             e2.
+		             e3.
+		             e4 }.
+	e1 addChildren: selection.
+	roots := OrderedCollection new.
+
+	selection do: [ :each | self assert: each parent equals: e1 ].
+	self command setValueFor: selection with: roots.
+	parent := selection first parent.
+	self deny: parent equals: e1.
+	selection do: [ :each | self assert: each parent equals: parent ].
+
+	self assert: e2 constraints position equals: 100 @ 100.
+	self assert: e3 constraints position equals: 110 @ 110.
+	self assert: e4 constraints position equals: 140 @ 140.
 ]