MycLib/Src/Myc.Signals.pas

unit Myc.Signals;

interface

uses
    System.SysUtils, Myc.Core.Notifier;


type
    IMycSemaphore = interface;

    TMycSignal = class;

    IMycSubscriber = interface
        function Notify: Boolean;
    end;

    TMycSubscription = record
    private
        FSignal: TMycSignal;
        FTag: TMycNotifyList<IMycSubscriber>.TTag;
    public
        class operator Initialize(out Dest: TMycSubscription);
        class operator Finalize(var Dest: TMycSubscription);
        class operator Assign(var Dest: TMycSubscription; const [ref] Src: TMycSubscription);

        procedure Setup(ASignal: TMycSignal; ATag: TMycNotifyList<IMycSubscriber>.TTag); inline;
        procedure Unsubscribe;
    end;

    IMycSignal = interface
        function Subscribe(const Subscriber: IMycSubscriber): TMycSubscription;
    end;

    TMycSignal = class abstract( TInterfacedObject, IMycSignal )
    public
        function Subscribe(const Subscriber: IMycSubscriber): TMycSubscription; virtual; abstract;
        procedure Unsubscribe(Tag: TMycNotifyList<IMycSubscriber>.TTag); virtual;  abstract;
    end;

    IMycState = interface( IMycSignal )
        {$region 'property access'}
        function GetIsSet: Boolean;
        {$endregion}
        property IsSet: Boolean read GetIsSet;
    end;

    IMycSemaphore = interface(IMycSubscriber)
        {$region 'property access'}
        function GetState: IMycState;
        {$endregion}
        property State: IMycState read GetState;
    end;

    TMycSemaphore = class(TMycSignal, IMycSemaphore, IMycState)
    strict private
        FSubscribers: TMycNotifyList<IMycSubscriber>;
    private
        [volatile] FCount: Integer;
        function GetState: IMycState;
        function GetIsSet: Boolean;
    public
        constructor Create(ACount: Integer);
        destructor Destroy; override;
        function Subscribe(const Subscriber: IMycSubscriber): TMycSubscription; override;
        procedure Unsubscribe(Tag: TMycNotifyList<IMycSubscriber>.TTag); override;
        function Notify: Boolean;
    end;

    Signals = record
    strict private
    class var
        FNull: IMycSemaphore;
        class constructor Create;
    public
        class function CreateSemaphore(Count: Integer): IMycSemaphore; static;
        class property Null: IMycSemaphore read FNull;
    end;

implementation

uses
    System.SyncObjs;

procedure TMycSubscription.Setup(ASignal: TMycSignal; ATag:
    TMycNotifyList<IMycSubscriber>.TTag);
begin
    Unsubscribe;
    FSignal := ASignal;
    FTag := ATag;
end;

procedure TMycSubscription.Unsubscribe;
begin
    if FTag<>nil then
    begin
        FSignal.Unsubscribe( FTag );
        FTag := nil;
    end;
end;

class operator TMycSubscription.Assign(var Dest: TMycSubscription; const [ref]
    Src: TMycSubscription);
begin
    Dest.Setup( Src.FSignal, Src.FTag );
end;

class operator TMycSubscription.Initialize(out Dest: TMycSubscription);
begin
    Dest.FTag := nil;
end;

class operator TMycSubscription.Finalize(var Dest: TMycSubscription);
begin
    Dest.Unsubscribe;
end;

constructor TMycSemaphore.Create(ACount: Integer);
begin
    inherited Create;
    FCount := ACount;
    FSubscribers.Create;
end;

destructor TMycSemaphore.Destroy;
begin
    FSubscribers.Destroy;
    inherited;
end;

function TMycSemaphore.Notify: Boolean;
begin
    FSubscribers.Lock;
    try
        var n := TInterlocked.Decrement( FCount );
        if n < -MaxInt div 2 then
            TInterlocked.Increment( FCount );

        if n = 0 then
            FSubscribers.Notify(
                function( Subscriber: IMycSubscriber ): Boolean
                begin
                    Result := Subscriber.Notify;
                end );

        Result := n > 0;
        if not Result then
            FSubscribers.UnadviseAll;
    finally
        FSubscribers.Release;
    end;
end;

function TMycSemaphore.GetIsSet: Boolean;
begin
    Result := FCount <= 0;
end;

function TMycSemaphore.GetState: IMycState;
begin
    exit( Self );
end;

function TMycSemaphore.Subscribe(const Subscriber: IMycSubscriber):
    TMycSubscription;
begin
    if not Assigned(Subscriber) then
        exit;

    Subscriber._AddRef;
    try
        FSubscribers.Lock;
        try
            if FCount <= 0 then
                Subscriber.Notify
            else
                Result.Setup( Self, FSubscribers.Advise( Subscriber ) );
        finally
            FSubscribers.Release;
        end;
    finally
        Subscriber._Release;
    end;
end;

procedure TMycSemaphore.Unsubscribe(Tag: TMycNotifyList<IMycSubscriber>.TTag);
begin
    if Tag=nil then
        exit;

    FSubscribers.Lock;
    try
        FSubscribers.Unadvise( Tag );
    finally
        FSubscribers.Release;
    end;
end;

class constructor Signals.Create;
begin
    FNull := TMycSemaphore.Create( 0 );
end;

{ Signals }

class function Signals.CreateSemaphore(Count: Integer): IMycSemaphore;
begin
    Result := TMycSemaphore.Create( Count );
end;

end.