unit Myc.Fmx.AstEditor; interface uses System.SysUtils, System.Classes, System.Types, System.UITypes, System.Math, System.Math.Vectors, System.Generics.Collections, FMX.Types, FMX.Controls, FMX.Graphics, Myc.Ast, Myc.Ast.Nodes, Myc.Ast.Identities, Myc.Ast.Types, Myc.Ast.Visitor, Myc.Ast.Scope, Myc.Ast.Environment, Myc.Ast.Refactoring.Remove, Myc.Fmx.AstEditor.Node, Myc.Fmx.AstEditor.Layout, Myc.Fmx.AstEditor.Workspace; type TAstEditor = class(TControl) private type TNodeMap = TDictionary; TUndoStack = TStack; TTypePropagator = class(TAstVisitor) private FMap: TNodeMap; procedure ApplyType(const Node: IAstNode); protected function Accept(const Node: IAstNode): TVoid; override; public constructor Create(AMap: TNodeMap); end; private FEnv: TAstEnvironment; FWorkspace: TWorkspace; FNodeMap: TNodeMap; 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 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 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; function GetPrevLinearNode(StartNode: TAstViewNode): TAstViewNode; procedure SetOnPaintConnections(const Value: TOnPaintConnectionsEvent); protected procedure Paint; override; // For design-time border 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; procedure Redo; function CanUndo: Boolean; function CanRedo: Boolean; procedure SetFocusedNode(Node: TAstViewNode); procedure Navigate(Key: Word; Shift: TShiftState); property CurrentAst: IAstNode read FCurrentAst; property FocusedNode: TAstViewNode read FFocusedNode; published property Align; property Anchors; property Position; property Width; property Height; property Visible; 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; implementation uses Myc.Data.Value, Myc.Fmx.AstEditor.Visualizer; { TAstEditor } constructor TAstEditor.Create(AOwner: TComponent); begin inherited Create(AOwner); Width := 400; 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; FWorkspace.OnMouseDown := HandleWorkspaceMouseDown; FNodeMap := TNodeMap.Create; FUndoStack := TUndoStack.Create; FRedoStack := TUndoStack.Create; FIsUndoing := False; FCurrentAst := nil; end; destructor TAstEditor.Destroy; begin SetRoot(nil); FNodeMap.Free; FUndoStack.Free; FRedoStack.Free; inherited; end; procedure TAstEditor.Init(const AEnv: TAstEnvironment); begin FEnv := AEnv; end; procedure TAstEditor.Paint; begin inherited; if (csDesigning in ComponentState) then begin Canvas.Stroke.Kind := TBrushKind.Solid; Canvas.Stroke.Color := TAlphaColors.Gray; Canvas.Stroke.Dash := TStrokeDash.Dash; Canvas.DrawRect(LocalRect, 0, 0, AllCorners, 1.0); end; end; procedure TAstEditor.SetOnPaintConnections(const Value: TOnPaintConnectionsEvent); begin FOnPaintConnections := Value; end; procedure TAstEditor.HandleWorkspacePaintConnections(ASender: TObject; ACanvas: TCanvas); begin if Assigned(FOnPaintConnections) then FOnPaintConnections(Self, ACanvas); end; procedure TAstEditor.HandleWorkspaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); begin if FWorkspace.CanFocus then FWorkspace.SetFocus; 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 begin FUndoStack.Push(FCurrentAst); FRedoStack.Clear; end; end; procedure TAstEditor.Undo; var prevAst: IAstNode; begin if FUndoStack.Count = 0 then exit; FIsUndoing := True; try if Assigned(FCurrentAst) then FRedoStack.Push(FCurrentAst); prevAst := FUndoStack.Pop; SetRoot(prevAst); // Default Clear=True, but guarded by FIsUndoing finally FIsUndoing := False; end; end; procedure TAstEditor.Redo; var nextAst: IAstNode; begin if FRedoStack.Count = 0 then exit; FIsUndoing := True; try if Assigned(FCurrentAst) then FUndoStack.Push(FCurrentAst); nextAst := FRedoStack.Pop; SetRoot(nextAst); finally FIsUndoing := False; end; end; function TAstEditor.CanUndo: Boolean; begin Result := FUndoStack.Count > 0; end; function TAstEditor.CanRedo: Boolean; begin Result := FRedoStack.Count > 0; end; procedure TAstEditor.HandleNodeDragDrop(ASource, ATarget: TControl; AIndex: Integer); var SourceParent: TControl; ContainerOwner: TAstViewNode; Reorderable: IReorderable; SourceIdx, TargetIdx: 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 exit; SourceParent := TControl(ASource.Parent); ContainerOwner := nil; if (SourceParent is TAstViewNode) 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 begin SourceIdx := ASource.Index; TargetIdx := AIndex; if SourceIdx <> TargetIdx then begin CommitSnapshot; Reorderable.MoveChild(SourceIdx, TargetIdx); NewAst := FRootViewNode.CreateAst; // IMPORTANT: Pass False to preserve the undo stack we just updated SetRoot(NewAst, False); end; end; end; end; procedure TAstEditor.HandleKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState); var NewRoot: IAstNode; begin // Undo / Redo Handling if (ssCtrl in Shift) then begin if (Key = vkZ) then begin if (ssShift in Shift) then begin if CanRedo then Redo; end else begin if CanUndo then Undo; end; Key := 0; Exit; end else if (Key = vkY) then begin if CanRedo then Redo; Key := 0; Exit; end; end; // Delete Handling if (Key = vkDelete) then begin if Assigned(FFocusedNode) and Assigned(FFocusedNode.Node) and Assigned(FCurrentAst) then 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; Key := 0; Exit; end; // Navigation if Key in [vkLeft, vkRight, vkUp, vkDown, vkTab, vkEscape] then begin Navigate(Key, Shift); Key := 0; end; end; procedure TAstEditor.SetRoot(const AstNode: IAstNode; AClearHistory: Boolean); var Visualizer: IAstVisualizer; begin FCurrentAst := AstNode; // Only clear if explicitly requested AND not currently performing an undo/redo if AClearHistory and (not FIsUndoing) then begin FUndoStack.Clear; FRedoStack.Clear; end; FFocusedNode := nil; 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 TAstEditor.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); viewNode.OnMouseDown := HandleNodeMouseDown; 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 TAstEditor.ClearVisuals; begin for var viewNode in FNodeMap.Values do begin viewNode.ErrorMessage := ''; viewNode.TypeInfoText := ''; end; end; procedure TAstEditor.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 TAstEditor.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 TAstEditor.RootResized(Sender: TObject); begin FWorkspace.World.Size := FRootViewNode.Size; end; procedure TAstEditor.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; // ================================================================================================= // == NAVIGATION IMPLEMENTATION // ================================================================================================= procedure TAstEditor.SetFocusedNode(Node: TAstViewNode); begin if FFocusedNode = Node then Exit; if Assigned(FFocusedNode) then FFocusedNode.IsFocused := False; FFocusedNode := Node; if Assigned(FFocusedNode) then begin FFocusedNode.IsFocused := True; EnsureVisible(FFocusedNode); end; end; procedure TAstEditor.EnsureVisible(Node: TAstViewNode); const cMargin = 40; var NodeRect, ViewRect: TRectF; Delta: TPointF; begin if (Node = nil) or (FWorkspace = nil) then Exit; NodeRect := Node.AbsoluteRect; ViewRect := FWorkspace.AbsoluteRect; ViewRect.Inflate(-cMargin, -cMargin); Delta := TPointF.Zero; 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) 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 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 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; end; CurrentControl := ParentControl; end; Result := nil; 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; procedure TAstEditor.Navigate(Key: Word; Shift: TShiftState); var Current: TAstViewNode; Target: TAstViewNode; begin if FFocusedNode = nil then begin SetFocusedNode(FRootViewNode); Exit; end; Current := FFocusedNode; Target := nil; if Key = vkTab then begin if ssShift in Shift then Target := GetPrevLinearNode(Current) else Target := GetNextLinearNode(Current); if Target <> nil then SetFocusedNode(Target); 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); end; if Target <> nil then SetFocusedNode(Target); end; { TAstEditor.TTypePropagator } constructor TAstEditor.TTypePropagator.Create(AMap: TNodeMap); begin inherited Create; FMap := AMap; end; procedure TAstEditor.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; function TAstEditor.TTypePropagator.Accept(const Node: IAstNode): TVoid; begin if Node = nil then exit; ApplyType(Node); Node.Accept(Self); end; end.