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

unit Myc.Fmx.AstEditor.Node;

interface

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

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

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: TVisualNode): Boolean;
        procedure MoveChild(SourceIndex, TargetIndex: Integer);
    end;

    IAstVisualizer = interface
        {$region 'private'}
        function GetExprDepth: Integer;
        function GetParentNode: TVisualNode;
        function GetWorkspace: TWorkspace;
        {$endregion}

        function Clone(ParentNode: TVisualNode; ExprDepth: Integer): IAstVisualizer;
        function CallAccept(const Node: IAstNode): TAstViewNode;

        property ExprDepth: Integer read GetExprDepth;
        property ParentNode: TVisualNode read GetParentNode;
        property Workspace: TWorkspace read GetWorkspace;
    end;

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

        FErrorMessage: string;
        FTypeInfoText: string;

        FIsFocused: Boolean;
        FIsHovered: Boolean;

        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 SetIsFocused(const Value: Boolean);
        procedure InvalidateVisuals;

    protected
        procedure DoPaint(Canvas: TCanvas; const Offset: TPointF); override;
        procedure SetupNode;

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

        procedure AfterConstruction; override;

        procedure MouseEnter; override;
        procedure MouseLeave; override;
        procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
        procedure MouseMove(Shift: TShiftState; X, Y: Single); override;

        function AddLabel(Parent: TVisualNode; const Txt: String): TTextNode;
        function AddContainer(Parent: TVisualNode; Orientation: TLayoutOrientation; Alignment: TLayoutAlignment): TAutoFitLayout;
        function AddExpr(Parent: TVisualNode; 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;
        property IsFocused: Boolean read FIsFocused write SetIsFocused;

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

    if Assigned(AVisualizer.ParentNode) then
        AVisualizer.ParentNode.AddChild(Self);

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

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

    FFrameless := False;
    FIsFocused := False;
    FIsHovered := False;

    Size := TSizeF.Create(cMinNodeWidth, cMinNodeHeight);

    HitTestEnabled := True;

    Margins := TMarginRect.Create(4, 4, 4, 4);
    Padding := TMarginRect.Create(3, 3, 3, 3);

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

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

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

procedure TAstViewNode.SetupNode;
begin
    if Assigned(FHandler) then
        FHandler.BuildUI(Self);
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;

function TAstViewNode.AddContainer(Parent: TVisualNode; Orientation: TLayoutOrientation; Alignment: TLayoutAlignment): TAutoFitLayout;
begin
    Result := TAutoFitLayout.Create(Host);
    Parent.AddChild(Result);
    Result.Orientation := Orientation;
    Result.Alignment := Alignment;
    Result.HitTestEnabled := False;
end;

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

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

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

function TAstViewNode.AddLabel(Parent: TVisualNode; const Txt: String): TTextNode;
begin
    Result := TTextNode.Create(Host);
    Parent.AddChild(Result);

    Result.Margins := TMarginRect.Create(cNodePadding, cTitleTopPadding, cNodePadding, cTitleBottomPadding);
    Result.Padding := TMarginRect.Create(0, 0, 0, 0);

    Result.Text := Txt;
end;

procedure TAstViewNode.DoPaint(Canvas: TCanvas; const Offset: TPointF);
var
    Rect: TRectF;
    EffBorderColor: TAlphaColor;
    EffBorderWidth: Single;
    EffDash: TStrokeDash;
    ShouldIgnoreHover: Boolean;
begin
    Rect := TRectF.Create(Offset, Size.Width, Size.Height);

    ShouldIgnoreHover := False;
    if Assigned(Node) then
    begin
        case Node.Kind of
            akBlockExpression, akParameterList, akArgumentList, akExpressionList, akRecordFieldList: ShouldIgnoreHover := True;
        end;
    end;

    if FFrameless then
    begin
        EffBorderColor := FBorderColor;
        EffBorderWidth := FBorderWidth;
        EffDash := TStrokeDash.Dot;
    end
    else
    begin
        EffBorderColor := FBorderColor;
        EffBorderWidth := FBorderWidth;
        EffDash := TStrokeDash.Solid;
    end;

    if FIsHovered and (not ShouldIgnoreHover) 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;

    if FIsFocused then
    begin
        EffBorderColor := TAlphaColors.Dodgerblue;
        EffBorderWidth := 2.0;
        EffDash := TStrokeDash.Solid;
    end;

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

    if FFrameless and (FErrorMessage = '') and (not FIsHovered) and (not FIsFocused) then
    begin
        Canvas.FillRect(Rect, 0, 0, AllCorners, 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(Rect, 0, 0, AllCorners, 1.0);
        end;
    end
    else
    begin
        var DrawRect := Rect;
        if EffBorderWidth > 0 then
            DrawRect.Inflate(-EffBorderWidth / 2, -EffBorderWidth / 2);

        Canvas.FillRect(DrawRect, 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(DrawRect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round);
        end;
    end;

    if FIsHovered and (Parent is TAutoFitLayout) then
    begin
        Canvas.Fill.Color := TAlphaColors.DimGray;
        Canvas.FillEllipse(TRectF.Create(Offset.X + 4, Offset.Y + 6, Offset.X + 12, Offset.Y + 14), 1.0);
        Canvas.FillEllipse(TRectF.Create(Offset.X + 4, Offset.Y + 16, Offset.X + 12, Offset.Y + 24), 1.0);
    end;
end;

procedure TAstViewNode.InvalidateVisuals;
begin
    if Assigned(Host) then
        Host.InvalidateRect(AbsoluteRect);
end;

procedure TAstViewNode.SetBackgroundColor(const Value: TAlphaColor);
begin
    if FBackgroundColor <> Value then
    begin
        FBackgroundColor := Value;
        InvalidateVisuals;
    end;
end;

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

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

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

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

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

procedure TAstViewNode.SetIsFocused(const Value: Boolean);
begin
    if FIsFocused <> Value then
    begin
        FIsFocused := Value;
        InvalidateVisuals;
    end;
end;

procedure TAstViewNode.SetTypeInfoText(const Value: string);
begin
    if FTypeInfoText <> Value then
    begin
        FTypeInfoText := Value;
    end;
end;

procedure TAstViewNode.MouseEnter;
begin
    FIsHovered := True;
    InvalidateVisuals;
end;

procedure TAstViewNode.MouseLeave;
begin
    FIsHovered := False;
    InvalidateVisuals;
end;

procedure TAstViewNode.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
const
    cHeaderHeight = 30;
begin
    if (Button = TMouseButton.mbLeft) and (Parent is TAutoFitLayout) then
    begin
        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);
begin
    inherited;
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.