332 lines
9.4 KiB
ObjectPascal
332 lines
9.4 KiB
ObjectPascal
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<IAstIdentity, TAstViewNode>;
|
|
|
|
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.
|