MycLib/Src/Myc.Core.Signals.pas

unit Myc.Core.Signals;

interface

uses
    System.SysUtils,
    Myc.Core.Notifier,
    Myc.Signals;

type
    // TMycNullSignal implements a "null object" pattern for ISignal.
    TMycNullSignal = class(TInterfacedObject, TSignal.ISignal)
    public
        function Subscribe(Subscriber: TSignal.ISubscriber): Pointer;
        procedure Unsubscribe(Tag: Pointer);
    end;

    // TMycNullState implements a "null object" pattern for IState.
    // This state is always considered "set".
    TMycNullState = class(TInterfacedObject, TSignal.ISignal, TState.IState)
    private
        function GetSignal: TSignal;
        function GetIsSet: Boolean;
    public
        function Subscribe(Subscriber: TSignal.ISubscriber): Pointer;
        procedure Unsubscribe(Tag: Pointer);
        property Signal: TSignal read GetSignal;
    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<TSignal.ISubscriber>;
        function GetSignal: TSignal;
    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<TSignal.ISubscriber>; // 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.
        function GetSignal: TSignal;
        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<TSignal.ISubscriber>; // 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;
        function GetSignal: TSignal;
        function GetIsSet: Boolean;
    public
        // Creates a new dirty flag, initially set to dirty (true).
        constructor Create(AInit: Boolean);
        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.GetSignal: TSignal;
begin
    Result := Self;
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.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.GetSignal: TSignal;
begin
    Result := Self;
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(AInit: Boolean);
begin
    inherited Create;
    FFlag := AInit;
    FSubscribers.Create;
end;

class function TMycFlag.CreateDirty: TFlag.IFlag;
begin
    // Factory method to create a new TMycFlag instance.
    Result := TMycFlag.Create( true );
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.GetSignal: TSignal;
begin
    Result := Self;
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( false );
    FSignal := ASignal;
end;

procedure TMycObserverFlag.AfterConstruction;
begin
    inherited;
    FSubscriptionTag := FSignal.Subscribe(Self);
end;

procedure TMycObserverFlag.BeforeDestruction;
begin
    FSignal.Unsubscribe(FSubscriptionTag);
    inherited;
end;

end.