Ast editor custom draw

2025-12-06 17:32:04 +01:00
parent 9ed563bcc1
commit e40f56eaeb
10 changed files with 1629 additions and 1439 deletions
@@ -0,0 +1,626 @@
+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
+    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.