Files
MycLib/ASTPlayground/Myc.Fmx.AstEditor.Node.pas
T
2025-11-02 19:38:52 +01:00

2226 lines
68 KiB
ObjectPascal

unit Myc.Fmx.AstEditor.Node;
interface
uses
System.SysUtils,
System.Classes,
System.UITypes,
System.Types,
System.Math.Vectors,
System.Math,
System.Generics.Defaults,
System.Generics.Collections,
FMX.Types,
FMX.Controls,
FMX.Objects,
FMX.Graphics,
FMX.StdCtrls,
Myc.Data.Scalar,
Myc.Data.Value,
Myc.Data.Keyword,
Myc.Ast.Nodes,
Myc.Ast.Visitor,
Myc.Ast,
Myc.Fmx.AstEditor.Workspace;
const
cNodePadding = 10;
cTitleTopPadding = 2;
cTitleBottomPadding = 4;
cMinNodeWidth = 10;
cMinNodeHeight = 10;
type
TAuraNode = class;
IAstVisualizer = interface
{$region 'private'}
function GetExprDepth: Integer;
function GetParentControl: TControl;
{$endregion}
function Clone(ParentControl: TControl; ExprDepth: Integer): IAstVisualizer;
function CallAccept(const Node: IAstNode): TAuraNode;
function GetWorkspace: TAuraWorkspace;
property ExprDepth: Integer read GetExprDepth;
property ParentControl: TControl read GetParentControl;
property Workspace: TAuraWorkspace read GetWorkspace;
end;
// Inherits from the new generic TAstVisitor<TAuraNode>
TAstVisualizer = class(TAstVisitor<TAuraNode>, IAstVisualizer)
private
FExprDepth: Integer;
FParentControl: TControl;
FWorkspace: TAuraWorkspace;
// Calls Accept on the node and returns the resulting TAuraNode.
function CallAccept(const Node: IAstNode): TAuraNode;
function GetExprDepth: Integer;
function GetParentControl: TControl;
function GetWorkspace: TAuraWorkspace;
procedure SetExprDepth(const Value: Integer);
procedure SetParentControl(const Value: TControl);
protected
// Visitor implementations for each AST node type.
function VisitConstant(const Node: IConstantNode): TAuraNode; override;
function VisitIdentifier(const Node: IIdentifierNode): TAuraNode; override;
function VisitKeyword(const Node: IKeywordNode): TAuraNode; override;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TAuraNode; override;
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TAuraNode; override;
function VisitIfExpression(const Node: IIfExpressionNode): TAuraNode; override;
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TAuraNode; override;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TAuraNode; override;
function VisitFunctionCall(const Node: IFunctionCallNode): TAuraNode; override;
function VisitMacroExpansionNode(const Node: IMacroExpansionNode): TAuraNode; override;
function VisitBlockExpression(const Node: IBlockExpressionNode): TAuraNode; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAuraNode; override;
function VisitAssignment(const Node: IAssignmentNode): TAuraNode; override;
function VisitMacroDefinition(const Node: IMacroDefinitionNode): TAuraNode; override;
function VisitQuasiquote(const Node: IQuasiquoteNode): TAuraNode; override;
function VisitUnquote(const Node: IUnquoteNode): TAuraNode; override;
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TAuraNode; override;
function VisitIndexer(const Node: IIndexerNode): TAuraNode; override;
function VisitMemberAccess(const Node: IMemberAccessNode): TAuraNode; override;
function VisitRecordLiteral(const Node: IRecordLiteralNode): TAuraNode; override;
function VisitCreateSeries(const Node: ICreateSeriesNode): TAuraNode; override;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TAuraNode; override;
function VisitSeriesLength(const Node: ISeriesLengthNode): TAuraNode; override;
function VisitRecurNode(const Node: IRecurNode): TAuraNode; override;
public
constructor Create(AWorkspace: TAuraWorkspace; AParentControl: TControl; AExprDepth: Integer);
destructor Destroy; override;
function Clone(ParentControl: TControl; ExprDepth: Integer): IAstVisualizer;
property ExprDepth: Integer read GetExprDepth write SetExprDepth;
property ParentControl: TControl read GetParentControl write SetParentControl;
property Workspace: TAuraWorkspace read GetWorkspace;
end;
// Defines the layout direction for children within TAutoFitControl
TLayoutOrientation = (loVertical, loHorizontal);
// Defines the alignment of children on the cross-axis
TLayoutAlignment = (laCenter, laFlush);
// A styled control that automatically adjusts its size to fit its children, including padding.
TAutoFitControl = class(TStyledControl)
private
FUpdatingOwnSize: Boolean; // Recursion guard
FNeedRecalcSize: Boolean; // Flag for EndUpdate
FOrientation: TLayoutOrientation; // Storage for Orientation
FAlignment: TLayoutAlignment; // Storage for Alignment
procedure RecalcOwnSize;
procedure SetOrientation(const Value: TLayoutOrientation);
procedure SetAlignment(const Value: TLayoutAlignment);
protected
// Called by children when their size, position, or visibility changes
procedure ParentContentChanged; override;
// Called when our own padding changes
procedure PaddingChanged; override;
// Called after children list has changed (add/remove)
procedure ChangeChildren; override;
// Initial calculation after loading
procedure Loaded; override;
// Handle pending recalc after updates
procedure DoEndUpdate; override;
public
constructor Create(AOwner: TComponent); override;
published
// Make Padding published if needed
property Padding;
property Orientation: TLayoutOrientation read FOrientation write SetOrientation default TLayoutOrientation.loHorizontal;
property Alignment: TLayoutAlignment read FAlignment write SetAlignment default TLayoutAlignment.laCenter;
end;
// A movable panel with a custom-painted border. Content (like title) is added externally.
TAuraNode = class(TAutoFitControl)
private
FBackgroundColor: TAlphaColor;
// Flag to indicate if the control is currently being dragged.
FIsDragging: Boolean;
// Stores the mouse coordinates at the beginning of the drag operation.
FDownPos: TPointF;
// Properties for the custom-drawn border.
FBorderColor: TAlphaColor;
FBorderWidth: Single;
FBorderRadius: Single;
// If true, the node is drawn without a border and with a transparent background.
FFrameless: Boolean;
FVisualizer: IAstVisualizer;
procedure SetBackgroundColor(const Value: TAlphaColor);
procedure SetBorderColor(const Value: TAlphaColor);
procedure SetBorderWidth(const Value: Single);
procedure SetBorderRadius(const Value: Single);
procedure SetFrameless(const Value: Boolean);
protected
procedure Paint; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
procedure MouseMove(Shift: TShiftState; X, Y: Single); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
property Visualizer: IAstVisualizer read FVisualizer;
procedure SetupNode; virtual;
function AddLabel(Parent: TControl; const Txt: String): TLabel;
function AddContainer(Parent: TControl; Orientation: TLayoutOrientation; Alignment: TLayoutAlignment): TAutoFitControl;
function AddExpr(Parent: TControl; const Title: String; const Node: IAstNode): TAuraNode;
public
constructor Create(const AVisualizer: IAstVisualizer); reintroduce;
destructor Destroy; override;
procedure AfterConstruction; override;
// Creates an AST from the visualization
function CreateAst: IAstNode; virtual;
published
// Custom border properties
property BorderColor: TAlphaColor read FBorderColor write SetBorderColor;
property BorderWidth: Single read FBorderWidth write SetBorderWidth;
property BorderRadius: Single read FBorderRadius write SetBorderRadius;
property BackgroundColor: TAlphaColor read FBackgroundColor write SetBackgroundColor;
// Behavior properties
property Frameless: Boolean read FFrameless write SetFrameless;
// Standard control properties
property Align;
property Anchors;
property ClipChildren default True;
property Cursor default crDefault;
property DragMode default TDragMode.dmManual;
property Enabled;
property Height;
property Hint;
property HitTest default True;
property Locked;
property Margins;
property Opacity;
property Padding;
property PopupMenu;
property Position;
property RotationAngle;
property RotationCenter;
property Scale;
property Size;
property Visible;
property Width;
property OnClick;
property OnDblClick;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseEnter;
property OnMouseLeave;
end;
TAuraConstantNode = class(TAuraNode)
private
FNode: IConstantNode;
protected
procedure SetupNode; override;
public
constructor Create(const AVisualizer: IAstVisualizer; const ANode: IConstantNode);
function CreateAst: IAstNode; override;
property Node: IConstantNode read FNode;
end;
TAuraIdentifierNode = class(TAuraNode)
private
FNode: IIdentifierNode;
protected
procedure SetupNode; override;
public
constructor Create(const AVisualizer: IAstVisualizer; const ANode: IIdentifierNode);
function CreateAst: IAstNode; override;
property Node: IIdentifierNode read FNode;
end;
TAuraKeywordNode = class(TAuraNode)
private
FNode: IKeywordNode;
protected
procedure SetupNode; override;
public
constructor Create(const AVisualizer: IAstVisualizer; const ANode: IKeywordNode);
function CreateAst: IAstNode; override;
property Node: IKeywordNode read FNode;
end;
TAuraBinaryExpressionNode = class(TAuraNode)
private
FNode: IBinaryExpressionNode;
function GetLeftNode: TAuraNode;
function GetRightNode: TAuraNode;
protected
procedure SetupNode; override;
public
constructor Create(const AVisualizer: IAstVisualizer; const ANode: IBinaryExpressionNode);
function CreateAst: IAstNode; override;
property LeftNode: TAuraNode read GetLeftNode;
property RightNode: TAuraNode read GetRightNode;
property Node: IBinaryExpressionNode read FNode;
end;
TAuraBlockExpressionNode = class(TAuraNode)
private
FNode: IBlockExpressionNode;
FChildNodes: TList<TAuraNode>; // To store children for CreateAst
protected
procedure SetupNode; override;
public
constructor Create(const AVisualizer: IAstVisualizer; const ANode: IBlockExpressionNode);
destructor Destroy; override;
function CreateAst: IAstNode; override;
property Node: IBlockExpressionNode read FNode;
end;
TAuraUnaryExpressionNode = class(TAuraNode)
private
FNode: IUnaryExpressionNode;
FChildNode: TAuraNode; // Stores the single child
protected
procedure SetupNode; override;
public
constructor Create(const AVisualizer: IAstVisualizer; const ANode: IUnaryExpressionNode);
function CreateAst: IAstNode; override;
property Node: IUnaryExpressionNode read FNode;
end;
TAuraIfExpressionNode = class(TAuraNode)
private
FNode: IIfExpressionNode;
FConditionNode: TAuraNode;
FThenNode: TAuraNode;
FElseNode: TAuraNode; // Can be nil
protected
procedure SetupNode; override;
public
constructor Create(const AVisualizer: IAstVisualizer; const ANode: IIfExpressionNode);
function CreateAst: IAstNode; override;
property Node: IIfExpressionNode read FNode;
end;
TAuraTernaryExpressionNode = class(TAuraNode)
private
FNode: ITernaryExpressionNode;
FConditionNode: TAuraNode;
FThenNode: TAuraNode;
FElseNode: TAuraNode;
protected
procedure SetupNode; override;
public
constructor Create(const AVisualizer: IAstVisualizer; const ANode: ITernaryExpressionNode);
function CreateAst: IAstNode; override;
property Node: ITernaryExpressionNode read FNode;
end;
TAuraLambdaExpressionNode = class(TAuraNode)
private
FNode: ILambdaExpressionNode;
FBodyNode: TAuraNode;
FParamLabels: TList<TLabel>; // To store param labels
protected
procedure SetupNode; override;
public
constructor Create(const AVisualizer: IAstVisualizer; const ANode: ILambdaExpressionNode);
destructor Destroy; override;
function CreateAst: IAstNode; override;
property Node: ILambdaExpressionNode read FNode;
end;
TAuraFunctionCallNode = class(TAuraNode)
private
FNode: IFunctionCallNode;
FCalleeNode: TAuraNode;
FArgumentNodes: TList<TAuraNode>;
protected
procedure SetupNode; override;
public
constructor Create(const AVisualizer: IAstVisualizer; const ANode: IFunctionCallNode);
destructor Destroy; override;
function CreateAst: IAstNode; override;
property Node: IFunctionCallNode read FNode;
end;
TAuraMacroExpansionNode = class(TAuraNode)
private
FNode: IMacroExpansionNode;
FExpandedBodyNode: TAuraNode;
protected
procedure SetupNode; override;
public
constructor Create(const AVisualizer: IAstVisualizer; const ANode: IMacroExpansionNode);
function CreateAst: IAstNode; override;
property Node: IMacroExpansionNode read FNode;
end;
TAuraRecurNode = class(TAuraNode)
private
FNode: IRecurNode;
FArgumentNodes: TList<TAuraNode>;
protected
procedure SetupNode; override;
public
constructor Create(const AVisualizer: IAstVisualizer; const ANode: IRecurNode);
destructor Destroy; override;
function CreateAst: IAstNode; override;
property Node: IRecurNode read FNode;
end;
TAuraVariableDeclarationNode = class(TAuraNode)
private
FNode: IVariableDeclarationNode;
FInitializerNode: TAuraNode; // Can be nil
protected
procedure SetupNode; override;
public
constructor Create(const AVisualizer: IAstVisualizer; const ANode: IVariableDeclarationNode);
function CreateAst: IAstNode; override;
property Node: IVariableDeclarationNode read FNode;
end;
TAuraAssignmentNode = class(TAuraNode)
private
FNode: IAssignmentNode;
FValueNode: TAuraNode;
protected
procedure SetupNode; override;
public
constructor Create(const AVisualizer: IAstVisualizer; const ANode: IAssignmentNode);
function CreateAst: IAstNode; override;
property Node: IAssignmentNode read FNode;
end;
TAuraMacroDefinitionNode = class(TAuraNode)
private
FNode: IMacroDefinitionNode;
FBodyNode: TAuraNode;
protected
procedure SetupNode; override;
public
constructor Create(const AVisualizer: IAstVisualizer; const ANode: IMacroDefinitionNode);
function CreateAst: IAstNode; override;
property Node: IMacroDefinitionNode read FNode;
end;
TAuraQuasiquoteNode = class(TAuraNode)
private
FNode: IQuasiquoteNode;
FExpressionNode: TAuraNode;
protected
procedure SetupNode; override;
public
constructor Create(const AVisualizer: IAstVisualizer; const ANode: IQuasiquoteNode);
function CreateAst: IAstNode; override;
property Node: IQuasiquoteNode read FNode;
end;
TAuraUnquoteNode = class(TAuraNode)
private
FNode: IUnquoteNode;
FExpressionNode: TAuraNode;
protected
procedure SetupNode; override;
public
constructor Create(const AVisualizer: IAstVisualizer; const ANode: IUnquoteNode);
function CreateAst: IAstNode; override;
property Node: IUnquoteNode read FNode;
end;
TAuraUnquoteSplicingNode = class(TAuraNode)
private
FNode: IUnquoteSplicingNode;
FExpressionNode: TAuraNode;
protected
procedure SetupNode; override;
public
constructor Create(const AVisualizer: IAstVisualizer; const ANode: IUnquoteSplicingNode);
function CreateAst: IAstNode; override;
property Node: IUnquoteSplicingNode read FNode;
end;
TAuraIndexerNode = class(TAuraNode)
private
FNode: IIndexerNode;
FBaseNode: TAuraNode;
FIndexNode: TAuraNode;
protected
procedure SetupNode; override;
public
constructor Create(const AVisualizer: IAstVisualizer; const ANode: IIndexerNode);
function CreateAst: IAstNode; override;
property Node: IIndexerNode read FNode;
end;
TAuraMemberAccessNode = class(TAuraNode)
private
FNode: IMemberAccessNode;
FBaseNode: TAuraNode;
protected
procedure SetupNode; override;
public
constructor Create(const AVisualizer: IAstVisualizer; const ANode: IMemberAccessNode);
function CreateAst: IAstNode; override;
property Node: IMemberAccessNode read FNode;
end;
TAuraRecordLiteralNode = class(TAuraNode)
private
FNode: IRecordLiteralNode;
FFieldNodes: TDictionary<IKeyword, TAuraNode>; // Map KeyName -> ValueNode
protected
procedure SetupNode; override;
public
constructor Create(const AVisualizer: IAstVisualizer; const ANode: IRecordLiteralNode);
destructor Destroy; override;
function CreateAst: IAstNode; override;
property Node: IRecordLiteralNode read FNode;
end;
TAuraCreateSeriesNode = class(TAuraNode)
private
FNode: ICreateSeriesNode;
protected
procedure SetupNode; override;
public
constructor Create(const AVisualizer: IAstVisualizer; const ANode: ICreateSeriesNode);
function CreateAst: IAstNode; override;
property Node: ICreateSeriesNode read FNode;
end;
TAuraAddSeriesItemNode = class(TAuraNode)
private
FNode: IAddSeriesItemNode;
FValueNode: TAuraNode;
FLookbackNode: TAuraNode; // Can be nil
protected
procedure SetupNode; override;
public
constructor Create(const AVisualizer: IAstVisualizer; const ANode: IAddSeriesItemNode);
function CreateAst: IAstNode; override;
property Node: IAddSeriesItemNode read FNode;
end;
TAuraSeriesLengthNode = class(TAuraNode)
private
FNode: ISeriesLengthNode;
protected
procedure SetupNode; override;
public
constructor Create(const AVisualizer: IAstVisualizer; const ANode: ISeriesLengthNode);
function CreateAst: IAstNode; override;
property Node: ISeriesLengthNode read FNode;
end;
implementation
{ TAstVisualizer }
constructor TAstVisualizer.Create(AWorkspace: TAuraWorkspace; AParentControl: TControl; AExprDepth: Integer);
begin
inherited Create;
FWorkspace := AWorkspace;
FParentControl := AParentControl;
FExprDepth := AExprDepth;
end;
destructor TAstVisualizer.Destroy;
begin
inherited;
end;
// Calls Accept on the node and returns the resulting TAuraNode.
function TAstVisualizer.CallAccept(const Node: IAstNode): TAuraNode;
var
DataValue: TDataValue;
begin
if not Assigned(Node) then
Exit(nil); // Handle nil input node gracefully
DataValue := Node.Accept(Self);
// Check if the result is actually a TAuraNode before casting
if DataValue.Kind = TDataValueKind.vkGeneric then
begin
// Assuming the visitor correctly returns TAuraNode wrapped in TDataValue.
Result := DataValue.AsGeneric<TAuraNode>;
end
else
begin
Result := nil;
end;
end;
function TAstVisualizer.Clone(ParentControl: TControl; ExprDepth: Integer): IAstVisualizer;
begin
Result := TAstVisualizer.Create(FWorkspace, ParentControl, ExprDepth);
end;
function TAstVisualizer.GetExprDepth: Integer;
begin
Result := FExprDepth;
end;
function TAstVisualizer.GetParentControl: TControl;
begin
Result := FParentControl;
end;
function TAstVisualizer.GetWorkspace: TAuraWorkspace;
begin
Result := FWorkspace;
end;
procedure TAstVisualizer.SetExprDepth(const Value: Integer);
begin
FExprDepth := Value;
end;
procedure TAstVisualizer.SetParentControl(const Value: TControl);
begin
FParentControl := Value;
end;
function TAstVisualizer.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TAuraNode;
begin
Result := TAuraAddSeriesItemNode.Create(Self, Node);
end;
function TAstVisualizer.VisitAssignment(const Node: IAssignmentNode): TAuraNode;
begin
Result := TAuraAssignmentNode.Create(Self, Node);
end;
// --- Visitor Implementations ---
function TAstVisualizer.VisitConstant(const Node: IConstantNode): TAuraNode;
begin
Result := TAuraConstantNode.Create(Self, Node);
end;
function TAstVisualizer.VisitIdentifier(const Node: IIdentifierNode): TAuraNode;
begin
Result := TAuraIdentifierNode.Create(Self, Node);
end;
function TAstVisualizer.VisitKeyword(const Node: IKeywordNode): TAuraNode;
begin
Result := TAuraKeywordNode.Create(Self, Node);
end;
function TAstVisualizer.VisitBinaryExpression(const Node: IBinaryExpressionNode): TAuraNode;
begin
Result := TAuraBinaryExpressionNode.Create(Self, Node);
end;
function TAstVisualizer.VisitBlockExpression(const Node: IBlockExpressionNode): TAuraNode;
begin
Result := TAuraBlockExpressionNode.Create(Self, Node);
end;
function TAstVisualizer.VisitCreateSeries(const Node: ICreateSeriesNode): TAuraNode;
begin
Result := TAuraCreateSeriesNode.Create(Self, Node);
end;
function TAstVisualizer.VisitFunctionCall(const Node: IFunctionCallNode): TAuraNode;
begin
Result := TAuraFunctionCallNode.Create(Self, Node);
end;
function TAstVisualizer.VisitUnaryExpression(const Node: IUnaryExpressionNode): TAuraNode;
begin
Result := TAuraUnaryExpressionNode.Create(Self, Node);
end;
function TAstVisualizer.VisitIfExpression(const Node: IIfExpressionNode): TAuraNode;
begin
Result := TAuraIfExpressionNode.Create(Self, Node);
end;
function TAstVisualizer.VisitIndexer(const Node: IIndexerNode): TAuraNode;
begin
Result := TAuraIndexerNode.Create(Self, Node);
end;
function TAstVisualizer.VisitLambdaExpression(const Node: ILambdaExpressionNode): TAuraNode;
begin
Result := TAuraLambdaExpressionNode.Create(Self, Node);
end;
function TAstVisualizer.VisitMacroDefinition(const Node: IMacroDefinitionNode): TAuraNode;
begin
Result := TAuraMacroDefinitionNode.Create(Self, Node);
end;
function TAstVisualizer.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TAuraNode;
begin
Result := TAuraMacroExpansionNode.Create(Self, Node);
end;
function TAstVisualizer.VisitMemberAccess(const Node: IMemberAccessNode): TAuraNode;
begin
Result := TAuraMemberAccessNode.Create(Self, Node);
end;
function TAstVisualizer.VisitRecordLiteral(const Node: IRecordLiteralNode): TAuraNode;
begin
Result := TAuraRecordLiteralNode.Create(Self, Node);
end;
function TAstVisualizer.VisitQuasiquote(const Node: IQuasiquoteNode): TAuraNode;
begin
Result := TAuraQuasiquoteNode.Create(Self, Node);
end;
function TAstVisualizer.VisitRecurNode(const Node: IRecurNode): TAuraNode;
begin
Result := TAuraRecurNode.Create(Self, Node);
end;
function TAstVisualizer.VisitSeriesLength(const Node: ISeriesLengthNode): TAuraNode;
begin
Result := TAuraSeriesLengthNode.Create(Self, Node);
end;
function TAstVisualizer.VisitTernaryExpression(const Node: ITernaryExpressionNode): TAuraNode;
begin
Result := TAuraTernaryExpressionNode.Create(Self, Node);
end;
function TAstVisualizer.VisitUnquote(const Node: IUnquoteNode): TAuraNode;
begin
Result := TAuraUnquoteNode.Create(Self, Node);
end;
function TAstVisualizer.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TAuraNode;
begin
Result := TAuraUnquoteSplicingNode.Create(Self, Node);
end;
function TAstVisualizer.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAuraNode;
begin
Result := TAuraVariableDeclarationNode.Create(Self, Node);
end;
{ TAutoFitControl }
constructor TAutoFitControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
HitTest := True;
FOrientation := TLayoutOrientation.loHorizontal;
FAlignment := TLayoutAlignment.laCenter; // Default alignment
end;
procedure TAutoFitControl.SetAlignment(const Value: TLayoutAlignment);
begin
if FAlignment <> Value then
begin
FAlignment := Value;
RecalcOwnSize; // Re-layout on alignment change
end;
end;
procedure TAutoFitControl.SetOrientation(const Value: TLayoutOrientation);
begin
if FOrientation <> Value then
begin
FOrientation := Value;
RecalcOwnSize; // Recalculate layout when orientation changes
end;
end;
procedure TAutoFitControl.RecalcOwnSize;
var
I: Integer;
Child: TControl;
ChildrenToLayout: TList<TControl>; // Still used to filter relevant children
CurrentX, CurrentY: Single;
RequiredWidth, RequiredHeight: Single;
ChildWidthWithMargins, ChildHeightWithMargins: Single;
HasVisibleChild: Boolean;
begin
if FUpdatingOwnSize then
Exit;
if IsUpdating then
begin
FNeedRecalcSize := True;
Exit;
end;
FUpdatingOwnSize := True;
ChildrenToLayout := nil;
try
RequiredWidth := Padding.Left + Padding.Right;
RequiredHeight := Padding.Top + Padding.Bottom;
CurrentX := Padding.Left;
CurrentY := Padding.Top;
HasVisibleChild := False;
// Collect relevant children
ChildrenToLayout := TList<TControl>.Create;
for I := 0 to ChildrenCount - 1 do
begin
if Children[I] is TControl then
begin
Child := TControl(Children[I]);
if Child.Visible and (Child.Align = TAlignLayout.None) then
begin
ChildrenToLayout.Add(Child);
HasVisibleChild := True;
end;
end;
end;
if HasVisibleChild then
begin
// Perform layout based on orientation
if FOrientation = TLayoutOrientation.loVertical then
begin
// Pass 1: Calculate total height and max width. Set Y pos.
for Child in ChildrenToLayout do
begin
// Store Y position
Child.Position.Y := CurrentY + Child.Margins.Top;
CurrentY := Child.Position.Y + Child.Height + Child.Margins.Bottom;
// Calculate max width
ChildWidthWithMargins := Padding.Left + Child.Margins.Left + Child.Width + Child.Margins.Right + Padding.Right;
RequiredWidth := System.Math.Max(RequiredWidth, ChildWidthWithMargins);
end;
RequiredHeight := CurrentY + Padding.Bottom;
// Pass 2: Align children horizontally based on FAlignment
if FAlignment = TLayoutAlignment.laFlush then
begin
// Flush (left-aligned)
for Child in ChildrenToLayout do
begin
Child.Position.X := Padding.Left + Child.Margins.Left;
end;
end
else
begin
// Center-aligned
var contentWidth := RequiredWidth - Padding.Left - Padding.Right;
for Child in ChildrenToLayout do
begin
var childTotalWidth := Child.Width + Child.Margins.Left + Child.Margins.Right;
var childX := Padding.Left + ((contentWidth - childTotalWidth) / 2) + Child.Margins.Left;
Child.Position.X := childX;
end;
end;
end
else // loHorizontal
begin
// Pass 1: Calculate total width and max height. Set X pos.
for Child in ChildrenToLayout do
begin
// Store X position
Child.Position.X := CurrentX + Child.Margins.Left;
CurrentX := Child.Position.X + Child.Width + Child.Margins.Right;
// Calculate max height
ChildHeightWithMargins := Padding.Top + Child.Margins.Top + Child.Height + Child.Margins.Bottom + Padding.Bottom;
RequiredHeight := System.Math.Max(RequiredHeight, ChildHeightWithMargins);
end;
RequiredWidth := CurrentX + Padding.Right;
// Pass 2: Align children vertically based on FAlignment
if FAlignment = TLayoutAlignment.laFlush then
begin
// Flush (top-aligned)
for Child in ChildrenToLayout do
begin
Child.Position.Y := Padding.Top + Child.Margins.Top;
end;
end
else
begin
// Center-aligned
var contentHeight := RequiredHeight - Padding.Top - Padding.Bottom;
for Child in ChildrenToLayout do
begin
var childTotalHeight := Child.Height + Child.Margins.Top + Child.Margins.Bottom;
var childY := Padding.Top + ((contentHeight - childTotalHeight) / 2) + Child.Margins.Top;
Child.Position.Y := childY;
end;
end;
end;
end
else
begin
RequiredWidth := Padding.Left + Padding.Right;
RequiredHeight := Padding.Top + Padding.Bottom;
end;
RequiredWidth := System.Math.Max(0, RequiredWidth);
RequiredHeight := System.Math.Max(0, RequiredHeight);
if not SameValue(RequiredWidth, Width, TEpsilon.Position) or not SameValue(RequiredHeight, Height, TEpsilon.Position) then
begin
FSize.SetSizeWithoutNotification(TSizeF.Create(RequiredWidth, RequiredHeight));
HandleSizeChanged;
end;
finally
ChildrenToLayout.Free;
FUpdatingOwnSize := False;
end;
end;
procedure TAutoFitControl.Loaded;
begin
inherited Loaded;
// Perform initial size calculation after all children are loaded
RecalcOwnSize;
end;
procedure TAutoFitControl.ChangeChildren;
begin
inherited ChangeChildren;
// Recalculate size when children are added or removed
RecalcOwnSize;
end;
procedure TAutoFitControl.PaddingChanged;
begin
inherited PaddingChanged;
// Recalculate size when padding changes
RecalcOwnSize;
end;
procedure TAutoFitControl.ParentContentChanged;
begin
inherited ParentContentChanged;
// Recalculate size when a child signals a potential layout change
RecalcOwnSize;
end;
procedure TAutoFitControl.DoEndUpdate;
begin
inherited;
// If a recalc was deferred during BeginUpdate/EndUpdate, do it now
if FNeedRecalcSize then
begin
FNeedRecalcSize := False;
RecalcOwnSize;
end;
end;
{ TAuraNode }
constructor TAuraNode.Create(const AVisualizer: IAstVisualizer);
begin
inherited Create(AVisualizer.Workspace);
Parent := AVisualizer.ParentControl;
FVisualizer := AVisualizer.Clone(Self, AVisualizer.ExprDepth);
FIsDragging := False;
// Default border settings
FBorderColor := TAlphaColors.Gray;
FBorderWidth := 1;
FBorderRadius := 9; // Rounded corners by default
FBackgroundColor := $080a0a0a;
// Default state for frameless mode
FFrameless := False;
// Set a default minimum size, will be adjusted later
Width := cMinNodeWidth;
Height := cMinNodeHeight;
// The panel must be able to receive mouse events.
HitTest := True; // Make sure HitTest is True to receive mouse events
// Clip children to the panel's bounds.
ClipChildren := True;
Margins.Left := 4;
Margins.Top := 4;
Margins.Right := 4;
Margins.Bottom := 4;
Padding.Left := 3;
Padding.Top := 3;
Padding.Right := 3;
Padding.Bottom := 3;
var cn: cardinal := $ea - (7 * FVisualizer.ExprDepth);
var c: cardinal := $ff000000 or (cn shl 16) or (cn shl 8) or cn;
BackgroundColor := c;
end;
destructor TAuraNode.Destroy;
begin
inherited;
end;
function TAuraNode.AddContainer(Parent: TControl; Orientation: TLayoutOrientation; Alignment: TLayoutAlignment): TAutoFitControl;
begin
Result := TAutoFitControl.Create(Self);
Result.Parent := Parent;
Result.Orientation := Orientation;
Result.Alignment := Alignment;
Result.HitTest := False; // Pass clicks to parent
end;
function TAuraNode.AddExpr(Parent: TControl; const Title: String; const Node: IAstNode): TAuraNode;
begin
var cont := AddContainer(Parent, loHorizontal, laCenter);
var lbl := AddLabel(cont, Title);
lbl.Font.Style := lbl.Font.Style + [TFontStyle.fsBold];
Result := FVisualizer.Clone(cont, FVisualizer.ExprDepth + 1).CallAccept(Node);
end;
function TAuraNode.AddLabel(Parent: TControl; const Txt: String): TLabel;
begin
Result := TLabel.Create(Self); // Owner is the node itself
Result.Parent := Parent;
Result.Position.Point := TPoint.Create(cNodePadding, cNodePadding);
Result.Margins.Left := cNodePadding;
Result.Margins.Right := cNodePadding;
Result.Margins.Top := cTitleTopPadding;
Result.Margins.Bottom := cTitleBottomPadding;
Result.WordWrap := false;
Result.AutoSize := True; // Let label determine its own size initially (do NOT use Align, because it will override AutoSize)
Result.HitTest := False; // Title label should not intercept clicks intended for the node
Result.StyledSettings := Result.StyledSettings - [TStyledSetting.Style]; // Tell FMX not to manage Font.Style via styles
Result.Text := Txt;
Result.ApplyStyleLookup;
end;
procedure TAuraNode.AfterConstruction;
begin
inherited;
SetupNode;
end;
function TAuraNode.CreateAst: IAstNode;
begin
Result := TAst.Block([]);
end;
procedure TAuraNode.Paint;
var
rect: TRectF;
begin
inherited; // Allow styled painting to occur first (if any)
// Clear background before drawing custom border/fill
Canvas.Fill.Kind := TBrushKind.None; // Make sure default fill is cleared if needed
//Canvas.ClearRect(TRectF.Create(0,0, Width, Height)); // Optional: Explicit clear
if FFrameless then
begin
Canvas.Fill.Kind := TBrushKind.Solid;
Canvas.Fill.Color := FBackgroundColor;
Canvas.Stroke.Kind := TBrushKind.None;
Canvas.FillRect(TRectF.Create(0, 0, Width, Height), 0, 0, [], 1.0);
Canvas.Stroke.Kind := TBrushKind.Solid;
Canvas.Stroke.Color := FBorderColor;
Canvas.Stroke.Thickness := 1;
Canvas.Stroke.Dash := TStrokeDash.Dot;
Canvas.DrawRect(TRectF.Create(0, 0, Width, Height), 0, 0, [], 1.0);
end
else
begin
// Draw background fill first
Canvas.Fill.Kind := TBrushKind.Solid;
Canvas.Fill.Color := FBackgroundColor;
rect := TRectF.Create(0, 0, Width, Height);
// Inflate inwards slightly if border exists to avoid overlap issues
if (FBorderWidth > 0) then
rect.Inflate(-FBorderWidth / 2, -FBorderWidth / 2);
Canvas.FillRect(rect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round);
// Custom painting for the border
if (FBorderWidth > 0) and (FBorderColor <> TAlphaColors.Null) then
begin
rect := TRectF.Create(0, 0, Width, Height);
// Inflate inwards so the border is fully visible within the control's bounds
rect.Inflate(-FBorderWidth / 2, -FBorderWidth / 2);
Canvas.Stroke.Kind := TBrushKind.Solid;
Canvas.Stroke.Color := FBorderColor;
Canvas.Stroke.Thickness := FBorderWidth;
Canvas.Stroke.Dash := TStrokeDash.Solid;
Canvas.DrawRect(rect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round);
end;
end;
// Title drawing removed, handled by external labels now.
end;
procedure TAuraNode.SetBorderColor(const Value: TAlphaColor);
begin
if FBorderColor <> Value then
begin
FBorderColor := Value;
Repaint;
end;
end;
procedure TAuraNode.SetBorderRadius(const Value: Single);
begin
if FBorderRadius <> Value then
begin
FBorderRadius := Value;
Repaint;
end;
end;
procedure TAuraNode.SetBorderWidth(const Value: Single);
begin
if FBorderWidth <> Value then
begin
FBorderWidth := Value;
Repaint;
end;
end;
procedure TAuraNode.SetFrameless(const Value: Boolean);
begin
if FFrameless <> Value then
begin
FFrameless := Value;
Repaint;
end;
end;
procedure TAuraNode.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
inherited;
if Button = TMouseButton.mbLeft then
begin
// Only start dragging if the click is on the node itself, not its children
var LControl := ObjectAtPoint(LocalToScreen(TPointF.Create(X, Y)));
if Assigned(LControl) and (LControl.GetObject = Self) then
begin
FIsDragging := True;
FDownPos := TPointF.Create(X, Y);
Capture;
BringToFront; // Bring node to front when dragging starts
end
else
FIsDragging := False; // Ensure dragging stops if click is on a child
end;
end;
procedure TAuraNode.MouseMove(Shift: TShiftState; X, Y: Single);
begin
inherited;
if FIsDragging then
begin
var deltaX := X - FDownPos.X;
var deltaY := Y - FDownPos.Y;
Position.X := Position.X + deltaX;
Position.Y := Position.Y + deltaY;
if ParentControl <> nil then
ParentControl.Repaint; // Repaint the workspace to update connections
end;
end;
procedure TAuraNode.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
inherited;
if (Button = TMouseButton.mbLeft) and (FIsDragging) then
begin
ReleaseCapture;
FIsDragging := False;
if ParentControl <> nil then // Repaint one last time after drag ends
ParentControl.Repaint;
end;
end;
procedure TAuraNode.SetBackgroundColor(const Value: TAlphaColor);
begin
FBackgroundColor := Value;
Repaint;
end;
procedure TAuraNode.SetupNode;
begin
end;
{ TAuraConstantNode }
constructor TAuraConstantNode.Create(const AVisualizer: IAstVisualizer; const ANode: IConstantNode);
begin
inherited Create(AVisualizer);
FNode := ANode;
end;
function TAuraConstantNode.CreateAst: IAstNode;
begin
Result := FNode;
end;
procedure TAuraConstantNode.SetupNode;
var
valueStr: string;
isConcise: Boolean;
begin
BeginUpdate;
try
valueStr := FNode.Value.ToString;
// Check if it's a number or a single-line text and not excessively long
isConcise := ((FNode.Value.Kind = TDataValueKind.vkScalar) or (Pos(sLineBreak, valueStr) = 0)) and (Length(valueStr) < 40);
if isConcise then
begin
// Display value directly in a centered label, frameless node
Frameless := true;
AddLabel(Self, valueStr);
end
else
begin
// Use standard framed node with Title label + Value label
Frameless := False;
Orientation := loVertical;
var titleLabel := AddLabel(Self, 'Const');
titleLabel.Font.Style := titleLabel.Font.Style + [TFontStyle.fsBold];
// Value Label
var valueLabel := AddLabel(Self, valueStr);
valueLabel.AutoSize := False; // ***Important: Disable AutoSize when Align=Client***
valueLabel.WordWrap := True; // Allow wrapping for long text
end;
finally
EndUpdate;
end;
end;
{ TAuraIdentifierNode }
constructor TAuraIdentifierNode.Create(const AVisualizer: IAstVisualizer; const ANode: IIdentifierNode);
begin
inherited Create(AVisualizer);
FNode := ANode;
end;
function TAuraIdentifierNode.CreateAst: IAstNode;
begin
Result := TAst.Identifier(FNode.Name);
end;
procedure TAuraIdentifierNode.SetupNode;
begin
BeginUpdate;
try
Frameless := true; // Identifiers are frameless
AddLabel(Self, FNode.Name); // Add label with the identifier name
finally
EndUpdate;
end;
end;
{ TAuraKeywordNode }
constructor TAuraKeywordNode.Create(const AVisualizer: IAstVisualizer; const ANode: IKeywordNode);
begin
inherited Create(AVisualizer);
FNode := ANode;
end;
function TAuraKeywordNode.CreateAst: IAstNode;
begin
Result := FNode; // Keywords are literals, return original node
end;
procedure TAuraKeywordNode.SetupNode;
begin
BeginUpdate;
try
Frameless := true;
var lbl := AddLabel(Self, ':' + FNode.Value.Name);
lbl.StyledSettings := lbl.StyledSettings - [TStyledSetting.FontColor];
lbl.FontColor := TAlphaColors.Mediumvioletred;
finally
EndUpdate;
end;
end;
{ TAuraBinaryExpressionNode }
constructor TAuraBinaryExpressionNode.Create(const AVisualizer: IAstVisualizer; const ANode: IBinaryExpressionNode);
begin
inherited Create(AVisualizer);
FNode := ANode;
end;
function TAuraBinaryExpressionNode.CreateAst: IAstNode;
begin
Result := TAst.BinaryExpr(LeftNode.CreateAst, FNode.Operator, RightNode.CreateAst);
end;
function TAuraBinaryExpressionNode.GetLeftNode: TAuraNode;
begin
Result := Children[0] as TAuraNode;
end;
function TAuraBinaryExpressionNode.GetRightNode: TAuraNode;
begin
Result := Children[2] as TAuraNode;
end;
procedure TAuraBinaryExpressionNode.SetupNode;
begin
var visu := FVisualizer.Clone(Self, FVisualizer.ExprDepth + 1);
BeginUpdate;
try
Frameless := true; // Generally make binary expressions frameless containers
Orientation := loHorizontal;
visu.CallAccept(FNode.Left);
// 2. Operator Label
AddLabel(Self, FNode.Operator.ToString);
// 3. RightNode Expression Node (Visited Recursively)
visu.CallAccept(FNode.Right);
finally
EndUpdate;
end;
end;
{ TAuraBlockExpressionNode }
constructor TAuraBlockExpressionNode.Create(const AVisualizer: IAstVisualizer; const ANode: IBlockExpressionNode);
begin
inherited Create(AVisualizer);
FNode := ANode;
FChildNodes := TList<TAuraNode>.Create;
end;
destructor TAuraBlockExpressionNode.Destroy;
begin
FChildNodes.Free;
inherited Destroy;
end;
function TAuraBlockExpressionNode.CreateAst: IAstNode;
var
exprs: TArray<IAstNode>;
childNode: TAuraNode;
i: Integer;
begin
SetLength(exprs, FChildNodes.Count);
for i := 0 to FChildNodes.Count - 1 do
begin
childNode := FChildNodes[i];
if Assigned(childNode) then
exprs[i] := childNode.CreateAst
else
exprs[i] := TAst.Constant(TDataValue.Void); // Or handle error
end;
Result := TAst.Block(exprs);
end;
procedure TAuraBlockExpressionNode.SetupNode;
var
visu: IAstVisualizer;
childNode: TAuraNode;
expr: IAstNode;
titleLabel: TLabel;
i: Integer;
returnContainer: TAutoFitControl;
visuReturn: IAstVisualizer;
begin
// This visualizer parents children directly to Self
visu := FVisualizer.Clone(Self, FVisualizer.ExprDepth + 1);
BeginUpdate;
try
Frameless := true;
Orientation := loVertical;
Alignment := laFlush; // Align all child rows to the left
for i := 0 to High(FNode.Expressions) do
begin
expr := FNode.Expressions[i];
if i = High(FNode.Expressions) then
begin
// Last expression: create a horizontal container for "return [expr]"
returnContainer := AddContainer(Self, loHorizontal, laCenter);
// Add "return" label to the container
titleLabel := AddLabel(returnContainer, 'return'); // Use AddLabel from TAuraNode (Self)
titleLabel.Font.Style := titleLabel.Font.Style + [TFontStyle.fsBold];
// Create a new visualizer targeting this container
visuReturn := FVisualizer.Clone(returnContainer, FVisualizer.ExprDepth + 1);
// Add the expression node to the container
childNode := visuReturn.CallAccept(expr);
FChildNodes.Add(childNode); // Store for CreateAst
end
else
begin
// Not the last expression, add directly to Self
childNode := visu.CallAccept(expr);
FChildNodes.Add(childNode); // Store for CreateAst
end;
end;
finally
EndUpdate;
end;
end;
{ TAuraUnaryExpressionNode }
constructor TAuraUnaryExpressionNode.Create(const AVisualizer: IAstVisualizer; const ANode: IUnaryExpressionNode);
begin
inherited Create(AVisualizer);
FNode := ANode;
end;
function TAuraUnaryExpressionNode.CreateAst: IAstNode;
begin
Result := TAst.UnaryExpr(FNode.Operator, FChildNode.CreateAst);
end;
procedure TAuraUnaryExpressionNode.SetupNode;
var
visu: IAstVisualizer;
titleLabel: TLabel;
begin
visu := FVisualizer.Clone(Self, FVisualizer.ExprDepth + 1);
BeginUpdate;
try
// Vertical layout, framed
Frameless := False;
Orientation := loVertical;
// Title
titleLabel := AddLabel(Self, 'Unary Op: ' + FNode.Operator.ToString);
titleLabel.Font.Style := titleLabel.Font.Style + [TFontStyle.fsBold];
// Child
FChildNode := visu.CallAccept(FNode.Right);
finally
EndUpdate;
end;
end;
{ TAuraIfExpressionNode }
constructor TAuraIfExpressionNode.Create(const AVisualizer: IAstVisualizer; const ANode: IIfExpressionNode);
begin
inherited Create(AVisualizer);
FNode := ANode;
FElseNode := nil;
end;
function TAuraIfExpressionNode.CreateAst: IAstNode;
var
elseAst: IAstNode;
begin
if Assigned(FElseNode) then
elseAst := FElseNode.CreateAst
else
elseAst := nil;
Result := TAst.IfExpr(FConditionNode.CreateAst, FThenNode.CreateAst, elseAst);
end;
procedure TAuraIfExpressionNode.SetupNode;
begin
BeginUpdate;
try
Frameless := False;
Orientation := loVertical;
Alignment := laFlush;
FConditionNode := AddExpr(Self, 'if', FNode.Condition);
FThenNode := AddExpr(Self, 'then', FNode.ThenBranch);
if Assigned(FNode.ElseBranch) then
FElseNode := AddExpr(Self, 'else', FNode.ElseBranch);
finally
EndUpdate;
end;
end;
{ TAuraTernaryExpressionNode }
constructor TAuraTernaryExpressionNode.Create(const AVisualizer: IAstVisualizer; const ANode: ITernaryExpressionNode);
begin
inherited Create(AVisualizer);
FNode := ANode;
end;
function TAuraTernaryExpressionNode.CreateAst: IAstNode;
begin
Result := TAst.TernaryExpr(FConditionNode.CreateAst, FThenNode.CreateAst, FElseNode.CreateAst);
end;
procedure TAuraTernaryExpressionNode.SetupNode;
var
visu: IAstVisualizer;
begin
visu := FVisualizer.Clone(Self, FVisualizer.ExprDepth + 1);
BeginUpdate;
try
Frameless := True; // Horizontal layout
Orientation := loHorizontal;
FConditionNode := visu.CallAccept(FNode.Condition);
AddLabel(Self, '?');
FThenNode := visu.CallAccept(FNode.ThenBranch);
AddLabel(Self, ':');
FElseNode := visu.CallAccept(FNode.ElseBranch);
finally
EndUpdate;
end;
end;
{ TAuraLambdaExpressionNode }
constructor TAuraLambdaExpressionNode.Create(const AVisualizer: IAstVisualizer; const ANode: ILambdaExpressionNode);
begin
inherited Create(AVisualizer);
FNode := ANode;
FParamLabels := TList<TLabel>.Create;
end;
destructor TAuraLambdaExpressionNode.Destroy;
begin
FParamLabels.Free;
inherited Destroy;
end;
function TAuraLambdaExpressionNode.CreateAst: IAstNode;
begin
Result := TAst.LambdaExpr(FNode.Parameters, FBodyNode.CreateAst);
end;
procedure TAuraLambdaExpressionNode.SetupNode;
var
visu: IAstVisualizer;
titleContainer: TAutoFitControl;
paramLabel: TLabel;
i: Integer;
begin
visu := FVisualizer.Clone(Self, 0);
BeginUpdate;
try
Frameless := False;
Orientation := loVertical; // Main node is vertical
Alignment := laFlush;
BackgroundColor := $090000ff;
// Create a horizontal container for the title/params
titleContainer := AddContainer(Self, loHorizontal, laCenter);
// 1. Lambda Symbol Label (Title)
paramLabel := AddLabel(Self, WideChar($03BB)); // Lambda
paramLabel.Parent := titleContainer; // Add to title container
paramLabel.Font.Style := paramLabel.Font.Style + [TFontStyle.fsBold];
// 2. Add Parameters
paramLabel := AddLabel(Self, '(');
paramLabel.Parent := titleContainer;
FParamLabels.Add(paramLabel);
for i := 0 to High(FNode.Parameters) do
begin
paramLabel := AddLabel(Self, FNode.Parameters[i].Name);
paramLabel.Parent := titleContainer;
FParamLabels.Add(paramLabel);
if i < High(FNode.Parameters) then
begin
paramLabel := AddLabel(Self, ',');
paramLabel.Parent := titleContainer;
FParamLabels.Add(paramLabel);
end;
end;
paramLabel := AddLabel(Self, ')');
paramLabel.Parent := titleContainer;
FParamLabels.Add(paramLabel);
// 3. Body
FBodyNode := visu.CallAccept(FNode.Body);
FBodyNode.Frameless := false;
finally
EndUpdate;
end;
end;
{ TAuraFunctionCallNode }
constructor TAuraFunctionCallNode.Create(const AVisualizer: IAstVisualizer; const ANode: IFunctionCallNode);
begin
inherited Create(AVisualizer);
FNode := ANode;
FArgumentNodes := TList<TAuraNode>.Create;
end;
destructor TAuraFunctionCallNode.Destroy;
begin
FArgumentNodes.Free;
inherited Destroy;
end;
function TAuraFunctionCallNode.CreateAst: IAstNode;
var
args: TArray<IAstNode>;
i: Integer;
begin
SetLength(args, FArgumentNodes.Count);
for i := 0 to FArgumentNodes.Count - 1 do
args[i] := FArgumentNodes[i].CreateAst;
Result := TAst.FunctionCall(FCalleeNode.CreateAst, args);
end;
procedure TAuraFunctionCallNode.SetupNode;
var
visu: IAstVisualizer;
i: Integer;
argNode: TAuraNode;
begin
visu := FVisualizer.Clone(Self, FVisualizer.ExprDepth + 1);
BeginUpdate;
try
Frameless := True; // Horizontal layout
Orientation := loHorizontal;
var callLabel := AddLabel(Self, 'call ');
callLabel.Font.Style := callLabel.Font.Style + [TFontStyle.fsBold];
// Callee
FCalleeNode := visu.CallAccept(FNode.Callee);
// Arguments
if Length(FNode.Arguments) > 0 then
begin
AddLabel(Self, '(');
for i := 0 to High(FNode.Arguments) do
begin
argNode := visu.CallAccept(FNode.Arguments[i]);
FArgumentNodes.Add(argNode);
if i < High(FNode.Arguments) then
AddLabel(Self, ',');
end;
AddLabel(Self, ')');
end;
finally
EndUpdate;
end;
end;
{ TAuraMacroExpansionNode }
constructor TAuraMacroExpansionNode.Create(const AVisualizer: IAstVisualizer; const ANode: IMacroExpansionNode);
begin
inherited Create(AVisualizer);
FNode := ANode;
end;
function TAuraMacroExpansionNode.CreateAst: IAstNode;
begin
// Re-create the node using the original FNode (which is an IFunctionCallNode)
// and the CreateAst of the expanded body.
Result := TAst.MacroExpansionNode(FNode, FExpandedBodyNode.CreateAst);
end;
procedure TAuraMacroExpansionNode.SetupNode;
var
visu: IAstVisualizer;
titleLabel: TLabel;
begin
visu := FVisualizer.Clone(Self, FVisualizer.ExprDepth + 1);
BeginUpdate;
try
Frameless := False;
Orientation := loVertical;
titleLabel := AddLabel(Self, 'Macro Expansion');
titleLabel.Font.Style := titleLabel.Font.Style + [TFontStyle.fsBold];
FExpandedBodyNode := visu.CallAccept(FNode.ExpandedBody);
finally
EndUpdate;
end;
end;
{ TAuraRecurNode }
constructor TAuraRecurNode.Create(const AVisualizer: IAstVisualizer; const ANode: IRecurNode);
begin
inherited Create(AVisualizer);
FNode := ANode;
FArgumentNodes := TList<TAuraNode>.Create;
end;
destructor TAuraRecurNode.Destroy;
begin
FArgumentNodes.Free;
inherited Destroy;
end;
function TAuraRecurNode.CreateAst: IAstNode;
var
args: TArray<IAstNode>;
i: Integer;
begin
SetLength(args, FArgumentNodes.Count);
for i := 0 to FArgumentNodes.Count - 1 do
args[i] := FArgumentNodes[i].CreateAst;
Result := TAst.Recur(args);
end;
procedure TAuraRecurNode.SetupNode;
var
visu: IAstVisualizer;
i: Integer;
argNode: TAuraNode;
titleLabel: TLabel;
begin
visu := FVisualizer.Clone(Self, FVisualizer.ExprDepth + 1);
BeginUpdate;
try
Frameless := True; // Horizontal layout
Orientation := loHorizontal;
// 1. 'recur' keyword
titleLabel := AddLabel(Self, WideChar($03BB));
titleLabel.Font.Style := titleLabel.Font.Style + [TFontStyle.fsBold];
// 2. Arguments
AddLabel(Self, '(');
for i := 0 to High(FNode.Arguments) do
begin
argNode := visu.CallAccept(FNode.Arguments[i]);
FArgumentNodes.Add(argNode);
if i < High(FNode.Arguments) then
AddLabel(Self, ',');
end;
AddLabel(Self, ')');
finally
EndUpdate;
end;
end;
{ TAuraVariableDeclarationNode }
constructor TAuraVariableDeclarationNode.Create(const AVisualizer: IAstVisualizer; const ANode: IVariableDeclarationNode);
begin
inherited Create(AVisualizer);
FNode := ANode;
FInitializerNode := nil;
end;
function TAuraVariableDeclarationNode.CreateAst: IAstNode;
var
initAst: IAstNode;
begin
if Assigned(FInitializerNode) then
initAst := FInitializerNode.CreateAst
else
initAst := nil;
// Re-create the identifier node from the original FNode
Result := TAst.VarDecl(TAst.Identifier(FNode.Identifier.Name), initAst);
end;
procedure TAuraVariableDeclarationNode.SetupNode;
var
visu: IAstVisualizer;
varLabel: TLabel;
begin
visu := FVisualizer.Clone(Self, FVisualizer.ExprDepth + 1);
BeginUpdate;
try
Frameless := True; // Horizontal layout
Orientation := loHorizontal;
varLabel := AddLabel(Self, 'var');
varLabel.Font.Style := varLabel.Font.Style + [TFontStyle.fsBold];
// Add identifier name as a label
AddLabel(Self, FNode.Identifier.Name);
if Assigned(FNode.Initializer) then
begin
AddLabel(Self, ':=');
FInitializerNode := visu.CallAccept(FNode.Initializer);
end;
finally
EndUpdate;
end;
end;
{ TAuraAssignmentNode }
constructor TAuraAssignmentNode.Create(const AVisualizer: IAstVisualizer; const ANode: IAssignmentNode);
begin
inherited Create(AVisualizer);
FNode := ANode;
end;
function TAuraAssignmentNode.CreateAst: IAstNode;
begin
// Re-create identifier from FNode
Result := TAst.Assign(TAst.Identifier(FNode.Identifier.Name), FValueNode.CreateAst);
end;
procedure TAuraAssignmentNode.SetupNode;
var
visu: IAstVisualizer;
begin
visu := FVisualizer.Clone(Self, FVisualizer.ExprDepth + 1);
BeginUpdate;
try
Frameless := True; // Horizontal layout
Orientation := loHorizontal;
// Add identifier name as a label
AddLabel(Self, FNode.Identifier.Name);
AddLabel(Self, ':=');
FValueNode := visu.CallAccept(FNode.Value);
finally
EndUpdate;
end;
end;
{ TAuraMacroDefinitionNode }
constructor TAuraMacroDefinitionNode.Create(const AVisualizer: IAstVisualizer; const ANode: IMacroDefinitionNode);
begin
inherited Create(AVisualizer);
FNode := ANode;
end;
function TAuraMacroDefinitionNode.CreateAst: IAstNode;
begin
// This assumes FBodyNode will create a valid IQuasiquoteNode.
Result :=
TAst.MacroDef(
TAst.Identifier(FNode.Name.Name),
FNode.Parameters, // Re-use original parameters
IQuasiquoteNode(FBodyNode.CreateAst)
);
end;
procedure TAuraMacroDefinitionNode.SetupNode;
var
visu: IAstVisualizer;
titleLabel: TLabel;
paramStr: string;
i: Integer;
begin
visu := FVisualizer.Clone(Self, FVisualizer.ExprDepth + 1);
BeginUpdate;
try
Frameless := False;
Orientation := loVertical;
// Build parameter string
paramStr := '';
for i := 0 to High(FNode.Parameters) do
begin
if i > 0 then
paramStr := paramStr + ', ';
paramStr := paramStr + FNode.Parameters[i].Name;
end;
titleLabel := AddLabel(Self, 'Macro Def: ' + FNode.Name.Name + ' (' + paramStr + ')');
titleLabel.Font.Style := titleLabel.Font.Style + [TFontStyle.fsBold];
FBodyNode := visu.CallAccept(FNode.Body);
finally
EndUpdate;
end;
end;
{ TAuraQuasiquoteNode }
constructor TAuraQuasiquoteNode.Create(const AVisualizer: IAstVisualizer; const ANode: IQuasiquoteNode);
begin
inherited Create(AVisualizer);
FNode := ANode;
end;
function TAuraQuasiquoteNode.CreateAst: IAstNode;
begin
Result := TAst.Quasiquote(FExpressionNode.CreateAst);
end;
procedure TAuraQuasiquoteNode.SetupNode;
var
visu: IAstVisualizer;
titleLabel: TLabel;
begin
visu := FVisualizer.Clone(Self, FVisualizer.ExprDepth + 1);
BeginUpdate;
try
Frameless := False;
Orientation := loVertical;
titleLabel := AddLabel(Self, 'Quasiquote');
titleLabel.Font.Style := titleLabel.Font.Style + [TFontStyle.fsBold];
FExpressionNode := visu.CallAccept(FNode.Expression);
finally
EndUpdate;
end;
end;
{ TAuraUnquoteNode }
constructor TAuraUnquoteNode.Create(const AVisualizer: IAstVisualizer; const ANode: IUnquoteNode);
begin
inherited Create(AVisualizer);
FNode := ANode;
end;
function TAuraUnquoteNode.CreateAst: IAstNode;
begin
Result := TAst.Unquote(FExpressionNode.CreateAst);
end;
procedure TAuraUnquoteNode.SetupNode;
var
visu: IAstVisualizer;
begin
visu := FVisualizer.Clone(Self, FVisualizer.ExprDepth + 1);
BeginUpdate;
try
Frameless := True; // Horizontal layout
Orientation := loHorizontal;
var leftBracket := AddLabel(Self, '<');
leftBracket.Padding.Right := 0;
leftBracket.Margins.Right := 0;
FExpressionNode := visu.CallAccept(FNode.Expression);
var rightBracket := AddLabel(Self, '>');
rightBracket.Padding.Left := 0;
rightBracket.Margins.Left := 0;
finally
EndUpdate;
end;
end;
{ TAuraUnquoteSplicingNode }
constructor TAuraUnquoteSplicingNode.Create(const AVisualizer: IAstVisualizer; const ANode: IUnquoteSplicingNode);
begin
inherited Create(AVisualizer);
FNode := ANode;
end;
function TAuraUnquoteSplicingNode.CreateAst: IAstNode;
begin
Result := TAst.UnquoteSplicing(FExpressionNode.CreateAst.AsQuasiquote);
end;
procedure TAuraUnquoteSplicingNode.SetupNode;
var
visu: IAstVisualizer;
titleLabel: TLabel;
begin
visu := FVisualizer.Clone(Self, FVisualizer.ExprDepth + 1);
BeginUpdate;
try
Frameless := False;
Orientation := loVertical;
titleLabel := AddLabel(Self, 'Unquote-Splicing');
titleLabel.Font.Style := titleLabel.Font.Style + [TFontStyle.fsBold];
FExpressionNode := visu.CallAccept(FNode.Expression);
finally
EndUpdate;
end;
end;
{ TAuraIndexerNode }
constructor TAuraIndexerNode.Create(const AVisualizer: IAstVisualizer; const ANode: IIndexerNode);
begin
inherited Create(AVisualizer);
FNode := ANode;
end;
function TAuraIndexerNode.CreateAst: IAstNode;
begin
Result := TAst.Indexer(FBaseNode.CreateAst, FIndexNode.CreateAst);
end;
procedure TAuraIndexerNode.SetupNode;
var
visu: IAstVisualizer;
begin
visu := FVisualizer.Clone(Self, FVisualizer.ExprDepth + 1);
BeginUpdate;
try
Frameless := True; // Horizontal layout: Base[Index]
Orientation := loHorizontal;
FBaseNode := visu.CallAccept(FNode.Base);
AddLabel(Self, '[');
FIndexNode := visu.CallAccept(FNode.Index);
AddLabel(Self, ']');
finally
EndUpdate;
end;
end;
{ TAuraMemberAccessNode }
constructor TAuraMemberAccessNode.Create(const AVisualizer: IAstVisualizer; const ANode: IMemberAccessNode);
begin
inherited Create(AVisualizer);
FNode := ANode;
end;
function TAuraMemberAccessNode.CreateAst: IAstNode;
begin
// Re-create identifier from FNode
Result := TAst.MemberAccess(FBaseNode.CreateAst, TAst.Keyword(FNode.Member.Value.Name));
end;
procedure TAuraMemberAccessNode.SetupNode;
var
visu: IAstVisualizer;
begin
visu := FVisualizer.Clone(Self, FVisualizer.ExprDepth + 1);
BeginUpdate;
try
Frameless := True; // Horizontal layout: Base.Member
Orientation := loHorizontal;
FBaseNode := visu.CallAccept(FNode.Base);
AddLabel(Self, '.');
// Add member name as a label
AddLabel(Self, FNode.Member.Value.Name);
finally
EndUpdate;
end;
end;
{ TAuraRecordLiteralNode }
constructor TAuraRecordLiteralNode.Create(const AVisualizer: IAstVisualizer; const ANode: IRecordLiteralNode);
begin
inherited Create(AVisualizer);
FNode := ANode;
FFieldNodes := TDictionary<IKeyword, TAuraNode>.Create;
end;
destructor TAuraRecordLiteralNode.Destroy;
begin
FFieldNodes.Free;
inherited Destroy;
end;
function TAuraRecordLiteralNode.CreateAst: IAstNode;
var
fields: TArray<TRecordFieldLiteral>;
i: Integer;
valueNode: TAuraNode;
pair: TPair<IKeyword, TAuraNode>;
begin
SetLength(fields, FFieldNodes.Count);
i := 0;
// Note: TDictionary iteration order is not guaranteed,
// but TScalarRecordDefinition is looked up by name, so order doesn't matter.
for pair in FFieldNodes do
begin
valueNode := pair.Value;
fields[i] := TRecordFieldLiteral.Create(TKeywordNode.Create(pair.Key), valueNode.CreateAst);
inc(i);
end;
Result := TAst.RecordLiteral(fields);
end;
procedure TAuraRecordLiteralNode.SetupNode;
var
field: TRecordFieldLiteral;
fieldContainer: TAutoFitControl;
valueNode: TAuraNode;
keyLabel: TLabel;
begin
BeginUpdate;
try
Frameless := False;
Orientation := loVertical;
Alignment := laFlush; // Align fields to the left
if Length(FNode.Fields) = 0 then
begin
AddLabel(Self, '{}');
end
else
begin
for field in FNode.Fields do
begin
// Create a horizontal container for the key-value pair
fieldContainer := AddContainer(Self, loHorizontal, laCenter);
// Key label
keyLabel := AddLabel(fieldContainer, ':' + field.Key.Value.Name);
keyLabel.Font.Style := keyLabel.Font.Style + [TFontStyle.fsBold];
keyLabel.StyledSettings := keyLabel.StyledSettings - [TStyledSetting.FontColor];
keyLabel.FontColor := TAlphaColors.Mediumvioletred;
// Value node
valueNode := FVisualizer.Clone(fieldContainer, FVisualizer.ExprDepth + 1).CallAccept(field.Value);
// Store for CreateAst
FFieldNodes.Add(field.Key.Value, valueNode);
end;
end;
finally
EndUpdate;
end;
end;
{ TAuraCreateSeriesNode }
constructor TAuraCreateSeriesNode.Create(const AVisualizer: IAstVisualizer; const ANode: ICreateSeriesNode);
begin
inherited Create(AVisualizer);
FNode := ANode;
end;
function TAuraCreateSeriesNode.CreateAst: IAstNode;
begin
Result := TAst.CreateSeries(FNode.Definition);
end;
procedure TAuraCreateSeriesNode.SetupNode;
var
titleLabel: TLabel;
begin
BeginUpdate;
try
Frameless := False; // Leaf node, but framed
Orientation := loVertical;
titleLabel := AddLabel(Self, 'Create Series: ' + FNode.Definition);
titleLabel.Font.Style := titleLabel.Font.Style + [TFontStyle.fsBold];
finally
EndUpdate;
end;
end;
{ TAuraAddSeriesItemNode }
constructor TAuraAddSeriesItemNode.Create(const AVisualizer: IAstVisualizer; const ANode: IAddSeriesItemNode);
begin
inherited Create(AVisualizer);
FNode := ANode;
FLookbackNode := nil;
end;
function TAuraAddSeriesItemNode.CreateAst: IAstNode;
var
lookbackAst: IAstNode;
begin
if Assigned(FLookbackNode) then
lookbackAst := FLookbackNode.CreateAst
else
lookbackAst := nil;
Result := TAst.AddSeriesItem(TAst.Identifier(FNode.Series.Name), FValueNode.CreateAst, lookbackAst);
end;
procedure TAuraAddSeriesItemNode.SetupNode;
var
visu: IAstVisualizer;
titleLabel: TLabel;
begin
visu := FVisualizer.Clone(Self, FVisualizer.ExprDepth + 1);
BeginUpdate;
try
Frameless := False;
Orientation := loVertical;
titleLabel := AddLabel(Self, 'Add Item to: ' + FNode.Series.Name);
titleLabel.Font.Style := titleLabel.Font.Style + [TFontStyle.fsBold];
FValueNode := visu.CallAccept(FNode.Value);
if Assigned(FNode.Lookback) then
FLookbackNode := visu.CallAccept(FNode.Lookback);
finally
EndUpdate;
end;
end;
{ TAuraSeriesLengthNode }
constructor TAuraSeriesLengthNode.Create(const AVisualizer: IAstVisualizer; const ANode: ISeriesLengthNode);
begin
inherited Create(AVisualizer);
FNode := ANode;
end;
function TAuraSeriesLengthNode.CreateAst: IAstNode;
begin
Result := TAst.SeriesLength(TAst.Identifier(FNode.Series.Name));
end;
procedure TAuraSeriesLengthNode.SetupNode;
var
titleLabel: TLabel;
begin
BeginUpdate;
try
Frameless := False; // Leaf node, but framed
Orientation := loVertical;
titleLabel := AddLabel(Self, 'Length of: ' + FNode.Series.Name);
titleLabel.Font.Style := titleLabel.Font.Style + [TFontStyle.fsBold];
finally
EndUpdate;
end;
end;
end.