diff --git a/src/Pyramid-Bloc/PyramidBlocGeometryPlugin.class.st b/src/Pyramid-Bloc/PyramidBlocGeometryPlugin.class.st deleted file mode 100644 index 63799cd..0000000 --- a/src/Pyramid-Bloc/PyramidBlocGeometryPlugin.class.st +++ /dev/null @@ -1,94 +0,0 @@ -Class { - #name : #PyramidBlocGeometryPlugin, - #superclass : #Object, - #traits : 'TPyramidPlugin', - #classTraits : 'TPyramidPlugin classTrait', - #instVars : [ - 'propertiesManager' - ], - #category : #'Pyramid-Bloc-plugin-bloc-geometry' -} - -{ #category : #accessing } -PyramidBlocGeometryPlugin class >> cornerRadii [ - - | property | - property := PyramidProperty new - name: 'Corner radius'; - command: PyramidRoundedRectangleCornerRadiiCommand new; - inputPresenterClass: - PyramidCornerRadiiInputPresenter; - yourself. - property inputPresenterModel help: - 'Change the corner radius of the geometry. For example: - - "10" to set a radius of 10 px on each corner. - - "10 20" to set a radius of 10 px on the top-left and bottom-right corner and 20 px on the top-right and bottom-left corner. - - "10 20 30 40" to set a radius of 10 px on top-left, 20 px on top-right, 30 px on bottom-right and 40 px on bottom-left.'. - ^ property -] - -{ #category : #accessing } -PyramidBlocGeometryPlugin class >> geometry [ - - | property | - property := PyramidProperty new - name: 'Geo'; - command: PyramidGeometryCommand new; - inputPresenterClass: PyramidMagicButtonsInputPresenter; - yourself. - self geometryClasses do: [ :each | - property inputPresenterModel addButtonModel: - each asPyramidMagicButton ]. - ^ property -] - -{ #category : #'as yet unclassified' } -PyramidBlocGeometryPlugin class >> geometryClasses [ - - ^ { - BlRectangleGeometry. - BlRoundedRectangleGeometry. - BlSquareGeometry. - BlEllipseGeometry. - BlCircleGeometry. - BlAnnulusSectorGeometry. - BlTriangleGeometry. - BlLineGeometry . - BlPolylineGeometry. - BlBezierCurveGeometry. - BlPolygonGeometry } -] - -{ #category : #adding } -PyramidBlocGeometryPlugin >> addPanelsOn: aPyramidSimpleWindow [ - - aPyramidSimpleWindow at: #tabRight addItem: [ :builder | - builder - makeTab: self propertiesManager mainPresenter - label: 'Geo' - icon: (Smalltalk ui icons iconNamed: #box) - order: 4 ] -] - -{ #category : #connecting } -PyramidBlocGeometryPlugin >> connectOn: aPyramidEditor [ - - propertiesManager projectModel: aPyramidEditor projectModel. - propertiesManager commandExecutor: - aPyramidEditor commandExecutor -] - -{ #category : #initialization } -PyramidBlocGeometryPlugin >> initialize [ - - propertiesManager := PyramidPropertiesManagerForSelection new. - - propertiesManager addProperty: self class geometry. - propertiesManager addProperty: self class cornerRadii. -] - -{ #category : #adding } -PyramidBlocGeometryPlugin >> propertiesManager [ - - ^ propertiesManager -] diff --git a/src/Pyramid-Bloc/PyramidEditorPlugin.class.st b/src/Pyramid-Bloc/PyramidEditorPlugin.class.st new file mode 100644 index 0000000..8e2a591 --- /dev/null +++ b/src/Pyramid-Bloc/PyramidEditorPlugin.class.st @@ -0,0 +1,158 @@ +Class { + #name : #PyramidEditorPlugin, + #superclass : #Object, + #traits : 'TPyramidPlugin', + #classTraits : 'TPyramidPlugin classTrait', + #instVars : [ + 'propertiesManager' + ], + #category : #'Pyramid-Bloc-plugin-bloc-editor' +} + +{ #category : #accessing } +PyramidEditorPlugin class >> cornerRadii [ + + | property | + property := PyramidProperty new + name: 'Corner radius'; + command: PyramidRoundedRectangleCornerRadiiCommand new; + inputPresenterClass: PyramidCornerRadiiInputPresenter; + yourself. + property inputPresenterModel help: + 'Change the corner radius of the geometry. For example: + - "10" to set a radius of 10 px on each corner. + - "10 20" to set a radius of 10 px on the top-left and bottom-right corner and 20 px on the top-right and bottom-left corner. + - "10 20 30 40" to set a radius of 10 px on top-left, 20 px on top-right, 30 px on bottom-right and 40 px on bottom-left.'. + ^ property +] + +{ #category : #accessing } +PyramidEditorPlugin class >> geometry [ + + | property | + property := PyramidProperty new + name: 'Geo'; + command: PyramidGeometryCommand new; + inputPresenterClass: PyramidMagicButtonsInputPresenter; + yourself. + self geometryClasses do: [ :each | + property inputPresenterModel addButtonModel: + each asPyramidMagicButton ]. + ^ property +] + +{ #category : #'as yet unclassified' } +PyramidEditorPlugin class >> geometryClasses [ + + ^ { + BlRectangleGeometry. + BlRoundedRectangleGeometry. + BlSquareGeometry. + BlEllipseGeometry. + BlCircleGeometry. + BlAnnulusSectorGeometry. + BlTriangleGeometry. + BlLineGeometry. + BlPolylineGeometry. + BlBezierCurveGeometry. + BlPolygonGeometry } +] + +{ #category : #'as yet unclassified' } +PyramidEditorPlugin class >> toButtonEndIcon [ + + | property | + property := PyramidProperty new + name: 'End Icon'; + command: PyramidToButtonEndIconCommand new; + inputPresenterClass: PyramidIconInputPresenter; + yourself. + ^ property +] + +{ #category : #'as yet unclassified' } +PyramidEditorPlugin class >> toButtonIcon [ + + | property | + property := PyramidProperty new + name: 'Icon'; + command: PyramidToButtonIconCommand new; + inputPresenterClass: PyramidIconInputPresenter; + yourself. + ^ property +] + +{ #category : #'as yet unclassified' } +PyramidEditorPlugin class >> toButtonLabel [ + + | property | + property := PyramidProperty new + name: 'Text'; + command: PyramidToButtonLabelCommand new; + inputPresenterClass: PyramidTextInputPresenter; + yourself. + ^ property +] + +{ #category : #'as yet unclassified' } +PyramidEditorPlugin class >> toImageInnerImage [ + + | property | + property := PyramidProperty new + name: 'Image'; + command: PyramidToImageInnerImageCommand new; + inputPresenterClass: PyramidIconInputPresenter; + yourself. + ^ property +] + +{ #category : #'as yet unclassified' } +PyramidEditorPlugin class >> toLabelText [ + + | property | + property := PyramidProperty new + name: 'Text'; + command: PyramidToLabelTextCommand new; + inputPresenterClass: PyramidTextInputPresenter; + yourself. + ^ property +] + +{ #category : #adding } +PyramidEditorPlugin >> addPanelsOn: aPyramidSimpleWindow [ + + aPyramidSimpleWindow at: #tabRight addItem: [ :builder | + builder + makeTab: propertiesManager mainPresenter + label: 'Editor' + icon: (Smalltalk ui icons iconNamed: #box) + order: 5 ] +] + +{ #category : #connecting } +PyramidEditorPlugin >> connectOn: aPyramidEditor [ + + propertiesManager projectModel: aPyramidEditor projectModel. + propertiesManager commandExecutor: aPyramidEditor commandExecutor +] + +{ #category : #initialization } +PyramidEditorPlugin >> initialize [ + + propertiesManager := PyramidPropertiesManagerForSelection new. + + "BlElements properties" + propertiesManager addProperty: self class geometry. + propertiesManager addProperty: self class cornerRadii. + + "ToButton properties" + propertiesManager addProperty: self class toButtonLabel. + propertiesManager addProperty: self class toButtonIcon. + propertiesManager addProperty: self class toButtonEndIcon. + + "ToImage properties" + propertiesManager addProperty: self class toImageInnerImage. + + "ToLabel properties" + propertiesManager addProperty: self class toLabelText. +] diff --git a/src/Pyramid-Bloc/PyramidGeometryCommand.class.st b/src/Pyramid-Bloc/PyramidGeometryCommand.class.st index ad6277e..d67417e 100644 --- a/src/Pyramid-Bloc/PyramidGeometryCommand.class.st +++ b/src/Pyramid-Bloc/PyramidGeometryCommand.class.st @@ -1,7 +1,7 @@ Class { #name : #PyramidGeometryCommand, #superclass : #PyramidAbstractBlocCommand, - #category : #'Pyramid-Bloc-plugin-bloc-geometry' + #category : #'Pyramid-Bloc-plugin-bloc-editor' } { #category : #getter } diff --git a/src/Pyramid-Bloc/PyramidLibraryElement.class.st b/src/Pyramid-Bloc/PyramidLibraryElement.class.st index a885324..62dd2f0 100644 --- a/src/Pyramid-Bloc/PyramidLibraryElement.class.st +++ b/src/Pyramid-Bloc/PyramidLibraryElement.class.st @@ -5,6 +5,7 @@ Class { 'name', 'icon', 'block', + 'provider', 'status' ], #category : #'Pyramid-Bloc-plugin-navigation' @@ -103,6 +104,18 @@ PyramidLibraryElement >> name: anObject [ name := anObject ] +{ #category : #accessing } +PyramidLibraryElement >> provider [ + + ^ provider +] + +{ #category : #accessing } +PyramidLibraryElement >> provider: aClass [ + +provider := aClass +] + { #category : #accessing } PyramidLibraryElement >> status [ diff --git a/src/Pyramid-Bloc/PyramidMainExtension.class.st b/src/Pyramid-Bloc/PyramidMainExtension.class.st index 78f4d36..1b48b84 100644 --- a/src/Pyramid-Bloc/PyramidMainExtension.class.st +++ b/src/Pyramid-Bloc/PyramidMainExtension.class.st @@ -21,11 +21,17 @@ Class { 'currentGridWindowSize', 'currentGridVisibility', 'currentGridSpacing', - 'currentGridColor' + 'currentGridColor', + 'currentProjectIcons' ], #category : #'Pyramid-Bloc-plugin-space-extensions' } +{ #category : #adding } +PyramidMainExtension class >> addIconName: aSymbol forElementId: aString [ + self currentProjectIcons at: aString asSymbol put: aSymbol +] + { #category : #accessing } PyramidMainExtension class >> currentGridColor [ @@ -73,6 +79,29 @@ PyramidMainExtension class >> currentGridWindowSize: aPoint [ currentGridWindowSize := aPoint ] +{ #category : #accessing } +PyramidMainExtension class >> currentProjectIcons [ + + ^ currentProjectIcons ifNil: [ currentProjectIcons := Dictionary new ] +] + +{ #category : #accessing } +PyramidMainExtension class >> currentProjectIcons: aDictionary [ + currentProjectIcons := aDictionary + +] + +{ #category : #accessing } +PyramidMainExtension class >> iconNameForElementId: aString [ + ^ self currentProjectIcons at: aString ifAbsent: [ nil ] +] + +{ #category : #initialization } +PyramidMainExtension class >> resetCurrentProjectIcons [ + + currentProjectIcons := Dictionary new +] + { #category : #accessing } PyramidMainExtension >> borderElement [ @@ -296,11 +325,13 @@ PyramidMainExtension >> informTransformationChanged [ { #category : #initialization } PyramidMainExtension >> initialize [ "Set the default parameter value of the grid" + self class currentGridWindowSize: self defaultExtent. self class currentGridVisibility: self defaultGridVisibility. self class currentGridSpacing: self defaultGridSpacing. self class currentGridColor: self defaultGridColor. - + self class resetCurrentProjectIcons. + gridWindowSize := self defaultExtent. gridVisibility := self defaultGridVisibility. gridSpacing := self defaultGridSpacing. @@ -308,14 +339,14 @@ PyramidMainExtension >> initialize [ "Set up the graphical parameter windows of the grid and the space extension" workplacePropertiesView := PyramidWorkplacePropertiesPresenter new - workplaceSizeValue: self defaultExtent; + workplaceSizeValue: self defaultExtent; whenWorkplaceValuesChangedDo: [ :point | self extent: point ]; whenVisibilityChangedDo: [ gridVisibility := workplacePropertiesView visibilityButton - state. - + state. + self class currentGridVisibility: gridVisibility. self createGrid ]; @@ -341,7 +372,7 @@ PyramidMainExtension >> initialize [ self class currentGridColor: color. self createGrid ]; yourself. - workplacePropertiesView visibilityButton state: gridVisibility. + workplacePropertiesView visibilityButton state: gridVisibility. self defaultGridSpacing <= 0 ifTrue: [ gridSpacing := 1 ]. diff --git a/src/Pyramid-Bloc/PyramidRoundedRectangleCornerRadiiCommand.class.st b/src/Pyramid-Bloc/PyramidRoundedRectangleCornerRadiiCommand.class.st index a035164..f614852 100644 --- a/src/Pyramid-Bloc/PyramidRoundedRectangleCornerRadiiCommand.class.st +++ b/src/Pyramid-Bloc/PyramidRoundedRectangleCornerRadiiCommand.class.st @@ -1,7 +1,7 @@ Class { #name : #PyramidRoundedRectangleCornerRadiiCommand, #superclass : #PyramidAbstractBlocCommand, - #category : #'Pyramid-Bloc-plugin-bloc-geometry' + #category : #'Pyramid-Bloc-plugin-bloc-editor' } { #category : #testing } @@ -17,8 +17,9 @@ PyramidRoundedRectangleCornerRadiiCommand >> getValueFor: aBlElement [ ^ aBlElement geometry cornerRadii ] -{ #category : #setter } +{ #category : #initialization } PyramidRoundedRectangleCornerRadiiCommand >> setValueFor: aBlElement with: anArgument [ - aBlElement geometry: (BlRoundedRectangleGeometry cornerRadii: anArgument) + aBlElement geometry: + (BlRoundedRectangleGeometry cornerRadii: anArgument) ] diff --git a/src/Pyramid-Bloc/PyramidSavePlugin.class.st b/src/Pyramid-Bloc/PyramidSavePlugin.class.st index 6b29766..04cb13c 100644 --- a/src/Pyramid-Bloc/PyramidSavePlugin.class.st +++ b/src/Pyramid-Bloc/PyramidSavePlugin.class.st @@ -20,7 +20,6 @@ PyramidSavePlugin class >> openOn: aCollectionOfBlElement saveModel: aSaveModel | editor savePlugin metaData mainExtension spacePlugin | PyramidSavingService currentProjectMetaData: nil. - PyramidMainExtension currentGridWindowSize: nil. editor := PyramidEditor buildEditor. savePlugin := editor plugins select: [ :each | each class = self ]. savePlugin size = 1 ifFalse: [ @@ -46,6 +45,8 @@ PyramidSavePlugin class >> openOn: aCollectionOfBlElement saveModel: aSaveModel editor open. metaData ifNotNil: [ + (metaData at: #icons ifAbsent: [ nil ]) ifNotNil: [ :icons | + PyramidMainExtension currentProjectIcons: icons ]. spacePlugin := editor plugins detect: [ :p | p isKindOf: PyramidSpacePlugin ] ifNone: [ nil ]. @@ -60,8 +61,10 @@ PyramidSavePlugin class >> openOn: aCollectionOfBlElement saveModel: aSaveModel mainExtension workplacePropertiesView workplaceSizeValue: size ]. (metaData at: #gridVisibility ifAbsent: [ nil ]) ifNotNil: [ - :visibility | mainExtension gridVisibility: visibility. - mainExtension workplacePropertiesView visibilityButton state: visibility ]. + :visibility | + mainExtension gridVisibility: visibility. + mainExtension workplacePropertiesView visibilityButton + state: visibility ]. (metaData at: #gridSpacing ifAbsent: [ nil ]) ifNotNil: [ :spacing | mainExtension gridSpacing: spacing. diff --git a/src/Pyramid-Bloc/PyramidSavingService.class.st b/src/Pyramid-Bloc/PyramidSavingService.class.st index 7e49cf9..40028ee 100644 --- a/src/Pyramid-Bloc/PyramidSavingService.class.st +++ b/src/Pyramid-Bloc/PyramidSavingService.class.st @@ -118,7 +118,7 @@ PyramidSavingService class >> ston [ { #category : #private } PyramidSavingService >> buildMetaDataMethod [ - | methodName windowSize gridVisibility gridSpacing gridColor dictContent nl tab header | + | methodName windowSize gridVisibility gridSpacing gridColor icons dictContent nl tab header existingIds | methodName := self saveModel savingMethodName , 'MetaData'. windowSize := PyramidMainExtension currentGridWindowSize ifNil: [ 800 @ 600 ]. @@ -127,34 +127,61 @@ PyramidSavingService >> buildMetaDataMethod [ gridSpacing := PyramidMainExtension currentGridSpacing ifNil: [ 10 ]. gridColor := PyramidMainExtension currentGridColor ifNil: [ Color black ]. + existingIds := Set new. + [ + self saveModel projectModel firstLevelElements do: [ :e | + (e respondsTo: #id) ifTrue: [ + e id ifNotNil: [ :anId | existingIds add: anId asString ] ] ] ] + on: Error + do: [ :err | existingIds := Set new ]. + icons := Dictionary new. + PyramidMainExtension currentProjectIcons keysAndValuesDo: [ + :key + :value | + | keyString suffix baseId | + keyString := key asString. + suffix := #( '_icon' '_endIcon' '_innerImage' ) + detect: [ :s | keyString endsWith: s ] + ifNone: [ nil ]. + suffix ifNotNil: [ + baseId := keyString copyFrom: 1 to: keyString size - suffix size. + (existingIds includes: baseId) ifTrue: [ + icons at: key put: value ] ] ] . (windowSize = (800 @ 600) and: [ gridVisibility not and: [ - gridSpacing = 10 and: [ gridColor = Color black ] ] ]) ifTrue: [ + gridSpacing = 10 and: [ + gridColor = Color black and: [ icons isEmpty ] ] ] ]) ifTrue: [ ^ nil ]. - nl := String with: Character cr. tab := String with: Character tab. - dictContent := ''. windowSize = (800 @ 600) ifFalse: [ - dictContent := dictContent , nl , tab , tab , 'at: #windowSize put: ' - , windowSize x printString , ' @ ' - , windowSize y printString , ';' ]. + dictContent := dictContent , nl , tab , tab + , 'at: #windowSize put: ' , windowSize x printString + , ' @ ' , windowSize y printString , ';' ]. gridVisibility ifTrue: [ - dictContent := dictContent - , nl , tab , tab , 'at: #gridVisibility put: true;' ]. + dictContent := dictContent , nl , tab , tab + , 'at: #gridVisibility put: true;' ]. gridSpacing = 10 ifFalse: [ - dictContent := dictContent , nl , tab , tab , 'at: #gridSpacing put: ' - , gridSpacing printString , ';' ]. + dictContent := dictContent , nl , tab , tab + , 'at: #gridSpacing put: ' , gridSpacing printString + , ';' ]. gridColor = Color black ifFalse: [ - dictContent := dictContent , nl , tab , tab , 'at: #gridColor put: ' - , gridColor printString , ';' ]. - - header := methodName , nl , tab , '"Pyramid project metadata"' , nl , tab. - + dictContent := dictContent , nl , tab , tab + , 'at: #gridColor put: ' , gridColor printString + , ';' ]. + icons ifNotEmpty: [ + dictContent := dictContent , nl , tab , tab + , 'at: #icons put: (Dictionary new'. + icons keysAndValuesDo: [ :id :symbol | + dictContent := dictContent , nl , tab , tab , tab , 'at: #' , id + , ' put: #' , symbol , ';' ]. + dictContent := dictContent , nl , tab , tab , tab , 'yourself);' ]. + header := methodName , nl , tab , '"Pyramid project metadata"' , nl + , tab. ^ header , '' , nl , tab - , 'PyramidSavingService currentProjectMetaData: (Dictionary new' - , dictContent , nl , tab , tab , 'yourself)' + , 'PyramidSavingService currentProjectMetaData: (Dictionary new' + , dictContent , nl , tab , tab , 'yourself)' ] { #category : #testing } diff --git a/src/Pyramid-Bloc/PyramidSelectionMakerExtension.class.st b/src/Pyramid-Bloc/PyramidSelectionMakerExtension.class.st index f067f35..8713a64 100644 --- a/src/Pyramid-Bloc/PyramidSelectionMakerExtension.class.st +++ b/src/Pyramid-Bloc/PyramidSelectionMakerExtension.class.st @@ -186,12 +186,15 @@ PyramidSelectionMakerExtension >> selectAllElementsInBound: aBound [ { #category : #'as yet unclassified' } PyramidSelectionMakerExtension >> selectFirstElementAt: aPosition [ - | selectedElements | + | selectedElements filtered | self projectModel ifNil: [ ^ { } ]. selectedElements := self projectModel allElements select: [ :each | each boundsInSpace containsPoint: aPosition ]. selectedElements ifEmpty: [ ^ { } ]. - ^ { selectedElements last } + filtered := selectedElements select: [ :e | + e parentsShouldSerializeChildren ]. + filtered ifEmpty: [ ^ { selectedElements last } ]. + ^ { filtered last } ] { #category : #accessing } diff --git a/src/Pyramid-Bloc/PyramidToButtonEndIconCommand.class.st b/src/Pyramid-Bloc/PyramidToButtonEndIconCommand.class.st new file mode 100644 index 0000000..3c9bb5a --- /dev/null +++ b/src/Pyramid-Bloc/PyramidToButtonEndIconCommand.class.st @@ -0,0 +1,28 @@ +Class { + #name : #PyramidToButtonEndIconCommand, + #superclass : #PyramidAbstractBlocCommand, + #category : #'Pyramid-Bloc-plugin-bloc-editor' +} + +{ #category : #testing } +PyramidToButtonEndIconCommand >> canBeUsedFor: anObject [ + + ^ (super canBeUsedFor: anObject) and: [ anObject class = ToButton ] +] + +{ #category : #getter } +PyramidToButtonEndIconCommand >> getValueFor: aToButton [ + ^ (PyramidMainExtension currentProjectIcons + at: aToButton id , '_endIcon' ifAbsent: [ nil ]) + ifNil: [ '' ] +] + +{ #category : #setter } +PyramidToButtonEndIconCommand >> setValueFor: aToButton with: aSymbol [ + + aToButton endIcon: + (PyramidIconInputPresenter toImageFromName: aSymbol). + PyramidMainExtension + addIconName: aSymbol + forElementId: aToButton id , '_endIcon' +] diff --git a/src/Pyramid-Bloc/PyramidToButtonIconCommand.class.st b/src/Pyramid-Bloc/PyramidToButtonIconCommand.class.st new file mode 100644 index 0000000..dafe7bb --- /dev/null +++ b/src/Pyramid-Bloc/PyramidToButtonIconCommand.class.st @@ -0,0 +1,27 @@ +Class { + #name : #PyramidToButtonIconCommand, + #superclass : #PyramidAbstractBlocCommand, + #category : #'Pyramid-Bloc-plugin-bloc-editor' +} + +{ #category : #testing } +PyramidToButtonIconCommand >> canBeUsedFor: anObject [ + + ^ (super canBeUsedFor: anObject) and: [ anObject class = ToButton ] +] + +{ #category : #getter } +PyramidToButtonIconCommand >> getValueFor: aToButton [ + ^ (PyramidMainExtension iconNameForElementId: aToButton id , '_icon') ifNil: [ '' ] + + +] + +{ #category : #setter } +PyramidToButtonIconCommand >> setValueFor: aToButton with: aSymbol [ + + aToButton icon: (PyramidIconInputPresenter toImageFromName: aSymbol). + PyramidMainExtension + addIconName: aSymbol + forElementId: aToButton id , '_icon' +] diff --git a/src/Pyramid-Bloc/PyramidToButtonLabelCommand.class.st b/src/Pyramid-Bloc/PyramidToButtonLabelCommand.class.st new file mode 100644 index 0000000..a73dabb --- /dev/null +++ b/src/Pyramid-Bloc/PyramidToButtonLabelCommand.class.st @@ -0,0 +1,24 @@ +Class { + #name : #PyramidToButtonLabelCommand, + #superclass : #PyramidAbstractBlocCommand, + #category : #'Pyramid-Bloc-plugin-bloc-editor' +} + +{ #category : #testing } +PyramidToButtonLabelCommand >> canBeUsedFor: anObject [ + + ^ (super canBeUsedFor: anObject) and: [ + anObject class = ToButton ] +] + +{ #category : #getter } +PyramidToButtonLabelCommand >> getValueFor: anObject [ + + ^ anObject labelText ifNil: [ '' ] +] + +{ #category : #setter } +PyramidToButtonLabelCommand >> setValueFor: anObject with: aString [ + + anObject labelText: aString +] diff --git a/src/Pyramid-Bloc/PyramidToImageInnerImageCommand.class.st b/src/Pyramid-Bloc/PyramidToImageInnerImageCommand.class.st new file mode 100644 index 0000000..4925d79 --- /dev/null +++ b/src/Pyramid-Bloc/PyramidToImageInnerImageCommand.class.st @@ -0,0 +1,31 @@ +Class { + #name : #PyramidToImageInnerImageCommand, + #superclass : #PyramidAbstractBlocCommand, + #instVars : [ + 'iconName' + ], + #category : #'Pyramid-Bloc-plugin-bloc-editor' +} + +{ #category : #testing } +PyramidToImageInnerImageCommand >> canBeUsedFor: anObject [ + ^ (super canBeUsedFor: anObject) and: [ anObject class = ToImage ] +] + +{ #category : #getter } +PyramidToImageInnerImageCommand >> getValueFor: aToImage [ + + ^ (PyramidMainExtension currentProjectIcons + at: aToImage id asString, '_innerImage' + ifAbsent: [ nil ]) ifNil: [ '' ] +] + +{ #category : #setter } +PyramidToImageInnerImageCommand >> setValueFor: aToImage with: aSymbol [ + + aToImage innerImage: + (PyramidIconInputPresenter innerElementFromName: aSymbol). + PyramidMainExtension + addIconName: aSymbol + forElementId: aToImage id asString, '_innerImage' +] diff --git a/src/Pyramid-Bloc/PyramidToLabelTextCommand.class.st b/src/Pyramid-Bloc/PyramidToLabelTextCommand.class.st new file mode 100644 index 0000000..2bed470 --- /dev/null +++ b/src/Pyramid-Bloc/PyramidToLabelTextCommand.class.st @@ -0,0 +1,21 @@ +Class { + #name : #PyramidToLabelTextCommand, + #superclass : #PyramidAbstractBlocCommand, + #category : #'Pyramid-Bloc-plugin-bloc-editor' +} + +{ #category : #testing } +PyramidToLabelTextCommand >> canBeUsedFor: anObject [ + + ^ (super canBeUsedFor: anObject) and: [ anObject class = ToLabel ] +] + +{ #category : #getter } +PyramidToLabelTextCommand >> getValueFor: aToLabel [ + ^ aToLabel text asString ifNil: [ '' ] +] + +{ #category : #setter } +PyramidToLabelTextCommand >> setValueFor: aToLabel with: aString [ + aToLabel text: aString +] diff --git a/src/Pyramid-Tests/PyramidCornerRadiiInputPresenterTest.class.st b/src/Pyramid-Tests/PyramidCornerRadiiInputPresenterTest.class.st index 2ea3d1e..8a9e7b7 100644 --- a/src/Pyramid-Tests/PyramidCornerRadiiInputPresenterTest.class.st +++ b/src/Pyramid-Tests/PyramidCornerRadiiInputPresenterTest.class.st @@ -3,7 +3,7 @@ Class { #superclass : #TestCase, #traits : 'TPyramidInputPresenterTest', #classTraits : 'TPyramidInputPresenterTest classTrait', - #category : #'Pyramid-Tests-cases-plugin-bloc-geometry' + #category : #'Pyramid-Tests-cases-plugin-editor' } { #category : #accessing } diff --git a/src/Pyramid-Tests/PyramidGeometryCommandTest.class.st b/src/Pyramid-Tests/PyramidGeometryCommandTest.class.st index 1cefa68..6011bd9 100644 --- a/src/Pyramid-Tests/PyramidGeometryCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidGeometryCommandTest.class.st @@ -3,7 +3,7 @@ Class { #superclass : #TestCase, #traits : 'TPyramidCommandTest', #classTraits : 'TPyramidCommandTest classTrait', - #category : #'Pyramid-Tests-cases-plugin-bloc-geometry' + #category : #'Pyramid-Tests-cases-plugin-editor' } { #category : #accessing } diff --git a/src/Pyramid-Tests/PyramidRoundedRectangleCornerRadiiCommandTest.class.st b/src/Pyramid-Tests/PyramidRoundedRectangleCornerRadiiCommandTest.class.st index 38d349a..fab8827 100644 --- a/src/Pyramid-Tests/PyramidRoundedRectangleCornerRadiiCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidRoundedRectangleCornerRadiiCommandTest.class.st @@ -3,7 +3,7 @@ Class { #superclass : #TestCase, #traits : 'TPyramidCommandTest', #classTraits : 'TPyramidCommandTest classTrait', - #category : #'Pyramid-Tests-cases-plugin-bloc-geometry' + #category : #'Pyramid-Tests-cases-plugin-editor' } { #category : #accessing } diff --git a/src/Pyramid-Tests/PyramidToButtonEndIconCommandTest.class.st b/src/Pyramid-Tests/PyramidToButtonEndIconCommandTest.class.st new file mode 100644 index 0000000..188aab6 --- /dev/null +++ b/src/Pyramid-Tests/PyramidToButtonEndIconCommandTest.class.st @@ -0,0 +1,36 @@ +Class { + #name : #PyramidToButtonEndIconCommandTest, + #superclass : #TestCase, + #traits : 'TPyramidCommandTest', + #classTraits : 'TPyramidCommandTest classTrait', + #category : #'Pyramid-Tests-cases-plugin-editor' +} + +{ #category : #accessing } +PyramidToButtonEndIconCommandTest >> command [ + + ^ PyramidToButtonEndIconCommand new +] + +{ #category : #accessing } +PyramidToButtonEndIconCommandTest >> targetContainers [ + + | buttonA buttonAWithIcon | + buttonA := ToButton new + id: 'A'; + yourself. + + buttonAWithIcon := ToButton new + id: 'A'; + icon: + (PyramidIconInputPresenter toImageFromName: #add); + yourself. + + PyramidMainExtension addIconName: #add forElementId: 'A_endIcon'. + + + ^ { (PyramidCommandTestContainer + no: buttonA + with: buttonAWithIcon + prop: #add) } +] diff --git a/src/Pyramid-Tests/PyramidToButtonIconCommandTest.class.st b/src/Pyramid-Tests/PyramidToButtonIconCommandTest.class.st new file mode 100644 index 0000000..46f64a8 --- /dev/null +++ b/src/Pyramid-Tests/PyramidToButtonIconCommandTest.class.st @@ -0,0 +1,36 @@ +Class { + #name : #PyramidToButtonIconCommandTest, + #superclass : #TestCase, + #traits : 'TPyramidCommandTest', + #classTraits : 'TPyramidCommandTest classTrait', + #category : #'Pyramid-Tests-cases-plugin-editor' +} + +{ #category : #accessing } +PyramidToButtonIconCommandTest >> command [ + + ^ PyramidToButtonIconCommand new +] + +{ #category : #accessing } +PyramidToButtonIconCommandTest >> targetContainers [ + + | buttonA buttonAWithIcon | + buttonA := ToButton new + id: 'A'; + yourself. + + buttonAWithIcon := ToButton new + id: 'A'; + icon: + (PyramidIconInputPresenter toImageFromName: #add); + yourself. + + PyramidMainExtension addIconName: #add forElementId: 'A_icon'. + + + ^ { (PyramidCommandTestContainer + no: buttonA + with: buttonAWithIcon + prop: #add) } +] diff --git a/src/Pyramid-Tests/PyramidToButtonLabelCommandTest.class.st b/src/Pyramid-Tests/PyramidToButtonLabelCommandTest.class.st new file mode 100644 index 0000000..ec4de0c --- /dev/null +++ b/src/Pyramid-Tests/PyramidToButtonLabelCommandTest.class.st @@ -0,0 +1,34 @@ +Class { + #name : #PyramidToButtonLabelCommandTest, + #superclass : #TestCase, + #traits : 'TPyramidCommandTest', + #classTraits : 'TPyramidCommandTest classTrait', + #category : #'Pyramid-Tests-cases-plugin-editor' +} + +{ #category : #accessing } +PyramidToButtonLabelCommandTest >> command [ + +^ PyramidToButtonLabelCommand new +] + +{ #category : #accessing } +PyramidToButtonLabelCommandTest >> targetContainers [ + + ^ { + (PyramidCommandTestContainer + no: ToButton new + with: (ToButton new + labelText: 'hello'; + yourself) + prop: 'hello'). + + (PyramidCommandTestContainer + no: (ToButton new + labelText: 'hello'; + yourself) + with: (ToButton new + labelText: 'pyramid'; + yourself) + prop: 'pyramid') } +] diff --git a/src/Pyramid-Tests/PyramidToImageInnerImageCommandTest.class.st b/src/Pyramid-Tests/PyramidToImageInnerImageCommandTest.class.st new file mode 100644 index 0000000..0543da3 --- /dev/null +++ b/src/Pyramid-Tests/PyramidToImageInnerImageCommandTest.class.st @@ -0,0 +1,39 @@ +Class { + #name : #PyramidToImageInnerImageCommandTest, + #superclass : #TestCase, + #traits : 'TPyramidCommandTest', + #classTraits : 'TPyramidCommandTest classTrait', + #category : #'Pyramid-Tests-cases-plugin-editor' +} + +{ #category : #accessing } +PyramidToImageInnerImageCommandTest >> command [ + +^ PyramidToImageInnerImageCommand new +] + +{ #category : #accessing } +PyramidToImageInnerImageCommandTest >> targetContainers [ + + | icon | + icon := Smalltalk ui icons iconNamed: #add. + PyramidMainExtension addIconName: #add forElementId: 'A_innerImage'. + PyramidMainExtension addIconName: #add forElementId: 'nil_innerImage'. + ^ { + (PyramidCommandTestContainer + no: (ToImage new + id: 'A'; + yourself) + with: (ToImage new + id: 'A'; + innerImage: icon; + yourself) + prop: #add). + (PyramidCommandTestContainer + no: (ToImage + new) + with: (ToImage new + innerImage: icon; + yourself) + prop: #add) } +] diff --git a/src/Pyramid-Tests/PyramidToLabelTextCommandTest.class.st b/src/Pyramid-Tests/PyramidToLabelTextCommandTest.class.st new file mode 100644 index 0000000..4df79c6 --- /dev/null +++ b/src/Pyramid-Tests/PyramidToLabelTextCommandTest.class.st @@ -0,0 +1,35 @@ +Class { + #name : #PyramidToLabelTextCommandTest, + #superclass : #TestCase, + #traits : 'TPyramidCommandTest', + #classTraits : 'TPyramidCommandTest classTrait', + #category : #'Pyramid-Tests-cases-plugin-editor' +} + +{ #category : #accessing } +PyramidToLabelTextCommandTest >> command [ + +^ PyramidToLabelTextCommand new +] + +{ #category : #accessing } +PyramidToLabelTextCommandTest >> targetContainers [ + + ^ { + + (PyramidCommandTestContainer + no: ToLabel new + with: (ToLabel new + text: 'hello'; + yourself) + prop: 'hello'). + + (PyramidCommandTestContainer + no: (ToLabel new + text: 'hello'; + yourself) + with: (ToLabel new + text: 'pyramid'; + yourself) + prop: 'pyramid') } +] diff --git a/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st b/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st index bd42e46..d4fbb46 100644 --- a/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st +++ b/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st @@ -45,9 +45,7 @@ PyramidToploThemePlugin class >> defaultThemeSettingOn: aBuilder [ PyramidToploThemePlugin class >> toploAntIconCategory [ - ^ PyramidToploThemePlugin - toploIconThemeCategoryFromClass: ToAntDesignIconProvider - withCategoryPrefix: 'Ant Design - ' + ^ PyramidIconInputPresenter toploAntIconCategory ] { #category : #adding } @@ -193,9 +191,7 @@ PyramidToploThemePlugin class >> toploLibraryCategory [ PyramidToploThemePlugin class >> toploMaterialIconCategory [ - ^ PyramidToploThemePlugin - toploIconThemeCategoryFromClass: ToMaterialDesignIconProvider - withCategoryPrefix: 'Material Design - ' + ^ PyramidIconInputPresenter toploMaterialIconCategory ] { #category : #adding } diff --git a/src/Pyramid/PyramidExternalRessourceProxy.class.st b/src/Pyramid/PyramidExternalRessourceProxy.class.st index 049fdf1..c1035b9 100644 --- a/src/Pyramid/PyramidExternalRessourceProxy.class.st +++ b/src/Pyramid/PyramidExternalRessourceProxy.class.st @@ -33,6 +33,22 @@ PyramidExternalRessourceProxy class >> fromTarget: aTarget selector: aSelector a postConstructionBlock: aBlock) ] +{ #category : #converting } +PyramidExternalRessourceProxy >> asBlBackground [ + + ^ BlBackground image: self +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> asElement [ + + (self pyramidExternalRessourceObject isKindOf: Form ) ifTrue: [ ^ BlElement new + extent: self extent; + background: self; + yourself ]. + ^ self pyramidExternalRessourceObject asElement +] + { #category : #converting } PyramidExternalRessourceProxy >> asStashConstructor [ diff --git a/src/Pyramid/PyramidHistory.class.st b/src/Pyramid/PyramidHistory.class.st index 05a8d77..5c18bab 100644 --- a/src/Pyramid/PyramidHistory.class.st +++ b/src/Pyramid/PyramidHistory.class.st @@ -66,6 +66,6 @@ PyramidHistory >> redo [ PyramidHistory >> undo [ self canUndo ifTrue: [ - (self mementosStack at: self position) key restore. - position := position - 1 ] + (self mementosStack at: self position) key restore. + position := position - 1 ]. ] diff --git a/src/Pyramid/PyramidIconInputPresenter.class.st b/src/Pyramid/PyramidIconInputPresenter.class.st new file mode 100644 index 0000000..acfaaec --- /dev/null +++ b/src/Pyramid/PyramidIconInputPresenter.class.st @@ -0,0 +1,281 @@ +Class { + #name : #PyramidIconInputPresenter, + #superclass : #PyramidInputPresenter, + #instVars : [ + 'textInput', + 'button', + 'whenValueChangedDo', + 'categoryList', + 'iconList' + ], + #category : #'Pyramid-specs-custom' +} + +{ #category : #private } +PyramidIconInputPresenter class >> buildProxy: aTarget selector: aSelector args: anArray [ + + ^ PyramidExternalRessourceProxy fromSource: + (PyramidExternalRessourceSource + target: aTarget + selector: aSelector + arguments: anArray) +] + +{ #category : #private } +PyramidIconInputPresenter class >> findToploIconNamed: aSymbol [ + ^ (self + toploIconThemeCategoryFromClass: ToAntDesignIconProvider + withCategoryPrefix: '') , + (self + toploIconThemeCategoryFromClass: ToMaterialDesignIconProvider + withCategoryPrefix: '') + inject: nil + into: [ :found :cat | + found ifNil: [ + cat elements + detect: [ :e | e name = aSymbol ] + ifNone: [ nil ] ] ] +] + +{ #category : #private } +PyramidIconInputPresenter class >> innerElementFromName: aSymbol [ + + (self findToploIconNamed: aSymbol) ifNotNil: [ :element | + | proxy | + proxy := self toploSvgProxyFor: element. + + proxy pyramidExternalRessourceSource postConstructionBlock: [ :obj | + obj constraints horizontal matchParent. + obj constraints vertical matchParent ]. + + ^ proxy ]. + + ^ self buildProxy: Object selector: #iconNamed: args: { aSymbol } +] + +{ #category : #private } +PyramidIconInputPresenter class >> toImageFromName: aSymbol [ + + (self findToploIconNamed: aSymbol) ifNotNil: [ :element | + | proxy | + proxy := self toploSvgProxyFor: element. + + proxy pyramidExternalRessourceSource postConstructionBlock: [ :obj | + obj constraints horizontal exact: 16. + obj constraints vertical exact: 16 ]. + + ^ ToImage new + innerImage: proxy; + yourself ]. + + ^ ToImage new + innerImage: + (self buildProxy: Object selector: #iconNamed: args: { aSymbol }); + yourself +] + +{ #category : #adding } +PyramidIconInputPresenter class >> toploAntIconCategory [ + + ^ self + toploIconThemeCategoryFromClass: ToAntDesignIconProvider + withCategoryPrefix: 'Ant Design - ' +] + +{ #category : #adding } +PyramidIconInputPresenter class >> toploIconThemeCategoryFromClass: aClass withCategoryPrefix: aString [ + + | categoriesMethods | + categoriesMethods := aClass class methods select: [ :method | + method selector first = $_ and: [ + ($_ split: method selector) last = 'loaded' ] ]. + + ^ categoriesMethods collect: [ :method | + | prefix elementSelectors elements | + prefix := ($_ split: method selector) second. + + elementSelectors := (aClass perform: method selector) collect: [ + :suffix | prefix , '_' , suffix ]. + + elements := elementSelectors collect: [ :selector | + PyramidLibraryElement new + name: selector; + provider: aClass; + icon: (Smalltalk ui icons iconNamed: #blank); + block: [ + | image | + image := ToImage new + extent: 48 asPoint; + innerImage: + (PyramidExternalRessourceProxy new + pyramidExternalRessourceSource: + (PyramidExternalRessourceSource + new + postConstructionBlock: [ :obj | + obj constraints horizontal + matchParent. + obj constraints vertical + matchParent ]; + target: BlSvgConverter; + selector: #convertFromString:; + arguments: + { (PyramidExternalRessourceProxy + new + + pyramidExternalRessourceSource: + (PyramidExternalRessourceSource + new + target: aClass; + selector: + selector asSymbol; + arguments: { }; + yourself); + yourself) }; + yourself); + yourself). + { image } ]; + yourself ]. + PyramidLibraryCategory new + name: aString , prefix; + icon: (Smalltalk ui icons iconNamed: #image); + elements: elements; + yourself ] +] + +{ #category : #adding } +PyramidIconInputPresenter class >> toploMaterialIconCategory [ + + ^ self + toploIconThemeCategoryFromClass: ToMaterialDesignIconProvider + withCategoryPrefix: 'Material Design - ' +] + +{ #category : #private } +PyramidIconInputPresenter class >> toploSvgProxyFor: element [ + + | stringProxy svgProxy | + stringProxy := self + buildProxy: element provider + selector: element name asSymbol + args: #( ). + + svgProxy := self + buildProxy: BlSvgConverter + selector: #convertFromString: + args: { stringProxy }. + + ^ svgProxy +] + +{ #category : #private } +PyramidIconInputPresenter >> buildIconPickerPresenter [ + + | categories presenter | + categories := OrderedCollection new. + categories add: (PyramidLibraryCategory new + name: 'Smalltalk Icons'; + icon: (Smalltalk ui icons iconNamed: #image); + elements: + (Smalltalk ui icons allIconNames asSortedCollection collect: [ + :name | + PyramidLibraryElement new + name: name asString; + icon: (Smalltalk ui icons iconNamed: name); + yourself ]); + yourself). + + categories addAll: self class toploAntIconCategory. + categories addAll: self class toploMaterialIconCategory. + + categoryList := SpListPresenter new. + categoryList + items: categories asArray; + display: [ :category | category name ]; + displayIcon: [ :category | category icon ]. + + + iconList := SpFilteringListPresenter new. + iconList + display: [ :element | element name ]; + displayIcon: [ :element | + | icon | + icon := element icon. + (icon isNil or: [ icon = (Smalltalk ui icons iconNamed: #blank) ]) + ifTrue: [ + [ element asForm scaledToSize: 16 @ 16 ] + on: Error + do: [ Smalltalk ui icons iconNamed: #blank ] ] + ifFalse: [ icon ] ]; + itemFilter: [ :element :filter | + filter isEmpty or: [ + element asLowercase includesSubstring: filter asLowercase ] ]. + + categoryList whenSelectionChangedDo: [ :selection | + selection isEmpty + ifTrue: [ iconList items: #( ) ] + ifFalse: [ + iconList items: selection selectedItem elements asArray ] ]. + categories isNotEmpty ifTrue: [ categoryList selectIndex: 1 ]. + presenter := SpPresenter new. + presenter layout: (SpBoxLayout newHorizontal + add: categoryList width: 220; + add: iconList; + yourself). + ^ presenter -> iconList +] + +{ #category : #layout } +PyramidIconInputPresenter >> defaultLayout [ + ^ SpBoxLayout newHorizontal + spacing: 2; + add: textInput; + add: button width: 24; + yourself +] + +{ #category : #initialization } +PyramidIconInputPresenter >> initializePresenters [ + + whenValueChangedDo := [ :v | ]. + textInput := SpTextInputFieldPresenter new. + textInput whenSubmitDo: [ :text | whenValueChangedDo value: text ]. + button := SpButtonPresenter new + help: 'Select an icon'; + icon: (Smalltalk ui icons iconNamed: #image); + action: [ self openIconModal ]; + yourself +] + +{ #category : #private } +PyramidIconInputPresenter >> openIconModal [ + + | result modalPresenter window dialog selected | + result := self buildIconPickerPresenter. + modalPresenter := result key. + iconList := result value. + window := modalPresenter asModalWindow. + window title: 'Choose an icon'. + window centered. + dialog := window open. + dialog isOk ifFalse: [ ^ self ]. + selected := iconList selectedItem. + selected ifNil: [ ^ self ]. + self value: selected name. + whenValueChangedDo value: selected name +] + +{ #category : #accessing } +PyramidIconInputPresenter >> value [ + ^ textInput text +] + +{ #category : #accessing } +PyramidIconInputPresenter >> value: aString [ + + textInput text: (aString ifNil: [ '' ]) +] + +{ #category : #accessing } +PyramidIconInputPresenter >> whenValueChangedDo: aBlock [ + whenValueChangedDo := aBlock +]