Issue 0103

src/Pyramid-Bloc/PyramidGroupCommand.class.st

@@ -1,51 +1,91 @@
 Class {
 	#name : #PyramidGroupCommand,
-	#superclass : #PyramidAbstractGroupCommand,
-	#category : #'Pyramid-Bloc-plugin-bloc'
+	#superclass : #PyramidCommand,
+	#instVars : [
+		'historyCommandArguments'
+	],
+	#category : #'Pyramid-Bloc-plugin-bloc-group'
 }
 
 { #category : #testing }
-PyramidGroupCommand >> canBeUsedFor: anObject [
+PyramidGroupCommand >> canBeUsedFor: aCollectionOfBlElements [
+
+	| parent |
+	aCollectionOfBlElements isCollection ifFalse: [ ^ false ].
+	aCollectionOfBlElements ifEmpty: [ ^ false ].
+
+	parent := aCollectionOfBlElements first parent.
+	parent ifNil: [ ^ false ].
+	^ aCollectionOfBlElements allSatisfy: [ :each |
+				  each parent = parent ]
+]
 
-	^ anObject isCollection and: [
-		  anObject isNotEmpty and: [
-			  | parent |
-			  parent := anObject first parent.
-			  anObject allSatisfy: [ :each | each parent = parent ] ] ]
+{ #category : #'as yet unclassified' }
+PyramidGroupCommand >> commandInverse [
+	"Command used to undo the group."
+
+	^ PyramidUndoGroupCommand new 
 ]
 
 { #category : #'as yet unclassified' }
-PyramidGroupCommand >> cleanUpRoots: roots forGroup: groupElement [
+PyramidGroupCommand >> commandInverseArgumentsFor: aSelection and: aFirstLevelCollection [
+
+	historyCommandArguments := PyramidGroupCommandModel new.
+	historyCommandArguments originElement: aSelection first first parent.
+	historyCommandArguments firstLevelElements: aFirstLevelCollection.
+	historyCommandArguments originFirstLevelElements:
+		aFirstLevelCollection asArray.
+	historyCommandArguments originalChildrenElements:
+		historyCommandArguments originElement children copy.
+	historyCommandArguments selectionInCorrectOrder:
+		(self orderGroup: aSelection first).
+	^ self historyCommandArguments
+]
 
-	(roots includesAny: groupElement children) ifFalse: [ ^ self ].
-	roots removeAll: groupElement children.
-	roots add: groupElement.
+{ #category : #'as yet unclassified' }
+PyramidGroupCommand >> commandRestauration [
+	"Command used to redo the group."
+
+	^ PyramidRedoGroupCommand new
+
 ]
 
 { #category : #'as yet unclassified' }
-PyramidGroupCommand >> commandInverse [
+PyramidGroupCommand >> commandRestaurationArgumentsFor: aSelection and: aFirstLevelCollection [
 
-	^ PyramidGroupInverseCommand new
+	self historyCommandArguments groupElement: aSelection first first parent.
+	^ self historyCommandArguments
 ]
 
 { #category : #'as yet unclassified' }
-PyramidGroupCommand >> makeGroupElement [
+PyramidGroupCommand >> createNewGroupElement: aCollectionOfBlElement [
 
-	^ BlElement new id: #group; clipChildren: false; yourself
+	^ BlElement new
+		  id: #group;
+		  clipChildren: false;
+		  addChildren: aCollectionOfBlElement;
+		  yourself.
 ]
 
 { #category : #'as yet unclassified' }
-PyramidGroupCommand >> makeGroupElementFor: aCollection [
+PyramidGroupCommand >> getValueFor: aBlElement [
 
-	| 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 ].
+	^ self historyCommandArguments
+]
 
-	^ groupElement
+{ #category : #accessing }
+PyramidGroupCommand >> historyCommandArguments [
+
+	^ historyCommandArguments
+]
+
+{ #category : #'as yet unclassified' }
+PyramidGroupCommand >> orderGroup: aCollectionToGroup [
+
+	"The group order must be the same as their parent children order."
+	| parent |
+	parent := aCollectionToGroup first parent.
+	^ aCollectionToGroup sorted: [ :e1 :e2 | (parent childIndexOf: e1) < (parent childIndexOf: e2) ]
 ]
 
 { #category : #'as yet unclassified' }
@@ -69,45 +109,44 @@ PyramidGroupCommand >> positionGroupElement: groupElement [
 { #category : #'as yet unclassified' }
 PyramidGroupCommand >> saveStatesOf: aCollection with: arguments [
 
-	| mementos |
-	mementos := aCollection asArray collect: [ :each |
-		            PyramidCommandMemento new
-			            command: self;
-			            target: each;
-			            arguments: arguments;
-			            yourself ].
-	mementos size = 1 ifTrue: [ ^ mementos first ].
-	^ PyramidCompositeMemento new
-		  mementos: mementos;
-		  yourself
+	^ self
+		  saveStatesOf: {aCollection}
+		  withCommand: self commandRestauration
+		  withArguments:
+		  (self commandRestaurationArgumentsFor: aCollection and: arguments)
 ]
 
 { #category : #'as yet unclassified' }
 PyramidGroupCommand >> saveStatesWithCommandInverseOf: aCollection with: arguments [
 
-	| mementos |
-	mementos := aCollection asArray collect: [ :each |
-		            PyramidCommandMemento new
-			            command: self commandInverse;
-			            target: each;
-			            arguments: arguments;
-			            yourself ].
-	mementos size = 1 ifTrue: [ ^ mementos first ].
-	^ PyramidCompositeMemento new
-		  mementos: mementos;
-		  yourself
+	^ self
+		  saveStatesOf: {aCollection}
+		  withCommand: self commandInverse
+		  withArguments:
+		  (self commandInverseArgumentsFor: aCollection and: arguments)
 ]
 
 { #category : #'as yet unclassified' }
-PyramidGroupCommand >> setValueFor: aCollection with: roots [
-
-	| 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.
-
-	"remove any roots elements from the roots collection and add the group insteed."
-	self cleanUpRoots: roots forGroup: groupElement
+PyramidGroupCommand >> setValueFor: aCollectionToGroup with: aCollectionOfFirstLevelElements [
+
+	| groupInCorrectOrder parent groupElement removedElementFromFirstLevel |
+	"First get aCollection to group on the correct order."
+	groupInCorrectOrder := self orderGroup: aCollectionToGroup.
+
+	"Second remove element from parent and firstLevel"
+	parent := groupInCorrectOrder first parent.
+	parent removeChildren: groupInCorrectOrder.
+	removedElementFromFirstLevel := aCollectionOfFirstLevelElements
+		                                removeAll: groupInCorrectOrder.
+
+	"third create groupElement"
+	groupElement := self createNewGroupElement: groupInCorrectOrder.
+
+	"Last add groupElement to parent and to firstLevel if it come from it."
+	parent addChild: groupElement.
+	removedElementFromFirstLevel ifNotEmpty: [
+		aCollectionOfFirstLevelElements add: groupElement ].
+
+	"Set Correct position"
+	self positionGroupElement: groupElement
 ]

src/Pyramid-Bloc/PyramidGroupCommandModel.class.st

@@ -0,0 +1,85 @@
+Class {
+	#name : #PyramidGroupCommandModel,
+	#superclass : #Object,
+	#instVars : [
+		'originElement',
+		'groupElement',
+		'firstLevelElements',
+		'originalChildrenElements',
+		'originFirstLevelElements',
+		'selectionInCorrectOrder'
+	],
+	#category : #'Pyramid-Bloc-plugin-bloc-group'
+}
+
+{ #category : #accessing }
+PyramidGroupCommandModel >> firstLevelElements [
+
+	^ firstLevelElements
+]
+
+{ #category : #accessing }
+PyramidGroupCommandModel >> firstLevelElements: anObject [
+
+	firstLevelElements := anObject
+]
+
+{ #category : #accessing }
+PyramidGroupCommandModel >> groupElement [
+
+	^ groupElement
+]
+
+{ #category : #accessing }
+PyramidGroupCommandModel >> groupElement: anObject [
+
+	groupElement := anObject
+]
+
+{ #category : #accessing }
+PyramidGroupCommandModel >> originElement [
+
+	^ originElement
+]
+
+{ #category : #accessing }
+PyramidGroupCommandModel >> originElement: anObject [
+
+	originElement := anObject
+]
+
+{ #category : #accessing }
+PyramidGroupCommandModel >> originFirstLevelElements [
+
+	^ originFirstLevelElements
+]
+
+{ #category : #accessing }
+PyramidGroupCommandModel >> originFirstLevelElements: anObject [
+
+	originFirstLevelElements := anObject
+]
+
+{ #category : #accessing }
+PyramidGroupCommandModel >> originalChildrenElements [
+
+	^ originalChildrenElements
+]
+
+{ #category : #accessing }
+PyramidGroupCommandModel >> originalChildrenElements: anObject [
+
+	originalChildrenElements := anObject
+]
+
+{ #category : #accessing }
+PyramidGroupCommandModel >> selectionInCorrectOrder [
+
+	^ selectionInCorrectOrder
+]
+
+{ #category : #accessing }
+PyramidGroupCommandModel >> selectionInCorrectOrder: anObject [
+
+	selectionInCorrectOrder := anObject
+]