MycLib/Src/Myc.Fmx.Chart.Series.pas

unit Myc.Fmx.Chart.Series;

interface

uses
    System.SysUtils,
    System.UITypes,
    FMX.Graphics,
    Myc.Signals,
    Myc.Mutable,
    Myc.Trade.Types,
    Myc.Trade.DataArray,
    Myc.Trade.DataPoint,
    Myc.Trade.DataConverter,
    Myc.Trade.Core.DataConverter,
    Myc.Fmx.Chart;

type
    TChartSeriesReceiver<T> = class(TMycProcessor<T>)
    strict private
        FCurrData: TMycDataArray<T>;
        FLookback: TMutable<Int64>;
    private
        FData: TWriteable<TMycDataArray<T>>;
    protected
        function ProcessData(const Value: T): TState; override;
    public
        constructor Create(const ALookback: TMutable<Int64>);
        property Data: TWriteable<TMycDataArray<T>> read FData;
    end;

    TChartSeriesProcessor<T> = class(TMycChart.TSeries)
    strict private
        FDataSeries: TMycDataArray<T>;
    private
        FData: TMycDataArray<T>;
        FDataProvider: TDataProvider<T>;
        FReceiver: TChartSeriesReceiver<T>;
        FReceiverTag: TDataProvider<T>.TTag;
    protected
        function GetCount: Int64; override;
        function GetTotalCount: Int64; override;
        procedure Update;

    public
        constructor Create(const ADataProvider: TDataProvider<T>; const ALookback: TMutable<Int64>);
        destructor Destroy; override;
        property Data: TMycDataArray<T> read FData;
    end;

    { TChartCustomLayer }
    TChartCustomLayer<T> = class abstract(TMycChart.TDataLayer)
    private
        FSeries: TChartSeriesProcessor<T>;
    protected
        function GetSeries: TMycChart.TSeries; override;
        function GetValueRange(First, Last: Int64; out MinValue, MaxValue: Double): Boolean; override; abstract;
        procedure Update; override;
        procedure Paint(
            const Canvas: TCanvas;
            First, Last: Int64;
            const XForm: TFunc<Int64, Single>;
            const YForm: TFunc<Double, Single>
        ); override; abstract;
    public
        constructor Create(AParent: TMycChart.TPanel; const ADataProvider: TDataProvider<T>);
        destructor Destroy; override;
    end;

    { TChartOhlcLayer }
    TChartOhlcLayer = class(TChartCustomLayer<TOhlcItem>)
    private
        FUpColor: TMutable<TAlphaColor>;
        FDownColor: TMutable<TAlphaColor>;
    protected
        function GetValueRange(First, Last: Int64; out MinValue, MaxValue: Double): Boolean; override;
        procedure Paint(
            const Canvas: TCanvas;
            First, Last: Int64;
            const XForm: TFunc<Int64, Single>;
            const YForm: TFunc<Double, Single>
        ); override;
    public
        constructor Create(
            AParent: TMycChart.TPanel;
            const ADataProvider: TDataProvider<TOhlcItem>;
            const AUpColor, ADownColor: TMutable<TAlphaColor>
        );
    end;

    { TChartLineLayer }
    TChartLineLayer = class(TChartCustomLayer<Double>)
    private
        FLineColor: TAlphaColor;
        FLineWidth: Single;
    protected
        function GetValueRange(First, Last: Int64; out MinValue, MaxValue: Double): Boolean; override;
        procedure Paint(
            const Canvas: TCanvas;
            First, Last: Int64;
            const XForm: TFunc<Int64, Single>;
            const YForm: TFunc<Double, Single>
        ); override;
    public
        constructor Create(
            AParent: TMycChart.TPanel;
            const ADataProvider: TDataProvider<Double>;
            const ALineColor: TAlphaColor;
            ALineWidth: Single
        );
    end;

    { TChartXAxisLayer }
    TChartXAxisLayer<T> = class(TMycChart.TXAxisLayer)
    private
        FSeries: TChartSeriesProcessor<T>;
    protected
        function GetSeries: TMycChart.TSeries; override;
        procedure Update; override;
        function GetCaption(Idx: Int64): String; override; abstract;
    public
        constructor Create(AOwner: TMycChart; const ADataProvider: TDataProvider<T>);
        destructor Destroy; override;
    end;

    { TChartXAxisTimestampLayer }
    TChartXAxisTimestampLayer = class(TChartXAxisLayer<TDateTime>)
    private
        FTimeframe: TTimeframe;
    protected
        // Provide a formatted timestamp string for a given data index.
        function GetCaption(Idx: Int64): String; override; final;
    public
        constructor Create(AOwner: TMycChart; ATimeframe: TTimeframe; const ADataProvider: TDataProvider<TDateTime>);
    end;

implementation

uses
    System.Types,
    System.Math,
    FMX.Types;

{ TChartSeriesReceiver<T> }

constructor TChartSeriesReceiver<T>.Create(const ALookback: TMutable<Int64>);
begin
    inherited Create;
    FLookback := ALookback;
    FCurrData := TMycDataArray<T>.CreateEmpty;
    FData := TWriteable<TMycDataArray<T>>.CreateWriteable(FCurrData).Protect;
end;

function TChartSeriesReceiver<T>.ProcessData(const Value: T): TState;
begin
    Result := TState.Null;
    FCurrData := FCurrData.Add(Value, FLookback.Value);
    FData.Value := FCurrData;
end;

{ TChartSeriesProcessor<T> }

constructor TChartSeriesProcessor<T>.Create(const ADataProvider: TDataProvider<T>; const ALookback: TMutable<Int64>);
begin
    inherited Create;
    FDataProvider := ADataProvider;
    FDataSeries := TMycDataArray<T>.CreateEmpty;
    FData := FDataSeries;

    FReceiver := TChartSeriesReceiver<T>.Create(ALookback);
    FReceiverTag := FDataProvider.Link(FReceiver);
end;

destructor TChartSeriesProcessor<T>.Destroy;
begin
    FDataProvider.Unlink(FReceiverTag);
    inherited;
end;

function TChartSeriesProcessor<T>.GetCount: Int64;
begin
    Result := FData.Count;
end;

function TChartSeriesProcessor<T>.GetTotalCount: Int64;
begin
    Result := FData.TotalCount;
end;

procedure TChartSeriesProcessor<T>.Update;
begin
    FData := FReceiver.Data.Value;
end;

{ TChartLineLayer }

constructor TChartLineLayer.Create(
    AParent: TMycChart.TPanel;
    const ADataProvider: TDataProvider<Double>;
    const ALineColor: TAlphaColor;
    ALineWidth: Single
);
begin
    inherited Create(AParent, ADataProvider);
    FLineColor := ALineColor;
    FLineWidth := ALineWidth;
end;

function TChartLineLayer.GetValueRange(First, Last: Int64; out MinValue, MaxValue: Double): Boolean;
var
    i: Int64;
begin
    MinValue := MaxDouble;
    MaxValue := -MaxDouble;
    for i := First to Last do
    begin
        var v := FSeries.Data.Items[i];
        if not IsNaN(v) then
        begin
            MinValue := Min(MinValue, v);
            MaxValue := Max(MaxValue, v);
        end;
    end;
    Result := (MinValue < MaxValue);
end;

procedure TChartLineLayer.Paint(
    const Canvas: TCanvas;
    First, Last: Int64;
    const XForm: TFunc<Int64, Single>;
    const YForm: TFunc<Double, Single>
);
var
    points: TPathData;
    n: Int64;
begin
    points := TPathData.Create;
    try
        n := First;
        while n < Last do
        begin
            // Skip warmup/gap data
            while (n <= Last) and (IsNaN(FSeries.Data[n])) do
                inc(n);

            if n < Last then
            begin
                points.MoveTo(TPointF.Create(XForm(n), YForm(FSeries.Data[n])));
                inc(n);
                while n <= Last do
                begin
                    if IsNaN(FSeries.Data[n]) then
                        break;
                    points.LineTo(TPointF.Create(XForm(n), YForm(FSeries.Data[n])));
                    inc(n);
                end;
            end;
        end;

        Canvas.Stroke.Color := FLineColor;
        Canvas.Stroke.Thickness := FLineWidth;
        Canvas.Stroke.Join := TStrokeJoin.Bevel;
        Canvas.DrawPath(points, 1);
    finally
        points.Free;
    end;
end;

{ TChartOhlcLayer }

constructor TChartOhlcLayer.Create(
    AParent: TMycChart.TPanel;
    const ADataProvider: TDataProvider<TOhlcItem>;
    const AUpColor, ADownColor: TMutable<TAlphaColor>
);
begin
    inherited Create(AParent, ADataProvider);
    FUpColor := AUpColor;
    FDownColor := ADownColor;

    FUpColor.Changed.Subscribe(Owner.NeedRepaint);
    FDownColor.Changed.Subscribe(Owner.NeedRepaint);
end;

function TChartOhlcLayer.GetValueRange(First, Last: Int64; out MinValue, MaxValue: Double): Boolean;
var
    i: Int64;
begin
    MinValue := MaxDouble;
    MaxValue := -MaxDouble;

    for i := First to Last do
    begin
        var item := FSeries.Data.Items[i];
        MinValue := Min(MinValue, item.Low);
        MaxValue := Max(MaxValue, item.High);
    end;
    Result := (MinValue <> MaxDouble);
end;

procedure TChartOhlcLayer.Paint(
    const Canvas: TCanvas;
    First, Last: Int64;
    const XForm: TFunc<Int64, Single>;
    const YForm: TFunc<Double, Single>
);
var
    i: Int64;
    x, candleWidth: Single;
    yOpen, yHigh, yLow, yClose: Single;
    item: TOhlcItem;
    isUp: boolean;
begin
    candleWidth := Max(2, 0.8 * Abs((XForm(First + 1) - XForm(First))));

    for i := First to Last do
    begin
        item := FSeries.Data.Items[i];
        x := XForm(i);
        yOpen := YForm(item.Open);
        yClose := YForm(item.Close);
        yHigh := YForm(item.High);
        yLow := YForm(item.Low);
        isUp := item.Close >= item.Open;

        if isUp then
            Canvas.Stroke.Color := FUpColor.Value
        else
            Canvas.Stroke.Color := FDownColor.Value;
        Canvas.Stroke.Thickness := 1.0;

        Canvas.DrawLine(TPointF.Create(x, yHigh), TPointF.Create(x, yLow), 1);

        Canvas.Fill.Color := Canvas.Stroke.Color;
        if isUp then
            Canvas.FillRect(TRectF.Create(x - candleWidth / 2, yClose, x + candleWidth / 2, yOpen), 0, 0, AllCorners, 1)
        else
            Canvas.FillRect(TRectF.Create(x - candleWidth / 2, yOpen, x + candleWidth / 2, yClose), 0, 0, AllCorners, 1);
    end;
end;

{ TChartCustomLayer }

constructor TChartCustomLayer<T>.Create(AParent: TMycChart.TPanel; const ADataProvider: TDataProvider<T>);
begin
    inherited Create(AParent);
    FSeries := TChartSeriesProcessor<T>.Create(ADataProvider, AParent.Owner.Lookback.AsMutable);
end;

destructor TChartCustomLayer<T>.Destroy;
begin
    FSeries.Free;
    inherited;
end;

function TChartCustomLayer<T>.GetSeries: TMycChart.TSeries;
begin
    Result := FSeries;
end;

procedure TChartCustomLayer<T>.Update;
begin
    FSeries.Update;
end;

{ TChartXAxisLayer }

constructor TChartXAxisLayer<T>.Create(AOwner: TMycChart; const ADataProvider: TDataProvider<T>);
begin
    inherited Create(AOwner);
    FSeries := TChartSeriesProcessor<T>.Create(ADataProvider, AOwner.Lookback.AsMutable);
end;

destructor TChartXAxisLayer<T>.Destroy;
begin
    FSeries.Free;
    inherited;
end;

function TChartXAxisLayer<T>.GetSeries: TMycChart.TSeries;
begin
    Result := FSeries;
end;

procedure TChartXAxisLayer<T>.Update;
begin
    FSeries.Update;
end;

constructor TChartXAxisTimestampLayer.Create(AOwner: TMycChart; ATimeframe: TTimeframe; const ADataProvider: TDataProvider<TDateTime>);
begin
    inherited Create(AOwner, ADataProvider);
    FTimeframe := ATimeframe;
end;

function TChartXAxisTimestampLayer.GetCaption(Idx: Int64): String;
var
    dt: TDateTime;
    formatStr: string;
begin
    Result := '';
    if (Idx >= 0) and (Idx < FSeries.Count) then
    begin
        dt := FSeries.Data[Idx];

        // Choose format based on the series timeframe.
        if FTimeframe >= D then // Daily, Weekly, Monthly, Yearly
            formatStr := 'dd.mm.yyyy'
        else if FTimeframe >= M then // Hourly + Minutes
            formatStr := 'dd.mm.yyyy hh:nn'
        else // Seconds
            formatStr := 'dd.mm.yyyy hh:nn:ss';

        Result := FormatDateTime(formatStr, dt);
    end;
end;

end.