Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

Ast editor custom draw

Browse Source
This commit is contained in:
Michael Schimmel
2025-12-06 19:21:36 +01:00
parent e40f56eaeb
commit 872c15ac51
6 changed files with 394 additions and 43 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/AST/Myc.Fmx.AstEditor.Workspace.pas
+130 -35
View File
@@ -29,8 +29,8 @@ type
private
FRootNode: TVisualNode;
FContentOffset: TPointF;
FZoom: Single;
FContentOffset: TPointF; // Verschiebung in Screen-Pixeln
FZoom: Single; // Skalierungsfaktor
FIsPanning: Boolean;
FLastMousePos: TPointF;
@@ -40,7 +40,7 @@ type
FIsDraggingNode: Boolean;
FDragSource: TVisualNode;
FDragVisualBitmap: TBitmap;
FDragVisualPos: TPointF;
FDragVisualPos: TPointF; // World Coordinates
FDragOffset: TPointF;
FCurrentDropTarget: TVisualNode;
@@ -62,6 +62,10 @@ type
procedure UpdateDropMarker(const WorldPos: TPointF);
procedure StopDrag;
// Koordinaten-Transformation
function LocalToWorld(const ALocalPoint: TPointF): TPointF;
function WorldToLocal(const AWorldPoint: TPointF): TPointF;
protected
procedure Paint; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
@@ -76,7 +80,6 @@ type
procedure BeginDragNode(ASource: TVisualNode);
procedure InvalidateConnections;
// Moved to public for Editor access
function ScreenToWorld(const APoint: TPointF): TPointF;
procedure RequestLayout;
@@ -147,7 +150,7 @@ end;
procedure TWorkspace.SetZoom(const Value: Single);
begin
if FZoom <> Value then
if not SameValue(FZoom, Value, TEpsilon.Position) then
begin
FZoom := EnsureRange(Value, MinZoom, MaxZoom);
Repaint;
@@ -163,13 +166,43 @@ begin
end;
end;
// =============================================================================
// COORDINATE SYSTEM LOGIC
// =============================================================================
// Screen(Local) = (World * Zoom) + ContentOffset
// World = (Screen - ContentOffset) / Zoom
// =============================================================================
function TWorkspace.LocalToWorld(const ALocalPoint: TPointF): TPointF;
begin
// Transformation: Screen Pixel -> Logical AST Coordinate
if FZoom < 0.001 then
Result := ALocalPoint - FContentOffset
else
Result := (ALocalPoint - FContentOffset) / FZoom;
end;
function TWorkspace.WorldToLocal(const AWorldPoint: TPointF): TPointF;
begin
// Transformation: Logical AST Coordinate -> Screen Pixel
Result := (AWorldPoint * FZoom) + FContentOffset;
end;
function TWorkspace.ScreenToWorld(const APoint: TPointF): TPointF;
begin
// Helper for external calls (e.g. from DragDrop where we get global mouse pos)
Result := LocalToWorld(ScreenToLocal(APoint));
end;
procedure TWorkspace.Paint;
var
State: TCanvasSaveState;
DragRect: TRectF;
M: TMatrix;
begin
inherited;
// Design-Time Border
if (csDesigning in ComponentState) then
begin
Canvas.Stroke.Kind := TBrushKind.Solid;
@@ -182,33 +215,62 @@ begin
try
Canvas.IntersectClipRect(LocalRect);
Canvas.MultiplyMatrix(TMatrix.CreateScaling(FZoom, FZoom));
Canvas.MultiplyMatrix(TMatrix.CreateTranslation(FContentOffset.X, FContentOffset.Y));
// --- MATRIX APPLICATION ---
// Order matters!
// 1. Scale (Zoom)
// 2. Translate (Pan)
// Mathematically corresponds to: World * Scale + Translate
M := TMatrix.Identity;
M := M * TMatrix.CreateScaling(FZoom, FZoom);
M := M * TMatrix.CreateTranslation(FContentOffset.X, FContentOffset.Y);
Canvas.MultiplyMatrix(M);
// Callback for Connections (World Space drawing)
if Assigned(FOnPaintConnections) then
FOnPaintConnections(Self, Canvas);
// Draw Tree (World Space)
if Assigned(FRootNode) then
FRootNode.Paint(Canvas, TPointF.Zero);
// Draw Drop Marker (World Space)
if FShowDropMarker then
begin
// Adjust line thickness inverse to zoom to keep it consistent on screen
var LineThick := 3.0 / FZoom;
var DotRadius := 4.0 / FZoom;
Canvas.Stroke.Kind := TBrushKind.Solid;
Canvas.Stroke.Color := TAlphaColors.Red;
Canvas.Stroke.Thickness := 3 / FZoom;
Canvas.Stroke.Thickness := LineThick;
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);
Canvas.FillEllipse(
TRectF.Create(FDropP1.X - DotRadius, FDropP1.Y - DotRadius, FDropP1.X + DotRadius, FDropP1.Y + DotRadius),
1.0
);
Canvas.FillEllipse(
TRectF.Create(FDropP2.X - DotRadius, FDropP2.Y - DotRadius, FDropP2.X + DotRadius, FDropP2.Y + DotRadius),
1.0
);
end;
// Draw Drag Ghost (World Space)
if FIsDraggingNode and Assigned(FDragVisualBitmap) then
begin
DragRect := TRectF.Create(FDragVisualPos, FDragVisualBitmap.Width, FDragVisualBitmap.Height);
// Scale is already in the Bitmap (BitmapScale), but here we draw on Scaled Canvas.
// We draw 1:1 on World Coordinates.
DragRect :=
TRectF.Create(
FDragVisualPos,
FDragVisualBitmap.Width / FDragVisualBitmap.BitmapScale,
FDragVisualBitmap.Height / FDragVisualBitmap.BitmapScale
);
Canvas.DrawBitmap(FDragVisualBitmap, TRectF.Create(0, 0, FDragVisualBitmap.Width, FDragVisualBitmap.Height), DragRect, 0.7);
end;
@@ -217,14 +279,6 @@ begin
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;
@@ -235,33 +289,44 @@ procedure TWorkspace.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: S
var
WorldP: TPointF;
Hit: TVisualNode;
HitTestP: TPointF;
begin
inherited;
if CanFocus then
SetFocus;
WorldP := ScreenToWorld(LocalToScreen(TPointF.Create(X, Y)));
// Convert local mouse pos (pixel) to world pos
WorldP := LocalToWorld(TPointF.Create(X, Y));
if (Button in [TMouseButton.mbLeft, TMouseButton.mbMiddle]) and (ssCtrl in Shift) then
// Panning Start
if (Button = TMouseButton.mbMiddle) or ((Button = TMouseButton.mbLeft) and (ssCtrl in Shift)) then
begin
FIsPanning := True;
FLastMousePos := TPointF.Create(X, Y);
FLastMousePos := TPointF.Create(X, Y); // Keep raw pixel for delta
Root.Captured := Self;
Exit;
end;
if Assigned(FRootNode) then
begin
Hit := FRootNode.HitTest(WorldP);
// --- HIT TEST FIX ---
// HitTest expects coordinates relative to the Node's Local Origin (0,0).
// The RootNode is drawn at FRootNode.Position in World Space.
// So we transform: WorldMouse - NodePosition
HitTestP := WorldP - FRootNode.Position;
Hit := FRootNode.HitTest(HitTestP);
if Assigned(Hit) then
begin
FCapturedNode := Hit;
// Propagate: Convert WorldP to the Node's internal coordinate system
var NodeLocal := Hit.AbsoluteToLocal(WorldP);
Hit.MouseDown(Button, Shift, NodeLocal.X, NodeLocal.Y);
end
else if Button = TMouseButton.mbLeft then
begin
// Clicked background -> Pan
FIsPanning := True;
FLastMousePos := TPointF.Create(X, Y);
Root.Captured := Self;
@@ -273,12 +338,13 @@ procedure TWorkspace.MouseMove(Shift: TShiftState; X, Y: Single);
var
WorldP: TPointF;
LocalP: TPointF;
HitTestP: TPointF;
Hit: TVisualNode;
Delta: TPointF;
begin
inherited;
LocalP := TPointF.Create(X, Y);
WorldP := ScreenToWorld(LocalToScreen(LocalP));
WorldP := LocalToWorld(LocalP);
if FIsDraggingNode then
begin
@@ -288,6 +354,7 @@ begin
end
else if FIsPanning then
begin
// Pan logic works in Screen Pixels (1:1 mouse movement)
Delta := LocalP - FLastMousePos;
FContentOffset := FContentOffset + Delta;
FLastMousePos := LocalP;
@@ -295,6 +362,7 @@ begin
end
else
begin
// Propagate to Captured Node
if Assigned(FCapturedNode) then
begin
var NodeLocal := FCapturedNode.AbsoluteToLocal(WorldP);
@@ -302,12 +370,19 @@ begin
end
else if Assigned(FRootNode) then
begin
Hit := FRootNode.HitTest(WorldP);
// Handle Hover
// --- HIT TEST FIX ---
HitTestP := WorldP - FRootNode.Position;
Hit := FRootNode.HitTest(HitTestP);
if Hit <> FMouseOverNode then
begin
if Assigned(FMouseOverNode) then
FMouseOverNode.MouseLeave;
FMouseOverNode := Hit;
if Assigned(FMouseOverNode) then
FMouseOverNode.MouseEnter;
end;
@@ -326,7 +401,7 @@ var
WorldP: TPointF;
begin
inherited;
WorldP := ScreenToWorld(LocalToScreen(TPointF.Create(X, Y)));
WorldP := LocalToWorld(TPointF.Create(X, Y));
if FIsDraggingNode then
begin
@@ -348,7 +423,7 @@ end;
procedure TWorkspace.MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
var
OldZoom: Single;
LocalP, OffsetLocal: TPointF;
LocalP, WorldBefore, OffsetNew: TPointF;
begin
OldZoom := FZoom;
@@ -357,11 +432,20 @@ begin
else
SetZoom(FZoom - ZoomStep);
// Zoom-To-Mouse Logic
if not SameValue(OldZoom, FZoom, TEpsilon.Position) then
begin
// 1. Where was the mouse pointing in World Space BEFORE zoom?
LocalP := ScreenToLocal(Screen.MousePos);
OffsetLocal := LocalP - FContentOffset;
FContentOffset := LocalP - (OffsetLocal * (FZoom / OldZoom));
WorldBefore := (LocalP - FContentOffset) / OldZoom;
// 2. We want WorldBefore to be at LocalP AFTER zoom.
// LocalP = (WorldBefore * NewZoom) + NewOffset
// NewOffset = LocalP - (WorldBefore * NewZoom)
OffsetNew := LocalP - (WorldBefore * FZoom);
FContentOffset := OffsetNew;
Repaint;
end;
Handled := True;
@@ -370,7 +454,7 @@ end;
procedure TWorkspace.BeginDragNode(ASource: TVisualNode);
var
Bitmap: TBitmap;
Scale: Single;
ScaleFactor: Single;
begin
if FIsDraggingNode or FIsPanning then
Exit;
@@ -381,9 +465,10 @@ begin
FDragSource := ASource;
Root.Captured := Self;
Scale := Scene.GetSceneScale;
Bitmap := TBitmap.Create(Round(ASource.Size.Width * Scale), Round(ASource.Size.Height * Scale));
Bitmap.BitmapScale := Scale;
// Snapshot creation
ScaleFactor := Scene.GetSceneScale;
Bitmap := TBitmap.Create(Round(ASource.Size.Width * ScaleFactor), Round(ASource.Size.Height * ScaleFactor));
Bitmap.BitmapScale := ScaleFactor;
if Bitmap.Canvas.BeginScene then
try
@@ -414,6 +499,7 @@ var
Child: TVisualNode;
P1, P2: TPointF;
AbsP: TPointF;
HitTestP: TPointF;
begin
FShowDropMarker := False;
FCurrentDropTarget := nil;
@@ -422,7 +508,15 @@ begin
if FDragSource = nil then
Exit;
Hit := FRootNode.HitTest(WorldPos);
if Assigned(FRootNode) then
begin
// Fix HitTest for Root Offset
HitTestP := WorldPos - FRootNode.Position;
Hit := FRootNode.HitTest(HitTestP);
end
else
Hit := nil;
if Hit = nil then
Exit;
@@ -443,6 +537,7 @@ begin
InsertIndex := TargetContainer.GetInsertionIndex(TargetLocal);
FCurrentDropIndex := InsertIndex;
// Marker Geometry Calculation
if InsertIndex < TargetContainer.GetChildCount then
begin
Child := TargetContainer.GetChild(InsertIndex);
Src/AST/Myc.Fmx.AstEditor.pas
+262 -4
View File
@@ -524,19 +524,83 @@ end;
procedure TAstEditor.EnsureVisible(Node: TAstViewNode);
const
cMargin = 40;
cMargin = 20; // Margin to the screen edge
var
NodeRect: TRectF;
VisibleWorldRect: TRectF;
NewOffset: TPointF;
ViewW, ViewH: Single;
begin
if (Node = nil) or (FWorkspace = nil) then
Exit;
// 1. Get node coordinates in world space and add margin
NodeRect := Node.AbsoluteRect;
NodeRect.Inflate(cMargin, cMargin);
var ScreenCenter := TRectF.Create(0, 0, FWorkspace.Width, FWorkspace.Height).CenterPoint;
var NodeCenterWorld := NodeRect.CenterPoint;
// Safety check for zoom to avoid division by zero
if FWorkspace.Zoom < 0.001 then
Exit;
FWorkspace.ContentOffset := ScreenCenter - (NodeCenterWorld * FWorkspace.Zoom);
// 2. Calculate the currently visible area in world space
// Formula: WorldPoint = (ScreenPoint - ContentOffset) / Zoom
// TopLeft (0,0) corresponds to -ContentOffset / Zoom.
ViewW := FWorkspace.Width / FWorkspace.Zoom;
ViewH := FWorkspace.Height / FWorkspace.Zoom;
VisibleWorldRect := TRectF.Create(-FWorkspace.ContentOffset.X / FWorkspace.Zoom, -FWorkspace.ContentOffset.Y / FWorkspace.Zoom, 0, 0);
VisibleWorldRect.Width := ViewW;
VisibleWorldRect.Height := ViewH;
// 3. Check if the node is already fully visible
// Contains checks Left, Top, Right and Bottom boundaries.
if VisibleWorldRect.Contains(NodeRect) then
Exit;
// 4. Calculate new offset (Minimum Movement Strategy)
NewOffset := FWorkspace.ContentOffset;
// --- Horizontal Adjustment (X) ---
if NodeRect.Width > ViewW then
begin
// Special case: Node is wider than the screen -> Align Left
NewOffset.X := -(NodeRect.Left * FWorkspace.Zoom);
end
else if NodeRect.Left < VisibleWorldRect.Left then
begin
// Cut off on the left -> Move viewport to the left (Align Left)
NewOffset.X := -(NodeRect.Left * FWorkspace.Zoom);
end
else if NodeRect.Right > VisibleWorldRect.Right then
begin
// Cut off on the right -> Move viewport to the right (Align Right edge)
// Desired equation: (NodeRect.Right * Zoom) + NewOffset = Workspace.Width
NewOffset.X := -((NodeRect.Right - ViewW) * FWorkspace.Zoom);
end;
// --- Vertical Adjustment (Y) ---
if NodeRect.Height > ViewH then
begin
// Special case: Node is taller than the screen -> Align Top
NewOffset.Y := -(NodeRect.Top * FWorkspace.Zoom);
end
else if NodeRect.Top < VisibleWorldRect.Top then
begin
// Cut off at the top -> Move viewport up (Align Top)
NewOffset.Y := -(NodeRect.Top * FWorkspace.Zoom);
end
else if NodeRect.Bottom > VisibleWorldRect.Bottom then
begin
// Cut off at the bottom -> Move viewport down (Align Bottom edge)
NewOffset.Y := -((NodeRect.Bottom - ViewH) * FWorkspace.Zoom);
end;
// 5. Only update if changed (avoids unnecessary repaints)
if not (SameValue(NewOffset.X, FWorkspace.ContentOffset.X, TEpsilon.Position)
and SameValue(NewOffset.Y, FWorkspace.ContentOffset.Y, TEpsilon.Position)) then
begin
FWorkspace.ContentOffset := NewOffset;
end;
end;
function TAstEditor.GetNextLinearNode(StartNode: TAstViewNode): TAstViewNode;
@@ -602,17 +666,211 @@ begin
end;
function TAstEditor.GetPrevLinearNode(StartNode: TAstViewNode): TAstViewNode;
// Helper: Finds the visually last AST node in a subtree (bottom-right most)
function FindLast(Node: TVisualNode): TAstViewNode;
var
i: Integer;
begin
// Iterate children backwards (last to first)
for i := Node.GetChildCount - 1 downto 0 do
begin
Result := FindLast(Node.GetChild(i));
if Result <> nil then
Exit;
end;
// If no child yielded a result, check the node itself
if Node is TAstViewNode then
Result := TAstViewNode(Node)
else
Result := nil;
end;
var
Current, Parent: TVisualNode;
i, Idx: Integer;
SiblingResult: TAstViewNode;
begin
Result := nil;
Current := StartNode;
// Traverse up the tree
while Current.Parent <> nil do
begin
Parent := Current.Parent;
Idx := -1;
// 1. Find index of Current node in Parent
for i := 0 to Parent.GetChildCount - 1 do
begin
if Parent.GetChild(i) = Current then
begin
Idx := i;
Break;
end;
end;
// 2. Check siblings to the left (reverse order)
if Idx > 0 then
begin
for i := Idx - 1 downto 0 do
begin
// Dig deep into the sibling to find the last visible node
SiblingResult := FindLast(Parent.GetChild(i));
if SiblingResult <> nil then
Exit(SiblingResult);
end;
end;
// 3. No predecessor in siblings? Then the Parent is the predecessor
if Parent is TAstViewNode then
Exit(TAstViewNode(Parent));
// 4. If Parent is just a layout container, move further up
Current := Parent;
end;
end;
function TAstEditor.GetNextVerticalNeighbor(StartNode: TAstViewNode): TAstViewNode;
// Helper: Finds the first valid AST node within a visual subtree.
// This ensures that if we jump to a container, we focus its first content.
function FindFirstAstNode(Node: TVisualNode): TAstViewNode;
begin
if Node is TAstViewNode then
Exit(TAstViewNode(Node));
for var i := 0 to Node.GetChildCount - 1 do
begin
Result := FindFirstAstNode(Node.GetChild(i));
if Result <> nil then
Exit;
end;
Result := nil;
end;
var
Current, Parent: TVisualNode;
LayoutParent: TAutoFitLayout;
i, Idx: Integer;
Sibling: TVisualNode;
begin
Current := StartNode;
// 1. Search up the hierarchy for the nearest vertical list with a successor
while Current.Parent <> nil do
begin
Parent := Current.Parent;
// We are only interested if the parent controls layout (TAutoFitLayout or TAstViewNode)
if Parent is TAutoFitLayout then
begin
LayoutParent := TAutoFitLayout(Parent);
// Check if this container arranges its children vertically
if LayoutParent.Orientation = TLayoutOrientation.loVertical then
begin
// Find the index of the child path we just came from
Idx := -1;
for i := 0 to Parent.GetChildCount - 1 do
begin
if Parent.GetChild(i) = Current then
begin
Idx := i;
Break;
end;
end;
// Check if there is a next sibling in this vertical list
if (Idx >= 0) and (Idx < Parent.GetChildCount - 1) then
begin
Sibling := Parent.GetChild(Idx + 1);
// Found a vertical neighbor! Now get the actual node inside it.
Result := FindFirstAstNode(Sibling);
if Result <> nil then
Exit;
end;
end;
end;
// Move up to the next parent
Current := Parent;
end;
// 2. Fallback: If no vertical sibling found in hierarchy, behave like Cursor Right
Result := GetNextLinearNode(StartNode);
end;
function TAstEditor.GetPrevVerticalNeighbor(StartNode: TAstViewNode): TAstViewNode;
// Helper: Finds the first valid AST node within a visual subtree.
// (Identical to the helper in GetNextVerticalNeighbor)
function FindFirstAstNode(Node: TVisualNode): TAstViewNode;
begin
if Node is TAstViewNode then
Exit(TAstViewNode(Node));
for var i := 0 to Node.GetChildCount - 1 do
begin
Result := FindFirstAstNode(Node.GetChild(i));
if Result <> nil then
Exit;
end;
Result := nil;
end;
var
Current, Parent: TVisualNode;
LayoutParent: TAutoFitLayout;
i, Idx: Integer;
Sibling: TVisualNode;
begin
Current := StartNode;
// 1. Search up the hierarchy for the nearest vertical list with a predecessor
while Current.Parent <> nil do
begin
Parent := Current.Parent;
if Parent is TAutoFitLayout then
begin
LayoutParent := TAutoFitLayout(Parent);
// Check if this container arranges its children vertically
if LayoutParent.Orientation = TLayoutOrientation.loVertical then
begin
// Find index of current child path
Idx := -1;
for i := 0 to Parent.GetChildCount - 1 do
begin
if Parent.GetChild(i) = Current then
begin
Idx := i;
Break;
end;
end;
// Check if there is a PREVIOUS sibling (Idx - 1)
if Idx > 0 then
begin
Sibling := Parent.GetChild(Idx - 1);
// Found a vertical neighbor above!
// Dive into it to find its FIRST element (jumping to the start of the block)
Result := FindFirstAstNode(Sibling);
if Result <> nil then
Exit;
end;
end;
end;
// Move up to next parent
Current := Parent;
end;
// 2. Fallback: If no vertical sibling found, behave like Cursor Left
Result := GetPrevLinearNode(StartNode);
end;