diff --git a/src/Pyramid-Bloc/PyramidAddChildrenCommand.class.st b/src/Pyramid-Bloc/PyramidAddChildrenCommand.class.st new file mode 100644 index 00000000..e427786c --- /dev/null +++ b/src/Pyramid-Bloc/PyramidAddChildrenCommand.class.st @@ -0,0 +1,19 @@ +Class { + #name : 'PyramidAddChildrenCommand', + #superclass : 'PyramidChildrenCommand', + #category : 'Pyramid-Bloc-plugin-bloc', + #package : 'Pyramid-Bloc', + #tag : 'plugin-bloc' +} + +{ #category : 'as yet unclassified' } +PyramidAddChildrenCommand >> commandInverse [ + + ^ PyramidRemoveChildrenCommand new +] + +{ #category : 'as yet unclassified' } +PyramidAddChildrenCommand >> setValueFor: aBlElement with: aChildrenToAdd [ + + aBlElement addChildren: aChildrenToAdd +] diff --git a/src/Pyramid-Bloc/PyramidElementToAddCategory.class.st b/src/Pyramid-Bloc/PyramidElementToAddCategory.class.st new file mode 100644 index 00000000..4536c76a --- /dev/null +++ b/src/Pyramid-Bloc/PyramidElementToAddCategory.class.st @@ -0,0 +1,80 @@ +Class { + #name : 'PyramidElementToAddCategory', + #superclass : 'Object', + #instVars : [ + 'name', + 'icon', + 'factories' + ], + #category : 'Pyramid-Bloc-plugin-tree-library', + #package : 'Pyramid-Bloc', + #tag : 'plugin-tree-library' +} + +{ #category : 'comparing' } +PyramidElementToAddCategory >> <= aPyramidLibraryCategory [ + + ^ self name <= aPyramidLibraryCategory name +] + +{ #category : 'converting' } +PyramidElementToAddCategory >> asNotebookPage [ + + ^ SpNotebookPage + title: self name + icon: self icon + provider: [self makeProvider] +] + +{ #category : 'accessing' } +PyramidElementToAddCategory >> factories [ + + ^ factories +] + +{ #category : 'accessing' } +PyramidElementToAddCategory >> factories: anObject [ + + factories := anObject +] + +{ #category : 'accessing' } +PyramidElementToAddCategory >> icon [ + + ^ icon +] + +{ #category : 'accessing' } +PyramidElementToAddCategory >> icon: anObject [ + + icon := anObject +] + +{ #category : 'as yet unclassified' } +PyramidElementToAddCategory >> makeProvider [ + + ^ + SpTablePresenter new + addColumn: ((SpImageTableColumn + title: 'Icon' + evaluated: [ :aFactory | aFactory elementIcon ]) + width: 50; + yourself); + addColumn: + (SpStringTableColumn title: 'Name' evaluated: #elementName); + items: self factories; + beResizable; + yourself +] + +{ #category : 'accessing' } +PyramidElementToAddCategory >> name [ + + ^ name +] + +{ #category : 'accessing' } +PyramidElementToAddCategory >> name: anObject [ + + name := anObject +] diff --git a/src/Pyramid-Bloc/PyramidElementToAddFactory.class.st b/src/Pyramid-Bloc/PyramidElementToAddFactory.class.st new file mode 100644 index 00000000..d604251d --- /dev/null +++ b/src/Pyramid-Bloc/PyramidElementToAddFactory.class.st @@ -0,0 +1,79 @@ +Class { + #name : 'PyramidElementToAddFactory', + #superclass : 'Object', + #instVars : [ + 'elementIcon', + 'elementName', + 'elementBlock' + ], + #category : 'Pyramid-Bloc-plugin-tree-library', + #package : 'Pyramid-Bloc', + #tag : 'plugin-tree-library' +} + +{ #category : 'comparing' } +PyramidElementToAddFactory >> <= aPyramidLibraryCategory [ + + ^ self elementName <= aPyramidLibraryCategory elementName +] + +{ #category : 'testing' } +PyramidElementToAddFactory >> canMakeNewElement [ + + [self elementBlock value] on: Error do: [ ^ false ]. + ^ true +] + +{ #category : 'accessing' } +PyramidElementToAddFactory >> elementBlock [ + + ^ elementBlock +] + +{ #category : 'accessing' } +PyramidElementToAddFactory >> elementBlock: anObject [ + + elementBlock := anObject +] + +{ #category : 'accessing' } +PyramidElementToAddFactory >> elementIcon [ + + ^ elementIcon +] + +{ #category : 'accessing' } +PyramidElementToAddFactory >> elementIcon: anObject [ + + elementIcon := anObject +] + +{ #category : 'accessing' } +PyramidElementToAddFactory >> elementName [ + + ^ elementName +] + +{ #category : 'accessing' } +PyramidElementToAddFactory >> elementName: anObject [ + + elementName := anObject +] + +{ #category : 'as yet unclassified' } +PyramidElementToAddFactory >> makeElement [ + + ^ self elementBlock value +] + +{ #category : 'as yet unclassified' } +PyramidElementToAddFactory >> makeForm [ + + | array | + array := self elementBlock value. + ^ BlElement new + size: 800 @ 600; + addChildren: array; + clipChildren: false; + asForm +] diff --git a/src/Pyramid-Bloc/PyramidElementToAddFactoryEmpty.class.st b/src/Pyramid-Bloc/PyramidElementToAddFactoryEmpty.class.st new file mode 100644 index 00000000..c7b87769 --- /dev/null +++ b/src/Pyramid-Bloc/PyramidElementToAddFactoryEmpty.class.st @@ -0,0 +1,19 @@ +Class { + #name : 'PyramidElementToAddFactoryEmpty', + #superclass : 'PyramidElementToAddFactory', + #category : 'Pyramid-Bloc-plugin-tree-library', + #package : 'Pyramid-Bloc', + #tag : 'plugin-tree-library' +} + +{ #category : 'testing' } +PyramidElementToAddFactoryEmpty >> canMakeNewElement [ + + ^ false +] + +{ #category : 'as yet unclassified' } +PyramidElementToAddFactoryEmpty >> makeForm [ + + ^ BlElement new asForm +] diff --git a/src/Pyramid-Bloc/PyramidElementToAddFactoryPresenter.class.st b/src/Pyramid-Bloc/PyramidElementToAddFactoryPresenter.class.st new file mode 100644 index 00000000..4ac37610 --- /dev/null +++ b/src/Pyramid-Bloc/PyramidElementToAddFactoryPresenter.class.st @@ -0,0 +1,128 @@ +Class { + #name : 'PyramidElementToAddFactoryPresenter', + #superclass : 'SpPresenter', + #instVars : [ + 'categoryPresenter', + 'factoryPresenter', + 'categories', + 'selectedCategory', + 'selectedFactory', + 'whenItemChangeDo' + ], + #category : 'Pyramid-Bloc-plugin-tree-library', + #package : 'Pyramid-Bloc', + #tag : 'plugin-tree-library' +} + +{ #category : 'accessing' } +PyramidElementToAddFactoryPresenter >> categories [ + + ^ categories +] + +{ #category : 'accessing' } +PyramidElementToAddFactoryPresenter >> categories: anObject [ + + categories := anObject. + self categoryPresenter items: anObject +] + +{ #category : 'accessing' } +PyramidElementToAddFactoryPresenter >> categoryPresenter [ + + ^ categoryPresenter +] + +{ #category : 'layout' } +PyramidElementToAddFactoryPresenter >> defaultLayout [ + + ^ SpPanedLayout newHorizontal add: self categoryPresenter; add: self factoryPresenter ; yourself. +] + +{ #category : 'accessing' } +PyramidElementToAddFactoryPresenter >> factoryPresenter [ + + ^ factoryPresenter +] + +{ #category : 'initialization - deprecated' } +PyramidElementToAddFactoryPresenter >> initialize [ + + super initialize. + whenItemChangeDo := [ :e | ]. + +] + +{ #category : 'initialization - deprecated' } +PyramidElementToAddFactoryPresenter >> initializePresenter [ + + whenItemChangeDo := [ :e | ]. + categoryPresenter := SpTablePresenter new + addColumn: ((SpImageTableColumn + title: 'Icon' + evaluated: [ :aCategory | aCategory icon ]) + width: 20; + yourself); + addColumn: + (SpStringTableColumn + title: 'Name' + evaluated: #name); + whenSelectedItemChangedDo: [ :category | + self selectedCategory: category ]; + beResizable; + yourself. + factoryPresenter := SpTablePresenter new + addColumn: ((SpImageTableColumn + title: 'Icon' + evaluated: [ :aFactory | + aFactory elementIcon ]) + width: 20; + yourself); + addColumn: + (SpStringTableColumn + title: 'Name' + evaluated: #elementName); + whenSelectedItemChangedDo: [ :factory | + self selectedFactory: factory ]; + beResizable; + yourself +] + +{ #category : 'accessing' } +PyramidElementToAddFactoryPresenter >> selectedCategory [ + + ^ selectedCategory +] + +{ #category : 'accessing' } +PyramidElementToAddFactoryPresenter >> selectedCategory: anObject [ + + selectedCategory := anObject. + anObject ifNil: [ ^ self ]. + self factoryPresenter items: anObject factories +] + +{ #category : 'accessing' } +PyramidElementToAddFactoryPresenter >> selectedFactory [ + + ^ selectedFactory +] + +{ #category : 'accessing' } +PyramidElementToAddFactoryPresenter >> selectedFactory: anObject [ + + selectedFactory := anObject. + self whenItemChangeDo value: anObject +] + +{ #category : 'accessing' } +PyramidElementToAddFactoryPresenter >> whenItemChangeDo [ + + ^ whenItemChangeDo +] + +{ #category : 'accessing' } +PyramidElementToAddFactoryPresenter >> whenItemChangeDo: anObject [ + + whenItemChangeDo := anObject +] diff --git a/src/Pyramid-Bloc/PyramidElementToAddModel.class.st b/src/Pyramid-Bloc/PyramidElementToAddModel.class.st new file mode 100644 index 00000000..4671c5ec --- /dev/null +++ b/src/Pyramid-Bloc/PyramidElementToAddModel.class.st @@ -0,0 +1,43 @@ +Class { + #name : 'PyramidElementToAddModel', + #superclass : 'Object', + #instVars : [ + 'categories' + ], + #category : 'Pyramid-Bloc-plugin-tree-library', + #package : 'Pyramid-Bloc', + #tag : 'plugin-tree-library' +} + +{ #category : 'as yet unclassified' } +PyramidElementToAddModel class >> defaultLibrary [ + + | library | + library := self new. + TPyramidElementToAdd users do: [ :class | class addOnLibrary: library ]. + ^ library +] + +{ #category : 'adding' } +PyramidElementToAddModel >> addCategoryWithName: aCategoryName withIcon: aCategoryIcon withAllFactories: aCollection [ + + | newCategory | + newCategory := PyramidElementToAddCategory new + name: aCategoryName; + icon: aCategoryIcon; + factories: aCollection; + yourself. + categories add: newCategory +] + +{ #category : 'initialization' } +PyramidElementToAddModel >> allCategories [ + + ^ categories +] + +{ #category : 'initialization' } +PyramidElementToAddModel >> initialize [ + + categories := OrderedCollection new. +] diff --git a/src/Pyramid-Bloc/PyramidElementToAddPresenter.class.st b/src/Pyramid-Bloc/PyramidElementToAddPresenter.class.st new file mode 100644 index 00000000..a99711ed --- /dev/null +++ b/src/Pyramid-Bloc/PyramidElementToAddPresenter.class.st @@ -0,0 +1,107 @@ +Class { + #name : 'PyramidElementToAddPresenter', + #superclass : 'SpPresenter', + #instVars : [ + 'selector', + 'preview', + 'addButton', + 'libraryModel', + 'currentFactory' + ], + #category : 'Pyramid-Bloc-plugin-tree-library', + #package : 'Pyramid-Bloc', + #tag : 'plugin-tree-library' +} + +{ #category : 'as yet unclassified' } +PyramidElementToAddPresenter class >> defaultEmptyFactory [ + + ^ PyramidElementToAddFactoryEmpty new +] + +{ #category : 'accessing' } +PyramidElementToAddPresenter >> addButton [ + + ^ addButton +] + +{ #category : 'accessing' } +PyramidElementToAddPresenter >> currentFactory [ + + currentFactory ifNil: [ currentFactory := self class defaultEmptyFactory ]. + ^ currentFactory +] + +{ #category : 'accessing' } +PyramidElementToAddPresenter >> currentFactory: anObject [ + + currentFactory := anObject. + self preview image: self currentFactory makeForm. + self addButton enabled: self currentFactory canMakeNewElement +] + +{ #category : 'layout' } +PyramidElementToAddPresenter >> defaultLayout [ + + ^ SpPanedLayout newHorizontal + add: self selector; + add: (SpBoxLayout newVertical + spacing: 4; + add: self preview expand: true; + add: self addButton expand: false; + yourself); + yourself +] + +{ #category : 'requirements' } +PyramidElementToAddPresenter >> elementToAdd [ + + ^ self currentFactory makeElement +] + +{ #category : 'initialization - deprecated' } +PyramidElementToAddPresenter >> initializePresenter [ + + addButton := SpButtonPresenter new + label: 'Add'; + icon: (Smalltalk ui icons iconNamed: #add); + enabled: false; + yourself. + selector := PyramidElementToAddFactoryPresenter new whenItemChangeDo: [ + :aFactory | self currentFactory: aFactory ]. + preview := SpImagePresenter new autoScale: true. + libraryModel := PyramidElementToAddModel defaultLibrary. + self refresh +] + +{ #category : 'accessing' } +PyramidElementToAddPresenter >> libraryModel [ + + ^ libraryModel +] + +{ #category : 'accessing' } +PyramidElementToAddPresenter >> libraryModel: anObject [ + + libraryModel := anObject. + self refresh +] + +{ #category : 'accessing' } +PyramidElementToAddPresenter >> preview [ + + ^ preview +] + +{ #category : 'accessing' } +PyramidElementToAddPresenter >> refresh [ + + self currentFactory: nil. + self selector categories: self libraryModel allCategories +] + +{ #category : 'accessing' } +PyramidElementToAddPresenter >> selector [ + + ^ selector +] diff --git a/src/Pyramid-Bloc/PyramidLibraryContainerPresenter.class.st b/src/Pyramid-Bloc/PyramidLibraryContainerPresenter.class.st new file mode 100644 index 00000000..63a0a79c --- /dev/null +++ b/src/Pyramid-Bloc/PyramidLibraryContainerPresenter.class.st @@ -0,0 +1,100 @@ +Class { + #name : 'PyramidLibraryContainerPresenter', + #superclass : 'SpPresenter', + #instVars : [ + 'library', + 'idGenerator' + ], + #classVars : [ + 'IdGenerator' + ], + #category : 'Pyramid-Bloc-plugin-tree-library', + #package : 'Pyramid-Bloc', + #tag : 'plugin-tree-library' +} + +{ #category : 'accessing' } +PyramidLibraryContainerPresenter class >> makeIdGenerator [ +^ Generator on: [ :generator | + | index | + index := 1. + [ + Character alphabet do: [ :each | + | next suffix | + next := each asUppercase asString. + suffix := index = 1 + ifTrue: [ '' ] + ifFalse: [ index asString ]. + generator yield: next , suffix ]. + index := index + 1 ] repeat ] +] + +{ #category : 'as yet unclassified' } +PyramidLibraryContainerPresenter >> buttonAction: aBlock [ + + library addButton action: aBlock +] + +{ #category : 'as yet unclassified' } +PyramidLibraryContainerPresenter >> buttonLabel: aString [ + + library addButton label: aString +] + +{ #category : 'initialization' } +PyramidLibraryContainerPresenter >> defaultLayout [ + + ^ SpBoxLayout newVertical + spacing: 4; + add: (SpLabelPresenter new + label: 'Library'; + displayBold: [ :a | true ]; + yourself) + expand: false; + add: (SpBoxLayout newHorizontal + add: library width: 800; + yourself) + height: 400; + yourself. +] + +{ #category : 'requirements' } +PyramidLibraryContainerPresenter >> elementToAdd [ + + | array | + array := self library elementToAdd. + array do: [:each | each id: self idGenerator next; yourself]. + ^ array +] + +{ #category : 'accessing' } +PyramidLibraryContainerPresenter >> idGenerator [ + + idGenerator ifNil: [ idGenerator := self class makeIdGenerator ]. + ^ idGenerator +] + +{ #category : 'accessing' } +PyramidLibraryContainerPresenter >> idGenerator: anObject [ + + idGenerator := anObject +] + +{ #category : 'initialization' } +PyramidLibraryContainerPresenter >> initializePresenters [ + + library := PyramidElementToAddPresenter new. + +] + +{ #category : 'requirements' } +PyramidLibraryContainerPresenter >> library [ + + ^ library +] + +{ #category : 'requirements' } +PyramidLibraryContainerPresenter >> library: aLibrary [ + + library := aLibrary +] diff --git a/src/Pyramid-Bloc/PyramidLibraryElement.class.st b/src/Pyramid-Bloc/PyramidLibraryElement.class.st deleted file mode 100644 index 0fb29044..00000000 --- a/src/Pyramid-Bloc/PyramidLibraryElement.class.st +++ /dev/null @@ -1,55 +0,0 @@ -Class { - #name : 'PyramidLibraryElement', - #superclass : 'Object', - #instVars : [ - 'title', - 'form', - 'blockMaker' - ], - #category : 'Pyramid-Bloc-plugin-tree-library', - #package : 'Pyramid-Bloc', - #tag : 'plugin-tree-library' -} - -{ #category : 'converting' } -PyramidLibraryElement >> asElement [ - - ^ self blockMaker value -] - -{ #category : 'accessing' } -PyramidLibraryElement >> blockMaker [ - - ^ blockMaker -] - -{ #category : 'accessing' } -PyramidLibraryElement >> blockMaker: anObject [ - - blockMaker := anObject. - form := blockMaker value exportAsForm -] - -{ #category : 'accessing' } -PyramidLibraryElement >> form [ - - ^ form -] - -{ #category : 'accessing' } -PyramidLibraryElement >> form: anObject [ - - form := anObject -] - -{ #category : 'accessing' } -PyramidLibraryElement >> title [ - - ^ title -] - -{ #category : 'accessing' } -PyramidLibraryElement >> title: anObject [ - - title := anObject -] diff --git a/src/Pyramid-Bloc/PyramidLibraryPresenter.class.st b/src/Pyramid-Bloc/PyramidLibraryPresenter.class.st deleted file mode 100644 index ea4f13b1..00000000 --- a/src/Pyramid-Bloc/PyramidLibraryPresenter.class.st +++ /dev/null @@ -1,161 +0,0 @@ -Class { - #name : 'PyramidLibraryPresenter', - #superclass : 'SpPresenter', - #instVars : [ - 'list', - 'preview', - 'editor', - 'addButton', - 'idGenerator' - ], - #classVars : [ - 'IdGenerator' - ], - #category : 'Pyramid-Bloc-plugin-tree-library', - #package : 'Pyramid-Bloc', - #tag : 'plugin-tree-library' -} - -{ #category : 'accessing' } -PyramidLibraryPresenter class >> makeIdGenerator [ -^ Generator on: [ :generator | - | index | - index := 1. - [ - Character alphabet do: [ :each | - | next suffix | - next := each asUppercase asString. - suffix := index = 1 - ifTrue: [ '' ] - ifFalse: [ index asString ]. - generator yield: next , suffix ]. - index := index + 1 ] repeat ] -] - -{ #category : 'initialization' } -PyramidLibraryPresenter >> addButton [ -^ addButton -] - -{ #category : 'as yet unclassified' } -PyramidLibraryPresenter >> buttonAction [ - - ^ self shouldBeImplemented -] - -{ #category : 'as yet unclassified' } -PyramidLibraryPresenter >> buttonLabel [ - - ^ self shouldBeImplemented -] - -{ #category : 'as yet unclassified' } -PyramidLibraryPresenter >> defaultItemsList [ - - ^ { - (PyramidLibraryElement new - title: 'Square with randomized color'; - blockMaker: [ - BlElement new - background: Color random; - id: self idGenerator next; - yourself ]; - yourself). - (PyramidLibraryElement new - title: 'Text'; - blockMaker: [ - 'text' asRopedText asElement - id: self idGenerator next; - yourself ]; - yourself) } -] - -{ #category : 'initialization' } -PyramidLibraryPresenter >> defaultLayout [ - - ^ SpBoxLayout newVertical - spacing: 4; - add: (SpLabelPresenter new - label: 'Library'; - displayBold: [ :a | true ]; - yourself); - add: (SpBoxLayout newHorizontal - spacing: 4; - add: self list width: 200; - add: (SpBoxLayout newVertical - spacing: 4; - add: self preview expand: true; - add: (SpBoxLayout newVertical - spacing: 4; - add: SpNullPresenter new expand: true; - add: (SpBoxLayout newHorizontal - spacing: 4; - add: self addButton; - yourself) - expand: false; - yourself) - expand: false; - yourself) - width: 300; - yourself); yourself -] - -{ #category : 'accessing' } -PyramidLibraryPresenter >> editor [ - ^ editor -] - -{ #category : 'accessing' } -PyramidLibraryPresenter >> editor: aPyramidEditor [ - - editor := aPyramidEditor -] - -{ #category : 'accessing' } -PyramidLibraryPresenter >> idGenerator [ - - idGenerator ifNil: [ idGenerator := self class makeIdGenerator ]. - ^ idGenerator -] - -{ #category : 'accessing' } -PyramidLibraryPresenter >> idGenerator: anObject [ - - idGenerator := anObject -] - -{ #category : 'initialization' } -PyramidLibraryPresenter >> initializePresenters [ - - addButton := SpButtonPresenter new - label: self buttonLabel; - action: [ self buttonAction ]; - yourself. - preview := SpImagePresenter new. - list := SpListPresenter new - beSingleSelection; - dragEnabled: true; - items: self defaultItemsList; - display: [ :each | each title ]; - whenSelectedDo: [ :element | - self updatePreviewWith: element ]; - selectFirst; - yourself -] - -{ #category : 'accessing' } -PyramidLibraryPresenter >> list [ - - ^ list -] - -{ #category : 'accessing' } -PyramidLibraryPresenter >> preview [ - ^ preview -] - -{ #category : 'as yet unclassified' } -PyramidLibraryPresenter >> updatePreviewWith: aLibraryElement [ - - self preview image: aLibraryElement form -] diff --git a/src/Pyramid-Bloc/PyramidLibraryPresenterForElement.class.st b/src/Pyramid-Bloc/PyramidLibraryPresenterForElement.class.st deleted file mode 100644 index f723e316..00000000 --- a/src/Pyramid-Bloc/PyramidLibraryPresenterForElement.class.st +++ /dev/null @@ -1,22 +0,0 @@ -Class { - #name : 'PyramidLibraryPresenterForElement', - #superclass : 'PyramidLibraryPresenter', - #category : 'Pyramid-Bloc-plugin-tree-library', - #package : 'Pyramid-Bloc', - #tag : 'plugin-tree-library' -} - -{ #category : 'as yet unclassified' } -PyramidLibraryPresenterForElement >> buttonAction [ - - self editor propertiesManager commandExecutor - use: PyramidAddChildCommand new - on: self editor projectModel selection - with: self list selectedItem blockMaker value -] - -{ #category : 'private' } -PyramidLibraryPresenterForElement >> buttonLabel [ - - ^ 'Add new child' -] diff --git a/src/Pyramid-Bloc/PyramidLibraryPresenterForFirstLevelElement.class.st b/src/Pyramid-Bloc/PyramidLibraryPresenterForFirstLevelElement.class.st deleted file mode 100644 index 6b10f393..00000000 --- a/src/Pyramid-Bloc/PyramidLibraryPresenterForFirstLevelElement.class.st +++ /dev/null @@ -1,22 +0,0 @@ -Class { - #name : 'PyramidLibraryPresenterForFirstLevelElement', - #superclass : 'PyramidLibraryPresenter', - #category : 'Pyramid-Bloc-plugin-tree-library', - #package : 'Pyramid-Bloc', - #tag : 'plugin-tree-library' -} - -{ #category : 'as yet unclassified' } -PyramidLibraryPresenterForFirstLevelElement >> buttonAction [ - - self editor propertiesManager commandExecutor - use: PyramidAddToCollectionCommand new - on: { self editor projectModel firstLevelElements } - with: self list selectedItem blockMaker value -] - -{ #category : 'private' } -PyramidLibraryPresenterForFirstLevelElement >> buttonLabel [ - - ^ 'Add new on first level' -] diff --git a/src/Pyramid-Bloc/PyramidRemoveChildrenCommand.class.st b/src/Pyramid-Bloc/PyramidRemoveChildrenCommand.class.st new file mode 100644 index 00000000..c6fd0c5b --- /dev/null +++ b/src/Pyramid-Bloc/PyramidRemoveChildrenCommand.class.st @@ -0,0 +1,19 @@ +Class { + #name : 'PyramidRemoveChildrenCommand', + #superclass : 'PyramidChildrenCommand', + #category : 'Pyramid-Bloc-plugin-bloc', + #package : 'Pyramid-Bloc', + #tag : 'plugin-bloc' +} + +{ #category : 'as yet unclassified' } +PyramidRemoveChildrenCommand >> commandInverse [ + + ^ PyramidAddChildrenCommand new +] + +{ #category : 'as yet unclassified' } +PyramidRemoveChildrenCommand >> setValueFor: aBlElement with: aChildrenToAdd [ + + aBlElement addChildren: aChildrenToAdd +] diff --git a/src/Pyramid-Bloc/PyramidTreePlugin.class.st b/src/Pyramid-Bloc/PyramidTreePlugin.class.st index fdae130b..44d6a20a 100644 --- a/src/Pyramid-Bloc/PyramidTreePlugin.class.st +++ b/src/Pyramid-Bloc/PyramidTreePlugin.class.st @@ -1,8 +1,8 @@ Class { #name : 'PyramidTreePlugin', #superclass : 'Object', - #traits : 'TPyramidPlugin', - #classTraits : 'TPyramidPlugin classTrait', + #traits : 'TPyramidPlugin + TPyramidElementToAdd', + #classTraits : 'TPyramidPlugin classTrait + TPyramidElementToAdd classTrait', #instVars : [ 'treePresenter', 'editor', @@ -17,6 +17,68 @@ Class { #tag : 'plugin-tree-library' } +{ #category : 'as yet unclassified' } +PyramidTreePlugin class >> addDefaultOnLibrary: library [ + + | factoryElement factoryTextElement | + + factoryElement := PyramidElementToAddFactory new + elementIcon: + (Smalltalk ui icons iconNamed: #class); + elementName: 'Simple Element'; + elementBlock: [ {BlElement new background: Color random; yourself} ]; + yourself. + factoryTextElement := PyramidElementToAddFactory new + elementIcon: + (Smalltalk ui icons iconNamed: #haloFontSize); + elementName: 'Simple Element'; + elementBlock: [ {BlTextElement new text: 'Change me' asRopedText; yourself} ]; + yourself. + + library + addCategoryWithName: '(Default)' + withIcon: (Smalltalk ui icons iconNamed: #box) + withAllFactories: { factoryElement . factoryTextElement } sorted. + + ^ library +] + +{ #category : 'adding' } +PyramidTreePlugin class >> addOnLibrary: aLibrary [ + + self addDefaultOnLibrary: aLibrary. + self addPystonOnLibrary: aLibrary +] + +{ #category : 'as yet unclassified' } +PyramidTreePlugin class >> addPystonOnLibrary: library [ + + | pragmas methods packages | + pragmas := Pragma allNamed: #pySTON. + methods := (pragmas collect: #method) asSet. + packages := (methods collect: #package) asSet. + + packages do: [ :package | + | factories | + factories := methods + select: [ :method | method package = package ] + thenCollect: [ :method | + PyramidElementToAddFactory new + elementIcon: (Smalltalk ui icons iconNamed: + method methodClass soleInstance systemIconName); + elementName: method selector; + elementBlock: [ + (method methodClass soleInstance perform: + method selector) materializeAsBlElement ]; + yourself ]. + library + addCategoryWithName: package name + withIcon: (Smalltalk ui icons iconNamed: #smallInfo) + withAllFactories: factories asArray sorted ]. + + ^ library +] + { #category : 'accessing' } PyramidTreePlugin class >> columnsBuildersClasses [ @@ -80,8 +142,6 @@ PyramidTreePlugin >> editor [ PyramidTreePlugin >> editor: aPyramidEditor [ editor := aPyramidEditor. - self libraryPresenterForElement editor: aPyramidEditor. - self libraryPresenterForRoot editor: aPyramidEditor. self treePresenter projectModel: aPyramidEditor projectModel. self treePresenter editorMenuBuilder: (self editor window services at: #selectionMenu) builder @@ -101,15 +161,35 @@ PyramidTreePlugin >> initialize [ PyramidTreePlugin >> initializeLibraryPresenters [ | idGenerator | - idGenerator := PyramidLibraryPresenter makeIdGenerator. - libraryPresenterForElement := PyramidLibraryPresenterForElement new - editor: self editor; + idGenerator := PyramidLibraryContainerPresenter makeIdGenerator. + libraryPresenterForElement := PyramidLibraryContainerPresenter new idGenerator: idGenerator; + library: PyramidElementToAddPresenter new; + buttonLabel: 'Add new child'; + buttonAction: [ + self editor propertiesManager + commandExecutor + use: PyramidAddChildrenCommand new + on: + self editor projectModel selection + with: + libraryPresenterForElement + elementToAdd ]; yourself. - libraryPresenterForRoot := PyramidLibraryPresenterForFirstLevelElement - new - editor: self editor; + libraryPresenterForRoot := PyramidLibraryContainerPresenter new idGenerator: idGenerator; + library: PyramidElementToAddPresenter new; + buttonLabel: 'Add new on first level'; + buttonAction: [ + self editor propertiesManager + commandExecutor + use: + PyramidAddAllToCollectionCommand new + on: + { self editor projectModel + firstLevelElements } + with: + libraryPresenterForRoot elementToAdd ]; yourself ] diff --git a/src/Pyramid-Bloc/TPyramidElementToAdd.trait.st b/src/Pyramid-Bloc/TPyramidElementToAdd.trait.st new file mode 100644 index 00000000..90761470 --- /dev/null +++ b/src/Pyramid-Bloc/TPyramidElementToAdd.trait.st @@ -0,0 +1,12 @@ +Trait { + #name : 'TPyramidElementToAdd', + #category : 'Pyramid-Bloc-plugin-tree-library', + #package : 'Pyramid-Bloc', + #tag : 'plugin-tree-library' +} + +{ #category : 'adding' } +TPyramidElementToAdd classSide >> addOnLibrary: aLibrary [ + + self shouldBeImplemented +] diff --git a/src/Pyramid-Tests/PyramidLibraryPresenterTest.class.st b/src/Pyramid-Tests/PyramidLibraryPresenterTest.class.st index aaadd2e3..bf8be69c 100644 --- a/src/Pyramid-Tests/PyramidLibraryPresenterTest.class.st +++ b/src/Pyramid-Tests/PyramidLibraryPresenterTest.class.st @@ -10,19 +10,34 @@ Class { PyramidLibraryPresenterTest >> testIdGenerator [ "We generate a bunch of id and we verify that none are the same" - | treePlugin libraryPresForElements libraryPresForFirstLevel elements | + | treePlugin libraryPresForElements libraryPresForFirstLevel elementIds | treePlugin := PyramidTreePlugin new. libraryPresForElements := treePlugin libraryPresenterForElement. libraryPresForFirstLevel := treePlugin libraryPresenterForRoot. - elements := Bag new. + libraryPresForElements library currentFactory: + (PyramidElementToAddFactory new + elementBlock: [ + { + BlElement new. + BlElement new } ]; + yourself). + libraryPresForFirstLevel library currentFactory: + (PyramidElementToAddFactory new + elementBlock: [ + { + BlElement new. + BlElement new } ]; + yourself). + + elementIds := Bag new. 1 to: 100 do: [ :i | - elements add: - libraryPresForElements list selectedItem blockMaker value id - asSymbol ]. + elementIds addAll: + (libraryPresForElements elementToAdd collect: [ :each | + each id asSymbol ]) ]. 1 to: 100 do: [ :i | - elements add: - libraryPresForFirstLevel list selectedItem blockMaker value id - asSymbol ]. - self assert: elements size equals: 200. - self assert: elements asSet size equals: 200 + elementIds addAll: + (libraryPresForFirstLevel elementToAdd collect: [ :each | + each id asSymbol ]) ]. + self assert: elementIds size equals: 400. + self assert: elementIds asSet size equals: 400. ] diff --git a/src/Pyramid-Tests/PyramidPluginTestModeTest.class.st b/src/Pyramid-Tests/PyramidPluginTestModeTest.class.st index 05664c3d..8deceb1d 100644 --- a/src/Pyramid-Tests/PyramidPluginTestModeTest.class.st +++ b/src/Pyramid-Tests/PyramidPluginTestModeTest.class.st @@ -10,74 +10,3 @@ Class { #package : 'Pyramid-Tests', #tag : 'cases-plugin-testmode' } - -{ #category : 'accessing' } -PyramidPluginTestModeTest >> editor [ -^ editor -] - -{ #category : 'accessing' } -PyramidPluginTestModeTest >> plugin [ - - ^ plugin -] - -{ #category : 'running' } -PyramidPluginTestModeTest >> setUp [ - - super setUp. - - plugin := PyramidPluginTestMode new. - spacePlugin := PyramidSpacePlugin new. - editor := PyramidEditorBuilder new plugins: { plugin . spacePlugin }; build. -] - -{ #category : 'tests' } -PyramidPluginTestModeTest >> testIsTestOnGoing [ - - self assert: self plugin isTestOnGoing not. - self plugin switchToTestMode. - self assert: self plugin isTestOnGoing. - self plugin switchToTestMode. - self assert: self plugin isTestOnGoing not. -] - -{ #category : 'tests' } -PyramidPluginTestModeTest >> testSwitchToTestMode [ - - | element elementThatReceiveEvent | - element := BlElement new - size: 500 asPoint; - background: Color blue; - addEventHandler: (BlEventHandler - on: BlPrimaryClickEvent - do: [ :evt | ]); - yourself. - self plugin elementAtEvents addEventHandler: (BlEventHandler - on: BlPrimaryClickEvent - do: [ :evt | ]). - self editor projectModel firstLevelElements add: element. - - self plugin elementAtMain forceLayout. - elementThatReceiveEvent := self plugin elementAtMain - findMouseEventTargetAt: - 10 asPoint - + self plugin currentTransformTranslation. - self deny: elementThatReceiveEvent equals: element. - - self plugin switchToTestMode. - self plugin elementAtMain forceLayout. - elementThatReceiveEvent := self plugin elementAtMain - findMouseEventTargetAt: - 10 asPoint - + self plugin currentTransformTranslation. - self assert: elementThatReceiveEvent equals: element. - - self plugin switchToTestMode. - self plugin elementAtMain forceLayout. - elementThatReceiveEvent := self plugin elementAtMain - findMouseEventTargetAt: - 10 asPoint - + self plugin currentTransformTranslation. - self deny: elementThatReceiveEvent equals: element -] diff --git a/src/Pyramid-Tests/PyramidProjectModelObserverForTest.class.st b/src/Pyramid-Tests/PyramidProjectModelObserverForTest.class.st index 2cf56e00..c66b29f2 100644 --- a/src/Pyramid-Tests/PyramidProjectModelObserverForTest.class.st +++ b/src/Pyramid-Tests/PyramidProjectModelObserverForTest.class.st @@ -11,12 +11,12 @@ Class { #tag : 'cases-models' } -{ #category : 'initialization' } +{ #category : 'accessing' } PyramidProjectModelObserverForTest >> initialize [ - self pyramidElementsChangedAction: [ :evt | ]. - self pyramidFirstLevelElementsChangedAction: [ :evt | ]. - self pyramidSelectionChangedAction: [ :evt | ] + self pyramidElementsChangedAction: [ :evt | ]. + self pyramidFirstLevelElementsChangedAction: [ :evt | ]. + self pyramidSelectionChangedAction: [ :evt | ] ] { #category : 'accessing' } @@ -37,12 +37,18 @@ PyramidProjectModelObserverForTest >> projectModel: aProjectModel [ ] { #category : 'as yet unclassified' } +PyramidProjectModelObserverForTest >> pyramidElementsChanged [ + + self pyramidElementsChangedAction value. +] + +{ #category : 'accessing' } PyramidProjectModelObserverForTest >> pyramidElementsChanged: anEvent [ self pyramidElementsChangedAction value: anEvent ] -{ #category : 'as yet unclassified' } +{ #category : 'accessing' } PyramidProjectModelObserverForTest >> pyramidElementsChangedAction [ ^ pyramidElementsChangedAction @@ -55,6 +61,12 @@ PyramidProjectModelObserverForTest >> pyramidElementsChangedAction: anObject [ ] { #category : 'as yet unclassified' } +PyramidProjectModelObserverForTest >> pyramidFirstLevelElementsChanged [ + + self pyramidFirstLevelElementsChangedAction value +] + +{ #category : 'accessing' } PyramidProjectModelObserverForTest >> pyramidFirstLevelElementsChanged: anEvent [ self pyramidFirstLevelElementsChangedAction value: anEvent @@ -73,6 +85,12 @@ PyramidProjectModelObserverForTest >> pyramidFirstLevelElementsChangedAction: an ] { #category : 'as yet unclassified' } +PyramidProjectModelObserverForTest >> pyramidSelectionChanged [ + + self pyramidSelectionChangedAction value +] + +{ #category : 'accessing' } PyramidProjectModelObserverForTest >> pyramidSelectionChanged: anEvent [ self pyramidSelectionChangedAction value: anEvent diff --git a/src/Pyramid-Tests/PyramidProjectModelTest.class.st b/src/Pyramid-Tests/PyramidProjectModelTest.class.st index 4539877e..75457f83 100644 --- a/src/Pyramid-Tests/PyramidProjectModelTest.class.st +++ b/src/Pyramid-Tests/PyramidProjectModelTest.class.st @@ -80,9 +80,17 @@ PyramidProjectModelTest >> setUp [ observer := PyramidProjectModelObserverForTest new. observer projectModel: projectModel. - - projectModel firstLevelElements addAll: { BlElement new. BlElement new. BlElement new. BlElement new}. - projectModel selection addAll: { BlElement new. BlElement new. BlElement new. BlElement new}. + + projectModel firstLevelElements addAll: { + BlElement new. + BlElement new. + BlElement new. + BlElement new }. + projectModel selection addAll: { + BlElement new. + BlElement new. + BlElement new. + BlElement new }. pyramidElementsChanged := false. pyramidFirstLevelElementsChanged := false. diff --git a/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st b/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st index f3052608..c54d95ba 100644 --- a/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st +++ b/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st @@ -1,8 +1,8 @@ Class { #name : 'PyramidToploThemePlugin', #superclass : 'Object', - #traits : 'TPyramidPlugin', - #classTraits : 'TPyramidPlugin classTrait', + #traits : 'TPyramidPlugin + TPyramidElementToAdd', + #classTraits : 'TPyramidPlugin classTrait + TPyramidElementToAdd classTrait', #instVars : [ 'themePresenter', 'themePropertyManager' @@ -12,6 +12,27 @@ Class { #tag : 'plugin-theme-management' } +{ #category : 'adding' } +PyramidToploThemePlugin class >> addOnLibrary: aLibrary [ + + | classes factories | + classes := ToElement allSubclasses. + factories := classes + reject: [ :each | each isAbstract ] + thenCollect: [ :class | + PyramidElementToAddFactory new + elementIcon: + (Smalltalk ui icons iconNamed: class systemIconName); + elementName: class name; + elementBlock: [ { class new } ]; + yourself ]. + + aLibrary + addCategoryWithName: 'Toplo' + withIcon: (Smalltalk ui icons iconNamed: #smallInfo) + withAllFactories: factories asArray sorted. +] + { #category : 'asserting' } PyramidToploThemePlugin class >> shouldInstall [ diff --git a/src/Pyramid/PyramidAddAllToCollectionCommand.class.st b/src/Pyramid/PyramidAddAllToCollectionCommand.class.st new file mode 100644 index 00000000..b6a14472 --- /dev/null +++ b/src/Pyramid/PyramidAddAllToCollectionCommand.class.st @@ -0,0 +1,25 @@ +Class { + #name : 'PyramidAddAllToCollectionCommand', + #superclass : 'PyramidCollectionCommand', + #category : 'Pyramid-commands', + #package : 'Pyramid', + #tag : 'commands' +} + +{ #category : 'as yet unclassified' } +PyramidAddAllToCollectionCommand >> commandInverse [ + + ^ PyramidRemoveAllFromCollectionCommand new +] + +{ #category : 'as yet unclassified' } +PyramidAddAllToCollectionCommand >> getValueFor: anObject [ + + ^ nil +] + +{ #category : 'as yet unclassified' } +PyramidAddAllToCollectionCommand >> setValueFor: anObject with: anArgument [ + + anObject addAll: anArgument +] diff --git a/src/Pyramid/PyramidRemoveAllFromCollectionCommand.class.st b/src/Pyramid/PyramidRemoveAllFromCollectionCommand.class.st new file mode 100644 index 00000000..f806ede2 --- /dev/null +++ b/src/Pyramid/PyramidRemoveAllFromCollectionCommand.class.st @@ -0,0 +1,25 @@ +Class { + #name : 'PyramidRemoveAllFromCollectionCommand', + #superclass : 'PyramidCollectionCommand', + #category : 'Pyramid-commands', + #package : 'Pyramid', + #tag : 'commands' +} + +{ #category : 'as yet unclassified' } +PyramidRemoveAllFromCollectionCommand >> commandInverse [ + + ^ PyramidAddAllToCollectionCommand new +] + +{ #category : 'as yet unclassified' } +PyramidRemoveAllFromCollectionCommand >> getValueFor: anObject [ + + ^ nil +] + +{ #category : 'as yet unclassified' } +PyramidRemoveAllFromCollectionCommand >> setValueFor: anObject with: anArgument [ + + anObject removeAll: anArgument +] diff --git a/src/Pyramid/PyramidSpCodeObjectInteractionModel.class.st b/src/Pyramid/PyramidSpCodeObjectInteractionModel.class.st index d43ed647..7f132ae8 100644 --- a/src/Pyramid/PyramidSpCodeObjectInteractionModel.class.st +++ b/src/Pyramid/PyramidSpCodeObjectInteractionModel.class.st @@ -12,31 +12,38 @@ Class { { #category : 'accessing' } PyramidSpCodeObjectInteractionModel >> doItReceiver [ - self projectModel selection ifEmpty: [ ^ self projectModel firstLevelElements ]. - self projectModel selection size = 1 ifTrue: [ ^self projectModel selection first ]. + self projectModel selection ifEmpty: [ + ^ self projectModel firstLevelElements ]. + self projectModel selection size = 1 ifTrue: [ + ^ self projectModel selection first ]. ^ self projectModel selection asArray ] { #category : 'as yet unclassified' } PyramidSpCodeObjectInteractionModel >> doItReceiverString [ - self projectModel selection ifEmpty: [ ^ 'the collection of first level elements' ]. + self projectModel selection ifEmpty: [ + ^ 'the collection of first level elements' ]. self projectModel selection size = 1 ifTrue: [ ^ 'the selected element' ]. ^ 'an array of <1p> selected elements' expandMacrosWith: self projectModel selection size ] +{ #category : 'as yet unclassified' } +PyramidSpCodeObjectInteractionModel >> isScripting [ + + ^ true +] + { #category : 'accessing' } PyramidSpCodeObjectInteractionModel >> projectModel [ ^ projectModel - ] { #category : 'accessing' } -PyramidSpCodeObjectInteractionModel >> projectModel: aProjectModel [ - - projectModel := aProjectModel. +PyramidSpCodeObjectInteractionModel >> projectModel: anObject [ + projectModel := anObject ] diff --git a/src/Pyramid/PyramidStonLoader.class.st b/src/Pyramid/PyramidStonLoader.class.st new file mode 100644 index 00000000..6c5ad9bc --- /dev/null +++ b/src/Pyramid/PyramidStonLoader.class.st @@ -0,0 +1,13 @@ +Class { + #name : 'PyramidStonLoader', + #superclass : 'Object', + #category : 'Pyramid-external-ressources', + #package : 'Pyramid', + #tag : 'external-ressources' +} + +{ #category : 'as yet unclassified' } +PyramidStonLoader class >> loadClass: aClass selector: aSelector [ + + ^ (aClass perform: aSelector) materializeAsBlElement +]