unit Myc.Core.Signals; interface uses System.SysUtils, Myc.Core.Notifier, Myc.Signals; type TMycState = class abstract( TInterfacedObject, IMycState ) protected function GetIsSet: Boolean; virtual; abstract; public function Subscribe(Subscriber: IMycSubscriber): Pointer; virtual; abstract; procedure Unsubscribe(Tag: TMycNotifyList.TTag); virtual; abstract; property IsSet: Boolean read GetIsSet; end; // TMycNullState implements a "null object" pattern for IMycState. // This state is always considered "set". TMycNullState = class(TInterfacedObject, IMycState) protected // IMycState function GetIsSet: Boolean; function Subscribe(Subscriber: IMycSubscriber): Pointer; procedure Unsubscribe(Tag: TMycNotifyList.TTag); public constructor Create; end; // TMycLatch implements a countdown latch. // It is initialized with a count. Calls to its Notify method (as an IMycSubscriber) // 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(TMycState, IMycLatch) 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 IMycLatch.GetState and IMycFlag.GetState. protected function GetIsSet: Boolean; override; final; // Implementation for IMycState.GetIsSet. 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; // IMycSignal implementation function Subscribe(Subscriber: IMycSubscriber): Pointer; override; procedure Unsubscribe(Tag: TMycNotifyList.TTag); override; // IMycSubscriber 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, IMycLatch ) private function GetState: TState; function Notify: Boolean; end; // TMycDirty 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. TMycDirty = class(TMycState, IMycDirty) 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; override; final; // Implementation for IMycState.GetIsSet (true if dirty). public // Creates a new dirty flag, initially set to dirty (true). constructor Create; destructor Destroy; override; // Factory method to create a new TMycDirty instance. class function CreateDirty: IMycDirty; static; function Subscribe(Subscriber: IMycSubscriber): Pointer; override; procedure Unsubscribe(Tag: TMycNotifyList.TTag); override; // IMycSubscriber implementation for TMycDirty. // Sets this flag to dirty (true). Notifies subscribers if it transitioned from clean to dirty. function Notify: Boolean; // IMycDirty implementation. Resets the flag to clean (false). function Reset: Boolean; end; TMycNullDirty = class( TInterfacedObject, IMycDirty ) private function GetState: TState; function Notify: Boolean; function Reset: Boolean; end; implementation uses System.SyncObjs; // For TInterlocked { TMycNullState } constructor TMycNullState.Create; begin inherited Create; end; function TMycNullState.GetIsSet: Boolean; begin Result := true; // Null state is always set. end; function TMycNullState.Subscribe(Subscriber: IMycSubscriber): Pointer; begin // Since the state is always set, notify the subscriber immediately. if Assigned(Subscriber) then begin Subscriber.Notify; end; // No ongoing subscription is necessary or meaningful for a null state. Result := nil; end; procedure TMycNullState.Unsubscribe(Tag: TMycNotifyList.TTag); begin // Unsubscribing from a null state has no effect. 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: IMycSubscriber): 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 IMycState. Result := Self; end; function TMycLatch.Subscribe(Subscriber: IMycSubscriber): 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: TMycNotifyList.TTag); begin if Tag = nil then exit; FSubscribers.Lock; try FSubscribers.Unadvise(Tag); finally FSubscribers.Release; end; end; { TMycNullDirty } function TMycNullDirty.GetState: TState; begin Result := TState.Null; end; function TMycNullDirty.Notify: Boolean; begin Result := false; end; function TMycNullDirty.Reset: Boolean; begin Result := true; end; { TMycDirty } constructor TMycDirty.Create; begin inherited Create; FFlag := true; // A new dirty flag is initially considered dirty. FSubscribers.Create; end; class function TMycDirty.CreateDirty: IMycDirty; begin // Factory method to create a new TMycDirty instance. Result := TMycDirty.Create; end; destructor TMycDirty.Destroy; begin FSubscribers.Destroy; // Clean up the subscriber list. inherited; end; function TMycDirty.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 TMycDirty.GetIsSet: Boolean; begin // IsSet is true if the flag is dirty (FFlag = true). Result := FFlag; end; function TMycDirty.GetState: TState; begin // TMycDirty itself implements IMycState. Result := Self; end; function TMycDirty.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: IMycSubscriber): Boolean begin Result := Subscriber.Notify; end); end; // The return value of this Notify (as an IMycSubscriber) indicates if this // TMycDirty instance itself would want more notifications if it were subscribed to something. // Here, it reflects whether a state change to dirty occurred due to this call. Result := wasPreviouslyClean; finally FSubscribers.Release; end; end; function TMycDirty.Subscribe(Subscriber: IMycSubscriber): Pointer; begin if not Assigned(Subscriber) then exit(nil); // For TMycDirty, 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 TMycDirty.Unsubscribe(Tag: TMycNotifyList.TTag); begin if Tag = nil then exit; FSubscribers.Lock; try FSubscribers.Unadvise(Tag); finally FSubscribers.Release; end; end; end.