Bugfix in TEvent, DataServer Push-Mode

This commit is contained in:
Michael Schimmel
2025-06-24 18:32:32 +02:00
parent 35413f5966
commit 3797507d95
13 changed files with 251 additions and 69 deletions
+2 -1
View File
@@ -5,7 +5,8 @@ uses
System.StartUpCopy, System.StartUpCopy,
FMX.Forms, FMX.Forms,
MainForm in 'MainForm.pas' {Form1}, MainForm in 'MainForm.pas' {Form1},
Myc.Trade.Core.DataPoint in '..\Src\Myc.Trade.Core.DataPoint.pas'; Myc.Trade.Core.DataPoint in '..\Src\Myc.Trade.Core.DataPoint.pas',
Myc.Trade.Ticker in '..\Src\Myc.Trade.Ticker.pas';
{$R *.res} {$R *.res}
+3 -2
View File
@@ -134,6 +134,7 @@
<Form>Form1</Form> <Form>Form1</Form>
</DCCReference> </DCCReference>
<DCCReference Include="..\Src\Myc.Trade.Core.DataPoint.pas"/> <DCCReference Include="..\Src\Myc.Trade.Core.DataPoint.pas"/>
<DCCReference Include="..\Src\Myc.Trade.Ticker.pas"/>
<BuildConfiguration Include="Base"> <BuildConfiguration Include="Base">
<Key>Base</Key> <Key>Base</Key>
</BuildConfiguration> </BuildConfiguration>
@@ -177,9 +178,9 @@
<Overwrite>true</Overwrite> <Overwrite>true</Overwrite>
</Platform> </Platform>
</DeployFile> </DeployFile>
<DeployFile LocalName="Win64\Debug\AuraTrader.rsm" Configuration="Debug" Class="DebugSymbols"> <DeployFile LocalName="Win64\Release\AuraTrader.exe" Configuration="Release" Class="ProjectOutput">
<Platform Name="Win64"> <Platform Name="Win64">
<RemoteName>AuraTrader.rsm</RemoteName> <RemoteName>AuraTrader.exe</RemoteName>
<Overwrite>true</Overwrite> <Overwrite>true</Overwrite>
</Platform> </Platform>
</DeployFile> </DeployFile>
+16
View File
@@ -64,6 +64,22 @@ object Form1: TForm1
JustifyLastLine = Left JustifyLastLine = Left
FlowDirection = LeftToRight FlowDirection = LeftToRight
end end
object Button1: TButton
Position.X = 712.00000000000000000
Position.Y = 72.00000000000000000
TabOrder = 6
Text = 'Button1'
TextSettings.Trimming = None
OnClick = Button1Click
end
object Button2: TButton
Position.X = 720.00000000000000000
Position.Y = 96.00000000000000000
TabOrder = 8
Text = 'Button2'
TextSettings.Trimming = None
OnClick = Button2Click
end
end end
object LogMemo: TMemo object LogMemo: TMemo
Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
+62
View File
@@ -32,6 +32,7 @@ uses
Myc.Signals, Myc.Signals,
Myc.Lazy, Myc.Lazy,
Myc.Signals.FMX, Myc.Signals.FMX,
Myc.TaskManager,
FMX.ListBox, FMX.ListBox,
FMX.Layouts; FMX.Layouts;
@@ -44,10 +45,14 @@ type
SymbolsComboBox: TComboBox; SymbolsComboBox: TComboBox;
LoadButton: TButton; LoadButton: TButton;
FlowLayout: TFlowLayout; FlowLayout: TFlowLayout;
Button1: TButton;
Button2: TButton;
procedure RandomButtonClick(Sender: TObject); procedure RandomButtonClick(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject); procedure FormDestroy(Sender: TObject);
procedure LoadButtonClick(Sender: TObject); procedure LoadButtonClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private private
const const
cnt = 20; cnt = 20;
@@ -63,6 +68,8 @@ type
FServer: IDataServer<TAskBidItem>; FServer: IDataServer<TAskBidItem>;
FSymbols: TFuture<TArray<String>>; FSymbols: TFuture<TArray<String>>;
FRandom: TList<TRndItem>; FRandom: TList<TRndItem>;
FTerminate: TEvent;
FLoadDone: TState;
public public
{ Public declarations } { Public declarations }
published published
@@ -76,8 +83,61 @@ implementation
{$R *.fmx} {$R *.fmx}
procedure TForm1.Button1Click(Sender: TObject);
begin
if SymbolsComboBox.ItemIndex < 0 then
exit;
var arr := TDataSeries<TAskBidItem>.CreateArray(3000);
var curr := TMutable<TDataSeries<TAskBidItem>>.CreateProtected;
var Symbol := FSymbols.WaitFor[SymbolsComboBox.ItemIndex];
var done :=
TAuraFileLoader<TAskBidItem>.LoadData(
FServer as TAuraTABFileServer,
Symbol,
FTerminate.Signal,
procedure(const Values: TArray<TDataPoint<TAskBidItem>>)
begin
arr.Add(Values);
curr.Value := arr.Copy;
end
);
FLoadDone := TState.All([FLoadDone, done]);
LogMemo.AddIdleHandler(curr.Changed, procedure begin LogMemo.Lines.Add(Symbol + ': ' + curr.Value.TotalCount.ToString); end);
Path1.AddIdleHandler(
curr.Changed,
procedure
begin
var Prices := curr.Value;
if Prices.Count > 0 then
begin
Path1.BeginUpdate;
try
Path1.Data.Clear;
Path1.Data.MoveTo(PointF(Path1.Width - 1, Prices[0].Data.Ask));
for var i := 1 to Prices.Count - 1 do
Path1.Data.LineTo(PointF(Path1.Width - i - 1, Prices[i].Data.Ask));
finally
Path1.EndUpdate;
end;
end;
end
);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
FTerminate.Notify;
end;
procedure TForm1.FormCreate(Sender: TObject); procedure TForm1.FormCreate(Sender: TObject);
begin begin
FTerminate := TEvent.CreateEvent;
FRandom := TList<TRndItem>.Create; FRandom := TList<TRndItem>.Create;
// Create an instance of the TAuraTABFileServer. The server can be reused for multiple stream creations. [364] // Create an instance of the TAuraTABFileServer. The server can be reused for multiple stream creations. [364]
@@ -110,6 +170,8 @@ end;
procedure TForm1.FormDestroy(Sender: TObject); procedure TForm1.FormDestroy(Sender: TObject);
begin begin
FTerminate.Notify;
TaskManager.WaitFor(FLoadDone);
Application.OnIdle := nil; Application.OnIdle := nil;
FRandom.Free; FRandom.Free;
end; end;
+51
View File
@@ -3,6 +3,7 @@ unit Myc.Core.Lazy;
interface interface
uses uses
System.Classes,
System.SysUtils, System.SysUtils,
Myc.Signals, Myc.Signals,
Myc.Lazy; Myc.Lazy;
@@ -76,6 +77,19 @@ type
constructor Create(const AChanged: TSignal.ISignal; const AProc: TFunc<T>); constructor Create(const AChanged: TSignal.ISignal; const AProc: TFunc<T>);
end; end;
TMycProtectedWriteableMutable<T> = class(TInterfacedObject, TMutable<T>.IMutable, TMutable<T>.IWriteable)
private
FValue: T;
FChanged: TEvent;
FLock: Integer;
protected
function GetChanged: TSignal;
function GetValue: T;
public
constructor Create(const AValue: T);
procedure SetValue(const Value: T);
end;
implementation implementation
{ TMycNullMutable<T> } { TMycNullMutable<T> }
@@ -204,4 +218,41 @@ begin
Result := FProc(); Result := FProc();
end; end;
{ TMycProtectedWriteableMutable<T> }
constructor TMycProtectedWriteableMutable<T>.Create(const AValue: T);
begin
inherited Create;
FValue := AValue;
FChanged := TEvent.CreateEvent;
end;
function TMycProtectedWriteableMutable<T>.GetChanged: TSignal;
begin
Result := FChanged.Signal;
end;
function TMycProtectedWriteableMutable<T>.GetValue: T;
begin
while AtomicExchange(FLock, 1) = 1 do
YieldProcessor;
try
Result := FValue;
finally
AtomicExchange(FLock, 0);
end;
end;
procedure TMycProtectedWriteableMutable<T>.SetValue(const Value: T);
begin
while AtomicExchange(FLock, 1) = 1 do
YieldProcessor;
try
FValue := Value;
FChanged.Notify;
finally
AtomicExchange(FLock, 0);
end;
end;
end. end.
-1
View File
@@ -217,7 +217,6 @@ begin
FSubscribers.Lock; FSubscribers.Lock;
try try
Subscriber.Notify;
Result := FSubscribers.Advise(Subscriber); Result := FSubscribers.Advise(Subscriber);
finally finally
FSubscribers.Release; FSubscribers.Release;
+2 -2
View File
@@ -82,7 +82,7 @@ type
procedure EnqueueJob(const Job: TProc); procedure EnqueueJob(const Job: TProc);
function Run(Job: TProc): TSignal.ISubscriber; function Run(Job: TProc): TSignal.ISubscriber;
function CreateTask(const Gate: TState; const Proc: TProc): TSignal.TSubscription; function CreateTask(const Gate: TState; const Proc: TProc): TSignal.TSubscription;
procedure WaitFor(State: TState.IState); procedure WaitFor(const State: TState.IState);
procedure Teardown; procedure Teardown;
function InMainThread: Boolean; function InMainThread: Boolean;
function InWorkerThread: Boolean; function InWorkerThread: Boolean;
@@ -345,7 +345,7 @@ begin
end; end;
end; end;
procedure TMycTaskFactory.WaitFor(State: TState.IState); procedure TMycTaskFactory.WaitFor(const State: TState.IState);
var var
lock: TSemaphore; // This is System.SyncObjs.TSemaphore lock: TSemaphore; // This is System.SyncObjs.TSemaphore
begin begin
+7
View File
@@ -20,6 +20,7 @@ type
IWriteable = interface(IMutable) IWriteable = interface(IMutable)
procedure SetValue(const Value: T); procedure SetValue(const Value: T);
property Value: T read GetValue write SetValue;
end; end;
{$REGION 'private'} {$REGION 'private'}
@@ -44,6 +45,7 @@ type
class function Construct(const Changing: TSignal; const Proc: TFunc<T>): TMutable<T>; overload; static; class function Construct(const Changing: TSignal; const Proc: TFunc<T>): TMutable<T>; overload; static;
class function CreateWriteable(const Init: T): IWriteable; overload; static; class function CreateWriteable(const Init: T): IWriteable; overload; static;
class function CreateProtected: IWriteable; overload; static;
property Value: T read GetValue; property Value: T read GetValue;
property Changed: TSignal read GetChanged; property Changed: TSignal read GetChanged;
@@ -107,6 +109,11 @@ begin
Result := TMycFuncMutable<T>.Create(Changing, Proc); Result := TMycFuncMutable<T>.Create(Changing, Proc);
end; end;
class function TMutable<T>.CreateProtected: IWriteable;
begin
Result := TMycProtectedWriteableMutable<T>.Create(Default(T));
end;
class function TMutable<T>.CreateWriteable(const Init: T): IWriteable; class function TMutable<T>.CreateWriteable(const Init: T): IWriteable;
begin begin
Result := TMycWriteableMutable<T>.Create(Init); Result := TMycWriteableMutable<T>.Create(Init);
+7 -10
View File
@@ -9,7 +9,7 @@ uses
Myc.Signals; Myc.Signals;
type type
TMsgProc = reference to procedure( const Sender: TObject; const M: TMessage ); TMsgProc = reference to procedure(const Sender: TObject; const M: TMessage);
TComponentValidation = class(TComponent) TComponentValidation = class(TComponent)
private private
@@ -32,11 +32,12 @@ type
implementation implementation
uses uses
{$IFDEF FRAMEWORK_FMX} {$IFDEF FRAMEWORK_FMX}
FMX.Types FMX.Types
{$ELSE} {$ELSE}
VCL.Types // to be checked VCL.Types // to be checked
{$IFEND}; {$IFEND}
;
{ TComponentValidation } { TComponentValidation }
@@ -58,17 +59,13 @@ end;
procedure TComponentValidation.DoMsg(const Sender: TObject; const M: TMessage); procedure TComponentValidation.DoMsg(const Sender: TObject; const M: TMessage);
begin begin
if FReceived.Reset then if FReceived.Reset then
FProc( Sender, M ); FProc(Sender, M);
end; end;
procedure TComponentValidationHelper.AddIdleHandler(const Signal: TSignal; const Proc: TProc); procedure TComponentValidationHelper.AddIdleHandler(const Signal: TSignal; const Proc: TProc);
begin begin
var capProc := Proc; var capProc := Proc;
AddMsgHandler(TIdleMessage, Signal, AddMsgHandler(TIdleMessage, Signal, procedure(const Sender: TObject; const M: TMessage) begin capProc(); end);
procedure( const Sender: TObject; const M: TMessage )
begin
capProc();
end );
end; end;
procedure TComponentValidationHelper.AddMsgHandler(const MsgClass: TClass; const Signal: TSignal; const Proc: TMsgProc); procedure TComponentValidationHelper.AddMsgHandler(const MsgClass: TClass; const Signal: TSignal; const Proc: TMsgProc);
+3 -3
View File
@@ -16,7 +16,7 @@ type
// After waiting, or if the state is already set, any first stored exception // After waiting, or if the state is already set, any first stored exception
// from any worker thread of this factory will be re-raised in the calling (main) thread. // from any worker thread of this factory will be re-raised in the calling (main) thread.
// Raises ETaskException if called from within a worker thread. // Raises ETaskException if called from within a worker thread.
procedure WaitFor(State: TState.IState); procedure WaitFor(const State: TState.IState);
end; end;
var var
@@ -42,7 +42,7 @@ type
public public
// IMycTaskManager // IMycTaskManager
function CreateTask(const Gate: TState; const Proc: TProc): TSignal.TSubscription; function CreateTask(const Gate: TState; const Proc: TProc): TSignal.TSubscription;
procedure WaitFor(State: TState.IState); procedure WaitFor(const State: TState.IState);
constructor Create; constructor Create;
end; end;
@@ -77,7 +77,7 @@ begin
Result := Gate.Signal.Subscribe(TMycExecMock.Create(Proc)); Result := Gate.Signal.Subscribe(TMycExecMock.Create(Proc));
end; end;
procedure TMycTaskManagerMock.WaitFor(State: TState.IState); procedure TMycTaskManagerMock.WaitFor(const State: TState.IState);
begin begin
Assert(State.IsSet); Assert(State.IsSet);
end; end;
-1
View File
@@ -14,7 +14,6 @@ type
TChunk = TArray<TDataPoint<T>>; TChunk = TArray<TDataPoint<T>>;
private private
FChunks: TArray<TChunk>; FChunks: TArray<TChunk>;
FChunks1: TArray<TChunk>;
FCount: Int64; FCount: Int64;
FMaxLookback: Int64; FMaxLookback: Int64;
FTotalCount: Int64; FTotalCount: Int64;
+65
View File
@@ -176,6 +176,26 @@ type
function ParseFileName(const FileName: string): TAuraDataFile; override; function ParseFileName(const FileName: string): TAuraDataFile; override;
end; end;
// Implements a data stream that reads from Aura-specific historical data files.
TAuraFileLoader<T: record> = class(TInterfacedObject)
type
TDataProc = reference to procedure(const Values: TArray<TDataPoint<T>>);
public
class function LoadData(
DataServer: TAuraDataServer<T>;
const Symbol: String;
const Terminate: TSignal;
const Proc: TDataProc
): TState;
class procedure LoadFile(
DataServer: TAuraDataServer<T>;
currFile: TAuraDataFile;
Terminated: TState;
Done: TLatch;
Proc: TDataProc
);
end;
implementation implementation
uses uses
@@ -740,4 +760,49 @@ begin
end; end;
end; end;
class function TAuraFileLoader<T>.LoadData(
DataServer: TAuraDataServer<T>;
const Symbol: String;
const Terminate: TSignal;
const Proc: TDataProc
): TState;
begin
var capProc := Proc;
var terminated := TFlag.CreateObserver(Terminate).State;
var firstFile := DataServer.FindFirstFile(Symbol);
var done := TLatch.CreateLatch(1);
TaskManager.CreateTask(firstFile.Done, procedure begin LoadFile(DataServer, firstFile.Value, terminated, done, capProc); end);
Result := done.State;
end;
class procedure TAuraFileLoader<T>.LoadFile(
DataServer: TAuraDataServer<T>;
currFile: TAuraDataFile;
Terminated: TState;
Done: TLatch;
Proc: TDataProc
);
begin
if not currFile.IsValid or Terminated.IsSet then
begin
Done.Notify;
exit;
end;
var data := DataServer.LoadDataFile(currFile);
TaskManager.CreateTask(
data.Done,
procedure
begin
Proc(data.Value);
LoadFile(DataServer, currFile.GetNextFile, Terminated, Done, Proc);
end
);
end;
end. end.
+33 -49
View File
@@ -3,70 +3,54 @@ unit Myc.Trade.Ticker;
interface interface
uses uses
Myc.Lazy; System.SysUtils,
Myc.Signals,
Myc.Lazy,
Myc.Trade.DataPoint,
Myc.Trade.DataStream,
Myc.Trade.DataProvider;
type type
TMycLogger = reference to procedure(const Msg: String); TTickProc<T> = reference to procedure(const Tick: TDataPoint<T>);
IMycTradeObject = interface TTicker<T> = class(TInterfacedObject, TSignal.ISubscriber)
end; type
TConsumer = record
TMycTradeObject = class(TInterfacedObject, IMycTradeObject) Proc: TTickProc<T>;
Lookback: Int64;
end;
private private
FCaption: string; FStream: IDataStream<T>;
FLog: TMycLogger; FConsumers: TArray<TConsumer>;
function GetCaption: string; FProvider: TMutable<TDataSeries<T>>;
function Notify: Boolean;
public public
constructor Create(const ACaption: string; ALog: TMycLogger); constructor Create(const AStream: IDataStream<T>; const AConsumers: TArray<TConsumer>);
property Caption: string read GetCaption;
property Log: TMycLogger read FLog;
end;
IMycTime = interface
{$REGION 'property access'}
function GetTimeStamp: TDateTime;
{$ENDREGION}
property TimeStamp: TDateTime read GetTimeStamp;
end;
IMycTick = interface
{$REGION 'property access'}
function GetAsk: Double;
function GetBid: Double;
function GetTime: IMycTime;
function GetVolume: Double;
{$ENDREGION}
property Ask: Double read GetAsk;
property Bid: Double read GetBid;
property Time: IMycTime read GetTime;
property Volume: Double read GetVolume;
end;
IMycTicker = interface(IMycTradeObject)
{$REGION 'property access'}
function GetLastTick: TLazy<IMycTick>;
function GetCurrentTime: IMycTime;
{$ENDREGION}
property LastTick: TLazy<IMycTick> read GetLastTick;
property CurrentTime: IMycTime read GetCurrentTime;
end;
IMycHistoryTicker = interface(IMycTicker)
end; end;
implementation implementation
constructor TMycTradeObject.Create(const ACaption: string; ALog: TMycLogger); constructor TTicker<T>.Create(const AStream: IDataStream<T>; const AConsumers: TArray<TConsumer>);
begin begin
inherited Create; inherited Create;
FCaption := ACaption; FStream := AStream;
FLog := procedure(const Msg: String) begin ALog('[' + FCaption + '] ' + Msg); end; FConsumers := AConsumers;
var ml: Int64 := 0;
for var consumer in FConsumers do
if consumer.Lookback > ml then
ml := consumer.Lookback;
FProvider := TDataStreamProvider<T>.Create(ml, 100, AStream);
end; end;
function TMycTradeObject.GetCaption: string; { TTicker<T> }
function TTicker<T>.Notify: Boolean;
begin begin
Result := FCaption;
end; end;
end. end.