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

unit Myc.Fmx.AstEditor;

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,
    Myc.Fmx.AstEditor.Layout;

const
    cNodePadding = 10;
    cTitleTopPadding = 2;
    cTitleBottomPadding = 4;
    cMinNodeWidth = 10;
    cMinNodeHeight = 10;
    cDragGutterWidth = 20; // Width of the trigger zone for dragging

type
    TAstViewNode = class;

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

    IReorderable = interface
        ['{9FA7C504-D327-4E00-A5FE-DD2876886212}']
        function CanDrag(Child: TControl): Boolean;
        procedure MoveChild(SourceIndex, TargetIndex: Integer);
    end;

    IAstVisualizer = interface
        {$region 'private'}
        function GetExprDepth: Integer;
        function GetParentControl: TControl;
        function GetWorkspace: TWorkspace;
        {$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: TWorkspace read GetWorkspace;
    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;

        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 Handler: IAstViewNodeHandler read FHandler;

        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;

{ 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 := 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;
    Repaint;
end;

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

procedure TAstViewNode.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
const
    cHeaderHeight = 30; // Defined height for header drag area
begin
    // Check for Drag Start.
    // Condition: Left Click AND we are part of a container (list)
    if (Button = TMouseButton.mbLeft) and (Parent is TAutoFitControl) then
    begin
        // Hit-Test: Either Gutter (Left) OR Header area (Top)
        if (X < cDragGutterWidth) or (Y < cHeaderHeight) then
        begin
            if Assigned(FVisualizer.Workspace) then
            begin
                FVisualizer.Workspace.BeginDragNode(Self);
                Exit;
            end;
        end;
    end;

    inherited;
end;

procedure TAstViewNode.MouseMove(Shift: TShiftState; X, Y: Single);
const
    cHeaderHeight = 30;
begin
    // Cursor Logic (Hover Feedback)
    if (Parent is TAutoFitControl) and ((X < cDragGutterWidth) or (Y < cHeaderHeight)) then
        Cursor := crSizeAll
    else
        Cursor := crDefault;

    inherited;
end;

procedure TAstViewNode.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
    inherited;
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;
    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
            akBlockExpression, akParameterList, akArgumentList, akExpressionList, akRecordFieldList: shouldIgnoreHover := True;
        end;
    end;

    isHovering := IsMouseOver and (not shouldIgnoreHover);

    if FFrameless then
    begin
        effBorderColor := FBorderColor;
        effBorderWidth := FBorderWidth;
        effDash := TStrokeDash.Dot;
    end
    else
    begin
        effBorderColor := FBorderColor;
        effBorderWidth := FBorderWidth;
        effDash := TStrokeDash.Solid;
    end;

    if isHovering then
    begin
        effBorderColor := TAlphaColors.White;
        effBorderWidth := Max(2.0, FBorderWidth + 1.0);
        effDash := TStrokeDash.Solid;
    end;

    if FErrorMessage <> '' then
    begin
        effBorderColor := TAlphaColors.Red;
        effBorderWidth := 2.0;
        effDash := TStrokeDash.Solid;
    end;

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

    if FFrameless and (FErrorMessage = '') and (not isHovering) then
    begin
        Canvas.FillRect(TRectF.Create(0, 0, Width, Height), 0, 0, [], 1.0);

        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
        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);

        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;

    if isHovering and (Parent is TAutoFitControl) then
    begin
        Canvas.Fill.Color := TAlphaColors.DimGray;
        Canvas.FillEllipse(TRectF.Create(4, 6, 8, 10), 1.0);
        Canvas.FillEllipse(TRectF.Create(4, 12, 8, 16), 1.0);
        Canvas.FillEllipse(TRectF.Create(4, 18, 8, 22), 1.0);
    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.