Merge pull request #16 from OpenSmock/dev-9

Concurrent access and performance work

GeoView-Bloc-Alexandrie/BlElementAeGeoView.class.st

@@ -5,7 +5,8 @@ Class {
 	#classTraits : 'TGeoView classTrait',
 	#instVars : [
 		'layers',
-		'displayToGraphicProjection'
+		'displayToGraphicProjection',
+		'isMarkedForSortDatas'
 	],
 	#category : #'GeoView-Bloc-Alexandrie-Core'
 }
@@ -18,27 +19,37 @@ BlElementAeGeoView >> addLayer: aLayer [
 	self layers add: aLayer
 ]
 
-{ #category : #'as yet unclassified' }
+{ #category : #'API -- objects management' }
 BlElementAeGeoView >> addObject: anUserObject [
-
-	self layers do: [ :e | e addObject: anUserObject ].
-	self requestRepaint
+
+	self enqueueBlockAsTask: [
+		self layers do: [ :e | e addObject: anUserObject ].
+		self requestSortDatas.
+		self requestRepaint ]
 ]
 
-{ #category : #'as yet unclassified' }
+{ #category : #'API -- objects management' }
 BlElementAeGeoView >> addObjects: anUserObjectList [
 
-	self layers do: [ :e | e addObjects: anUserObjectList ].
-	self requestRepaint
+	self enqueueBlockAsTask: [
+		self layers do: [ :e | e addObjects: anUserObjectList ].
+		self requestSortDatas.
+		self requestRepaint ]
 ]
 
 { #category : #drawing }
 BlElementAeGeoView >> aeDrawOn: aeCanvas [
-
 	"drawing native bloc elements"
+
+	| sort |
 	super aeDrawOn: aeCanvas.
 
-	self layers do:[ :l | l aeDrawOn: aeCanvas ].
+	sort := self isMarkedForSortDatas.
+	self layers do: [ :l |
+		sort ifTrue: [ l sortDatas ].
+		l aeDrawOn: aeCanvas ].
+
+	isMarkedForSortDatas := false
 ]
 
 { #category : #private }
@@ -70,6 +81,15 @@ BlElementAeGeoView >> displayToGraphicProjection: anObject [
 	displayToGraphicProjection := anObject
 ]
 
+{ #category : #private }
+BlElementAeGeoView >> enqueueBlockAsTask: aBlockClosure [
+
+	| task |
+	task := BlTaskAction new.
+	task action: aBlockClosure.
+	self enqueueTask: task
+]
+
 { #category : #'API -- size' }
 BlElementAeGeoView >> getBounds [
 
@@ -88,66 +108,95 @@ BlElementAeGeoView >> getLayers [
 	^ self layers
 ]
 
+{ #category : #'API -- objects management' }
+BlElementAeGeoView >> haveObjectIndex: anIndex [
+	"Pay attention before using it because graphical model is out of sync real user model due to usage of BlTask (asynchronous)"
+
+	^ self layers anySatisfy: [ :l | l haveObjectIndex: anIndex ]
+]
+
+{ #category : #accessing }
+BlElementAeGeoView >> isMarkedForSortDatas [
+
+	^ isMarkedForSortDatas ifNil: [ isMarkedForSortDatas := false ]
+]
+
 { #category : #accessing }
 BlElementAeGeoView >> layers [
 
 	^ layers ifNil: [ layers := OrderedCollection new ]
 ]
 
-{ #category : #'as yet unclassified' }
+{ #category : #'API -- objects management' }
 BlElementAeGeoView >> removeObject: anUserObject [
-
-	self layers do: [ :e | e removeObject: anUserObject ].
-	self requestRepaint
+
+	self enqueueBlockAsTask: [
+		self layers do: [ :e | e removeObject: anUserObject ].
+		self requestRepaint ]
 ]
 
-{ #category : #'as yet unclassified' }
+{ #category : #'API -- objects management' }
 BlElementAeGeoView >> removeObjects: anUserObjectList [
-
-	self layers do: [ :e | e removeObjects: anUserObjectList ].
-	self requestRepaint
+
+	self enqueueBlockAsTask: [
+		self layers do: [ :e | e removeObjects: anUserObjectList ].
+		self requestRepaint ]
 ]
 
 { #category : #private }
 BlElementAeGeoView >> requestRepaint [
 
-	self layers ifEmpty: [ ^ self ].
-	self layers do:[ :l | l sortDatas ].
 	self invalidate.
 ]
 
+{ #category : #private }
+BlElementAeGeoView >> requestSortDatas [
+
+	isMarkedForSortDatas := true.
+]
+
 { #category : #'API -- selection' }
 BlElementAeGeoView >> selectedObjectIndexes: anIndexList [
-
-	self layers do: [ :l | l updateState: #selected withIndexes: anIndexList ].
-	self requestRepaint
+
+	self enqueueBlockAsTask: [
+		self layers do: [ :l | l updateState: #selected withIndexes: anIndexList ].
+		self requestSortDatas.
+		self requestRepaint ]
 ]
 
 { #category : #'API -- drawing' }
 BlElementAeGeoView >> updateGraphicModel [
 	"Update the graphic model with the Display model"
 
-	self layers do: [ :e | e updateGraphicModel ].
-	self requestRepaint
+	self enqueueBlockAsTask: [
+		self layers do: [ :e | e updateGraphicModel ].
+		self requestRepaint ]
 ]
 
-{ #category : #'as yet unclassified' }
+{ #category : #'API -- objects management' }
 BlElementAeGeoView >> updateObject: anUserObject [
-
-	self layers do: [ :e | e updateObject: anUserObject ].
-	self requestRepaint
+
+	self enqueueBlockAsTask: [
+		self layers do: [ :e | e updateObject: anUserObject ].
+		self requestSortDatas.
+		self requestRepaint ]
 ]
 
-{ #category : #'as yet unclassified' }
+{ #category : #'API -- objects management' }
 BlElementAeGeoView >> updateObjects: anUserObjectList [
-
-	self layers do: [ :e | e updateObjects: anUserObjectList ].
-	self requestRepaint
+
+	self enqueueBlockAsTask: [
+		self layers do: [ :e | e updateObjects: anUserObjectList ].
+		self requestSortDatas.
+		self requestRepaint ]
 ]
 
 { #category : #private }
 BlElementAeGeoView >> updateState: aStateSymbol withIndexes: aKeyList [
 
-	self layers do: [ :l | l updateState: aStateSymbol withIndexes: aKeyList ].
-	self requestRepaint
+	self enqueueBlockAsTask: [ 
+		self layers do: [ :l | l updateState: aStateSymbol withIndexes: aKeyList ].
+		self requestSortDatas.
+		self requestRepaint
+	]
 ]

GeoView-Bloc-Alexandrie/GeoViewManagerBlocAeImpl.class.st

@@ -59,15 +59,17 @@ GeoViewManagerBlocAeImpl >> getGlobalPointFromAbsoluteCoordinates: anAbsoluteCoo
 { #category : #'projection center' }
 GeoViewManagerBlocAeImpl >> getGlobalPointFromLocalPoint: aLocalPoint [
 
+	aLocalPoint ifNil:[ ^ nil ].
 	^ self view localPointToGlobal: aLocalPoint
 ]
 
 { #category : #'projection center' }
 GeoViewManagerBlocAeImpl >> getLocalPointFromAbsoluteCoordinates: anAbsoluteCoordinates [
 
 	| projection |
-	projection := self getMapProjectionManagerServicesProvider
-		              getProjection.
+	projection := self getMapProjectionManagerServicesProvider getProjection.
+	projection ifNil:[ ^ nil ].
+
 	^ self view displayToGraphicProjection projCartToPixel:
 		  (projection projLatLonToCart: anAbsoluteCoordinates)
 ]

GeoView-Bloc-Alexandrie/GeoViewUserToDisplayToGraphicLayer.extension.st

@@ -2,10 +2,9 @@ Extension { #name : #GeoViewUserToDisplayToGraphicLayer }
 
 { #category : #'*GeoView-Bloc-Alexandrie' }
 GeoViewUserToDisplayToGraphicLayer >> aeDrawOn: aeCanvas [
-	
+
 	self isVisible ifFalse: [ ^ self ].
-	sortedDatas ifNil:[ ^ self ].
+	sortedDatas ifNil: [ ^ self ].
 
-	self flag: 'Patch to wait correction on issue #9'.
-	sortedDatas copy do: [ :e | e ifNotNil:[:el | el aeDrawOn: aeCanvas ]]
+	sortedDatas do: [ :e | e aeDrawOn: aeCanvas ]
 ]

GeoView-Bloc/GeoViewNavigationBlocStrategy.class.st

@@ -42,6 +42,8 @@ GeoViewNavigationBlocStrategy >> moveMap: aSmockEventWrapper context: aSmockInpu
 	difPx := self previousPoint - point.
 	difPx := (difPx x) @ (difPx y negated).
 	geoCenterPx := geoViewMng getGlobalPointFromAbsoluteCoordinates: geoViewMng getGeoCenter.
+	geoCenterPx ifNil:[ ^ self ].
+
 	geoCenterPx := geoCenterPx + difPx.
 	geoViewMng centerOnPoint: geoCenterPx.
 
@@ -109,6 +111,8 @@ GeoViewNavigationBlocStrategy >> scrollDown: aSmockEventWrapper context: aSmockI
 	point := aSmockEventWrapper event position.
 
 	projection := geoViewMng getMapProjectionManagerServicesProvider getProjection.
+	projection ifNil:[ ^ self ].
+
 	projection2D := geoViewMng view displayToGraphicProjection.
 
 	geoPoint := geoViewMng getAbsoluteCoordinatesFromGlobalPoint: point.
@@ -139,6 +143,8 @@ GeoViewNavigationBlocStrategy >> scrollUp: aSmockEventWrapper context: aSmockInp
 	point := aSmockEventWrapper event position.
 
 	projection := geoViewMng getMapProjectionManagerServicesProvider getProjection.
+	projection ifNil:[ ^ self ].
+
 	projection2D := geoViewMng view displayToGraphicProjection.
 
 	geoPoint := geoViewMng getAbsoluteCoordinatesFromGlobalPoint: point.

GeoView-Examples-Bloc/GeoViewExamplesBloc.class.st

@@ -33,7 +33,7 @@ GeoViewExamplesBloc class >> exampleWithGeoObjects [
 	geoViewManager := GeoViewManagerBlocAeImpl start: #GeoViewManager , Random new next printString. 
 
 	"parameters"
-	geoViewManager setObjectIndexAccessor: #key.
+	"geoViewManager setObjectIndexAccessor: #key."
 
 	"setup projection example"
 	"geoViewManager getMapProjectionManagerServicesProvider setProjection: MercatorProjection new."
@@ -52,7 +52,50 @@ GeoViewExamplesBloc class >> exampleWithGeoObjects [
 	objects := self createGeoObjects.
 	geoViewManager addObjects: objects.
 
-	self openViewInWindow: geoViewManager.
+	^ self openViewInWindow: geoViewManager
+]
+
+{ #category : #examples }
+GeoViewExamplesBloc class >> exampleWithGeoObjectsUpdated [
+	"This example use ready-to-use geo-object classes (GeoObject and processData) to represent updated geographical view with a lot of data."
+
+	| geoViewManager layer objects space thread |
+	geoViewManager := GeoViewManagerBlocAeImpl start: #GeoViewManager , Random new next printString. 
+
+	"configure layers and process datas : objects that can be displayed and how"
+	layer := geoViewManager createAndAddLayer: #layer1.
+	layer setProcessData: GeoCircleProcessData new for: GeoCircle.
+	layer setProcessData: GeoEllipseProcessData new for: GeoEllipse.
+	layer setProcessData: GeoPolygonProcessData new for: GeoPolygon.
+	layer setProcessData: GeoPolylineProcessData new for: GeoPolyline.
+	layer setProcessData: GeoRectangleProcessData new for: GeoRectangle.
+	layer setProcessData: GeoTextProcessData new for: GeoText.
+	layer setProcessData: GeoArcBandProcessData new for: GeoArcBand.
+
+	"create sample datas"
+	objects := self createGeoObjects.
+	geoViewManager addObjects: objects.
+
+	space := self openViewInWindow: geoViewManager.
+
+	"Objet update thread"
+	thread := [ | random |
+		random := Random new.
+		[ true ] whileTrue:[
+			1 second wait.
+			objects do:[ :o |
+				o radiusInMeters: (random next * 200000).	
+				geoViewManager updateObject: o.
+			].
+		].
+	] forkAt: Processor userBackgroundPriority named: 'GeoView objects update example'.
+
+	"Stop thread when window is closed"
+	space addEventHandler: (BlEventHandler
+			 on: BlSpaceCloseRequest
+			 do: [ :event | thread terminate. ]).
+
+	^ space
 ]
 
 { #category : #private }
@@ -70,7 +113,9 @@ GeoViewExamplesBloc class >> openViewInWindow: aGeoViewManager [
 	space addEventHandler: (BlEventHandler
 			 on: BlSpaceCloseRequest
 			 do: [ :event |
-			 aGeoViewManager class stop: aGeoViewManager componentName ])
+			 aGeoViewManager class stop: aGeoViewManager componentName ]).
+
+	^ space
 ]
 
 { #category : #'see class side' }

GeoView-Tests/DCompositeShapeGeoViewAeProcessDataTest.class.st → GeoView-Tests/DCompositeShapeGeoViewProcessDataTest.class.st

@@ -2,13 +2,13 @@
 A DCompositeShapeGeoViewAeProcessDataTest is a test class for testing the behavior of DCompositeShapeGeoViewAeProcessData
 "
 Class {
-	#name : #DCompositeShapeGeoViewAeProcessDataTest,
+	#name : #DCompositeShapeGeoViewProcessDataTest,
 	#superclass : #TestCase,
-	#category : #'GeoView-Tests'
+	#category : #'GeoView-Tests-Cases - ProcessData'
 }
 
 { #category : #tests }
-DCompositeShapeGeoViewAeProcessDataTest >> testProcessCreatedDataIncomingWithContext [
+DCompositeShapeGeoViewProcessDataTest >> testProcessCreatedDataIncomingWithContext [
 
 	| processData dShape gShape |
 	processData := DCompositeShapeGeoViewProcessData new.
@@ -21,7 +21,7 @@ DCompositeShapeGeoViewAeProcessDataTest >> testProcessCreatedDataIncomingWithCon
 ]
 
 { #category : #tests }
-DCompositeShapeGeoViewAeProcessDataTest >> testProcessUpdatedDataIncomingWithContext [
+DCompositeShapeGeoViewProcessDataTest >> testProcessUpdatedDataIncomingWithContext [
 
 	| processData dShape gShape |
 	processData := DCompositeShapeGeoViewProcessData new.

GeoView/GeoViewManagerImpl.class.st

@@ -226,7 +226,7 @@ GeoViewManagerImpl >> getMapProjectionManagerServicesProvider [
 { #category : #'parameters - objects' }
 GeoViewManagerImpl >> getObjectIndexAccessor [
 
-	^ objectIndexAccessor ifNil:[ objectIndexAccessor := #tn ]
+	^ objectIndexAccessor ifNil:[ objectIndexAccessor := #key ]
 ]
 
 { #category : #services }