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

unit Myc.Fmx.AstEditor.Core;

interface

uses
    System.SysUtils,
    System.Classes,
    System.UITypes,
    System.Types,
    System.Math,
    System.Math.Vectors,
    System.Generics.Defaults,
    System.Generics.Collections,
    FMX.Types,
    FMX.Controls,
    FMX.Objects,
    FMX.Graphics,
    FMX.StdCtrls,
    Myc.Ast.Nodes,
    Myc.Fmx.AstEditor.Workspace;

const
    cNodePadding = 10;
    cTitleTopPadding = 2;
    cTitleBottomPadding = 4;
    cMinNodeWidth = 10;
    cMinNodeHeight = 10;

type
    TAuraNode = class; // Forward declaration

    // This aggregate interface encapsulates all node-specific logic.
    IAuraNodeHandler = interface
        // Gets the original logical AST node
        function GetAstNode: IAstNode;
        // Creates the specific FMX UI for this node
        procedure BuildUI(OwnerNode: TAuraNode);
        // Reconstructs the logical AST node from the FMX UI state
        function ReconstructAst(OwnerNode: TAuraNode): IAstNode;
        // The original logical AST node
        property Node: IAstNode read GetAstNode;
    end;

    IAstVisualizer = interface
        {$region 'private'}
        function GetExprDepth: Integer;
        function GetParentControl: TControl;
        function GetWorkspace: TAuraWorkspace;
        {$endregion}

        function Clone(ParentControl: TControl; ExprDepth: Integer): IAstVisualizer;
        function CallAccept(const Node: IAstNode): TAuraNode;

        property ExprDepth: Integer read GetExprDepth;
        property ParentControl: TControl read GetParentControl;
        property Workspace: TAuraWorkspace read GetWorkspace;
    end;

    // Defines the layout direction for children within TAutoFitControl
    TLayoutOrientation = (loVertical, loHorizontal);

    // Defines the alignment of children on the cross-axis
    TLayoutAlignment = (laCenter, laFlush);

    // A styled control that automatically adjusts its size to fit its children, including padding.
    TAutoFitControl = class(TStyledControl)
    private
        FUpdatingOwnSize: Boolean; // Recursion guard
        FNeedRecalcSize: Boolean; // Flag for EndUpdate
        FOrientation: TLayoutOrientation; // Storage for Orientation
        FAlignment: TLayoutAlignment; // Storage for Alignment
        procedure RecalcOwnSize;
        procedure SetOrientation(const Value: TLayoutOrientation);
        procedure SetAlignment(const Value: TLayoutAlignment);
    protected
        procedure ParentContentChanged; override;
        procedure PaddingChanged; override;
        procedure ChangeChildren; override;
        procedure Loaded; override;
        procedure DoEndUpdate; override;
    public
        constructor Create(AOwner: TComponent); override;

    published
        property Padding;
        property Orientation: TLayoutOrientation read FOrientation write SetOrientation default TLayoutOrientation.loHorizontal;
        property Alignment: TLayoutAlignment read FAlignment write SetAlignment default TLayoutAlignment.laCenter;
    end;

    // A movable panel with a custom-painted border. Content (like title) is added externally.
    TAuraNode = class(TAutoFitControl)
    private
        FBackgroundColor: TAlphaColor;
        FIsDragging: Boolean;
        FDownPos: TPointF;
        FBorderColor: TAlphaColor;
        FBorderWidth: Single;
        FBorderRadius: Single;
        FFrameless: Boolean;
        FVisualizer: IAstVisualizer;
        FHandler: IAuraNodeHandler;

        // --- Visual State Fields ---
        FErrorMessage: string;
        FTypeInfoText: string;

        procedure SetBackgroundColor(const Value: TAlphaColor);
        procedure SetBorderColor(const Value: TAlphaColor);
        procedure SetBorderWidth(const Value: Single);
        procedure SetBorderRadius(const Value: Single);
        procedure SetFrameless(const Value: Boolean);
        function GetNode: IAstNode;

        // New Setters
        procedure SetErrorMessage(const Value: string);
        procedure SetTypeInfoText(const Value: string);
        procedure UpdateVisualState;

    protected
        procedure Paint; 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;
        procedure SetupNode;

    public
        constructor Create(const AVisualizer: IAstVisualizer; const AHandler: IAuraNodeHandler); reintroduce;
        destructor Destroy; override;

        procedure AfterConstruction; override;

        function AddLabel(Parent: TControl; const Txt: String): TLabel;
        function AddContainer(Parent: TControl; Orientation: TLayoutOrientation; Alignment: TLayoutAlignment): TAutoFitControl;
        function AddExpr(Parent: TControl; const Title: String; const Node: IAstNode): TAuraNode;

        function CreateAst: IAstNode;

        property Visualizer: IAstVisualizer read FVisualizer;
        property Node: IAstNode read GetNode;

        // --- Visual State Properties ---
        property ErrorMessage: string read FErrorMessage write SetErrorMessage;
        property TypeInfoText: string read FTypeInfoText write SetTypeInfoText;

    published
        property BorderColor: TAlphaColor read FBorderColor write SetBorderColor;
        property BorderWidth: Single read FBorderWidth write SetBorderWidth;
        property BorderRadius: Single read FBorderRadius write SetBorderRadius;
        property BackgroundColor: TAlphaColor read FBackgroundColor write SetBackgroundColor;
        property Frameless: Boolean read FFrameless write SetFrameless;

        property Align;
        property Anchors;
        property ClipChildren default True;
        property Cursor default crDefault;
        property DragMode default TDragMode.dmManual;
        property Enabled;
        property Height;
        property Hint;
        property HitTest default True;
        property Locked;
        property Margins;
        property Opacity;
        property Padding;
        property PopupMenu;
        property Position;
        property RotationAngle;
        property RotationCenter;
        property Scale;
        property Size;
        property Visible;
        property Width;
        property OnClick;
        property OnDblClick;
        property OnMouseDown;
        property OnMouseMove;
        property OnMouseUp;
        property OnMouseWheel;
        property OnMouseEnter;
        property OnMouseLeave;
    end;

    // Helper base class to reduce boilerplate in specific handlers
    TBaseNodeHandler<T: IAstNode> = class(TInterfacedObject, IAuraNodeHandler)
    protected
        FNode: T;
        function GetAstNode: IAstNode;
    public
        constructor Create(const ANode: T);
        procedure BuildUI(OwnerNode: TAuraNode); virtual; abstract;
        function ReconstructAst(OwnerNode: TAuraNode): IAstNode; virtual; abstract;
    end;

implementation

uses
    Myc.Ast;

{ TAutoFitControl }

constructor TAutoFitControl.Create(AOwner: TComponent);
begin
    inherited Create(AOwner);
    HitTest := True;
    FOrientation := TLayoutOrientation.loHorizontal;
    FAlignment := TLayoutAlignment.laCenter;
end;

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

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

procedure TAutoFitControl.RecalcOwnSize;
var
    i: Integer;
    child: TControl;
    childrenToLayout: TList<TControl>;
    currentX, currentY: Single;
    requiredWidth, requiredHeight: Single;
    childWidthWithMargins, childHeightWithMargins: Single;
    hasVisibleChild: Boolean;
begin
    if FUpdatingOwnSize then
        exit;
    if IsUpdating then
    begin
        FNeedRecalcSize := True;
        exit;
    end;

    FUpdatingOwnSize := True;
    childrenToLayout := nil;
    try
        requiredWidth := Padding.Left + Padding.Right;
        requiredHeight := Padding.Top + Padding.Bottom;
        currentX := Padding.Left;
        currentY := Padding.Top;
        hasVisibleChild := False;

        childrenToLayout := TList<TControl>.Create;
        for i := 0 to ChildrenCount - 1 do
        begin
            if Children[i] is TControl then
            begin
                child := TControl(Children[i]);
                if child.Visible and (child.Align = TAlignLayout.None) then
                begin
                    childrenToLayout.Add(child);
                    hasVisibleChild := True;
                end;
            end;
        end;

        if hasVisibleChild then
        begin
            if FOrientation = TLayoutOrientation.loVertical then
            begin
                for child in childrenToLayout do
                begin
                    child.Position.Y := currentY + child.Margins.Top;
                    currentY := child.Position.Y + child.Height + child.Margins.Bottom;

                    childWidthWithMargins := Padding.Left + child.Margins.Left + child.Width + child.Margins.Right + Padding.Right;
                    requiredWidth := System.Math.Max(requiredWidth, childWidthWithMargins);
                end;
                requiredHeight := currentY + Padding.Bottom;

                if FAlignment = TLayoutAlignment.laFlush then
                begin
                    for child in childrenToLayout do
                    begin
                        child.Position.X := Padding.Left + child.Margins.Left;
                    end;
                end
                else
                begin
                    var contentWidth := requiredWidth - Padding.Left - Padding.Right;
                    for child in childrenToLayout do
                    begin
                        var childTotalWidth := child.Width + child.Margins.Left + child.Margins.Right;
                        var childX := Padding.Left + ((contentWidth - childTotalWidth) / 2) + child.Margins.Left;
                        child.Position.X := childX;
                    end;
                end;
            end
            else
            begin
                for child in childrenToLayout do
                begin
                    child.Position.X := currentX + child.Margins.Left;
                    currentX := child.Position.X + child.Width + child.Margins.Right;

                    childHeightWithMargins := Padding.Top + child.Margins.Top + child.Height + child.Margins.Bottom + Padding.Bottom;
                    requiredHeight := System.Math.Max(requiredHeight, childHeightWithMargins);
                end;
                requiredWidth := currentX + Padding.Right;

                if FAlignment = TLayoutAlignment.laFlush then
                begin
                    for child in childrenToLayout do
                    begin
                        child.Position.Y := Padding.Top + child.Margins.Top;
                    end;
                end
                else
                begin
                    var contentHeight := requiredHeight - Padding.Top - Padding.Bottom;
                    for child in childrenToLayout do
                    begin
                        var childTotalHeight := child.Height + child.Margins.Top + child.Margins.Bottom;
                        var childY := Padding.Top + ((contentHeight - childTotalHeight) / 2) + child.Margins.Top;
                        child.Position.Y := childY;
                    end;
                end;
            end;
        end
        else
        begin
            requiredWidth := Padding.Left + Padding.Right;
            requiredHeight := Padding.Top + Padding.Bottom;
        end;

        requiredWidth := System.Math.Max(0, requiredWidth);
        requiredHeight := System.Math.Max(0, requiredHeight);

        if not SameValue(requiredWidth, Width, TEpsilon.Position) or not SameValue(requiredHeight, Height, TEpsilon.Position) then
        begin
            FSize.SetSizeWithoutNotification(TSizeF.Create(requiredWidth, requiredHeight));
            HandleSizeChanged;
        end;

    finally
        childrenToLayout.Free;
        FUpdatingOwnSize := False;
    end;
end;

procedure TAutoFitControl.Loaded;
begin
    inherited Loaded;
    RecalcOwnSize;
end;

procedure TAutoFitControl.ChangeChildren;
begin
    inherited ChangeChildren;
    RecalcOwnSize;
end;

procedure TAutoFitControl.PaddingChanged;
begin
    inherited PaddingChanged;
    RecalcOwnSize;
end;

procedure TAutoFitControl.ParentContentChanged;
begin
    inherited ParentContentChanged;
    RecalcOwnSize;
end;

procedure TAutoFitControl.DoEndUpdate;
begin
    inherited;
    if FNeedRecalcSize then
    begin
        FNeedRecalcSize := False;
        RecalcOwnSize;
    end;
end;

{ TAuraNode }

constructor TAuraNode.Create(const AVisualizer: IAstVisualizer; const AHandler: IAuraNodeHandler);
begin
    inherited Create(AVisualizer.Workspace);

    Parent := AVisualizer.ParentControl;

    FVisualizer := AVisualizer.Clone(Self, AVisualizer.ExprDepth);
    FHandler := AHandler;

    FIsDragging := False;

    FBorderColor := TAlphaColors.Gray;
    FBorderWidth := 1;
    FBorderRadius := 9;
    FBackgroundColor := $080a0a0a;

    FFrameless := False;

    Width := cMinNodeWidth;
    Height := cMinNodeHeight;

    HitTest := True;
    ClipChildren := True;

    Margins.Left := 4;
    Margins.Top := 4;
    Margins.Right := 4;
    Margins.Bottom := 4;
    Padding.Left := 3;
    Padding.Top := 3;
    Padding.Right := 3;
    Padding.Bottom := 3;

    var cn: Cardinal := $ea - (7 * FVisualizer.ExprDepth);
    var c: Cardinal := $ff000000 or (cn shl 16) or (cn shl 8) or cn;
    BackgroundColor := c;
end;

destructor TAuraNode.Destroy;
begin
    FHandler := nil;
    inherited;
end;

function TAuraNode.AddContainer(Parent: TControl; Orientation: TLayoutOrientation; Alignment: TLayoutAlignment): TAutoFitControl;
begin
    Result := TAutoFitControl.Create(Self);
    Result.Parent := Parent;
    Result.Orientation := Orientation;
    Result.Alignment := Alignment;
    Result.HitTest := False;
end;

function TAuraNode.AddExpr(Parent: TControl; const Title: String; const Node: IAstNode): TAuraNode;
begin
    var cont := AddContainer(Parent, loHorizontal, laCenter);

    var lbl := AddLabel(cont, Title);
    lbl.Font.Style := lbl.Font.Style + [TFontStyle.fsBold];

    Result := FVisualizer.Clone(cont, FVisualizer.ExprDepth + 1).CallAccept(Node);
end;

function TAuraNode.AddLabel(Parent: TControl; const Txt: String): TLabel;
begin
    Result := TLabel.Create(Self);
    Result.Parent := Parent;

    Result.Position.Point := TPoint.Create(cNodePadding, cNodePadding);
    Result.Margins.Left := cNodePadding;
    Result.Margins.Right := cNodePadding;
    Result.Margins.Top := cTitleTopPadding;
    Result.Margins.Bottom := cTitleBottomPadding;
    Result.WordWrap := False;
    Result.AutoSize := True;
    Result.HitTest := False;

    Result.StyledSettings := Result.StyledSettings - [TStyledSetting.Style];

    Result.Text := Txt;
    Result.ApplyStyleLookup;
end;

procedure TAuraNode.AfterConstruction;
begin
    inherited;
    SetupNode;
end;

function TAuraNode.CreateAst: IAstNode;
begin
    if Assigned(FHandler) then
        Result := FHandler.ReconstructAst(Self)
    else
        Result := TAst.Nop;
end;

function TAuraNode.GetNode: IAstNode;
begin
    if Assigned(FHandler) then
        Result := FHandler.Node
    else
        Result := nil;
end;

procedure TAuraNode.SetErrorMessage(const Value: string);
begin
    if FErrorMessage <> Value then
    begin
        FErrorMessage := Value;
        UpdateVisualState;
        Repaint;
    end;
end;

procedure TAuraNode.SetTypeInfoText(const Value: string);
begin
    if FTypeInfoText <> Value then
    begin
        FTypeInfoText := Value;
        UpdateVisualState;
        // Type Info usually doesn't change painting, just hint
    end;
end;

procedure TAuraNode.UpdateVisualState;
begin
    if FErrorMessage <> '' then
    begin
        Hint := 'Error: ' + FErrorMessage;
        ShowHint := True;
    end
    else if FTypeInfoText <> '' then
    begin
        Hint := 'Type: ' + FTypeInfoText;
        ShowHint := True;
    end
    else
    begin
        Hint := '';
        ShowHint := False;
    end;
end;

procedure TAuraNode.Paint;
var
    rect: TRectF;
    effBorderColor: TAlphaColor;
    effBorderWidth: Single;
    effDash: TStrokeDash;
begin
    inherited;

    Canvas.Fill.Kind := TBrushKind.None;

    // Determine styles based on state (Error > Standard)
    if FErrorMessage <> '' then
    begin
        effBorderColor := TAlphaColors.Red;
        effBorderWidth := 2.0;
        effDash := TStrokeDash.Solid;
    end
    else
    begin
        effBorderColor := FBorderColor;
        effBorderWidth := FBorderWidth;
        if FFrameless then
            effDash := TStrokeDash.Dot
        else
            effDash := TStrokeDash.Solid;
    end;

    if FFrameless and (FErrorMessage = '') then
    begin
        // Standard frameless drawing (only if no error)
        Canvas.Fill.Kind := TBrushKind.Solid;
        Canvas.Fill.Color := FBackgroundColor;
        Canvas.Stroke.Kind := TBrushKind.None;
        Canvas.FillRect(TRectF.Create(0, 0, Width, Height), 0, 0, [], 1.0);
        Canvas.Stroke.Kind := TBrushKind.Solid;
        Canvas.Stroke.Color := effBorderColor;
        Canvas.Stroke.Thickness := effBorderWidth;
        Canvas.Stroke.Dash := effDash;
        Canvas.DrawRect(TRectF.Create(0, 0, Width, Height), 0, 0, [], 1.0);
    end
    else
    begin
        // Draw background fill first
        Canvas.Fill.Kind := TBrushKind.Solid;
        Canvas.Fill.Color := FBackgroundColor;
        rect := TRectF.Create(0, 0, Width, Height);
        if (effBorderWidth > 0) then
            rect.Inflate(-effBorderWidth / 2, -effBorderWidth / 2);
        Canvas.FillRect(rect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round);

        // Draw border (Custom or Error)
        if (effBorderWidth > 0) and (effBorderColor <> TAlphaColors.Null) then
        begin
            rect := TRectF.Create(0, 0, Width, Height);
            rect.Inflate(-effBorderWidth / 2, -effBorderWidth / 2);

            Canvas.Stroke.Kind := TBrushKind.Solid;
            Canvas.Stroke.Color := effBorderColor;
            Canvas.Stroke.Thickness := effBorderWidth;
            Canvas.Stroke.Dash := effDash;
            Canvas.DrawRect(rect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round);
        end;
    end;
end;

procedure TAuraNode.SetBorderColor(const Value: TAlphaColor);
begin
    if FBorderColor <> Value then
    begin
        FBorderColor := Value;
        Repaint;
    end;
end;

procedure TAuraNode.SetBorderRadius(const Value: Single);
begin
    if FBorderRadius <> Value then
    begin
        FBorderRadius := Value;
        Repaint;
    end;
end;

procedure TAuraNode.SetBorderWidth(const Value: Single);
begin
    if FBorderWidth <> Value then
    begin
        FBorderWidth := Value;
        Repaint;
    end;
end;

procedure TAuraNode.SetFrameless(const Value: Boolean);
begin
    if FFrameless <> Value then
    begin
        FFrameless := Value;
        Repaint;
    end;
end;

procedure TAuraNode.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
    inherited;
    if Button = TMouseButton.mbLeft then
    begin
        var lControl := ObjectAtPoint(LocalToScreen(TPointF.Create(X, Y)));
        if Assigned(lControl) and (lControl.GetObject = Self) then
        begin
            FIsDragging := True;
            FDownPos := TPointF.Create(X, Y);
            Capture;
            BringToFront;
        end
        else
            FIsDragging := False;
    end;
end;

procedure TAuraNode.MouseMove(Shift: TShiftState; X, Y: Single);
begin
    inherited;

    if FIsDragging then
    begin
        var deltaX := X - FDownPos.X;
        var deltaY := Y - FDownPos.Y;

        Position.X := Position.X + deltaX;
        Position.Y := Position.Y + deltaY;

        if ParentControl <> nil then
            ParentControl.Repaint;
    end;
end;

procedure TAuraNode.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
    inherited;
    if (Button = TMouseButton.mbLeft) and (FIsDragging) then
    begin
        ReleaseCapture;
        FIsDragging := False;
        if ParentControl <> nil then
            ParentControl.Repaint;
    end;
end;

procedure TAuraNode.SetBackgroundColor(const Value: TAlphaColor);
begin
    FBackgroundColor := Value;
    Repaint;
end;

procedure TAuraNode.SetupNode;
begin
    if Assigned(FHandler) then
        FHandler.BuildUI(Self);
end;

{ TBaseNodeHandler<T> }

constructor TBaseNodeHandler<T>.Create(const ANode: T);
begin
    inherited Create;
    FNode := ANode;
end;

function TBaseNodeHandler<T>.GetAstNode: IAstNode;
begin
    Result := FNode;
end;

end.