From f8e12071ec1808a38e861843a691282b756c2c05 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jo=C3=A3o=20Pedro=20Braz?= <brazjoaopedro@ymail.com>
Date: Sun, 10 Mar 2024 00:58:05 -0300
Subject: [PATCH] Collapse any duplicated events when flusing the event queue.

---
 src/Bloc/BlEvent.class.st            |  7 +++++++
 src/Bloc/BlHostEventFetcher.class.st | 16 ++++++++++++----
 src/Bloc/BlMouseMoveEvent.class.st   |  5 +++++
 3 files changed, 24 insertions(+), 4 deletions(-)

diff --git a/src/Bloc/BlEvent.class.st b/src/Bloc/BlEvent.class.st
index ce540bf01..2d8792b6d 100644
--- a/src/Bloc/BlEvent.class.st
+++ b/src/Bloc/BlEvent.class.st
@@ -151,6 +151,13 @@ BlEvent >> bubblingTarget: aTBlEventTarget [
 	currentTarget := aTBlEventTarget
 ]
 
+{ #category : #accessing }
+BlEvent >> canBeCollapsed [
+	"Whether I can be skipped in case there's too many of myself queued."
+
+	^ false
+]
+
 { #category : #testing }
 BlEvent >> canBePropagated [
 	<return: #Boolean>
diff --git a/src/Bloc/BlHostEventFetcher.class.st b/src/Bloc/BlHostEventFetcher.class.st
index 2d3add87f..bc466934c 100644
--- a/src/Bloc/BlHostEventFetcher.class.st
+++ b/src/Bloc/BlHostEventFetcher.class.st
@@ -11,7 +11,7 @@ Class {
 		'eventQueue',
 		'hostSpace'
 	],
-	#category : 'Bloc-Universe - Host'
+	#category : #'Bloc-Universe - Host'
 }
 
 { #category : #accessing }
@@ -35,11 +35,19 @@ BlHostEventFetcher >> enqueueEvent: aBlEvent [
 
 { #category : #'event processing' }
 BlHostEventFetcher >> fetchedEventsDo: aBlock [
-	"Flush event queue and evaluate a given block with every queued event as argument"
-	| theEvents |
+	"Flush event queue and evaluate a given block with every queued event as argument, also
+	collapses any events that can be replaced by newer ones."
 
+	| theEvents |
 	theEvents := LinkedList new.
-	eventQueue flush: [ :anEvent | theEvents add: anEvent ].
+	eventQueue
+		flush: [ :anEvent | 
+			| theLastEvent |
+			(anEvent canBeCollapsed
+				and: [ theEvents isNotEmpty
+						and: [ (theLastEvent := theEvents last) class = anEvent class ] ])
+				ifTrue: [ theEvents at: theEvents size put: anEvent ]
+				ifFalse: [ theEvents add: anEvent ] ].
 	theEvents do: aBlock
 ]
 
diff --git a/src/Bloc/BlMouseMoveEvent.class.st b/src/Bloc/BlMouseMoveEvent.class.st
index 3d93ebedd..021fb6212 100644
--- a/src/Bloc/BlMouseMoveEvent.class.st
+++ b/src/Bloc/BlMouseMoveEvent.class.st
@@ -49,6 +49,11 @@ BlMouseMoveEvent class >> secondary [
 	^ self button: BlMouseButton secondary
 ]
 
+{ #category : #accessing }
+BlMouseMoveEvent >> canBeCollapsed [
+	^ true
+]
+
 { #category : #accessing }
 BlMouseMoveEvent >> delta [
 	^ delta