980 lines
27 KiB
ObjectPascal
980 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.Node,
|
|
Myc.Fmx.AstEditor.Layout,
|
|
Myc.Fmx.AstEditor.Workspace;
|
|
|
|
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;
|
|
|
|
// 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.
|