Write an interaction example to create a bounding box creator (with p…

src/GeoView-Examples/GeoViewBoundingBoxCreatorController.class.st

@@ -0,0 +1,168 @@
+Class {
+	#name : #GeoViewBoundingBoxCreatorController,
+	#superclass : #BlEventListener,
+	#instVars : [
+		'isOnCreation',
+		'boundingBox',
+		'helperShape',
+		'geoView',
+		'key'
+	],
+	#category : #'GeoView-Examples-Utils'
+}
+
+{ #category : #'dnd handlers' }
+GeoViewBoundingBoxCreatorController >> dragEvent: anEvent [
+
+	| coordinates width height |
+	self isOnCreation ifFalse: [ ^ self ].
+
+	anEvent consume.
+
+	coordinates := geoView absoluteCoordinatesFromGlobalPoint:
+		               anEvent position.
+	coordinates ifNil: [ ^ self ].
+
+	boundingBox ifNil: [
+			boundingBox := GeoBoundingBox new key: self getNewKey.
+			boundingBox strokeStyle: (Color random asSmockStrokeStyle width: 2).
+			boundingBox topLeftAbsoluteCoordinates: coordinates.
+			geoView addObject: boundingBox ].
+
+	boundingBox bottomRightAbsoluteCoordinates: coordinates.
+	geoView updateObject: boundingBox.
+
+	"update helper"
+	(boundingBox notNil and:[ boundingBox isValid ]) ifTrue: [ | formulas |
+		formulas := GeodesicVincentyFormulas new.
+		width := formulas distanceInMetersFrom: boundingBox topLeftAbsoluteCoordinates to: boundingBox topRightAbsoluteCoordinates.
+		height := formulas distanceInMetersFrom: boundingBox topLeftAbsoluteCoordinates to: boundingBox bottomLeftAbsoluteCoordinates.
+		helperShape text: (width rounded) printString, 'M x ', (height rounded) printString, 'M'.
+		helperShape coordinates: ((geoView localPointFromAbsoluteCoordinates: boundingBox topLeftAbsoluteCoordinates)).
+	].
+	self helpersLayer updateDShape: helperShape.
+]
+
+{ #category : #'dnd handlers' }
+GeoViewBoundingBoxCreatorController >> dragStartEvent: anEvent [
+
+	self isOnCreation ifFalse:[ ^ self ].
+
+	anEvent consume.
+]
+
+{ #category : #'dnd handlers' }
+GeoViewBoundingBoxCreatorController >> dropEvent: anEvent [
+
+	self isOnCreation ifFalse:[ ^ self ].
+
+	anEvent consume.
+
+	(boundingBox topLeftAbsoluteCoordinates isValid and: [
+		 boundingBox bottomRightAbsoluteCoordinates isValid ]) ifFalse: [
+			geoView removeObject: boundingBox.
+			key := key - 1 ].
+
+	self stopCreation
+]
+
+{ #category : #private }
+GeoViewBoundingBoxCreatorController >> getNewKey [
+
+	key ifNil:[ key := 0 ].
+	key := key + 1.
+	^ key
+]
+
+{ #category : #private }
+GeoViewBoundingBoxCreatorController >> helpersLayer [
+
+	^ geoView getLayer: #helpers
+]
+
+{ #category : #accessing }
+GeoViewBoundingBoxCreatorController >> isOnCreation [
+
+	^ isOnCreation ifNil: [ isOnCreation := false ]
+]
+
+{ #category : #accessing }
+GeoViewBoundingBoxCreatorController >> isOnCreation: anObject [
+
+	isOnCreation := anObject
+]
+
+{ #category : #'keyboard handlers' }
+GeoViewBoundingBoxCreatorController >> keyUpEvent: anEvent [
+
+	self isOnCreation ifFalse: [ ^ self ].
+	anEvent key = KeyboardKey escape ifFalse: [ ^ self ].
+
+	anEvent consume.
+	self stopCreation
+]
+
+{ #category : #'mouse handlers' }
+GeoViewBoundingBoxCreatorController >> mouseMoveEvent: anEvent [
+
+	| coordinates |
+	self isOnCreation ifFalse:[ ^ self ].
+
+	coordinates := geoView absoluteCoordinatesFromGlobalPoint: anEvent position.
+	coordinates ifNil:[ ^ self ].
+
+	helperShape coordinates: ((geoView localPointFromAbsoluteCoordinates: coordinates) + (0@ -20)).
+	helperShape text: 'Create from: ', ((coordinates latitudeInDegrees ifNil:['--']) asString, '° '),  ((coordinates longitudeInDegrees ifNil:['--']) asString, '°').
+
+	self helpersLayer updateDShape: helperShape
+]
+
+{ #category : #'api - hooks' }
+GeoViewBoundingBoxCreatorController >> onInstalledIn: aGeoView [
+
+	super onInstalledIn: aGeoView.
+
+	geoView := aGeoView
+]
+
+{ #category : #'api - hooks' }
+GeoViewBoundingBoxCreatorController >> onUninstalledIn: aGeoView [
+
+	self stopCreation.
+	geoView := nil.
+
+	super onUninstalledIn: aGeoView.
+]
+
+{ #category : #API }
+GeoViewBoundingBoxCreatorController >> startCreation [
+	"the object to create"
+
+	self isOnCreation: true.
+	geoView interactionsStrategy allowMapMoving: false.
+
+	geoView focused: true.
+
+	"the object to help user (show a text)"
+	helperShape ifNil: [ helperShape := SmockDText new key: -100 ].
+	helperShape
+		text: nil;
+		setDrawModeDevice;
+		smockFont: (SmockFont defaultFont fontSize: 10);
+		fillColor: Color white;
+		effect: (SmockBackgroundEffect new
+				 fillColor: (Color black alpha: 0.66);
+				 padding: (SmockInsets all: 3)).
+
+	self helpersLayer addDShape: helperShape
+]
+
+{ #category : #API }
+GeoViewBoundingBoxCreatorController >> stopCreation [
+
+	self isOnCreation: false.
+	self helpersLayer removeAllDShapes. 
+	boundingBox := nil.
+
+	geoView interactionsStrategy allowMapMoving: true.
+]

src/GeoView-Examples/GeoViewExamples.class.st

@@ -12,6 +12,51 @@ GeoViewExamples class >> createAndStartTask: aBlockClosure [
 		  yourself
 ]
 
+{ #category : #'private - bloc' }
+GeoViewExamples class >> createBlButton: aText [
+	"Code created with Pyramid editor"
+	"self createBlButton: 'My button'"
+
+	^ BlElement new
+   background: (BlPaintBackground new
+         paint: (BlColorPaint new
+               color: (Color r: 1.0 g: 1.0 b: 1.0 alpha: 1.0);
+               yourself);
+         opacity: 1.0;
+         yourself);
+   border: (BlBorderBuilder new
+         paint: (BlColorPaint new
+               color: (Color r: 0.10166177908113393 g: 0.7135874877810362 b: 0.9921798631476051 alpha: 1.0);
+               yourself);
+         width: 2;
+         lineCap: BlStrokeLineCap round;
+         lineJoin: BlStrokeLineJoin round;
+         build);
+   geometry: (BlRoundedRectangleGeometry cornerRadius: 4);
+   id: #button;
+   addChildren: {(BlTextElement new
+         text: (BlRopedText new
+               rope: (BlAttributeRope attributes: {(BlTextForegroundAttribute new
+                           paint: (Color r: 0.2668621700879765 g: 0.2668621700879765 b: 0.2668621700879765 alpha: 1.0);
+                           yourself)} rope: (BlCollectionRope new
+                           collection: (aText ifNil:['Button']);
+                           yourself));
+               yourself);
+         id: #text;
+         constraintsDo: [:constraints |  constraints horizontal fitContent.
+            constraints vertical fitContent.
+            constraints frame horizontal alignCenter.
+            constraints frame vertical alignCenter.
+            constraints position: 3.0 @ 3.0 ];
+         layout: BlBasicLayout uniqueInstance;
+         yourself)};
+   constraintsDo: [:constraints |  constraints horizontal fitContent.
+      constraints vertical fitContent.
+      constraints padding: (BlInsets all: 8.0) ];
+   layout: BlFrameLayout new;
+   yourself
+]
+
 { #category : #private }
 GeoViewExamples class >> createGeoBoundingBoxes: aQuantity [
 
@@ -204,6 +249,41 @@ GeoViewExamples class >> createTissotIndicatorCircles [
 	^ circles
 ]
 
+{ #category : #'examples - interactions' }
+GeoViewExamples class >> exampleBoundingBoxCreator [
+	"This example show how to create several BoundingBoxes from scratch"
+
+	| element layer button controller |
+	element := GeoViewElement new id: #geoView.
+
+	"OSM layer"
+	element addLayer: (GeoViewMapTilesLayer newWithOpenStreetMap).
+
+	"Bounding box layer"
+	layer := GeoViewDomainObjectsLayer new name: #boundingbox.
+	layer setProcessData: (GeoBoundingBoxProjectedProcessData new) forClass: GeoBoundingBox. 
+	element addLayer: layer.
+
+	"Helpers layer"
+	layer := GeoViewDShapesLayer new name: #helpers.
+	element addLayer: layer.
+
+	"Create interaction button and event handlers"
+	controller := GeoViewBoundingBoxCreatorController new.
+	element addEventHandler: controller.
+
+	button := self createBlButton: 'Create Bounding Box'.
+	button addEventHandlerOn: BlClickEvent do: [ :e |
+		e consume.
+		controller isOnCreation 
+			ifFalse:[ controller startCreation ] 
+			ifTrue:[ controller stopCreation ].
+	].
+	element addChild: button.
+
+	^ self openViewInWindow: element
+]
+
 { #category : #'examples - interactions' }
 GeoViewExamples class >> exampleCitiesHover [
 	"This example show how to implement a mouse hover interaction to do something"
@@ -1429,7 +1509,7 @@ GeoViewExamples class >> largest50Countries [
         ^positions
 ]
 
-{ #category : #private }
+{ #category : #'private - bloc' }
 GeoViewExamples class >> openViewInWindow: aGeoViewElement [
 	"open the view in a window"
 

src/GeoView-Tests/AbstractGeoViewInteractionsStrategyTest.class.st

@@ -0,0 +1,107 @@
+"
+An AbstractGeoViewInteractionsStrategyTest is a test class for testing the behavior of AbstractGeoViewInteractionsStrategy
+"
+Class {
+	#name : #AbstractGeoViewInteractionsStrategyTest,
+	#superclass : #TestCase,
+	#instVars : [
+		'strategy'
+	],
+	#category : #'GeoView-Tests-Events'
+}
+
+{ #category : #testing }
+AbstractGeoViewInteractionsStrategyTest class >> isAbstract [ 
+
+	^ self == AbstractGeoViewInteractionsStrategyTest 
+]
+
+{ #category : #running }
+AbstractGeoViewInteractionsStrategyTest >> setUp [
+
+	super setUp.
+
+	strategy := self strategyClass new
+]
+
+{ #category : #running }
+AbstractGeoViewInteractionsStrategyTest >> strategyClass [
+
+	self subclassResponsibility 
+]
+
+{ #category : #tests }
+AbstractGeoViewInteractionsStrategyTest >> testAllowMapMoving [
+
+	self assert: strategy allowMapMoving.
+
+	strategy allowMapMoving: false.
+	self deny: strategy allowMapMoving.
+
+	strategy allowMapMoving: true.
+	self assert: strategy allowMapMoving
+]
+
+{ #category : #tests }
+AbstractGeoViewInteractionsStrategyTest >> testAllowMapScaling [
+
+	self assert: strategy allowMapScaling.
+
+	strategy allowMapScaling: false.
+	self deny: strategy allowMapScaling.
+
+	strategy allowMapScaling: true.
+	self assert: strategy allowMapScaling
+]
+
+{ #category : #tests }
+AbstractGeoViewInteractionsStrategyTest >> testGeoView [
+
+	| geoView |
+	geoView := GeoViewElement new.
+
+	self assert: strategy geoView isNil.
+
+	strategy geoView: geoView.
+	self assert: strategy geoView notNil.
+
+	strategy geoView: nil.
+	self assert: strategy geoView isNil.
+
+]
+
+{ #category : #tests }
+AbstractGeoViewInteractionsStrategyTest >> testIsMultipleSelection [
+
+	self assert: strategy isMultipleSelection.
+
+	strategy isMultipleSelection: false.
+	self deny: strategy isMultipleSelection.
+
+	strategy isMultipleSelection: true.
+	self assert: strategy isMultipleSelection
+]
+
+{ #category : #tests }
+AbstractGeoViewInteractionsStrategyTest >> testPickingRadius [
+
+	self assert: strategy pickingRadius equals: strategy class defaultPickingRadius.
+
+	strategy pickingRadius: 10.
+	self assert: strategy pickingRadius equals: 10.
+
+	strategy pickingRadius: nil.
+	self assert: strategy pickingRadius equals: strategy class defaultPickingRadius.
+]
+
+{ #category : #tests }
+AbstractGeoViewInteractionsStrategyTest >> testSelectionFilterBlock [
+
+	self assert: strategy selectionFilterBlock isNil.
+
+	strategy selectionFilterBlock: [ :e | true ].
+	self assert: strategy selectionFilterBlock notNil.
+
+	strategy selectionFilterBlock: nil.
+	self assert: strategy selectionFilterBlock isNil.
+]

src/GeoView-Tests/GeoProjectorProcessDataUserForTest.class.st

@@ -0,0 +1,7 @@
+Class {
+	#name : #GeoProjectorProcessDataUserForTest,
+	#superclass : #GeoViewDomainProcessData,
+	#traits : 'TGeoProjectorProcessData',
+	#classTraits : 'TGeoProjectorProcessData classTrait',
+	#category : #'GeoView-Tests-Utils'
+}