unit Myc.Core.Signals; interface uses System.SysUtils, Myc.Core.Notifier, Myc.Signals; type // TMycNullSignal implements a "null object" pattern for IMycState. // This state is always considered "set". TMycNullSignal = class(TInterfacedObject, TSignal.ISignal) public function Subscribe(Subscriber: TSignal.ISubscriber): Pointer; procedure Unsubscribe(Tag: Pointer); end; // TMycNullState implements a "null object" pattern for IMycState. // This state is always considered "set". TMycNullState = class(TInterfacedObject, TSignal.ISignal, TState.IState) protected // TState.IState function GetIsSet: Boolean; public function Subscribe(Subscriber: TSignal.ISubscriber): Pointer; procedure Unsubscribe(Tag: Pointer); end; // A state that acts as an event. It's state ist always set and it will always Trigger it's subscribers, if it gets notified by itself. TMycEvent = class(TInterfacedObject, TSignal.ISubscriber, TSignal.ISignal, TEvent.IEvent) strict private FSubscribers: TMycNotifyList; protected function GetSignal: TSignal; function GetIsSet: Boolean; public constructor Create; destructor Destroy; override; function Subscribe(Subscriber: TSignal.ISubscriber): Pointer; procedure Unsubscribe(Tag: Pointer); function Notify: Boolean; end; TMycNullEvent = class(TMycNullSignal, TEvent.IEvent) private function GetSignal: TSignal; function Notify: Boolean; end; TMycRouterEvent = class(TMycEvent) private FSignal: TSignal.ISignal; FSubscriptionTag: TSignal.TSubscriptionTag; public constructor Create(const ASignal: TSignal.ISignal); procedure AfterConstruction; override; procedure BeforeDestruction; override; end; // TMycLatch implements a countdown latch. // It is initialized with a count. Calls to its Notify method (as an TSignal.ISubscriber) // decrement this count. When the count reaches zero, the latch transitions to the "set" // state (IsSet becomes true), notifies its current subscribers once, and then remains set. TMycLatch = class(TInterfacedObject, TSignal.ISubscriber, TSignal.ISignal, TState.IState, TLatch.ILatch) strict private FSubscribers: TMycNotifyList; // List of subscribers waiting for this latch to be set. private [volatile] FCount: Integer; // The internal countdown value for the latch. function GetState: TState; // Implementation for TLatch.ILatch.GetState and IFlag.GetState. protected function GetIsSet: Boolean; public // Creates the latch with an initial count. // If ACount is 0 or less, the latch is effectively pre-set (delegates to FNull via CreateLatch factory). constructor Create(ACount: Integer); destructor Destroy; override; // ISignal implementation function Subscribe(Subscriber: TSignal.ISubscriber): Pointer; procedure Unsubscribe(Tag: Pointer); // TSignal.ISubscriber implementation for TMycLatch itself. // Decrements the internal count. If the count reaches zero, // registered subscribers are notified, and the latch becomes permanently set. function Notify: Boolean; end; TMycNullLatch = class(TInterfacedObject, TSignal.ISubscriber, TLatch.ILatch) private function GetState: TState; function Notify: Boolean; end; // TMycFlag implements a resettable "dirty flag". // It can be explicitly set to dirty (via Notify) or reset to clean (via Reset). // Subscribers are notified of relevant state changes. TMycFlag = class(TInterfacedObject, TSignal.ISubscriber, TSignal.ISignal, TState.IState, TFlag.IFlag) strict private FSubscribers: TMycNotifyList; // List of subscribers interested in state changes of this dirty flag. private [volatile] FFlag: Boolean; // Internal state: true if dirty/set, false if clean/reset. function GetState: TState; protected function GetIsSet: Boolean; public // Creates a new dirty flag, initially set to dirty (true). constructor Create; destructor Destroy; override; // Factory method to create a new TMycFlag instance. class function CreateDirty: TFlag.IFlag; static; function Subscribe(Subscriber: TSignal.ISubscriber): Pointer; procedure Unsubscribe(Tag: Pointer); // TSignal.ISubscriber implementation for TMycFlag. // Sets this flag to dirty (true). Notifies subscribers if it transitioned from clean to dirty. function Notify: Boolean; // TFlag.IFlag implementation. Resets the flag to clean (false). function Reset: Boolean; end; TMycNullFlag = class(TInterfacedObject, TFlag.IFlag) private function GetState: TState; function Notify: Boolean; function Reset: Boolean; end; TMycObserverFlag = class(TMycFlag) private FSignal: TSignal.ISignal; FSubscriptionTag: TSignal.TSubscriptionTag; public constructor Create(const ASignal: TSignal.ISignal); procedure AfterConstruction; override; procedure BeforeDestruction; override; end; implementation uses System.SyncObjs; // For TInterlocked { TMycNullSignal } function TMycNullSignal.Subscribe(Subscriber: TSignal.ISubscriber): Pointer; begin // No ongoing subscription is necessary or meaningful for a null state. Result := nil; end; procedure TMycNullSignal.Unsubscribe(Tag: Pointer); begin // Unsubscribing from a null signal has no effect. end; { TMycNullState } function TMycNullState.GetIsSet: Boolean; begin Result := true; // Null state is always set. end; function TMycNullState.Subscribe(Subscriber: TSignal.ISubscriber): Pointer; begin // Since the state is always set, notify the subscriber immediately. if Assigned(Subscriber) then Subscriber.Notify; Result := nil; end; procedure TMycNullState.Unsubscribe(Tag: Pointer); begin // Unsubscribing from a null state has no effect. end; { TMycEvent } constructor TMycEvent.Create; begin inherited Create; FSubscribers.Create; end; destructor TMycEvent.Destroy; begin FSubscribers.Destroy; inherited; end; function TMycEvent.GetIsSet: Boolean; begin Result := true; end; function TMycEvent.GetSignal: TSignal; begin Result := Self; end; function TMycEvent.Notify: Boolean; begin FSubscribers.Lock; try FSubscribers.Notify(function(Subscriber: TSignal.ISubscriber): Boolean begin Result := Subscriber.Notify; end); finally FSubscribers.Release; end; Result := true; end; function TMycEvent.Subscribe(Subscriber: TSignal.ISubscriber): Pointer; begin Result := nil; if not Assigned(Subscriber) then exit; FSubscribers.Lock; try Subscriber.Notify; Result := FSubscribers.Advise(Subscriber); finally FSubscribers.Release; end; end; procedure TMycEvent.Unsubscribe(Tag: Pointer); begin if Tag = nil then exit; FSubscribers.Lock; try FSubscribers.Unadvise(Tag); finally FSubscribers.Release; end; end; { TMycRouterEvent } constructor TMycRouterEvent.Create(const ASignal: TSignal.ISignal); begin inherited Create; FSignal := ASignal; end; procedure TMycRouterEvent.AfterConstruction; begin inherited; FSubscriptionTag := FSignal.Subscribe(Self); end; procedure TMycRouterEvent.BeforeDestruction; begin FSignal.Unsubscribe(FSubscriptionTag); inherited; end; { TMycNullLatch } function TMycNullLatch.GetState: TState; begin Result := TState.Null; end; function TMycNullLatch.Notify: Boolean; begin Result := false; end; { TMycLatch } constructor TMycLatch.Create(ACount: Integer); begin inherited Create; Assert(ACount >= 0); FCount := ACount; FSubscribers.Create; end; destructor TMycLatch.Destroy; begin FSubscribers.Destroy; inherited; end; function TMycLatch.Notify: Boolean; var currentCountAfterDecrement: Integer; shouldNotifySubscribers: Boolean; begin FSubscribers.Lock; try currentCountAfterDecrement := TInterlocked.Decrement(FCount); if currentCountAfterDecrement < -MaxInt div 2 then TInterlocked.Increment(FCount); // Defend against extreme underflow. shouldNotifySubscribers := (currentCountAfterDecrement = 0); // Notify only on transition to zero. if shouldNotifySubscribers then begin FSubscribers.Notify(function(Subscriber: TSignal.ISubscriber): Boolean begin Result := Subscriber.Notify; end); end; // Returns true if the latch has not yet been set by this Notify call (count > 0). Result := currentCountAfterDecrement > 0; // If the latch is now set (or was already set), unadvise all subscribers. // This ensures one-shot notification for the current set of subscribers. if currentCountAfterDecrement <= 0 then FSubscribers.UnadviseAll; finally FSubscribers.Release; end; end; function TMycLatch.GetIsSet: Boolean; begin // The latch is set if its count has reached zero or less. Result := FCount <= 0; end; function TMycLatch.GetState: TState; begin // TMycLatch itself implements TState.IState. Result := Self; end; function TMycLatch.Subscribe(Subscriber: TSignal.ISubscriber): Pointer; var alreadySet: Boolean; begin Result := nil; if not Assigned(Subscriber) then exit; FSubscribers.Lock; try alreadySet := (FCount <= 0); // Check if latch is already set. if alreadySet then begin // If already set, notify immediately; no persistent subscription needed. Subscriber.Notify; end else begin // If not yet set, advise the subscriber. Result := FSubscribers.Advise(Subscriber); end; finally FSubscribers.Release; end; end; procedure TMycLatch.Unsubscribe(Tag: Pointer); begin if Tag = nil then exit; FSubscribers.Lock; try FSubscribers.Unadvise(Tag); finally FSubscribers.Release; end; end; { TMycNullFlag } function TMycNullFlag.GetState: TState; begin Result := TState.Null; end; function TMycNullFlag.Notify: Boolean; begin Result := false; end; function TMycNullFlag.Reset: Boolean; begin Result := true; end; { TMycFlag } constructor TMycFlag.Create; begin inherited Create; FFlag := false; FSubscribers.Create; end; class function TMycFlag.CreateDirty: TFlag.IFlag; begin // Factory method to create a new TMycFlag instance. Result := TMycFlag.Create; end; destructor TMycFlag.Destroy; begin FSubscribers.Destroy; // Clean up the subscriber list. inherited; end; function TMycFlag.Reset: Boolean; begin // Sets the flag to false (clean) and returns true if it was previously true (dirty). Result := TInterlocked.Exchange(FFlag, false); end; function TMycFlag.GetIsSet: Boolean; begin // IsSet is true if the flag is dirty (FFlag = true). Result := FFlag; end; function TMycFlag.GetState: TState; begin // TMycFlag itself implements TState.IState. Result := Self; end; function TMycFlag.Notify: Boolean; var wasPreviouslyClean: Boolean; begin FSubscribers.Lock; try // Set the flag to true (dirty) and check if it was previously false (clean). wasPreviouslyClean := not TInterlocked.Exchange(FFlag, true); if wasPreviouslyClean then // Only notify subscribers if state changed from clean to dirty. begin FSubscribers.Notify(function(Subscriber: TSignal.ISubscriber): Boolean begin Result := Subscriber.Notify; end); end; finally FSubscribers.Release; Result := true; end; end; function TMycFlag.Subscribe(Subscriber: TSignal.ISubscriber): Pointer; begin if not Assigned(Subscriber) then exit(nil); // For TMycFlag, we always add the subscriber and then check if we need to notify immediately. // Ref counting for the subscriber interface is assumed to be handled by TMycNotifyList.Advise/Unadvise. // Or, if explicit management is needed like in TMycLatch, it should be added. // For consistency with TMycLatch, let's add AddRef/Release here too. FSubscribers.Lock; try // Add subscriber regardless of current state. Result := FSubscribers.Advise(Subscriber); if FFlag then // If currently dirty, notify the new subscriber immediately. begin Subscriber.Notify; end; finally FSubscribers.Release; end; end; procedure TMycFlag.Unsubscribe(Tag: Pointer); begin if Tag = nil then exit; FSubscribers.Lock; try FSubscribers.Unadvise(Tag); finally FSubscribers.Release; end; end; function TMycNullEvent.GetSignal: TSignal; begin Result := TSignal.Null; end; function TMycNullEvent.Notify: Boolean; begin Result := false; end; { TMycObserverFlag } constructor TMycObserverFlag.Create(const ASignal: TSignal.ISignal); begin inherited Create; FSignal := ASignal; end; procedure TMycObserverFlag.AfterConstruction; begin inherited; FSubscriptionTag := FSignal.Subscribe(Self); end; procedure TMycObserverFlag.BeforeDestruction; begin FSignal.Unsubscribe(FSubscriptionTag); inherited; end; end.