pharo-graphics · tinchodias · Oct 15, 2024 · Oct 2, 2024 · Oct 9, 2024 · Oct 9, 2024
diff --git a/src/Bloc/BlEvent.class.st b/src/Bloc/BlEvent.class.st
@@ -144,8 +144,9 @@ BlEvent >> canBePropagated [
 ]
 
 { #category : #'private - accessing' }
-BlEvent >> canBePropagated: anObject [
-	canBePropagated := anObject
+BlEvent >> canBePropagated: aBoolean [
+
+	canBePropagated := aBoolean
 ]
 
 { #category : #'private - steps' }
@@ -355,6 +356,16 @@ BlEvent >> newCopyFor: aTarget [
 		yourself
 ]
 
+{ #category : #printing }
+BlEvent >> printOn: aStream [
+
+	aStream
+		nextPutAll: self className;
+		nextPutAll: '(timestamp: ';
+		print: timestamp;
+		nextPut: $)
+]
+
 { #category : #sending }
 BlEvent >> sendTo: anObject [
 

diff --git a/src/Bloc/BlEventTraversalBubblingStep.class.st b/src/Bloc/BlEventTraversalBubblingStep.class.st
diff --git a/src/Bloc/BlEventTraversalCapturingStep.class.st b/src/Bloc/BlEventTraversalCapturingStep.class.st
diff --git a/src/Bloc/BlEventTraversalForwardingStep.class.st b/src/Bloc/BlEventTraversalForwardingStep.class.st
diff --git a/src/Bloc/BlEventTraversalStep.class.st b/src/Bloc/BlEventTraversalStep.class.st
diff --git a/src/Bloc/BlEventTraversalTargetStep.class.st b/src/Bloc/BlEventTraversalTargetStep.class.st
diff --git a/src/Bloc/BlHost.class.st b/src/Bloc/BlHost.class.st
@@ -7,8 +7,6 @@ A Host can be compared to a driver that communicates with the native multimedia
 Class {
 	#name : #BlHost,
 	#superclass : #Object,
-	#traits : 'TBlDebug',
-	#classTraits : 'TBlDebug classTrait',
 	#classVars : [
 		'PreferableHostClass'
 	],

diff --git a/src/Bloc/BlParallelUniverse.class.st b/src/Bloc/BlParallelUniverse.class.st
@@ -180,12 +180,12 @@ BlParallelUniverse >> closeSpaceSynchronously: aSpace [
 	aSpace dispatchRemovedFromSceneGraph.
 
 	"Raise an event indicating that the space is no longer attached to a universe"
-	aSpace dispatchEvent: (BlSpaceDetachedEvent new space: aSpace).
+	aSpace dispatchEventWithTimestamp: BlSpaceDetachedEvent new.
 
 	"Send space closed event.
 	Note: a new space may be spawned as a reaction to the event, that is why
 	we send it before stopping host and universe"
-	aSpace dispatchEvent: (BlSpaceClosedEvent new space: aSpace).
+	aSpace dispatchEventWithTimestamp: BlSpaceClosedEvent new.
 
 	self
 		assert: [ aSpace hasHostSpace not ]
@@ -204,7 +204,7 @@ BlParallelUniverse >> closeSpaceSynchronously: aSpace [
 	"Raise an event indicating that all normal event for closing a space have been completed.
 	This event is used by the debugger to stop the UI process. Users should not normally rely
 	on this event, as there is no guarantee that the process will not be terminated."
-	aSpace dispatchEvent: (BlSpaceDestroyedEvent new space: aSpace).
+	aSpace dispatchEventWithTimestamp: BlSpaceDestroyedEvent new
 ]
 
 { #category : #'api - spaces' }
@@ -278,7 +278,7 @@ BlParallelUniverse >> detachSpaceSynchronously: aSpace [
 					ifTrue: [ self stopUniverse ] ] ].
 
 	"Raise an event indicating that the space is no longer attached to a universe"
-	aSpace dispatchEvent: (BlSpaceDetachedEvent new space: aSpace).
+	aSpace dispatchEventWithTimestamp: BlSpaceDetachedEvent new
 ]
 
 { #category : #testing }
@@ -400,10 +400,7 @@ BlParallelUniverse >> openSpaceSynchronously: aSpace [
 
 	"Note: we should send shown event after everything else is done, because
 	theoretically, that only space could be closed as a reaction to the event"
-	aSpace dispatchEvent:
-		(BlSpaceShownEvent new
-			space: aSpace;
-			yourself).
+	aSpace dispatchEventWithTimestamp: BlSpaceShownEvent new.
 
 	"Notify root element that it is now visible to the user"
 	aSpace becomeVisible.

diff --git a/src/Bloc/BlSpace.class.st b/src/Bloc/BlSpace.class.st
@@ -660,6 +660,13 @@ BlSpace >> dispatchAddedToSceneGraph [
 
 ]
 
+{ #category : #'event handling' }
+BlSpace >> dispatchEventWithTimestamp: aBlEvent [ 
+
+	aBlEvent timestamp ifNil: [ aBlEvent timestamp: self time now ].
+	self dispatchEvent: aBlEvent
+]
+
 { #category : #'event handling' }
 BlSpace >> dispatchMousePickedOutside: aMouseOutsideEvent [
 
@@ -675,16 +682,16 @@ BlSpace >> dispatchRemovedFromSceneGraph [
 ]
 
 { #category : #pulse }
-BlSpace >> dispatchTimeEvent: aSpaceStepEventClass during: aBlock [
+BlSpace >> dispatchTimeEvent: aSpacePhaseEventClass during: aBlock [
+
 	| aStartTime |
-
 	aStartTime := self time now.
 	aBlock cull: self.
 	self eventDispatcher dispatchEvent:
-			(aSpaceStepEventClass new
-				start: aStartTime;
-				end: self time now;
-				yourself)
+		(aSpacePhaseEventClass new
+			 start: aStartTime;
+			 end: self time now;
+			 yourself)
 ]
 
 { #category : #'change - layout' }

diff --git a/src/Bloc/BlSpaceClosedEvent.class.st b/src/Bloc/BlSpaceClosedEvent.class.st
@@ -19,24 +19,10 @@ space close
 Class {
 	#name : #BlSpaceClosedEvent,
 	#superclass : #BlSpaceEvent,
-	#instVars : [
-		'space'
-	],
 	#category : #'Bloc-Events-Type-Space'
 }
 
 { #category : #sending }
 BlSpaceClosedEvent >> sendTo: anObject [
 	anObject spaceClosedEvent: self
 ]
-
-{ #category : #accessing }
-BlSpaceClosedEvent >> space [
-
-	^ space
-]
-
-{ #category : #accessing }
-BlSpaceClosedEvent >> space: aSpace [
-	space := aSpace
-]
diff --git a/src/Bloc/BlSpaceDestroyedEvent.class.st b/src/Bloc/BlSpaceDestroyedEvent.class.st
@@ -7,19 +7,5 @@ This event is used by the debugger to stop the UI process so it should be used w
 Class {
 	#name : #BlSpaceDestroyedEvent,
 	#superclass : #BlSpaceEvent,
-	#instVars : [
-		'space'
-	],
 	#category : #'Bloc-Events-Type-Space'
 }
-
-{ #category : #accessing }
-BlSpaceDestroyedEvent >> space [
-
-	^ space
-]
-
-{ #category : #accessing }
-BlSpaceDestroyedEvent >> space: aSpace [
-	space := aSpace
-]
diff --git a/src/Bloc/BlSpaceDetachedEvent.class.st b/src/Bloc/BlSpaceDetachedEvent.class.st
@@ -4,18 +4,5 @@ Is sent by the space after is it detached from the universe.
 Class {
 	#name : #BlSpaceDetachedEvent,
 	#superclass : #BlSpaceEvent,
-	#instVars : [
-		'space'
-	],
 	#category : #'Bloc-Events-Type-Space'
 }
-
-{ #category : #accessing }
-BlSpaceDetachedEvent >> space [
-	^ space
-]
-
-{ #category : #accessing }
-BlSpaceDetachedEvent >> space: anObject [
-	space := anObject
-]
diff --git a/src/Bloc/BlSpaceEventsProcessedEvent.class.st b/src/Bloc/BlSpaceEventsProcessedEvent.class.st
@@ -1,6 +1,6 @@
 Class {
 	#name : #BlSpaceEventsProcessedEvent,
-	#superclass : #BlSpaceStepEvent,
+	#superclass : #BlSpacePhaseEvent,
 	#category : #'Bloc-Events-Type-Space'
 }
 

diff --git a/src/Bloc/BlSpaceFrameDrawingPhase.class.st b/src/Bloc/BlSpaceFrameDrawingPhase.class.st
@@ -16,7 +16,9 @@ BlSpaceFrameDrawingPhase >> name [
 
 { #category : #actions }
 BlSpaceFrameDrawingPhase >> runOn: aSpace [
+
 	aSpace
 		dispatchTimeEvent: BlSpaceRenderEndEvent
-		during: [ :theSpace | BlSpaceRenderSignal for: theSpace block: [ theSpace render ] ]
+		during: [ :theSpace |
+			BlSpaceRenderSignal for: theSpace block: [ theSpace render ] ]
 ]
diff --git a/src/Bloc/BlSpaceFrameLayoutPhase.class.st b/src/Bloc/BlSpaceFrameLayoutPhase.class.st
@@ -16,7 +16,8 @@ BlSpaceFrameLayoutPhase >> name [
 
 { #category : #actions }
 BlSpaceFrameLayoutPhase >> runOn: aSpace [
+
 	aSpace
 		dispatchTimeEvent: BlSpaceLayoutEndEvent
-		during: [ :theSpace | theSpace doLayout ].
+		during: [ :theSpace | theSpace doLayout ]
 ]
diff --git a/src/Bloc/BlSpaceFrameTaskPhase.class.st b/src/Bloc/BlSpaceFrameTaskPhase.class.st
@@ -16,7 +16,8 @@ BlSpaceFrameTaskPhase >> name [
 
 { #category : #actions }
 BlSpaceFrameTaskPhase >> runOn: aSpace [
-	"process animations and other runnable tasks"
+	"Process animations and other runnable tasks"
+
 	aSpace
 		dispatchTimeEvent: BlSpaceTasksEndEvent
 		during: [ :theSpace | theSpace runTasks ]

diff --git a/src/Bloc/BlSpaceLayoutEndEvent.class.st b/src/Bloc/BlSpaceLayoutEndEvent.class.st
@@ -1,5 +1,5 @@
 Class {
 	#name : #BlSpaceLayoutEndEvent,
-	#superclass : #BlSpaceStepEvent,
+	#superclass : #BlSpacePhaseEvent,
 	#category : #'Bloc-Events-Type-Space'
 }