952 lines
27 KiB
ObjectPascal
952 lines
27 KiB
ObjectPascal
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.Render,
|
|
Myc.Fmx.AstEditor.Node,
|
|
Myc.Fmx.AstEditor.Workspace,
|
|
Myc.Fmx.AstEditor.Visualizer;
|
|
|
|
type
|
|
TAstEditor = class(TControl)
|
|
private
|
|
type
|
|
TNodeMap = TDictionary<IAstIdentity, TAstViewNode>;
|
|
TUndoStack = TStack<IAstNode>;
|
|
|
|
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;
|
|
|
|
FCurrentAst: IAstNode;
|
|
|
|
FUndoStack: TUndoStack;
|
|
FRedoStack: TUndoStack;
|
|
FIsUndoing: Boolean;
|
|
|
|
FOnPaintConnections: TOnPaintConnectionsEvent;
|
|
FOnWorkspaceMouseDown: TMouseEvent;
|
|
|
|
procedure CollectNodes(Parent: TVisualNode);
|
|
procedure ClearVisuals;
|
|
procedure ApplyErrors(const Log: ICompilerLog);
|
|
procedure ApplyTypes(const TypedAst: IAstNode);
|
|
|
|
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 CommitSnapshot;
|
|
|
|
procedure EnsureVisible(Node: 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;
|
|
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
procedure Init(const AEnv: TAstEnvironment);
|
|
|
|
procedure ValidateAndShow;
|
|
|
|
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;
|
|
|
|
property OnPaintConnections: TOnPaintConnectionsEvent read FOnPaintConnections write SetOnPaintConnections;
|
|
property OnMouseDown: TMouseEvent read FOnWorkspaceMouseDown write FOnWorkspaceMouseDown;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Myc.Data.Value;
|
|
|
|
{ TAstEditor }
|
|
|
|
constructor TAstEditor.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
Width := 400;
|
|
Height := 300;
|
|
ClipChildren := True;
|
|
|
|
FWorkspace := TWorkspace.Create(Self);
|
|
FWorkspace.Parent := Self;
|
|
FWorkspace.Align := TAlignLayout.Client;
|
|
FWorkspace.Stored := False;
|
|
FWorkspace.Locked := True;
|
|
|
|
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;
|
|
|
|
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.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);
|
|
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: TVisualNode; AIndex: Integer);
|
|
var
|
|
SourceView, TargetView: TAstViewNode;
|
|
ContainerOwner: TAstViewNode;
|
|
Reorderable: IReorderable;
|
|
SourceIdx: Integer;
|
|
NewAst: IAstNode;
|
|
begin
|
|
if (ASource = nil) or (AIndex < 0) then
|
|
exit;
|
|
if not (ASource is TAstViewNode) then
|
|
exit;
|
|
if not (ATarget is TAstViewNode) then
|
|
exit;
|
|
|
|
SourceView := TAstViewNode(ASource);
|
|
TargetView := TAstViewNode(ATarget);
|
|
ContainerOwner := TargetView;
|
|
|
|
if not Supports(ContainerOwner.Handler, IReorderable, Reorderable) then
|
|
exit;
|
|
|
|
if Reorderable.CanDrag(SourceView) and (SourceView.Parent = TargetView) then
|
|
begin
|
|
// Find current index of SourceView in Target
|
|
SourceIdx := -1;
|
|
for var i := 0 to TargetView.GetChildCount - 1 do
|
|
begin
|
|
if TargetView.GetChild(i) = SourceView then
|
|
begin
|
|
SourceIdx := i;
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
if SourceIdx >= 0 then
|
|
begin
|
|
CommitSnapshot;
|
|
Reorderable.MoveChild(SourceIdx, AIndex);
|
|
|
|
NewAst := FRootViewNode.CreateAst;
|
|
SetRoot(NewAst, False);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TAstEditor.HandleKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState);
|
|
var
|
|
NewRoot: IAstNode;
|
|
begin
|
|
// Undo / Redo
|
|
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
|
|
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
|
|
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;
|
|
|
|
if AClearHistory and (not FIsUndoing) then
|
|
begin
|
|
FUndoStack.Clear;
|
|
FRedoStack.Clear;
|
|
end;
|
|
|
|
FFocusedNode := nil;
|
|
FWorkspace.RootNode := nil;
|
|
|
|
if Assigned(FRootViewNode) then
|
|
FRootViewNode := nil;
|
|
|
|
if not Assigned(AstNode) then
|
|
exit;
|
|
|
|
Visualizer := TAstVisualizer.Create(FWorkspace, nil, 0);
|
|
FRootViewNode := Visualizer.CallAccept(AstNode);
|
|
|
|
if Assigned(FRootViewNode) then
|
|
begin
|
|
FWorkspace.RootNode := FRootViewNode;
|
|
FRootViewNode.Position := TPointF.Create(50, 50);
|
|
ValidateAndShow;
|
|
end;
|
|
end;
|
|
|
|
procedure TAstEditor.CollectNodes(Parent: TVisualNode);
|
|
var
|
|
i: Integer;
|
|
child: TVisualNode;
|
|
viewNode: TAstViewNode;
|
|
begin
|
|
for i := 0 to Parent.GetChildCount - 1 do
|
|
begin
|
|
child := Parent.GetChild(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.GetChildCount > 0 then
|
|
CollectNodes(child);
|
|
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.ValidateAndShow;
|
|
var
|
|
logicalAst: IAstNode;
|
|
begin
|
|
if not Assigned(FRootViewNode) then
|
|
exit;
|
|
|
|
logicalAst := FRootViewNode.CreateAst;
|
|
|
|
FNodeMap.Clear;
|
|
CollectNodes(FWorkspace.RootNode);
|
|
|
|
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);
|
|
|
|
FWorkspace.RootNode.RecalcLayout;
|
|
FWorkspace.InvalidateConnections;
|
|
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.RequestLayout;
|
|
end;
|
|
|
|
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 = 20; // Margin to the screen edge
|
|
var
|
|
NodeRect: TRectF;
|
|
VisibleWorldRect: TRectF;
|
|
NewOffset: TPointF;
|
|
ViewW, ViewH: Single;
|
|
begin
|
|
if (Node = nil) or (FWorkspace = nil) then
|
|
Exit;
|
|
|
|
// 1. Get node coordinates in world space and add margin
|
|
NodeRect := Node.AbsoluteRect;
|
|
NodeRect.Inflate(cMargin, cMargin);
|
|
|
|
// Safety check for zoom to avoid division by zero
|
|
if FWorkspace.Zoom < 0.001 then
|
|
Exit;
|
|
|
|
// 2. Calculate the currently visible area in world space
|
|
// Formula: WorldPoint = (ScreenPoint - ContentOffset) / Zoom
|
|
// TopLeft (0,0) corresponds to -ContentOffset / Zoom.
|
|
ViewW := FWorkspace.Width / FWorkspace.Zoom;
|
|
ViewH := FWorkspace.Height / FWorkspace.Zoom;
|
|
|
|
VisibleWorldRect := TRectF.Create(-FWorkspace.ContentOffset.X / FWorkspace.Zoom, -FWorkspace.ContentOffset.Y / FWorkspace.Zoom, 0, 0);
|
|
VisibleWorldRect.Width := ViewW;
|
|
VisibleWorldRect.Height := ViewH;
|
|
|
|
// 3. Check if the node is already fully visible
|
|
// Contains checks Left, Top, Right and Bottom boundaries.
|
|
if VisibleWorldRect.Contains(NodeRect) then
|
|
Exit;
|
|
|
|
// 4. Calculate new offset (Minimum Movement Strategy)
|
|
NewOffset := FWorkspace.ContentOffset;
|
|
|
|
// --- Horizontal Adjustment (X) ---
|
|
if NodeRect.Width > ViewW then
|
|
begin
|
|
// Special case: Node is wider than the screen -> Align Left
|
|
NewOffset.X := -(NodeRect.Left * FWorkspace.Zoom);
|
|
end
|
|
else if NodeRect.Left < VisibleWorldRect.Left then
|
|
begin
|
|
// Cut off on the left -> Move viewport to the left (Align Left)
|
|
NewOffset.X := -(NodeRect.Left * FWorkspace.Zoom);
|
|
end
|
|
else if NodeRect.Right > VisibleWorldRect.Right then
|
|
begin
|
|
// Cut off on the right -> Move viewport to the right (Align Right edge)
|
|
// Desired equation: (NodeRect.Right * Zoom) + NewOffset = Workspace.Width
|
|
NewOffset.X := -((NodeRect.Right - ViewW) * FWorkspace.Zoom);
|
|
end;
|
|
|
|
// --- Vertical Adjustment (Y) ---
|
|
if NodeRect.Height > ViewH then
|
|
begin
|
|
// Special case: Node is taller than the screen -> Align Top
|
|
NewOffset.Y := -(NodeRect.Top * FWorkspace.Zoom);
|
|
end
|
|
else if NodeRect.Top < VisibleWorldRect.Top then
|
|
begin
|
|
// Cut off at the top -> Move viewport up (Align Top)
|
|
NewOffset.Y := -(NodeRect.Top * FWorkspace.Zoom);
|
|
end
|
|
else if NodeRect.Bottom > VisibleWorldRect.Bottom then
|
|
begin
|
|
// Cut off at the bottom -> Move viewport down (Align Bottom edge)
|
|
NewOffset.Y := -((NodeRect.Bottom - ViewH) * FWorkspace.Zoom);
|
|
end;
|
|
|
|
// 5. Only update if changed (avoids unnecessary repaints)
|
|
if not (SameValue(NewOffset.X, FWorkspace.ContentOffset.X, TEpsilon.Position)
|
|
and SameValue(NewOffset.Y, FWorkspace.ContentOffset.Y, TEpsilon.Position)) then
|
|
begin
|
|
FWorkspace.ContentOffset := NewOffset;
|
|
end;
|
|
end;
|
|
|
|
function TAstEditor.GetNextLinearNode(StartNode: TAstViewNode): TAstViewNode;
|
|
function FindFirst(Node: TVisualNode): TAstViewNode;
|
|
begin
|
|
if Node is TAstViewNode then
|
|
Exit(TAstViewNode(Node));
|
|
for var i := 0 to Node.GetChildCount - 1 do
|
|
begin
|
|
Result := FindFirst(Node.GetChild(i));
|
|
if Result <> nil then
|
|
Exit;
|
|
end;
|
|
Result := nil;
|
|
end;
|
|
|
|
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;
|
|
|
|
// Helper: Finds the visually last AST node in a subtree (bottom-right most)
|
|
function FindLast(Node: TVisualNode): TAstViewNode;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
// Iterate children backwards (last to first)
|
|
for i := Node.GetChildCount - 1 downto 0 do
|
|
begin
|
|
Result := FindLast(Node.GetChild(i));
|
|
if Result <> nil then
|
|
Exit;
|
|
end;
|
|
|
|
// If no child yielded a result, check the node itself
|
|
if Node is TAstViewNode then
|
|
Result := TAstViewNode(Node)
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
var
|
|
Current, Parent: TVisualNode;
|
|
i, Idx: Integer;
|
|
SiblingResult: TAstViewNode;
|
|
begin
|
|
Result := nil;
|
|
Current := StartNode;
|
|
|
|
// Traverse up the tree
|
|
while Current.Parent <> nil do
|
|
begin
|
|
Parent := Current.Parent;
|
|
Idx := -1;
|
|
|
|
// 1. Find index of Current node in Parent
|
|
for i := 0 to Parent.GetChildCount - 1 do
|
|
begin
|
|
if Parent.GetChild(i) = Current then
|
|
begin
|
|
Idx := i;
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
// 2. Check siblings to the left (reverse order)
|
|
if Idx > 0 then
|
|
begin
|
|
for i := Idx - 1 downto 0 do
|
|
begin
|
|
// Dig deep into the sibling to find the last visible node
|
|
SiblingResult := FindLast(Parent.GetChild(i));
|
|
if SiblingResult <> nil then
|
|
Exit(SiblingResult);
|
|
end;
|
|
end;
|
|
|
|
// 3. No predecessor in siblings? Then the Parent is the predecessor
|
|
if Parent is TAstViewNode then
|
|
Exit(TAstViewNode(Parent));
|
|
|
|
// 4. If Parent is just a layout container, move further up
|
|
Current := Parent;
|
|
end;
|
|
end;
|
|
|
|
function TAstEditor.GetNextVerticalNeighbor(StartNode: TAstViewNode): TAstViewNode;
|
|
|
|
// Helper: Finds the first valid AST node within a visual subtree.
|
|
// This ensures that if we jump to a container, we focus its first content.
|
|
function FindFirstAstNode(Node: TVisualNode): TAstViewNode;
|
|
begin
|
|
if Node is TAstViewNode then
|
|
Exit(TAstViewNode(Node));
|
|
|
|
for var i := 0 to Node.GetChildCount - 1 do
|
|
begin
|
|
Result := FindFirstAstNode(Node.GetChild(i));
|
|
if Result <> nil then
|
|
Exit;
|
|
end;
|
|
Result := nil;
|
|
end;
|
|
|
|
var
|
|
Current, Parent: TVisualNode;
|
|
LayoutParent: TAutoFitLayout;
|
|
i, Idx: Integer;
|
|
Sibling: TVisualNode;
|
|
begin
|
|
Current := StartNode;
|
|
|
|
// 1. Search up the hierarchy for the nearest vertical list with a successor
|
|
while Current.Parent <> nil do
|
|
begin
|
|
Parent := Current.Parent;
|
|
|
|
// We are only interested if the parent controls layout (TAutoFitLayout or TAstViewNode)
|
|
if Parent is TAutoFitLayout then
|
|
begin
|
|
LayoutParent := TAutoFitLayout(Parent);
|
|
|
|
// Check if this container arranges its children vertically
|
|
if LayoutParent.Orientation = TLayoutOrientation.loVertical then
|
|
begin
|
|
// Find the index of the child path we just came from
|
|
Idx := -1;
|
|
for i := 0 to Parent.GetChildCount - 1 do
|
|
begin
|
|
if Parent.GetChild(i) = Current then
|
|
begin
|
|
Idx := i;
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
// Check if there is a next sibling in this vertical list
|
|
if (Idx >= 0) and (Idx < Parent.GetChildCount - 1) then
|
|
begin
|
|
Sibling := Parent.GetChild(Idx + 1);
|
|
|
|
// Found a vertical neighbor! Now get the actual node inside it.
|
|
Result := FindFirstAstNode(Sibling);
|
|
if Result <> nil then
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// Move up to the next parent
|
|
Current := Parent;
|
|
end;
|
|
|
|
// 2. Fallback: If no vertical sibling found in hierarchy, behave like Cursor Right
|
|
Result := GetNextLinearNode(StartNode);
|
|
end;
|
|
|
|
function TAstEditor.GetPrevVerticalNeighbor(StartNode: TAstViewNode): TAstViewNode;
|
|
|
|
// Helper: Finds the first valid AST node within a visual subtree.
|
|
// (Identical to the helper in GetNextVerticalNeighbor)
|
|
function FindFirstAstNode(Node: TVisualNode): TAstViewNode;
|
|
begin
|
|
if Node is TAstViewNode then
|
|
Exit(TAstViewNode(Node));
|
|
|
|
for var i := 0 to Node.GetChildCount - 1 do
|
|
begin
|
|
Result := FindFirstAstNode(Node.GetChild(i));
|
|
if Result <> nil then
|
|
Exit;
|
|
end;
|
|
Result := nil;
|
|
end;
|
|
|
|
var
|
|
Current, Parent: TVisualNode;
|
|
LayoutParent: TAutoFitLayout;
|
|
i, Idx: Integer;
|
|
Sibling: TVisualNode;
|
|
begin
|
|
Current := StartNode;
|
|
|
|
// 1. Search up the hierarchy for the nearest vertical list with a predecessor
|
|
while Current.Parent <> nil do
|
|
begin
|
|
Parent := Current.Parent;
|
|
|
|
if Parent is TAutoFitLayout then
|
|
begin
|
|
LayoutParent := TAutoFitLayout(Parent);
|
|
|
|
// Check if this container arranges its children vertically
|
|
if LayoutParent.Orientation = TLayoutOrientation.loVertical then
|
|
begin
|
|
// Find index of current child path
|
|
Idx := -1;
|
|
for i := 0 to Parent.GetChildCount - 1 do
|
|
begin
|
|
if Parent.GetChild(i) = Current then
|
|
begin
|
|
Idx := i;
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
// Check if there is a PREVIOUS sibling (Idx - 1)
|
|
if Idx > 0 then
|
|
begin
|
|
Sibling := Parent.GetChild(Idx - 1);
|
|
|
|
// Found a vertical neighbor above!
|
|
// Dive into it to find its FIRST element (jumping to the start of the block)
|
|
Result := FindFirstAstNode(Sibling);
|
|
if Result <> nil then
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// Move up to next parent
|
|
Current := Parent;
|
|
end;
|
|
|
|
// 2. Fallback: If no vertical sibling found, behave like Cursor Left
|
|
Result := GetPrevLinearNode(StartNode);
|
|
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;
|
|
|
|
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
|
|
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.
|