Visual AST editing with drag'n'drop 1s Version

This commit is contained in:
Michael Schimmel
2025-11-30 16:00:00 +01:00
parent cd0f2ffde3
commit 438baa3609
10 changed files with 917 additions and 565 deletions
+108 -35
View File
@@ -6,7 +6,9 @@ uses
System.SysUtils,
System.Classes,
System.Types,
System.Math.Vectors,
System.Generics.Collections,
FMX.Types,
FMX.Controls,
Myc.Ast,
Myc.Ast.Nodes,
@@ -24,13 +26,11 @@ type
type
TNodeMap = TDictionary<IAstIdentity, TAstViewNode>;
// Visitor to propagate Type Information from TypedAST to Visual Nodes
TTypePropagator = class(TAstVisitor)
private
FMap: TNodeMap;
procedure ApplyType(const Node: IAstNode);
protected
// Central hook: Called for every node during traversal
procedure Accept(const Node: IAstNode); override;
public
constructor Create(AMap: TNodeMap);
@@ -38,7 +38,7 @@ type
private
FEnv: TAstEnvironment;
FWorkspace: TAstWorkspace;
FWorkspace: TWorkspace;
FNodeMap: TNodeMap;
FRootViewNode: TAstViewNode;
@@ -46,9 +46,13 @@ type
procedure ClearVisuals;
procedure ApplyErrors(const Log: ICompilerLog);
procedure ApplyTypes(const TypedAst: IAstNode);
procedure RootResized(Sender: TObject);
// This signature MUST match TOnDragDropEvent in Myc.Fmx.AstEditor.Workspace
procedure HandleNodeDragDrop(ASource, ATarget: TControl; AIndex: Integer);
public
constructor Create(const AEnv: TAstEnvironment; AWorkspace: TAstWorkspace);
constructor Create(const AEnv: TAstEnvironment; AWorkspace: TWorkspace);
destructor Destroy; override;
procedure ValidateAndShow;
@@ -58,40 +62,120 @@ type
implementation
uses
Myc.Data.Value;
Myc.Data.Value,
Myc.Fmx.AstEditor.Visualizer;
{ TAstEditorController }
constructor TAstEditorController.Create(const AEnv: TAstEnvironment; AWorkspace: TAstWorkspace);
constructor TAstEditorController.Create(const AEnv: TAstEnvironment; AWorkspace: TWorkspace);
begin
inherited Create;
FEnv := AEnv;
FWorkspace := AWorkspace;
// Connect the event
FWorkspace.OnNodeDragDrop := HandleNodeDragDrop;
FNodeMap := TNodeMap.Create;
end;
destructor TAstEditorController.Destroy;
begin
SetRoot(nil);
FNodeMap.Free;
inherited;
end;
procedure TAstEditorController.SetRoot(const AstNode: IAstNode);
procedure TAstEditorController.HandleNodeDragDrop(ASource, ATarget: TControl; AIndex: Integer);
var
SourceParent: TControl;
ContainerOwner: TAstViewNode;
Reorderable: IReorderable;
SourceIdx, TargetIdx: Integer;
NewAst: IAstNode;
begin
FWorkspace.DeleteChildren;
FWorkspace.Build(AstNode, TPointF.Create(50, 50));
// Validation
if (ASource = nil) or (AIndex < 0) then
Exit;
if not (ASource is TAstViewNode) then
Exit;
if FWorkspace.ChildrenCount > 0 then
// Explicit cast to TControl to avoid TFmxObject incompatibility
if not (ASource.Parent is TControl) then
Exit;
SourceParent := TControl(ASource.Parent);
// We need to find the ViewNode responsible for this container that implements IReorderable.
ContainerOwner := nil;
// 1. Check if the direct parent is the ViewNode (Direct list handler scenario)
// TNodeListHandler adds items directly to the ViewNode, so SourceParent IS the ViewNode.
if (SourceParent is TAstViewNode) then
begin
for var i := 0 to FWorkspace.ChildrenCount - 1 do
if FWorkspace.Children[i] is TAstViewNode then
begin
FRootViewNode := TAstViewNode(FWorkspace.Children[i]);
break;
end;
ContainerOwner := TAstViewNode(SourceParent);
// Only keep it if it actually supports reordering
if not Supports(ContainerOwner.Handler, IReorderable, Reorderable) then
ContainerOwner := nil;
end;
ValidateAndShow;
// 2. Fallback: Check grandparent (Intermediate container scenario)
// Used when items are wrapped in an intermediate TAutoFitControl (e.g. by AddExpr).
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;
// Execute Move
if (ContainerOwner <> nil) and (Reorderable <> nil) then
begin
if Reorderable.CanDrag(ASource) then
begin
SourceIdx := ASource.Index;
TargetIdx := AIndex;
if SourceIdx <> TargetIdx then
begin
// A. Update internal state in the Handler (modifies FChildNodes list)
Reorderable.MoveChild(SourceIdx, TargetIdx);
// B. Rebuild UI Logic
// Since the handler's internal list is now reordered, CreateAst
// will produce a new AST with the correct order.
NewAst := FRootViewNode.CreateAst;
// C. Full UI Refresh
// ValidateAndShow only annotates. SetRoot destroys the old visual tree
// and builds a new one from the freshly generated AST.
SetRoot(NewAst);
end;
end;
end;
end;
procedure TAstEditorController.SetRoot(const AstNode: IAstNode);
var
Visualizer: IAstVisualizer;
begin
FWorkspace.World.DeleteChildren;
if Assigned(FRootViewNode) then
FRootViewNode.OnResized := nil;
FRootViewNode := nil;
if not Assigned(AstNode) then
Exit;
Visualizer := TAstVisualizer.Create(FWorkspace, FWorkspace.World, 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
ValidateAndShow;
end;
procedure TAstEditorController.CollectNodes(Parent: TControl);
@@ -109,9 +193,6 @@ begin
if child is TAstViewNode then
begin
viewNode := TAstViewNode(child);
// Register Identity -> ViewNode
// Note: ReconstructAst updates the Node property of the ViewNode,
// so we must ensure we use the identity from the *logical* node held by the view.
if Assigned(viewNode.Node) and Assigned(viewNode.Node.Identity) then
begin
FNodeMap.AddOrSetValue(viewNode.Node.Identity, viewNode);
@@ -162,13 +243,17 @@ begin
propagator := TTypePropagator.Create(FNodeMap);
try
// Start traversal. The overload Accept(Node) will be called.
propagator.Accept(TypedAst);
finally
propagator.Free;
end;
end;
procedure TAstEditorController.RootResized(Sender: TObject);
begin
FWorkspace.World.Size := FRootViewNode.Size;
end;
procedure TAstEditorController.ValidateAndShow;
var
logicalAst: IAstNode;
@@ -176,26 +261,18 @@ begin
if not Assigned(FRootViewNode) then
Exit;
// 1. Reconstruct Logical AST from UI
// This updates the .Node property on ViewNodes with fresh Identities (if configured) or reuses them.
logicalAst := FRootViewNode.CreateAst;
// 2. Rebuild Mapping based on the new logical nodes
FNodeMap.Clear;
CollectNodes(FWorkspace);
CollectNodes(FWorkspace.World);
// 3. Clear visuals
ClearVisuals;
// 4. Compile
try
// To get type info, we re-bind/check manually as Compile doesn't return the TypedAST.
var log := TCompilerLog.Create as ICompilerLog;
// We need to expand macros first to match the structure Compile used
var expanded := FEnv.ExpandMacros(logicalAst);
var typedAst := FEnv.Bind(expanded, [], log);
var specAst := FEnv.Specialize(typedAst);
ApplyTypes(specAst);
@@ -214,7 +291,7 @@ begin
end;
end;
FWorkspace.Repaint;
FWorkspace.World.Repaint;
end;
{ TAstEditorController.TTypePropagator }
@@ -247,11 +324,7 @@ procedure TAstEditorController.TTypePropagator.Accept(const Node: IAstNode);
begin
if Node = nil then
Exit;
// 1. Apply side effect
ApplyType(Node);
// 2. Continue traversal (Standard TAstVisitor logic calls VisitXY which calls Accept for children)
Node.Accept(Self);
end;