MycLib/Src/AST/Myc.Fmx.AstEditor.Render.pas

unit Myc.Fmx.AstEditor.Render;

interface

uses
    System.Types,
    System.UITypes,
    System.Classes,
    System.SysUtils,
    System.Math,
    System.Generics.Collections,
    FMX.Types,
    FMX.Graphics,
    FMX.TextLayout;

type
    TVisualNode = class;

    // Interface for the host (e.g. TWorkspace) to request repaints/layouts
    IVisualHost = interface
        ['{A9E2BD60-281B-42A2-9DB5-3100E8EF1519}']
        procedure InvalidateRect(const R: TRectF);
        procedure RequestLayout;
        function GetCanvas: TCanvas;
    end;

    // Helper structure for margins and padding
    TMarginRect = record
        Left, Top, Right, Bottom: Single;
        function Width: Single; inline;
        function Height: Single; inline;
        class function Create(L, T, R, B: Single): TMarginRect; static; inline;
        class operator Initialize(out Dest: TMarginRect);
    end;

    // The base class for all virtual UI elements (Flyweight)
    TVisualNode = class
    private
        FHost: IVisualHost;
        FParent: TVisualNode;
        FChildren: TList<TVisualNode>;

        // Data stored as Position and Size (Layout Model)
        // Direct field access is preferred within the unit
        FPosition: TPointF;
        FSize: TSizeF;

        FPadding: TMarginRect;
        FMargins: TMarginRect;
        FVisible: Boolean;
        FHitTest: Boolean;
        FTag: NativeInt;
        FOpacity: Single;

        procedure SetParent(const Value: TVisualNode);

    protected
        procedure SetHost(const Value: IVisualHost); virtual;
        // Called to paint the node-specific content (background, etc.)
        procedure DoPaint(Canvas: TCanvas; const Offset: TPointF); virtual;
    public
        constructor Create(AHost: IVisualHost = nil); virtual;
        destructor Destroy; override;

        // Layout system
        procedure RequestLayout;
        procedure RecalcLayout; virtual;

        // Geometry
        function GetAbsolutePosition: TPointF;
        function LocalToAbsolute(const P: TPointF): TPointF;
        function AbsoluteToLocal(const P: TPointF): TPointF;
        function AbsoluteRect: TRectF;

        function HitTest(const P: TPointF): TVisualNode; virtual;

        // Rendering pipeline
        // Offset is the absolute position of the parent content area
        procedure Paint(Canvas: TCanvas; const Offset: TPointF);

        // Child Management
        procedure AddChild(Child: TVisualNode);
        procedure RemoveChild(Child: TVisualNode);
        procedure DeleteChildren;
        function GetChildCount: Integer; inline;
        function GetChild(Index: Integer): TVisualNode; inline;

        // Interaction stubs (called by the host)
        procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); virtual;
        procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); virtual;
        procedure MouseMove(Shift: TShiftState; X, Y: Single); virtual;
        procedure MouseEnter; virtual;
        procedure MouseLeave; virtual;

        property Host: IVisualHost read FHost;
        property Parent: TVisualNode read FParent;

        // Direct field access via properties
        property Position: TPointF read FPosition write FPosition;
        property Size: TSizeF read FSize write FSize;

        property Padding: TMarginRect read FPadding write FPadding;
        property Margins: TMarginRect read FMargins write FMargins;

        property Visible: Boolean read FVisible write FVisible;
        property HitTestEnabled: Boolean read FHitTest write FHitTest;
        property Opacity: Single read FOpacity write FOpacity;
        property Tag: NativeInt read FTag write FTag;
    end;

    // Lightweight replacement for TLabel
    TTextNode = class(TVisualNode)
    private
        FText: string;
        FLayout: TTextLayout;
        FFontSettings: TTextSettings; // Stores font properties
        FColor: TAlphaColor;
        FIsLayoutDirty: Boolean;
        procedure SetText(const Value: string);
        procedure SetColor(const Value: TAlphaColor);
    protected
        procedure DoPaint(Canvas: TCanvas; const Offset: TPointF); override;
        procedure UpdateTextLayout(Canvas: TCanvas);
    public
        constructor Create(AHost: IVisualHost = nil); override;
        destructor Destroy; override;
        procedure RecalcLayout; override;

        property Text: string read FText write SetText;
        property Color: TAlphaColor read FColor write SetColor;
        property FontSettings: TTextSettings read FFontSettings;
    end;

    TLayoutOrientation = (loVertical, loHorizontal);
    TLayoutAlignment = (laCenter, laFlush);

    // The Layout Manager
    TAutoFitLayout = class(TVisualNode)
    private
        FOrientation: TLayoutOrientation;
        FAlignment: TLayoutAlignment;
        procedure SetOrientation(const Value: TLayoutOrientation);
        procedure SetAlignment(const Value: TLayoutAlignment);
    protected
        // TAutoFitLayout is a container, draws no background by default, but propagates Paint to children
        procedure DoPaint(Canvas: TCanvas; const Offset: TPointF); override;
    public
        constructor Create(AHost: IVisualHost = nil); override;
        procedure RecalcLayout; override;

        // Calculates the insertion index for drag & drop based on coordinates
        function GetInsertionIndex(const LocalP: TPointF): Integer;

        property Orientation: TLayoutOrientation read FOrientation write SetOrientation;
        property Alignment: TLayoutAlignment read FAlignment write SetAlignment;
    end;

implementation

{ TMarginRect }

class function TMarginRect.Create(L, T, R, B: Single): TMarginRect;
begin
    Result.Left := L;
    Result.Top := T;
    Result.Right := R;
    Result.Bottom := B;
end;

class operator TMarginRect.Initialize(out Dest: TMarginRect);
begin
    Dest.Left := 0;
    Dest.Top := 0;
    Dest.Right := 0;
    Dest.Bottom := 0;
end;

function TMarginRect.Height: Single;
begin
    Result := Top + Bottom;
end;

function TMarginRect.Width: Single;
begin
    Result := Left + Right;
end;

{ TVisualNode }

constructor TVisualNode.Create(AHost: IVisualHost);
begin
    inherited Create;
    FHost := AHost;
    FChildren := TList<TVisualNode>.Create;
    FVisible := True;
    FHitTest := True;
    FOpacity := 1.0;
    FPosition := TPointF.Create(0, 0);
    FSize := TSizeF.Create(10, 10);
end;

destructor TVisualNode.Destroy;
begin
    // Recursive release
    for var i := 0 to FChildren.Count - 1 do
        FChildren[i].Free;
    FChildren.Free;
    inherited;
end;

procedure TVisualNode.SetParent(const Value: TVisualNode);
begin
    if FParent <> Value then
    begin
        FParent := Value;
        // Propagate host if parent has one
        if (FHost = nil) and Assigned(FParent) then
            SetHost(FParent.Host);
    end;
end;

procedure TVisualNode.SetHost(const Value: IVisualHost);
begin
    FHost := Value;
    for var Child in FChildren do
        Child.SetHost(Value);
end;

procedure TVisualNode.AddChild(Child: TVisualNode);
begin
    Assert(Child <> nil);
    if Child.Parent <> nil then
        Child.Parent.RemoveChild(Child);

    FChildren.Add(Child);
    Child.SetParent(Self);
    RequestLayout;
end;

procedure TVisualNode.RemoveChild(Child: TVisualNode);
begin
    FChildren.Remove(Child);
    Child.FParent := nil;
    RequestLayout;
end;

procedure TVisualNode.DeleteChildren;
begin
    for var i := 0 to FChildren.Count - 1 do
        FChildren[i].Free;
    FChildren.Clear;
    RequestLayout;
end;

function TVisualNode.GetChild(Index: Integer): TVisualNode;
begin
    Result := FChildren[Index];
end;

function TVisualNode.GetChildCount: Integer;
begin
    Result := FChildren.Count;
end;

procedure TVisualNode.RequestLayout;
begin
    if Assigned(FParent) then
        FParent.RequestLayout
    else if Assigned(FHost) then
        FHost.RequestLayout;
end;

procedure TVisualNode.RecalcLayout;
begin
    // Base implementation: Does nothing.
    // Subclasses (Layouts) must implement calculation here.
end;

function TVisualNode.GetAbsolutePosition: TPointF;
var
    Curr: TVisualNode;
begin
    Result := FPosition;
    Curr := FParent;
    while Assigned(Curr) do
    begin
        // Add parent position + padding (since we are in the content area)
        Result := Result + Curr.FPosition + TPointF.Create(Curr.Padding.Left, Curr.Padding.Top);
        Curr := Curr.Parent;
    end;
end;

function TVisualNode.LocalToAbsolute(const P: TPointF): TPointF;
begin
    Result := GetAbsolutePosition + P;
end;

function TVisualNode.AbsoluteToLocal(const P: TPointF): TPointF;
begin
    Result := P - GetAbsolutePosition;
end;

function TVisualNode.AbsoluteRect: TRectF;
begin
    Result := TRectF.Create(GetAbsolutePosition, FSize.Width, FSize.Height);
end;

procedure TVisualNode.Paint(Canvas: TCanvas; const Offset: TPointF);
var
    AbsPos: TPointF;
    ChildOffset: TPointF;
    Child: TVisualNode;
begin
    if not FVisible then
        exit;

    // Absolute position of this node
    AbsPos := Offset + FPosition;

    // 1. Background / Own content
    DoPaint(Canvas, AbsPos);

    // 2. Draw children
    if FChildren.Count > 0 then
    begin
        // The 0,0 point for children is shifted by padding
        ChildOffset := AbsPos + TPointF.Create(FPadding.Left, FPadding.Top);
        for Child in FChildren do
            Child.Paint(Canvas, ChildOffset);
    end;
end;

procedure TVisualNode.DoPaint(Canvas: TCanvas; const Offset: TPointF);
begin
    // Stub
end;

function TVisualNode.HitTest(const P: TPointF): TVisualNode;
var
    i: Integer;
    Child: TVisualNode;
    LocalP: TPointF;
    ContentOrigin: TPointF;
begin
    Result := nil;
    if not FVisible or not FHitTest then
        exit;

    // P is relative to Position of this node. Check if P is inside rect.
    if not TRectF.Create(0, 0, FSize.Width, FSize.Height).Contains(P) then
        exit;

    ContentOrigin := TPointF.Create(FPadding.Left, FPadding.Top);

    // Check children in reverse Z-order (topmost first)
    for i := FChildren.Count - 1 downto 0 do
    begin
        Child := FChildren[i];
        // Transformation into child coordinates
        LocalP := P - ContentOrigin - Child.FPosition;

        Result := Child.HitTest(LocalP);
        if Result <> nil then
            exit;
    end;

    // If no child hit, it's us
    Result := Self;
end;

procedure TVisualNode.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
end;
procedure TVisualNode.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
end;
procedure TVisualNode.MouseMove(Shift: TShiftState; X, Y: Single);
begin
end;
procedure TVisualNode.MouseEnter;
begin
end;
procedure TVisualNode.MouseLeave;
begin
end;

{ TTextNode }

constructor TTextNode.Create(AHost: IVisualHost);
begin
    inherited;
    FHitTest := False; // Text is usually passive
    FIsLayoutDirty := True;
    FFontSettings := TTextSettings.Create(nil);
    FColor := TAlphaColors.Black;
end;

destructor TTextNode.Destroy;
begin
    FreeAndNil(FLayout);
    FreeAndNil(FFontSettings);
    inherited;
end;

procedure TTextNode.SetText(const Value: string);
begin
    if FText <> Value then
    begin
        FText := Value;
        FIsLayoutDirty := True;
        RequestLayout;
    end;
end;

procedure TTextNode.SetColor(const Value: TAlphaColor);
begin
    if FColor <> Value then
    begin
        FColor := Value;
        if Assigned(FHost) then
            FHost.InvalidateRect(AbsoluteRect);
    end;
end;

procedure TTextNode.UpdateTextLayout(Canvas: TCanvas);
begin
    if FIsLayoutDirty or (FLayout = nil) then
    begin
        if FLayout = nil then
            FLayout := TTextLayoutManager.DefaultTextLayout.Create(Canvas);

        FLayout.BeginUpdate;
        try
            FLayout.Text := FText;
            FLayout.Font.Assign(FFontSettings.Font);
            FLayout.Color := FColor;
            FLayout.WordWrap := False;
        finally
            FLayout.EndUpdate;
        end;
        FIsLayoutDirty := False;
    end;
end;

procedure TTextNode.RecalcLayout;
begin
    if Assigned(FHost) then
    begin
        UpdateTextLayout(FHost.GetCanvas);

        FSize.Width := FLayout.TextRect.Width + FPadding.Width;
        FSize.Height := FLayout.TextRect.Height + FPadding.Height;

        // Safety net for empty strings
        if FSize.Width < 1 then
            FSize.Width := 5;
        if FSize.Height < 1 then
            FSize.Height := 10;
    end;
end;

procedure TTextNode.DoPaint(Canvas: TCanvas; const Offset: TPointF);
begin
    UpdateTextLayout(Canvas);
    var P := Offset + TPointF.Create(FPadding.Left, FPadding.Top);

    // Set position and color on layout, then render
    FLayout.TopLeft := P;
    FLayout.Color := FColor;
    FLayout.RenderLayout(Canvas);
end;

{ TAutoFitLayout }

constructor TAutoFitLayout.Create(AHost: IVisualHost);
begin
    inherited;
    FOrientation := loHorizontal;
    FAlignment := laCenter;
end;

procedure TAutoFitLayout.SetOrientation(const Value: TLayoutOrientation);
begin
    if FOrientation <> Value then
    begin
        FOrientation := Value;
        RequestLayout;
    end;
end;

procedure TAutoFitLayout.SetAlignment(const Value: TLayoutAlignment);
begin
    if FAlignment <> Value then
    begin
        FAlignment := Value;
        RequestLayout;
    end;
end;

procedure TAutoFitLayout.DoPaint(Canvas: TCanvas; const Offset: TPointF);
begin
    // TAutoFitLayout is a container, draws no background by default.
    inherited DoPaint(Canvas, Offset);
end;

procedure TAutoFitLayout.RecalcLayout;
var
    Child: TVisualNode;
    CurrentX, CurrentY: Single;
    ReqW, ReqH: Single;
begin
    // 1. Recursion: Calculate children
    for Child in FChildren do
    begin
        if Child.Visible then
            Child.RecalcLayout;
    end;

    CurrentX := 0;
    CurrentY := 0;
    ReqW := 0;
    ReqH := 0;

    // 2. Stacking Logic
    if FOrientation = loVertical then
    begin
        for Child in FChildren do
        begin
            if not Child.Visible then
                continue;

            // Set Y-Position
            Child.FPosition := TPointF.Create(Child.Margins.Left, CurrentY + Child.Margins.Top);

            var ChildTotalH := Child.Size.Height + Child.Margins.Top + Child.Margins.Bottom;
            var ChildTotalW := Child.Size.Width + Child.Margins.Left + Child.Margins.Right;

            CurrentY := CurrentY + ChildTotalH;
            ReqW := Max(ReqW, ChildTotalW);
        end;
        ReqH := CurrentY;

        // 3. Alignment Logic (Cross-Axis)
        if FAlignment = laCenter then
        begin
            for Child in FChildren do
            begin
                if not Child.Visible then
                    continue;
                var ChildTotalW := Child.Size.Width + Child.Margins.Left + Child.Margins.Right;
                var OffsetX := (ReqW - ChildTotalW) * 0.5;
                Child.FPosition := TPointF.Create(Child.Margins.Left + OffsetX, Child.FPosition.Y);
            end;
        end;
    end
    else // Horizontal
    begin
        for Child in FChildren do
        begin
            if not Child.Visible then
                continue;

            // Set X-Position
            Child.FPosition := TPointF.Create(CurrentX + Child.Margins.Left, Child.Margins.Top);

            var ChildTotalW := Child.Size.Width + Child.Margins.Left + Child.Margins.Right;
            var ChildTotalH := Child.Size.Height + Child.Margins.Top + Child.Margins.Bottom;

            CurrentX := CurrentX + ChildTotalW;
            ReqH := Max(ReqH, ChildTotalH);
        end;
        ReqW := CurrentX;

        // 3. Alignment Logic (Cross-Axis)
        if FAlignment = laCenter then
        begin
            for Child in FChildren do
            begin
                if not Child.Visible then
                    continue;
                var ChildTotalH := Child.Size.Height + Child.Margins.Top + Child.Margins.Bottom;
                var OffsetY := (ReqH - ChildTotalH) * 0.5;
                Child.FPosition := TPointF.Create(Child.FPosition.X, Child.Margins.Top + OffsetY);
            end;
        end;
    end;

    // 4. Set own size
    FSize.Width := ReqW + FPadding.Width;
    FSize.Height := ReqH + FPadding.Height;
end;

function TAutoFitLayout.GetInsertionIndex(const LocalP: TPointF): Integer;
var
    i: Integer;
    Child: TVisualNode;
    Center: Single;
    ContentP: TPointF;
begin
    // Assumption: Append to end as default
    Result := FChildren.Count;

    // Convert coords to content area
    ContentP := LocalP - TPointF.Create(FPadding.Left, FPadding.Top);

    for i := 0 to FChildren.Count - 1 do
    begin
        Child := FChildren[i];
        if not Child.Visible then
            continue;

        if FOrientation = loVertical then
        begin
            Center := Child.FPosition.Y + (Child.Size.Height * 0.5);
            if ContentP.Y < Center then
                exit(i);
        end
        else
        begin
            Center := Child.FPosition.X + (Child.Size.Width * 0.5);
            if ContentP.X < Center then
                exit(i);
        end;
    end;
end;

end.