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 5b141a89..bfb54ab2 100644 --- a/src/Pyramid-Bloc/PyramidGroupCommand.class.st +++ b/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 ] 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 75d0be13..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,168 +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." - e1 := BlElement new. - e2 := BlElement new. - e3 := BlElement new. - e4 := BlElement new. - - 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. - selection do: [ :each | self assert: each parent equals: 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 nil. elements are roots." - 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. - 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." - 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 := { - e2. e3. - e4 }. - e1 addChildren: selection. - roots := OrderedCollection new. - roots addAll: selection. - - self assert: (roots includesAll: 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 includesAny: selection). - 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 ]. + 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 d841363d..00000000 --- a/src/Pyramid-Tests/PyramidGroupInverseCommandTest.class.st +++ /dev/null @@ -1,195 +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. -]