From 326a69675ef2b5dfcb0b32a10dc5c93f8e63cff7 Mon Sep 17 00:00:00 2001 From: Nyan11 Date: Mon, 18 Dec 2023 10:42:04 +0100 Subject: [PATCH 1/2] Fix order --- src/Pyramid-Bloc/PyramidGroupCommand.class.st | 20 ++++++- .../PyramidGroupCommandTest.class.st | 57 +++++++++++++++---- .../PyramidGroupInverseCommandTest.class.st | 23 +++++--- 3 files changed, 77 insertions(+), 23 deletions(-) diff --git a/src/Pyramid-Bloc/PyramidGroupCommand.class.st b/src/Pyramid-Bloc/PyramidGroupCommand.class.st index 5b141a89..40b45e28 100644 --- a/src/Pyramid-Bloc/PyramidGroupCommand.class.st +++ b/src/Pyramid-Bloc/PyramidGroupCommand.class.st @@ -37,17 +37,31 @@ PyramidGroupCommand >> makeGroupElement [ { #category : #'as yet unclassified' } PyramidGroupCommand >> makeGroupElementFor: aCollection [ - | parent groupElement | + | parent groupElement correctOrderCollection | "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 ]. + + "We must have the collection of element in the same order as in their parent and not in the selection order." + correctOrderCollection := self + orderCollection: aCollection + fromParent: parent. + + parent ifNotNil: [ parent removeChildren: correctOrderCollection ]. groupElement := self makeGroupElement. - groupElement addChildren: aCollection. + groupElement addChildren: correctOrderCollection. parent ifNotNil: [ parent addChild: groupElement ]. ^ groupElement ] +{ #category : #'as yet unclassified' } +PyramidGroupCommand >> orderCollection: aCollectionOfElement fromParent: aParentElement [ + + aParentElement ifNil: [ ^ aCollectionOfElement copy ]. + ^ aCollectionOfElement sorted: [ :e1 :e2 | (aParentElement childIndexOf: e1) < (aParentElement childIndexOf: e2)]. + +] + { #category : #'as yet unclassified' } PyramidGroupCommand >> positionGroupElement: groupElement [ diff --git a/src/Pyramid-Tests/PyramidGroupCommandTest.class.st b/src/Pyramid-Tests/PyramidGroupCommandTest.class.st index 75d0be13..0be2af46 100644 --- a/src/Pyramid-Tests/PyramidGroupCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidGroupCommandTest.class.st @@ -107,7 +107,7 @@ PyramidGroupCommandTest >> testHistory [ PyramidGroupCommandTest >> testSetValueForWith [ | e1 e2 e3 e4 selection roots parent | - "parent is nil. elements are not roots." + "parent is nil. elements are not roots. Order is not important because element are not display so it doesn't really make sense to test the order of the group command." e1 := BlElement new. e2 := BlElement new. e3 := BlElement new. @@ -124,10 +124,11 @@ PyramidGroupCommandTest >> testSetValueForWith [ self command setValueFor: selection with: roots. parent := selection first parent. self assert: parent isNotNil. + self assert: parent childrenCount equals: 4. selection do: [ :each | self assert: each parent equals: parent ]. - "parent is not nil. elements are not roots." + "parent is not nil. elements are not roots. Order in parent is not the same as in selection. The group should keep the parent order." e1 := BlElement new. e2 := BlElement new. e3 := BlElement new. @@ -137,7 +138,10 @@ PyramidGroupCommandTest >> testSetValueForWith [ e2. e3. e4 }. - e1 addChildren: selection. + e1 addChildren: { + e4. + e3. + e2 }. roots := OrderedCollection new. selection do: [ :each | self assert: each parent equals: e1 ]. @@ -145,9 +149,14 @@ PyramidGroupCommandTest >> testSetValueForWith [ parent := selection first parent. self deny: parent equals: e1. selection do: [ :each | self assert: each parent equals: parent ]. + "We test the order on new parent." + self assert: parent childrenCount equals: 3. + self assert: parent children first equals: e4. + self assert: parent children second equals: e3. + self assert: parent children last equals: e2. - "parent is nil. elements are roots." + "parent is nil. elements are roots. Order is not important because element are not display so it doesn't really make sense to test the order of the group command." e1 := BlElement new. e2 := BlElement new. e3 := BlElement new. @@ -166,12 +175,13 @@ PyramidGroupCommandTest >> testSetValueForWith [ self command setValueFor: selection with: roots. parent := selection first parent. self assert: parent isNotNil. + self assert: parent childrenCount equals: 4. selection do: [ :each | self assert: each parent equals: parent ]. self deny: (roots includesAny: selection). self assert: (roots includes: parent). - "parent is not nil. elements are roots." + "parent is not nil. elements are roots. Selection is not in correct order." e1 := BlElement new. e2 := BlElement new. e3 := BlElement new. @@ -181,24 +191,46 @@ PyramidGroupCommandTest >> testSetValueForWith [ e2. e3. e4 }. - e1 addChildren: selection. + "e1 contains the same element as selection but not in the same order. Group should put them in order according to e1 children order." + e1 addChildren: { + e4. + e3. + e2 }. + "roots is selection." roots := OrderedCollection new. roots addAll: selection. + "We check the setup for the test is ok." self assert: (roots includesAll: selection). selection do: [ :each | self assert: each parent equals: e1 ]. + "We execute the command." self command setValueFor: selection with: roots. + "We check parent is not e1 and all elements have the same new parent. and new parent is in root." parent := selection first parent. self deny: parent equals: e1. selection do: [ :each | self assert: each parent equals: parent ]. self deny: (roots includesAny: selection). self assert: (roots includes: parent). - + "We check if the new parent contains the 3 elements in the correct order." + self assert: parent childrenCount equals: 3. + self assert: parent children first equals: e4. + self assert: parent children second equals: e3. + self assert: parent children last equals: e2. + + "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. + 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. @@ -211,10 +243,11 @@ PyramidGroupCommandTest >> testSetValueForWith [ self command setValueFor: selection with: roots. parent := selection first parent. self assert: parent isNotNil. + self assert: parent childrenCount equals: 4. 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 ]. + selection do: [ :each | self assert: each parent equals: parent ] ] diff --git a/src/Pyramid-Tests/PyramidGroupInverseCommandTest.class.st b/src/Pyramid-Tests/PyramidGroupInverseCommandTest.class.st index d841363d..67472c09 100644 --- a/src/Pyramid-Tests/PyramidGroupInverseCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidGroupInverseCommandTest.class.st @@ -124,7 +124,6 @@ PyramidGroupInverseCommandTest >> testHistory [ PyramidGroupInverseCommandTest >> testSetValueForWith [ | e1 e2 e3 e4 selection roots parent | - "parent is not nil. elements are not roots." e1 := BlElement new. e2 := BlElement new. @@ -168,12 +167,20 @@ PyramidGroupInverseCommandTest >> testSetValueForWith [ selection do: [ :each | self assert: each parent equals: parent ]. self deny: (roots includes: e1). 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. + + "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 := { @@ -191,5 +198,5 @@ PyramidGroupInverseCommandTest >> testSetValueForWith [ self assert: e2 constraints position equals: 100 @ 100. self assert: e3 constraints position equals: 110 @ 110. - self assert: e4 constraints position equals: 140 @ 140. + self assert: e4 constraints position equals: 140 @ 140 ] From 5b7f858bf95d461ba1593a1c3811b7beaeca826a Mon Sep 17 00:00:00 2001 From: Nyan11 Date: Tue, 19 Dec 2023 10:41:38 +0100 Subject: [PATCH 2/2] Remake the group command --- .../PyramidAbstractGroupCommand.class.st | 33 -- src/Pyramid-Bloc/PyramidGroupCommand.class.st | 151 ++++--- .../PyramidGroupCommandModel.class.st | 85 ++++ .../PyramidGroupInverseCommand.class.st | 41 -- .../PyramidRedoGroupCommand.class.st | 51 +++ .../PyramidUndoGroupCommand.class.st | 45 ++ .../PyramidGroupCommandTest.class.st | 420 ++++++++++-------- .../PyramidGroupInverseCommandTest.class.st | 202 --------- 8 files changed, 495 insertions(+), 533 deletions(-) delete mode 100644 src/Pyramid-Bloc/PyramidAbstractGroupCommand.class.st create mode 100644 src/Pyramid-Bloc/PyramidGroupCommandModel.class.st delete mode 100644 src/Pyramid-Bloc/PyramidGroupInverseCommand.class.st create mode 100644 src/Pyramid-Bloc/PyramidRedoGroupCommand.class.st create mode 100644 src/Pyramid-Bloc/PyramidUndoGroupCommand.class.st delete mode 100644 src/Pyramid-Tests/PyramidGroupInverseCommandTest.class.st diff --git a/src/Pyramid-Bloc/PyramidAbstractGroupCommand.class.st b/src/Pyramid-Bloc/PyramidAbstractGroupCommand.class.st deleted file mode 100644 index c5d44f13..00000000 --- a/src/Pyramid-Bloc/PyramidAbstractGroupCommand.class.st +++ /dev/null @@ -1,33 +0,0 @@ -Class { - #name : #PyramidAbstractGroupCommand, - #superclass : #PyramidCommand, - #category : #'Pyramid-Bloc-plugin-bloc' -} - -{ #category : #testing } -PyramidAbstractGroupCommand class >> isAbstract [ - - ^ self == PyramidAbstractGroupCommand -] - -{ #category : #'as yet unclassified' } -PyramidAbstractGroupCommand >> getValueFor: aBlElement [ - - ^ nil -] - -{ #category : #'as yet unclassified' } -PyramidAbstractGroupCommand >> saveStatesOf: aCollection withCommand: aCommand withArguments: anArguments [ - - | mementos | - mementos := aCollection asArray collect: [ :each | - PyramidCommandMemento new - command: aCommand; - target: each; - arguments: anArguments; - yourself ]. - mementos size = 1 ifTrue: [ ^ mementos first ]. - ^ PyramidCompositeMemento new - mementos: mementos; - yourself -] diff --git a/src/Pyramid-Bloc/PyramidGroupCommand.class.st b/src/Pyramid-Bloc/PyramidGroupCommand.class.st index 40b45e28..bfb54ab2 100644 --- a/src/Pyramid-Bloc/PyramidGroupCommand.class.st +++ b/src/Pyramid-Bloc/PyramidGroupCommand.class.st @@ -1,65 +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 [ - ^ anObject isCollection and: [ - anObject isNotEmpty and: [ - | parent | - parent := anObject first parent. - anObject allSatisfy: [ :each | each parent = parent ] ] ] + | parent | + aCollectionOfBlElements isCollection ifFalse: [ ^ false ]. + aCollectionOfBlElements ifEmpty: [ ^ false ]. + + parent := aCollectionOfBlElements first parent. + parent ifNil: [ ^ false ]. + ^ aCollectionOfBlElements allSatisfy: [ :each | + each parent = parent ] ] { #category : #'as yet unclassified' } -PyramidGroupCommand >> cleanUpRoots: roots forGroup: groupElement [ +PyramidGroupCommand >> commandInverse [ + "Command used to undo the group." - (roots includesAny: groupElement children) ifFalse: [ ^ self ]. - roots removeAll: groupElement children. - roots add: groupElement. + ^ PyramidUndoGroupCommand new ] { #category : #'as yet unclassified' } -PyramidGroupCommand >> commandInverse [ +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 +] - ^ PyramidGroupInverseCommand new +{ #category : #'as yet unclassified' } +PyramidGroupCommand >> commandRestauration [ + "Command used to redo the group." + + ^ PyramidRedoGroupCommand new + ] { #category : #'as yet unclassified' } -PyramidGroupCommand >> makeGroupElement [ +PyramidGroupCommand >> commandRestaurationArgumentsFor: aSelection and: aFirstLevelCollection [ - ^ BlElement new id: #group; clipChildren: false; yourself + self historyCommandArguments groupElement: aSelection first first parent. + ^ self historyCommandArguments ] { #category : #'as yet unclassified' } -PyramidGroupCommand >> makeGroupElementFor: aCollection [ +PyramidGroupCommand >> createNewGroupElement: aCollectionOfBlElement [ - | parent groupElement correctOrderCollection | - "Remove any element from their parent. Add them to a ""group"" element. Then add the ""group"" to the parent." - parent := aCollection first parent. + ^ BlElement new + id: #group; + clipChildren: false; + addChildren: aCollectionOfBlElement; + yourself. +] + +{ #category : #'as yet unclassified' } +PyramidGroupCommand >> getValueFor: aBlElement [ - "We must have the collection of element in the same order as in their parent and not in the selection order." - correctOrderCollection := self - orderCollection: aCollection - fromParent: parent. + ^ self historyCommandArguments +] - parent ifNotNil: [ parent removeChildren: correctOrderCollection ]. - groupElement := self makeGroupElement. - groupElement addChildren: correctOrderCollection. - parent ifNotNil: [ parent addChild: groupElement ]. +{ #category : #accessing } +PyramidGroupCommand >> historyCommandArguments [ - ^ groupElement + ^ historyCommandArguments ] { #category : #'as yet unclassified' } -PyramidGroupCommand >> orderCollection: aCollectionOfElement fromParent: aParentElement [ +PyramidGroupCommand >> orderGroup: aCollectionToGroup [ - aParentElement ifNil: [ ^ aCollectionOfElement copy ]. - ^ aCollectionOfElement sorted: [ :e1 :e2 | (aParentElement childIndexOf: e1) < (aParentElement childIndexOf: e2)]. - + "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' } @@ -83,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 [ +PyramidGroupCommand >> setValueFor: aCollectionToGroup with: aCollectionOfFirstLevelElements [ + + | groupInCorrectOrder parent groupElement removedElementFromFirstLevel | + "First get aCollection to group on the correct order." + groupInCorrectOrder := self orderGroup: aCollectionToGroup. - | groupElement | - "Remove any element from their parent. Add them to a ""group"" element. Then add the ""group"" to the parent." - groupElement := self makeGroupElementFor: aCollection. + "Second remove element from parent and firstLevel" + parent := groupInCorrectOrder first parent. + parent removeChildren: groupInCorrectOrder. + removedElementFromFirstLevel := aCollectionOfFirstLevelElements + removeAll: groupInCorrectOrder. - "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. + "third create groupElement" + groupElement := self createNewGroupElement: groupInCorrectOrder. - "remove any roots elements from the roots collection and add the group insteed." - self cleanUpRoots: roots forGroup: groupElement + "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 ] diff --git a/src/Pyramid-Bloc/PyramidGroupCommandModel.class.st b/src/Pyramid-Bloc/PyramidGroupCommandModel.class.st new file mode 100644 index 00000000..000adc7e --- /dev/null +++ b/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 +] diff --git a/src/Pyramid-Bloc/PyramidGroupInverseCommand.class.st b/src/Pyramid-Bloc/PyramidGroupInverseCommand.class.st deleted file mode 100644 index 3917bf2f..00000000 --- a/src/Pyramid-Bloc/PyramidGroupInverseCommand.class.st +++ /dev/null @@ -1,41 +0,0 @@ -Class { - #name : #PyramidGroupInverseCommand, - #superclass : #PyramidAbstractGroupCommand, - #category : #'Pyramid-Bloc-plugin-bloc' -} - -{ #category : #testing } -PyramidGroupInverseCommand >> canBeUsedFor: anObject [ - - ^ anObject isCollection and: [ - anObject isNotEmpty and: [ - | parent | - parent := anObject first parent. - parent isNotNil and: [ - anObject allSatisfy: [ :each | each parent = parent ] ] ] ] -] - -{ #category : #'as yet unclassified' } -PyramidGroupInverseCommand >> commandInverse [ - - ^ PyramidGroupCommand new -] - -{ #category : #'as yet unclassified' } -PyramidGroupInverseCommand >> setValueFor: aCollection with: roots [ - - | elements groupElement | - groupElement := aCollection first parent. - 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. - groupElement parent removeChild: groupElement ]. - - (roots includes: groupElement) ifFalse: [ ^ self ]. - roots remove: groupElement. - roots addAll: elements -] diff --git a/src/Pyramid-Bloc/PyramidRedoGroupCommand.class.st b/src/Pyramid-Bloc/PyramidRedoGroupCommand.class.st new file mode 100644 index 00000000..05c74d6e --- /dev/null +++ b/src/Pyramid-Bloc/PyramidRedoGroupCommand.class.st @@ -0,0 +1,51 @@ +Class { + #name : #PyramidRedoGroupCommand, + #superclass : #PyramidCommand, + #category : #'Pyramid-Bloc-plugin-bloc-group' +} + +{ #category : #'as yet unclassified' } +PyramidRedoGroupCommand >> commandInverse [ + + ^ PyramidUndoGroupCommand new +] + +{ #category : #'as yet unclassified' } +PyramidRedoGroupCommand >> getValueFor: aBlElement [ + + ^ nil +] + +{ #category : #'as yet unclassified' } +PyramidRedoGroupCommand >> 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' } +PyramidRedoGroupCommand >> setValueFor: aCollectionToGroup with: aGroupModel [ + + | anyElementInFirstLevels | + aGroupModel originElement removeChildren: + aGroupModel selectionInCorrectOrder. + aGroupModel groupElement addChildren: + aGroupModel selectionInCorrectOrder. + aGroupModel originElement addChild: aGroupModel groupElement. + anyElementInFirstLevels := aGroupModel firstLevelElements removeAll: + aGroupModel selectionInCorrectOrder. + anyElementInFirstLevels ifNotEmpty: [ + aGroupModel firstLevelElements add: aGroupModel groupElement ]. + self positionGroupElement: aGroupModel groupElement. +] diff --git a/src/Pyramid-Bloc/PyramidUndoGroupCommand.class.st b/src/Pyramid-Bloc/PyramidUndoGroupCommand.class.st new file mode 100644 index 00000000..8fb36fa9 --- /dev/null +++ b/src/Pyramid-Bloc/PyramidUndoGroupCommand.class.st @@ -0,0 +1,45 @@ +Class { + #name : #PyramidUndoGroupCommand, + #superclass : #PyramidCommand, + #category : #'Pyramid-Bloc-plugin-bloc-group' +} + +{ #category : #'as yet unclassified' } +PyramidUndoGroupCommand >> commandInverse [ + + ^ PyramidRedoGroupCommand new +] + +{ #category : #'as yet unclassified' } +PyramidUndoGroupCommand >> getValueFor: aBlElement [ + + ^ nil +] + +{ #category : #'as yet unclassified' } +PyramidUndoGroupCommand >> positionChildrenOfGroupElement: groupElement [ + + | currentTop currentLeft | + currentTop := groupElement constraints position y. + currentLeft := groupElement constraints position x. + groupElement childrenDo: [ :child | + child position: + child constraints position + (currentLeft @ currentTop) ] +] + +{ #category : #'as yet unclassified' } +PyramidUndoGroupCommand >> setValueFor: aCollectionToGroup with: aGroupModel [ + "Remove children of group. + Remove children of origin. + Origin add original children. + firstLevelElements add original firstLevelElements." + + self positionChildrenOfGroupElement: aGroupModel groupElement. + aGroupModel groupElement removeChildren. + aGroupModel originElement removeChildren. + aGroupModel originElement addChildren: + aGroupModel originalChildrenElements. + aGroupModel firstLevelElements removeAll. + aGroupModel firstLevelElements addAll: + aGroupModel originFirstLevelElements +] diff --git a/src/Pyramid-Tests/PyramidGroupCommandTest.class.st b/src/Pyramid-Tests/PyramidGroupCommandTest.class.st index 0be2af46..8ba4c0db 100644 --- a/src/Pyramid-Tests/PyramidGroupCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidGroupCommandTest.class.st @@ -3,9 +3,89 @@ Class { #superclass : #TestCase, #traits : 'TPyramidCommandTest', #classTraits : 'TPyramidCommandTest classTrait', - #category : #'Pyramid-Tests-cases-plugin-bloc' + #category : #'Pyramid-Tests-cases-plugin-bloc-group' } +{ #category : #tests } +PyramidGroupCommandTest >> assertBeforeSetValuefor: selection parent: originalParent firstLevel: firstLevelElements elements: aCollection [ + "children have the same parent (originalParent)." + + self assert: + (selection allSatisfy: [ :e | e parent = originalParent ]). + + "children order is correct" + self + assert: originalParent children first + equals: (aCollection at: 1). + self + assert: originalParent children second + equals: (aCollection at: 2). + self + assert: originalParent children third + equals: (aCollection at: 3). + + "firstLevelElements does have all selection" + self assert: (selection allSatisfy: [ :target | + firstLevelElements includes: target ]). + self assert: firstLevelElements size equals: 4. + + "original parent does have selection as children." + self assert: (selection allSatisfy: [ :target | + originalParent children includes: target ]). + + "children position" + self + assert: (aCollection at: 1) constraints position + equals: 10 asPoint. + self + assert: (aCollection at: 2) constraints position + equals: 20 asPoint. + self + assert: (aCollection at: 3) constraints position + equals: 30 asPoint +] + +{ #category : #tests } +PyramidGroupCommandTest >> assertSetValuefor: selection parent: originalParent firstLevel: firstLevelElements elements: aCollection [ + + | group | + "children have the same parent (group) element." + group := selection first parent. + self assert: (selection allSatisfy: [ :e | e parent = group ]). + + "children order is correct" + self assert: group children first equals: (aCollection at: 1). + self assert: group children second equals: (aCollection at: 2). + self assert: group children third equals: (aCollection at: 3). + + "original parent has group as child" + self assert: (originalParent hasChild: group). + + "firstLevelElements do not have selection" + self deny: (firstLevelElements anySatisfy: [ :target | + selection includes: target ]). + + "firstLevelElements includes groupElement" + self assert: (firstLevelElements includes: group). + self assert: firstLevelElements size equals: 2. + + "original parent does not have selection as children." + self deny: (originalParent children anySatisfy: [ :target | + selection includes: target ]). + + "group and children position" + self assert: group constraints position equals: 10 asPoint. + self + assert: (aCollection at: 1) constraints position + equals: 0 asPoint. + self + assert: (aCollection at: 2) constraints position + equals: 10 asPoint. + self + assert: (aCollection at: 3) constraints position + equals: 20 asPoint +] + { #category : #accessing } PyramidGroupCommandTest >> command [ @@ -13,36 +93,67 @@ PyramidGroupCommandTest >> command [ ] { #category : #'as yet unclassified' } -PyramidGroupCommandTest >> targetsCanBeUsedFor [ - - | parent elements | - parent := BlElement new. - elements := { BlElement new. BlElement new . BlElement new }. - parent addChildren: elements. - - ^ { { BlElement new. BlElement new . BlElement new. BlElement new } . elements } +PyramidGroupCommandTest >> makeParentTestCase [ + + | parent e1 e2 e3 e4 | + parent := BlElement new + id: #parent; + yourself. + e1 := BlElement new + id: #e1; + position: 10 asPoint; + yourself. + e2 := BlElement new + id: #e2; + position: 20 asPoint; + yourself. + e3 := BlElement new + id: #e3; + position: 30 asPoint; + yourself. + e4 := BlElement new + id: #e4; + position: 40 asPoint; + yourself. + parent addChildren: { + e1. + e2. + e3. + e4 }. + ^ parent ] -{ #category : #'as yet unclassified' } -PyramidGroupCommandTest >> targetsCannotBeUsedFor [ - | parent elements | - parent := BlElement new. - elements := { - BlElement new. - BlElement new. - BlElement new }. - parent addChildren: elements. - - ^ { - { }. - (elements asOrderedCollection add: BlElement new; yourself) } +{ #category : #tests } +PyramidGroupCommandTest >> testCanBeUsedFor [ + + | originalParent selection e1 e2 e3 | + originalParent := self makeParentTestCase. + e1 := originalParent children first. + e2 := originalParent children second. + e3 := originalParent children third. + selection := { + e3. + e2. + e1 }. + self assert: (self command canBeUsedFor: selection). + self targetsCannotBeUsedFor do: [ :each | + self deny: (self command canBeUsedFor: each) ] ] { #category : #tests } PyramidGroupCommandTest >> testGetValueFor [ - self targetsCanBeUsedFor do: [ :each | - self assert: (self command getValueFor: each) equals: nil ] + | originalParent selection e1 e2 e3 | + originalParent := self makeParentTestCase. + e1 := originalParent children first. + e2 := originalParent children second. + e3 := originalParent children third. + selection := { + e3. + e2. + e1 }. + + self assert: (self command getValueFor: selection) equals: nil ] { #category : #tests } @@ -53,201 +164,122 @@ PyramidGroupCommandTest >> testHistory [ undo redo" - | history commandExecutor e1 e2 e3 e4 selection roots | + | history commandExecutor originalParent selection firstLevelElements e1 e2 e3 | + originalParent := self makeParentTestCase. + e1 := originalParent children first. + e2 := originalParent children second. + e3 := originalParent children third. + selection := { + e3. + e2. + e1 }. + firstLevelElements := { + e1. + e2. + e3. + BlElement new } asOrderedCollection. + history := PyramidHistory new. commandExecutor := PyramidHistoryCommandExecutor new history: history; wrappee: PyramidMainCommandExecutor new; yourself. - "parent is not nil. elements are roots." - e1 := BlElement new id: #parent. - e2 := BlElement new id: #e2. - e3 := BlElement new id: #e3. - e4 := BlElement new id: #e4. - - selection := { - e2. - e3. - e4 }. - e1 addChildren: selection. - roots := OrderedCollection new. - roots addAll: selection. - - self assert: (roots includesAll: selection). - self assert: (selection allSatisfy: [ :each | each parent = e1 ]). - "Do once" - commandExecutor use: self command on: { selection } with: roots. - self deny: (roots includesAny: selection). - self deny: (selection anySatisfy: [ :each | each parent = e1 ]). + commandExecutor + use: self command + on: { selection } + with: firstLevelElements. + self + assertSetValuefor: selection + parent: originalParent + firstLevel: firstLevelElements + elements: { + e1. + e2. + e3 }. "Undo all" history undo. - self assert: (roots includesAll: selection). - self assert: (selection allSatisfy: [ :each | each parent = e1 ]). + self + assertBeforeSetValuefor: selection + parent: originalParent + firstLevel: firstLevelElements + elements: { + e1. + e2. + e3 }. "Redo all" history redo. - self deny: (roots includesAny: selection). - self deny: (selection anySatisfy: [ :each | each parent = e1 ]). + self + assertSetValuefor: selection + parent: originalParent + firstLevel: firstLevelElements + elements: { + e1. + e2. + e3 }. "Undo all" history undo. - self assert: (roots includesAll: selection). - self assert: (selection allSatisfy: [ :each | each parent = e1 ]). + self + assertBeforeSetValuefor: selection + parent: originalParent + firstLevel: firstLevelElements + elements: { + e1. + e2. + e3 }. "Redo all" history redo. - self deny: (roots includesAny: selection). - self deny: (selection anySatisfy: [ :each | each parent = e1 ]) + self + assertSetValuefor: selection + parent: originalParent + firstLevel: firstLevelElements + elements: { + e1. + e2. + e3 } ] { #category : #tests } PyramidGroupCommandTest >> testSetValueForWith [ - | e1 e2 e3 e4 selection roots parent | - "parent is nil. elements are not roots. Order is not important because element are not display so it doesn't really make sense to test the order of the group command." - e1 := BlElement new. - e2 := BlElement new. - e3 := BlElement new. - e4 := BlElement new. - + | originalParent selection firstLevelElements e1 e2 e3 | + originalParent := self makeParentTestCase. + e1 := originalParent children first. + e2 := originalParent children second. + e3 := originalParent children third. 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 childrenCount equals: 4. - selection do: [ :each | self assert: each parent equals: parent ]. - - - "parent is not nil. elements are not roots. Order in parent is not the same as in selection. The group should keep the parent order." - e1 := BlElement new. - e2 := BlElement new. - e3 := BlElement new. - e4 := BlElement new. - - selection := { - e2. - e3. - e4 }. - e1 addChildren: { - e4. - e3. - e2 }. - 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 ]. - "We test the order on new parent." - self assert: parent childrenCount equals: 3. - self assert: parent children first equals: e4. - self assert: parent children second equals: e3. - self assert: parent children last equals: e2. - - - "parent is nil. elements are roots. Order is not important because element are not display so it doesn't really make sense to test the order of the group command." - e1 := BlElement new. - e2 := BlElement new. - e3 := BlElement new. - e4 := BlElement new. - - selection := { - e1. e2. - e3. - e4 }. - roots := OrderedCollection new. - roots addAll: selection. - - self assert: (roots includesAll: selection). - 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 childrenCount equals: 4. - selection do: [ :each | self assert: each parent equals: parent ]. - self deny: (roots includesAny: selection). - self assert: (roots includes: parent). - - - "parent is not nil. elements are roots. Selection is not in correct order." - e1 := BlElement new. - e2 := BlElement new. - e3 := BlElement new. - e4 := BlElement new. - - selection := { - e2. - e3. - e4 }. - "e1 contains the same element as selection but not in the same order. Group should put them in order according to e1 children order." - e1 addChildren: { - e4. - e3. - e2 }. - "roots is selection." - roots := OrderedCollection new. - roots addAll: selection. - - "We check the setup for the test is ok." - self assert: (roots includesAll: selection). - selection do: [ :each | self assert: each parent equals: e1 ]. - "We execute the command." - self command setValueFor: selection with: roots. - "We check parent is not e1 and all elements have the same new parent. and new parent is in root." - parent := selection first parent. - self deny: parent equals: e1. - selection do: [ :each | self assert: each parent equals: parent ]. - self deny: (roots includesAny: selection). - self assert: (roots includes: parent). - "We check if the new parent contains the 3 elements in the correct order." - self assert: parent childrenCount equals: 3. - self assert: parent children first equals: e4. - self assert: parent children second equals: e3. - self assert: parent children last equals: e2. - - - "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 childrenCount equals: 4. - 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 ] + e1 }. + firstLevelElements := { + e1. + e2. + e3. + BlElement new } asOrderedCollection. + + self + assertBeforeSetValuefor: selection + parent: originalParent + firstLevel: firstLevelElements + elements: { + e1. + e2. + e3 }. + + "Command execution." + self command setValueFor: selection with: firstLevelElements. + + self + assertSetValuefor: selection + parent: originalParent + firstLevel: firstLevelElements + elements: { + e1. + e2. + e3 } ] diff --git a/src/Pyramid-Tests/PyramidGroupInverseCommandTest.class.st b/src/Pyramid-Tests/PyramidGroupInverseCommandTest.class.st deleted file mode 100644 index 67472c09..00000000 --- a/src/Pyramid-Tests/PyramidGroupInverseCommandTest.class.st +++ /dev/null @@ -1,202 +0,0 @@ -Class { - #name : #PyramidGroupInverseCommandTest, - #superclass : #TestCase, - #traits : 'TPyramidCommandTest', - #classTraits : 'TPyramidCommandTest classTrait', - #category : #'Pyramid-Tests-cases-plugin-bloc' -} - -{ #category : #accessing } -PyramidGroupInverseCommandTest >> command [ - - ^ PyramidGroupInverseCommand new -] - -{ #category : #'as yet unclassified' } -PyramidGroupInverseCommandTest >> targetsCanBeUsedFor [ - - | parent elements | - parent := BlElement new. - elements := { - BlElement new. - BlElement new. - BlElement new }. - parent addChildren: elements. - - ^ { - elements } -] - -{ #category : #'as yet unclassified' } -PyramidGroupInverseCommandTest >> targetsCannotBeUsedFor [ - - | parent elements | - parent := BlElement new. - elements := { - BlElement new. - BlElement new. - BlElement new }. - parent addChildren: elements. - - ^ { - { }. - { - BlElement new. - BlElement new. - BlElement new. - BlElement new }. - (elements asOrderedCollection - add: BlElement new; - yourself) } -] - -{ #category : #tests } -PyramidGroupInverseCommandTest >> testGetValueFor [ - - self targetsCanBeUsedFor do: [ :each | - self assert: (self command getValueFor: each) equals: nil ] -] - -{ #category : #tests } -PyramidGroupInverseCommandTest >> testHistory [ - "Do once. - undo - redo - undo - redo" - - | history commandExecutor e1 e2 e3 e4 selection roots parent | - history := PyramidHistory new. - commandExecutor := PyramidHistoryCommandExecutor new - history: history; - wrappee: PyramidMainCommandExecutor new; - yourself. - - "parent is not nil. elements are roots." - e1 := BlElement new id: #parent. - e2 := BlElement new id: #e2. - e3 := BlElement new id: #e3. - e4 := BlElement new id: #e4. - - selection := { - e2. - e3. - e4 }. - e1 addChildren: selection. - roots := OrderedCollection new. - roots add: e1. - - self assert: (roots includes: selection first parent). - self deny: (roots includesAny: selection). - self assert: (selection allSatisfy: [ :each | each parent = e1 ]). - - "Do once" - commandExecutor use: self command on: { selection } with: roots. - self assert: (roots includesAll: selection). - self deny: (selection anySatisfy: [ :each | each parent = e1 ]). - - "Undo all" - history undo. - parent := selection first parent. - self assert: (roots includes: selection first parent). - self deny: (roots includesAny: selection). - self assert: (selection allSatisfy: [ :each | each parent = parent ]). - - "Redo all" - history redo. - self assert: (roots includesAll: selection). - self deny: (selection anySatisfy: [ :each | each parent = e1 ]). - - "Undo all" - history undo. - parent := selection first parent. - self assert: (roots includes: selection first parent). - self deny: (roots includesAny: selection). - self assert: (selection allSatisfy: [ :each | each parent = parent ]). - - "Redo all" - history redo. - self assert: (roots includesAll: selection). - self deny: (selection anySatisfy: [ :each | each parent = e1 ]). -] - -{ #category : #tests } -PyramidGroupInverseCommandTest >> testSetValueForWith [ - - | e1 e2 e3 e4 selection roots parent | - "parent is not nil. elements are not roots." - e1 := BlElement new. - e2 := BlElement new. - e3 := BlElement new. - e4 := BlElement new. - - 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 ]. - - - "parent is not nil. elements are roots." - e1 := BlElement new. - e2 := BlElement new. - e3 := BlElement new. - e4 := BlElement new. - - selection := { - e2. - e3. - e4 }. - e1 addChildren: selection. - roots := OrderedCollection new. - roots add: e1. - - self assert: (roots includes: e1). - self deny: (roots includesAny: selection). - 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 deny: (roots includes: e1). - 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 -]