Files
MycLib/Src/Myc.Signals.pas
T
2025-06-05 23:27:48 +02:00

461 lines
11 KiB
ObjectPascal

unit Myc.Signals;
interface
uses
System.SysUtils;
type
IMycSubscriber = interface
function Notify: Boolean;
end;
TSignal = record
type
TSubscriptionTag = Pointer;
ISignal = interface
function Subscribe(Subscriber: IMycSubscriber): TSubscriptionTag;
procedure Unsubscribe(Tag: TSubscriptionTag);
end;
TSubscription = record
private
FSignal: ISignal;
FTag: TSubscriptionTag;
constructor Create(const ASignal: ISignal; ATag: TSubscriptionTag);
public
class operator Initialize(out Dest: TSubscription);
// Unsubscribes from the associated signal
procedure Unsubscribe;
end;
strict private
class var
FNull: ISignal;
class constructor ClassCreate;
private
FSignal: ISignal;
public
constructor Create(const ASignal: ISignal);
class operator Initialize(out Dest: TSignal);
class operator Implicit(const A: ISignal): TSignal; overload;
class operator Implicit(const A: TSignal): ISignal; overload;
function Subscribe(Subscriber: IMycSubscriber): TSubscription; inline;
class property Null: ISignal read FNull;
end;
TEvent = record
type
IEvent = interface(TSignal.ISignal)
procedure Trigger;
end;
strict private
class var
FNull: IEvent;
class constructor ClassCreate;
private
FEvent: IEvent;
public
constructor Create(const AEvent: IEvent);
class operator Initialize(out Dest: TEvent);
class operator Implicit(const A: IEvent): TEvent; overload;
class operator Implicit(const A: TEvent): IEvent; overload;
class property Null: IEvent read FNull;
function Subscribe(Subscriber: IMycSubscriber): TSignal.TSubscription; inline;
procedure Unsubscribe(Tag: Pointer); inline;
end;
TState = record
type
IState = interface(TSignal.ISignal)
{$REGION 'property access'}
function GetIsSet: Boolean;
{$ENDREGION}
// IsSet is true if the TState has been reached or the condition is met.
property IsSet: Boolean read GetIsSet;
end;
strict private
class var
FNull: IState;
class constructor ClassCreate;
private
FState: IState;
function GetIsSet: Boolean; inline;
public
constructor Create(const AState: IState);
class operator Initialize(out Dest: TState);
class operator Implicit(const A: IState): TState; overload;
class operator Implicit(const A: TState): IState; overload;
class function All(const States: TArray<TState>): TState; static;
class function Any(const States: TArray<TState>): TState; static;
class property Null: IState read FNull;
function Subscribe(Subscriber: IMycSubscriber): TSignal.TSubscription; inline;
procedure Unsubscribe(Tag: Pointer); inline;
property IsSet: Boolean read GetIsSet;
end;
// A latch is a specific type of event that, once set, remains set (non-resettable).
// It becomes set when the internal countdown reaches zero.
TLatch = record
type
ILatch = interface(IMycSubscriber)
function GetState: TState;
property State: TState read GetState;
end;
strict private
class var
FNull: ILatch;
class constructor ClassCreate;
private
FLatch: ILatch;
function GetState: TState; inline;
public
constructor Create(const ALatch: ILatch);
class operator Initialize(out Dest: TLatch);
class operator Implicit(const A: ILatch): TLatch; overload;
class operator Implicit(const A: TLatch): ILatch; overload;
class function CreateLatch(Count: Integer): TLatch; static;
class function Enqueue(var Gate: TLatch; Count: Integer = 1): TState; static;
class property Null: ILatch read FNull;
function Notify: Boolean; inline;
property State: TState read GetState;
end;
// TFlag represents a resettable flag, typically indicating if a State is "dirty" (requiring attention) or "clean".
TFlag = record
type
IFlag = interface(IMycSubscriber)
function GetState: TState;
function Reset: Boolean;
property State: TState read GetState;
end;
strict private
class var
FNull: IFlag;
class constructor ClassCreate;
private
FDirty: IFlag;
function GetState: TState; inline;
public
constructor Create(const ADirty: IFlag);
class operator Initialize(out Dest: TFlag);
class operator Implicit(const A: IFlag): TFlag; overload;
class operator Implicit(const A: TFlag): IFlag; overload;
class function CreateFlag: IFlag; static;
class property Null: IFlag read FNull;
function Notify: Boolean; inline;
function Reset: Boolean;
property State: TState read GetState;
end;
implementation
uses
Myc.Core.Notifier,
Myc.Core.Signals;
{ TSignal.TSubscription }
constructor TSignal.TSubscription.Create(const ASignal: ISignal; ATag: TSubscriptionTag);
begin
FSignal := ASignal;
FTag := ATag;
Assert(Assigned(FSignal));
end;
procedure TSignal.TSubscription.Unsubscribe;
begin
FSignal.Unsubscribe(FTag);
FSignal := TSignal.Null;
FTag := nil;
end;
class operator TSignal.TSubscription.Initialize(out Dest: TSubscription);
begin
Dest.FSignal := TSignal.Null;
Dest.FTag := nil;
end;
{ TState }
constructor TState.Create(const AState: IState);
begin
FState := AState;
if not Assigned(FState) then
FState := FNull;
end;
class constructor TState.ClassCreate;
begin
// Create a singleton null latch instance that is initially (and always) set.
FNull := TMycNullState.Create(); // Calls the instance constructor
end;
class function TState.All(const States: TArray<TState>): TState;
var
Latch: TLatch.ILatch;
begin
Latch := TLatch.CreateLatch(Length(States));
for var i := 0 to High(States) do
States[i].Subscribe(Latch);
Result := Latch.State;
end;
class function TState.Any(const States: TArray<TState>): TState;
var
Latch: TLatch.ILatch;
begin
if Length(States) = 0 then
begin
Result := TState.Null;
end
else
begin
Latch := TLatch.CreateLatch(1);
for var i := 0 to High(States) do
States[i].Subscribe(Latch);
Result := Latch.State;
end;
end;
function TState.GetIsSet: Boolean;
begin
Result := FState.IsSet;
end;
function TState.Subscribe(Subscriber: IMycSubscriber): TSignal.TSubscription;
begin
Result := TSignal.TSubscription.Create(FState, FState.Subscribe(Subscriber));
end;
procedure TState.Unsubscribe(Tag: Pointer);
begin
FState.Unsubscribe(Tag);
end;
class operator TState.Implicit(const A: TState): IState;
begin
Result := A.FState;
end;
class operator TState.Implicit(const A: IState): TState;
begin
Result.Create(A);
end;
class operator TState.Initialize(out Dest: TState);
begin
Dest.FState := FNull;
end;
{ TEvent }
constructor TEvent.Create(const AEvent: IEvent);
begin
FEvent := AEvent;
if not Assigned(FEvent) then
FEvent := FNull;
end;
class constructor TEvent.ClassCreate;
begin
FNull := TMycNullEvent.Create();
end;
function TEvent.Subscribe(Subscriber: IMycSubscriber): TSignal.TSubscription;
begin
Result := TSignal.TSubscription.Create(FEvent, FEvent.Subscribe(Subscriber));
end;
procedure TEvent.Unsubscribe(Tag: Pointer);
begin
FEvent.Unsubscribe(Tag);
end;
class operator TEvent.Implicit(const A: TEvent): IEvent;
begin
Result := A.FEvent;
end;
class operator TEvent.Implicit(const A: IEvent): TEvent;
begin
Result.Create(A);
end;
class operator TEvent.Initialize(out Dest: TEvent);
begin
Dest.FEvent := FNull;
end;
{ TFlag }
class constructor TFlag.ClassCreate;
begin
FNull := TMycNullFlag.Create;
end;
constructor TFlag.Create(const ADirty: IFlag);
begin
FDirty := ADirty;
if not Assigned(FDirty) then
FDirty := FNull;
end;
class function TFlag.CreateFlag: IFlag;
begin
Result := TMycFlag.Create;
end;
function TFlag.GetState: TState;
begin
Result := FDirty.State;
end;
function TFlag.Notify: Boolean;
begin
Result := FDirty.Notify;
end;
function TFlag.Reset: Boolean;
begin
Result := FDirty.Reset;
end;
class operator TFlag.Implicit(const A: IFlag): TFlag;
begin
Result.Create(A);
end;
class operator TFlag.Implicit(const A: TFlag): IFlag;
begin
Result := A.FDirty;
end;
class operator TFlag.Initialize(out Dest: TFlag);
begin
Dest.FDirty := FNull;
end;
{ TLatch }
class constructor TLatch.ClassCreate;
begin
// Create a singleton null latch instance that is initially (and always) set.
FNull := TMycNullLatch.Create;
end;
constructor TLatch.Create(const ALatch: TLatch.ILatch);
begin
FLatch := ALatch;
if not Assigned(FLatch) then
FLatch := FNull;
end;
class function TLatch.CreateLatch(Count: Integer): TLatch;
begin
if Count > 0 then
Result := TMycLatch.Create(Count)
else
Result := FNull;
end;
class function TLatch.Enqueue(var Gate: TLatch; Count: Integer = 1): TState;
begin
var gateState := Gate.State;
Gate := TMycLatch.Create(Count);
gateState.Subscribe(Gate);
exit(Gate.State);
end;
function TLatch.GetState: TState;
begin
Result := FLatch.State;
end;
function TLatch.Notify: Boolean;
begin
Result := FLatch.Notify;
end;
class operator TLatch.Implicit(const A: TLatch.ILatch): TLatch;
begin
Result.Create(A);
end;
class operator TLatch.Implicit(const A: TLatch): TLatch.ILatch;
begin
Result := A.FLatch;
end;
class operator TLatch.Initialize(out Dest: TLatch);
begin
Dest.FLatch := FNull;
end;
class constructor TSignal.ClassCreate;
begin
FNull := TMycNullSignal.Create();
end;
{ TSignal }
constructor TSignal.Create(const ASignal: ISignal);
begin
FSignal := ASignal;
if not Assigned(FSignal) then
FSignal := FNull;
end;
function TSignal.Subscribe(Subscriber: IMycSubscriber): TSubscription;
begin
Result := TSubscription.Create(FSignal, FSignal.Subscribe(Subscriber));
end;
class operator TSignal.Implicit(const A: TSignal): ISignal;
begin
Result := A.FSignal;
end;
class operator TSignal.Implicit(const A: ISignal): TSignal;
begin
Result.Create(A);
end;
class operator TSignal.Initialize(out Dest: TSignal);
begin
Dest.FSignal := FNull;
end;
end.