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.Layout;

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

    TAstWorld = class(TControl)
    private
        FOnPaintConnections: TOnPaintConnectionsEvent;
        // VISUAL: Drop Marker State
        FShowDropMarker: Boolean;
        FDropP1, FDropP2: TPointF;
    protected
        procedure Paint; override;
        procedure AfterPaint; override;
    public
        constructor Create(AOwner: TComponent); override;
        procedure InvalidateConnections;
        property OnPaintConnections: TOnPaintConnectionsEvent read FOnPaintConnections write FOnPaintConnections;
    end;

    TWorkspace = class(TControl)
    private
        const
            MinZoom = 0.1;
            MaxZoom = 5.0;
            ZoomStep = 0.1;
    private
        FRootLayer: TAstWorld;
        FIsPanning: Boolean;
        FLastMousePos: TPointF;

        FIsDraggingNode: Boolean;
        FDragSource: TControl;
        FDragVisual: TControl;
        FDragOffset: TPointF;

        FCurrentDropTarget: TControl;
        FCurrentDropIndex: Integer;

        FOnNodeDragDrop: TOnDragDropEvent;

        function GetZoom: Single;
        procedure SetZoom(const Value: Single);
        function GetContentOffset: TPointF;
        procedure SetContentOffset(const Value: TPointF);
        function GetOnPaintConnections: TOnPaintConnectionsEvent;
        procedure SetOnPaintConnections(const Value: TOnPaintConnectionsEvent);

        procedure StopDrag;
        procedure UpdateDropMarker(const ScreenPos: TPointF);
    protected
        procedure Loaded; 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;
    public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;

        function ScreenToWorld(const APoint: TPointF): TPointF;
        procedure BeginDragNode(ASource: TControl);

        property World: TAstWorld read FRootLayer;
        property Zoom: Single read GetZoom write SetZoom;
        property ContentOffset: TPointF read GetContentOffset write SetContentOffset;
        property OnPaintConnections: TOnPaintConnectionsEvent read GetOnPaintConnections write SetOnPaintConnections;

        property OnNodeDragDrop: TOnDragDropEvent read FOnNodeDragDrop write FOnNodeDragDrop;
    end;

implementation

{ TAstWorld }

constructor TAstWorld.Create(AOwner: TComponent);
begin
    inherited;
    HitTest := False;
    Locked := True;
    Stored := False;
    ClipChildren := False;
    Width := 100;
    Height := 100;
    FShowDropMarker := False;
end;

procedure TAstWorld.Paint;
begin
    inherited;
    if (csDesigning in ComponentState) then
        DrawDesignBorder;

    // Connections should be BEHIND the nodes, so Paint is the correct place.
    if Assigned(FOnPaintConnections) then
        FOnPaintConnections(Self, Canvas);
end;

procedure TAstWorld.AfterPaint;
var
    ScaleFactor: Single;
    Radius: Single;
    Thickness: Single;
begin
    inherited;

    // --- DRAW DROP MARKER (IN FRONT OF NODES) ---
    if FShowDropMarker then
    begin
        // Calculate visual sizes inversely proportional to zoom
        if Scale.X > 0 then
            ScaleFactor := 1 / Scale.X
        else
            ScaleFactor := 1;

        Thickness := 3 * ScaleFactor;
        Radius := 4 * ScaleFactor;

        Canvas.Stroke.Kind := TBrushKind.Solid;
        Canvas.Stroke.Color := TAlphaColors.Red;
        Canvas.Stroke.Thickness := Thickness;
        Canvas.Stroke.Cap := TStrokeCap.Round;

        // Draw Line
        Canvas.DrawLine(FDropP1, FDropP2, 1.0);

        // Draw Circles at ends
        Canvas.Fill.Kind := TBrushKind.Solid;
        Canvas.Fill.Color := TAlphaColors.Red;

        Canvas.FillEllipse(TRectF.Create(FDropP1.X - Radius, FDropP1.Y - Radius, FDropP1.X + Radius, FDropP1.Y + Radius), 1.0);
        Canvas.FillEllipse(TRectF.Create(FDropP2.X - Radius, FDropP2.Y - Radius, FDropP2.X + Radius, FDropP2.Y + Radius), 1.0);
    end;
end;

procedure TAstWorld.InvalidateConnections;
begin
    Repaint;
end;

{ TWorkspace }

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

    FRootLayer := TAstWorld.Create(Self);
    FRootLayer.Parent := Self;
    FRootLayer.SetBounds(0, 0, 100, 100);
    FRootLayer.Scale.Point := TPointF.Create(1, 1);
end;

destructor TWorkspace.Destroy;
begin
    inherited;
end;

procedure TWorkspace.Loaded;
begin
    inherited;
    if FRootLayer <> nil then
        FRootLayer.BringToFront;
end;

function TWorkspace.ScreenToWorld(const APoint: TPointF): TPointF;
begin
    Result := ScreenToLocal(APoint);
    Result := FRootLayer.AbsoluteToLocal(LocalToAbsolute(Result));
end;

procedure TWorkspace.BeginDragNode(ASource: TControl);
var
    Snapshot: TBitmap;
    DragImg: TImage;
    MouseWorld: TPointF;
    AbsPos, WorldPos: TPointF;
begin
    if FIsDraggingNode or FIsPanning then
        Exit;

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

    Snapshot := ASource.MakeScreenshot;

    DragImg := TImage.Create(nil);
    DragImg.Parent := FRootLayer;
    DragImg.Bitmap := Snapshot;
    DragImg.WrapMode := TImageWrapMode.Stretch;
    DragImg.HitTest := False;
    DragImg.Opacity := 0.7;
    DragImg.BringToFront;

    AbsPos := ASource.LocalToAbsolute(TPointF.Zero);
    WorldPos := FRootLayer.AbsoluteToLocal(AbsPos);

    DragImg.SetBounds(WorldPos.X, WorldPos.Y, ASource.Width, ASource.Height);
    FDragVisual := DragImg;

    MouseWorld := ScreenToWorld(Screen.MousePos);
    FDragOffset := MouseWorld - WorldPos;

    ASource.Opacity := 0.4;
end;

procedure TWorkspace.UpdateDropMarker(const ScreenPos: TPointF);
var
    Obj: IControl;
    TargetCtrl: TControl;
    TargetLocalPos: TPointF;
    IsHorizontal: Boolean;
    InsertAfter: Boolean;
    PTL, PBR: TPointF;
    P1, P2: TPointF;
    SourceParent: TControl;
    TargetContainer: TAutoFitControl;
begin
    FRootLayer.FShowDropMarker := False;
    FCurrentDropTarget := nil;
    FCurrentDropIndex := -1;

    if FDragSource = nil then
        Exit;

    if not (FDragSource.Parent is TControl) then
        Exit;
    SourceParent := TControl(FDragSource.Parent);

    // 1. Find Drop Target
    Obj := ObjectAtPoint(ScreenPos);
    if (Obj = nil) or not (Obj.GetObject is TControl) then
        Exit;

    TargetCtrl := TControl(Obj.GetObject);

    // 2. Walk up hierarchy
    while (TargetCtrl <> nil) and (TargetCtrl.Parent <> SourceParent) do
    begin
        TargetCtrl := TargetCtrl.ParentControl;
        if TargetCtrl = FRootLayer then
            Exit;
    end;

    if TargetCtrl = nil then
        Exit;
    if TargetCtrl = FDragSource then
        Exit;

    FCurrentDropTarget := TargetCtrl;

    // 3. Determine Geometry using TAutoFitControl info
    TargetLocalPos := TargetCtrl.AbsoluteToLocal(ScreenPos);

    IsHorizontal := True; // Default fallback

    if SourceParent is TAutoFitControl then
    begin
        TargetContainer := TAutoFitControl(SourceParent);

        if TargetContainer.Orientation = TLayoutOrientation.loHorizontal then
            IsHorizontal := True
        else
            IsHorizontal := False;
    end;

    // Split logic
    if IsHorizontal then
        InsertAfter := TargetLocalPos.X > (TargetCtrl.Width / 2)
    else
        InsertAfter := TargetLocalPos.Y > (TargetCtrl.Height / 2);

    // 4. Calculate Index
    if InsertAfter then
        FCurrentDropIndex := TargetCtrl.Index + 1
    else
        FCurrentDropIndex := TargetCtrl.Index;

    // 5. Calculate Marker Visuals
    var AbsTL := TargetCtrl.LocalToAbsolute(TPointF.Zero);
    var AbsBR := TargetCtrl.LocalToAbsolute(TPointF.Create(TargetCtrl.Width, TargetCtrl.Height));

    PTL := FRootLayer.AbsoluteToLocal(AbsTL);
    PBR := FRootLayer.AbsoluteToLocal(AbsBR);

    if IsHorizontal then
    begin
        // Vertical Line
        var XPos := PTL.X;
        if InsertAfter then
            XPos := PBR.X;

        if InsertAfter then
            XPos := XPos + 2
        else
            XPos := XPos - 2;

        P1 := TPointF.Create(XPos, PTL.Y);
        P2 := TPointF.Create(XPos, PBR.Y);
    end
    else
    begin
        // Horizontal Line
        var YPos := PTL.Y;
        if InsertAfter then
            YPos := PBR.Y;

        if InsertAfter then
            YPos := YPos + 2
        else
            YPos := YPos - 2;

        P1 := TPointF.Create(PTL.X, YPos);
        P2 := TPointF.Create(PBR.X, YPos);
    end;

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

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

    if Assigned(FDragVisual) then
    begin
        FDragVisual.Parent := nil;
        FDragVisual.Free;
        FDragVisual := nil;
    end;

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

    FRootLayer.FShowDropMarker := False;
    FRootLayer.Repaint;

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

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

procedure TWorkspace.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
    inherited;
    // Capture Keyboard Focus
    if CanFocus then
        SetFocus;

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

procedure TWorkspace.MouseMove(Shift: TShiftState; X, Y: Single);
var
    LCurrentPos: TPointF;
    LDelta: TPointF;
    LWorldPos: TPointF;
begin
    inherited;

    if FIsDraggingNode then
    begin
        if Assigned(FDragVisual) then
        begin
            LWorldPos := ScreenToWorld(Screen.MousePos);
            FDragVisual.Position.Point := LWorldPos - FDragOffset;
        end;

        UpdateDropMarker(Screen.MousePos);

        FRootLayer.Repaint;
    end
    else if FIsPanning then
    begin
        LCurrentPos := TPointF.Create(X, Y);
        LDelta := LCurrentPos - FLastMousePos;

        FRootLayer.Position.Point := FRootLayer.Position.Point + LDelta;

        FLastMousePos := LCurrentPos;
    end;
end;

procedure TWorkspace.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
    inherited;
    if FIsDraggingNode then
    begin
        StopDrag;
    end
    else if FIsPanning then
    begin
        FIsPanning := False;
        Root.Captured := nil;
    end;
end;

procedure TWorkspace.MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
var
    LOldZoom, LNewZoom: Single;
    LScaleRatio: Single;
    LMousePosLocal: TPointF;
    LOffset: TPointF;
begin
    LOldZoom := Zoom;

    if WheelDelta > 0 then
        LNewZoom := LOldZoom + ZoomStep
    else
        LNewZoom := LOldZoom - ZoomStep;

    LNewZoom := EnsureRange(LNewZoom, MinZoom, MaxZoom);

    if not SameValue(LNewZoom, LOldZoom, TEpsilon.Vector) then
    begin
        LMousePosLocal := ScreenToLocal(Screen.MousePos);
        LOffset := LMousePosLocal - FRootLayer.Position.Point;
        LScaleRatio := LNewZoom / LOldZoom;

        FRootLayer.Position.Point := LMousePosLocal - (LOffset * LScaleRatio);
        SetZoom(LNewZoom);
    end;
    Handled := True;

    if not Handled then
        inherited;
end;

function TWorkspace.GetZoom: Single;
begin
    Result := FRootLayer.Scale.X;
end;

procedure TWorkspace.SetZoom(const Value: Single);
begin
    FRootLayer.Scale.Point := TPointF.Create(Value, Value);
end;

function TWorkspace.GetContentOffset: TPointF;
begin
    Result := FRootLayer.Position.Point;
end;

procedure TWorkspace.SetContentOffset(const Value: TPointF);
begin
    FRootLayer.Position.Point := Value;
end;

function TWorkspace.GetOnPaintConnections: TOnPaintConnectionsEvent;
begin
    Result := FRootLayer.OnPaintConnections;
end;

procedure TWorkspace.SetOnPaintConnections(const Value: TOnPaintConnectionsEvent);
begin
    FRootLayer.OnPaintConnections := Value;
end;

end.