MycLib/AuraTrader/Myc.Fmx.Chart.pas

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,
    FMX.Forms,
    Myc.Trade.DataPoint,
    Myc.Signals,
    Myc.Lazy;

type
    TMycChart = class(TStyledControl)
    public
        type
            TSeries = class abstract(TObject)
            private
                FOwner: TMycChart;
                function GetMainSeries: TSeries;
            protected
                function GetCount: Int64; virtual; abstract;
                function GetTotalCount: Int64; virtual; abstract;
                function GetValueRange(StartIndex, Count: Int64; out Min, Max: Double): Boolean; virtual; abstract;
                procedure Update; virtual; abstract;
                // The signature is changed to support viewport painting with an index offset
                procedure Paint(const Canvas: TCanvas; First, Last: Int64; const XForm, YForm: TFunc<Double, Single>); virtual; abstract;
                property MainSeries: TSeries read GetMainSeries;
            public
                constructor Create(AOwner: TMycChart);
                property Count: Int64 read GetCount;
                property Owner: TMycChart read FOwner;
                property TotalCount: Int64 read GetTotalCount;
            end;

    private
        FSeriesList: TList<TSeries>;
        FLookback: TWriteable<Int64>;
        FIdleSubscrId: TMessageSubscriptionId;
        FViewStartIndex: Int64;
        FViewCount: Int64;
        FIsDragging: Boolean;
        FDragStartPoint: TPointF;
        FJumpButtonRect: TRectF;
        FJumpButtonHot: Boolean;
        FJumpButtonPressed: Boolean;
    protected
        procedure Paint; override;
        procedure DoIdle;
        procedure MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); override;
        procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
        procedure MouseMove(Shift: TShiftState; X, Y: Single); override;
        procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
    public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;

        // Creates an OHLC candlestick/bar series and returns it
        function AddOhlcSeries(
            const DataProvider: IMycDataProvider<TDataPoint<TOhlcItem>>;
            const AUpColor: TAlphaColor = TAlphaColors.Green;
            const ADownColor: TAlphaColor = TAlphaColors.Red
        ): TSeries;

        // Creates a simple line series for double values and returns it
        function AddDoubleSeries(
            const DataProvider: IMycDataProvider<Double>;
            const ALineColor: TAlphaColor = TAlphaColors.Cornflowerblue;
            const ALineWidth: Single = 1.5
        ): TSeries;

        property Lookback: TWriteable<Int64> read FLookback write FLookback;
    end;

implementation

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

type
    TChartSeriesReceiver<T> = class(TMycProcessor<T>)
    strict private
        FCurrData: TMycDataArray<T>;
        FLookback: TWriteable<Int64>;
    private
        FData: TWriteable<TMycDataArray<T>>;
    protected
        function ProcessData(const Value: T): Boolean; override;
    public
        constructor Create(const ALookback: TWriteable<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; override;

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

    { TChartOhlcSeries }
    TChartOhlcSeries = class(TChartSeriesProcessor<TDataPoint<TOhlcItem>>)
    private
        FUpColor: TAlphaColor;
        FDownColor: 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(
            AOwner: TMycChart;
            const ADataProvider: IMycDataProvider<TDataPoint<TOhlcItem>>;
            const AUpColor, ADownColor: TAlphaColor
        );
    end;

    { TChartLineSeries }
    TChartLineSeries = class(TChartSeriesProcessor<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(
            AOwner: TMycChart;
            const ADataProvider: IMycDataProvider<Double>;
            const ALineColor: TAlphaColor;
            ALineWidth: Single
        );
    end;

{ TMycChart.TSeries }

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

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

{ TMycChart }

constructor TMycChart.Create(AOwner: TComponent);
begin
    inherited Create(AOwner);
    FSeriesList := TObjectList<TSeries>.Create(true);

    FLookback := TWriteable<Int64>.CreateWriteable(1000); // Load more data for panning
    FViewStartIndex := 0;
    FViewCount := 100; // Show 100 items by default
    FIsDragging := false;

    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.AddDoubleSeries(
    const DataProvider: IMycDataProvider<Double>;
    const ALineColor: TAlphaColor = TAlphaColors.Cornflowerblue;
    const ALineWidth: Single = 1.5
): TSeries;
begin
    Result := TChartLineSeries.Create(Self, DataProvider, ALineColor, ALineWidth);
    FSeriesList.Add(Result);
end;

function TMycChart.AddOhlcSeries(
    const DataProvider: IMycDataProvider<TDataPoint<TOhlcItem>>;
    const AUpColor: TAlphaColor = TAlphaColors.Green;
    const ADownColor: TAlphaColor = TAlphaColors.Red
): TSeries;
begin
    Result := TChartOhlcSeries.Create(Self, DataProvider, AUpColor, ADownColor);
    FSeriesList.Add(Result);
end;

procedure TMycChart.DoIdle;
begin
    if (FSeriesList.Count = 0) then
        exit;

    var prevTotalCount := FSeriesList[0].TotalCount;

    var seriesRepaint := false;
    var seriesChanged := false;
    for var series in FSeriesList do
    begin
        var seriesCount := series.TotalCount;

        // Check if this series may need a repaint
        if FViewStartIndex <= prevTotalCount - seriesCount then
            seriesRepaint := true;

        // Update the series
        series.Update;

        if seriesCount <> series.TotalCount then
            seriesChanged := true;
    end;

    // Don't move with live data, if the last bar isn't visible
    if FViewStartIndex > 0 then
    begin
        var newTotalCount := FSeriesList[0].TotalCount;
        var countDelta := newTotalCount - prevTotalCount;

        if countDelta > 0 then
        begin
            // Adjust the start index based on the absolute change in total data points
            FViewStartIndex := FViewStartIndex + countDelta;
            if FViewStartIndex + FViewCount > newTotalCount then
                FViewStartIndex := newTotalCount - FViewCount;
        end;
    end;

    if seriesRepaint and seriesChanged then
        Repaint;
end;

procedure TMycChart.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
    // Check for button press first
    if (Button = TMouseButton.mbLeft) and (FViewStartIndex > 0) and FJumpButtonRect.Contains(PointF(X, Y)) then
    begin
        FJumpButtonPressed := true;
        Repaint;
        exit; // Prevent chart dragging
    end;

    inherited MouseDown(Button, Shift, X, Y);
    if (Button = TMouseButton.mbLeft) then
    begin
        FIsDragging := true;
        FDragStartPoint := TPointF.Create(X, Y);
    end;
end;

procedure TMycChart.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
    // Check if a button press was active
    if FJumpButtonPressed then
    begin
        FJumpButtonPressed := false;
        // If mouse is released over the button, trigger the action
        if (FViewStartIndex > 0) and FJumpButtonRect.Contains(PointF(X, Y)) then
        begin
            FViewStartIndex := 0; // Jump to the latest candle
        end;
        Repaint;
        exit;
    end;

    inherited MouseUp(Button, Shift, X, Y);
    if (Button = TMouseButton.mbLeft) then
    begin
        FIsDragging := false;
    end;
end;

procedure TMycChart.MouseMove(Shift: TShiftState; X, Y: Single);
var
    isHot: Boolean;
    dx: Single;
    indexDelta: Int64;
    mainSeries: TSeries;
    maxIndex: Int64;
begin
    // Update button hot state
    if (FViewStartIndex > 0) then
    begin
        isHot := FJumpButtonRect.Contains(PointF(X, Y));
        if (isHot <> FJumpButtonHot) then
        begin
            FJumpButtonHot := isHot;
            Repaint;
        end;
    end
    else
    begin
        // Ensure hot state is off when button is not visible
        if FJumpButtonHot then
        begin
            FJumpButtonHot := false;
            Repaint;
        end;
    end;

    // Panning logic
    inherited MouseMove(Shift, X, Y);

    if FIsDragging then
    begin
        dx := X - FDragStartPoint.X;
        if Abs(dx) < 2 then // Threshold to avoid jitter
        begin
            exit;
        end;

        if (FSeriesList.Count = 0) or (FViewCount <= 0) then
        begin
            exit;
        end;

        indexDelta := Round(dx / (Self.Width / FViewCount));

        // To move content left (natural), view must shift to newer data (lower index).
        // Drag left (dx < 0) -> FViewStartIndex must decrease.
        // The formula for that is FViewStartIndex := FViewStartIndex + indexDelta; -> StartIndex + (negative) = decrease.
        FViewStartIndex := FViewStartIndex + indexDelta;

        // Clamp values
        mainSeries := FSeriesList[0];
        maxIndex := mainSeries.Count - FViewCount;
        if (maxIndex < 0) then
            maxIndex := 0;

        if (FViewStartIndex < 0) then
            FViewStartIndex := 0;
        if (FViewStartIndex > maxIndex) then
            FViewStartIndex := maxIndex;

        FDragStartPoint.X := X;
        FDragStartPoint.Y := Y;

        Repaint;
    end;
end;

procedure TMycChart.MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
var
    mousePos: TPointF;
    anchorIndex: Double;
    zoomFactor: Double;
    newViewCount: Int64;
    ratio: Double;
    mainSeries: TSeries;
begin
    Handled := true;

    if (FSeriesList.Count = 0) then
        exit;
    mainSeries := FSeriesList[0];
    if (mainSeries.Count = 0) or (Width <= 0) then
        exit;

    mousePos := ScreenToLocal(Screen.MousePos);

    // Calculate the anchor index for a right-to-left axis
    anchorIndex := FViewStartIndex + ((Self.Width - mousePos.X) / Self.Width) * FViewCount;

    if (WheelDelta > 0) then
        zoomFactor := 0.8 // Zoom In
    else
        zoomFactor := 1.25; // Zoom Out

    newViewCount := Round(FViewCount * zoomFactor);

    // Clamp zoom level
    if (newViewCount < 10) then
        newViewCount := 10;
    if (newViewCount > mainSeries.Count) then
        newViewCount := mainSeries.Count;
    if (newViewCount = FViewCount) then
        exit;

    // Adjust start index to keep anchor point stable
    if (FViewCount > 0) then
        ratio := (anchorIndex - FViewStartIndex) / FViewCount
    else
        ratio := 0;

    FViewStartIndex := Round(anchorIndex - (ratio * newViewCount));
    FViewCount := newViewCount;

    // Clamp start index
    if (FViewStartIndex < 0) then
        FViewStartIndex := 0;
    if (FViewStartIndex + FViewCount > mainSeries.Count) then
    begin
        FViewStartIndex := mainSeries.Count - FViewCount;
    end;

    Repaint;
end;

procedure TMycChart.Paint;

    function CalcView(Series: TSeries; MasterCount: Int64; out First: Int64; out Last: Int64): Boolean;
    begin
        var seriesTotalCount := series.TotalCount;
        var offset := MasterCount - seriesTotalCount;
        var startIdx := FViewStartIndex - offset;

        First := Max(0, startIdx);
        Last := Min(series.Count, startIdx + FViewCount) - 1;

        Result := First <= Last - 1;
    end;

var
    rect: TRectF;
    series: TSeries;
    globalMin, globalMax, seriesMin, seriesMax, padding: Double;
    rangeInitialized: Boolean;
    xTransform: TFunc<Double, Single>;
    yTransform: TFunc<Double, Single>;
    isButtonVisible: Boolean;
    buttonColor: TAlphaColor;
    path: TPathData;
    mainSeries: TSeries;
    masterTotalCount, seriesFirst, seriesLast: Int64;
begin
    inherited;
    rect := Self.LocalRect;

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

    rangeInitialized := false;
    mainSeries := FSeriesList[0];

    masterTotalCount := mainSeries.TotalCount;
    for series in FSeriesList do
    begin
        if CalcView(series, masterTotalCount, seriesFirst, seriesLast) then
        begin
            if series.GetValueRange(seriesFirst, seriesLast, 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;
    end;

    if not rangeInitialized then
        Exit;

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

    if (globalMax - globalMin) = 0 then
        exit;

    // Base transform maps an index from the viewport to a screen coordinate
    yTransform :=
        function(value: Double): Single begin Result := rect.Top + (1 - (value - globalMin) / (globalMax - globalMin)) * rect.Height; end;

    // --- Draw Series with Offset Compensation ---
    // The masterTotalCount is already calculated from the range finding loop
    for series in FSeriesList do
    begin
        if CalcView(series, masterTotalCount, seriesFirst, seriesLast) then
        begin
            var offset := masterTotalCount - series.TotalCount;
            xTransform :=
                function(index: Double): Single
                begin
                    Result := rect.Right - (((index + offset - FViewStartIndex) / (FViewCount - 1)) * rect.Width);
                end;

            series.Paint(Self.Canvas, seriesFirst, seriesLast, xTransform, yTransform);
        end;
    end;

    // --- Draw the "jump to latest" button ---
    isButtonVisible := (FViewStartIndex > 0);

    if isButtonVisible then
    begin
        // Define button position and size
        FJumpButtonRect := TRectF.Create(Self.Width - 44, Self.Height - 44, Self.Width - 10, Self.Height - 10);

        // Determine color based on state
        if FJumpButtonPressed then
            buttonColor := $FF707070 // Pressed color
        else if FJumpButtonHot then
            buttonColor := $FF505050 // Hover color
        else
            buttonColor := $FF303030; // Default color

        // Draw button background
        Canvas.Fill.Color := buttonColor;
        Canvas.FillRect(FJumpButtonRect, 4, 4, AllCorners, 0.7);

        // Draw an icon
        Canvas.Stroke.Color := TAlphaColors.White;
        Canvas.Stroke.Thickness := 1.5;

        path := TPathData.Create;
        try
            var cx := FJumpButtonRect.CenterPoint.X;
            var cy := FJumpButtonRect.CenterPoint.Y;
            path.MoveTo(PointF(cx - 5, cy - 6));
            path.LineTo(PointF(cx, cy));
            path.LineTo(PointF(cx - 5, cy + 6));
            path.MoveTo(PointF(cx + 2, cy - 6));
            path.LineTo(PointF(cx + 7, cy));
            path.LineTo(PointF(cx + 2, cy + 6));
            Canvas.DrawPath(path, 1);
        finally
            path.Free;
        end;
    end
    else
    begin
        // Reset button state when not visible
        FJumpButtonRect := TRectF.Empty;
        FJumpButtonPressed := false;
    end;
end;

{ TChartSeriesReceiver<T> }

constructor TChartSeriesReceiver<T>.Create(const ALookback: TWriteable<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): Boolean;
begin
    Result := true;
    FCurrData := FCurrData.Add(Value, FLookback.Value);
    FData.Value := FCurrData;
end;

{ TChartSeriesProcessor<T> }

constructor TChartSeriesProcessor<T>.Create(AOwner: TMycChart; const ADataProvider: IMycDataProvider<T>);
begin
    inherited Create(AOwner);
    FLock := TSpinLock.Create(false);
    FDataSeries := TMycDataArray<T>.CreateEmpty;
    FData := FDataSeries;
    FDataProvider := ADataProvider;
    FReceiver := TChartSeriesReceiver<T>.Create(AOwner.FLookback);
    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;

{ TChartOhlcSeries }

constructor TChartOhlcSeries.Create(
    AOwner: TMycChart;
    const ADataProvider: IMycDataProvider<TDataPoint<TOhlcItem>>;
    const AUpColor, ADownColor: TAlphaColor
);
begin
    inherited Create(AOwner, ADataProvider);
    FUpColor := AUpColor;
    FDownColor := ADownColor;
end;

function TChartOhlcSeries.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 dp := Data.Items[i];
        MinValue := Min(MinValue, dp.Data.Low);
        MaxValue := Max(MaxValue, dp.Data.High);
    end;
    Result := (MinValue <> MaxDouble);
end;

procedure TChartOhlcSeries.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: TDataPoint<TOhlcItem>;
    isUp: boolean;
begin
    candleWidth := Max(2, 0.8 * Abs((XForm(First + 1) - XForm(First))));

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

        if isUp then
            Canvas.Stroke.Color := FUpColor
        else
            Canvas.Stroke.Color := FDownColor;
        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;

{ TChartLineSeries }

constructor TChartLineSeries.Create(
    AOwner: TMycChart;
    const ADataProvider: IMycDataProvider<Double>;
    const ALineColor: TAlphaColor;
    ALineWidth: Single
);
begin
    inherited Create(AOwner, ADataProvider);
    FLineColor := ALineColor;
    FLineWidth := ALineWidth;
end;

function TChartLineSeries.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 := Data.Items[i];
        if not IsNaN(v) then
        begin
            MinValue := Min(MinValue, v);
            MaxValue := Max(MaxValue, v);
        end;
    end;
    Result := (MinValue <> MaxDouble);
end;

procedure TChartLineSeries.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(Data[n])) do
            inc(n);
        if (n > Last) then
            exit;

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

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

end.