Michael Schimmel
2304 lines
72 KiB
ObjectPascal
2304 lines
72 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; // Forward declaration
|
|
|
|
// This aggregate interface encapsulates all node-specific logic.
|
|
IAuraNodeHandler = interface
|
|
['{B66291B7-14A1-4638-927A-05B1623C83A6}']
|
|
// Gets the original logical AST node
|
|
function GetAstNode: IAstNode;
|
|
// Creates the specific FMX UI for this node
|
|
procedure BuildUI(OwnerNode: TAuraNode);
|
|
// Reconstructs the logical AST node from the FMX UI state
|
|
function ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
// The original logical AST node
|
|
property Node: IAstNode read GetAstNode;
|
|
end;
|
|
|
|
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 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;
|
|
function VisitNop(const Node: INopNode): 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;
|
|
FHandler: IAuraNodeHandler; // *** NEW: Strategy/Aggregate ***
|
|
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);
|
|
function GetNode: IAstNode;
|
|
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;
|
|
procedure SetupNode;
|
|
|
|
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; const AHandler: IAuraNodeHandler); reintroduce;
|
|
destructor Destroy; override;
|
|
|
|
procedure AfterConstruction; override;
|
|
|
|
// *** CHANGED: Now non-virtual, delegates to handler ***
|
|
function CreateAst: IAstNode;
|
|
|
|
property Visualizer: IAstVisualizer read FVisualizer;
|
|
// *** NEW: Access to the original logical node via the handler ***
|
|
property Node: IAstNode read GetNode;
|
|
|
|
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;
|
|
|
|
implementation
|
|
|
|
// We declare the handler classes here in the implementation
|
|
// as they are private details of the visualizer.
|
|
|
|
type
|
|
{ TConstantNodeHandler }
|
|
TConstantNodeHandler = class(TInterfacedObject, IAuraNodeHandler)
|
|
private
|
|
FNode: IConstantNode;
|
|
function GetAstNode: IAstNode;
|
|
public
|
|
constructor Create(const ANode: IConstantNode);
|
|
procedure BuildUI(OwnerNode: TAuraNode);
|
|
function ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
end;
|
|
|
|
{ TAuraIdentifierNode }
|
|
TIdentifierNodeHandler = class(TInterfacedObject, IAuraNodeHandler)
|
|
private
|
|
FNode: IIdentifierNode;
|
|
function GetAstNode: IAstNode;
|
|
public
|
|
constructor Create(const ANode: IIdentifierNode);
|
|
procedure BuildUI(OwnerNode: TAuraNode);
|
|
function ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
end;
|
|
|
|
{ TAuraKeywordNode }
|
|
TKeywordNodeHandler = class(TInterfacedObject, IAuraNodeHandler)
|
|
private
|
|
FNode: IKeywordNode;
|
|
function GetAstNode: IAstNode;
|
|
public
|
|
constructor Create(const ANode: IKeywordNode);
|
|
procedure BuildUI(OwnerNode: TAuraNode);
|
|
function ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
end;
|
|
|
|
{ TAuraBlockExpressionNode }
|
|
TBlockExpressionNodeHandler = class(TInterfacedObject, IAuraNodeHandler)
|
|
private
|
|
FNode: IBlockExpressionNode;
|
|
FChildNodes: TList<TAuraNode>; // To store children for CreateAst
|
|
function GetAstNode: IAstNode;
|
|
public
|
|
constructor Create(const ANode: IBlockExpressionNode);
|
|
destructor Destroy; override;
|
|
procedure BuildUI(OwnerNode: TAuraNode);
|
|
function ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
end;
|
|
|
|
{ TAuraIfExpressionNode }
|
|
TIfExpressionNodeHandler = class(TInterfacedObject, IAuraNodeHandler)
|
|
private
|
|
FNode: IIfExpressionNode;
|
|
FConditionNode: TAuraNode;
|
|
FThenNode: TAuraNode;
|
|
FElseNode: TAuraNode; // Can be nil
|
|
function GetAstNode: IAstNode;
|
|
public
|
|
constructor Create(const ANode: IIfExpressionNode);
|
|
procedure BuildUI(OwnerNode: TAuraNode);
|
|
function ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
end;
|
|
|
|
{ TAuraTernaryExpressionNode }
|
|
TTernaryExpressionNodeHandler = class(TInterfacedObject, IAuraNodeHandler)
|
|
private
|
|
FNode: ITernaryExpressionNode;
|
|
FConditionNode: TAuraNode;
|
|
FThenNode: TAuraNode;
|
|
FElseNode: TAuraNode;
|
|
function GetAstNode: IAstNode;
|
|
public
|
|
constructor Create(const ANode: ITernaryExpressionNode);
|
|
procedure BuildUI(OwnerNode: TAuraNode);
|
|
function ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
end;
|
|
|
|
{ TAuraLambdaExpressionNode }
|
|
TLambdaExpressionNodeHandler = class(TInterfacedObject, IAuraNodeHandler)
|
|
private
|
|
FNode: ILambdaExpressionNode;
|
|
FBodyNode: TAuraNode;
|
|
FParamLabels: TList<TLabel>; // To store param labels
|
|
function GetAstNode: IAstNode;
|
|
public
|
|
constructor Create(const ANode: ILambdaExpressionNode);
|
|
destructor Destroy; override;
|
|
procedure BuildUI(OwnerNode: TAuraNode);
|
|
function ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
end;
|
|
|
|
{ TAuraFunctionCallNode }
|
|
TFunctionCallNodeHandler = class(TInterfacedObject, IAuraNodeHandler)
|
|
private
|
|
FNode: IFunctionCallNode;
|
|
FCalleeNode: TAuraNode;
|
|
FArgumentNodes: TList<TAuraNode>;
|
|
function GetAstNode: IAstNode;
|
|
public
|
|
constructor Create(const ANode: IFunctionCallNode);
|
|
destructor Destroy; override;
|
|
procedure BuildUI(OwnerNode: TAuraNode);
|
|
function ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
end;
|
|
|
|
{ TAuraMacroExpansionNode }
|
|
TMacroExpansionNodeHandler = class(TInterfacedObject, IAuraNodeHandler)
|
|
private
|
|
FNode: IMacroExpansionNode;
|
|
FExpandedBodyNode: TAuraNode;
|
|
function GetAstNode: IAstNode;
|
|
public
|
|
constructor Create(const ANode: IMacroExpansionNode);
|
|
procedure BuildUI(OwnerNode: TAuraNode);
|
|
function ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
end;
|
|
|
|
{ TAuraRecurNode }
|
|
TRecurNodeHandler = class(TInterfacedObject, IAuraNodeHandler)
|
|
private
|
|
FNode: IRecurNode;
|
|
FArgumentNodes: TList<TAuraNode>;
|
|
function GetAstNode: IAstNode;
|
|
public
|
|
constructor Create(const ANode: IRecurNode);
|
|
destructor Destroy; override;
|
|
procedure BuildUI(OwnerNode: TAuraNode);
|
|
function ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
end;
|
|
|
|
{ TAuraVariableDeclarationNode }
|
|
TVariableDeclarationNodeHandler = class(TInterfacedObject, IAuraNodeHandler)
|
|
private
|
|
FNode: IVariableDeclarationNode;
|
|
FTargetNode: TAuraNode;
|
|
FInitializerNode: TAuraNode; // Can be nil
|
|
function GetAstNode: IAstNode;
|
|
public
|
|
constructor Create(const ANode: IVariableDeclarationNode);
|
|
procedure BuildUI(OwnerNode: TAuraNode);
|
|
function ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
end;
|
|
|
|
{ TAuraAssignmentNode }
|
|
TAssignmentNodeHandler = class(TInterfacedObject, IAuraNodeHandler)
|
|
private
|
|
FNode: IAssignmentNode;
|
|
FTargetNode: TAuraNode;
|
|
FValueNode: TAuraNode;
|
|
function GetAstNode: IAstNode;
|
|
public
|
|
constructor Create(const ANode: IAssignmentNode);
|
|
procedure BuildUI(OwnerNode: TAuraNode);
|
|
function ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
end;
|
|
|
|
{ TAuraMacroDefinitionNode }
|
|
TMacroDefinitionNodeHandler = class(TInterfacedObject, IAuraNodeHandler)
|
|
private
|
|
FNode: IMacroDefinitionNode;
|
|
FBodyNode: TAuraNode;
|
|
function GetAstNode: IAstNode;
|
|
public
|
|
constructor Create(const ANode: IMacroDefinitionNode);
|
|
procedure BuildUI(OwnerNode: TAuraNode);
|
|
function ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
end;
|
|
|
|
{ TAuraQuasiquoteNode }
|
|
TQuasiquoteNodeHandler = class(TInterfacedObject, IAuraNodeHandler)
|
|
private
|
|
FNode: IQuasiquoteNode;
|
|
FExpressionNode: TAuraNode;
|
|
function GetAstNode: IAstNode;
|
|
public
|
|
constructor Create(const ANode: IQuasiquoteNode);
|
|
procedure BuildUI(OwnerNode: TAuraNode);
|
|
function ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
end;
|
|
|
|
{ TAuraUnquoteNode }
|
|
TUnquoteNodeHandler = class(TInterfacedObject, IAuraNodeHandler)
|
|
private
|
|
FNode: IUnquoteNode;
|
|
FExpressionNode: TAuraNode;
|
|
function GetAstNode: IAstNode;
|
|
public
|
|
constructor Create(const ANode: IUnquoteNode);
|
|
procedure BuildUI(OwnerNode: TAuraNode);
|
|
function ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
end;
|
|
|
|
{ TAuraUnquoteSplicingNode }
|
|
TUnquoteSplicingNodeHandler = class(TInterfacedObject, IAuraNodeHandler)
|
|
private
|
|
FNode: IUnquoteSplicingNode;
|
|
FExpressionNode: TAuraNode;
|
|
function GetAstNode: IAstNode;
|
|
public
|
|
constructor Create(const ANode: IUnquoteSplicingNode);
|
|
procedure BuildUI(OwnerNode: TAuraNode);
|
|
function ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
end;
|
|
|
|
{ TAuraIndexerNode }
|
|
TIndexerNodeHandler = class(TInterfacedObject, IAuraNodeHandler)
|
|
private
|
|
FNode: IIndexerNode;
|
|
FBaseNode: TAuraNode;
|
|
FIndexNode: TAuraNode;
|
|
function GetAstNode: IAstNode;
|
|
public
|
|
constructor Create(const ANode: IIndexerNode);
|
|
procedure BuildUI(OwnerNode: TAuraNode);
|
|
function ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
end;
|
|
|
|
{ TAuraMemberAccessNode }
|
|
TMemberAccessNodeHandler = class(TInterfacedObject, IAuraNodeHandler)
|
|
private
|
|
FNode: IMemberAccessNode;
|
|
FBaseNode: TAuraNode;
|
|
function GetAstNode: IAstNode;
|
|
public
|
|
constructor Create(const ANode: IMemberAccessNode);
|
|
procedure BuildUI(OwnerNode: TAuraNode);
|
|
function ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
end;
|
|
|
|
{ TAuraRecordLiteralNode }
|
|
TRecordLiteralNodeHandler = class(TInterfacedObject, IAuraNodeHandler)
|
|
private
|
|
FNode: IRecordLiteralNode;
|
|
FFieldNodes: TDictionary<IKeyword, TAuraNode>; // Map KeyName -> ValueNode
|
|
function GetAstNode: IAstNode;
|
|
public
|
|
constructor Create(const ANode: IRecordLiteralNode);
|
|
destructor Destroy; override;
|
|
procedure BuildUI(OwnerNode: TAuraNode);
|
|
function ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
end;
|
|
|
|
{ TAuraCreateSeriesNode }
|
|
TCreateSeriesNodeHandler = class(TInterfacedObject, IAuraNodeHandler)
|
|
private
|
|
FNode: ICreateSeriesNode;
|
|
function GetAstNode: IAstNode;
|
|
public
|
|
constructor Create(const ANode: ICreateSeriesNode);
|
|
procedure BuildUI(OwnerNode: TAuraNode);
|
|
function ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
end;
|
|
|
|
{ TAuraAddSeriesItemNode }
|
|
TAddSeriesItemNodeHandler = class(TInterfacedObject, IAuraNodeHandler)
|
|
private
|
|
FNode: IAddSeriesItemNode;
|
|
FValueNode: TAuraNode;
|
|
FLookbackNode: TAuraNode; // Can be nil
|
|
function GetAstNode: IAstNode;
|
|
public
|
|
constructor Create(const ANode: IAddSeriesItemNode);
|
|
procedure BuildUI(OwnerNode: TAuraNode);
|
|
function ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
end;
|
|
|
|
{ TAuraSeriesLengthNode }
|
|
TSeriesLengthNodeHandler = class(TInterfacedObject, IAuraNodeHandler)
|
|
private
|
|
FNode: ISeriesLengthNode;
|
|
function GetAstNode: IAstNode;
|
|
public
|
|
constructor Create(const ANode: ISeriesLengthNode);
|
|
procedure BuildUI(OwnerNode: TAuraNode);
|
|
function ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
end;
|
|
|
|
{ TAuraNopNode }
|
|
TNopNodeHandler = class(TInterfacedObject, IAuraNodeHandler)
|
|
private
|
|
FNode: INopNode;
|
|
function GetAstNode: IAstNode;
|
|
public
|
|
constructor Create(const ANode: INopNode);
|
|
procedure BuildUI(OwnerNode: TAuraNode);
|
|
function ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
end;
|
|
|
|
{ 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;
|
|
|
|
// --- Visitor Implementations ---
|
|
// *** CHANGED: All visitor methods now create a Handler and inject it into a generic TAuraNode ***
|
|
|
|
function TAstVisualizer.VisitConstant(const Node: IConstantNode): TAuraNode;
|
|
var
|
|
Handler: IAuraNodeHandler;
|
|
begin
|
|
Handler := TConstantNodeHandler.Create(Node);
|
|
Result := TAuraNode.Create(Self, Handler);
|
|
end;
|
|
|
|
function TAstVisualizer.VisitIdentifier(const Node: IIdentifierNode): TAuraNode;
|
|
var
|
|
Handler: IAuraNodeHandler;
|
|
begin
|
|
Handler := TIdentifierNodeHandler.Create(Node);
|
|
Result := TAuraNode.Create(Self, Handler);
|
|
end;
|
|
|
|
function TAstVisualizer.VisitKeyword(const Node: IKeywordNode): TAuraNode;
|
|
var
|
|
Handler: IAuraNodeHandler;
|
|
begin
|
|
Handler := TKeywordNodeHandler.Create(Node);
|
|
Result := TAuraNode.Create(Self, Handler);
|
|
end;
|
|
|
|
function TAstVisualizer.VisitBlockExpression(const Node: IBlockExpressionNode): TAuraNode;
|
|
var
|
|
Handler: IAuraNodeHandler;
|
|
begin
|
|
Handler := TBlockExpressionNodeHandler.Create(Node);
|
|
Result := TAuraNode.Create(Self, Handler);
|
|
end;
|
|
|
|
function TAstVisualizer.VisitIfExpression(const Node: IIfExpressionNode): TAuraNode;
|
|
var
|
|
Handler: IAuraNodeHandler;
|
|
begin
|
|
Handler := TIfExpressionNodeHandler.Create(Node);
|
|
Result := TAuraNode.Create(Self, Handler);
|
|
end;
|
|
|
|
function TAstVisualizer.VisitTernaryExpression(const Node: ITernaryExpressionNode): TAuraNode;
|
|
var
|
|
Handler: IAuraNodeHandler;
|
|
begin
|
|
Handler := TTernaryExpressionNodeHandler.Create(Node);
|
|
Result := TAuraNode.Create(Self, Handler);
|
|
end;
|
|
|
|
function TAstVisualizer.VisitLambdaExpression(const Node: ILambdaExpressionNode): TAuraNode;
|
|
var
|
|
Handler: IAuraNodeHandler;
|
|
begin
|
|
Handler := TLambdaExpressionNodeHandler.Create(Node);
|
|
Result := TAuraNode.Create(Self, Handler);
|
|
end;
|
|
|
|
function TAstVisualizer.VisitFunctionCall(const Node: IFunctionCallNode): TAuraNode;
|
|
var
|
|
Handler: IAuraNodeHandler;
|
|
begin
|
|
Handler := TFunctionCallNodeHandler.Create(Node);
|
|
Result := TAuraNode.Create(Self, Handler);
|
|
end;
|
|
|
|
function TAstVisualizer.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TAuraNode;
|
|
var
|
|
Handler: IAuraNodeHandler;
|
|
begin
|
|
Handler := TMacroExpansionNodeHandler.Create(Node);
|
|
Result := TAuraNode.Create(Self, Handler);
|
|
end;
|
|
|
|
function TAstVisualizer.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAuraNode;
|
|
var
|
|
Handler: IAuraNodeHandler;
|
|
begin
|
|
Handler := TVariableDeclarationNodeHandler.Create(Node);
|
|
Result := TAuraNode.Create(Self, Handler);
|
|
end;
|
|
|
|
function TAstVisualizer.VisitAssignment(const Node: IAssignmentNode): TAuraNode;
|
|
var
|
|
Handler: IAuraNodeHandler;
|
|
begin
|
|
Handler := TAssignmentNodeHandler.Create(Node);
|
|
Result := TAuraNode.Create(Self, Handler);
|
|
end;
|
|
|
|
function TAstVisualizer.VisitMacroDefinition(const Node: IMacroDefinitionNode): TAuraNode;
|
|
var
|
|
Handler: IAuraNodeHandler;
|
|
begin
|
|
Handler := TMacroDefinitionNodeHandler.Create(Node);
|
|
Result := TAuraNode.Create(Self, Handler);
|
|
end;
|
|
|
|
function TAstVisualizer.VisitQuasiquote(const Node: IQuasiquoteNode): TAuraNode;
|
|
var
|
|
Handler: IAuraNodeHandler;
|
|
begin
|
|
Handler := TQuasiquoteNodeHandler.Create(Node);
|
|
Result := TAuraNode.Create(Self, Handler);
|
|
end;
|
|
|
|
function TAstVisualizer.VisitUnquote(const Node: IUnquoteNode): TAuraNode;
|
|
var
|
|
Handler: IAuraNodeHandler;
|
|
begin
|
|
Handler := TUnquoteNodeHandler.Create(Node);
|
|
Result := TAuraNode.Create(Self, Handler);
|
|
end;
|
|
|
|
function TAstVisualizer.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TAuraNode;
|
|
var
|
|
Handler: IAuraNodeHandler;
|
|
begin
|
|
Handler := TUnquoteSplicingNodeHandler.Create(Node);
|
|
Result := TAuraNode.Create(Self, Handler);
|
|
end;
|
|
|
|
function TAstVisualizer.VisitIndexer(const Node: IIndexerNode): TAuraNode;
|
|
var
|
|
Handler: IAuraNodeHandler;
|
|
begin
|
|
Handler := TIndexerNodeHandler.Create(Node);
|
|
Result := TAuraNode.Create(Self, Handler);
|
|
end;
|
|
|
|
function TAstVisualizer.VisitMemberAccess(const Node: IMemberAccessNode): TAuraNode;
|
|
var
|
|
Handler: IAuraNodeHandler;
|
|
begin
|
|
Handler := TMemberAccessNodeHandler.Create(Node);
|
|
Result := TAuraNode.Create(Self, Handler);
|
|
end;
|
|
|
|
function TAstVisualizer.VisitRecordLiteral(const Node: IRecordLiteralNode): TAuraNode;
|
|
var
|
|
Handler: IAuraNodeHandler;
|
|
begin
|
|
Handler := TRecordLiteralNodeHandler.Create(Node);
|
|
Result := TAuraNode.Create(Self, Handler);
|
|
end;
|
|
|
|
function TAstVisualizer.VisitCreateSeries(const Node: ICreateSeriesNode): TAuraNode;
|
|
var
|
|
Handler: IAuraNodeHandler;
|
|
begin
|
|
Handler := TCreateSeriesNodeHandler.Create(Node);
|
|
Result := TAuraNode.Create(Self, Handler);
|
|
end;
|
|
|
|
function TAstVisualizer.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TAuraNode;
|
|
var
|
|
Handler: IAuraNodeHandler;
|
|
begin
|
|
Handler := TAddSeriesItemNodeHandler.Create(Node);
|
|
Result := TAuraNode.Create(Self, Handler);
|
|
end;
|
|
|
|
function TAstVisualizer.VisitSeriesLength(const Node: ISeriesLengthNode): TAuraNode;
|
|
var
|
|
Handler: IAuraNodeHandler;
|
|
begin
|
|
Handler := TSeriesLengthNodeHandler.Create(Node);
|
|
Result := TAuraNode.Create(Self, Handler);
|
|
end;
|
|
|
|
function TAstVisualizer.VisitRecurNode(const Node: IRecurNode): TAuraNode;
|
|
var
|
|
Handler: IAuraNodeHandler;
|
|
begin
|
|
Handler := TRecurNodeHandler.Create(Node);
|
|
Result := TAuraNode.Create(Self, Handler);
|
|
end;
|
|
|
|
function TAstVisualizer.VisitNop(const Node: INopNode): TAuraNode;
|
|
var
|
|
Handler: IAuraNodeHandler;
|
|
begin
|
|
Handler := TNopNodeHandler.Create(Node);
|
|
Result := TAuraNode.Create(Self, Handler);
|
|
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; const AHandler: IAuraNodeHandler);
|
|
begin
|
|
inherited Create(AVisualizer.Workspace);
|
|
|
|
Parent := AVisualizer.ParentControl;
|
|
|
|
FVisualizer := AVisualizer.Clone(Self, AVisualizer.ExprDepth);
|
|
FHandler := AHandler; // *** Store the injected handler ***
|
|
|
|
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
|
|
FHandler := nil; // Release the handler interface
|
|
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
|
|
// *** CHANGED: Delegate AST reconstruction to the handler ***
|
|
if Assigned(FHandler) then
|
|
Result := FHandler.ReconstructAst(Self)
|
|
else
|
|
Result := TAst.Nop; // Fallback if handler is missing
|
|
end;
|
|
|
|
function TAuraNode.GetNode: IAstNode;
|
|
begin
|
|
// *** NEW: Get the logical node from the handler ***
|
|
if Assigned(FHandler) then
|
|
Result := FHandler.Node
|
|
else
|
|
Result := nil;
|
|
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
|
|
|
|
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 := FBorderWidth;
|
|
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;
|
|
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
|
|
if Assigned(FHandler) then
|
|
FHandler.BuildUI(Self);
|
|
end;
|
|
|
|
{ TConstantNodeHandler }
|
|
|
|
constructor TConstantNodeHandler.Create(const ANode: IConstantNode);
|
|
begin
|
|
inherited Create;
|
|
FNode := ANode;
|
|
end;
|
|
|
|
function TConstantNodeHandler.GetAstNode: IAstNode;
|
|
begin
|
|
Result := FNode;
|
|
end;
|
|
|
|
procedure TConstantNodeHandler.BuildUI(OwnerNode: TAuraNode);
|
|
var
|
|
valueStr: string;
|
|
isConcise: Boolean;
|
|
begin
|
|
OwnerNode.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
|
|
OwnerNode.Frameless := true;
|
|
OwnerNode.AddLabel(OwnerNode, valueStr);
|
|
end
|
|
else
|
|
begin
|
|
// Use standard framed node with Title label + Value label
|
|
OwnerNode.Frameless := False;
|
|
OwnerNode.Orientation := loVertical;
|
|
|
|
var titleLabel := OwnerNode.AddLabel(OwnerNode, 'Const');
|
|
titleLabel.Font.Style := titleLabel.Font.Style + [TFontStyle.fsBold];
|
|
|
|
// Value Label
|
|
var valueLabel := OwnerNode.AddLabel(OwnerNode, valueStr);
|
|
valueLabel.AutoSize := False;
|
|
valueLabel.WordWrap := True;
|
|
end;
|
|
finally
|
|
OwnerNode.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TConstantNodeHandler.ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
begin
|
|
Result := FNode; // Literals are immutable
|
|
end;
|
|
|
|
{ TIdentifierNodeHandler }
|
|
|
|
constructor TIdentifierNodeHandler.Create(const ANode: IIdentifierNode);
|
|
begin
|
|
inherited Create;
|
|
FNode := ANode;
|
|
end;
|
|
|
|
function TIdentifierNodeHandler.GetAstNode: IAstNode;
|
|
begin
|
|
Result := FNode;
|
|
end;
|
|
|
|
procedure TIdentifierNodeHandler.BuildUI(OwnerNode: TAuraNode);
|
|
begin
|
|
OwnerNode.BeginUpdate;
|
|
try
|
|
OwnerNode.Frameless := true; // Identifiers are frameless
|
|
OwnerNode.AddLabel(OwnerNode, FNode.Name); // Add label with the identifier name
|
|
finally
|
|
OwnerNode.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TIdentifierNodeHandler.ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
begin
|
|
// Find the label text if needed, but for now, re-use FNode's data
|
|
// In a real editor, you'd fetch text from the TEdit/TLabel
|
|
Result := TAst.Identifier(FNode.Name);
|
|
end;
|
|
|
|
{ TKeywordNodeHandler }
|
|
|
|
constructor TKeywordNodeHandler.Create(const ANode: IKeywordNode);
|
|
begin
|
|
inherited Create;
|
|
FNode := ANode;
|
|
end;
|
|
|
|
function TKeywordNodeHandler.GetAstNode: IAstNode;
|
|
begin
|
|
Result := FNode;
|
|
end;
|
|
|
|
procedure TKeywordNodeHandler.BuildUI(OwnerNode: TAuraNode);
|
|
begin
|
|
OwnerNode.BeginUpdate;
|
|
try
|
|
OwnerNode.Frameless := true;
|
|
var lbl := OwnerNode.AddLabel(OwnerNode, ':' + FNode.Value.Name);
|
|
lbl.StyledSettings := lbl.StyledSettings - [TStyledSetting.FontColor];
|
|
lbl.FontColor := TAlphaColors.Mediumvioletred;
|
|
finally
|
|
OwnerNode.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TKeywordNodeHandler.ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
begin
|
|
Result := FNode; // Keywords are literals
|
|
end;
|
|
|
|
{ TBlockExpressionNodeHandler }
|
|
|
|
constructor TBlockExpressionNodeHandler.Create(const ANode: IBlockExpressionNode);
|
|
begin
|
|
inherited Create;
|
|
FNode := ANode;
|
|
FChildNodes := TList<TAuraNode>.Create;
|
|
end;
|
|
|
|
destructor TBlockExpressionNodeHandler.Destroy;
|
|
begin
|
|
FChildNodes.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TBlockExpressionNodeHandler.GetAstNode: IAstNode;
|
|
begin
|
|
Result := FNode;
|
|
end;
|
|
|
|
procedure TBlockExpressionNodeHandler.BuildUI(OwnerNode: TAuraNode);
|
|
var
|
|
visu: IAstVisualizer;
|
|
childNode: TAuraNode;
|
|
expr: IAstNode;
|
|
titleLabel: TLabel;
|
|
i: Integer;
|
|
returnContainer: TAutoFitControl;
|
|
visuReturn: IAstVisualizer;
|
|
begin
|
|
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth + 1);
|
|
OwnerNode.BeginUpdate;
|
|
try
|
|
OwnerNode.Frameless := true;
|
|
OwnerNode.Orientation := loVertical;
|
|
OwnerNode.Alignment := laFlush;
|
|
|
|
for i := 0 to High(FNode.Expressions) do
|
|
begin
|
|
expr := FNode.Expressions[i];
|
|
|
|
if i = High(FNode.Expressions) then
|
|
begin
|
|
returnContainer := OwnerNode.AddContainer(OwnerNode, loHorizontal, laCenter);
|
|
titleLabel := OwnerNode.AddLabel(returnContainer, 'return');
|
|
titleLabel.Font.Style := titleLabel.Font.Style + [TFontStyle.fsBold];
|
|
visuReturn := OwnerNode.Visualizer.Clone(returnContainer, OwnerNode.Visualizer.ExprDepth + 1);
|
|
childNode := visuReturn.CallAccept(expr);
|
|
FChildNodes.Add(childNode);
|
|
end
|
|
else
|
|
begin
|
|
childNode := visu.CallAccept(expr);
|
|
FChildNodes.Add(childNode);
|
|
end;
|
|
end;
|
|
finally
|
|
OwnerNode.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TBlockExpressionNodeHandler.ReconstructAst(OwnerNode: TAuraNode): 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.Nop; // Use Nop as placeholder
|
|
end;
|
|
Result := TAst.Block(exprs);
|
|
end;
|
|
|
|
{ TIfExpressionNodeHandler }
|
|
|
|
constructor TIfExpressionNodeHandler.Create(const ANode: IIfExpressionNode);
|
|
begin
|
|
inherited Create;
|
|
FNode := ANode;
|
|
FElseNode := nil;
|
|
end;
|
|
|
|
function TIfExpressionNodeHandler.GetAstNode: IAstNode;
|
|
begin
|
|
Result := FNode;
|
|
end;
|
|
|
|
procedure TIfExpressionNodeHandler.BuildUI(OwnerNode: TAuraNode);
|
|
begin
|
|
OwnerNode.BeginUpdate;
|
|
try
|
|
OwnerNode.Frameless := False;
|
|
OwnerNode.Orientation := loVertical;
|
|
OwnerNode.Alignment := laFlush;
|
|
|
|
FConditionNode := OwnerNode.AddExpr(OwnerNode, 'if', FNode.Condition);
|
|
FThenNode := OwnerNode.AddExpr(OwnerNode, 'then', FNode.ThenBranch);
|
|
if Assigned(FNode.ElseBranch) then
|
|
FElseNode := OwnerNode.AddExpr(OwnerNode, 'else', FNode.ElseBranch);
|
|
finally
|
|
OwnerNode.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TIfExpressionNodeHandler.ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
var
|
|
elseAst: IAstNode;
|
|
begin
|
|
if Assigned(FElseNode) then
|
|
elseAst := FElseNode.CreateAst
|
|
else
|
|
elseAst := nil;
|
|
|
|
Result := TAst.IfExpr(FConditionNode.CreateAst, FThenNode.CreateAst, elseAst);
|
|
end;
|
|
|
|
{ TTernaryExpressionNodeHandler }
|
|
|
|
constructor TTernaryExpressionNodeHandler.Create(const ANode: ITernaryExpressionNode);
|
|
begin
|
|
inherited Create;
|
|
FNode := ANode;
|
|
end;
|
|
|
|
function TTernaryExpressionNodeHandler.GetAstNode: IAstNode;
|
|
begin
|
|
Result := FNode;
|
|
end;
|
|
|
|
procedure TTernaryExpressionNodeHandler.BuildUI(OwnerNode: TAuraNode);
|
|
var
|
|
visu: IAstVisualizer;
|
|
begin
|
|
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth + 1);
|
|
OwnerNode.BeginUpdate;
|
|
try
|
|
OwnerNode.Frameless := True;
|
|
OwnerNode.Orientation := loHorizontal;
|
|
FConditionNode := visu.CallAccept(FNode.Condition);
|
|
OwnerNode.AddLabel(OwnerNode, '?');
|
|
FThenNode := visu.CallAccept(FNode.ThenBranch);
|
|
OwnerNode.AddLabel(OwnerNode, ':');
|
|
FElseNode := visu.CallAccept(FNode.ElseBranch);
|
|
finally
|
|
OwnerNode.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TTernaryExpressionNodeHandler.ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
begin
|
|
Result := TAst.TernaryExpr(FConditionNode.CreateAst, FThenNode.CreateAst, FElseNode.CreateAst);
|
|
end;
|
|
|
|
{ TLambdaExpressionNodeHandler }
|
|
|
|
constructor TLambdaExpressionNodeHandler.Create(const ANode: ILambdaExpressionNode);
|
|
begin
|
|
inherited Create;
|
|
FNode := ANode;
|
|
FParamLabels := TList<TLabel>.Create;
|
|
end;
|
|
|
|
destructor TLambdaExpressionNodeHandler.Destroy;
|
|
begin
|
|
FParamLabels.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TLambdaExpressionNodeHandler.GetAstNode: IAstNode;
|
|
begin
|
|
Result := FNode;
|
|
end;
|
|
|
|
procedure TLambdaExpressionNodeHandler.BuildUI(OwnerNode: TAuraNode);
|
|
var
|
|
visu: IAstVisualizer;
|
|
titleContainer: TAutoFitControl;
|
|
paramLabel: TLabel;
|
|
i: Integer;
|
|
begin
|
|
visu := OwnerNode.Visualizer.Clone(OwnerNode, 0); // Reset depth for body
|
|
OwnerNode.BeginUpdate;
|
|
try
|
|
OwnerNode.Frameless := False;
|
|
OwnerNode.Orientation := loVertical;
|
|
OwnerNode.Alignment := laFlush;
|
|
OwnerNode.BackgroundColor := $090000ff;
|
|
|
|
titleContainer := OwnerNode.AddContainer(OwnerNode, loHorizontal, laCenter);
|
|
|
|
paramLabel := OwnerNode.AddLabel(titleContainer, 'fn'); // ASCII replacement for Lambda
|
|
paramLabel.Font.Style := paramLabel.Font.Style + [TFontStyle.fsBold];
|
|
FParamLabels.Add(paramLabel); // Add to list (though not really needed for CreateAst)
|
|
|
|
paramLabel := OwnerNode.AddLabel(titleContainer, '(');
|
|
FParamLabels.Add(paramLabel);
|
|
|
|
for i := 0 to High(FNode.Parameters) do
|
|
begin
|
|
paramLabel := OwnerNode.AddLabel(titleContainer, FNode.Parameters[i].Name);
|
|
FParamLabels.Add(paramLabel);
|
|
|
|
if i < High(FNode.Parameters) then
|
|
begin
|
|
paramLabel := OwnerNode.AddLabel(titleContainer, ',');
|
|
FParamLabels.Add(paramLabel);
|
|
end;
|
|
end;
|
|
|
|
paramLabel := OwnerNode.AddLabel(titleContainer, ')');
|
|
FParamLabels.Add(paramLabel);
|
|
|
|
FBodyNode := visu.CallAccept(FNode.Body);
|
|
FBodyNode.Frameless := false;
|
|
|
|
finally
|
|
OwnerNode.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TLambdaExpressionNodeHandler.ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
begin
|
|
// Params are read from FNode (assuming they are not editable via UI labels for now)
|
|
Result := TAst.LambdaExpr(FNode.Parameters, FBodyNode.CreateAst);
|
|
end;
|
|
|
|
{ TFunctionCallNodeHandler }
|
|
|
|
constructor TFunctionCallNodeHandler.Create(const ANode: IFunctionCallNode);
|
|
begin
|
|
inherited Create;
|
|
FNode := ANode;
|
|
FArgumentNodes := TList<TAuraNode>.Create;
|
|
end;
|
|
|
|
destructor TFunctionCallNodeHandler.Destroy;
|
|
begin
|
|
FArgumentNodes.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TFunctionCallNodeHandler.GetAstNode: IAstNode;
|
|
begin
|
|
Result := FNode;
|
|
end;
|
|
|
|
procedure TFunctionCallNodeHandler.BuildUI(OwnerNode: TAuraNode);
|
|
var
|
|
visu: IAstVisualizer;
|
|
i: Integer;
|
|
argNode: TAuraNode;
|
|
begin
|
|
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth + 1);
|
|
OwnerNode.BeginUpdate;
|
|
try
|
|
OwnerNode.Frameless := True;
|
|
OwnerNode.Orientation := loHorizontal;
|
|
|
|
var callLabel := OwnerNode.AddLabel(OwnerNode, 'call ');
|
|
callLabel.Font.Style := callLabel.Font.Style + [TFontStyle.fsBold];
|
|
|
|
FCalleeNode := visu.CallAccept(FNode.Callee);
|
|
|
|
if Length(FNode.Arguments) > 0 then
|
|
begin
|
|
OwnerNode.AddLabel(OwnerNode, '(');
|
|
for i := 0 to High(FNode.Arguments) do
|
|
begin
|
|
argNode := visu.CallAccept(FNode.Arguments[i]);
|
|
FArgumentNodes.Add(argNode);
|
|
if i < High(FNode.Arguments) then
|
|
OwnerNode.AddLabel(OwnerNode, ',');
|
|
end;
|
|
OwnerNode.AddLabel(OwnerNode, ')');
|
|
end;
|
|
finally
|
|
OwnerNode.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TFunctionCallNodeHandler.ReconstructAst(OwnerNode: TAuraNode): 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;
|
|
|
|
{ TMacroExpansionNodeHandler }
|
|
|
|
constructor TMacroExpansionNodeHandler.Create(const ANode: IMacroExpansionNode);
|
|
begin
|
|
inherited Create;
|
|
FNode := ANode;
|
|
end;
|
|
|
|
function TMacroExpansionNodeHandler.GetAstNode: IAstNode;
|
|
begin
|
|
Result := FNode;
|
|
end;
|
|
|
|
procedure TMacroExpansionNodeHandler.BuildUI(OwnerNode: TAuraNode);
|
|
var
|
|
visu: IAstVisualizer;
|
|
titleLabel: TLabel;
|
|
begin
|
|
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth + 1);
|
|
OwnerNode.BeginUpdate;
|
|
try
|
|
OwnerNode.Frameless := False;
|
|
OwnerNode.Orientation := loVertical;
|
|
titleLabel := OwnerNode.AddLabel(OwnerNode, 'Macro Expansion');
|
|
titleLabel.Font.Style := titleLabel.Font.Style + [TFontStyle.fsBold];
|
|
FExpandedBodyNode := visu.CallAccept(FNode.ExpandedBody);
|
|
finally
|
|
OwnerNode.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TMacroExpansionNodeHandler.ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
begin
|
|
Result := TAst.MacroExpansionNode(FNode.CallNode, FExpandedBodyNode.CreateAst.AsTypedNode);
|
|
end;
|
|
|
|
{ TRecurNodeHandler }
|
|
|
|
constructor TRecurNodeHandler.Create(const ANode: IRecurNode);
|
|
begin
|
|
inherited Create;
|
|
FNode := ANode;
|
|
FArgumentNodes := TList<TAuraNode>.Create;
|
|
end;
|
|
|
|
destructor TRecurNodeHandler.Destroy;
|
|
begin
|
|
FArgumentNodes.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TRecurNodeHandler.GetAstNode: IAstNode;
|
|
begin
|
|
Result := FNode;
|
|
end;
|
|
|
|
procedure TRecurNodeHandler.BuildUI(OwnerNode: TAuraNode);
|
|
var
|
|
visu: IAstVisualizer;
|
|
i: Integer;
|
|
argNode: TAuraNode;
|
|
titleLabel: TLabel;
|
|
begin
|
|
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth + 1);
|
|
OwnerNode.BeginUpdate;
|
|
try
|
|
OwnerNode.Frameless := True;
|
|
OwnerNode.Orientation := loHorizontal;
|
|
|
|
titleLabel := OwnerNode.AddLabel(OwnerNode, 'recur'); // ASCII text
|
|
titleLabel.Font.Style := titleLabel.Font.Style + [TFontStyle.fsBold];
|
|
|
|
OwnerNode.AddLabel(OwnerNode, '(');
|
|
for i := 0 to High(FNode.Arguments) do
|
|
begin
|
|
argNode := visu.CallAccept(FNode.Arguments[i]);
|
|
FArgumentNodes.Add(argNode);
|
|
if i < High(FNode.Arguments) then
|
|
OwnerNode.AddLabel(OwnerNode, ',');
|
|
end;
|
|
OwnerNode.AddLabel(OwnerNode, ')');
|
|
finally
|
|
OwnerNode.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TRecurNodeHandler.ReconstructAst(OwnerNode: TAuraNode): 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;
|
|
|
|
{ TVariableDeclarationNodeHandler }
|
|
|
|
constructor TVariableDeclarationNodeHandler.Create(const ANode: IVariableDeclarationNode);
|
|
begin
|
|
inherited Create;
|
|
FNode := ANode;
|
|
FInitializerNode := nil;
|
|
end;
|
|
|
|
function TVariableDeclarationNodeHandler.GetAstNode: IAstNode;
|
|
begin
|
|
Result := FNode;
|
|
end;
|
|
|
|
procedure TVariableDeclarationNodeHandler.BuildUI(OwnerNode: TAuraNode);
|
|
var
|
|
visu: IAstVisualizer;
|
|
varLabel: TLabel;
|
|
begin
|
|
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth + 1);
|
|
OwnerNode.BeginUpdate;
|
|
try
|
|
OwnerNode.Frameless := True;
|
|
OwnerNode.Orientation := loHorizontal;
|
|
|
|
varLabel := OwnerNode.AddLabel(OwnerNode, 'var');
|
|
|
|
varLabel.Font.Style := varLabel.Font.Style + [TFontStyle.fsBold];
|
|
FTargetNode := visu.CallAccept(FNode.Target);
|
|
|
|
if Assigned(FNode.Initializer) then
|
|
begin
|
|
OwnerNode.AddLabel(OwnerNode, ':=');
|
|
FInitializerNode := visu.CallAccept(FNode.Initializer);
|
|
end;
|
|
finally
|
|
OwnerNode.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TVariableDeclarationNodeHandler.ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
var
|
|
initAst: IAstNode;
|
|
begin
|
|
if Assigned(FInitializerNode) then
|
|
initAst := FInitializerNode.CreateAst
|
|
else
|
|
initAst := nil;
|
|
Result := TAst.VarDecl(FTargetNode.CreateAst, initAst);
|
|
end;
|
|
|
|
{ TAssignmentNodeHandler }
|
|
|
|
constructor TAssignmentNodeHandler.Create(const ANode: IAssignmentNode);
|
|
begin
|
|
inherited Create;
|
|
FNode := ANode;
|
|
end;
|
|
|
|
function TAssignmentNodeHandler.GetAstNode: IAstNode;
|
|
begin
|
|
Result := FNode;
|
|
end;
|
|
|
|
procedure TAssignmentNodeHandler.BuildUI(OwnerNode: TAuraNode);
|
|
var
|
|
visu: IAstVisualizer;
|
|
begin
|
|
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth + 1);
|
|
OwnerNode.BeginUpdate;
|
|
try
|
|
OwnerNode.Frameless := True;
|
|
OwnerNode.Orientation := loHorizontal;
|
|
FTargetNode := visu.CallAccept(FNode.Target);
|
|
OwnerNode.AddLabel(OwnerNode, ':=');
|
|
FValueNode := visu.CallAccept(FNode.Value);
|
|
finally
|
|
OwnerNode.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TAssignmentNodeHandler.ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
begin
|
|
Result := TAst.Assign(FTargetNode.CreateAst, FValueNode.CreateAst);
|
|
end;
|
|
|
|
{ TMacroDefinitionNodeHandler }
|
|
|
|
constructor TMacroDefinitionNodeHandler.Create(const ANode: IMacroDefinitionNode);
|
|
begin
|
|
inherited Create;
|
|
FNode := ANode;
|
|
end;
|
|
|
|
function TMacroDefinitionNodeHandler.GetAstNode: IAstNode;
|
|
begin
|
|
Result := FNode;
|
|
end;
|
|
|
|
procedure TMacroDefinitionNodeHandler.BuildUI(OwnerNode: TAuraNode);
|
|
var
|
|
visu: IAstVisualizer;
|
|
titleLabel: TLabel;
|
|
paramStr: string;
|
|
i: Integer;
|
|
begin
|
|
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth + 1);
|
|
OwnerNode.BeginUpdate;
|
|
try
|
|
OwnerNode.Frameless := False;
|
|
OwnerNode.Orientation := loVertical;
|
|
|
|
paramStr := '';
|
|
for i := 0 to High(FNode.Parameters) do
|
|
begin
|
|
if i > 0 then
|
|
paramStr := paramStr + ', ';
|
|
paramStr := paramStr + FNode.Parameters[i].Name;
|
|
end;
|
|
|
|
titleLabel := OwnerNode.AddLabel(OwnerNode, 'Macro Def: ' + FNode.Name.Name + ' (' + paramStr + ')');
|
|
titleLabel.Font.Style := titleLabel.Font.Style + [TFontStyle.fsBold];
|
|
|
|
FBodyNode := visu.CallAccept(FNode.Body);
|
|
finally
|
|
OwnerNode.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TMacroDefinitionNodeHandler.ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
begin
|
|
Result := TAst.MacroDef(TAst.Identifier(FNode.Name.Name), FNode.Parameters, FBodyNode.CreateAst);
|
|
end;
|
|
|
|
{ TQuasiquoteNodeHandler }
|
|
|
|
constructor TQuasiquoteNodeHandler.Create(const ANode: IQuasiquoteNode);
|
|
begin
|
|
inherited Create;
|
|
FNode := ANode;
|
|
end;
|
|
|
|
function TQuasiquoteNodeHandler.GetAstNode: IAstNode;
|
|
begin
|
|
Result := FNode;
|
|
end;
|
|
|
|
procedure TQuasiquoteNodeHandler.BuildUI(OwnerNode: TAuraNode);
|
|
var
|
|
visu: IAstVisualizer;
|
|
titleLabel: TLabel;
|
|
begin
|
|
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth + 1);
|
|
OwnerNode.BeginUpdate;
|
|
try
|
|
OwnerNode.Frameless := False;
|
|
OwnerNode.Orientation := loVertical;
|
|
titleLabel := OwnerNode.AddLabel(OwnerNode, 'Quasiquote');
|
|
titleLabel.Font.Style := titleLabel.Font.Style + [TFontStyle.fsBold];
|
|
FExpressionNode := visu.CallAccept(FNode.Expression);
|
|
finally
|
|
OwnerNode.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TQuasiquoteNodeHandler.ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
begin
|
|
Result := TAst.Quasiquote(FExpressionNode.CreateAst);
|
|
end;
|
|
|
|
{ TUnquoteNodeHandler }
|
|
|
|
constructor TUnquoteNodeHandler.Create(const ANode: IUnquoteNode);
|
|
begin
|
|
inherited Create;
|
|
FNode := ANode;
|
|
end;
|
|
|
|
function TUnquoteNodeHandler.GetAstNode: IAstNode;
|
|
begin
|
|
Result := FNode;
|
|
end;
|
|
|
|
procedure TUnquoteNodeHandler.BuildUI(OwnerNode: TAuraNode);
|
|
var
|
|
visu: IAstVisualizer;
|
|
begin
|
|
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth + 1);
|
|
OwnerNode.BeginUpdate;
|
|
try
|
|
OwnerNode.Frameless := True;
|
|
OwnerNode.Orientation := loHorizontal;
|
|
|
|
var leftBracket := OwnerNode.AddLabel(OwnerNode, '<');
|
|
leftBracket.Padding.Right := 0;
|
|
leftBracket.Margins.Right := 0;
|
|
|
|
FExpressionNode := visu.CallAccept(FNode.Expression);
|
|
|
|
var rightBracket := OwnerNode.AddLabel(OwnerNode, '>');
|
|
rightBracket.Padding.Left := 0;
|
|
rightBracket.Margins.Left := 0;
|
|
finally
|
|
OwnerNode.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TUnquoteNodeHandler.ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
begin
|
|
Result := TAst.Unquote(FExpressionNode.CreateAst);
|
|
end;
|
|
|
|
{ TUnquoteSplicingNodeHandler }
|
|
|
|
constructor TUnquoteSplicingNodeHandler.Create(const ANode: IUnquoteSplicingNode);
|
|
begin
|
|
inherited Create;
|
|
FNode := ANode;
|
|
end;
|
|
|
|
function TUnquoteSplicingNodeHandler.GetAstNode: IAstNode;
|
|
begin
|
|
Result := FNode;
|
|
end;
|
|
|
|
procedure TUnquoteSplicingNodeHandler.BuildUI(OwnerNode: TAuraNode);
|
|
var
|
|
visu: IAstVisualizer;
|
|
titleLabel: TLabel;
|
|
begin
|
|
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth + 1);
|
|
OwnerNode.BeginUpdate;
|
|
try
|
|
OwnerNode.Frameless := False;
|
|
OwnerNode.Orientation := loVertical;
|
|
titleLabel := OwnerNode.AddLabel(OwnerNode, 'Unquote-Splicing');
|
|
titleLabel.Font.Style := titleLabel.Font.Style + [TFontStyle.fsBold];
|
|
FExpressionNode := visu.CallAccept(FNode.Expression);
|
|
finally
|
|
OwnerNode.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TUnquoteSplicingNodeHandler.ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
begin
|
|
Result := TAst.UnquoteSplicing(FExpressionNode.CreateAst.AsQuasiquote);
|
|
end;
|
|
|
|
{ TIndexerNodeHandler }
|
|
|
|
constructor TIndexerNodeHandler.Create(const ANode: IIndexerNode);
|
|
begin
|
|
inherited Create;
|
|
FNode := ANode;
|
|
end;
|
|
|
|
function TIndexerNodeHandler.GetAstNode: IAstNode;
|
|
begin
|
|
Result := FNode;
|
|
end;
|
|
|
|
procedure TIndexerNodeHandler.BuildUI(OwnerNode: TAuraNode);
|
|
var
|
|
visu: IAstVisualizer;
|
|
begin
|
|
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth + 1);
|
|
OwnerNode.BeginUpdate;
|
|
try
|
|
OwnerNode.Frameless := True;
|
|
OwnerNode.Orientation := loHorizontal;
|
|
FBaseNode := visu.CallAccept(FNode.Base);
|
|
OwnerNode.AddLabel(OwnerNode, '[');
|
|
FIndexNode := visu.CallAccept(FNode.Index);
|
|
OwnerNode.AddLabel(OwnerNode, ']');
|
|
finally
|
|
OwnerNode.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TIndexerNodeHandler.ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
begin
|
|
Result := TAst.Indexer(FBaseNode.CreateAst, FIndexNode.CreateAst);
|
|
end;
|
|
|
|
{ TMemberAccessNodeHandler }
|
|
|
|
constructor TMemberAccessNodeHandler.Create(const ANode: IMemberAccessNode);
|
|
begin
|
|
inherited Create;
|
|
FNode := ANode;
|
|
end;
|
|
|
|
function TMemberAccessNodeHandler.GetAstNode: IAstNode;
|
|
begin
|
|
Result := FNode;
|
|
end;
|
|
|
|
procedure TMemberAccessNodeHandler.BuildUI(OwnerNode: TAuraNode);
|
|
var
|
|
visu: IAstVisualizer;
|
|
begin
|
|
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth + 1);
|
|
OwnerNode.BeginUpdate;
|
|
try
|
|
OwnerNode.Frameless := True;
|
|
OwnerNode.Orientation := loHorizontal;
|
|
FBaseNode := visu.CallAccept(FNode.Base);
|
|
OwnerNode.AddLabel(OwnerNode, '.');
|
|
OwnerNode.AddLabel(OwnerNode, FNode.Member.Value.Name);
|
|
finally
|
|
OwnerNode.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TMemberAccessNodeHandler.ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
begin
|
|
Result := TAst.MemberAccess(FBaseNode.CreateAst, TAst.Keyword(FNode.Member.Value.Name));
|
|
end;
|
|
|
|
{ TRecordLiteralNodeHandler }
|
|
|
|
constructor TRecordLiteralNodeHandler.Create(const ANode: IRecordLiteralNode);
|
|
begin
|
|
inherited Create;
|
|
FNode := ANode;
|
|
FFieldNodes := TDictionary<IKeyword, TAuraNode>.Create;
|
|
end;
|
|
|
|
destructor TRecordLiteralNodeHandler.Destroy;
|
|
begin
|
|
FFieldNodes.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TRecordLiteralNodeHandler.GetAstNode: IAstNode;
|
|
begin
|
|
Result := FNode;
|
|
end;
|
|
|
|
procedure TRecordLiteralNodeHandler.BuildUI(OwnerNode: TAuraNode);
|
|
var
|
|
field: TRecordFieldLiteral;
|
|
fieldContainer: TAutoFitControl;
|
|
valueNode: TAuraNode;
|
|
keyLabel: TLabel;
|
|
begin
|
|
OwnerNode.BeginUpdate;
|
|
try
|
|
OwnerNode.Frameless := False;
|
|
OwnerNode.Orientation := loVertical;
|
|
OwnerNode.Alignment := laFlush;
|
|
|
|
if Length(FNode.Fields) = 0 then
|
|
begin
|
|
OwnerNode.AddLabel(OwnerNode, '{}');
|
|
end
|
|
else
|
|
begin
|
|
for field in FNode.Fields do
|
|
begin
|
|
fieldContainer := OwnerNode.AddContainer(OwnerNode, loHorizontal, laCenter);
|
|
keyLabel := OwnerNode.AddLabel(fieldContainer, ':' + field.Key.Value.Name);
|
|
keyLabel.Font.Style := keyLabel.Font.Style + [TFontStyle.fsBold];
|
|
keyLabel.StyledSettings := keyLabel.StyledSettings - [TStyledSetting.FontColor];
|
|
keyLabel.FontColor := TAlphaColors.Mediumvioletred;
|
|
|
|
valueNode := OwnerNode.Visualizer.Clone(fieldContainer, OwnerNode.Visualizer.ExprDepth + 1).CallAccept(field.Value);
|
|
FFieldNodes.Add(field.Key.Value, valueNode);
|
|
end;
|
|
end;
|
|
finally
|
|
OwnerNode.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TRecordLiteralNodeHandler.ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
var
|
|
fields: TArray<TRecordFieldLiteral>;
|
|
i: Integer;
|
|
valueNode: TAuraNode;
|
|
pair: TPair<IKeyword, TAuraNode>;
|
|
begin
|
|
SetLength(fields, FFieldNodes.Count);
|
|
i := 0;
|
|
for pair in FFieldNodes do
|
|
begin
|
|
valueNode := pair.Value;
|
|
fields[i] := TRecordFieldLiteral.Create(TAst.Keyword(pair.Key.Name), valueNode.CreateAst);
|
|
inc(i);
|
|
end;
|
|
Result := TAst.RecordLiteral(fields);
|
|
end;
|
|
|
|
{ TCreateSeriesNodeHandler }
|
|
|
|
constructor TCreateSeriesNodeHandler.Create(const ANode: ICreateSeriesNode);
|
|
begin
|
|
inherited Create;
|
|
FNode := ANode;
|
|
end;
|
|
|
|
function TCreateSeriesNodeHandler.GetAstNode: IAstNode;
|
|
begin
|
|
Result := FNode;
|
|
end;
|
|
|
|
procedure TCreateSeriesNodeHandler.BuildUI(OwnerNode: TAuraNode);
|
|
var
|
|
titleLabel: TLabel;
|
|
begin
|
|
OwnerNode.BeginUpdate;
|
|
try
|
|
OwnerNode.Frameless := False;
|
|
OwnerNode.Orientation := loVertical;
|
|
titleLabel := OwnerNode.AddLabel(OwnerNode, 'Create Series: ' + FNode.Definition);
|
|
titleLabel.Font.Style := titleLabel.Font.Style + [TFontStyle.fsBold];
|
|
finally
|
|
OwnerNode.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TCreateSeriesNodeHandler.ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
begin
|
|
Result := TAst.CreateSeries(FNode.Definition);
|
|
end;
|
|
|
|
{ TAddSeriesItemNodeHandler }
|
|
|
|
constructor TAddSeriesItemNodeHandler.Create(const ANode: IAddSeriesItemNode);
|
|
begin
|
|
inherited Create;
|
|
FNode := ANode;
|
|
FLookbackNode := nil;
|
|
end;
|
|
|
|
function TAddSeriesItemNodeHandler.GetAstNode: IAstNode;
|
|
begin
|
|
Result := FNode;
|
|
end;
|
|
|
|
procedure TAddSeriesItemNodeHandler.BuildUI(OwnerNode: TAuraNode);
|
|
var
|
|
visu: IAstVisualizer;
|
|
titleLabel: TLabel;
|
|
begin
|
|
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth + 1);
|
|
OwnerNode.BeginUpdate;
|
|
try
|
|
OwnerNode.Frameless := False;
|
|
OwnerNode.Orientation := loVertical;
|
|
|
|
titleLabel := OwnerNode.AddLabel(OwnerNode, '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
|
|
OwnerNode.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TAddSeriesItemNodeHandler.ReconstructAst(OwnerNode: TAuraNode): 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;
|
|
|
|
{ TSeriesLengthNodeHandler }
|
|
|
|
constructor TSeriesLengthNodeHandler.Create(const ANode: ISeriesLengthNode);
|
|
begin
|
|
inherited Create;
|
|
FNode := ANode;
|
|
end;
|
|
|
|
function TSeriesLengthNodeHandler.GetAstNode: IAstNode;
|
|
begin
|
|
Result := FNode;
|
|
end;
|
|
|
|
procedure TSeriesLengthNodeHandler.BuildUI(OwnerNode: TAuraNode);
|
|
var
|
|
titleLabel: TLabel;
|
|
begin
|
|
OwnerNode.BeginUpdate;
|
|
try
|
|
OwnerNode.Frameless := False;
|
|
OwnerNode.Orientation := loVertical;
|
|
titleLabel := OwnerNode.AddLabel(OwnerNode, 'Length of: ' + FNode.Series.Name);
|
|
titleLabel.Font.Style := titleLabel.Font.Style + [TFontStyle.fsBold];
|
|
finally
|
|
OwnerNode.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TSeriesLengthNodeHandler.ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
begin
|
|
Result := TAst.SeriesLength(TAst.Identifier(FNode.Series.Name));
|
|
end;
|
|
|
|
{ TNopNodeHandler }
|
|
|
|
constructor TNopNodeHandler.Create(const ANode: INopNode);
|
|
begin
|
|
inherited Create;
|
|
FNode := ANode;
|
|
end;
|
|
|
|
function TNopNodeHandler.GetAstNode: IAstNode;
|
|
begin
|
|
Result := FNode;
|
|
end;
|
|
|
|
procedure TNopNodeHandler.BuildUI(OwnerNode: TAuraNode);
|
|
var
|
|
lbl: TLabel;
|
|
begin
|
|
OwnerNode.BeginUpdate;
|
|
try
|
|
OwnerNode.Frameless := true;
|
|
OwnerNode.Alignment := TLayoutAlignment.laCenter;
|
|
OwnerNode.Orientation := TLayoutOrientation.loHorizontal;
|
|
lbl := OwnerNode.AddLabel(OwnerNode, '...');
|
|
lbl.Font.Style := lbl.Font.Style + [TFontStyle.fsBold];
|
|
lbl.Margins.Rect := TRectF.Create(8, 4, 8, 4);
|
|
finally
|
|
OwnerNode.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TNopNodeHandler.ReconstructAst(OwnerNode: TAuraNode): IAstNode;
|
|
begin
|
|
Result := FNode;
|
|
end;
|
|
|
|
end.
|