Dev stage shadow

src/Pyramid-Bloc/PyramidBackgroundBlocPlugin.class.st

@@ -671,6 +671,86 @@ PyramidBackgroundBlocPlugin class >> outskirts [
 	^ property
 ]
 
+{ #category : #accessing }
+PyramidBackgroundBlocPlugin class >> shadow [
+
+	| property |
+	property := PyramidProperty new
+		            name: 'Shadow Effect';
+		            command: PyramidShadowCommand current;
+		            inputPresenterClass: PyramidMagicButtonsInputPresenter;
+		            yourself.
+	property inputPresenterModel
+		addButtonModel: (PyramidMagicButtonModel new
+				 icon: (Smalltalk ui icons iconNamed: #blank);
+				 helpSelected: 'No shadow.';
+				 helpNotSelected: 'Remove shadow.';
+				 label: 'None';
+				 inputValue: [ BlNullEffect new ];
+				 inputValidation: [ :value | value class = BlNullEffect ];
+				 yourself);
+		addButtonModel: (PyramidMagicButtonModel new
+				 icon: (Smalltalk ui icons iconNamed: #windowMaximize);
+				 helpSelected: 'Shadow type is simple.';
+				 helpNotSelected: 'Set shadow type to simple.';
+				 label: 'Simple';
+				 inputValue: [ PyramidShadowCommand current lastSimpleShadow ];
+				 inputValidation: [ :value | value class = BlSimpleShadowEffect ];
+				 yourself);
+		addButtonModel: (PyramidMagicButtonModel new
+				 icon: (Smalltalk ui icons iconNamed: #radioButtonUnselected);
+				 helpSelected: 'Shadow type is gaussian.';
+				 helpNotSelected: 'Set shadow type to gaussian.';
+				 label: 'Gaussian';
+				 inputValue: [ PyramidShadowCommand current lastGaussianShadow ];
+				 inputValidation: [ :value | value class = BlGaussianShadowEffect ];
+				 yourself).
+	^ property
+]
+
+{ #category : #accessing }
+PyramidBackgroundBlocPlugin class >> shadowColor [
+
+	| property |
+	property := PyramidProperty new
+		            name: 'Shadow Color';
+		            command: PyramidShadowColorCommand new;
+		            inputPresenterClass:
+			            PyramidColorInputSingleLineWithPickupButtonPresenter;
+		            yourself.
+	^ property
+
+
+]
+
+{ #category : #accessing }
+PyramidBackgroundBlocPlugin class >> shadowOffset [
+
+	| property |
+	property := PyramidProperty new
+		            name: 'Shadow Offset';
+		            command: PyramidShadowOffsetCommand new;
+		            inputPresenterClass:
+			            PyramidPointInputPresenter;
+		            yourself.
+		property inputPresenterModel help:
+		'Set the position x and y for the shadow offset'.
+	^ property
+]
+
+{ #category : #accessing }
+PyramidBackgroundBlocPlugin class >> shadowWidthGaussian [
+
+	| property |
+	property := PyramidProperty new
+		            name: 'Shadow Width';
+		            command: PyramidShadowGaussianWidthCommand new;
+		            inputPresenterClass: PyramidNumberInputPresenter;
+		            yourself.
+	property inputPresenterModel help: 'Set the width value'.
+	^ property
+]
+
 { #category : #adding }
 PyramidBackgroundBlocPlugin >> addPanelsOn: aPyramidSimpleWindow [
 
@@ -747,7 +827,14 @@ PyramidBackgroundBlocPlugin >> initialize [
 	propertiesManager addProperty: self class borderRadialInnerCenter.
 	propertiesManager addProperty: self class borderRadialInnerRadius.
 	propertiesManager addProperty: self class borderRadialOuterCenter.
-	propertiesManager addProperty: self class borderRadialOuterRadius
+	propertiesManager addProperty: self class borderRadialOuterRadius.
+
+	"Shadow"
+	PyramidShadowCommand resetShadowCommand.
+	propertiesManager addProperty: self class shadow.
+	propertiesManager addProperty: self class shadowColor.
+	propertiesManager addProperty: self class shadowOffset.
+	propertiesManager addProperty: self class shadowWidthGaussian
 ]
 
 { #category : #adding }

src/Pyramid-Bloc/PyramidMoveChildInParentPlugin.class.st

@@ -46,22 +46,21 @@ PyramidMoveChildInParentPlugin >> contextMenuMoveChildInParent: aBuilder [
 
 	aBuilder
 		addGroupSingleSelection: [ :group :single |
-			group
-				addItem: [ :item |
-					item
-						icon: (Smalltalk ui icons iconNamed: #up);
-						name: 'Move index child up';
-						action: [ self moveChildIndexUpInParent ];
-						yourself ];
-
-				addItem: [ :item |
-					item
-						icon: (Smalltalk ui icons iconNamed: #down);
-						name: 'Move index child down';
-						action: [ self moveChildIndexDownInParent ];
-						yourself ];
-				yourself ]
-		order: 10.
+				group
+					addItem: [ :item |
+							item
+								icon: (Smalltalk ui icons iconNamed: #up);
+								name: 'Move child up';
+								action: [  self moveChildIndexDownInParent  ];
+								yourself ];
+					addItem: [ :item |
+							item
+								icon: (Smalltalk ui icons iconNamed: #down);
+								name: 'Move child down';
+								action: [self moveChildIndexUpInParent];
+								yourself ];
+					yourself ]
+		order: 10
 ]
 
 { #category : #accessing }
@@ -91,28 +90,23 @@ PyramidMoveChildInParentPlugin >> moveChildIndexDownCommand: aBlElementParent wi
 PyramidMoveChildInParentPlugin >> moveChildIndexDownInParent [
 
 	| childToMoveCollection childToMove childIndexToMove parentChild navigationSelectionPanel |
-
 	childToMoveCollection := projectModel selection collection.
 	navigationSelectionPanel := navigationPlugin navigation selectionPanel.
-
-	childToMoveCollection size = 1
-	ifFalse: [ ^ self ].
+
+	childToMoveCollection size = 1 ifFalse: [ ^ self ].
 	childToMove := childToMoveCollection first.
-
-	childToMove hasParent 
-	ifFalse: [ ^ self ].
+
+	childToMove hasParent ifFalse: [ ^ self ].
 	parentChild := childToMove parent.
-
-	childIndexToMove := (parentChild childIndexOf: childToMove).
-
-	childIndexToMove > 1
-		ifTrue: [ self moveChildIndexDownCommand: parentChild with: childToMove.
-			self refreshTreeTable ]
-		ifFalse: [ self inform: 'Cannot move down' ].
 
-
-
+	childIndexToMove := parentChild childIndexOf: childToMove.
 
+	childIndexToMove > 1
+		ifTrue: [
+				self moveChildIndexDownCommand: parentChild with: childToMove.
+				self refreshTreeTable ]
+		ifFalse: [ "cannot move the child up and the index down"
+			self inform: 'Cannot move up' ]
 ]
 
 { #category : #'as yet unclassified' }
@@ -129,27 +123,23 @@ PyramidMoveChildInParentPlugin >> moveChildIndexUpCommand: aBlElementParent with
 PyramidMoveChildInParentPlugin >> moveChildIndexUpInParent [
 
 	| childToMoveCollection childToMove childIndexToMove parentChild navigationSelectionPanel |
-
 	childToMoveCollection := projectModel selection collection.
 	navigationSelectionPanel := navigationPlugin navigation selectionPanel.
-
-	childToMoveCollection size = 1
-	ifFalse: [ ^ self ].
+
+	childToMoveCollection size = 1 ifFalse: [ ^ self ].
 	childToMove := childToMoveCollection first.
-
-	childToMove hasParent 
-	ifFalse: [ ^ self ].
+
+	childToMove hasParent ifFalse: [ ^ self ].
 	parentChild := childToMove parent.
-
-	childIndexToMove := (parentChild childIndexOf: childToMove).
-
-	childIndexToMove < (parentChild children size)
-		ifTrue: [ self moveChildIndexUpCommand: parentChild with: childToMove.
-			self refreshTreeTable ]
-		ifFalse: [ self inform: 'Cannot move up' ].
-
-
 
+	childIndexToMove := parentChild childIndexOf: childToMove.
+
+	childIndexToMove < parentChild children size
+		ifTrue: [
+				self moveChildIndexUpCommand: parentChild with: childToMove.
+				self refreshTreeTable ]
+		ifFalse: [ "cannot move the child down and the index up"
+			self inform: 'Cannot move down' ]
 ]
 
 { #category : #accessing }

src/Pyramid-Bloc/PyramidShadowColorCommand.class.st

@@ -0,0 +1,30 @@
+Class {
+	#name : #PyramidShadowColorCommand,
+	#superclass : #PyramidAbstractBlocCommand,
+	#category : #'Pyramid-Bloc-plugin-bloc-visuals'
+}
+
+{ #category : #testing }
+PyramidShadowColorCommand >> canBeUsedFor: anObject [
+
+	^ (super canBeUsedFor: anObject) and: [
+			  anObject effect class = BlSimpleShadowEffect or: [
+				  anObject effect class = BlGaussianShadowEffect ] ]
+]
+
+{ #category : #accessing }
+PyramidShadowColorCommand >> getValueFor: aBlElement [
+
+	(aBlElement effect class = BlSimpleShadowEffect or: [
+		 aBlElement effect class = BlGaussianShadowEffect ]) ifFalse: [ ^ nil ].
+	^ aBlElement effect color
+]
+
+{ #category : #accessing }
+PyramidShadowColorCommand >> setValueFor: aBlElement with: aColor [
+
+	(aBlElement effect class = BlSimpleShadowEffect or: [
+		 aBlElement effect class = BlGaussianShadowEffect ]) ifFalse: [ ^ nil ].
+	aBlElement effect: (aBlElement effect copyWithColor: aColor).
+	PyramidShadowCommand current syncFromElement: aBlElement
+]

src/Pyramid-Bloc/PyramidShadowCommand.class.st

@@ -0,0 +1,61 @@
+Class {
+	#name : #PyramidShadowCommand,
+	#superclass : #PyramidAbstractBlocCommand,
+	#instVars : [
+		'lastSimpleShadow',
+		'lastGaussianShadow'
+	],
+	#classInstVars : [
+		'current'
+	],
+	#category : #'Pyramid-Bloc-plugin-bloc-visuals'
+}
+
+{ #category : #accessing }
+PyramidShadowCommand class >> current [
+	current ifNil: [ current := self new ].
+	^ current
+]
+
+{ #category : #accessing }
+PyramidShadowCommand class >> resetShadowCommand [
+
+	current := nil
+]
+
+{ #category : #accessing }
+PyramidShadowCommand >> getValueFor: aBlElement [
+
+		^ aBlElement effect 
+]
+
+{ #category : #accessing }
+PyramidShadowCommand >> lastGaussianShadow [
+    ^ lastGaussianShadow ifNil: [ BlGaussianShadowEffect color: Color black width: 2 offset: 2 @ 2 ]
+]
+
+{ #category : #accessing }
+PyramidShadowCommand >> lastSimpleShadow [
+
+	^ lastSimpleShadow ifNil: [
+		  BlSimpleShadowEffect color: Color black offset: 2 @ 2 ]
+]
+
+{ #category : #accessing }
+PyramidShadowCommand >> setValueFor: aBlElement with: anArgument [
+
+	anArgument class = BlSimpleShadowEffect ifTrue: [
+		lastSimpleShadow := anArgument ].
+	anArgument class = BlGaussianShadowEffect ifTrue: [
+		lastGaussianShadow := anArgument ].
+	aBlElement effect: anArgument
+]
+
+{ #category : #updating }
+PyramidShadowCommand >> syncFromElement: aBlElement [
+
+	aBlElement effect class = BlSimpleShadowEffect ifTrue: [
+		lastSimpleShadow := aBlElement effect ].
+	aBlElement effect class = BlGaussianShadowEffect ifTrue: [
+		lastGaussianShadow := aBlElement effect ]
+]

src/Pyramid-Bloc/PyramidShadowGaussianWidthCommand.class.st

@@ -0,0 +1,29 @@
+Class {
+	#name : #PyramidShadowGaussianWidthCommand,
+	#superclass : #PyramidAbstractBlocCommand,
+	#category : #'Pyramid-Bloc-plugin-bloc-visuals'
+}
+
+{ #category : #testing }
+PyramidShadowGaussianWidthCommand >> canBeUsedFor: anObject [
+
+	^ (super canBeUsedFor: anObject) and: [
+		  anObject effect class = BlGaussianShadowEffect ]
+]
+
+{ #category : #accessing }
+PyramidShadowGaussianWidthCommand >> getValueFor: aBlElement [
+
+	(aBlElement effect class = BlSimpleShadowEffect or: [
+		 aBlElement effect class = BlGaussianShadowEffect ]) ifFalse: [ ^ nil ].
+	^ aBlElement effect width
+]
+
+{ #category : #accessing }
+PyramidShadowGaussianWidthCommand >> setValueFor: aBlElement with: aWidth [
+
+	(aBlElement effect class = BlSimpleShadowEffect or: [
+		 aBlElement effect class = BlGaussianShadowEffect ]) ifFalse: [ ^ nil ].
+	aBlElement effect: (aBlElement effect copyWithWidth: aWidth).
+	PyramidShadowCommand current syncFromElement: aBlElement
+]

src/Pyramid-Bloc/PyramidShadowOffsetCommand.class.st

@@ -0,0 +1,29 @@
+Class {
+	#name : #PyramidShadowOffsetCommand,
+	#superclass : #PyramidAbstractBlocCommand,
+	#category : #'Pyramid-Bloc-plugin-bloc-visuals'
+}
+
+{ #category : #testing }
+PyramidShadowOffsetCommand >> canBeUsedFor: anObject [
+
+	^ (super canBeUsedFor: anObject) and: [
+		  anObject effect class = BlSimpleShadowEffect or: [anObject effect class = BlGaussianShadowEffect] ]
+]
+
+{ #category : #accessing }
+PyramidShadowOffsetCommand >> getValueFor: aBlElement [
+
+	(aBlElement effect class = BlSimpleShadowEffect or: [
+		 aBlElement effect class = BlGaussianShadowEffect ]) ifFalse: [ ^ nil ].
+	^ aBlElement effect offset
+]
+
+{ #category : #accessing }
+PyramidShadowOffsetCommand >> setValueFor: aBlElement with: aPoint [
+
+	(aBlElement effect class = BlSimpleShadowEffect or: [
+		 aBlElement effect class = BlGaussianShadowEffect ]) ifFalse: [ ^ nil ].
+	aBlElement effect: (aBlElement effect copyWithOffset: aPoint).
+	PyramidShadowCommand current syncFromElement: aBlElement
+]

src/Pyramid-Tests/PyramidAddChildCommandTest.class.st

@@ -12,7 +12,7 @@ PyramidAddChildCommandTest >> command [
 	^ PyramidAddChildCommand new
 ]
 
-{ #category : #'as yet unclassified' }
+{ #category : #accessing }
 PyramidAddChildCommandTest >> targetsCanBeUsedFor [
 
 	^ { BlElement new . BlElement new addChild: BlElement new; yourself }