diff --git a/AuraTrader/AuraTrader.dpr b/AuraTrader/AuraTrader.dpr
index 0dd1b4e..9425132 100644
--- a/AuraTrader/AuraTrader.dpr
+++ b/AuraTrader/AuraTrader.dpr
@@ -8,12 +8,15 @@ uses
Myc.Trade.Core.DataPoint in '..\Src\Myc.Trade.Core.DataPoint.pas',
Myc.Trade.Ticker in '..\Src\Myc.Trade.Ticker.pas',
Myc.Aura.Module in '..\Src\Myc.Aura.Module.pas',
- Myc.Aura.Parameter in '..\Src\Myc.Aura.Parameter.pas';
+ Myc.Aura.Parameter in '..\Src\Myc.Aura.Parameter.pas',
+ TestModule in 'TestModule.pas',
+ TestChartControl in 'TestChartControl.pas' {TestChartForm};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
+ Application.CreateForm(TTestChartForm, TestChartForm);
Application.Run;
end.
diff --git a/AuraTrader/AuraTrader.dproj b/AuraTrader/AuraTrader.dproj
index 11c0b7b..d3265b9 100644
--- a/AuraTrader/AuraTrader.dproj
+++ b/AuraTrader/AuraTrader.dproj
@@ -4,7 +4,7 @@
20.3
FMX
True
- Release
+ Debug
Win64
AuraTrader
3
@@ -137,6 +137,11 @@
+
+
+
+ fmx
+
Base
@@ -180,6 +185,12 @@
true
+
+
+ AuraTrader.rsm
+ true
+
+
AuraTrader.exe
diff --git a/AuraTrader/MainForm.fmx b/AuraTrader/MainForm.fmx
index e1c14a6..e21a5d2 100644
--- a/AuraTrader/MainForm.fmx
+++ b/AuraTrader/MainForm.fmx
@@ -10,109 +10,200 @@ object Form1: TForm1
OnCreate = FormCreate
OnDestroy = FormDestroy
DesignerMasterStyle = 0
- object Panel1: TPanel
+ object MainPanel: TPanel
Align = Client
Size.Width = 796.00000000000000000
- Size.Height = 616.00000000000000000
+ Size.Height = 712.00000000000000000
Size.PlatformDefault = False
TabOrder = 2
- object Layout: TFlowLayout
- Align = Client
- Size.Width = 627.00000000000000000
- Size.Height = 616.00000000000000000
- Size.PlatformDefault = False
- TabOrder = 1
- Justify = Left
- JustifyLastLine = Left
- FlowDirection = LeftToRight
- HorizontalGap = 2.00000000000000000
- VerticalGap = 2.00000000000000000
- OnResized = LayoutResized
- end
- object SymbolsComboBox: TComboBox
- Anchors = [akTop, akRight]
- Position.X = 608.00000000000000000
- Position.Y = 16.00000000000000000
- Size.Width = 177.00000000000000000
- Size.Height = 22.00000000000000000
- Size.PlatformDefault = False
- TabOrder = 5
- end
- object RandomBox: TCheckBox
- Anchors = [akTop, akRight]
- Position.X = 609.00000000000000000
- Position.Y = 46.00000000000000000
- TabOrder = 2
- Text = 'Random'
- end
- object LoadButton: TButton
- Anchors = [akTop, akRight]
- Position.X = 641.00000000000000000
- Position.Y = 86.00000000000000000
- Size.Width = 47.00000000000000000
- Size.Height = 22.00000000000000000
- Size.PlatformDefault = False
- TabOrder = 6
- Text = 'Load'
- TextSettings.Trimming = None
- OnClick = LoadButtonClick
- end
- object RandomButton: TButton
- Anchors = [akTop, akRight]
- Position.X = 705.00000000000000000
- Position.Y = 86.00000000000000000
- TabOrder = 3
- Text = 'Random'
- TextSettings.Trimming = None
- OnClick = RandomButtonClick
- end
- object ChartButton: TButton
- Anchors = [akTop, akRight]
- Position.X = 665.00000000000000000
- Position.Y = 130.00000000000000000
- TabOrder = 8
- Text = 'ChartButton'
- TextSettings.Trimming = None
- OnClick = ChartButtonClick
- end
- object StopButton: TButton
- Anchors = [akTop, akRight]
- Position.X = 665.00000000000000000
- Position.Y = 160.00000000000000000
- TabOrder = 10
- Text = 'StopButton'
- TextSettings.Trimming = None
- OnClick = StopButtonClick
- end
- object TreeView1: TTreeView
- Align = Left
- Size.Width = 161.00000000000000000
- Size.Height = 616.00000000000000000
- Size.PlatformDefault = False
- TabOrder = 0
- Viewport.Width = 157.00000000000000000
- Viewport.Height = 612.00000000000000000
- end
object Splitter1: TSplitter
Align = Left
Cursor = crHSplit
MinSize = 20.00000000000000000
- Position.X = 161.00000000000000000
+ Position.X = 169.00000000000000000
Size.Width = 8.00000000000000000
- Size.Height = 616.00000000000000000
+ Size.Height = 712.00000000000000000
Size.PlatformDefault = False
end
+ object WorkspacePanel: TPanel
+ Align = Client
+ Size.Width = 619.00000000000000000
+ Size.Height = 712.00000000000000000
+ Size.PlatformDefault = False
+ TabOrder = 3
+ object TabControl: TTabControl
+ Align = Client
+ Size.Width = 619.00000000000000000
+ Size.Height = 672.00000000000000000
+ Size.PlatformDefault = False
+ TabIndex = 0
+ TabOrder = 10
+ TabPosition = PlatformDefault
+ end
+ object ToolBar: TToolBar
+ Size.Width = 619.00000000000000000
+ Size.Height = 40.00000000000000000
+ Size.PlatformDefault = False
+ TabOrder = 3
+ object AddWorkspaceButton: TSpeedButton
+ Action = AddWorkspaceAction
+ Align = FitLeft
+ ImageIndex = -1
+ Size.Width = 145.45458984375000000
+ Size.Height = 40.00000000000000000
+ Size.PlatformDefault = False
+ Text = 'Add'
+ TextSettings.Trimming = None
+ end
+ object TestButton: TSpeedButton
+ Action = TestAction
+ Align = FitLeft
+ ImageIndex = -1
+ Position.X = 145.45458984375000000
+ Size.Width = 145.45454406738280000
+ Size.Height = 40.00000000000000000
+ Size.PlatformDefault = False
+ TextSettings.Trimming = None
+ object TestPopup: TPopup
+ PlacementTarget = TestButton
+ Size.Width = 400.00000000000000000
+ Size.Height = 400.00000000000000000
+ Size.PlatformDefault = False
+ TabOrder = 7
+ object FlowLayout1: TFlowLayout
+ Position.X = 224.00000000000000000
+ Position.Y = 167.00000000000000000
+ TabOrder = 4
+ Justify = Left
+ JustifyLastLine = Left
+ FlowDirection = LeftToRight
+ object RandomBox: TCheckBox
+ Anchors = [akTop, akRight]
+ TabOrder = 1
+ Text = 'Random'
+ end
+ object LoadButton: TButton
+ Anchors = [akTop, akRight]
+ Position.Y = 19.00000000000000000
+ Size.Width = 47.00000000000000000
+ Size.Height = 22.00000000000000000
+ Size.PlatformDefault = False
+ TabOrder = 5
+ Text = 'Load'
+ TextSettings.Trimming = None
+ OnClick = LoadButtonClick
+ end
+ object RandomButton: TButton
+ Anchors = [akTop, akRight]
+ Position.Y = 41.00000000000000000
+ TabOrder = 2
+ Text = 'Random'
+ TextSettings.Trimming = None
+ OnClick = RandomButtonClick
+ end
+ object StopButton: TButton
+ Anchors = [akTop, akRight]
+ Position.Y = 63.00000000000000000
+ TabOrder = 8
+ Text = 'StopButton'
+ TextSettings.Trimming = None
+ OnClick = StopButtonClick
+ end
+ object ChartButton: TButton
+ Anchors = [akTop, akRight]
+ Position.Y = 85.00000000000000000
+ TabOrder = 7
+ Text = 'ChartButton'
+ TextSettings.Trimming = None
+ OnClick = ChartButtonClick
+ end
+ object SymbolsComboBox: TComboBox
+ Anchors = [akTop, akRight]
+ Position.Y = 107.00000000000000000
+ Size.Width = 177.00000000000000000
+ Size.Height = 22.00000000000000000
+ Size.PlatformDefault = False
+ TabOrder = 4
+ end
+ end
+ end
+ end
+ object SpeedButton1: TSpeedButton
+ Position.X = 376.00000000000000000
+ Position.Y = 8.00000000000000000
+ Text = 'SpeedButton1'
+ TextSettings.Trimming = None
+ OnClick = SpeedButton1Click
+ end
+ end
+ end
+ object ObjectsPanel: TPanel
+ Align = Left
+ Size.Width = 169.00000000000000000
+ Size.Height = 712.00000000000000000
+ Size.PlatformDefault = False
+ TabOrder = 4
+ object ObjectsTabControl: TTabControl
+ Align = Client
+ Size.Width = 169.00000000000000000
+ Size.Height = 712.00000000000000000
+ Size.PlatformDefault = False
+ TabIndex = 0
+ TabOrder = 0
+ TabPosition = Bottom
+ Sizes = (
+ 169s
+ 686s)
+ object ModulesTabItem: TTabItem
+ CustomIcon = <
+ item
+ end>
+ TextSettings.Trimming = None
+ IsSelected = True
+ Size.Width = 66.00000000000000000
+ Size.Height = 26.00000000000000000
+ Size.PlatformDefault = False
+ StyleLookup = ''
+ TabOrder = 0
+ Text = 'Modules'
+ object TreeView: TTreeView
+ Align = Client
+ Size.Width = 169.00000000000000000
+ Size.Height = 686.00000000000000000
+ Size.PlatformDefault = False
+ TabOrder = 0
+ OnDblClick = TreeViewDblClick
+ AllowDrag = True
+ Viewport.Width = 165.00000000000000000
+ Viewport.Height = 682.00000000000000000
+ end
+ end
+ end
+ end
end
object LogMemo: TMemo
Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
DataDetectorTypes = []
Align = Bottom
- Position.Y = 616.00000000000000000
+ Position.Y = 712.00000000000000000
Size.Width = 796.00000000000000000
- Size.Height = 224.00000000000000000
+ Size.Height = 128.00000000000000000
Size.PlatformDefault = False
TabOrder = 1
Viewport.Width = 792.00000000000000000
- Viewport.Height = 220.00000000000000000
+ Viewport.Height = 124.00000000000000000
+ end
+ object ActionList: TActionList
+ Left = 209
+ Top = 32
+ object AddWorkspaceAction: TAction
+ Text = 'Add Workspace'
+ OnExecute = AddWorkspaceActionExecute
+ end
+ object TestAction: TAction
+ Text = 'Test...'
+ Checked = True
+ OnExecute = TestActionExecute
+ end
end
end
diff --git a/AuraTrader/MainForm.pas b/AuraTrader/MainForm.pas
index 4356635..28c4117 100644
--- a/AuraTrader/MainForm.pas
+++ b/AuraTrader/MainForm.pas
@@ -10,6 +10,7 @@ uses
System.Variants,
System.DateUtils,
System.Generics.Collections,
+ System.Rtti,
FMX.Types,
FMX.Controls,
FMX.Forms,
@@ -33,24 +34,44 @@ uses
Myc.Lazy,
Myc.Signals.FMX,
Myc.TaskManager,
+ Myc.Aura.Module,
FMX.ListBox,
FMX.Layouts,
- FMX.MultiView,
- FMX.TreeView;
+ FMX.TreeView,
+ FMX.TabControl,
+ FMX.Menus,
+ System.ImageList,
+ FMX.ImgList,
+ System.Actions,
+ FMX.ActnList,
+ TestChartControl;
type
TForm1 = class(TForm)
LogMemo: TMemo;
- Panel1: TPanel;
- Layout: TFlowLayout;
+ MainPanel: TPanel;
SymbolsComboBox: TComboBox;
RandomBox: TCheckBox;
LoadButton: TButton;
RandomButton: TButton;
ChartButton: TButton;
StopButton: TButton;
- TreeView1: TTreeView;
Splitter1: TSplitter;
+ ActionList: TActionList;
+ AddWorkspaceAction: TAction;
+ WorkspacePanel: TPanel;
+ TabControl: TTabControl;
+ ToolBar: TToolBar;
+ AddWorkspaceButton: TSpeedButton;
+ ObjectsPanel: TPanel;
+ ObjectsTabControl: TTabControl;
+ ModulesTabItem: TTabItem;
+ TreeView: TTreeView;
+ TestButton: TSpeedButton;
+ TestAction: TAction;
+ SpeedButton1: TSpeedButton;
+ TestPopup: TPopup;
+ FlowLayout1: TFlowLayout;
procedure RandomButtonClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
@@ -58,6 +79,10 @@ type
procedure ChartButtonClick(Sender: TObject);
procedure StopButtonClick(Sender: TObject);
procedure LayoutResized(Sender: TObject);
+ procedure TreeViewDblClick(Sender: TObject);
+ procedure AddWorkspaceActionExecute(Sender: TObject);
+ procedure TestActionExecute(Sender: TObject);
+ procedure SpeedButton1Click(Sender: TObject);
private
const
cnt = 20;
@@ -75,10 +100,13 @@ type
FRandom: TList;
FTerminate: TEvent;
FLoadDone: TState;
+ FApplication: IAuraApplication;
+ FModulesItem: TTreeViewItem;
function SelectedSymbol: String;
- function SelectedStream: IDataStream;
+
public
- { Public declarations }
+ procedure NewWorkspace;
+ function CurrLayout: TFlowLayout;
published
property OnEvent: TNotifyEvent read FOnEvent write FOnEvent;
end;
@@ -88,15 +116,99 @@ var
implementation
+uses
+ TestModule;
+
{$R *.fmx}
+procedure TForm1.NewWorkspace;
+begin
+ var ws: IAuraWorkspace := TMycAuraWorkspace.Create('New workspace', tmTesting);
+ FApplication.Workspaces.Insert(-1, ws);
+
+ var tab := TabControl.Add;
+ tab.Text := ws.Caption;
+ tab.Tag := NativeInt(ws);
+
+ var tabBtn := TSpeedButton.Create(Self);
+ tabBtn.Parent := tab;
+ tabBtn.Align := TAlignLayout.Right;
+
+ var scrollbox := TVertScrollBox.Create(Self);
+ scrollbox.Parent := tab;
+ scrollbox.Align := TAlignLayout.Client;
+
+ var flow := TFlowLayout.Create(Self);
+ flow.Parent := tab;
+ flow.Align := TAlignLayout.Client;
+
+ tab.ProcessSignal(ws.Name.Changed, procedure begin tab.Text := ws.Caption; end);
+end;
+
procedure TForm1.StopButtonClick(Sender: TObject);
begin
FTerminate.Notify;
end;
+procedure TForm1.TreeViewDblClick(Sender: TObject);
+begin
+ var addnew := false;
+
+ var sel := TreeView.Selected as TTreeViewItem;
+
+ var parent := sel.ParentItem;
+ if parent = nil then
+ exit;
+
+ if parent = FModulesItem then
+ begin
+ if (TabControl.ActiveTab <> nil) and (TabControl.ActiveTab.Tag <> 0) then
+ begin
+ var ws := IAuraWorkspace(TabControl.ActiveTab.Tag);
+ var module := FApplication.Modules[sel.TagString];
+ if (ws <> nil) and (module <> nil) then
+ module.SetupWorkspace(ws);
+ end;
+ end;
+end;
+
procedure TForm1.FormCreate(Sender: TObject);
begin
+ FApplication := TMycAuraApplication.Create;
+
+ FModulesItem := TTreeViewItem.Create(Self);
+ FModulesItem.Text := 'Modules';
+
+ const modName = 'Test_Module';
+
+ FApplication.RegisterModule(modName, TTestModule.Create('Test-Module', 1));
+
+ TreeView.AddObject(FModulesItem);
+ FModulesItem.ProcessSignal(
+ FApplication.ModuleNames.Changed,
+ procedure
+ begin
+ FModulesItem.BeginUpdate;
+ try
+ while FModulesItem.Count > 0 do
+ FModulesItem[0].Free;
+ var mods := FApplication.ModuleNames.Value;
+ for var i := 0 to High(mods) do
+ begin
+ var ModItem := TTreeViewItem.Create(Self);
+ ModItem.Text := mods[i];
+ ModItem.DragMode := TDragMode.dmAutomatic;
+ ModItem.Text := 'Module-' + mods[i];
+ ModItem.TagString := mods[i];
+ FModulesItem.AddObject(ModItem);
+ end;
+ FModulesItem.ExpandAll;
+ finally
+ FModulesItem.EndUpdate;
+ end;
+ end
+ );
+
FTerminate := TEvent.CreateEvent;
FRandom := TList.Create;
@@ -130,6 +242,8 @@ begin
end;
end
);
+
+ NewWorkspace;
end;
procedure TForm1.FormDestroy(Sender: TObject);
@@ -149,6 +263,9 @@ procedure TForm1.LoadButtonClick(Sender: TObject);
begin
if SymbolsComboBox.ItemIndex < 0 then
exit;
+ var Layout := CurrLayout;
+ if Layout = nil then
+ exit;
var Stream := FServer.CreateStream(FSymbols.WaitFor[SymbolsComboBox.ItemIndex]);
var Data := TDataStreamProvider.Create(30000, 10000, Stream);
@@ -181,6 +298,10 @@ end;
procedure TForm1.RandomButtonClick(Sender: TObject);
begin
+ var Layout := CurrLayout;
+ if Layout = nil then
+ exit;
+
var rnd: TRndItem;
rnd.Stream := FServer.CreateStream(FSymbols.WaitFor[Random(Length(FSymbols.WaitFor))]);
@@ -221,8 +342,22 @@ begin
Proc(FRandom.Count - 1);
end;
+procedure TForm1.TestActionExecute(Sender: TObject);
+begin
+ TestPopup.IsOpen := TestAction.Checked;
+end;
+
+procedure TForm1.AddWorkspaceActionExecute(Sender: TObject);
+begin
+ NewWorkspace;
+end;
+
procedure TForm1.ChartButtonClick(Sender: TObject);
begin
+ var Layout := CurrLayout;
+ if Layout = nil then
+ exit;
+
var Symbol := SelectedSymbol;
if Symbol = '' then
exit;
@@ -283,12 +418,25 @@ begin
);
end;
-function TForm1.SelectedStream: IDataStream;
+function TForm1.CurrLayout: TFlowLayout;
begin
- var sym := SelectedSymbol;
- if sym = '' then
+ if TabControl.ActiveTab = nil then
exit(nil);
- Result := FServer.CreateStream(sym);
+
+ var Res: TFlowLayout := nil;
+ TabControl.ActiveTab.EnumControls(
+ function(Control: TControl): TEnumControlsResult
+ begin
+ Result := TEnumControlsResult.Continue;
+ if Control is TFlowLayout then
+ begin
+ Res := Control as TFlowLayout;
+ Result := TEnumControlsResult.Stop;
+ end;
+ end
+ );
+
+ Result := Res;
end;
function TForm1.SelectedSymbol: String;
@@ -300,4 +448,9 @@ begin
Result := FSymbols.WaitFor[SymbolsComboBox.ItemIndex];
end;
+procedure TForm1.SpeedButton1Click(Sender: TObject);
+begin
+ TestChartForm.Visible := true;
+end;
+
end.
diff --git a/AuraTrader/TestChartControl.fmx b/AuraTrader/TestChartControl.fmx
new file mode 100644
index 0000000..40c1180
--- /dev/null
+++ b/AuraTrader/TestChartControl.fmx
@@ -0,0 +1,12 @@
+object TestChartForm: TTestChartForm
+ Left = 0
+ Top = 0
+ Caption = 'Chart Test'
+ ClientHeight = 480
+ ClientWidth = 640
+ FormFactor.Width = 320
+ FormFactor.Height = 480
+ FormFactor.Devices = [Desktop]
+ OnCreate = FormCreate
+ DesignerMasterStyle = 0
+end
diff --git a/AuraTrader/TestChartControl.pas b/AuraTrader/TestChartControl.pas
new file mode 100644
index 0000000..b7cae58
--- /dev/null
+++ b/AuraTrader/TestChartControl.pas
@@ -0,0 +1,698 @@
+unit TestChartControl;
+
+interface
+
+uses
+ System.SysUtils,
+ System.Types,
+ System.UITypes,
+ System.Classes,
+ System.Variants,
+ System.Generics.Collections,
+ System.Math,
+ System.UIConsts, // For AlphaColors
+ FMX.Types,
+ FMX.Controls,
+ FMX.Forms,
+ FMX.Graphics,
+ FMX.Dialogs,
+ FMX.Objects,
+ Myc.Trade.DataPoint;
+
+type
+ // Declared for testing, will be moved to external unit
+ TOhlcItem = record
+ Open, High, Low, Close: Double;
+ end;
+
+ // Custom high-precision point type using Double.
+ TPointD = record
+ public
+ X: Double;
+ Y: Double;
+ constructor Create(AX, AY: Double);
+ end;
+
+ // Custom high-precision rectangle type using Double.
+ TRectD = record
+ private
+ function GetHeight: Double;
+ function GetWidth: Double;
+ public
+ Left, Top, Right, Bottom: Double;
+ constructor Create(const ALeft, ATop, ARight, ABottom: Double); overload;
+ constructor Create(const ATopLeft, ABottomRight: TPointD); overload;
+ property Width: Double read GetWidth;
+ property Height: Double read GetHeight;
+ end;
+
+ TChart = class; // Forward declaration
+
+ // Abstract base class for a single series in a chart.
+ TChartSeries = class abstract(TCollectionItem)
+ private
+ FColor: TAlphaColor;
+ FThickness: Single;
+ procedure SetColor(const Value: TAlphaColor);
+ procedure SetThickness(const Value: Single);
+ protected
+ function GetChart: TChart;
+ public
+ constructor Create(Collection: TCollection); override;
+ // Calculates the bounding box for this series.
+ procedure GetBounds(var MinPoint, MaxPoint: TPointD); virtual; abstract;
+ // Draws the series on the canvas.
+ procedure Draw(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF); virtual; abstract;
+ published
+ property Color: TAlphaColor read FColor write SetColor;
+ property Thickness: Single read FThickness write SetThickness;
+ end;
+
+ // Generic, abstract adapter to connect a TDataSeries to a TChart.
+ TChartSeriesAdapter = class abstract(TChartSeries)
+ private
+ FDataSeries: TDataSeries;
+ protected
+ procedure SetDataSeries(const Value: TDataSeries); virtual;
+ // Converts a data point from the source series to a high-precision visual point for the chart.
+ // May not be applicable for all series types (e.g., OHLC).
+ function DataToPoint(const DataPoint: TDataPoint): TPointD; virtual; abstract;
+ public
+ constructor Create(Collection: TCollection); override;
+ property DataSeries: TDataSeries read FDataSeries write SetDataSeries;
+ end;
+
+ TDataSourceField = (dsfAsk, dsfBid);
+
+ // Concrete series implementation for displaying TDataSeries.
+ TChartAskBidSeries = class(TChartSeriesAdapter)
+ private
+ FDataSourceField: TDataSourceField;
+ FCachedPoints: TArray;
+ FCacheValid: Boolean;
+ procedure SetDataSourceField(const Value: TDataSourceField);
+ procedure EnsureCacheIsValid;
+ protected
+ procedure SetDataSeries(const Value: TDataSeries); override;
+ function DataToPoint(const DataPoint: TDataPoint): TPointD; override;
+ public
+ constructor Create(Collection: TCollection); override;
+ procedure GetBounds(var MinPoint, MaxPoint: TPointD); override;
+ procedure Draw(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF); override;
+ published
+ property DataSourceField: TDataSourceField read FDataSourceField write SetDataSourceField;
+ end;
+
+ // Concrete series implementation for displaying TDataSeries as candlesticks.
+ TChartOhlcSeries = class(TChartSeriesAdapter)
+ private
+ FUpColor: TAlphaColor;
+ FDownColor: TAlphaColor;
+ protected
+ // This function is not used for OHLC drawing but must be implemented.
+ function DataToPoint(const DataPoint: TDataPoint): TPointD; override;
+ public
+ constructor Create(Collection: TCollection); override;
+ procedure GetBounds(var MinPoint, MaxPoint: TPointD); override;
+ procedure Draw(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF); override;
+ published
+ property UpColor: TAlphaColor read FUpColor write FUpColor;
+ property DownColor: TAlphaColor read FDownColor write FDownColor;
+ end;
+
+ TChartSeriesCollection = class(TCollection)
+ private
+ [weak]
+ FOwner: TChart;
+ function GetItem(Index: Integer): TChartSeries;
+ procedure SetItem(Index: Integer; const Value: TChartSeries);
+ protected
+ function GetOwner: TPersistent; override;
+ procedure Update(Item: TCollectionItem); override;
+ public
+ constructor Create(AOwner: TChart);
+ property Items[Index: Integer]: TChartSeries read GetItem write SetItem; default;
+ end;
+
+ // A control for displaying charts.
+ TChart = class(TControl)
+ private
+ FSeries: TChartSeriesCollection;
+ FAxisColor: TAlphaColor;
+ FGridColor: TAlphaColor;
+ FPadding: Single;
+ procedure SetSeries(const Value: TChartSeriesCollection);
+ procedure SetAxisColor(const Value: TAlphaColor);
+ procedure SetGridColor(const Value: TAlphaColor);
+ procedure SetPadding(const Value: Single);
+ protected
+ procedure Paint; override;
+ procedure RecalcDataBounds(out MinPoint, MaxPoint: TPointD);
+ procedure DrawAxes(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF);
+ procedure DrawGrid(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure Repaint;
+ published
+ property Align;
+ property Anchors;
+ property Series: TChartSeriesCollection read FSeries write SetSeries;
+ property AxisColor: TAlphaColor read FAxisColor write SetAxisColor;
+ property GridColor: TAlphaColor read FGridColor write SetGridColor;
+ property Padding: Single read FPadding write SetPadding;
+ end;
+
+ TTestChartForm = class(TForm)
+ procedure FormCreate(Sender: TObject);
+ private
+ FChart: TChart;
+ public
+ end;
+
+var
+ TestChartForm: TTestChartForm;
+
+implementation
+
+{$R *.fmx}
+
+{ TPointD }
+
+constructor TPointD.Create(AX, AY: Double);
+begin
+ X := AX;
+ Y := AY;
+end;
+
+{ TRectD }
+
+constructor TRectD.Create(const ALeft, ATop, ARight, ABottom: Double);
+begin
+ Left := ALeft;
+ Top := ATop;
+ Right := ARight;
+ Bottom := ABottom;
+end;
+
+constructor TRectD.Create(const ATopLeft, ABottomRight: TPointD);
+begin
+ Left := ATopLeft.X;
+ Top := ATopLeft.Y;
+ Right := ABottomRight.X;
+ Bottom := ABottomRight.Y;
+end;
+
+function TRectD.GetHeight: Double;
+begin
+ Result := Bottom - Top;
+end;
+
+function TRectD.GetWidth: Double;
+begin
+ Result := Right - Left;
+end;
+
+{ TChartSeries }
+
+constructor TChartSeries.Create(Collection: TCollection);
+begin
+ inherited Create(Collection);
+ FColor := TAlphaColors.Black; // Default color for wicks in OHLC
+ FThickness := 1;
+end;
+
+function TChartSeries.GetChart: TChart;
+begin
+ Result := (Collection as TChartSeriesCollection).GetOwner as TChart;
+end;
+
+procedure TChartSeries.SetColor(const Value: TAlphaColor);
+begin
+ if (FColor <> Value) then
+ begin
+ FColor := Value;
+ if Assigned(Collection) then
+ Changed(False);
+ end;
+end;
+
+procedure TChartSeries.SetThickness(const Value: Single);
+begin
+ if (FThickness <> Value) then
+ begin
+ FThickness := Value;
+ if Assigned(Collection) then
+ Changed(False);
+ end;
+end;
+
+{ TChartSeriesAdapter }
+
+constructor TChartSeriesAdapter.Create(Collection: TCollection);
+begin
+ inherited Create(Collection);
+ FDataSeries := TDataSeries.Null;
+end;
+
+procedure TChartSeriesAdapter.SetDataSeries(const Value: TDataSeries);
+begin
+ FDataSeries := Value;
+ if Assigned(Collection) then
+ Changed(False);
+end;
+
+{ TChartAskBidSeries }
+
+constructor TChartAskBidSeries.Create(Collection: TCollection);
+begin
+ inherited Create(Collection);
+ Self.Color := TAlphaColors.Blue; // Override default for line charts
+ Self.Thickness := 2;
+ FDataSourceField := dsfAsk;
+ FCacheValid := False;
+end;
+
+procedure TChartAskBidSeries.EnsureCacheIsValid;
+var
+ i: Int64;
+ pointCount: Int64;
+begin
+ if FCacheValid then
+ Exit;
+ pointCount := DataSeries.Count;
+ SetLength(FCachedPoints, pointCount);
+ if (pointCount > 0) then
+ begin
+ for i := 0 to pointCount - 1 do
+ begin
+ FCachedPoints[i] := DataToPoint(DataSeries[pointCount - 1 - i]);
+ end;
+ end;
+ FCacheValid := True;
+end;
+
+procedure TChartAskBidSeries.GetBounds(var MinPoint, MaxPoint: TPointD);
+var
+ pt: TPointD;
+ isFirst: Boolean;
+begin
+ EnsureCacheIsValid;
+ if (Length(FCachedPoints) = 0) then
+ Exit;
+ isFirst := (MinPoint.X = MaxPoint.X) and (MinPoint.Y = MaxPoint.Y);
+ if isFirst then
+ begin
+ MinPoint := FCachedPoints[0];
+ MaxPoint := FCachedPoints[0];
+ end;
+ for pt in FCachedPoints do
+ begin
+ MinPoint.X := Min(MinPoint.X, pt.X);
+ MinPoint.Y := Min(MinPoint.Y, pt.Y);
+ MaxPoint.X := Max(MaxPoint.X, pt.X);
+ MaxPoint.Y := Max(MaxPoint.Y, pt.Y);
+ end;
+end;
+
+procedure TChartAskBidSeries.Draw(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF);
+var
+ scaleX, scaleY: Double;
+ pt1, pt2: TPointD;
+ transformedPt1, transformedPt2: TPointF;
+ j: Integer;
+begin
+ EnsureCacheIsValid;
+ if Length(FCachedPoints) < 2 then
+ Exit;
+ if (ADataRect.Width <= 0) or (ADataRect.Height <= 0) then
+ Exit;
+ scaleX := ACanvasRect.Width / ADataRect.Width;
+ scaleY := ACanvasRect.Height / ADataRect.Height;
+ ACanvas.Stroke.Kind := TBrushKind.Solid;
+ ACanvas.Stroke.Color := Self.Color;
+ ACanvas.Stroke.Thickness := Self.Thickness;
+ pt1 := FCachedPoints[0];
+ for j := 1 to High(FCachedPoints) do
+ begin
+ pt2 := FCachedPoints[j];
+ transformedPt1.X := ACanvasRect.Left + (pt1.X - ADataRect.Left) * scaleX;
+ transformedPt1.Y := ACanvasRect.Bottom - (pt1.Y - ADataRect.Top) * scaleY;
+ transformedPt2.X := ACanvasRect.Left + (pt2.X - ADataRect.Left) * scaleX;
+ transformedPt2.Y := ACanvasRect.Bottom - (pt2.Y - ADataRect.Top) * scaleY;
+ ACanvas.DrawLine(transformedPt1, transformedPt2, 1);
+ pt1 := pt2;
+ end;
+end;
+
+procedure TChartAskBidSeries.SetDataSeries(const Value: TDataSeries);
+begin
+ inherited SetDataSeries(Value);
+ FCacheValid := False;
+end;
+
+function TChartAskBidSeries.DataToPoint(const DataPoint: TDataPoint): TPointD;
+begin
+ Result.X := DataPoint.Time;
+ case FDataSourceField of
+ dsfAsk: Result.Y := DataPoint.Data.Ask;
+ dsfBid: Result.Y := DataPoint.Data.Bid;
+ else
+ Result.Y := 0;
+ end;
+end;
+
+procedure TChartAskBidSeries.SetDataSourceField(const Value: TDataSourceField);
+begin
+ if (FDataSourceField <> Value) then
+ begin
+ FDataSourceField := Value;
+ FCacheValid := False;
+ if Assigned(Collection) then
+ Changed(False);
+ end;
+end;
+
+{ TChartOhlcSeries }
+
+constructor TChartOhlcSeries.Create(Collection: TCollection);
+begin
+ inherited Create(Collection);
+ FUpColor := TAlphaColors.Green;
+ FDownColor := TAlphaColors.Red;
+end;
+
+function TChartOhlcSeries.DataToPoint(const DataPoint: TDataPoint): TPointD;
+begin
+ // Not used for OHLC series drawing, but must be implemented for the abstract parent.
+ Result.X := DataPoint.Time;
+ Result.Y := DataPoint.Data.Close;
+end;
+
+procedure TChartOhlcSeries.GetBounds(var MinPoint, MaxPoint: TPointD);
+var
+ isFirst: Boolean;
+ i: Int64;
+ dataPoint: TDataPoint;
+begin
+ if (DataSeries.Count = 0) then
+ Exit;
+ isFirst := (MinPoint.X > MaxPoint.X); // A more robust check for an uninitialized state
+ for i := 0 to DataSeries.Count - 1 do
+ begin
+ dataPoint := DataSeries[i];
+ if isFirst then
+ begin
+ MinPoint.X := dataPoint.Time;
+ MaxPoint.X := dataPoint.Time;
+ MinPoint.Y := dataPoint.Data.Low;
+ MaxPoint.Y := dataPoint.Data.High;
+ isFirst := False;
+ end
+ else
+ begin
+ MinPoint.X := Min(MinPoint.X, dataPoint.Time);
+ MaxPoint.X := Max(MaxPoint.X, dataPoint.Time);
+ MinPoint.Y := Min(MinPoint.Y, dataPoint.Data.Low);
+ MaxPoint.Y := Max(MaxPoint.Y, dataPoint.Data.High);
+ end;
+ end;
+end;
+
+procedure TChartOhlcSeries.Draw(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF);
+var
+ scaleX, scaleY: Double;
+ i: Int64;
+ dataPoint: TDataPoint;
+ x_center, candleWidth: Single;
+ y_high, y_low, y_open, y_close: Single;
+ body: TRectF;
+begin
+ if (DataSeries.Count = 0) or (ADataRect.Width <= 0) or (ADataRect.Height <= 0) then
+ Exit;
+ scaleX := ACanvasRect.Width / ADataRect.Width;
+ scaleY := ACanvasRect.Height / ADataRect.Height;
+ candleWidth := Max(3.0, (ACanvasRect.Width / DataSeries.Count) * 0.8);
+
+ for i := 0 to DataSeries.Count - 1 do
+ begin
+ dataPoint := DataSeries[i];
+ x_center := ACanvasRect.Left + (dataPoint.Time - ADataRect.Left) * scaleX;
+ y_high := ACanvasRect.Bottom - (dataPoint.Data.High - ADataRect.Top) * scaleY;
+ y_low := ACanvasRect.Bottom - (dataPoint.Data.Low - ADataRect.Top) * scaleY;
+ y_open := ACanvasRect.Bottom - (dataPoint.Data.Open - ADataRect.Top) * scaleY;
+ y_close := ACanvasRect.Bottom - (dataPoint.Data.Close - ADataRect.Top) * scaleY;
+
+ ACanvas.Stroke.Color := Self.Color;
+ ACanvas.Stroke.Thickness := Self.Thickness;
+ ACanvas.DrawLine(TPointF.Create(x_center, y_high), TPointF.Create(x_center, y_low), 1.0);
+
+ if (dataPoint.Data.Close >= dataPoint.Data.Open) then
+ ACanvas.Fill.Color := FUpColor
+ else
+ ACanvas.Fill.Color := FDownColor;
+
+ body := TRectF.Create(x_center - candleWidth / 2, y_open, x_center + candleWidth / 2, y_close);
+ NormalizeRect(body);
+ ACanvas.FillRect(body, 0, 0, [], 1.0);
+ end;
+end;
+
+{ TChartSeriesCollection }
+
+constructor TChartSeriesCollection.Create(AOwner: TChart);
+begin
+ inherited Create(TChartSeries);
+ FOwner := AOwner;
+end;
+
+function TChartSeriesCollection.GetItem(Index: Integer): TChartSeries;
+begin
+ Result := TChartSeries(inherited GetItem(Index));
+end;
+
+function TChartSeriesCollection.GetOwner: TPersistent;
+begin
+ Result := FOwner;
+end;
+
+procedure TChartSeriesCollection.SetItem(Index: Integer; const Value: TChartSeries);
+begin
+ inherited SetItem(Index, Value);
+end;
+
+procedure TChartSeriesCollection.Update(Item: TCollectionItem);
+begin
+ inherited;
+ if Assigned(FOwner) then
+ FOwner.Repaint;
+end;
+
+{ TChart }
+
+constructor TChart.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FSeries := TChartSeriesCollection.Create(Self);
+ FAxisColor := TAlphaColors.Black;
+ FGridColor := TAlphaColors.Lightgray;
+ FPadding := 30;
+end;
+
+destructor TChart.Destroy;
+begin
+ FSeries.Free;
+ inherited Destroy;
+end;
+
+procedure TChart.Paint;
+var
+ minPt, maxPt: TPointD;
+ dataRect: TRectD;
+ canvasRect: TRectF;
+ series: TCollectionItem;
+ hasData: Boolean;
+begin
+ inherited;
+ Canvas.Fill.Color := TAlphaColors.White;
+ Canvas.FillRect(LocalRect, 1);
+ if (FSeries.Count = 0) then
+ Exit;
+
+ RecalcDataBounds(minPt, maxPt);
+ hasData := (minPt.X < maxPt.X) and (minPt.Y < maxPt.Y);
+
+ if not hasData then
+ Exit;
+
+ dataRect := TRectD.Create(minPt, maxPt);
+ canvasRect := Self.LocalRect;
+ canvasRect.Inflate(-FPadding, -FPadding);
+
+ if (canvasRect.Width < 1) or (canvasRect.Height < 1) then
+ Exit;
+
+ DrawGrid(Canvas, dataRect, canvasRect);
+ DrawAxes(Canvas, dataRect, canvasRect);
+
+ for series in FSeries do
+ begin
+ (series as TChartSeries).Draw(Canvas, dataRect, canvasRect);
+ end;
+end;
+
+procedure TChart.RecalcDataBounds(out MinPoint, MaxPoint: TPointD);
+var
+ series: TCollectionItem;
+begin
+ MinPoint := TPointD.Create(Infinity, Infinity);
+ MaxPoint := TPointD.Create(NegInfinity, NegInfinity);
+
+ for series in FSeries do
+ begin
+ (series as TChartSeries).GetBounds(MinPoint, MaxPoint);
+ end;
+end;
+
+procedure TChart.DrawAxes(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF);
+begin
+ ACanvas.Stroke.Kind := TBrushKind.Solid;
+ ACanvas.Stroke.Color := FAxisColor;
+ ACanvas.Stroke.Thickness := 1;
+ ACanvas.DrawLine(TPointF.Create(ACanvasRect.Left, ACanvasRect.Bottom), TPointF.Create(ACanvasRect.Right, ACanvasRect.Bottom), 1);
+ ACanvas.DrawLine(TPointF.Create(ACanvasRect.Left, ACanvasRect.Top), TPointF.Create(ACanvasRect.Left, ACanvasRect.Bottom), 1);
+end;
+
+procedure TChart.DrawGrid(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF);
+var
+ i: Integer;
+ x, y: Single;
+const
+ GridLines = 5;
+begin
+ ACanvas.Stroke.Kind := TBrushKind.Solid;
+ ACanvas.Stroke.Color := FGridColor;
+ ACanvas.Stroke.Thickness := 1;
+ ACanvas.Stroke.Dash := TStrokeDash.Dot;
+ for i := 1 to GridLines do
+ begin
+ x := ACanvasRect.Left + i * ACanvasRect.Width / GridLines;
+ ACanvas.DrawLine(TPointF.Create(x, ACanvasRect.Top), TPointF.Create(x, ACanvasRect.Bottom), 1);
+ end;
+ for i := 0 to GridLines - 1 do
+ begin
+ y := ACanvasRect.Bottom - i * ACanvasRect.Height / GridLines;
+ ACanvas.DrawLine(TPointF.Create(ACanvasRect.Left, y), TPointF.Create(ACanvasRect.Right, y), 1);
+ end;
+ ACanvas.Stroke.Dash := TStrokeDash.Solid;
+end;
+
+procedure TChart.SetSeries(const Value: TChartSeriesCollection);
+begin
+ FSeries.Assign(Value);
+end;
+
+procedure TChart.SetAxisColor(const Value: TAlphaColor);
+begin
+ if (FAxisColor <> Value) then
+ begin
+ FAxisColor := Value;
+ Repaint;
+ end;
+end;
+
+procedure TChart.SetGridColor(const Value: TAlphaColor);
+begin
+ if (FGridColor <> Value) then
+ begin
+ FGridColor := Value;
+ Repaint;
+ end;
+end;
+
+procedure TChart.SetPadding(const Value: Single);
+begin
+ if (FPadding <> Value) then
+ begin
+ FPadding := Value;
+ Repaint;
+ end;
+end;
+
+procedure TChart.Repaint;
+begin
+ inherited;
+end;
+
+{ TTestChartForm }
+
+procedure TTestChartForm.FormCreate(Sender: TObject);
+var
+ ohlcSeries: TChartOhlcSeries;
+ askSeries, bidSeries: TChartAskBidSeries;
+ i: Integer;
+ ohlcData: TDataSeries;
+ askBidData: TDataSeries;
+ ohlcDataPoints: array of TDataPoint;
+ askBidDataPoints: array of TDataPoint;
+ startTime: TDateTime;
+ lastClose, o, h, l, c: Double;
+ ohlcItem: TOhlcItem;
+const
+ NUM_POINTS = 50;
+begin
+ FChart := TChart.Create(Self);
+ FChart.Parent := Self;
+ FChart.Align := TAlignLayout.Client;
+
+ // 1. Create OHLC Data
+ ohlcData := TDataSeries.CreateWriteable(NUM_POINTS);
+ askBidData := TDataSeries.CreateWriteable(NUM_POINTS);
+ startTime := Now;
+ SetLength(ohlcDataPoints, NUM_POINTS);
+ SetLength(askBidDataPoints, NUM_POINTS);
+
+ lastClose := 100;
+ for i := 0 to NUM_POINTS - 1 do
+ begin
+ o := lastClose + (Random - 0.5) * 2;
+ h := o + Random * 3;
+ l := o - Random * 3;
+ c := l + Random * (h - l);
+ lastClose := c;
+
+ ohlcItem.Open := o;
+ ohlcItem.High := h;
+ ohlcItem.Low := l;
+ ohlcItem.Close := c;
+ ohlcDataPoints[i] := TDataPoint.Create(startTime + i, ohlcItem);
+
+ // Derive Ask/Bid data from OHLC close price
+ askBidDataPoints[i] :=
+ TDataPoint.Create(
+ startTime + i,
+ TAskBidItem.Create(c, c * 0.995) // Ask = Close, Bid = Close - 0.5% spread
+ );
+ end;
+ ohlcData.Add(ohlcDataPoints);
+ askBidData.Add(askBidDataPoints);
+
+ // 2. Create and add OHLC Series
+ ohlcSeries := TChartOhlcSeries.Create(FChart.Series);
+ ohlcSeries.DataSeries := ohlcData;
+
+ // 3. Create and add Ask/Bid Line Series
+ askSeries := TChartAskBidSeries.Create(FChart.Series);
+ askSeries.DataSeries := askBidData;
+ askSeries.DataSourceField := dsfAsk;
+ askSeries.Color := TAlphaColors.Blue;
+ askSeries.Thickness := 2;
+
+ bidSeries := TChartAskBidSeries.Create(FChart.Series);
+ bidSeries.DataSeries := askBidData;
+ bidSeries.DataSourceField := dsfBid;
+ bidSeries.Color := TAlphaColors.Orange;
+ bidSeries.Thickness := 2;
+end;
+
+end.
diff --git a/AuraTrader/TestModule.pas b/AuraTrader/TestModule.pas
new file mode 100644
index 0000000..8a90c82
--- /dev/null
+++ b/AuraTrader/TestModule.pas
@@ -0,0 +1,30 @@
+unit TestModule;
+
+interface
+
+uses
+ Myc.Aura.Module;
+
+type
+ TTestModule = class( TMycAuraNode, IAuraModule )
+ private
+ FId: Integer;
+ public
+ constructor Create(const AName: string; AId: Integer);
+ procedure SetupWorkspace(const Workspace: IAuraWorkspace);
+ end;
+
+implementation
+
+constructor TTestModule.Create(const AName: string; AId: Integer);
+begin
+ inherited Create(AName);
+ FId := AId;
+end;
+
+procedure TTestModule.SetupWorkspace(const Workspace: IAuraWorkspace);
+begin
+
+end;
+
+end.
diff --git a/Src/Myc.Aura.Module.pas b/Src/Myc.Aura.Module.pas
index da2e0a3..0c7935f 100644
--- a/Src/Myc.Aura.Module.pas
+++ b/Src/Myc.Aura.Module.pas
@@ -12,144 +12,144 @@ optimizations, and conducting statistical robustness analysis via Monte Carlo si
#### `IAuraObject`
Base interface for all Aura objects, providing a common `Name` property for identification.
- * `Name`: A writeable string representing the object's name.
+ * `Name`: A writeable string representing the object's name.
#### `TAuraArray`
A record providing a mutable, observable array-like collection for `IAuraObject` instances. It wraps a `TWriteable>` and offers basic array manipulation methods.
- * `Items`: A writeable array of `IAuraObject` instances.
- * `Insert(Idx: Integer; const Item: T)`: Inserts an item at a specified index.
- * `Delete(Idx: Integer)`: Deletes an item at a specified index.
- * `IndexOf(const Item: T)`: Returns the index of a given item.
+ * `Items`: A writeable array of `IAuraObject` instances.
+ * `Insert(Idx: Integer; const Item: T)`: Inserts an item at a specified index.
+ * `Delete(Idx: Integer)`: Deletes an item at a specified index.
+ * `IndexOf(const Item: T)`: Returns the index of a given item.
#### `IAuraLiveObject`
Extends `IAuraObject` for entities that are dynamically produced and actively executing operations, providing logging capabilities and a running status.
- * `Log`: A `TStrings` object for logging events and status messages.
- * `IsRunning`: Indicates whether the object is currently active.
+ * `Log`: A `TStrings` object for logging events and status messages.
+ * `IsRunning`: Indicates whether the object is currently active.
#### `IAuraNode`
Extends `IAuraObject` for objects that can be part of a hierarchical structure and can be serialized.
- * `Caption`: A human-readable representation of the object's name.
- * `Serialize(const Write: TJsonWriter)`: Serializes the object's state to a JSON writer.
+ * `Caption`: A human-readable representation of the object's name.
+ * `Serialize(const Write: TJsonWriter)`: Serializes the object's state to a JSON writer.
#### `IAuraChilds`
A generic interface for `IAuraNode`s that can have child nodes, enabling hierarchical organization within the Aura system.
- * `Items`: A `TAuraArray` containing the child nodes.
+ * `Items`: A `TAuraArray` containing the child nodes.
#### `TAuraParameterDef`
Defines the metadata for a single strategy parameter, including its name, type, and default value.
- * `Name`: The name of the parameter.
- * `ParamType`: The data type of the parameter (e.g., integer, float, string, UTC time).
- * `DefaultValue`: The default value for the parameter, stored as a `TAuraParameterValue`.
+ * `Name`: The name of the parameter.
+ * `ParamType`: The data type of the parameter (e.g., integer, float, string, UTC time).
+ * `DefaultValue`: The default value for the parameter, stored as a `TAuraParameterValue`.
#### `TAuraParameterRecordDef`
Represents a collection of `TAuraParameterDef` records, defining all parameters for a specific strategy. This is an alias for `TArray`.
#### `IAuraBot`
An interface representing an instance that executes a trading strategy with given parameters over a specified time period.
- * `PnL`: A mutable data series representing the Profit and Loss (PnL) curve of the bot's execution.
+ * `PnL`: A mutable data series representing the Profit and Loss (PnL) curve of the bot's execution.
#### `IAuraStrategy`
Defines a trading strategy, providing methods to create `IAuraBot` instances and specifying its parameter structure.
- * `CreateBot(const Parameters: TArray; StartTime, EndTime: TDateTime)`: Creates and returns an `IAuraBot` instance configured with the given parameters and time range.
- * `ParameterRecordDef`: Defines the set of parameters expected by this strategy.
+ * `CreateBot(const Parameters: TArray; StartTime, EndTime: TDateTime)`: Creates and returns an `IAuraBot` instance configured with the given parameters and time range.
+ * `ParameterRecordDef`: Defines the set of parameters expected by this strategy.
#### `TAuraTradePerformance`
A record encapsulating key performance metrics from a backtest or optimization run.
- * `PnL`: Total Profit and Loss.
- * `SharpeRatio`: Risk-adjusted return.
- * `MaxDrawdown`: Maximum peak-to-trough decline.
- * `ProfitFactor`: Ratio of gross profits to gross losses.
- * `CalmarRatio`: Annualized return divided by the maximum drawdown.
- * `WinRate`: Percentage of winning trades.
+ * `PnL`: Total Profit and Loss.
+ * `SharpeRatio`: Risk-adjusted return.
+ * `MaxDrawdown`: Maximum peak-to-trough decline.
+ * `ProfitFactor`: Ratio of gross profits to gross losses.
+ * `CalmarRatio`: Annualized return divided by the maximum drawdown.
+ * `WinRate`: Percentage of winning trades.
#### `TAuraMonteCarloResult`
Stores the results of a Monte Carlo simulation, providing a probabilistic distribution of `TAuraTradePerformance` outcomes.
- * `Percentile`: An array of `TAuraTradePerformance` records, sorted by PnL and distributed into 10% percentiles, allowing for statistical risk assessment.
+ * `Percentile`: An array of `TAuraTradePerformance` records, sorted by PnL and distributed into 10% percentiles, allowing for statistical risk assessment.
#### `IAuraTradeResult`
Represents the comprehensive outcome of a trade simulation (e.g., from a backtest or optimization), including performance metrics, trade details, and the ability to perform Monte Carlo analysis.
- * `Performance`: The `TAuraTradePerformance` metrics for this result.
- * `Trades`: A `TDataSeries` representing the PnLs of individual trades, serving as the basis for Monte Carlo simulation.
- * `CalcMonteCarloSimulation(Steps: Integer)`: Asynchronously performs a Monte Carlo simulation on the `Trades` data, returning a `TFuture` that resolves to a `TAuraMonteCarloResult`.
+ * `Performance`: The `TAuraTradePerformance` metrics for this result.
+ * `Trades`: A `TDataSeries` representing the PnLs of individual trades, serving as the basis for Monte Carlo simulation.
+ * `CalcMonteCarloSimulation(Steps: Integer)`: Asynchronously performs a Monte Carlo simulation on the `Trades` data, returning a `TFuture` that resolves to a `TAuraMonteCarloResult`.
#### `TAuraTimeRange`
A record defining a specific time window with a start and end date/time.
- * `StartTime`: The start of the time range.
- * `EndTime`: The end of the time range.
+ * `StartTime`: The start of the time range.
+ * `EndTime`: The end of the time range.
#### `IAuraBacktest`
An interface for executing a single backtest of a trading strategy.
- * `BacktestResult`: A `TFuture` that resolves to the `IAuraTradeResult` of this backtest.
- * `Bot`: The `IAuraBot` instance executing the backtest.
- * `Parameters`: The specific parameters used for this backtest.
- * `Strategy`: The `IAuraStrategy` being backtested.
- * `TimeRange`: The historical time window over which the backtest is conducted.
+ * `BacktestResult`: A `TFuture` that resolves to the `IAuraTradeResult` of this backtest.
+ * `Bot`: The `IAuraBot` instance executing the backtest.
+ * `Parameters`: The specific parameters used for this backtest.
+ * `Strategy`: The `IAuraStrategy` being backtested.
+ * `TimeRange`: The historical time window over which the backtest is conducted.
#### `IAuraParameterOptimization`
Represents a single optimization slot (window) within a Walk-Forward Optimization process. It manages the execution of multiple in-sample backtests to find optimal parameters, followed by an out-of-sample test.
- * `InSampleTests`: A mutable array of `IAuraBacktest` instances representing the backtests run during the in-sample optimization phase. New tests are added, and less optimal ones may be removed.
- * `OutOfSampleTest`: A mutable `IAuraBacktest` representing the test run with the best-fit parameters from the in-sample optimization on the subsequent out-of-sample data.
+ * `InSampleTests`: A mutable array of `IAuraBacktest` instances representing the backtests run during the in-sample optimization phase. New tests are added, and less optimal ones may be removed.
+ * `OutOfSampleTest`: A mutable `IAuraBacktest` representing the test run with the best-fit parameters from the in-sample optimization on the subsequent out-of-sample data.
#### `IAuraWalkForwardOptimizer`
Orchestrates the entire Walk-Forward Optimization (WFO) process, coordinating multiple `IAuraParameterOptimization` slots sequentially to test strategy adaptability across various market phases.
- * `OptimizationResult`: A `TFuture` that resolves to the aggregated `IAuraTradeResult` representing the combined performance of all out-of-sample tests.
- * `Slot`: An array of `IAuraParameterOptimization` instances, each representing a distinct optimization window.
+ * `OptimizationResult`: A `TFuture` that resolves to the aggregated `IAuraTradeResult` representing the combined performance of all out-of-sample tests.
+ * `Slot`: An array of `IAuraParameterOptimization` instances, each representing a distinct optimization window.
#### `IAuraParameterNode`
Represents a single configurable parameter for optimization algorithms, allowing its value to be set and observed.
- * `Value`: A mutable `TAuraParameterValue` representing the parameter's current setting.
+ * `Value`: A mutable `TAuraParameterValue` representing the parameter's current setting.
#### `IAuraParameterList`
An alias for `IAuraChilds`, providing a structured way to manage collections of `IAuraParameterNode`s.
#### `IAuraStudy`
Base interface for all types of strategy analysis studies (e.g., single backtests, parameter optimizations, WFOs).
- * `EventLog`: A `TStrings` object for logging events specific to the study.
- * `Strategy`: The `IAuraStrategy` that is the subject of the study.
+ * `EventLog`: A `TStrings` object for logging events specific to the study.
+ * `Strategy`: The `IAuraStrategy` that is the subject of the study.
#### `TAuraParameterRange`
Defines the allowed range for a strategy parameter during optimization.
- * `MinValue`: The minimum allowed value for the parameter, as a `TAuraParameterValue`.
- * `MaxValue`: The maximum allowed value for the parameter, as a `TAuraParameterValue`.
+ * `MinValue`: The minimum allowed value for the parameter, as a `TAuraParameterValue`.
+ * `MaxValue`: The maximum allowed value for the parameter, as a `TAuraParameterValue`.
#### `IAuraBacktestStudy`
A specialized `IAuraStudy` for setting up and initiating a single backtest.
- * `TimeRange`: The `TAuraTimeRange` for the backtest.
- * `Start`: Initiates and returns an `IAuraBacktest` instance.
+ * `TimeRange`: The `TAuraTimeRange` for the backtest.
+ * `Start`: Initiates and returns an `IAuraBacktest` instance.
#### `IAuraParameterOptimizationStudy`
A specialized `IAuraStudy` for configuring and initiating a parameter optimization process (e.g., using genetic algorithms) over a specific time range.
- * `Parameters`: An `IAuraChilds` collection of `IAuraParameterNode`s defining the configuration parameters for the optimization algorithm itself (e.g., max generations, population size).
- * `TimeRange`: The `TAuraTimeRange` for the optimization.
- * `Start`: Initiates and returns an `IAuraParameterOptimization` instance.
+ * `Parameters`: An `IAuraChilds` collection of `IAuraParameterNode`s defining the configuration parameters for the optimization algorithm itself (e.g., max generations, population size).
+ * `TimeRange`: The `TAuraTimeRange` for the optimization.
+ * `Start`: Initiates and returns an `IAuraParameterOptimization` instance.
#### `IAuraWFOStudy`
A specialized `IAuraStudy` for configuring and initiating a Walk-Forward Optimization process.
- * `ParameterRange[Idx: Integer]`: A writeable `TAuraParameterRange` defining the search space for each strategy parameter during the optimization phases.
- * `NumSlots`: A writeable integer indicating the number of time windows (slots) for the WFO.
- * `Start`: Initiates and returns an `IAuraWalkForwardOptimizer` instance.
+ * `ParameterRange[Idx: Integer]`: A writeable `TAuraParameterRange` defining the search space for each strategy parameter during the optimization phases.
+ * `NumSlots`: A writeable integer indicating the number of time windows (slots) for the WFO.
+ * `Start`: Initiates and returns an `IAuraWalkForwardOptimizer` instance.
#### `IAuraTradingMode`
An enumeration defining different operational modes for a trading environment.
- * `tmTesting`: Mode for historical backtesting.
- * `tmSim`: Mode for simulated live trading (paper trading).
- * `tmLive`: Mode for actual live trading.
+ * `tmTesting`: Mode for historical backtesting.
+ * `tmSim`: Mode for simulated live trading (paper trading).
+ * `tmLive`: Mode for actual live trading.
#### `IAuraWorkspace`
Represents the scope of a complete testing and trading environment, containing various studies and managing the overall trading mode.
- * `WalkForwardAnalysis`: An `IAuraChilds` collection of `IAuraWFOStudy` instances.
- * `Backtests`: An `IAuraChilds` collection of `IAuraBacktestStudy` instances.
- * `ParameterOptimizations`: An `IAuraChilds` collection of `IAuraParameterOptimizationStudy` instances.
- * `TradingMode`: A writeable `IAuraTradingMode` indicating the current operational mode.
+ * `WalkForwardAnalysis`: An `IAuraChilds` collection of `IAuraWFOStudy` instances.
+ * `Backtests`: An `IAuraChilds` collection of `IAuraBacktestStudy` instances.
+ * `ParameterOptimizations`: An `IAuraChilds` collection of `IAuraParameterOptimizationStudy` instances.
+ * `TradingMode`: A writeable `IAuraTradingMode` indicating the current operational mode.
-#### `IAuraStrategyFactory`
+#### `IAuraModule`
An interface for creating instances of `IAuraStrategy`. Used for managing available strategy types.
- * `CreateStrategy`: Creates and returns a new `IAuraStrategy` instance.
+ * `CreateStrategy`: Creates and returns a new `IAuraStrategy` instance.
#### `IAuraApplication`
The application-level singleton, serving as the root for serialization and providing access to all defined strategies and workspaces.
- * `Strategies`: An `IAuraChilds` collection of `IAuraStrategyFactory` instances.
- * `Workspaces`: An `IAuraChilds` collection of `IAuraWorkspace` instances.
+ * `Strategies`: An `IAuraChilds` collection of `IAuraModule` instances.
+ * `Workspaces`: An `IAuraChilds` collection of `IAuraWorkspace` instances.
---
*)
@@ -161,6 +161,7 @@ interface
uses
System.JSON.Writers,
System.Classes,
+ System.Generics.Collections,
Myc.Signals,
Myc.Futures,
Myc.Lazy,
@@ -179,6 +180,7 @@ type
FArray: TWriteable>;
function GetItems: TWriteable>;
public
+ class operator Initialize(out Dest: TAuraArray);
procedure Insert(Idx: Integer; const Item: T);
procedure Delete(Idx: Integer);
function IndexOf(const Item: T): Integer;
@@ -200,10 +202,28 @@ type
property Caption: string read GetCaption;
end;
- IAuraChilds = interface(IAuraNode)
- function GetItems: TAuraArray;
+ IAuraChilds = interface(IAuraNode)
+ function GetItems: TWriteable>;
+ procedure Insert(Idx: Integer; const Item: T);
+ procedure Delete(Idx: Integer);
+ function IndexOf(const Item: T): Integer;
// Nodes to add as childs in hierarchical representation
- property Items: TAuraArray read GetItems;
+ property Items: TWriteable> read GetItems;
+ end;
+
+ TAuraChilds = record
+ private
+ FChilds: IAuraChilds;
+ function GetCaption: string;
+ public
+ constructor Create(const AChilds: IAuraChilds);
+ class operator Implicit(const A: IAuraChilds): TAuraChilds; overload;
+ class operator Implicit(const A: TAuraChilds): IAuraChilds; overload;
+ procedure Serialize(const Write: TJsonWriter);
+ procedure Insert(Idx: Integer; const Item: T);
+ procedure Delete(Idx: Integer);
+ function IndexOf(const Item: T): Integer;
+ property Caption: string read GetCaption;
end;
TAuraParameterDef = record
@@ -346,57 +366,227 @@ type
property NumSlots: TWriteable read GetNumSlots;
end;
- IAuraTradingMode = (tmTesting, tmSim, tmLive);
+ TAuraTradingMode = (tmTesting, tmSim, tmLive);
// Repesents the scope of a workspace
IAuraWorkspace = interface(IAuraNode)
- function GetWalkForwardAnalysis: IAuraChilds;
- function GetBacktests: IAuraChilds;
- function GetParameterOptimizations: IAuraChilds;
- function GetTradingMode: TWriteable;
- property WalkForwardAnalysis: IAuraChilds read GetWalkForwardAnalysis;
- property Backtests: IAuraChilds read GetBacktests;
- property ParameterOptimizations: IAuraChilds read GetParameterOptimizations;
- property TradingMode: TWriteable read GetTradingMode;
+ ['{8485F7E7-F097-4CB8-8186-A6C9AE0048AF}']
+ // function GetWalkForwardAnalysis: IAuraChilds;
+ // function GetBacktests: IAuraChilds;
+ // function GetParameterOptimizations: IAuraChilds;
+ // function GetWalkForwardAnalysis: IAuraChilds;
+ // function GetBacktests: IAuraChilds;
+ // function GetParameterOptimizations: IAuraChilds;
+ // property WalkForwardAnalysis: IAuraChilds read GetWalkForwardAnalysis;
+ // property Backtests: IAuraChilds read GetBacktests;
+ // property ParameterOptimizations: IAuraChilds read GetParameterOptimizations;
+ // property WalkForwardAnalysis: IAuraChilds read GetWalkForwardAnalysis;
+ // property Backtests: IAuraChilds read GetBacktests;
+ // property ParameterOptimizations: IAuraChilds read GetParameterOptimizations;
+ function GetTradingMode: TWriteable;
+ function GetStudies: TAuraArray;
+ property TradingMode: TWriteable read GetTradingMode;
+ property Studies: TAuraArray read GetStudies;
end;
- IAuraStrategyFactory = interface(IAuraNode)
- function CreateStrategy: IAuraStrategy;
+ IAuraModule = interface
+ procedure SetupWorkspace(const Workspace: IAuraWorkspace);
end;
// Application singleton, the root for serialization
IAuraApplication = interface(IAuraNode)
- function GetStrategies: IAuraChilds;
+ function GetModuleNames: TMutable>;
+ function GetModules(const Name: String): IAuraModule;
function GetWorkspaces: IAuraChilds;
- property Strategies: IAuraChilds read GetStrategies;
+ procedure RegisterModule(const Name: String; const Module: IAuraModule);
+ property ModuleNames: TMutable> read GetModuleNames;
+ property Modules[const Name: String]: IAuraModule read GetModules;
property Workspaces: IAuraChilds read GetWorkspaces;
end;
+ ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+ // Generic implementation for a collection of child nodes.
+ TMycAuraObject = class(TInterfacedObject, IAuraObject)
+ private
+ FName: TWriteable;
+ function GetName: TWriteable;
+ procedure Serialize(const Write: TJsonWriter);
+ public
+ constructor Create(const AName: string);
+ end;
+
+ // Generic implementation for a collection of child nodes.
+ TMycAuraNode = class(TInterfacedObject, IAuraNode)
+ private
+ FName: TWriteable;
+ function GetName: TWriteable;
+ protected
+ function GetCaption: string; virtual;
+ procedure Serialize(const Write: TJsonWriter);
+ public
+ constructor Create(const AName: string);
+ end;
+
+ // Generic implementation for a collection of child nodes.
+ TMycAuraChilds = class(TInterfacedObject, IAuraChilds)
+ private
+ FName: TWriteable;
+ FItems: TWriteable>;
+ function GetCaption: string;
+ function GetItems: TWriteable>;
+ function GetName: TWriteable;
+ procedure Serialize(const Write: TJsonWriter);
+ public
+ constructor Create(const AName: string);
+ procedure Delete(Idx: Integer);
+ function IndexOf(const Item: T): Integer;
+ procedure Insert(Idx: Integer; const Item: T);
+ end;
+
+ TMycAuraWorkspace = class(TMycAuraNode, IAuraWorkspace)
+ private
+ FTradingMode: TWriteable;
+ FStudies: TAuraArray;
+ function GetStudies: TAuraArray;
+ function GetTradingMode: TWriteable;
+ protected
+ function GetCaption: string; override;
+ public
+ constructor Create(const AName: string; TradingMode: TAuraTradingMode);
+ end;
+
+ TMycAuraApplication = class(TInterfacedObject, IAuraApplication)
+ private
+ FName: TWriteable;
+ FModules: TDictionary;
+ FModulesChanged: TEvent;
+ FModuleNames: TMutable>;
+ FWorkspaces: TAuraChilds;
+ function GetCaption: string;
+ function GetName: TWriteable;
+ function GetModuleNames: TMutable>;
+ function GetModules(const Name: String): IAuraModule;
+ function GetWorkspaces: IAuraChilds;
+ procedure Serialize(const Write: TJsonWriter);
+ public
+ constructor Create;
+ procedure RegisterModule(const Name: String; const Module: IAuraModule);
+ end;
+
implementation
-uses
- System.Generics.Collections;
+{ TMycAuraObject }
+
+constructor TMycAuraObject.Create(const AName: string);
+begin
+ inherited Create;
+ FName := TWriteable.CreateWriteable;
+ FName.Value := AName;
+end;
+
+function TMycAuraObject.GetName: TWriteable;
+begin
+ Result := FName;
+end;
+
+procedure TMycAuraObject.Serialize(const Write: TJsonWriter);
+begin
+ Write.WriteStartObject;
+ Write.WritePropertyName('Name');
+ Write.WriteValue(FName.Value);
+ Write.WriteEndObject;
+end;
+
+{ TMycAuraNode }
+
+constructor TMycAuraNode.Create(const AName: string);
+begin
+ inherited Create;
+ FName := TWriteable.CreateWriteable;
+ FName.Value := AName;
+end;
+
+function TMycAuraNode.GetCaption: string;
+begin
+ Result := FName.Value;
+end;
+
+function TMycAuraNode.GetName: TWriteable;
+begin
+ Result := FName;
+end;
+
+procedure TMycAuraNode.Serialize(const Write: TJsonWriter);
+begin
+ Write.WriteStartObject;
+ inherited;
+ Write.WriteEndObject;
+end;
+
+{ TAuraArray }
+
+class operator TAuraArray.Initialize(out Dest: TAuraArray);
+begin
+ Dest.FArray := TWriteable>.CreateWriteable;
+end;
procedure TAuraArray.Delete(Idx: Integer);
+var
+ oldArray: TArray;
+ newArray: TArray;
+ oldCount: Integer;
begin
- if Idx < 0 then
+ oldArray := FArray.Value;
+ oldCount := Length(oldArray);
+
+ if (Idx < 0) or (Idx >= oldCount) then
exit;
- var Arr: TArray;
- SetLength(Arr, Length(FArray.Value) - 1);
- TArray.Copy(FArray.Value, Arr, 0, 0, Idx - 1);
- TArray.Copy(FArray.Value, Arr, Idx + 1, Idx, High(Arr) - Idx);
- FArray.Value := Arr;
+ SetLength(newArray, oldCount - 1);
+
+ // Copy elements before the index
+ if Idx > 0 then
+ TArray.Copy(oldArray, newArray, 0, 0, Idx);
+
+ // Copy elements after the index
+ if Idx < oldCount - 1 then
+ TArray.Copy(oldArray, newArray, Idx + 1, Idx, oldCount - Idx - 1);
+
+ FArray.Value := newArray;
end;
procedure TAuraArray.Insert(Idx: Integer; const Item: T);
+var
+ oldArray: TArray;
+ newArray: TArray;
+ oldCount: Integer;
begin
- var Arr: TArray;
- SetLength(Arr, Length(FArray.Value) + 1);
- TArray.Copy(FArray.Value, Arr, 0, 0, Idx - 1);
- Arr[Idx] := Item;
- TArray.Copy(FArray.Value, Arr, Idx, Idx + 1, High(Arr) - Idx);
- FArray.Value := Arr;
+ oldArray := FArray.Value;
+ if not Assigned(oldArray) then
+ SetLength(oldArray, 0);
+ oldCount := Length(oldArray);
+
+ if Idx < 0 then
+ Idx := 0;
+ if Idx > oldCount then
+ Idx := oldCount;
+
+ SetLength(newArray, oldCount + 1);
+
+ // Copy elements before the index
+ if Idx > 0 then
+ TArray.Copy(oldArray, newArray, 0, 0, Idx);
+
+ newArray[Idx] := Item;
+
+ // Copy elements after the index
+ if Idx < oldCount then
+ TArray.Copy(oldArray, newArray, Idx, Idx + 1, oldCount - Idx);
+
+ FArray.Value := newArray;
end;
function TAuraArray.GetItems: TWriteable>;
@@ -409,4 +599,232 @@ begin
Result := TArray.IndexOf(FArray.Value, Item);
end;
+{ TMycAuraChilds }
+
+constructor TMycAuraChilds.Create(const AName: string);
+begin
+ inherited Create;
+ FName := TWriteable.CreateWriteable(AName);
+ FItems := TWriteable>.CreateWriteable;
+end;
+
+procedure TMycAuraChilds.Delete(Idx: Integer);
+var
+ oldArray: TArray;
+ newArray: TArray;
+ oldCount: Integer;
+begin
+ oldArray := FItems.Value;
+ oldCount := Length(oldArray);
+
+ if (Idx < 0) or (Idx >= oldCount) then
+ exit;
+
+ SetLength(newArray, oldCount - 1);
+
+ // Copy elements before the index
+ if Idx > 0 then
+ TArray.Copy(oldArray, newArray, 0, 0, Idx);
+
+ // Copy elements after the index
+ if Idx < oldCount - 1 then
+ TArray.Copy(oldArray, newArray, Idx + 1, Idx, oldCount - Idx - 1);
+
+ FItems.Value := newArray;
+end;
+
+function TMycAuraChilds.GetCaption: string;
+begin
+ Result := FName.Value;
+end;
+
+function TMycAuraChilds.GetItems: TWriteable>;
+begin
+ Result := FItems;
+end;
+
+function TMycAuraChilds.GetName: TWriteable;
+begin
+ Result := FName;
+end;
+
+function TMycAuraChilds.IndexOf(const Item: T): Integer;
+begin
+ Result := TArray.IndexOf(FItems.Value, Item);
+end;
+
+procedure TMycAuraChilds.Insert(Idx: Integer; const Item: T);
+var
+ oldArray: TArray;
+ newArray: TArray;
+ oldCount: Integer;
+begin
+ oldArray := FItems.Value;
+ if not Assigned(oldArray) then
+ SetLength(oldArray, 0);
+ oldCount := Length(oldArray);
+
+ if Idx < 0 then
+ Idx := 0;
+ if Idx > oldCount then
+ Idx := oldCount;
+
+ SetLength(newArray, oldCount + 1);
+
+ // Copy elements before the index
+ if Idx > 0 then
+ TArray.Copy(oldArray, newArray, 0, 0, Idx);
+
+ newArray[Idx] := Item;
+
+ // Copy elements after the index
+ if Idx < oldCount then
+ TArray.Copy(oldArray, newArray, Idx, Idx + 1, oldCount - Idx);
+
+ FItems.Value := newArray;
+end;
+
+procedure TMycAuraChilds.Serialize(const Write: TJsonWriter);
+var
+ Item: T;
+ arr: TArray;
+begin
+ Write.WriteStartObject;
+ inherited;
+ Write.WritePropertyName('Items');
+ Write.WriteStartArray;
+ arr := FItems.Value;
+ for Item in arr do
+ Item.Serialize(Write);
+ Write.WriteEndArray;
+ Write.WriteEndObject;
+end;
+
+{ TMycAuraApplication }
+
+constructor TMycAuraApplication.Create;
+begin
+ inherited Create;
+ FName := TWriteable.CreateWriteable('Application');
+ FModules := TDictionary.Create;
+ FModulesChanged := TEvent.CreateEvent;
+ FModuleNames :=
+ TMutable>.Construct(FModulesChanged.Signal, function: TArray begin Result := FModules.Keys.ToArray; end);
+ FWorkspaces := TMycAuraChilds.Create('Workspaces');
+end;
+
+function TMycAuraApplication.GetCaption: string;
+begin
+ Result := FName.Value;
+end;
+
+function TMycAuraApplication.GetName: TWriteable;
+begin
+ Result := FName;
+end;
+
+function TMycAuraApplication.GetModuleNames: TMutable>;
+begin
+ Result := FModuleNames;
+end;
+
+function TMycAuraApplication.GetModules(const Name: String): IAuraModule;
+begin
+ if not FModules.TryGetValue(Name, Result) then
+ Result := nil;
+end;
+
+function TMycAuraApplication.GetWorkspaces: IAuraChilds;
+begin
+ Result := FWorkspaces;
+end;
+
+procedure TMycAuraApplication.RegisterModule(const Name: String; const Module: IAuraModule);
+begin
+ FModules.Add(Name, Module);
+ FModulesChanged.Notify;
+end;
+
+procedure TMycAuraApplication.Serialize(const Write: TJsonWriter);
+begin
+ Write.WriteStartObject;
+ Write.WritePropertyName('Name');
+ Write.WriteValue(FName.Value);
+ Write.WritePropertyName('Workspaces');
+ FWorkspaces.Serialize(Write);
+ Write.WriteEndObject;
+end;
+
+function CreateAuraApplication: IAuraApplication;
+begin
+ Result := TMycAuraApplication.Create;
+end;
+
+constructor TMycAuraWorkspace.Create(const AName: string; TradingMode: TAuraTradingMode);
+begin
+ inherited Create(AName);
+ FTradingMode := TWriteable.CreateWriteable(TradingMode);
+end;
+
+function TMycAuraWorkspace.GetCaption: string;
+begin
+ var mode := '';
+ case FTradingMode.Value of
+ tmTesting: mode := ' (Test)';
+ tmSim: mode := ' (Sim)';
+ tmLive: mode := ' (Live)';
+ end;
+ Result := inherited GetCaption + mode;
+end;
+
+function TMycAuraWorkspace.GetStudies: TAuraArray;
+begin
+ Result := FStudies;
+end;
+
+function TMycAuraWorkspace.GetTradingMode: TWriteable;
+begin
+ Result := FTradingMode;
+end;
+
+constructor TAuraChilds.Create(const AChilds: IAuraChilds);
+begin
+ FChilds := AChilds;
+end;
+
+procedure TAuraChilds.Delete(Idx: Integer);
+begin
+ FChilds.Delete(Idx);
+end;
+
+function TAuraChilds.GetCaption: string;
+begin
+ Result := FChilds.Caption;
+end;
+
+function TAuraChilds.IndexOf(const Item: T): Integer;
+begin
+ Result := FChilds.IndexOf(Item);
+end;
+
+procedure TAuraChilds.Insert(Idx: Integer; const Item: T);
+begin
+ FChilds.Insert(Idx, Item);
+end;
+
+procedure TAuraChilds.Serialize(const Write: TJsonWriter);
+begin
+ FChilds.Serialize(Write);
+end;
+
+class operator TAuraChilds.Implicit(const A: IAuraChilds): TAuraChilds;
+begin
+ Result.Create(A);
+end;
+
+class operator TAuraChilds.Implicit(const A: TAuraChilds): IAuraChilds;
+begin
+ Result := A.FChilds;
+end;
+
end.
diff --git a/Src/Myc.Core.Notifier.pas b/Src/Myc.Core.Notifier.pas
index 5d5e001..99b4eb9 100644
--- a/Src/Myc.Core.Notifier.pas
+++ b/Src/Myc.Core.Notifier.pas
@@ -208,6 +208,7 @@ begin
exit;
Item := PItem(Tag);
+ Item.Receiver := nil;
if Item = FList then
FList := Item.Next;
@@ -217,8 +218,6 @@ begin
if Item.Next <> nil then
Item.Next.Prev := Item.Prev;
- Item.Receiver := nil;
-
FreeItem(Item);
end;
diff --git a/Src/Myc.Lazy.pas b/Src/Myc.Lazy.pas
index b7faefe..835814b 100644
--- a/Src/Myc.Lazy.pas
+++ b/Src/Myc.Lazy.pas
@@ -63,6 +63,7 @@ type
class operator Implicit(const A: TWriteable): IWriteable; overload;
class function CreateWriteable: TWriteable; overload; static;
+ class function CreateWriteable(const Init: T): TWriteable; overload; static;
function Protect: TWriteable;
@@ -212,7 +213,12 @@ end;
class function TWriteable.CreateWriteable: TWriteable;
begin
- Result := TMycWriteableMutable.Create(Default(T));
+ Result := CreateWriteable(Default(T));
+end;
+
+class function TWriteable.CreateWriteable(const Init: T): TWriteable;
+begin
+ Result := TMycWriteableMutable.Create(Init);
end;
function TWriteable.GetChanged: TSignal;
diff --git a/Src/Myc.Signals.FMX.pas b/Src/Myc.Signals.FMX.pas
index f770161..8663628 100644
--- a/Src/Myc.Signals.FMX.pas
+++ b/Src/Myc.Signals.FMX.pas
@@ -5,145 +5,214 @@ interface
uses
System.Classes,
System.SysUtils,
- System.Generics.Collections,
- System.Diagnostics,
- System.Messaging,
Myc.Signals;
type
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;
- 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
- procedure ProcessSignal(const Signal: TSignal; const Proc: TMsgProc); overload;
- procedure ProcessSignal(const Signal: TSignal; const Proc: TProc); overload;
+ function ProcessSignal(const Signal: TSignal; const Proc: TMsgProc): TComponent; overload;
+ function ProcessSignal(const Signal: TSignal; const Proc: TProc): TComponent; overload;
+ end;
+
+ TSignalSyncHelper = record helper for TSignal
+ function Queue(const Proc: TProc; Delay: Integer = 0): TSignal.TSubscription; overload;
+ function Queue(Thread: TThread; const Proc: TProc; Delay: Integer = 0): TSignal.TSubscription; overload;
end;
implementation
uses
+ System.Diagnostics,
+ System.Messaging,
FMX.Types;
-{ TSignalComponentHelper.TSignalSubscription }
+type
+ TSignalSubscriber = class(TComponent, TSignal.ISubscriber)
+ private
+ FSignal: TSignal;
+ FSigSubscr: TSignal.TSubscription;
+ FProc: TSignalComponentHelper.TMsgProc;
+ FNotified: Integer;
+ FIdleSubscrId: TMessageSubscriptionId;
+ FNext, FPrev: TSignalSubscriber;
+ class var
+ FQueued: Integer;
+ FCount: Integer;
+ FFirst: TSignalSubscriber;
+ FCurr: TSignalSubscriber;
+ class procedure HandleSignals(Timeout: Int64);
+ public
+ constructor Create(AOwner: TComponent; const ASignal: TSignal; const AProc: TSignalComponentHelper.TMsgProc); reintroduce;
+ destructor Destroy; override;
+ procedure AfterConstruction; override;
+ procedure BeforeDestruction; override;
+ function Notify: Boolean;
+ end;
-constructor TSignalComponentHelper.TSignalSubscription.Create(AOwner: TComponent; const ASignal: TSignal; const AProc: TMsgProc);
+ TSyncSubscriber = class(TInterfacedObject, TSignal.ISubscriber)
+ Thread: TThread;
+ Delay: Integer;
+ Timestamp: Int64;
+ Proc: TProc;
+ class var
+ Timer: TStopwatch;
+ function Notify: Boolean;
+ class constructor CreateClass;
+ end;
+
+class constructor TSyncSubscriber.CreateClass;
+begin
+ Timer := TStopwatch.StartNew;
+end;
+
+function TSyncSubscriber.Notify: Boolean;
+begin
+ if Assigned(Proc) then
+ begin
+ var cProc := Proc;
+ Proc := nil;
+ TThread.ForceQueue(Thread, procedure begin cProc() end, Delay - (Timer.ElapsedMilliseconds - Timestamp));
+ end;
+ Result := false;
+end;
+
+{ TSignalSubscription }
+
+constructor TSignalSubscriber.Create(AOwner: TComponent; const ASignal: TSignal; const AProc: TSignalComponentHelper.TMsgProc);
begin
inherited Create(AOwner);
FSignal := ASignal;
FProc := AProc;
- FIdx := 0;
- if FItems = nil then
+ if FFirst = nil then
begin
- FItems := TList.Create;
FIdleSubscrId :=
TMessageManager
.DefaultManager
.SubscribeToMessage(TIdleMessage, procedure(const Sender: TObject; const M: TMessage) begin HandleSignals(50); end);
end;
- FItems.Add(Self);
+
+ FPrev := nil;
+ if FFirst <> nil then
+ FNext := FFirst;
+ if FNext <> nil then
+ FNext.FPrev := Self;
+ FFirst := Self;
FSigSubscr := FSignal.Subscribe(Self);
end;
-destructor TSignalComponentHelper.TSignalSubscription.Destroy;
+destructor TSignalSubscriber.Destroy;
begin
FSigSubscr.Unsubscribe;
- FItems.Remove(Self);
- if FItems.Count = 0 then
+ if FFirst = Self then
+ FFirst := FNext;
+ if FNext <> nil then
+ FNext.FPrev := FPrev;
+ if FPrev <> nil then
+ FPrev.FNext := FNext;
+
+ if FFirst = nil then
begin
TMessageManager.DefaultManager.Unsubscribe(TIdleMessage, FIdleSubscrId);
- FreeAndNil(FItems);
end;
inherited;
end;
-class procedure TSignalComponentHelper.TSignalSubscription.HandleSignals(Timeout: Int64);
+procedure TSignalSubscriber.AfterConstruction;
+begin
+ inherited;
+ Notify;
+end;
+
+procedure TSignalSubscriber.BeforeDestruction;
+begin
+ FSigSubscr.Unsubscribe;
+ if FCurr = Self then
+ FCurr := FCurr.FNext;
+ inherited;
+end;
+
+class procedure TSignalSubscriber.HandleSignals(Timeout: Int64);
begin
if AtomicExchange(FQueued, 0) = 0 then
exit;
var Stopwatch := TStopwatch.StartNew;
+ var doBreak := false;
- if (FIdx = 0) or (FIdx > FItems.Count) then
- FIdx := FItems.Count;
+ if FCurr = nil then
+ FCurr := FFirst;
- while FIdx > 0 do
+ while FCurr <> nil do
begin
- dec(FIdx);
- var sub := FItems[FIdx];
+ var sub := FCurr;
+ FCurr := sub.FNext;
if AtomicExchange(sub.FNotified, 0) = 1 then
begin
- var done := false;
- try
- sub.FProc(done);
- finally
- if done then
- sub.Free;
+ if not (csDestroying in sub.ComponentState) then
+ begin
+ var done := false;
+ try
+ sub.FProc(done);
+ finally
+ if done then
+ sub.Free;
+ end;
end;
- if AtomicDecrement(FCount) = 1 then
- break;
+ doBreak := AtomicDecrement(FCount) = 1;
end;
- if Stopwatch.ElapsedMilliseconds > Timeout then
+ doBreak := doBreak or (Stopwatch.ElapsedMilliseconds > Timeout);
+
+ if doBreak then
begin
AtomicExchange(FQueued, 1);
break;
end;
-
- if FIdx = 0 then
- FIdx := FItems.Count;
end;
end;
-function TSignalComponentHelper.TSignalSubscription.Notify: Boolean;
+function TSignalSubscriber.Notify: Boolean;
begin
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 TSignalComponentHelper.ProcessSignal(const Signal: TSignal; const Proc: TProc);
+function TSignalComponentHelper.ProcessSignal(const Signal: TSignal; const Proc: TProc): TComponent;
begin
var cProc: TProc := Proc;
- TSignalSubscription.Create(Self, Signal, procedure(out IsDone: Boolean) begin cProc(); end);
+ Result := ProcessSignal(Signal, procedure(out IsDone: Boolean) begin cProc(); end);
end;
-procedure TSignalComponentHelper.ProcessSignal(const Signal: TSignal; const Proc: TMsgProc);
+function TSignalComponentHelper.ProcessSignal(const Signal: TSignal; const Proc: TMsgProc): TComponent;
begin
- TSignalSubscription.Create(Self, Signal, Proc);
+ Result := TSignalSubscriber.Create(Self, Signal, Proc);
+end;
+
+{ TSignalSyncHelper }
+
+function TSignalSyncHelper.Queue(const Proc: TProc; Delay: Integer = 0): TSignal.TSubscription;
+begin
+ Result := Queue(nil, Proc, Delay);
+end;
+
+function TSignalSyncHelper.Queue(Thread: TThread; const Proc: TProc; Delay: Integer = 0): TSignal.TSubscription;
+begin
+ var Subscr := TSyncSubscriber.Create;
+ Subscr.Thread := Thread;
+ Subscr.Proc := Proc;
+ Subscr.Delay := Delay;
+ Subscr.Timestamp := TSyncSubscriber.Timer.ElapsedMilliseconds;
+ Result := Subscribe(Subscr);
end;
end.