PureBasic

Code : Tout sélectionner

;============================================================
;  PubSub.pbi
;
;  Lightweight pub-sub for PureBasic apps. Independent of PureBasic's built-in event loop: use any integer as an event ID and route it through Subscribe / Emit.
;
;  Features:
;    - Subscribe / Unsubscribe / Emit
;    - Clear / ClearAll
;    - Optional payload pointer carried to every listener
;    - Listener priorities (higher fires first)
;    - One-shot listeners (auto-removed after their first call)
;    - Safe under re-entrant emits from inside a callback
;
;  Usage:
;    Procedure OnSomething(EventID, *Payload)
;       Debug "fired: " + EventID
;    EndProcedure
;
;    PubSub::Subscribe(#MyEvent, @OnSomething(), PubSub::#Priority_High)
;    PubSub::Emit(#MyEvent)
;

DeclareModule PubSub
	; Callback signature. Every listener gets the event ID it was fired for and the *Payload pointer that the emitter passed (which may be #Null).
	Prototype Listener(EventID, *Payload)
	
	Enumeration ; Priority shortcuts. Any integer works; these are just helpers.
		#Priority_Lowest  = -1000
		#Priority_Low     = -100
		#Priority_Normal  = 0
		#Priority_High    = 100
		#Priority_Highest = 1000
	EndEnumeration
	
	; Public procedures declaration
	Declare   Subscribe(EventID.i, *Callback.Listener, Priority.l = #Priority_Normal, OneShot.a = #False)
	Declare   Unsubscribe(EventID.i, *Callback.Listener)
	Declare   Emit(EventID.i, *Payload = #Null)
	Declare   Clear(EventID.i)
	Declare   ClearAll()
	Declare.i ListenerCount(EventID.i)
EndDeclareModule

Module PubSub
	EnableExplicit
	; Private variables, structures and constants
	Structure ListenerEntry
		Callback.i
		Priority.l
		OneShot.a
	EndStructure
	
	Structure EventBucket
		EventID.i
		List Listeners.ListenerEntry()
	EndStructure
	
	Global NewMap Events.EventBucket()
	
	; Public procedures
	Procedure Subscribe(EventID.i, *Callback.Listener, Priority.l = #Priority_Normal, OneShot.a = #False)
		Protected Key.s = Str(EventID)
		Protected Inserted = #False
		
		If Not FindMapElement(Events(), Key)
			AddMapElement(Events(), Key)
			Events()\EventID = EventID
		EndIf
		
		; Insert before the first existing listener with strictly lower priority, so equal-priority listeners preserve subscription order (FIFO).
		ForEach Events()\Listeners()
			If Events()\Listeners()\Priority < Priority
				InsertElement(Events()\Listeners())
				Inserted = #True
				Break
			EndIf
		Next
		
		If Not Inserted
			LastElement(Events()\Listeners())
			AddElement(Events()\Listeners())
		EndIf
		
		Events()\Listeners()\Callback = *Callback
		Events()\Listeners()\Priority = Priority
		Events()\Listeners()\OneShot  = OneShot
	EndProcedure
	
	Procedure Unsubscribe(EventID.i, *Callback.Listener)
		Protected Key.s = Str(EventID)
		
		If Not FindMapElement(Events(), Key)
			ProcedureReturn
		EndIf
		
		ForEach Events()\Listeners()
			If Events()\Listeners()\Callback = *Callback
				DeleteElement(Events()\Listeners())
				Break
			EndIf
		Next
		
		If ListSize(Events()\Listeners()) = 0
			DeleteMapElement(Events())
		EndIf
	EndProcedure
	
	Procedure Emit(EventID.i, *Payload = #Null)
		Protected Key.s = Str(EventID)
		Protected i, Count
		Protected Cb.Listener
		
		If Not FindMapElement(Events(), Key)
			ProcedureReturn
		EndIf
		
		Count = ListSize(Events()\Listeners())
		If Count = 0
			ProcedureReturn
		EndIf
		
		; Snapshot listeners before firing; a callback may Subscribe, Unsubscribe, Clear, or Emit recursively, and we must not let that corrupt iteration of the live list.
		Protected Dim Snapshot.ListenerEntry(Count - 1)
		i = 0
		ForEach Events()\Listeners()
			Snapshot(i)\Callback = Events()\Listeners()\Callback
			Snapshot(i)\Priority = Events()\Listeners()\Priority
			Snapshot(i)\OneShot  = Events()\Listeners()\OneShot
			i + 1
		Next
		
		; Fire snapshot in stored order (already priority-sorted).
		For i = 0 To Count - 1
			Cb = Snapshot(i)\Callback
			Cb(EventID, *Payload)
		Next
		
		; Sweep one-shots that fired. The bucket may have been mutated
		; or removed by a recursive call, so re-find before touching.
		If FindMapElement(Events(), Key)
			For i = 0 To Count - 1
				If Snapshot(i)\OneShot
					ForEach Events()\Listeners()
						If Events()\Listeners()\Callback = Snapshot(i)\Callback And Events()\Listeners()\OneShot
							DeleteElement(Events()\Listeners())
							Break
						EndIf
					Next
				EndIf
			Next
			
			If ListSize(Events()\Listeners()) = 0
				DeleteMapElement(Events())
			EndIf
		EndIf
	EndProcedure
	
	Procedure Clear(EventID.i)
		Protected Key.s = Str(EventID)
		If FindMapElement(Events(), Key)
			DeleteMapElement(Events())
		EndIf
	EndProcedure
	
	Procedure ClearAll()
		ClearMap(Events())
	EndProcedure
	
	Procedure.i ListenerCount(EventID.i)
		Protected Key.s = Str(EventID)
		If FindMapElement(Events(), Key)
			ProcedureReturn ListSize(Events()\Listeners())
		EndIf
		ProcedureReturn 0
	EndProcedure
EndModule

CompilerIf #PB_Compiler_IsMainFile
	XIncludeFile "PubSub.pbi"
	
	#Event_Hello = 1
	#Event_Bye   = 2
	
	Procedure A(EventID, *Payload)
		Debug "A fired on " + EventID
	EndProcedure
	
	Procedure B(EventID, *Payload)
		Debug "B fired on " + EventID + "  payload=" + PeekS(*Payload)
	EndProcedure
	
	Procedure Once(EventID, *Payload)
		Debug "one-shot fired on " + EventID
	EndProcedure
	
	PubSub::Subscribe(#Event_Hello, @A(), PubSub::#Priority_Low)
	PubSub::Subscribe(#Event_Hello, @B(), PubSub::#Priority_High)   ; fires before A
	PubSub::Subscribe(#Event_Hello, @Once(), PubSub::#Priority_Normal, #True)
	
	Define msg.s = "world"
	PubSub::Emit(#Event_Hello, @msg)   ; B, Once, A
	PubSub::Emit(#Event_Hello, @msg)   ; B, A   (Once is gone)
	
	Debug "listeners on #Event_Hello: " + PubSub::ListenerCount(#Event_Hello)
	PubSub::ClearAll()
	Debug "after ClearAll: " + PubSub::ListenerCount(#Event_Hello)
CompilerEndIf