diff --git a/src/BlocPac-Overlay/BlOverlayListener.class.st b/src/BlocPac-Overlay/BlOverlayListener.class.st index 1c61594f..bd997aef 100644 --- a/src/BlocPac-Overlay/BlOverlayListener.class.st +++ b/src/BlocPac-Overlay/BlOverlayListener.class.st @@ -110,12 +110,18 @@ BlOverlayListener >> overlayElement: anOverlayElement [ { #category : #geometry } BlOverlayListener >> positionFor: anElement [ - + | aNewPosition | self assert: [ anElement isNotNil ] description: [ 'Reference element must not be nil' ]. - - ^ (self overlayElement globalPointToParent: anElement bounds inSpace position) + + aNewPosition := self overlayElement + globalPointToParent: anElement bounds inSpace position. + + self overlayElement hasParent + ifTrue: [ aNewPosition := self overlayElement parent localPointToChildren: aNewPosition ]. + + ^ aNewPosition ] { #category : #'api - updating' } diff --git a/src/BlocPac-PannableAndZoomable-Examples/BlElementBoundsInScripterExamples.class.st b/src/BlocPac-PannableAndZoomable-Examples/BlElementBoundsInScripterExamples.class.st new file mode 100644 index 00000000..144a02bb --- /dev/null +++ b/src/BlocPac-PannableAndZoomable-Examples/BlElementBoundsInScripterExamples.class.st @@ -0,0 +1,287 @@ +Class { + #name : #BlElementBoundsInScripterExamples, + #superclass : #Object, + #traits : 'TBlDevScripterExamples', + #classTraits : 'TBlDevScripterExamples classTrait', + #category : #'BlocPac-PannableAndZoomable-Examples' +} + +{ #category : #examples } +BlElementBoundsInScripterExamples >> assertBoundsInSpaceForElement: anElement [ + | aBoundsInSpace1 aBoundsInSpace2 | + aBoundsInSpace1 := anElement bounds inSpace. + aBoundsInSpace2 := anElement boundsInSpace. + + self + assertBoundsRectangle: aBoundsInSpace1 asRectangle + equals: aBoundsInSpace2 + description: 'element bounds inSpace ({1}) ~= element boundsInSpace ({2})' +] + +{ #category : #examples } +BlElementBoundsInScripterExamples >> assertBoundsRectangle: aRectangleOne equals: aRectangleTwo description: aFormatString [ + "Format string must have two {1} {2} arguments." + + | aResult | + aResult := aRectangleOne closeTo: aRectangleTwo precision: 0.001. + self + assert: aResult + description: [ aFormatString format: { aRectangleOne. aRectangleTwo } ] +] + +{ #category : #examples } +BlElementBoundsInScripterExamples >> canvasInScripter: aScripter [ + GtJustContextStackSignal emit. + ^ self scripter: aScripter elementWithId: #'canvas' +] + +{ #category : #examples } +BlElementBoundsInScripterExamples >> canvassableElement [ + + | aChildBuilder | + aChildBuilder := [ :aPosition :aSize :aColor | + BlElement new + relocate: aPosition; + size: aSize; + geometry: BlCircleGeometry new; + background: aColor ]. + + ^ BlElement new + id: #top; + background: (Color veryLightGray alpha: 0.3); + layout: BlLinearLayout horizontal; + constraintsDo: [ :c | + c vertical matchParent. + c horizontal matchParent ]; + padding: (BlInsets all: 10); + addChild: (BlElement new + id: #container; + background: (Color veryLightGray alpha: 0.2); + layout: BlLinearLayout horizontal; + constraintsDo: [ :c | + c vertical matchParent. + c horizontal matchParent ]; + padding: (BlInsets all: 20); + addChild: (BlCanvassableElement new + id: #canvas; + background: (Color veryLightGray alpha: 0.1); + constraintsDo: [ :c | + c vertical matchParent. + c horizontal matchParent ]; + addChild: (BlElement new + relocate: 60 @ 200; + size: 30 @ 20; + background: Color red) + as: #'node-one'; + addChild: (BlElement new + relocate: 300 @ 600; + size: 20 @ 30; + background: Color blue) + as: #'node-two')) +] + +{ #category : #examples } +BlElementBoundsInScripterExamples >> containerInScripter: aScripter [ + ^ self scripter: aScripter elementWithId: #'container' +] + +{ #category : #examples } +BlElementBoundsInScripterExamples >> displayCanvassableElement [ + + | aScripter aCanvas | + aScripter := self scripterWithElement: [ self canvassableElement ]. + + aCanvas := self canvasInScripter: aScripter. + self + assert: aCanvas childrenTransformation isIdentity not + description: [ 'Canvas transformation must not be identity.' ]. + self assert: aCanvas zoomStep equals: 1.2. + + ^ aScripter +] + +{ #category : #examples } +BlElementBoundsInScripterExamples >> displayCanvassableElement_canvasBoundsInSpace [ + + | aScripter anElement aBoundsInSpace | + aScripter := self displayCanvassableElement. + anElement := self canvasInScripter: aScripter. + + self assert: anElement bounds asRectangle equals: (20 @ 20 corner: 760 @ 560). + + aBoundsInSpace := anElement bounds inSpace. + self assert: aBoundsInSpace asRectangle equals: (30 @ 30 corner: 770 @ 570). + + self assertBoundsInSpaceForElement: anElement. + ^ aScripter +] + +{ #category : #examples } +BlElementBoundsInScripterExamples >> displayCanvassableElement_containerBoundsInSpace [ + + | aScripter anElement aBoundsInSpace | + aScripter := self displayCanvassableElement. + anElement := self containerInScripter: aScripter. + + self assert: anElement bounds asRectangle equals: (10 @ 10 corner: 790 @ 590). + + aBoundsInSpace := anElement bounds inSpace. + self assert: aBoundsInSpace asRectangle equals: (10 @ 10 corner: 790 @ 590). + + self assertBoundsInSpaceForElement: anElement. + + ^ aScripter +] + +{ #category : #examples } +BlElementBoundsInScripterExamples >> displayCanvassableElement_nodeOneBoundsInSpace [ + + | aScripter anElement | + aScripter := self displayCanvassableElement. + anElement := self nodeOneInScripter: aScripter. + + self assert: anElement position equals: 60 @ 200. + self assert: anElement extent equals: 30 @ 20. + self assert: anElement bounds asRectangle equals: (60 @ 200 corner: 90 @ 220). + + self + assertBoundsRectangle: anElement bounds inSpace asRectangle + equals: (236.74418604651163 @ 30.00000000000003 + corner: 274.4186046511628 @ 55.11627906976747) + description: 'nodeOne bounds inSpace ({1}) ~= expected {2}'. + self assertBoundsInSpaceForElement: anElement. + + ^ aScripter +] + +{ #category : #examples } +BlElementBoundsInScripterExamples >> displayCanvassableElement_nodeOneWithResizerInCanvas [ + "Assertions are correct." + + + | aScripter aNodeOne aResizer aCanvas aListener | + aScripter := self displayCanvassableElement. + aCanvas := self canvasInScripter: aScripter. + aNodeOne := self nodeOneInScripter: aScripter. + + aScripter do + block: [ + aResizer := BlResizerElement new preventMouseEvents zIndex: 100. + aListener := aResizer instVarNamed: #overlayListener. + aResizer attachTo: aNodeOne. + aCanvas addChild: aResizer ]; + play. + + self + assertBoundsRectangle: aResizer bounds asRectangle + equals: (60.0 @ 200.0 corner: 90.0 @ 220.0) + description: 'Resizer bounds ({1}) ~= {2}'. + + self + assertBoundsRectangle: aResizer bounds inSpace asRectangle + equals: (236.74418604651163 @ 30.00000000000003 + corner: 274.4186046511628 @ 55.11627906976747) + description: 'Resizer bounds inSpace ({1}) ~= {2}'. + self assertBoundsInSpaceForElement: aResizer. + + ^ aScripter +] + +{ #category : #examples } +BlElementBoundsInScripterExamples >> displayCanvassableElement_nodeOneWithResizerInSpaceRoot [ + "Assertions are correct." + + + | aScripter anElement aResizer | + aScripter := self displayCanvassableElement. + anElement := self nodeOneInScripter: aScripter. + + aScripter do + block: [ :aParent | + aResizer := BlResizerElement new + preventMouseEvents; + zIndex: 100. + aResizer attachTo: anElement. + aParent addChild: aResizer ]; + onSpaceRoot; + play. + + "self + assertBoundsRectangle: aResizer bounds asRectangle + equals: (236.74418604651163 @ 30.00000000000003 + corner: 274.4186046511628 @ 55.11627906976747) + description: 'Resizer bounds ({1}) ~= {2}'." + + self + assertBoundsRectangle: aResizer bounds inSpace asRectangle + equals: (236.74418604651163 @ 30.00000000000003 + corner: 274.4186046511628 @ 55.11627906976747) + description: 'Resizer bounds inSpace ({1}) ~= {2}'. + + self assertBoundsInSpaceForElement: aResizer. + ^ aScripter +] + +{ #category : #examples } +BlElementBoundsInScripterExamples >> displayCanvassableElement_nodeTwoBoundsInSpace [ + + | aScripter anElement aBoundsInSpace | + aScripter := self displayCanvassableElement. + anElement := self nodeTwoInScripter: aScripter. + + self assert: anElement position equals: 300 @ 600. + self assert: anElement extent equals: 20 @ 30. + self assert: anElement bounds asRectangle equals: (300 @ 600 corner: 320 @ 630). + + aBoundsInSpace := anElement bounds inSpace. + self + assertBoundsRectangle: aBoundsInSpace asRectangle + equals: (538.1395348837209 @ 532.3255813953489 + corner: 563.2558139534884 @ 570.0) + description: 'nodeTwo bounds inSpace ({1}) ~= expected {2}'. + + self assertBoundsInSpaceForElement: anElement. + ^ aScripter +] + +{ #category : #examples } +BlElementBoundsInScripterExamples >> displayCanvassableElement_topBoundsInSpace [ + + | aScripter anElement aBoundsInSpace | + aScripter := self displayCanvassableElement. + anElement := self topInScripter: aScripter. + + self assert: anElement bounds asRectangle equals: (0 @ 0 corner: 800 @ 600). + + aBoundsInSpace := anElement bounds inSpace. + self assert: aBoundsInSpace asRectangle equals: (0 @ 0 corner: 800 @ 600). + + self assertBoundsInSpaceForElement: anElement. + + ^ aScripter +] + +{ #category : #examples } +BlElementBoundsInScripterExamples >> nodeOneInScripter: aScripter [ + ^ self scripter: aScripter elementWithId: #'node-one' +] + +{ #category : #examples } +BlElementBoundsInScripterExamples >> nodeTwoInScripter: aScripter [ + ^ self scripter: aScripter elementWithId: #'node-two' +] + +{ #category : #examples } +BlElementBoundsInScripterExamples >> scripter: aScripter elementWithId: aNodeId [ + | anElement | + anElement := (aScripter root query // aNodeId) anyOne. + + self assert: anElement isNotNil. + + ^ anElement +] + +{ #category : #examples } +BlElementBoundsInScripterExamples >> topInScripter: aScripter [ + ^ self scripter: aScripter elementWithId: #'top' +] diff --git a/src/BlocPac-PannableAndZoomable/BlCanvassableElement.class.st b/src/BlocPac-PannableAndZoomable/BlCanvassableElement.class.st index 930c504a..c6870cc6 100644 --- a/src/BlocPac-PannableAndZoomable/BlCanvassableElement.class.st +++ b/src/BlocPac-PannableAndZoomable/BlCanvassableElement.class.st @@ -14,7 +14,8 @@ Class { 'autoScaleEnabled', 'childrenTransformationOrigin', 'childrenScaleFactor', - 'childrenTranslationFactor' + 'childrenTranslationFactor', + 'shouldTranslateOnMouseWheelZoom' ], #category : #'BlocPac-PannableAndZoomable-Core' } @@ -39,6 +40,16 @@ BlCanvassableElement >> autoScaleEnabled [ ^ autoScaleEnabled ] +{ #category : #'api - zooming' } +BlCanvassableElement >> calculateTranslationFactorOnMouseWheelZoom: anEvent [ + | localPosition translateScalingFactor translateX translateY | + translateScalingFactor := 1 / 2. + localPosition := self globalPointToLocal: anEvent position. + translateX := (self extent x / 2 - localPosition x) * translateScalingFactor. + translateY := (self extent y / 2 - localPosition y) * translateScalingFactor. + ^ self childrenTranslationFactor + (translateX @ translateY) +] + { #category : #accessing } BlCanvassableElement >> childrenBoundingBox [ | aChildrenBoundingBox | @@ -79,6 +90,9 @@ BlCanvassableElement >> childrenScaleFactor: aNumber [ (childrenScaleFactor closeTo: aNewScaleFactor) ifTrue: [ ^ self ]. + + aNewScaleFactor < self minChildrenScaleFactor + ifTrue: [ ^ self ]. childrenScaleFactor := aNewScaleFactor. self updateChildrenTransformation. @@ -160,7 +174,13 @@ BlCanvassableElement >> initialize [ childrenTransformationOrigin := 0@0. self addEventHandler: BlCanvassableElementSlideHandler new. - self beInSeparateCompositionLayer + self beInSeparateCompositionLayer. + self withZoomOnScrollWheel. +] + +{ #category : #'api - zooming' } +BlCanvassableElement >> minChildrenScaleFactor [ + ^ 0.014 ] { #category : #layout } @@ -208,6 +228,35 @@ BlCanvassableElement >> scaleChildrenToFitContentDuringLayout [ self updateChildrenTransformation ] +{ #category : #accessing } +BlCanvassableElement >> shouldTranslateOnMouseWheelZoom [ + ^ shouldTranslateOnMouseWheelZoom + ifNil: [ shouldTranslateOnMouseWheelZoom := true ] +] + +{ #category : #accessing } +BlCanvassableElement >> shouldTranslateOnMouseWheelZoom: aBoolean [ + shouldTranslateOnMouseWheelZoom := aBoolean +] + +{ #category : #'api - transformation' } +BlCanvassableElement >> translate: aPoint [ + "Animate a change to translation" + | translateAnimation | + + childrenTransformationOrigin := self extent / 2.0. + + "self disableAutoScale." + + translateAnimation := BlNumberTransition new + onStepDo: [ :aTranslateFactor | self childrenTranslationFactor: aTranslateFactor ]; + from: self childrenTranslationFactor; + to: self childrenTranslationFactor + aPoint; + duration: 250 milliSeconds. + + self addAnimation: translateAnimation +] + { #category : #transformations } BlCanvassableElement >> updateChildrenTransformation [ self @@ -218,6 +267,42 @@ BlCanvassableElement >> updateChildrenTransformation [ scaleBy: childrenScaleFactor ] ] +{ #category : #'api - zooming' } +BlCanvassableElement >> withZoomOnScrollWheel [ + self + when: BlMouseWheelEvent + do: [ :anEvent | + (self shouldTranslateOnMouseWheelZoom and: [ anEvent isPrimarilyVertical ]) + ifTrue: [ anEvent modifiers = BlKeyModifiers primary + ifTrue: [ | eventYvector newZoomLevel scalingFactor | + anEvent consumed: true. + eventYvector := anEvent vector y. + scalingFactor := 1 / 2. + eventYvector positive + ifTrue: [ newZoomLevel := self zoomLevel * scalingFactor reciprocal round: 2. + self zoomLevel: newZoomLevel withTranslate: anEvent ] + ifFalse: [ newZoomLevel := self zoomLevel * scalingFactor round: 2. + self zoomLevel: newZoomLevel ] ]. + + anEvent modifiers = BlKeyModifiers alt + ifTrue: [ | eventYvector | + anEvent consumed: true. + eventYvector := anEvent vector y. + eventYvector positive + ifTrue: [ self translate: (anEvent currentTarget topMostParent extent x / 10) @ 0 ] + ifFalse: [ self + translate: (anEvent currentTarget topMostParent extent x / 10) negated @ 0 ] ]. + + anEvent modifiers = BlKeyModifiers new + ifTrue: [ | eventYvector | + anEvent consumed: true. + eventYvector := anEvent vector y. + eventYvector positive + ifTrue: [ self translate: 0 @ (anEvent currentTarget topMostParent extent x / 10) ] + ifFalse: [ self + translate: 0 @ (anEvent currentTarget topMostParent extent x / 10) negated ] ] ] ] +] + { #category : #'api - zooming' } BlCanvassableElement >> zoomIn [ self zoomLevel: self zoomLevel * self zoomStep @@ -248,6 +333,30 @@ BlCanvassableElement >> zoomLevel: aNumber [ self addAnimation: anAnimation ] +{ #category : #'api - zooming' } +BlCanvassableElement >> zoomLevel: aNumber withTranslate: anEvent [ + "Animate a change to zoom level while translating to a new position" + | translateAnimation zoomAnimation | + + childrenTransformationOrigin := self extent / 2.0. + + self disableAutoScale. + + translateAnimation := BlNumberTransition new + onStepDo: [ :aTranslateFactor | childrenTranslationFactor := aTranslateFactor ]; + from: self childrenTranslationFactor; + to: (self calculateTranslationFactorOnMouseWheelZoom: anEvent); + duration: 250 milliSeconds. + + zoomAnimation := BlNumberTransition new + onStepDo: [ :aScaleFactor | self childrenScaleFactor: aScaleFactor ]; + from: self childrenScaleFactor; + to: aNumber; + duration: 250 milliSeconds. + + self addAnimation: (BlParallelAnimation with: {translateAnimation. zoomAnimation}) +] + { #category : #'api - zooming' } BlCanvassableElement >> zoomOut [ self zoomLevel: self zoomLevel / self zoomStep diff --git a/src/BlocPac-Resizable/BlResizerListener.class.st b/src/BlocPac-Resizable/BlResizerListener.class.st index 6dca9949..9e809bb3 100644 --- a/src/BlocPac-Resizable/BlResizerListener.class.st +++ b/src/BlocPac-Resizable/BlResizerListener.class.st @@ -32,8 +32,8 @@ BlResizerListener >> dragDelta: anEvent [ dragDelta := dragPosition - dragStartPosition." | dragPosition startPosition | - dragPosition := anEvent currentTarget globalPointToParent: anEvent position. - startPosition := anEvent currentTarget globalPointToParent: dragStartPosition. + dragPosition := anEvent position. + startPosition := dragStartPosition. ^ dragPosition - startPosition ] @@ -69,6 +69,8 @@ BlResizerListener >> dragEvent: anEvent [ self hasTarget ifFalse: [ ^ self ]. + self resizeTarget hasParent + ifFalse: [ ^ self ]. dragDelta := self dragDelta: anEvent. @@ -84,6 +86,7 @@ BlResizerListener >> dragEvent: anEvent [ self resizeTarget globalBoundsToLocal: theBounds. self resizeTarget localBoundsToParent: theBounds. + self resizeTarget parent localBoundsToChildren: theBounds. self resizeTarget relocate: theBounds position.