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 17:32:04 +01:00
parent 9ed563bcc1
commit e40f56eaeb
10 changed files with 1629 additions and 1439 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/AST/Myc.Fmx.AstEditor.pas
+139 -425
View File
@@ -21,9 +21,10 @@ uses
Myc.Ast.Scope,
Myc.Ast.Environment,
Myc.Ast.Refactoring.Remove,
Myc.Fmx.AstEditor.Render,
Myc.Fmx.AstEditor.Node,
Myc.Fmx.AstEditor.Layout,
Myc.Fmx.AstEditor.Workspace;
Myc.Fmx.AstEditor.Workspace,
Myc.Fmx.AstEditor.Visualizer;
type
TAstEditor = class(TControl)
@@ -49,37 +50,29 @@ type
FRootViewNode: TAstViewNode;
FFocusedNode: TAstViewNode;
// State Tracking
FCurrentAst: IAstNode;
// Undo/Redo Stacks
FUndoStack: TUndoStack;
FRedoStack: TUndoStack;
FIsUndoing: Boolean;
// Events
FOnPaintConnections: TOnPaintConnectionsEvent;
FOnWorkspaceMouseDown: TMouseEvent;
procedure CollectNodes(Parent: TControl);
procedure CollectNodes(Parent: TVisualNode);
procedure ClearVisuals;
procedure ApplyErrors(const Log: ICompilerLog);
procedure ApplyTypes(const TypedAst: IAstNode);
procedure RootResized(Sender: TObject);
// Internal Event Wiring
procedure HandleNodeDragDrop(ASource, ATarget: TControl; AIndex: Integer);
procedure HandleNodeDragDrop(ASource, ATarget: TVisualNode; AIndex: Integer);
procedure HandleKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState);
procedure HandleWorkspacePaintConnections(ASender: TObject; ACanvas: TCanvas);
procedure HandleWorkspaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
procedure HandleNodeMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
procedure CommitSnapshot;
// --- Navigation Helper ---
procedure EnsureVisible(Node: TAstViewNode);
function GetParentNode(StartNode: TAstViewNode): TAstViewNode;
function GetFirstChild(StartNode: TAstViewNode): TAstViewNode;
function GetNextVerticalNeighbor(StartNode: TAstViewNode): TAstViewNode;
function GetPrevVerticalNeighbor(StartNode: TAstViewNode): TAstViewNode;
function GetNextLinearNode(StartNode: TAstViewNode): TAstViewNode;
@@ -88,18 +81,16 @@ type
procedure SetOnPaintConnections(const Value: TOnPaintConnectionsEvent);
protected
procedure Paint; override; // For design-time border
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
// Must be called after creation to link the AST Environment
procedure Init(const AEnv: TAstEnvironment);
procedure ValidateAndShow;
// AClearHistory=False ensures stacks are kept (e.g. after internal edits)
procedure SetRoot(const AstNode: IAstNode; AClearHistory: Boolean = True);
procedure Undo;
@@ -123,7 +114,6 @@ type
property Enabled;
property Opacity;
// Expose events relevant to the outside world
property OnPaintConnections: TOnPaintConnectionsEvent read FOnPaintConnections write SetOnPaintConnections;
property OnMouseDown: TMouseEvent read FOnWorkspaceMouseDown write FOnWorkspaceMouseDown;
end;
@@ -131,8 +121,7 @@ type
implementation
uses
Myc.Data.Value,
Myc.Fmx.AstEditor.Visualizer;
Myc.Data.Value;
{ TAstEditor }
@@ -143,14 +132,12 @@ begin
Height := 300;
ClipChildren := True;
// Create Internal Workspace
FWorkspace := TWorkspace.Create(Self);
FWorkspace.Parent := Self;
FWorkspace.Align := TAlignLayout.Client;
FWorkspace.Stored := False;
FWorkspace.Locked := True;
// Wire Internal Events
FWorkspace.OnNodeDragDrop := HandleNodeDragDrop;
FWorkspace.OnKeyDown := HandleKeyDown;
FWorkspace.OnPaintConnections := HandleWorkspacePaintConnections;
@@ -205,21 +192,18 @@ begin
if FWorkspace.CanFocus then
FWorkspace.SetFocus;
var WorldP := FWorkspace.ScreenToWorld(FWorkspace.LocalToScreen(TPointF.Create(X, Y)));
var Hit := FWorkspace.RootNode.HitTest(WorldP);
if (Button = TMouseButton.mbLeft) and (Hit is TAstViewNode) then
begin
SetFocusedNode(TAstViewNode(Hit));
end;
if Assigned(FOnWorkspaceMouseDown) then
FOnWorkspaceMouseDown(Self, Button, Shift, X, Y);
end;
procedure TAstEditor.HandleNodeMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
if FWorkspace.CanFocus then
FWorkspace.SetFocus;
if (Button = TMouseButton.mbLeft) and (Sender is TAstViewNode) then
begin
SetFocusedNode(TAstViewNode(Sender));
end;
end;
procedure TAstEditor.CommitSnapshot;
begin
if Assigned(FCurrentAst) and (not FIsUndoing) then
@@ -242,7 +226,7 @@ begin
FRedoStack.Push(FCurrentAst);
prevAst := FUndoStack.Pop;
SetRoot(prevAst); // Default Clear=True, but guarded by FIsUndoing
SetRoot(prevAst);
finally
FIsUndoing := False;
end;
@@ -277,56 +261,49 @@ begin
Result := FRedoStack.Count > 0;
end;
procedure TAstEditor.HandleNodeDragDrop(ASource, ATarget: TControl; AIndex: Integer);
procedure TAstEditor.HandleNodeDragDrop(ASource, ATarget: TVisualNode; AIndex: Integer);
var
SourceParent: TControl;
SourceView, TargetView: TAstViewNode;
ContainerOwner: TAstViewNode;
Reorderable: IReorderable;
SourceIdx, TargetIdx: Integer;
SourceIdx: Integer;
NewAst: IAstNode;
begin
if (ASource = nil) or (AIndex < 0) then
exit;
if not (ASource is TAstViewNode) then
exit;
if not (ASource.Parent is TControl) then
if not (ATarget is TAstViewNode) then
exit;
SourceParent := TControl(ASource.Parent);
ContainerOwner := nil;
SourceView := TAstViewNode(ASource);
TargetView := TAstViewNode(ATarget);
ContainerOwner := TargetView;
if (SourceParent is TAstViewNode) then
if not Supports(ContainerOwner.Handler, IReorderable, Reorderable) then
exit;
if Reorderable.CanDrag(SourceView) and (SourceView.Parent = TargetView) then
begin
ContainerOwner := TAstViewNode(SourceParent);
if not Supports(ContainerOwner.Handler, IReorderable, Reorderable) then
ContainerOwner := nil;
end;
if (ContainerOwner = nil) and (SourceParent.Parent is TAstViewNode) then
begin
ContainerOwner := TAstViewNode(SourceParent.Parent);
if not Supports(ContainerOwner.Handler, IReorderable, Reorderable) then
ContainerOwner := nil;
end;
if (ContainerOwner <> nil) and (Reorderable <> nil) then
begin
if Reorderable.CanDrag(ASource) then
// Find current index of SourceView in Target
SourceIdx := -1;
for var i := 0 to TargetView.GetChildCount - 1 do
begin
SourceIdx := ASource.Index;
TargetIdx := AIndex;
if SourceIdx <> TargetIdx then
if TargetView.GetChild(i) = SourceView then
begin
CommitSnapshot;
Reorderable.MoveChild(SourceIdx, TargetIdx);
NewAst := FRootViewNode.CreateAst;
// IMPORTANT: Pass False to preserve the undo stack we just updated
SetRoot(NewAst, False);
SourceIdx := i;
Break;
end;
end;
if SourceIdx >= 0 then
begin
CommitSnapshot;
Reorderable.MoveChild(SourceIdx, AIndex);
NewAst := FRootViewNode.CreateAst;
SetRoot(NewAst, False);
end;
end;
end;
@@ -334,7 +311,7 @@ procedure TAstEditor.HandleKeyDown(Sender: TObject; var Key: Word; var KeyChar:
var
NewRoot: IAstNode;
begin
// Undo / Redo Handling
// Undo / Redo
if (ssCtrl in Shift) then
begin
if (Key = vkZ) then
@@ -361,7 +338,7 @@ begin
end;
end;
// Delete Handling
// Delete
if (Key = vkDelete) then
begin
if Assigned(FFocusedNode) and Assigned(FFocusedNode.Node) and Assigned(FCurrentAst) then
@@ -369,7 +346,6 @@ begin
CommitSnapshot;
if TAstNodeRemover.TryRemove(FCurrentAst, FFocusedNode.Node, NewRoot) then
begin
// IMPORTANT: Pass False to preserve the undo stack we just updated
SetRoot(NewRoot, False);
end;
end;
@@ -391,7 +367,6 @@ var
begin
FCurrentAst := AstNode;
// Only clear if explicitly requested AND not currently performing an undo/redo
if AClearHistory and (not FIsUndoing) then
begin
FUndoStack.Clear;
@@ -399,55 +374,47 @@ begin
end;
FFocusedNode := nil;
FWorkspace.RootNode := nil;
FWorkspace.World.DeleteChildren;
if Assigned(FRootViewNode) then
FRootViewNode.OnResized := nil;
FRootViewNode := nil;
FRootViewNode := nil;
if not Assigned(AstNode) then
exit;
Visualizer := TAstVisualizer.Create(FWorkspace, FWorkspace.World, 0);
Visualizer := TAstVisualizer.Create(FWorkspace, nil, 0);
FRootViewNode := Visualizer.CallAccept(AstNode);
if Assigned(FRootViewNode) then
begin
FWorkspace.World.Size := FRootViewNode.Size;
FRootViewNode.OnResized := RootResized;
FRootViewNode.Position.Point := TPointF.Create(50, 50);
end;
if Assigned(FRootViewNode) then
FWorkspace.RootNode := FRootViewNode;
FRootViewNode.Position := TPointF.Create(50, 50);
ValidateAndShow;
end;
end;
procedure TAstEditor.CollectNodes(Parent: TControl);
procedure TAstEditor.CollectNodes(Parent: TVisualNode);
var
i: Integer;
child: TControl;
child: TVisualNode;
viewNode: TAstViewNode;
begin
for i := 0 to Parent.ChildrenCount - 1 do
for i := 0 to Parent.GetChildCount - 1 do
begin
if Parent.Children[i] is TControl then
child := Parent.GetChild(i);
if child is TAstViewNode then
begin
child := TControl(Parent.Children[i]);
viewNode := TAstViewNode(child);
if child is TAstViewNode then
if Assigned(viewNode.Node) and Assigned(viewNode.Node.Identity) then
begin
viewNode := TAstViewNode(child);
viewNode.OnMouseDown := HandleNodeMouseDown;
if Assigned(viewNode.Node) and Assigned(viewNode.Node.Identity) then
begin
FNodeMap.AddOrSetValue(viewNode.Node.Identity, viewNode);
end;
FNodeMap.AddOrSetValue(viewNode.Node.Identity, viewNode);
end;
if child.ChildrenCount > 0 then
CollectNodes(child);
end;
if child.GetChildCount > 0 then
CollectNodes(child);
end;
end;
@@ -495,11 +462,6 @@ begin
end;
end;
procedure TAstEditor.RootResized(Sender: TObject);
begin
FWorkspace.World.Size := FRootViewNode.Size;
end;
procedure TAstEditor.ValidateAndShow;
var
logicalAst: IAstNode;
@@ -510,7 +472,7 @@ begin
logicalAst := FRootViewNode.CreateAst;
FNodeMap.Clear;
CollectNodes(FWorkspace.World);
CollectNodes(FWorkspace.RootNode);
ClearVisuals;
@@ -527,6 +489,9 @@ begin
var compiled := FEnv.Link(specAst.AsLambdaExpression, log);
ApplyErrors(log);
FWorkspace.RootNode.RecalcLayout;
FWorkspace.InvalidateConnections;
except
on E: ECompilationFailed do
begin
@@ -537,13 +502,9 @@ begin
end;
end;
FWorkspace.World.Repaint;
FWorkspace.RequestLayout;
end;
// =================================================================================================
// == NAVIGATION IMPLEMENTATION
// =================================================================================================
procedure TAstEditor.SetFocusedNode(Node: TAstViewNode);
begin
if FFocusedNode = Node then
@@ -565,338 +526,96 @@ procedure TAstEditor.EnsureVisible(Node: TAstViewNode);
const
cMargin = 40;
var
NodeRect, ViewRect: TRectF;
Delta: TPointF;
NodeRect: TRectF;
begin
if (Node = nil) or (FWorkspace = nil) then
Exit;
NodeRect := Node.AbsoluteRect;
ViewRect := FWorkspace.AbsoluteRect;
ViewRect.Inflate(-cMargin, -cMargin);
Delta := TPointF.Zero;
var ScreenCenter := TRectF.Create(0, 0, FWorkspace.Width, FWorkspace.Height).CenterPoint;
var NodeCenterWorld := NodeRect.CenterPoint;
if NodeRect.Width > ViewRect.Width then
Delta.X := ViewRect.CenterPoint.X - NodeRect.CenterPoint.X
else if NodeRect.Left < ViewRect.Left then
Delta.X := ViewRect.Left - NodeRect.Left
else if NodeRect.Right > ViewRect.Right then
Delta.X := ViewRect.Right - NodeRect.Right;
if NodeRect.Height > ViewRect.Height then
Delta.Y := ViewRect.CenterPoint.Y - NodeRect.CenterPoint.Y
else if NodeRect.Top < ViewRect.Top then
Delta.Y := ViewRect.Top - NodeRect.Top
else if NodeRect.Bottom > ViewRect.Bottom then
Delta.Y := ViewRect.Bottom - NodeRect.Bottom;
if not (SameValue(Delta.X, 0, TEpsilon.Position) and SameValue(Delta.Y, 0, TEpsilon.Position)) then
begin
FWorkspace.ContentOffset := FWorkspace.ContentOffset + Delta;
end;
end;
function TAstEditor.GetParentNode(StartNode: TAstViewNode): TAstViewNode;
var
curr: TControl;
begin
Result := nil;
if StartNode = nil then
Exit;
curr := StartNode.ParentControl;
while (curr <> nil) and (curr <> FWorkspace.World) do
begin
if curr is TAstViewNode then
Exit(TAstViewNode(curr));
curr := curr.ParentControl;
end;
end;
function TAstEditor.GetFirstChild(StartNode: TAstViewNode): TAstViewNode;
function FindFirst(Parent: TControl): TAstViewNode;
var
i: Integer;
begin
Result := nil;
for i := 0 to Parent.ChildrenCount - 1 do
begin
if Parent.Children[i] is TAstViewNode then
Exit(TAstViewNode(Parent.Children[i]))
else if (Parent.Children[i] is TControl) and (TControl(Parent.Children[i]).ChildrenCount > 0) then
begin
Result := FindFirst(TControl(Parent.Children[i]));
if Result <> nil then
Exit;
end;
end;
end;
begin
Result := FindFirst(StartNode);
end;
function FindFirstViewNode(Container: TControl): TAstViewNode;
var
i: Integer;
Child: TControl;
begin
Result := nil;
if Container is TAstViewNode then
Exit(TAstViewNode(Container));
for i := 0 to Container.ChildrenCount - 1 do
begin
if Container.Children[i] is TControl then
begin
Child := TControl(Container.Children[i]);
if Child.Visible then
begin
Result := FindFirstViewNode(Child);
if Result <> nil then
Exit;
end;
end;
end;
end;
function FindLastViewNode(Container: TControl): TAstViewNode;
var
i: Integer;
Child: TControl;
begin
Result := nil;
if Container is TAstViewNode then
exit(TAstViewNode(Container));
for i := Container.ChildrenCount - 1 downto 0 do
begin
if Container.Children[i] is TControl then
begin
Child := TControl(Container.Children[i]);
if Child.Visible then
begin
var Found := FindLastViewNode(Child);
if Found <> nil then
Exit(Found);
end;
end;
end;
end;
function FindNextSiblingInList(Parent: TControl; AfterControl: TControl): TAstViewNode;
var
i, StartIndex: Integer;
Candidate: TControl;
begin
Result := nil;
StartIndex := -1;
for i := 0 to Parent.ChildrenCount - 1 do
if Parent.Children[i] = AfterControl then
begin
StartIndex := i;
Break;
end;
if StartIndex >= 0 then
begin
for i := StartIndex + 1 to Parent.ChildrenCount - 1 do
begin
if Parent.Children[i] is TControl then
begin
Candidate := TControl(Parent.Children[i]);
if Candidate.Visible then
begin
Result := FindFirstViewNode(Candidate);
if Result <> nil then
Exit;
end;
end;
end;
end;
end;
function FindPrevSiblingInList(Parent: TControl; BeforeControl: TControl): TAstViewNode;
var
i, StartIndex: Integer;
Candidate: TControl;
begin
Result := nil;
StartIndex := -1;
for i := 0 to Parent.ChildrenCount - 1 do
if Parent.Children[i] = BeforeControl then
begin
StartIndex := i;
Break;
end;
if StartIndex >= 0 then
begin
for i := StartIndex - 1 downto 0 do
begin
if Parent.Children[i] is TControl then
begin
Candidate := TControl(Parent.Children[i]);
if Candidate.Visible then
begin
Result := FindLastViewNode(Candidate);
if Result <> nil then
Exit;
end;
end;
end;
end;
end;
function TAstEditor.GetNextVerticalNeighbor(StartNode: TAstViewNode): TAstViewNode;
var
Current, Parent: TControl;
begin
Result := nil;
Current := StartNode;
while (Current <> nil) and (Current <> FWorkspace.World) do
begin
Parent := Current.ParentControl;
if Parent = nil then
Break;
if (Parent is TAutoFitControl) and (TAutoFitControl(Parent).Orientation = TLayoutOrientation.loVertical) then
begin
Result := FindNextSiblingInList(Parent, Current);
if Result <> nil then
Exit;
end;
Current := Parent;
end;
if Result = nil then
Result := GetNextLinearNode(StartNode)
end;
function TAstEditor.GetPrevVerticalNeighbor(StartNode: TAstViewNode): TAstViewNode;
var
Current, Parent: TControl;
begin
Result := nil;
Current := StartNode;
while (Current <> nil) and (Current <> FWorkspace.World) do
begin
Parent := Current.ParentControl;
if Parent = nil then
Break;
if (Parent is TAutoFitControl) and (TAutoFitControl(Parent).Orientation = TLayoutOrientation.loVertical) then
begin
Result := FindPrevSiblingInList(Parent, Current);
if Result <> nil then
Exit;
end;
Current := Parent;
end;
if Result = nil then
Result := GetPrevLinearNode(StartNode)
FWorkspace.ContentOffset := ScreenCenter - (NodeCenterWorld * FWorkspace.Zoom);
end;
function TAstEditor.GetNextLinearNode(StartNode: TAstViewNode): TAstViewNode;
var
CurrentControl, ParentControl: TControl;
i, StartIndex: Integer;
Candidate: TControl;
begin
Result := GetFirstChild(StartNode);
if Result <> nil then
Exit;
CurrentControl := StartNode;
while (CurrentControl <> nil) and (CurrentControl <> FWorkspace.World) do
function FindFirst(Node: TVisualNode): TAstViewNode;
begin
ParentControl := CurrentControl.ParentControl;
if ParentControl = nil then
Break;
StartIndex := -1;
for i := 0 to ParentControl.ChildrenCount - 1 do
if ParentControl.Children[i] = CurrentControl then
begin
StartIndex := i;
Break;
end;
if StartIndex >= 0 then
if Node is TAstViewNode then
Exit(TAstViewNode(Node));
for var i := 0 to Node.GetChildCount - 1 do
begin
for i := StartIndex + 1 to ParentControl.ChildrenCount - 1 do
begin
if ParentControl.Children[i] is TControl then
begin
Candidate := TControl(ParentControl.Children[i]);
if Candidate.Visible then
begin
Result := FindFirstViewNode(Candidate);
if Result <> nil then
Exit;
end;
end;
end;
Result := FindFirst(Node.GetChild(i));
if Result <> nil then
Exit;
end;
CurrentControl := ParentControl;
Result := nil;
end;
Result := nil;
function FindNext(Node: TVisualNode): TAstViewNode;
var
Parent: TVisualNode;
Idx: Integer;
begin
Result := nil;
if Node.GetChildCount > 0 then
begin
Result := FindFirst(Node.GetChild(0));
if Result <> nil then
Exit;
end;
Parent := Node.Parent;
while Parent <> nil do
begin
Idx := -1;
for var k := 0 to Parent.GetChildCount - 1 do
if Parent.GetChild(k) = Node then
begin
Idx := k;
break;
end;
if (Idx >= 0) and (Idx < Parent.GetChildCount - 1) then
begin
for var k := Idx + 1 to Parent.GetChildCount - 1 do
begin
Result := FindFirst(Parent.GetChild(k));
if Result <> nil then
Exit;
end;
end;
Node := Parent;
Parent := Node.Parent;
end;
end;
begin
for var i := 0 to StartNode.GetChildCount - 1 do
begin
Result := FindFirst(StartNode.GetChild(i));
if Result <> nil then
Exit;
end;
Result := FindNext(StartNode);
end;
function TAstEditor.GetPrevLinearNode(StartNode: TAstViewNode): TAstViewNode;
var
CurrentControl, ParentControl: TControl;
i, StartIndex: Integer;
Candidate: TControl;
begin
CurrentControl := StartNode;
while (CurrentControl <> nil) and (CurrentControl <> FWorkspace.World) do
begin
ParentControl := CurrentControl.ParentControl;
if ParentControl = nil then
Break;
StartIndex := -1;
for i := 0 to ParentControl.ChildrenCount - 1 do
if ParentControl.Children[i] = CurrentControl then
begin
StartIndex := i;
Break;
end;
if StartIndex >= 0 then
begin
for i := StartIndex - 1 downto 0 do
begin
if ParentControl.Children[i] is TControl then
begin
Candidate := TControl(ParentControl.Children[i]);
if Candidate.Visible then
begin
Result := FindLastViewNode(Candidate);
if Result <> nil then
Exit;
end;
end;
end;
end;
if ParentControl is TAstViewNode then
Exit(TAstViewNode(ParentControl));
CurrentControl := ParentControl;
end;
Result := nil;
end;
function TAstEditor.GetNextVerticalNeighbor(StartNode: TAstViewNode): TAstViewNode;
begin
Result := GetNextLinearNode(StartNode);
end;
function TAstEditor.GetPrevVerticalNeighbor(StartNode: TAstViewNode): TAstViewNode;
begin
Result := GetPrevLinearNode(StartNode);
end;
procedure TAstEditor.Navigate(Key: Word; Shift: TShiftState);
var
Current: TAstViewNode;
@@ -923,19 +642,14 @@ begin
Exit;
end;
if Key = vkEscape then
begin
Target := GetParentNode(Current);
if Target <> nil then
SetFocusedNode(Target);
Exit;
end;
case Key of
vkLeft: Target := GetPrevLinearNode(Current);
vkRight: Target := GetNextLinearNode(Current);
vkUp: Target := GetPrevVerticalNeighbor(Current);
vkDown: Target := GetNextVerticalNeighbor(Current);
vkEscape:
if Current.Parent is TAstViewNode then
Target := TAstViewNode(Current.Parent);
end;
if Target <> nil then