Issues 0035

src/Pyramid-Bloc/PyramidPositionOffsetCommand.class.st

@@ -4,26 +4,22 @@ Class {
 	#category : #'Pyramid-Bloc-plugin-bloc'
 }
 
+{ #category : #'as yet unclassified' }
+PyramidPositionOffsetCommand >> commandInverse [
+
+	^ PyramidPositionCommand new
+]
+
 { #category : #'as yet unclassified' }
 PyramidPositionOffsetCommand >> getValueFor: aBlElement [
 
 	^ aBlElement constraints position
 ]
 
 { #category : #'as yet unclassified' }
-PyramidPositionOffsetCommand >> saveStatesOf: aCollection withCommand: aCommand withArguments: anArguments [
-
-	| mementos |
-	mementos := aCollection collect: [ :each |
-		            PyramidCommandMemento new
-			            command: PyramidPositionCommand new;
-			            target: each;
-			            arguments: (self getValueFor: each);
-			            yourself ].
-	mementos size = 1 ifTrue: [ ^ mementos first ].
-	^ PyramidCompositeMemento new
-		  mementos: mementos;
-		  yourself
+PyramidPositionOffsetCommand >> saveStatesOf: aCollection with: arguments [
+
+	^ self saveStatesWithCommandInverseOf: aCollection with: arguments
 ]
 
 { #category : #'as yet unclassified' }

src/Pyramid-Tests/PyramidBackgroundCommandTest.class.st

@@ -0,0 +1,51 @@
+Class {
+	#name : #PyramidBackgroundCommandTest,
+	#superclass : #TestCase,
+	#traits : 'TPyramidCommandTest',
+	#classTraits : 'TPyramidCommandTest classTrait',
+	#category : #'Pyramid-Tests-cases-plugin-bloc'
+}
+
+{ #category : #accessing }
+PyramidBackgroundCommandTest >> command [
+
+	^ PyramidBackgroundCommand new
+]
+
+{ #category : #'as yet unclassified' }
+PyramidBackgroundCommandTest >> targetContainers [
+
+	^ {
+		  (PyramidCommandTestContainer
+			   no: BlElement new
+			   with: (BlElement new
+					    background: BlTransparentBackground new;
+					    yourself)
+			   prop: BlTransparentBackground new).
+			(PyramidCommandTestContainer
+			   no: BlElement new
+			   with: (BlElement new
+					    background: BlTransparentBackground new;
+					    yourself)
+			   prop: BlTransparentBackground new).
+		  (PyramidCommandTestContainer
+			   no: BlElement new
+			   with: (BlElement new
+					    background:(BlImageBackground image: (self iconNamed: #add));
+					    yourself)
+			   prop: (BlImageBackground image: (self iconNamed: #add))).
+		  (PyramidCommandTestContainer
+			   no: BlElement new
+			   with: (BlElement new
+					    background: (BlPaintBackground new paint:
+								     (BlLinearGradientPaint vertical stops: {
+											      (0.2 -> Color yellow).
+											      (0.5 -> Color black).
+											      (1 -> Color orange) }));
+					    yourself)
+			   prop: (BlPaintBackground new paint:
+					    (BlLinearGradientPaint vertical stops: {
+							     (0.2 -> Color yellow).
+							     (0.5 -> Color black).
+							     (1 -> Color orange) }))) }
+]

src/Pyramid-Tests/PyramidClipChildrenCommandTest.class.st

@@ -0,0 +1,43 @@
+Class {
+	#name : #PyramidClipChildrenCommandTest,
+	#superclass : #TestCase,
+	#traits : 'TPyramidCommandTest',
+	#classTraits : 'TPyramidCommandTest classTrait',
+	#category : #'Pyramid-Tests-cases-plugin-bloc'
+}
+
+{ #category : #accessing }
+PyramidClipChildrenCommandTest >> command [
+
+	^ PyramidClipChildrenCommand new
+]
+
+{ #category : #'as yet unclassified' }
+PyramidClipChildrenCommandTest >> targetContainers [
+
+	^ {
+		  (PyramidCommandTestContainer
+			   no: BlElement new
+			   with: (BlElement new
+					    clipChildren: true;
+					    yourself)
+			   prop: true).
+			(PyramidCommandTestContainer
+			   no: (BlElement new clipChildren: true; yourself)
+			   with: (BlElement new
+					    clipChildren: true;
+					    yourself)
+			   prop: true).
+			(PyramidCommandTestContainer
+			   no:  (BlElement new clipChildren: true; yourself)
+			   with: (BlElement new
+					    clipChildren: false;
+					    yourself)
+			   prop: false).
+		  (PyramidCommandTestContainer
+			   no: BlElement new
+			   with: (BlElement new
+					    clipChildren: false;
+					    yourself)
+			   prop: false). }
+]

src/Pyramid-Tests/PyramidCommandTestContainer.class.st

@@ -0,0 +1,52 @@
+Class {
+	#name : #PyramidCommandTestContainer,
+	#superclass : #Object,
+	#instVars : [
+		'targetNoProp',
+		'targetWithProp',
+		'prop'
+	],
+	#category : #'Pyramid-Tests-cases-plugin-bloc'
+}
+
+{ #category : #'as yet unclassified' }
+PyramidCommandTestContainer class >> no: aTargetNoProp with: aTargetWithProp prop: aProp [
+
+^ self new targetNoProp: aTargetNoProp; targetWithProp: aTargetWithProp; prop: aProp; yourself
+]
+
+{ #category : #accessing }
+PyramidCommandTestContainer >> prop [
+
+	^ prop
+]
+
+{ #category : #accessing }
+PyramidCommandTestContainer >> prop: anObject [
+
+	prop := anObject
+]
+
+{ #category : #accessing }
+PyramidCommandTestContainer >> targetNoProp [
+
+	^ targetNoProp
+]
+
+{ #category : #accessing }
+PyramidCommandTestContainer >> targetNoProp: anObject [
+
+	targetNoProp := anObject
+]
+
+{ #category : #accessing }
+PyramidCommandTestContainer >> targetWithProp [
+
+	^ targetWithProp
+]
+
+{ #category : #accessing }
+PyramidCommandTestContainer >> targetWithProp: anObject [
+
+	targetWithProp := anObject
+]

src/Pyramid-Tests/PyramidElementIdCommandTest.class.st

@@ -0,0 +1,34 @@
+Class {
+	#name : #PyramidElementIdCommandTest,
+	#superclass : #TestCase,
+	#traits : 'TPyramidCommandTest',
+	#classTraits : 'TPyramidCommandTest classTrait',
+	#category : #'Pyramid-Tests-cases-plugin-bloc'
+}
+
+{ #category : #accessing }
+PyramidElementIdCommandTest >> command [
+
+		^ PyramidElementIdCommand new
+]
+
+{ #category : #'as yet unclassified' }
+PyramidElementIdCommandTest >> targetContainers [
+
+
+	^ {
+		  (PyramidCommandTestContainer
+			   no: BlElement new
+			   with: (BlElement new
+					    id: #test;
+					    yourself)
+			   prop: 'test').
+		  (PyramidCommandTestContainer
+			   no: (BlElement new
+					    id: #old;
+					    yourself)
+			   with: (BlElement new
+					    id: #new;
+					    yourself)
+			   prop: 'new') }
+]

src/Pyramid-Tests/PyramidPositionCommandTest.class.st

@@ -0,0 +1,31 @@
+Class {
+	#name : #PyramidPositionCommandTest,
+	#superclass : #TestCase,
+	#traits : 'TPyramidCommandTest',
+	#classTraits : 'TPyramidCommandTest classTrait',
+	#category : #'Pyramid-Tests-cases-plugin-bloc'
+}
+
+{ #category : #accessing }
+PyramidPositionCommandTest >> command [
+
+	^ PyramidPositionCommand new
+]
+
+{ #category : #'as yet unclassified' }
+PyramidPositionCommandTest >> targetContainers [
+
+	^ {
+		  (PyramidCommandTestContainer
+			   no: BlElement new
+			   with: (BlElement new
+					    position: 50 @ 50;
+					    yourself)
+			   prop: 50 @ 50).
+			 (PyramidCommandTestContainer 
+			   no: (BlElement new position: 50 @ 50; yourself)
+			   with: (BlElement new
+					    position: 400 @ 0;
+					    yourself)
+			   prop: 400 @ 0). }
+]

src/Pyramid-Tests/PyramidPositionOffsetCommandTest.class.st

@@ -0,0 +1,104 @@
+Class {
+	#name : #PyramidPositionOffsetCommandTest,
+	#superclass : #TestCase,
+	#traits : 'TPyramidCommandTest',
+	#classTraits : 'TPyramidCommandTest classTrait',
+	#category : #'Pyramid-Tests-cases-plugin-bloc'
+}
+
+{ #category : #accessing }
+PyramidPositionOffsetCommandTest >> command [
+
+	^ PyramidPositionOffsetCommand new
+]
+
+{ #category : #'as yet unclassified' }
+PyramidPositionOffsetCommandTest >> targetContainers [
+
+	^ {
+		  (PyramidCommandTestContainer
+			   no: BlElement new
+			   with: (BlElement new
+					    position: 50 @ 50;
+					    yourself)
+			   prop: 50 @ 50).
+		  (PyramidCommandTestContainer
+			   no: (BlElement new
+					    position: 50 @ 50;
+					    yourself)
+			   with: (BlElement new
+					    position: 100 @ 100;
+					    yourself)
+			   prop: 50 @ 50) }
+]
+
+{ #category : #accessing }
+PyramidPositionOffsetCommandTest >> targetsWithValuesAndValues [
+
+	^ self targetContainers collect: [ :each |
+		  each targetWithProp -> each targetWithProp constraints position ]
+]
+
+{ #category : #tests }
+PyramidPositionOffsetCommandTest >> testHistory [
+	"Do once.
+	undo
+	redo
+	undo
+	redo"
+
+	| history commandExecutor targets initialValue |
+	targets := {
+		           BlElement new.
+		           BlElement new.
+		           BlElement new }.
+	initialValue := 0 @ 0.
+	history := PyramidHistory new.
+	commandExecutor := PyramidHistoryCommandExecutor new
+		                   history: history;
+		                   wrappee: PyramidMainCommandExecutor new;
+		                   yourself.
+
+	"Do once"
+	self argumentsForHistory do: [ :each |
+		commandExecutor use: self command on: targets with: each.
+		initialValue := initialValue + each ].
+
+	"Undo all"
+	self argumentsForHistory reverseDo: [ :argument |
+		targets do: [ :target |
+			self assert: (self command getValueFor: target) equals: initialValue ].
+		initialValue := initialValue - argument.
+		history canUndo ifTrue: [ history undo ] ].
+
+	"Redo all"
+	self argumentsForHistory do: [ :argument |
+		initialValue := initialValue + argument.
+		history canRedo ifTrue: [ history redo ].
+		targets do: [ :target |
+			self assert: (self command getValueFor: target) equals: initialValue ] ].
+
+	"Undo all"
+	self argumentsForHistory reverseDo: [ :argument |
+		targets do: [ :target |
+			self assert: (self command getValueFor: target) equals: initialValue ].
+		initialValue := initialValue - argument.
+		history canUndo ifTrue: [ history undo ] ].
+
+	"Redo all"
+	self argumentsForHistory do: [ :argument |
+		initialValue := initialValue + argument.
+		history canRedo ifTrue: [ history redo ].
+		targets do: [ :target |
+			self assert: (self command getValueFor: target) equals: initialValue ] ]
+]
+
+{ #category : #tests }
+PyramidPositionOffsetCommandTest >> testSetValueForWith [
+
+	self targetsWithoutValuesAndValues do: [ :each |
+		| initialValue |
+		initialValue := self command getValueFor: each key.
+		self command setValueFor: each key with: each value.
+		self assert: (self command getValueFor: each key) equals: each value + initialValue ]
+]