diff --git a/src/Pyramid-Bloc/PyramidMainExtension.class.st b/src/Pyramid-Bloc/PyramidMainExtension.class.st index e91a2d4e..4c8722ac 100644 --- a/src/Pyramid-Bloc/PyramidMainExtension.class.st +++ b/src/Pyramid-Bloc/PyramidMainExtension.class.st @@ -78,7 +78,8 @@ PyramidMainExtension >> initialize [ yourself); add: (PyramidPointInputPresenter new value: self defaultExtent; - whenValueChangedDo: [ :point | self extent: point ]; + whenValueChangedDo: [ :point | + self extent: point ]; yourself); yourself); yourself. @@ -95,6 +96,7 @@ PyramidMainExtension >> initialize [ containerElement := BlElement new + id: #MainExtension_containerElement; constraintsDo: [ :c | c vertical matchParent. c horizontal matchParent ]; @@ -102,6 +104,7 @@ PyramidMainExtension >> initialize [ zIndex: 0; yourself. borderElement := BlElement new + id: #MainExtension_borderElement; border: self defaultBorder; outskirts: BlOutskirts outside; constraintsDo: [ :c | @@ -109,8 +112,10 @@ PyramidMainExtension >> initialize [ c horizontal matchParent ]; clipChildren: false; zIndex: 1; + preventMeAndChildrenMouseEvents; yourself. sizeElement := BlElement new + id: #MainExtension_sizeElement; size: self defaultExtent; clipChildren: false; addChildren: { diff --git a/src/Pyramid-Bloc/PyramidMenuExtension.class.st b/src/Pyramid-Bloc/PyramidMenuExtension.class.st index a3923c5b..3c211208 100644 --- a/src/Pyramid-Bloc/PyramidMenuExtension.class.st +++ b/src/Pyramid-Bloc/PyramidMenuExtension.class.st @@ -30,11 +30,11 @@ PyramidMenuExtension >> installOn: aBuilder [ self builder: aBuilder. - self elementAtDisplay background: Color gray. + self elementAtDisplays background: Color gray. - self elementAtEvents - when: BlSecondaryMouseUpEvent - do: [ :evt | self showMenuAt: evt ] + self elementAtEvents addEventHandler: (BlEventHandler + on: BlSecondaryMouseUpEvent + do: [ :evt | self showMenuAt: evt ]) ] { #category : #accessing } @@ -73,9 +73,9 @@ PyramidMenuExtension >> showMenuAt: anEvent [ chooseColorSubMenu addItem: [ :item | item name: color printString; - action: [ self elementAtDisplay background: color ]; + action: [ self elementAtDisplays background: color ]; icon: [ - self elementAtDisplay background paint color = color + self elementAtDisplays background paint color = color ifTrue: [ self iconNamed: #testGreen ] ifFalse: [ self iconNamed: #testNotRun ] ] ] ]. diff --git a/src/Pyramid-Bloc/PyramidMouseTransformExtension.class.st b/src/Pyramid-Bloc/PyramidMouseTransformExtension.class.st index 27799086..12c22af5 100644 --- a/src/Pyramid-Bloc/PyramidMouseTransformExtension.class.st +++ b/src/Pyramid-Bloc/PyramidMouseTransformExtension.class.st @@ -22,19 +22,23 @@ PyramidMouseTransformExtension >> installOn: aBuilder [ self builder: aBuilder. - self elementAtEvents when: BlMiddleMouseDownEvent do: [ :evt | - self origin: self currentTransformTranslation - evt position. - self isDragging: true ]. - - self elementAtEvents when: BlMouseMoveEvent do: [ :evt | - evt middleButtonPressed ifFalse: [ self isDragging: false ]. - self isDragging ifTrue: [ - self elementAtTransforms transformDo: [ :t | - t translateBy: evt position + self origin ]. - self builder signalTransformationChanged ] ]. - self elementAtEvents - when: BlMiddleMouseUpEvent - do: [ :evt | self isDragging: false ] + self elementAtEvents addEventHandler: (BlEventHandler + on: BlMiddleMouseDownEvent + do: [ :evt | + self origin: self currentTransformTranslation - evt position. + self isDragging: true ]). + + self elementAtEvents addEventHandler: (BlEventHandler + on: BlMouseMoveEvent + do: [ :evt | + evt middleButtonPressed ifFalse: [ self isDragging: false ]. + self isDragging ifTrue: [ + self elementAtTransforms transformDo: [ :t | + t translateBy: evt position + self origin ]. + self builder signalTransformationChanged ] ]). + self elementAtEvents addEventHandler: (BlEventHandler + on: BlMiddleMouseUpEvent + do: [ :evt | self isDragging: false ]) ] { #category : #accessing } diff --git a/src/Pyramid-Bloc/PyramidPluginTestMode.class.st b/src/Pyramid-Bloc/PyramidPluginTestMode.class.st new file mode 100644 index 00000000..37adba69 --- /dev/null +++ b/src/Pyramid-Bloc/PyramidPluginTestMode.class.st @@ -0,0 +1,113 @@ +Class { + #name : #PyramidPluginTestMode, + #superclass : #Object, + #traits : 'TPyramidPlugin + TPyramidEditorExtension', + #classTraits : 'TPyramidPlugin classTrait + TPyramidEditorExtension classTrait', + #instVars : [ + 'button', + 'spacePlugin', + 'isTestOnGoing', + 'builder' + ], + #category : #'Pyramid-Bloc-plugin-testmode' +} + +{ #category : #adding } +PyramidPluginTestMode >> addPanelsOn: aPyramidSimpleWindow [ + + aPyramidSimpleWindow + at: #topRight + addItem: [ :builder | + builder makeButtonWithIcon: self button order: 0 ]. +] + +{ #category : #'as yet unclassified' } +PyramidPluginTestMode >> builder [ + + ^ builder +] + +{ #category : #actions } +PyramidPluginTestMode >> button [ + + ^ button +] + +{ #category : #connecting } +PyramidPluginTestMode >> connectOn: aPyramidEditor [ + + spacePlugin := aPyramidEditor plugins + detect: [ :p | p isKindOf: PyramidSpacePlugin ] + ifNone: [ ]. + + spacePlugin ifNotNil: [ builder := spacePlugin builder ] + +] + +{ #category : #actions } +PyramidPluginTestMode >> initialize [ + + isTestOnGoing := false. + button := SpButtonPresenter new + icon: self startTestIcon; + help: 'Switch between test/edit mode.'; + action: [ self switchToTestMode ]; + yourself +] + +{ #category : #accessing } +PyramidPluginTestMode >> isTestOnGoing [ + ^ isTestOnGoing +] + +{ #category : #accessing } +PyramidPluginTestMode >> isTestOnGoing: aBoolean [ + + isTestOnGoing := aBoolean +] + +{ #category : #'as yet unclassified' } +PyramidPluginTestMode >> startTestIcon [ + + ^ self iconNamed: #smallDoIt +] + +{ #category : #'as yet unclassified' } +PyramidPluginTestMode >> stopTestIcon [ + + ^ self iconNamed: #stop +] + +{ #category : #actions } +PyramidPluginTestMode >> switchToTestMode [ + " + if test ok + 0. isTestOnGoing: false. + 1. event element visibility: visible. + 2. displayAddons element visibility: visible. + if test nok + 0. isTestOnGoing: true. + 1. event element visibility: gone. + 2. displayAddons element visibility: gone." + + | event displayPosition | + self builder ifNil: [ + self flag: + 'If builder is nil then there is no space plugin loaded on current Pyramid instance.'. + self inform: + 'No space plugin found. Please reload the Pyramid plugins on WorldMenu.'. + ^ self ]. + event := self elementAtEvents. + displayPosition := self elementAtDisplaysAddons. + self isTestOnGoing + ifTrue: [ + self isTestOnGoing: false. + self button icon: self startTestIcon. + event visibility: BlVisibility visible. + displayPosition visibility: BlVisibility visible ] + ifFalse: [ + self isTestOnGoing: true. + self button icon: self stopTestIcon. + event visibility: BlVisibility gone. + displayPosition visibility: BlVisibility gone ] +] diff --git a/src/Pyramid-Bloc/PyramidPositionExtension.class.st b/src/Pyramid-Bloc/PyramidPositionExtension.class.st index e4871789..51d75b9e 100644 --- a/src/Pyramid-Bloc/PyramidPositionExtension.class.st +++ b/src/Pyramid-Bloc/PyramidPositionExtension.class.st @@ -30,8 +30,10 @@ PyramidPositionExtension >> installOn: aBuilder [ self builder: aBuilder. - self elementAtEvents when: BlMouseMoveEvent do: [ :evt | - self display text: - (evt position - self currentTransformTranslation) asRopedText ]. - self elementAtDisplay addChild: self display. + self elementAtEvents addEventHandler: (BlEventHandler + on: BlMouseMoveEvent + do: [ :evt | + self display text: + (evt position - self currentTransformTranslation) asRopedText ]). + self elementAtDisplaysAddons addChild: self display ] diff --git a/src/Pyramid-Bloc/PyramidSelectionMakerExtension.class.st b/src/Pyramid-Bloc/PyramidSelectionMakerExtension.class.st index 79289cfa..83cdf240 100644 --- a/src/Pyramid-Bloc/PyramidSelectionMakerExtension.class.st +++ b/src/Pyramid-Bloc/PyramidSelectionMakerExtension.class.st @@ -120,23 +120,24 @@ PyramidSelectionMakerExtension >> installOn: aBuilder [ self builder: aBuilder. - self elementAtDisplay addChild: self selectionGhost. - self elementAtEvents - when: BlPrimaryMouseDownEvent - do: [ :evt | self dragStart: evt ]. - self elementAtEvents - when: BlSecondaryMouseDownEvent - do: [ :evt | self dragStart: evt ]. - - self elementAtEvents - when: BlMouseMoveEvent - do: [ :evt | self dragEvent: evt ]. - - self elementAtEvents - when: BlPrimaryMouseUpEvent - do: [ :evt | self dragEnd: evt ]. - self elementAtEvents when: BlSecondaryMouseUpEvent do: [ :evt | - self dragEnd: evt ] + self elementAtDisplaysAddons addChild: self selectionGhost. + self elementAtEvents addEventHandler: (BlEventHandler + on: BlPrimaryMouseDownEvent + do: [ :evt | self dragStart: evt ]). + self elementAtEvents addEventHandler: (BlEventHandler + on: BlSecondaryMouseDownEvent + do: [ :evt | self dragStart: evt ]). + + self elementAtEvents addEventHandler: (BlEventHandler + on: BlMouseMoveEvent + do: [ :evt | self dragEvent: evt ]). + + self elementAtEvents addEventHandler: (BlEventHandler + on: BlPrimaryMouseUpEvent + do: [ :evt | self dragEnd: evt ]). + self elementAtEvents addEventHandler: (BlEventHandler + on: BlSecondaryMouseUpEvent + do: [ :evt | self dragEnd: evt ]) ] { #category : #accessing } diff --git a/src/Pyramid-Bloc/PyramidSelectionWidgetBorderBuilder.class.st b/src/Pyramid-Bloc/PyramidSelectionWidgetBorderBuilder.class.st index 9c015116..2c844fb7 100644 --- a/src/Pyramid-Bloc/PyramidSelectionWidgetBorderBuilder.class.st +++ b/src/Pyramid-Bloc/PyramidSelectionWidgetBorderBuilder.class.st @@ -90,12 +90,14 @@ PyramidSelectionWidgetBorderBuilder >> leftLabelFor: aBlElement [ label := self labelWithColor: self mainLeftColor. label transformDo: [ :t | t rotateBy: -90 ]. - aBlElement when: BlElementExtentChangedEvent do: [ :evt | - label text: (aBlElement height < 50 - ifTrue: [ '' asRopedText ] - ifFalse: [ aBlElement height printString asRopedText ]). - label requestLayout. - label position: -22 @ (aBlElement height - 20 / 2) ]. + aBlElement addEventHandler: (BlEventHandler + on: BlElementExtentChangedEvent + do: [ :evt | + label text: (aBlElement height < 50 + ifTrue: [ '' asRopedText ] + ifFalse: [ aBlElement height printString asRopedText ]). + label requestLayout. + label position: -22 @ (aBlElement height - 20 / 2) ]). ^ label ] @@ -167,11 +169,13 @@ PyramidSelectionWidgetBorderBuilder >> topLabelFor: aBlElement [ | label | label := self labelWithColor: self mainTopColor. - aBlElement when: BlElementExtentChangedEvent do: [ :evt | - label text: (aBlElement width < 50 - ifTrue: [ '' asRopedText ] - ifFalse: [ aBlElement width printString asRopedText ]). - label requestLayout. - label position: aBlElement width - 20 / 2 @ -13 ]. + aBlElement addEventHandler: (BlEventHandler + on: BlElementExtentChangedEvent + do: [ :evt | + label text: (aBlElement width < 50 + ifTrue: [ '' asRopedText ] + ifFalse: [ aBlElement width printString asRopedText ]). + label requestLayout. + label position: aBlElement width - 20 / 2 @ -13 ]). ^ label ] diff --git a/src/Pyramid-Bloc/PyramidSelectionWidgetExtension.class.st b/src/Pyramid-Bloc/PyramidSelectionWidgetExtension.class.st index a1f4faff..43026412 100644 --- a/src/Pyramid-Bloc/PyramidSelectionWidgetExtension.class.st +++ b/src/Pyramid-Bloc/PyramidSelectionWidgetExtension.class.st @@ -127,7 +127,7 @@ PyramidSelectionWidgetExtension >> isDragging: anObject [ PyramidSelectionWidgetExtension >> makeMonoSelectionFor: aBlElement [ | monoSelection eventElement dragGhostElement borderElement | - monoSelection := (BlOverlayElement on: aBlElement). + monoSelection := BlOverlayElement on: aBlElement. monoSelection clipChildren: false. dragGhostElement := BlElement new @@ -145,12 +145,15 @@ PyramidSelectionWidgetExtension >> makeMonoSelectionFor: aBlElement [ c vertical matchParent. c horizontal matchParent ]; zIndex: 100; - when: BlPrimaryMouseDownEvent - do: [ :evt | self centerDragStart: evt ]; - when: BlMouseEvent - do: [ :evt | self centerDragEvent: evt ]; - when: BlPrimaryMouseUpEvent - do: [ :evt | self centerDragEnd: evt ]; + addEventHandler: (BlEventHandler + on: BlPrimaryMouseDownEvent + do: [ :evt | self centerDragStart: evt ]); + addEventHandler: (BlEventHandler + on: BlMouseEvent + do: [ :evt | self centerDragEvent: evt ]); + addEventHandler: (BlEventHandler + on: BlPrimaryMouseUpEvent + do: [ :evt | self centerDragEnd: evt ]); yourself. borderElement := PyramidSelectionWidgetBorderBuilder new build. diff --git a/src/Pyramid-Bloc/PyramidSpaceBuilder.class.st b/src/Pyramid-Bloc/PyramidSpaceBuilder.class.st index edfb5595..fe49da82 100644 --- a/src/Pyramid-Bloc/PyramidSpaceBuilder.class.st +++ b/src/Pyramid-Bloc/PyramidSpaceBuilder.class.st @@ -31,6 +31,7 @@ PyramidSpaceBuilder class >> defaultEditorBuilder [ { #displays. #transforms. #main. #events. #widgets }; yourself. + (builder overlays at: #displays) element addChild: (BlElement new id: #displaysAddons; clipChildren: false; yourself). self defaultEditorExtensions do: [ :class | builder addExtension: class new ]. @@ -93,12 +94,12 @@ PyramidSpaceBuilder >> build [ self overlays ifEmpty: [ ^ self space ]. - self space - when: BlKeyDownEvent - do: [ :evt | self keyboard add: evt key ]. - self space - when: BlKeyUpEvent - do: [ :evt | self keyboard remove: evt key ]. + self space addEventHandler: (BlEventHandler + on: BlKeyDownEvent + do: [ :evt | self keyboard add: evt key ]). + self space addEventHandler: (BlEventHandler + on: BlKeyUpEvent + do: [ :evt | self keyboard remove: evt key ]). self signalTransformationChanged. self topMostOverlay buildOn: self space root. diff --git a/src/Pyramid-Bloc/PyramidSpaceContainer.class.st b/src/Pyramid-Bloc/PyramidSpaceContainer.class.st index 39e964f0..3cd2a410 100644 --- a/src/Pyramid-Bloc/PyramidSpaceContainer.class.st +++ b/src/Pyramid-Bloc/PyramidSpaceContainer.class.st @@ -29,5 +29,8 @@ PyramidSpaceContainer >> element: anObject [ { #category : #initialization } PyramidSpaceContainer >> initialize [ - element := BlElement new constraintsDo: [ :c | c vertical matchParent . c horizontal matchParent ]; clipChildren: false; yourself + element := (BlElement id: (self class name asSymbol)) + constraintsDo: [ :c | c vertical matchParent. c horizontal matchParent ]; + clipChildren: false; + yourself ] diff --git a/src/Pyramid-Bloc/PyramidSpacePlugin.class.st b/src/Pyramid-Bloc/PyramidSpacePlugin.class.st index ee8ba982..13307fd3 100644 --- a/src/Pyramid-Bloc/PyramidSpacePlugin.class.st +++ b/src/Pyramid-Bloc/PyramidSpacePlugin.class.st @@ -60,8 +60,9 @@ PyramidSpacePlugin >> makePresenterWithBlSpace: aBlSpace [ host containerMorph: morph. aBlSpace host: host. - aBlSpace when: BlSpaceDestroyedEvent do: [ :evt | - self updateMorphInCaseOfFaillure: morph ]. + aBlSpace addEventHandler: (BlEventHandler + on: BlSpaceDestroyedEvent + do: [ :evt | self updateMorphInCaseOfFaillure: morph ]). self morphicPresenter morph: morph. self morphicPresenter whenDisplayDo: [ aBlSpace show ] diff --git a/src/Pyramid-Bloc/PyramidWheelTransformExtension.class.st b/src/Pyramid-Bloc/PyramidWheelTransformExtension.class.st index 1e1c9bb6..71689fe5 100644 --- a/src/Pyramid-Bloc/PyramidWheelTransformExtension.class.st +++ b/src/Pyramid-Bloc/PyramidWheelTransformExtension.class.st @@ -11,17 +11,19 @@ PyramidWheelTransformExtension >> installOn: aBuilder [ self builder: aBuilder. - self elementAtEvents when: BlMouseWheelEvent do: [ :evt | - | moveTo | - moveTo := nil. - self isNoKeyPressed ifTrue: [ moveTo := evt vector asPoint ]. - self isOnlyShiftKeyPressed ifTrue: [ - moveTo := evt vector asPoint leftRotated ]. - moveTo ifNotNil: [ - self elementAtTransforms transformDo: [ :t | - t translateBy: - moveTo * self wheelSpeed + self currentTransformTranslation ]. - self builder signalTransformationChanged ] ] + self elementAtEvents addEventHandler: (BlEventHandler + on: BlMouseWheelEvent + do: [ :evt | + | moveTo | + moveTo := nil. + self isNoKeyPressed ifTrue: [ moveTo := evt vector asPoint ]. + self isOnlyShiftKeyPressed ifTrue: [ + moveTo := evt vector asPoint leftRotated ]. + moveTo ifNotNil: [ + self elementAtTransforms transformDo: [ :t | + t translateBy: + moveTo * self wheelSpeed + self currentTransformTranslation ]. + self builder signalTransformationChanged ] ]) ] { #category : #'as yet unclassified' } diff --git a/src/Pyramid-Bloc/TPyramidEditorExtension.trait.st b/src/Pyramid-Bloc/TPyramidEditorExtension.trait.st index d9038406..231adbff 100644 --- a/src/Pyramid-Bloc/TPyramidEditorExtension.trait.st +++ b/src/Pyramid-Bloc/TPyramidEditorExtension.trait.st @@ -12,11 +12,17 @@ TPyramidEditorExtension >> currentTransformTranslation [ ] { #category : #'as yet unclassified' } -TPyramidEditorExtension >> elementAtDisplay [ +TPyramidEditorExtension >> elementAtDisplays [ ^ (self builder elementAt: #displays) ] +{ #category : #'as yet unclassified' } +TPyramidEditorExtension >> elementAtDisplaysAddons [ + + ^ self elementAtDisplays childWithId: #displaysAddons +] + { #category : #'as yet unclassified' } TPyramidEditorExtension >> elementAtEvents [