From e058c892b5069885842896f901dc5b7875200de5 Mon Sep 17 00:00:00 2001
From: Pablo Tesone <tesonep@gmail.com>
Date: Fri, 15 Nov 2024 10:28:44 +0100
Subject: [PATCH 1/2] - Adding stats window showing phases, GCs and FPS. -
 Adding extension methods to show them in the space

---
 src/Bloc-DevTool/BlBenchmarkConsole.class.st  | 102 ---------
 .../BlProfilingSpaceFrame.class.st            |  54 +++++
 src/Bloc-DevTool/BlSpace.extension.st         |  42 ++++
 src/Bloc-DevTool/BlSpaceStatistics.class.st   | 209 ++++++++++++++++++
 .../BlSpaceStatisticsWindow.class.st          | 122 ++++++++++
 5 files changed, 427 insertions(+), 102 deletions(-)
 delete mode 100644 src/Bloc-DevTool/BlBenchmarkConsole.class.st
 create mode 100644 src/Bloc-DevTool/BlProfilingSpaceFrame.class.st
 create mode 100644 src/Bloc-DevTool/BlSpaceStatistics.class.st
 create mode 100644 src/Bloc-DevTool/BlSpaceStatisticsWindow.class.st

diff --git a/src/Bloc-DevTool/BlBenchmarkConsole.class.st b/src/Bloc-DevTool/BlBenchmarkConsole.class.st
deleted file mode 100644
index 42a85604d..000000000
--- a/src/Bloc-DevTool/BlBenchmarkConsole.class.st
+++ /dev/null
@@ -1,102 +0,0 @@
-Class {
-	#name : #BlBenchmarkConsole,
-	#superclass : #BlElement,
-	#instVars : [
-		'fpsShape',
-		'renderTimeShape',
-		'eventProcessingShape',
-		'layoutingShape'
-	],
-	#category : #'Bloc-DevTool-Core'
-}
-
-{ #category : #'as yet unclassified' }
-BlBenchmarkConsole class >> on: aStage [
-	^ self new
-		listenSpace: aStage;
-		yourself
-]
-
-{ #category : #benchmark }
-BlBenchmarkConsole >> eventProcessingTime: aNumber [
-	eventProcessingShape text: (BlRopedText string: 'event time: ', aNumber asString)
-]
-
-{ #category : #benchmark }
-BlBenchmarkConsole >> fps: aNumber [
-	fpsShape text: (BlRopedText string: 'fps: ', aNumber asString)
-]
-
-{ #category : #initialization }
-BlBenchmarkConsole >> initialize [
-	super initialize.
-	
-	self constraintsDo: [ :c |
-		c horizontal exact: 100.
-		c vertical fitContent.
-		c padding: (BlInsets all: 5) ].
-	
-	self border:(BlBorder paint: Color black width: 2).
-	self background: (Color white alpha: 0.9).
-	
-	fpsShape := BlTextElement new.
-	fpsShape constraintsDo: [ :c |
-		c horizontal fitContent.
-		c vertical fitContent.
-		c padding: (BlInsets all: 2) ].
-	renderTimeShape := BlTextElement new.
-	renderTimeShape constraintsDo: [ :c |
-		c horizontal fitContent.
-		c vertical fitContent.
-		c padding: (BlInsets all: 2) ].
-	eventProcessingShape := BlTextElement new.
-	eventProcessingShape constraintsDo: [ :c |
-		c horizontal fitContent.
-		c vertical fitContent.
-		c padding: (BlInsets all: 2) ].
-	layoutingShape := BlTextElement new.
-	layoutingShape constraintsDo: [ :c |
-		c horizontal fitContent.
-		c vertical fitContent.
-		c padding: (BlInsets all: 2) ].
-
-	self
-		layout: (BlLinearLayout vertical);
-		addChild: fpsShape;
-		addChild: renderTimeShape
-]
-
-{ #category : #benchmark }
-BlBenchmarkConsole >> layoutTime: aNumber [
-	layoutingShape text: (BlRopedText string: 'layout time: ', aNumber asString)
-]
-
-{ #category : #initialization }
-BlBenchmarkConsole >> listenSpace: aSpace [
-	| lastTime frames framesLimit |
-	lastTime := aSpace time now.
-	frames := 0.
-	framesLimit := 120.
-	aSpace addEventHandler: 
-		(BlEventHandler on: BlSpaceRenderEndEvent do: [ :evt | 
-				frames := frames + 1.
-				frames % framesLimit = 0
-					ifTrue: [
-						self fps: (1000.0 /( ((evt end - lastTime) / framesLimit) asMilliSeconds max:1)) ceiling.
-						lastTime := evt end.
-						frames := 0 ].
-				self renderTime: (evt end - evt start) ]).
-	aSpace addEventHandler: 
-		(BlEventHandler on: BlSpaceEventsProcessedEvent do: [ :evt | 
-					self eventProcessingTime: (evt end - evt start). 
-					  ]).
-  	aSpace addEventHandler: 
-		(BlEventHandler on: BlSpaceLayoutEndEvent do: [ :evt | 
-					self layoutTime: (evt end - evt start). 
-					  ])
-]
-
-{ #category : #benchmark }
-BlBenchmarkConsole >> renderTime: aNumber [
-	renderTimeShape text: (BlRopedText string: 'render time: ', aNumber asString)
-]
diff --git a/src/Bloc-DevTool/BlProfilingSpaceFrame.class.st b/src/Bloc-DevTool/BlProfilingSpaceFrame.class.st
new file mode 100644
index 000000000..2ddd3f524
--- /dev/null
+++ b/src/Bloc-DevTool/BlProfilingSpaceFrame.class.st
@@ -0,0 +1,54 @@
+"
+I am a subclass of BlSpaceFrame to replace the it with profiling extensions
+"
+Class {
+	#name : #BlProfilingSpaceFrame,
+	#superclass : #BlSpaceFrame,
+	#instVars : [
+		'spaceStatistics'
+	],
+	#category : #'Bloc-DevTool-Profiling'
+}
+
+{ #category : #initialization }
+BlProfilingSpaceFrame >> fillFrom: aBlSpaceFrame [ 
+	
+	id := aBlSpaceFrame id.
+	phases := aBlSpaceFrame phases. 
+	currentPhaseLink := (aBlSpaceFrame instVarNamed: #currentPhaseLink)
+]
+
+{ #category : #running }
+BlProfilingSpaceFrame >> runCurrentPhaseOn: aSpace [
+
+	| millis |
+	millis := [ self currentPhase runOn: aSpace ] millisecondsToRun.
+
+	spaceStatistics recordMilliseconds: millis forFramePhase: self currentPhase 
+]
+
+{ #category : #running }
+BlProfilingSpaceFrame >> runOn: aSpace [
+	self incrementFrameId.
+
+	spaceStatistics frameStarted: id.
+
+	self runCurrentPhaseOn: aSpace.
+
+	[ self hasNextPhase ] whileTrue: [
+		self switchToNextPhase.
+		self runCurrentPhaseOn: aSpace ].
+
+	"move back to the first phase"
+	self switchToNextPhase.
+	
+	spaceStatistics frameEnded: id.
+
+]
+
+{ #category : #accessing }
+BlProfilingSpaceFrame >> spaceStatistics: aPRSpaceStatistics [ 
+
+	spaceStatistics := aPRSpaceStatistics 
+
+]
diff --git a/src/Bloc-DevTool/BlSpace.extension.st b/src/Bloc-DevTool/BlSpace.extension.st
index b5b6ed1ea..e98e28ad6 100644
--- a/src/Bloc-DevTool/BlSpace.extension.st
+++ b/src/Bloc-DevTool/BlSpace.extension.st
@@ -5,3 +5,45 @@ BlSpace >> addHalosListener [
 
 	self root addEventFilter: BlDevHalosEventListener new
 ]
+
+{ #category : #'*Bloc-DevTool' }
+BlSpace >> enableStatistics [
+
+	| spaceStatistics |
+	
+	self spaceStatistics ifNotNil: [ ^ self ].
+	
+	spaceStatistics := BlSpaceStatistics new
+		space: self;
+		yourself.
+
+	frame := BlProfilingSpaceFrame new
+		         fillFrom: frame;
+				   spaceStatistics: spaceStatistics;
+		         yourself.
+		
+	self addEventHandlerOn: BlSpaceShownEvent do: [ spaceStatistics spaceShown ]. 
+	self addEventHandlerOn: BlSpaceClosedEvent do: [ spaceStatistics spaceClosed ]. 
+	
+	self userData at: #spaceStatistics put: spaceStatistics
+]
+
+{ #category : #'*Bloc-DevTool' }
+BlSpace >> showStatisticsWindow [
+	
+	(BlSpaceStatisticsWindow for: self) open 
+]
+
+{ #category : #'*Bloc-DevTool' }
+BlSpace >> showStatisticsWindowAndKeptOpen [
+	
+	(BlSpaceStatisticsWindow for: self) 
+		keepOpened;
+		open 
+]
+
+{ #category : #'*Bloc-DevTool' }
+BlSpace >> spaceStatistics [
+
+	^ self userData at: #spaceStatistics ifAbsent: [ nil ].
+]
diff --git a/src/Bloc-DevTool/BlSpaceStatistics.class.st b/src/Bloc-DevTool/BlSpaceStatistics.class.st
new file mode 100644
index 000000000..0ee4375b9
--- /dev/null
+++ b/src/Bloc-DevTool/BlSpaceStatistics.class.st
@@ -0,0 +1,209 @@
+"
+I collect the statistics of executing an space.
+- FPS
+- GCs
+- Duration of Phases
+"
+Class {
+	#name : #BlSpaceStatistics,
+	#superclass : #Object,
+	#instVars : [
+		'space',
+		'totalFrames',
+		'durationPerPhase',
+		'currentFrames',
+		'previousMillisecond',
+		'fps',
+		'listeners',
+		'service',
+		'fullGCDuringLastPeriod',
+		'incrementalGCDuringLastPeriod',
+		'fullGCCount',
+		'incrementalGCCount',
+		'lastFullGCCount',
+		'lastIncrementalGCCount',
+		'totalTime'
+	],
+	#category : #'Bloc-DevTool-Profiling'
+}
+
+{ #category : #events }
+BlSpaceStatistics >> doUpdate [
+
+	self updateValues.
+	listeners do: [ :e | e refresh ]
+]
+
+{ #category : #accessing }
+BlSpaceStatistics >> fps [
+
+	^ fps 
+]
+
+{ #category : #events }
+BlSpaceStatistics >> frameEnded: id [
+
+	currentFrames := currentFrames + 1.
+	totalFrames := totalFrames + 1.
+
+
+]
+
+{ #category : #events }
+BlSpaceStatistics >> frameStarted: id [
+
+	
+]
+
+{ #category : #accessing }
+BlSpaceStatistics >> fullFPS [
+	
+	^ (totalFrames / (self totalTime / 1000)) asFloat
+]
+
+{ #category : #accessing }
+BlSpaceStatistics >> fullGCCount [
+
+	^ fullGCCount
+]
+
+{ #category : #accessing }
+BlSpaceStatistics >> fullGCCount: anObject [
+
+	fullGCCount := anObject
+]
+
+{ #category : #accessing }
+BlSpaceStatistics >> fullGCDuringLastPeriod [
+			
+	^ fullGCDuringLastPeriod
+]
+
+{ #category : #accessing }
+BlSpaceStatistics >> incrementalGCCount [
+
+	^ incrementalGCCount
+]
+
+{ #category : #accessing }
+BlSpaceStatistics >> incrementalGCCount: anObject [
+
+	incrementalGCCount := anObject
+]
+
+{ #category : #accessing }
+BlSpaceStatistics >> incrementalGCDuringLastPeriod [
+			
+	^ incrementalGCDuringLastPeriod
+]
+
+{ #category : #initialization }
+BlSpaceStatistics >> initialize [
+
+	super initialize.
+	totalFrames := 0.
+	durationPerPhase := Dictionary new.
+
+	fps := 0.
+	previousMillisecond := 0.
+	totalTime := 0.
+	currentFrames := 0.
+	listeners := OrderedCollection new.
+	
+	fullGCDuringLastPeriod := 0.
+	incrementalGCDuringLastPeriod := 0.
+	
+	fullGCCount := 0.
+	lastFullGCCount := 0.
+	
+	incrementalGCCount := 0.
+	lastIncrementalGCCount := 0.
+]
+
+{ #category : #accessing }
+BlSpaceStatistics >> phaseStatistics [
+
+	| total |
+
+	total := durationPerPhase sumNumbers.
+	
+	^ space frame phases collect: [ :e | | duration |
+		duration := durationPerPhase at: e ifAbsent: [0].
+		{ e. duration milliSeconds. total = 0 ifTrue: [0] ifFalse: [(duration / total) asFloat] } ].
+]
+
+{ #category : #events }
+BlSpaceStatistics >> recordMilliseconds: millis forFramePhase: phase [
+
+	| value |
+	value := durationPerPhase at: phase ifAbsent: [ 0 ].
+	durationPerPhase at: phase put: (value + millis)
+]
+
+{ #category : #'API - listeners' }
+BlSpaceStatistics >> registerListener: aPRSpaceStatisticsWindow [ 
+	
+	listeners add: aPRSpaceStatisticsWindow 
+]
+
+{ #category : #accessing }
+BlSpaceStatistics >> space: aBlSpace [
+
+	space := aBlSpace 
+]
+
+{ #category : #events }
+BlSpaceStatistics >> spaceClosed [
+
+	service ifNotNil: [service stop].
+	
+	self updateValues.
+
+	listeners do: [:e | e closed].
+]
+
+{ #category : #events }
+BlSpaceStatistics >> spaceShown [
+
+	lastFullGCCount := Smalltalk vm fullGCCount.
+	lastIncrementalGCCount := Smalltalk vm incrementalGCCount.
+
+	previousMillisecond := Time millisecondClockValue.
+	service := TKTParameterizableService new 
+		name: 'Update Space Statistics ' , self identityHash printString;
+		step: [ self doUpdate ];
+		start;
+		yourself
+]
+
+{ #category : #accessing }
+BlSpaceStatistics >> totalTime [
+
+	^ totalTime
+]
+
+{ #category : #private }
+BlSpaceStatistics >> updateValues [
+
+	| currentIncrementalGCCount currentMillisecond currentFullGCCount |
+	currentMillisecond := Time millisecondClockValue.
+
+	totalTime := totalTime + (currentMillisecond - previousMillisecond).
+
+	fps := (currentFrames
+	        / (currentMillisecond - previousMillisecond / 1000)) asFloat.
+	previousMillisecond := Time millisecondClockValue.
+	currentFrames := 0.
+
+	currentFullGCCount := Smalltalk vm fullGCCount.
+	fullGCDuringLastPeriod := currentFullGCCount - lastFullGCCount.
+	fullGCCount := fullGCCount + fullGCDuringLastPeriod.
+	lastFullGCCount := currentFullGCCount.
+
+	currentIncrementalGCCount := Smalltalk vm incrementalGCCount.
+	incrementalGCDuringLastPeriod := currentIncrementalGCCount
+	                                 - lastIncrementalGCCount.
+	incrementalGCCount := incrementalGCCount
+	                      + incrementalGCDuringLastPeriod.
+	lastIncrementalGCCount := currentIncrementalGCCount
+]
diff --git a/src/Bloc-DevTool/BlSpaceStatisticsWindow.class.st b/src/Bloc-DevTool/BlSpaceStatisticsWindow.class.st
new file mode 100644
index 000000000..0dec1f85e
--- /dev/null
+++ b/src/Bloc-DevTool/BlSpaceStatisticsWindow.class.st
@@ -0,0 +1,122 @@
+"
+I open an small window with the statistics of BlSpaceStatistics
+"
+Class {
+	#name : #BlSpaceStatisticsWindow,
+	#superclass : #Object,
+	#instVars : [
+		'space',
+		'statiticsElement',
+		'statistics',
+		'fpsElement',
+		'fullGCsElements',
+		'incrementalGCsElements',
+		'phaseTimes',
+		'phaseNames',
+		'shouldClose'
+	],
+	#category : #'Bloc-DevTool-Profiling'
+}
+
+{ #category : #'instance creation' }
+BlSpaceStatisticsWindow class >> for: aBlSpace [
+
+	aBlSpace enableStatistics.
+
+	^ self basicNew
+		  initializeFor: aBlSpace spaceStatistics;
+		  yourself
+]
+
+{ #category : #actions }
+BlSpaceStatisticsWindow >> closed [
+
+	shouldClose ifTrue: [space close]
+]
+
+{ #category : #initialization }
+BlSpaceStatisticsWindow >> createStatisticsElement [
+
+	statiticsElement := BlElement new.
+	statiticsElement constraintsDo: [ :c |
+		c horizontal matchParent.
+		c vertical matchParent ].
+	
+	statiticsElement layout: (BlGridLayout horizontal
+			 columnCount: 2;
+			 cellSpacing: 3;
+			 yourself).
+
+	statiticsElement addChildren: {
+			('FPS' asRopedText asElement
+				 width: 100;
+				 yourself).
+			(fpsElement := 'xxx' asRopedText asElement).
+			'FullGCs' asRopedText asElement.
+			(fullGCsElements := 'xxx' asRopedText asElement).
+			'IncrementalGCs' asRopedText asElement.
+			(incrementalGCsElements := 'xxx' asRopedText asElement) }.
+			
+	statiticsElement addChildren: { 
+		BlElement new height: 10; yourself.
+		BlElement new height: 10; yourself.
+		'Phase' asRopedText bold asElement.
+		'Time' asRopedText bold asElement.
+	 }.
+	
+	phaseNames := (1 to: 15) collect: [:e | '' asRopedText asElement ].
+	phaseTimes := (1 to: phaseNames size) collect: [:e | '' asRopedText asElement ].
+
+	phaseNames with: phaseTimes do: [ :aName :aTime | statiticsElement addChild: aName; addChild: aTime ]
+]
+
+{ #category : #actions }
+BlSpaceStatisticsWindow >> doRefresh [
+
+	| phaseStats |
+
+	fpsElement text: (statistics fps printString , ' / ' , statistics fullFPS printString) asRopedText. 
+	fullGCsElements text: (statistics fullGCDuringLastPeriod printString , ' / ' , statistics fullGCCount printString) asRopedText. 
+	incrementalGCsElements text: (statistics incrementalGCDuringLastPeriod printString , ' / ' , statistics incrementalGCCount printString) asRopedText.
+	
+	phaseStats := statistics phaseStatistics.
+	
+	phaseNames withIndexDo: [ :nameElement :index | |timeElement stats|
+		timeElement := phaseTimes at: index.
+		phaseStats size >= index 
+			ifTrue: [ 
+				stats := phaseStats at: index.
+				nameElement text: stats first name asRopedText .
+				timeElement text: ('{1} / {2} %' format: { stats second. (stats third * 100) roundTo: 0.01 }) asRopedText]
+			ifFalse: [ timeElement text: '' asRopedText. nameElement text: '' asRopedText ]]
+]
+
+{ #category : #initialization }
+BlSpaceStatisticsWindow >> initializeFor: aPRSpaceStatistics [ 
+
+	statistics := aPRSpaceStatistics.
+	statistics registerListener: self.
+	
+	space := BlSpace new.
+	self createStatisticsElement.
+	space root addChild: statiticsElement.
+	shouldClose := true.
+]
+
+{ #category : #actions }
+BlSpaceStatisticsWindow >> keepOpened [
+
+	shouldClose := false
+]
+
+{ #category : #actions }
+BlSpaceStatisticsWindow >> open [
+	
+	space show
+]
+
+{ #category : #actions }
+BlSpaceStatisticsWindow >> refresh [
+
+	space universe defer: [ self doRefresh ]
+]

From e068977c4523bf9b02aebf4ec81c18f0e69989b7 Mon Sep 17 00:00:00 2001
From: Pablo Tesone <tesonep@gmail.com>
Date: Tue, 19 Nov 2024 14:52:49 +0100
Subject: [PATCH 2/2] Adding total frames and FPS samples in every second.

---
 src/Bloc-DevTool/BlSpaceStatistics.class.st | 33 +++++++++++++++++----
 1 file changed, 27 insertions(+), 6 deletions(-)

diff --git a/src/Bloc-DevTool/BlSpaceStatistics.class.st b/src/Bloc-DevTool/BlSpaceStatistics.class.st
index 0ee4375b9..bdc4514e6 100644
--- a/src/Bloc-DevTool/BlSpaceStatistics.class.st
+++ b/src/Bloc-DevTool/BlSpaceStatistics.class.st
@@ -14,6 +14,7 @@ Class {
 		'currentFrames',
 		'previousMillisecond',
 		'fps',
+		'fpsSamples',
 		'listeners',
 		'service',
 		'fullGCDuringLastPeriod',
@@ -22,7 +23,8 @@ Class {
 		'incrementalGCCount',
 		'lastFullGCCount',
 		'lastIncrementalGCCount',
-		'totalTime'
+		'totalTime',
+		'hasClosed'
 	],
 	#category : #'Bloc-DevTool-Profiling'
 }
@@ -40,6 +42,12 @@ BlSpaceStatistics >> fps [
 	^ fps 
 ]
 
+{ #category : #accessing }
+BlSpaceStatistics >> fpsSamples [
+
+	^ fpsSamples 
+]
+
 { #category : #events }
 BlSpaceStatistics >> frameEnded: id [
 
@@ -105,6 +113,7 @@ BlSpaceStatistics >> initialize [
 	durationPerPhase := Dictionary new.
 
 	fps := 0.
+	fpsSamples := OrderedCollection new: 50.
 	previousMillisecond := 0.
 	totalTime := 0.
 	currentFrames := 0.
@@ -118,6 +127,8 @@ BlSpaceStatistics >> initialize [
 	
 	incrementalGCCount := 0.
 	lastIncrementalGCCount := 0.
+	
+	hasClosed := false.
 ]
 
 { #category : #accessing }
@@ -141,9 +152,9 @@ BlSpaceStatistics >> recordMilliseconds: millis forFramePhase: phase [
 ]
 
 { #category : #'API - listeners' }
-BlSpaceStatistics >> registerListener: aPRSpaceStatisticsWindow [ 
+BlSpaceStatistics >> registerListener: aPRSpaceStatisticsListener [
 	
-	listeners add: aPRSpaceStatisticsWindow 
+	listeners add: aPRSpaceStatisticsListener 
 ]
 
 { #category : #accessing }
@@ -155,11 +166,15 @@ BlSpaceStatistics >> space: aBlSpace [
 { #category : #events }
 BlSpaceStatistics >> spaceClosed [
 
+	hasClosed ifTrue: [ ^self ].
+	hasClosed := true.
+	
 	service ifNotNil: [service stop].
 	
 	self updateValues.
 
 	listeners do: [:e | e closed].
+
 ]
 
 { #category : #events }
@@ -176,6 +191,12 @@ BlSpaceStatistics >> spaceShown [
 		yourself
 ]
 
+{ #category : #accessing }
+BlSpaceStatistics >> totalFrames [
+	
+	^ totalFrames
+]
+
 { #category : #accessing }
 BlSpaceStatistics >> totalTime [
 
@@ -190,9 +211,9 @@ BlSpaceStatistics >> updateValues [
 
 	totalTime := totalTime + (currentMillisecond - previousMillisecond).
 
-	fps := (currentFrames
-	        / (currentMillisecond - previousMillisecond / 1000)) asFloat.
-	previousMillisecond := Time millisecondClockValue.
+	fps := (currentFrames/ (currentMillisecond - previousMillisecond / 1000)) asFloat.
+	fpsSamples add: { currentMillisecond. fps }.
+	previousMillisecond := currentMillisecond.
 	currentFrames := 0.
 
 	currentFullGCCount := Smalltalk vm fullGCCount.