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

unit Myc.Fmx.AstEditor.Workspace;

interface

uses
    System.Classes,
    System.SysUtils,
    System.Types,
    System.UITypes,
    System.Math,
    System.Math.Vectors,
    FMX.Types,
    FMX.Controls,
    FMX.Objects,
    FMX.Graphics,
    FMX.Forms,
    Myc.Fmx.AstEditor.Render;

type
    TOnPaintConnectionsEvent = procedure(ASender: TObject; ACanvas: TCanvas) of object;
    TOnDragDropEvent = procedure(ASource, ATarget: TVisualNode; AIndex: Integer) of object;

    TWorkspace = class(TControl, IVisualHost)
    private
        const
            MinZoom = 0.1;
            MaxZoom = 5.0;
            ZoomStep = 0.1;
    private
        FRootNode: TVisualNode;

        FContentOffset: TPointF;
        FZoom: Single;

        FIsPanning: Boolean;
        FLastMousePos: TPointF;
        FMouseOverNode: TVisualNode;
        FCapturedNode: TVisualNode;

        FIsDraggingNode: Boolean;
        FDragSource: TVisualNode;
        FDragVisualBitmap: TBitmap;
        FDragVisualPos: TPointF;
        FDragOffset: TPointF;

        FCurrentDropTarget: TVisualNode;
        FCurrentDropIndex: Integer;
        FShowDropMarker: Boolean;
        FDropP1, FDropP2: TPointF;

        FOnPaintConnections: TOnPaintConnectionsEvent;
        FOnNodeDragDrop: TOnDragDropEvent;

        // IVisualHost
        procedure InvalidateRect(const R: TRectF);
        function GetCanvas: TCanvas;

        procedure SetZoom(const Value: Single);
        procedure SetContentOffset(const Value: TPointF);
        procedure SetRootNode(const Value: TVisualNode);

        procedure UpdateDropMarker(const WorldPos: TPointF);
        procedure StopDrag;

    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 MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); override;
        procedure Resize; override;
    public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;

        procedure BeginDragNode(ASource: TVisualNode);
        procedure InvalidateConnections;

        // Moved to public for Editor access
        function ScreenToWorld(const APoint: TPointF): TPointF;
        procedure RequestLayout;

        property RootNode: TVisualNode read FRootNode write SetRootNode;
        property Zoom: Single read FZoom write SetZoom;
        property ContentOffset: TPointF read FContentOffset write SetContentOffset;

        property OnPaintConnections: TOnPaintConnectionsEvent read FOnPaintConnections write FOnPaintConnections;
        property OnNodeDragDrop: TOnDragDropEvent read FOnNodeDragDrop write FOnNodeDragDrop;
    end;

implementation

uses
    Myc.Fmx.AstEditor.Node;

{ TWorkspace }

constructor TWorkspace.Create(AOwner: TComponent);
begin
    inherited Create(AOwner);
    ClipChildren := True;
    HitTest := True;
    CanFocus := True;
    AutoCapture := True;

    FZoom := 1.0;
    FContentOffset := TPointF.Zero;
    FRootNode := TVisualNode.Create(Self);
end;

destructor TWorkspace.Destroy;
begin
    FreeAndNil(FRootNode);
    FreeAndNil(FDragVisualBitmap);
    inherited;
end;

function TWorkspace.GetCanvas: TCanvas;
begin
    Result := Canvas;
end;

procedure TWorkspace.InvalidateRect(const R: TRectF);
begin
    Repaint;
end;

procedure TWorkspace.RequestLayout;
begin
    if Assigned(FRootNode) then
    begin
        FRootNode.RecalcLayout;
        Repaint;
    end;
end;

procedure TWorkspace.SetRootNode(const Value: TVisualNode);
begin
    if FRootNode <> Value then
    begin
        if Assigned(FRootNode) then
            FRootNode.Free;
        FRootNode := Value;
        RequestLayout;
    end;
end;

procedure TWorkspace.SetZoom(const Value: Single);
begin
    if FZoom <> Value then
    begin
        FZoom := EnsureRange(Value, MinZoom, MaxZoom);
        Repaint;
    end;
end;

procedure TWorkspace.SetContentOffset(const Value: TPointF);
begin
    if FContentOffset <> Value then
    begin
        FContentOffset := Value;
        Repaint;
    end;
end;

procedure TWorkspace.Paint;
var
    State: TCanvasSaveState;
    DragRect: TRectF;
begin
    inherited;

    if (csDesigning in ComponentState) then
    begin
        Canvas.Stroke.Kind := TBrushKind.Solid;
        Canvas.Stroke.Color := TAlphaColors.Gray;
        Canvas.Stroke.Dash := TStrokeDash.Dash;
        Canvas.DrawRect(LocalRect, 0, 0, AllCorners, 1.0);
    end;

    State := Canvas.SaveState;
    try
        Canvas.IntersectClipRect(LocalRect);

        Canvas.MultiplyMatrix(TMatrix.CreateScaling(FZoom, FZoom));
        Canvas.MultiplyMatrix(TMatrix.CreateTranslation(FContentOffset.X, FContentOffset.Y));

        if Assigned(FOnPaintConnections) then
            FOnPaintConnections(Self, Canvas);

        if Assigned(FRootNode) then
            FRootNode.Paint(Canvas, TPointF.Zero);

        if FShowDropMarker then
        begin
            Canvas.Stroke.Kind := TBrushKind.Solid;
            Canvas.Stroke.Color := TAlphaColors.Red;
            Canvas.Stroke.Thickness := 3 / FZoom;
            Canvas.Stroke.Cap := TStrokeCap.Round;

            Canvas.DrawLine(FDropP1, FDropP2, 1.0);

            Canvas.Fill.Color := TAlphaColors.Red;
            var R: Single := 4 / FZoom;
            Canvas.FillEllipse(TRectF.Create(FDropP1.X - R, FDropP1.Y - R, FDropP1.X + R, FDropP1.Y + R), 1.0);
            Canvas.FillEllipse(TRectF.Create(FDropP2.X - R, FDropP2.Y - R, FDropP2.X + R, FDropP2.Y + R), 1.0);
        end;

        if FIsDraggingNode and Assigned(FDragVisualBitmap) then
        begin
            DragRect := TRectF.Create(FDragVisualPos, FDragVisualBitmap.Width, FDragVisualBitmap.Height);
            Canvas.DrawBitmap(FDragVisualBitmap, TRectF.Create(0, 0, FDragVisualBitmap.Width, FDragVisualBitmap.Height), DragRect, 0.7);
        end;

    finally
        Canvas.RestoreState(State);
    end;
end;

function TWorkspace.ScreenToWorld(const APoint: TPointF): TPointF;
var
    LocalP: TPointF;
begin
    LocalP := ScreenToLocal(APoint);
    Result := (LocalP - FContentOffset) / FZoom;
end;

procedure TWorkspace.Resize;
begin
    inherited;
    Repaint;
end;

procedure TWorkspace.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
var
    WorldP: TPointF;
    Hit: TVisualNode;
begin
    inherited;
    if CanFocus then
        SetFocus;

    WorldP := ScreenToWorld(LocalToScreen(TPointF.Create(X, Y)));

    if (Button in [TMouseButton.mbLeft, TMouseButton.mbMiddle]) and (ssCtrl in Shift) then
    begin
        FIsPanning := True;
        FLastMousePos := TPointF.Create(X, Y);
        Root.Captured := Self;
        Exit;
    end;

    if Assigned(FRootNode) then
    begin
        Hit := FRootNode.HitTest(WorldP);

        if Assigned(Hit) then
        begin
            FCapturedNode := Hit;
            var NodeLocal := Hit.AbsoluteToLocal(WorldP);
            Hit.MouseDown(Button, Shift, NodeLocal.X, NodeLocal.Y);
        end
        else if Button = TMouseButton.mbLeft then
        begin
            FIsPanning := True;
            FLastMousePos := TPointF.Create(X, Y);
            Root.Captured := Self;
        end;
    end;
end;

procedure TWorkspace.MouseMove(Shift: TShiftState; X, Y: Single);
var
    WorldP: TPointF;
    LocalP: TPointF;
    Hit: TVisualNode;
    Delta: TPointF;
begin
    inherited;
    LocalP := TPointF.Create(X, Y);
    WorldP := ScreenToWorld(LocalToScreen(LocalP));

    if FIsDraggingNode then
    begin
        FDragVisualPos := WorldP - FDragOffset;
        UpdateDropMarker(WorldP);
        Repaint;
    end
    else if FIsPanning then
    begin
        Delta := LocalP - FLastMousePos;
        FContentOffset := FContentOffset + Delta;
        FLastMousePos := LocalP;
        Repaint;
    end
    else
    begin
        if Assigned(FCapturedNode) then
        begin
            var NodeLocal := FCapturedNode.AbsoluteToLocal(WorldP);
            FCapturedNode.MouseMove(Shift, NodeLocal.X, NodeLocal.Y);
        end
        else if Assigned(FRootNode) then
        begin
            Hit := FRootNode.HitTest(WorldP);
            if Hit <> FMouseOverNode then
            begin
                if Assigned(FMouseOverNode) then
                    FMouseOverNode.MouseLeave;
                FMouseOverNode := Hit;
                if Assigned(FMouseOverNode) then
                    FMouseOverNode.MouseEnter;
            end;

            if Assigned(FMouseOverNode) then
            begin
                var NodeLocal := FMouseOverNode.AbsoluteToLocal(WorldP);
                FMouseOverNode.MouseMove(Shift, NodeLocal.X, NodeLocal.Y);
            end;
        end;
    end;
end;

procedure TWorkspace.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
var
    WorldP: TPointF;
begin
    inherited;
    WorldP := ScreenToWorld(LocalToScreen(TPointF.Create(X, Y)));

    if FIsDraggingNode then
    begin
        StopDrag;
    end
    else if FIsPanning then
    begin
        FIsPanning := False;
        Root.Captured := nil;
    end
    else if Assigned(FCapturedNode) then
    begin
        var NodeLocal := FCapturedNode.AbsoluteToLocal(WorldP);
        FCapturedNode.MouseUp(Button, Shift, NodeLocal.X, NodeLocal.Y);
        FCapturedNode := nil;
    end;
end;

procedure TWorkspace.MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
var
    OldZoom: Single;
    LocalP, OffsetLocal: TPointF;
begin
    OldZoom := FZoom;

    if WheelDelta > 0 then
        SetZoom(FZoom + ZoomStep)
    else
        SetZoom(FZoom - ZoomStep);

    if not SameValue(OldZoom, FZoom, TEpsilon.Position) then
    begin
        LocalP := ScreenToLocal(Screen.MousePos);
        OffsetLocal := LocalP - FContentOffset;
        FContentOffset := LocalP - (OffsetLocal * (FZoom / OldZoom));
        Repaint;
    end;
    Handled := True;
end;

procedure TWorkspace.BeginDragNode(ASource: TVisualNode);
var
    Bitmap: TBitmap;
    Scale: Single;
begin
    if FIsDraggingNode or FIsPanning then
        Exit;
    if ASource = nil then
        Exit;

    FIsDraggingNode := True;
    FDragSource := ASource;
    Root.Captured := Self;

    Scale := Scene.GetSceneScale;
    Bitmap := TBitmap.Create(Round(ASource.Size.Width * Scale), Round(ASource.Size.Height * Scale));
    Bitmap.BitmapScale := Scale;

    if Bitmap.Canvas.BeginScene then
        try
            Bitmap.Canvas.Clear(0);
            ASource.Paint(Bitmap.Canvas, TPointF.Zero);
        finally
            Bitmap.Canvas.EndScene;
        end;

    FDragVisualBitmap := Bitmap;

    var MouseWorld := ScreenToWorld(Screen.MousePos);
    var NodeWorld := ASource.GetAbsolutePosition;

    FDragOffset := MouseWorld - NodeWorld;
    FDragVisualPos := NodeWorld;

    ASource.Opacity := 0.4;
    ASource.RequestLayout;
end;

procedure TWorkspace.UpdateDropMarker(const WorldPos: TPointF);
var
    Hit: TVisualNode;
    TargetContainer: TAutoFitLayout;
    IsHorizontal: Boolean;
    InsertIndex: Integer;
    Child: TVisualNode;
    P1, P2: TPointF;
    AbsP: TPointF;
begin
    FShowDropMarker := False;
    FCurrentDropTarget := nil;
    FCurrentDropIndex := -1;

    if FDragSource = nil then
        Exit;

    Hit := FRootNode.HitTest(WorldPos);
    if Hit = nil then
        Exit;

    if (Hit is TAutoFitLayout) then
        TargetContainer := TAutoFitLayout(Hit)
    else if (Hit.Parent is TAutoFitLayout) then
        TargetContainer := TAutoFitLayout(Hit.Parent)
    else
        Exit;

    if TargetContainer = FDragSource then
        Exit;

    FCurrentDropTarget := TargetContainer;
    IsHorizontal := TargetContainer.Orientation = loHorizontal;

    var TargetLocal := TargetContainer.AbsoluteToLocal(WorldPos);
    InsertIndex := TargetContainer.GetInsertionIndex(TargetLocal);
    FCurrentDropIndex := InsertIndex;

    if InsertIndex < TargetContainer.GetChildCount then
    begin
        Child := TargetContainer.GetChild(InsertIndex);
        AbsP := Child.GetAbsolutePosition;
        if IsHorizontal then
        begin
            P1 := AbsP;
            P2 := AbsP + TPointF.Create(0, Child.Size.Height);
        end
        else
        begin
            P1 := AbsP;
            P2 := AbsP + TPointF.Create(Child.Size.Width, 0);
        end;
    end
    else if TargetContainer.GetChildCount > 0 then
    begin
        Child := TargetContainer.GetChild(TargetContainer.GetChildCount - 1);
        AbsP := Child.GetAbsolutePosition;
        if IsHorizontal then
        begin
            P1 := AbsP + TPointF.Create(Child.Size.Width + Child.Margins.Right, 0);
            P2 := P1 + TPointF.Create(0, Child.Size.Height);
        end
        else
        begin
            P1 := AbsP + TPointF.Create(0, Child.Size.Height + Child.Margins.Bottom);
            P2 := P1 + TPointF.Create(Child.Size.Width, 0);
        end;
    end
    else
    begin
        AbsP := TargetContainer.GetAbsolutePosition + TPointF.Create(TargetContainer.Padding.Left, TargetContainer.Padding.Top);
        if IsHorizontal then
        begin
            P1 := AbsP;
            P2 := AbsP + TPointF.Create(0, 20);
        end
        else
        begin
            P1 := AbsP;
            P2 := AbsP + TPointF.Create(20, 0);
        end;
    end;

    FDropP1 := P1;
    FDropP2 := P2;
    FShowDropMarker := True;
end;

procedure TWorkspace.StopDrag;
begin
    if not FIsDraggingNode then
        Exit;

    FreeAndNil(FDragVisualBitmap);

    if Assigned(FDragSource) then
    begin
        FDragSource.Opacity := 1.0;

        if Assigned(FOnNodeDragDrop) and Assigned(FCurrentDropTarget) and (FCurrentDropIndex >= 0) then
        begin
            FOnNodeDragDrop(FDragSource, FCurrentDropTarget, FCurrentDropIndex);
        end;
    end;

    FShowDropMarker := False;
    FIsDraggingNode := False;
    FDragSource := nil;
    FCurrentDropTarget := nil;
    Root.Captured := nil;

    Repaint;
end;

procedure TWorkspace.InvalidateConnections;
begin
    Repaint;
end;

end.