unit Myc.Core.Signals; interface uses System.SysUtils, Myc.Core.Notifier, Myc.Signals; type TMycState = class abstract( TInterfacedObject, IMycState ) strict private class var FNull: IMycState; class constructor ClassCreate; protected function GetIsSet: Boolean; virtual; abstract; public function Subscribe(Subscriber: IMycSubscriber): TMycSubscription; virtual; abstract; procedure Unsubscribe(Tag: TMycNotifyList.TTag); virtual; abstract; property IsSet: Boolean read GetIsSet; // Provides access to the singleton null latch instance (always set). class property Null: IMycState read FNull; 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): TMycSubscription; 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. class var FNull: IMycLatch; // Singleton instance of a latch that is always set. class constructor ClassCreate; // Class constructor to initialize FNull. private [volatile] FCount: Integer; // The internal countdown value for the latch. function GetState: IMycState; // 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; // Factory method: creates a new countdown latch or returns the Null latch if Count <= 0. class function CreateLatch(Count: Integer): IMycLatch; static; // IMycSignal implementation function Subscribe(Subscriber: IMycSubscriber): TMycSubscription; 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; // Provides access to the singleton null latch instance (always set). class property Null: IMycLatch read FNull; 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: IMycState; // Implementation for IMycFlag.GetState. 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; // IMycSignal implementation function Subscribe(Subscriber: IMycSubscriber): TMycSubscription; 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; implementation uses System.SyncObjs; // For TInterlocked class constructor TMycState.ClassCreate; begin // Create a singleton null latch instance that is initially (and always) set. FNull := TMycNullState.Create(); // Calls the instance constructor end; { 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): TMycSubscription; 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.Create(Self, nil); // Return an empty subscription. end; procedure TMycNullState.Unsubscribe(Tag: TMycNotifyList.TTag); begin // Unsubscribing from a null state has no effect. end; { TMycLatch } constructor TMycLatch.Create(ACount: Integer); begin inherited Create; Assert( ACount >= 0 ); FCount := ACount; FSubscribers.Create; end; class constructor TMycLatch.ClassCreate; begin // Create a singleton null latch instance that is initially (and always) set. FNull := TMycLatch.Create(0); // Calls the instance constructor end; destructor TMycLatch.Destroy; begin FSubscribers.Destroy; inherited; end; class function TMycLatch.CreateLatch(Count: Integer): IMycLatch; begin // Factory method: returns a new latch or the shared Null latch if Count <= 0. if Count > 0 then Result := TMycLatch.Create(Count) // Instance constructor else Result := FNull; 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: IMycState; begin // TMycLatch itself implements IMycState. exit(Self); end; function TMycLatch.Subscribe(Subscriber: IMycSubscriber): TMycSubscription; var alreadySet: Boolean; begin 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.Create(Self, 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; { 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: IMycState; begin // TMycDirty itself implements IMycState. exit(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): TMycSubscription; begin if not Assigned(Subscriber) then exit; // 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.Create(Self, 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.