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

unit Myc.FMX.Chart.Series;

interface

uses
    System.SysUtils,
    System.SyncObjs,
    System.UITypes,
    FMX.Graphics,
    Myc.Signals,
    Myc.Lazy,
    Myc.Trade.Types,
    Myc.Trade.DataArray,
    Myc.Trade.DataPoint,
    Myc.Fmx.Chart;

type
    TChartSeriesCounter<T> = class(TMycConverter<T, Int64>)
    private
        FCount: Int64;
    protected
        function ProcessData(const Value: T): TState; override;
    public
        constructor Create;
    end;

    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>;
        FLock: TSpinLock;
    private
        FData: TMycDataArray<T>;
        FDataProvider: IMycDataProvider<T>;
        FReceiver: TChartSeriesReceiver<T>;
        FReceiverTag: TTag;
    protected
        function GetCount: Int64; override;
        function GetTotalCount: Int64; override;
        procedure Update;

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

    { TChartCustomLayer }
    TChartCustomLayer<T> = class(TMycChart.TLayer)
    private
        FSeries: TChartSeriesProcessor<T>;
    protected
        function GetSeries: TMycChart.TSeries; override;
        function GetValueRange(First, Last: Int64; out MinValue, MaxValue: Double): Boolean; override;
        procedure Update; override;
        procedure Paint(const Canvas: TCanvas; First, Last: Int64; const XForm, YForm: TFunc<Double, Single>); override;
    public
        constructor Create(AParent: TMycChart.TPanel; const ADataProvider: IMycDataProvider<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, YForm: TFunc<Double, Single>); override;
    public
        constructor Create(
            AParent: TMycChart.TPanel;
            const ADataProvider: IMycDataProvider<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, YForm: TFunc<Double, Single>); override;
    public
        constructor Create(
            AParent: TMycChart.TPanel;
            const ADataProvider: IMycDataProvider<Double>;
            const ALineColor: TAlphaColor;
            ALineWidth: Single
        );
    end;

implementation

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

constructor TChartSeriesCounter<T>.Create;
begin
    inherited Create;
    FCount := 0;
end;

function TChartSeriesCounter<T>.ProcessData(const Value: T): TState;
begin
    Result := Broadcast(FCount);
    inc(FCount);
end;

{ 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: IMycDataProvider<T>; const ALookback: TMutable<Int64>);
begin
    inherited Create;
    FDataProvider := ADataProvider;
    FLock := TSpinLock.Create(false);
    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: IMycDataProvider<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 <> MaxDouble);
end;

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

        points.MoveTo(TPointF.Create(XForm(n), YForm(FSeries.Data[n])));
        for i := n + 1 to Last do
            if not IsNaN(FSeries.Data[i]) then
                points.LineTo(TPointF.Create(XForm(i), YForm(FSeries.Data[i])));

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

{ TChartOhlcLayer }

constructor TChartOhlcLayer.Create(
    AParent: TMycChart.TPanel;
    const ADataProvider: IMycDataProvider<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, 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: IMycDataProvider<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;

function TChartCustomLayer<T>.GetValueRange(First, Last: Int64; out MinValue, MaxValue: Double): Boolean;
begin
    Result := false;
end;

procedure TChartCustomLayer<T>.Paint(const Canvas: TCanvas; First, Last: Int64; const XForm, YForm: TFunc<Double, Single>);
begin
    // nope
end;

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

end.