unit Myc.Fmx.AstEditor.Controller; interface uses System.SysUtils, System.Classes, System.Types, System.Math.Vectors, System.Generics.Collections, FMX.Types, FMX.Controls, Myc.Ast, Myc.Ast.Nodes, Myc.Ast.Identities, Myc.Ast.Types, Myc.Ast.Visitor, Myc.Ast.Scope, Myc.Ast.Environment, Myc.Fmx.AstEditor, Myc.Fmx.AstEditor.Workspace; type TAstEditorController = class private type TNodeMap = TDictionary; TTypePropagator = class(TAstVisitor) private FMap: TNodeMap; procedure ApplyType(const Node: IAstNode); protected procedure Accept(const Node: IAstNode); override; public constructor Create(AMap: TNodeMap); end; private FEnv: TAstEnvironment; FWorkspace: TWorkspace; FNodeMap: TNodeMap; FRootViewNode: TAstViewNode; procedure CollectNodes(Parent: TControl); 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: TWorkspace); destructor Destroy; override; procedure ValidateAndShow; procedure SetRoot(const AstNode: IAstNode); end; implementation uses Myc.Data.Value, Myc.Fmx.AstEditor.Visualizer; { TAstEditorController } 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.HandleNodeDragDrop(ASource, ATarget: TControl; AIndex: Integer); var SourceParent: TControl; ContainerOwner: TAstViewNode; Reorderable: IReorderable; SourceIdx, TargetIdx: Integer; NewAst: IAstNode; begin // Validation if (ASource = nil) or (AIndex < 0) then Exit; if not (ASource is TAstViewNode) then Exit; // 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 ContainerOwner := TAstViewNode(SourceParent); // Only keep it if it actually supports reordering if not Supports(ContainerOwner.Handler, IReorderable, Reorderable) then ContainerOwner := nil; end; // 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); var i: Integer; child: TControl; viewNode: TAstViewNode; begin for i := 0 to Parent.ChildrenCount - 1 do begin if Parent.Children[i] is TControl then begin child := TControl(Parent.Children[i]); if child is TAstViewNode then begin viewNode := TAstViewNode(child); if Assigned(viewNode.Node) and Assigned(viewNode.Node.Identity) then begin FNodeMap.AddOrSetValue(viewNode.Node.Identity, viewNode); end; end; if child.ChildrenCount > 0 then CollectNodes(child); end; end; end; procedure TAstEditorController.ClearVisuals; begin for var viewNode in FNodeMap.Values do begin viewNode.ErrorMessage := ''; viewNode.TypeInfoText := ''; end; end; procedure TAstEditorController.ApplyErrors(const Log: ICompilerLog); var entry: TCompilerError; viewNode: TAstViewNode; begin for entry in Log.GetEntries do begin if (entry.Level = elError) and Assigned(entry.Node) and Assigned(entry.Node.Identity) then begin if FNodeMap.TryGetValue(entry.Node.Identity, viewNode) then begin if viewNode.ErrorMessage = '' then viewNode.ErrorMessage := entry.Message else viewNode.ErrorMessage := viewNode.ErrorMessage + sLineBreak + entry.Message; end; end; end; end; procedure TAstEditorController.ApplyTypes(const TypedAst: IAstNode); var propagator: TTypePropagator; begin if not Assigned(TypedAst) then Exit; propagator := TTypePropagator.Create(FNodeMap); try 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; begin if not Assigned(FRootViewNode) then Exit; logicalAst := FRootViewNode.CreateAst; FNodeMap.Clear; CollectNodes(FWorkspace.World); ClearVisuals; try var log := TCompilerLog.Create as ICompilerLog; var expanded := FEnv.ExpandMacros(logicalAst); var typedAst := FEnv.Bind(expanded, [], log); var specAst := FEnv.Specialize(typedAst); ApplyTypes(specAst); if specAst.Kind = akLambdaExpression then var compiled := FEnv.Link(specAst.AsLambdaExpression, log); ApplyErrors(log); except on E: ECompilationFailed do begin var tempLog := TCompilerLog.Create as ICompilerLog; for var err in E.Errors do tempLog.Add(err.Level, err.Message, err.Node); ApplyErrors(tempLog); end; end; FWorkspace.World.Repaint; end; { TAstEditorController.TTypePropagator } constructor TAstEditorController.TTypePropagator.Create(AMap: TNodeMap); begin inherited Create; FMap := AMap; end; procedure TAstEditorController.TTypePropagator.ApplyType(const Node: IAstNode); var viewNode: TAstViewNode; begin if Assigned(Node) and Assigned(Node.Identity) then begin if FMap.TryGetValue(Node.Identity, viewNode) then begin if Node.IsTyped then begin var st := Node.AsTypedNode.StaticType; if Assigned(st) then viewNode.TypeInfoText := st.ToString; end; end; end; end; procedure TAstEditorController.TTypePropagator.Accept(const Node: IAstNode); begin if Node = nil then Exit; ApplyType(Node); Node.Accept(Self); end; end.