unit Myc.Fmx.Chart;

interface

uses
    System.SysUtils,
    System.Classes,
    System.Types,
    System.Generics.Collections,
    System.UITypes,
    System.UIConsts,
    System.Messaging,
    System.Math.Vectors,
    FMX.Types,
    FMX.Controls,
    FMX.Graphics,
    Myc.Trade.DataPoint,
    Myc.Signals;

type
    TCandleStyle = (csCandleStick, csHiLoBar);

    TMycChart = class(TStyledControl)
        type
            TSeries = class abstract(TContainedObject)
            private
                function GetMainSeries: TSeries;
                function GetOwner: TMycChart;
            protected
                function GetCount: Int64; virtual; abstract;
                function GetValueRange(StartIndex, Count: Int64; out Min, Max: Double): Boolean; virtual; abstract;
                function Update: Boolean; virtual; abstract;
                procedure Paint(const ACanvas: TCanvas; const AXForm, AYForm: TFunc<Double, Single>); virtual; abstract;

            public
                constructor Create(AOwner: TMycChart);
                property Count: Int64 read GetCount;
                property MainSeries: TSeries read GetMainSeries;
                property Owner: TMycChart read GetOwner;
            end;

    private
        FSeriesList: TList<TSeries>;
        FLookback: Integer;
        FIdleSubscrId: TMessageSubscriptionId;
    protected
        procedure Paint; override;
        procedure DoIdle;
    public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;

        // Creates an OHLC candlestick/bar series
        function CreateOhlcListener(
            const AUpColor: TAlphaColor = TAlphaColors.Green;
            const ADownColor: TAlphaColor = TAlphaColors.Red;
            const AStyle: TCandleStyle = csCandleStick
        ): IMycProcessor<TArray<TDataPoint<TOhlcItem>>>;

        // Creates a simple line series for double values
        function CreateDoubleListener(const ALineColor: TAlphaColor = TAlphaColors.Cornflowerblue; const ALineWidth: Single = 1.5):
            IMycProcessor<TArray<Double>>;

        // The maximum number of data points to display from the main series.
        property Lookback: Integer read FLookback write FLookback;
    end;

implementation

uses
    System.Math,
    System.SyncObjs, WinApi.Windows,
    Myc.Trade.DataArray;

type
    TChartSeriesProcessor<T> = class(TMycChart.TSeries, IMycProcessor<TArray<T>>)
    strict private
        FDataSeries: TMycDataArray<T>;
        FChanged: Boolean;
        FLock: TSpinLock;
        procedure ProcessData(const Values: TArray<T>);
    private
        FData: TMycDataArray<T>;
    protected
        function GetCount: Int64; override;
        function Update: Boolean; override;

    public
        constructor Create(AOwner: TMycChart);
        property Data: TMycDataArray<T> read FData;
    end;

    { TChartOhlcSeries }
    TChartOhlcSeries = class(TChartSeriesProcessor<TDataPoint<TOhlcItem>>)
    private
        FUpColor: TAlphaColor;
        FDownColor: TAlphaColor;
        FStyle: TCandleStyle;
    protected
        function GetValueRange(StartIndex, Count: Int64; out Min, Max: Double): Boolean; override;
        procedure Paint(const ACanvas: TCanvas; const AXForm, AYForm: TFunc<Double, Single>); override;
    public
        constructor Create(AOwner: TMycChart; const AUpColor, ADownColor: TAlphaColor; AStyle: TCandleStyle);
    end;

    { TChartLineSeries }
    TChartLineSeries = class(TChartSeriesProcessor<Double>)
    private
        FLineColor: TAlphaColor;
        FLineWidth: Single;
    protected
        function GetValueRange(StartIndex, Count: Int64; out Min, Max: Double): Boolean; override;
        procedure Paint(const ACanvas: TCanvas; const AXForm, AYForm: TFunc<Double, Single>); override;
    public
        constructor Create(AOwner: TMycChart; const ALineColor: TAlphaColor; ALineWidth: Single);
    end;

{ TMycChart.TSeries }

constructor TMycChart.TSeries.Create(AOwner: TMycChart);
begin
    inherited Create(AOwner);
end;

function TMycChart.TSeries.GetMainSeries: TSeries;
begin
    Result := nil;
    if Owner.FSeriesList.Count > 0 then
        Result := Owner.FSeriesList[0];
end;

function TMycChart.TSeries.GetOwner: TMycChart;
begin
    Result := Controller as TMycChart;
end;

{ TMycChart }

constructor TMycChart.Create(AOwner: TComponent);
begin
    inherited Create(AOwner);
    FSeriesList := TObjectList<TSeries>.Create(true);
    FLookback := 100; // Default lookback

    FIdleSubscrId :=
        TMessageManager
            .DefaultManager
            .SubscribeToMessage(TIdleMessage, procedure(const Sender: TObject; const M: TMessage) begin DoIdle; end);
end;

destructor TMycChart.Destroy;
begin
    TMessageManager.DefaultManager.Unsubscribe(TIdleMessage, FIdleSubscrId);

    FSeriesList.Free;
    inherited;
end;

function TMycChart.CreateDoubleListener(const ALineColor: TAlphaColor = TAlphaColors.Cornflowerblue; const ALineWidth: Single = 1.5):
    IMycProcessor<TArray<Double>>;
var
    series: TChartLineSeries;
begin
    series := TChartLineSeries.Create(Self, ALineColor, ALineWidth);
    FSeriesList.Add(series);
    Result := series;
end;

function TMycChart.CreateOhlcListener(
    const AUpColor: TAlphaColor = TAlphaColors.Green;
    const ADownColor: TAlphaColor = TAlphaColors.Red;
    const AStyle: TCandleStyle = csCandleStick
): IMycProcessor<TArray<TDataPoint<TOhlcItem>>>;
var
    series: TChartOhlcSeries;
begin
    series := TChartOhlcSeries.Create(Self, AUpColor, ADownColor, AStyle);
    FSeriesList.Add(series);
    Result := series;
end;

procedure TMycChart.DoIdle;
begin
    var doRepaint := false;
    for var series in FSeriesList do
        if series.Update then
            doRepaint := true;
    if doRepaint then
        Repaint;
end;

procedure TMycChart.Paint;
var
    rect: TRectF;
    series: TSeries;
    globalMin, globalMax, seriesMin, seriesMax, padding: Double;
    rangeInitialized: Boolean;
    xTransform: TFunc<Double, Single>;
    yTransform: TFunc<Double, Single>;
begin
    inherited;
    rect := Self.LocalRect;

    if (FSeriesList.Count = 0) or (FLookback <= 1) then
    begin
        Canvas.Fill.Color := TAlphaColors.Gray;
        Canvas.FillText(rect, 'No Data', false, 1, [], TTextAlign.Center, TTextAlign.Center);
        Exit;
    end;

    rangeInitialized := false;

    for series in FSeriesList do
    begin
        if series.GetValueRange(0, FLookback, seriesMin, seriesMax) then
        begin
            if not rangeInitialized then
            begin
                globalMin := seriesMin;
                globalMax := seriesMax;
                rangeInitialized := true;
            end
            else
            begin
                globalMin := Min(globalMin, seriesMin);
                globalMax := Max(globalMax, seriesMax);
            end;
        end;
    end;

    if not rangeInitialized then
        Exit;

    padding := (globalMax - globalMin) * 0.1;
    globalMin := globalMin - padding;
    globalMax := globalMax + padding;

    if (globalMax - globalMin) = 0 then
        exit;

    xTransform := function(index: Double): Single begin Result := rect.Right - (index / (FLookback - 1)) * rect.Width; end;

    yTransform :=
        function(value: Double): Single
        begin
            Result := rect.Top + (1 - (value - globalMin) / (globalMax - globalMin)) * rect.Height;
        end;

//    var T :=
//        TMatrix.CreateTranslation(rect.Left, rect.Top + rect.Height*globalMax / (globalMax - globalMin)) *
//        TMatrix.CreateScaling(rect.Width / (FLookback - 1), -rect.Height / (globalMax - globalMin));

    for series in FSeriesList do
    begin
        series.Paint(Self.Canvas, xTransform, yTransform);
    end;
end;

{ TChartSeriesProcessor<T> }

constructor TChartSeriesProcessor<T>.Create(AOwner: TMycChart);
begin
    inherited Create(AOwner);
    FLock := TSpinLock.Create(false);
    FDataSeries := TMycDataArray<T>.CreateEmpty;
    FData := FDataSeries;
end;

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

procedure TChartSeriesProcessor<T>.ProcessData(const Values: TArray<T>);
begin
    FLock.Enter;
    try
        FDataSeries := FDataSeries.Add(Values, 0, Length(Values), Owner.Lookback);
        FChanged := true;
    finally
        FLock.Exit;
    end;
end;

function TChartSeriesProcessor<T>.Update: Boolean;
begin
    FLock.Enter;
    try
        Result := FChanged;
        FChanged := false;
        if Result then
            FData := FDataSeries;
    finally
        FLock.Exit;
    end;
end;

{ TChartOhlcSeries }

constructor TChartOhlcSeries.Create(AOwner: TMycChart; const AUpColor, ADownColor: TAlphaColor; AStyle: TCandleStyle);
begin
    inherited Create(AOwner);
    FUpColor := AUpColor;
    FDownColor := ADownColor;
    FStyle := AStyle;
end;

function TChartOhlcSeries.GetValueRange(StartIndex, Count: Int64; out Min, Max: Double): Boolean;
var
    i: Int64;
begin
    Result := GetCount > 0;
    if not Result then
        Exit;

    Min := MaxDouble;
    Max := -MaxDouble;
    for i := StartIndex to System.Math.Min(GetCount - 1, StartIndex + Count - 1) do
    begin
        Min := System.Math.Min(Min, Data.Items[i].Data.Low);
        Max := System.Math.Max(Max, Data.Items[i].Data.High);
    end;
    Result := (Min <> MaxDouble);
end;

procedure TChartOhlcSeries.Paint(const ACanvas: TCanvas; const AXForm, AYForm: TFunc<Double, Single>);
var
    i, displayCount: Int64;
    x, candleWidth: Single;
    yOpen, yHigh, yLow, yClose: Single;
    item: TDataPoint<TOhlcItem>;
    isUp: boolean;
begin
    displayCount := System.Math.Min(Data.Count, Owner.Lookback);
    if displayCount <= 0 then
        Exit;

    if displayCount > 1 then
        candleWidth := Max(2, 0.8 * Abs((AXForm(1) - AXForm(0))))
    else
        candleWidth := 10;

    for i := 0 to displayCount - 1 do
    begin
        item := Data.Items[i];
        x := AXForm(i);
        yOpen := AYForm(item.Data.Open);
        yClose := AYForm(item.Data.Close);
        yHigh := AYForm(item.Data.High);
        yLow := AYForm(item.Data.Low);
        isUp := item.Data.Close >= item.Data.Open;

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

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

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

{ TChartLineSeries }

constructor TChartLineSeries.Create(AOwner: TMycChart; const ALineColor: TAlphaColor; ALineWidth: Single);
begin
    inherited Create(AOwner);
    FLineColor := ALineColor;
    FLineWidth := ALineWidth;
end;

function TChartLineSeries.GetValueRange(StartIndex, Count: Int64; out Min, Max: Double): Boolean;
var
    i: Int64;
begin
    Result := GetCount > 0;
    if not Result then
        Exit;

    Min := MaxDouble;
    Max := -MaxDouble;
    for i := StartIndex to System.Math.Min(GetCount - 1, StartIndex + Count - 1) do
    begin
        Min := System.Math.Min(Min, Data.Items[i]);
        Max := System.Math.Max(Max, Data.Items[i]);
    end;
    Result := (Min <> MaxDouble);
end;

procedure TChartLineSeries.Paint(const ACanvas: TCanvas; const AXForm, AYForm: TFunc<Double, Single>);
begin
    if not Assigned(MainSeries) or (Data.Count = 0) or (MainSeries.Count = 0) then
        Exit;

    var points := TPathData.Create;

    var displayCount := System.Math.Min(Data.Count, Owner.Lookback);
    if displayCount < 2 then
        Exit;

    points.MoveTo( TPointF.Create(AXForm(0), AYForm(Data[0])) );
    for var i := 1 to displayCount - 1 do
        points.LineTo( TPointF.Create(AXForm(i), AYForm(Data[i])) );

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

end.