1st Aura Project Layout

Src/Myc.Signals.FMX.pas

@@ -5,72 +5,145 @@ interface
 uses
     System.Classes,
     System.SysUtils,
+    System.Generics.Collections,
+    System.Diagnostics,
     System.Messaging,
     Myc.Signals;
 
 type
-    TMsgProc = reference to procedure(const Sender: TObject; const M: TMessage);
-
-    TComponentValidation = class(TComponent)
-    private
-        FReceived: TFlag;
-        FProc: TMsgProc;
-        FSubscription: TMessageSubscriptionId;
-        FMsgClass: TClass;
-        procedure DoMsg(const Sender: TObject; const M: TMessage);
+    TSignalComponentHelper = class helper for TComponent
+        type
+            TMsgProc = reference to procedure(out IsDone: Boolean);
 
+            TSignalSubscription = class(TComponent, TSignal.ISubscriber)
+            private
+                FSignal: TSignal;
+                FSigSubscr: TSignal.TSubscription;
+                FProc: TMsgProc;
+                FNotified: Integer;
+                FIdleSubscrId: TMessageSubscriptionId;
+                class var
+                    FQueued: Integer;
+                    FCount: Integer;
+                    FItems: TList<TSignalSubscription>;
+                    FIdx: Integer;
+                class procedure HandleSignals(Timeout: Int64);
+                function Notify: Boolean;
+            public
+                constructor Create(AOwner: TComponent; const ASignal: TSignal; const AProc: TMsgProc); reintroduce;
+                destructor Destroy; override;
+            end;
     public
-        constructor Create(AOwner: TComponent; const AMsgClass: TClass; const ASignal: TSignal; const AProc: TMsgProc); reintroduce;
-        destructor Destroy; override;
-    end;
-
-    TComponentValidationHelper = class helper for TComponent
-        procedure AddMsgHandler(const MsgClass: TClass; const Signal: TSignal; const Proc: TMsgProc);
-        procedure AddIdleHandler(const Signal: TSignal; const Proc: TProc);
+        procedure ProcessSignal(const Signal: TSignal; const Proc: TMsgProc); overload;
+        procedure ProcessSignal(const Signal: TSignal; const Proc: TProc); overload;
     end;
 
 implementation
 
 uses
-{$IFDEF FRAMEWORK_FMX}
-    FMX.Types
-{$ELSE}
-    VCL.Types // to be checked
-{$IFEND}
-        ;
+    FMX.Types;
 
-{ TComponentValidation }
+{ TSignalComponentHelper.TSignalSubscription }
 
-constructor TComponentValidation.Create(AOwner: TComponent; const AMsgClass: TClass; const ASignal: TSignal; const AProc: TMsgProc);
+constructor TSignalComponentHelper.TSignalSubscription.Create(AOwner: TComponent; const ASignal: TSignal; const AProc: TMsgProc);
 begin
     inherited Create(AOwner);
-    FMsgClass := AMsgClass;
+    FSignal := ASignal;
     FProc := AProc;
-    FReceived := TFlag.CreateObserver(ASignal);
-    FSubscription := TMessageManager.DefaultManager.SubscribeToMessage(FMsgClass, DoMsg);
+    FIdx := 0;
+
+    if FItems = nil then
+    begin
+        FItems := TList<TSignalSubscription>.Create;
+        FIdleSubscrId :=
+            TMessageManager
+                .DefaultManager
+                .SubscribeToMessage(TIdleMessage, procedure(const Sender: TObject; const M: TMessage) begin HandleSignals(50); end);
+    end;
+    FItems.Add(Self);
+
+    FSigSubscr := FSignal.Subscribe(Self);
 end;
 
-destructor TComponentValidation.Destroy;
+destructor TSignalComponentHelper.TSignalSubscription.Destroy;
 begin
-    TMessageManager.DefaultManager.Unsubscribe(FMsgClass, FSubscription);
+    FSigSubscr.Unsubscribe;
+
+    FItems.Remove(Self);
+    if FItems.Count = 0 then
+    begin
+        TMessageManager.DefaultManager.Unsubscribe(TIdleMessage, FIdleSubscrId);
+        FreeAndNil(FItems);
+    end;
+
     inherited;
 end;
 
-procedure TComponentValidation.DoMsg(const Sender: TObject; const M: TMessage);
+class procedure TSignalComponentHelper.TSignalSubscription.HandleSignals(Timeout: Int64);
 begin
-    if FReceived.Reset then
-        FProc(Sender, M);
+    if AtomicExchange(FQueued, 0) = 0 then
+        exit;
+
+    var Stopwatch := TStopwatch.StartNew;
+
+    if (FIdx = 0) or (FIdx > FItems.Count) then
+        FIdx := FItems.Count;
+
+    while FIdx > 0 do
+    begin
+        dec(FIdx);
+        var sub := FItems[FIdx];
+
+        if AtomicExchange(sub.FNotified, 0) = 1 then
+        begin
+            var done := false;
+            try
+                sub.FProc(done);
+            finally
+                if done then
+                    sub.Free;
+            end;
+
+            if AtomicDecrement(FCount) = 1 then
+                break;
+        end;
+
+        if Stopwatch.ElapsedMilliseconds > Timeout then
+        begin
+            AtomicExchange(FQueued, 1);
+            break;
+        end;
+
+        if FIdx = 0 then
+            FIdx := FItems.Count;
+    end;
 end;
 
-procedure TComponentValidationHelper.AddIdleHandler(const Signal: TSignal; const Proc: TProc);
+function TSignalComponentHelper.TSignalSubscription.Notify: Boolean;
 begin
-    var capProc := Proc;
-    AddMsgHandler(TIdleMessage, Signal, procedure(const Sender: TObject; const M: TMessage) begin capProc(); end);
+    if AtomicExchange(FNotified, 1) = 0 then
+        AtomicIncrement(FCount);
+    AtomicExchange(FQueued, 1);
+
+    //    if AtomicExchange(FQueued, 1) = 0 then
+    //        TThread.Queue( nil,
+    //            procedure
+    //            begin
+    //                if AtomicExchange(FQueued, 0) = 1 then
+    //                    HandleSignals( 40 );
+    //            end);
+    Result := true;
 end;
 
-procedure TComponentValidationHelper.AddMsgHandler(const MsgClass: TClass; const Signal: TSignal; const Proc: TMsgProc);
+procedure TSignalComponentHelper.ProcessSignal(const Signal: TSignal; const Proc: TProc);
 begin
-    TComponentValidation.Create(Self, MsgClass, Signal, Proc);
+    var cProc: TProc := Proc;
+    TSignalSubscription.Create(Self, Signal, procedure(out IsDone: Boolean) begin cProc(); end);
+end;
+
+procedure TSignalComponentHelper.ProcessSignal(const Signal: TSignal; const Proc: TMsgProc);
+begin
+    TSignalSubscription.Create(Self, Signal, Proc);
 end;
 
 end.