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
    TAstViewNode = class; // Forward declaration

    IAstViewNodeHandler = interface
        function GetAstNode: IAstNode;
        procedure BuildUI(OwnerNode: TAstViewNode);
        function ReconstructAst(OwnerNode: TAstViewNode): IAstNode;
        property Node: IAstNode read GetAstNode;
    end;

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

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

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

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

    TAutoFitControl = class(TStyledControl)
    private
        FUpdatingOwnSize: Boolean;
        FNeedRecalcSize: Boolean;
        FOrientation: TLayoutOrientation;
        FAlignment: TLayoutAlignment;
        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;

    TAstViewNode = class(TAutoFitControl)
    private
        FBackgroundColor: TAlphaColor;
        FBorderColor: TAlphaColor;
        FBorderWidth: Single;
        FBorderRadius: Single;
        FFrameless: Boolean;
        FVisualizer: IAstVisualizer;
        FHandler: IAstViewNodeHandler;

        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;

        procedure SetErrorMessage(const Value: string);
        procedure SetTypeInfoText(const Value: string);
        procedure UpdateVisualState;

    protected
        procedure Paint; override;
        procedure SetupNode;

        // Overrides for interaction
        procedure DoMouseEnter; override;
        procedure DoMouseLeave; 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(const AVisualizer: IAstVisualizer; const AHandler: IAstViewNodeHandler); 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): TAstViewNode;

        function CreateAst: IAstNode;

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

        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;

    TBaseNodeHandler<T: IAstNode> = class(TInterfacedObject, IAstViewNodeHandler)
    protected
        FNode: T;
        function GetAstNode: IAstNode;
    public
        constructor Create(const ANode: T);
        procedure BuildUI(OwnerNode: TAstViewNode); virtual; abstract;
        function ReconstructAst(OwnerNode: TAstViewNode): 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;

{ TAstViewNode }

constructor TAstViewNode.Create(const AVisualizer: IAstVisualizer; const AHandler: IAstViewNodeHandler);
begin
    inherited Create(AVisualizer.Workspace);

    Parent := AVisualizer.ParentControl;

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

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

    FFrameless := False;

    Width := cMinNodeWidth;
    Height := cMinNodeHeight;

    // HitTest muss True sein für Hover-Effekte (IsMouseOver)
    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 TAstViewNode.Destroy;
begin
    FHandler := nil;
    inherited;
end;

procedure TAstViewNode.DoMouseEnter;
begin
    inherited;
    // Wir müssen neu zeichnen, da sich IsMouseOver geändert hat,
    // FMX triggert Paint nicht automatisch bei Hover.
    Repaint;
end;

procedure TAstViewNode.DoMouseLeave;
begin
    inherited;
    Repaint;
end;

procedure TAstViewNode.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
var
    pt: TPointF;
begin
    inherited;
    // Panning-Weiterleitung an den Workspace
    if Assigned(FVisualizer.Workspace) then
    begin
        pt := LocalToAbsolute(TPointF.Create(X, Y));
        pt := FVisualizer.Workspace.AbsoluteToLocal(pt);
        FVisualizer.Workspace.ExternalMouseDown(Button, Shift, pt.X, pt.Y);
    end;
end;

procedure TAstViewNode.MouseMove(Shift: TShiftState; X, Y: Single);
var
    pt: TPointF;
begin
    inherited;
    if Assigned(FVisualizer.Workspace) then
    begin
        pt := LocalToAbsolute(TPointF.Create(X, Y));
        pt := FVisualizer.Workspace.AbsoluteToLocal(pt);
        FVisualizer.Workspace.ExternalMouseMove(Shift, pt.X, pt.Y);
    end;
end;

procedure TAstViewNode.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
var
    pt: TPointF;
begin
    inherited;
    if Assigned(FVisualizer.Workspace) then
    begin
        pt := LocalToAbsolute(TPointF.Create(X, Y));
        pt := FVisualizer.Workspace.AbsoluteToLocal(pt);
        FVisualizer.Workspace.ExternalMouseUp(Button, Shift, pt.X, pt.Y);
    end;
end;

function TAstViewNode.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 TAstViewNode.AddExpr(Parent: TControl; const Title: String; const Node: IAstNode): TAstViewNode;
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 TAstViewNode.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 TAstViewNode.AfterConstruction;
begin
    inherited;
    SetupNode;
end;

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

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

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

procedure TAstViewNode.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 TAstViewNode.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 TAstViewNode.Paint;
var
    rect: TRectF;
    effBorderColor: TAlphaColor;
    effBorderWidth: Single;
    effDash: TStrokeDash;
    isHovering: Boolean;
    shouldIgnoreHover: Boolean;
begin
    inherited;

    shouldIgnoreHover := False;
    if Assigned(Node) then
    begin
        case Node.Kind of
            // Lists and Blocks should generally not be highlighted as a whole on hover
            // because they are containers for other selectable items.
            akBlockExpression, akParameterList, akArgumentList, akExpressionList, akRecordFieldList: shouldIgnoreHover := True;
        end;
    end;

    // Determine hover state: active only if mouse is over AND it is not a container type
    isHovering := IsMouseOver and (not shouldIgnoreHover);

    // 1. Set base values
    if FFrameless then
    begin
        effBorderColor := FBorderColor;
        effBorderWidth := FBorderWidth;
        effDash := TStrokeDash.Dot;
    end
    else
    begin
        effBorderColor := FBorderColor;
        effBorderWidth := FBorderWidth;
        effDash := TStrokeDash.Solid;
    end;

    // 2. Hover state (overrides base, makes frameless nodes visible)
    if isHovering then
    begin
        // Bright white for strong contrast against dark background
        effBorderColor := TAlphaColors.White;

        // Make border slightly thicker for a "pop" effect
        effBorderWidth := Max(2.0, FBorderWidth + 1.0);

        // Always solid line when hovering, even if originally frameless
        effDash := TStrokeDash.Solid;
    end;

    // 3. Error state (dominates everything)
    if FErrorMessage <> '' then
    begin
        effBorderColor := TAlphaColors.Red;
        effBorderWidth := 2.0;
        effDash := TStrokeDash.Solid;
    end;

    // --- Drawing ---

    // Fill background
    Canvas.Fill.Kind := TBrushKind.Solid;
    Canvas.Fill.Color := FBackgroundColor;

    if FFrameless and (FErrorMessage = '') and (not isHovering) then
    begin
        // Special case: Inactive, frameless node (e.g., simple constant)
        // Draw only background, no border
        Canvas.FillRect(TRectF.Create(0, 0, Width, Height), 0, 0, [], 1.0);

        // Draw border only if explicit width is set (e.g. debugging)
        if FBorderWidth > 0 then
        begin
            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;
    end
    else
    begin
        // Standard case: Node with border (or hovered frameless node)

        rect := TRectF.Create(0, 0, Width, Height);
        // Adjust to avoid clipping the border
        if (effBorderWidth > 0) then
            rect.Inflate(-effBorderWidth / 2, -effBorderWidth / 2);

        Canvas.FillRect(rect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round);

        // Draw border
        if (effBorderWidth > 0) and (effBorderColor <> TAlphaColors.Null) then
        begin
            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 TAstViewNode.SetBorderColor(const Value: TAlphaColor);
begin
    if FBorderColor <> Value then
    begin
        FBorderColor := Value;
        Repaint;
    end;
end;

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

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

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

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

procedure TAstViewNode.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.