Michael Schimmel
874 lines
29 KiB
ObjectPascal
874 lines
29 KiB
ObjectPascal
unit Myc.Ast.Visualizer;
|
|
|
|
interface
|
|
|
|
uses
|
|
System.SysUtils,
|
|
System.Classes,
|
|
System.UITypes,
|
|
System.Types,
|
|
System.Generics.Collections,
|
|
FMX.Types,
|
|
FMX.Controls,
|
|
FMX.Objects,
|
|
FMX.Graphics,
|
|
Myc.Ast.Nodes,
|
|
DraggablePanel;
|
|
|
|
type
|
|
TPinConnection = record
|
|
OutputPin: TControl;
|
|
InputPin: TControl;
|
|
constructor Create(AOutputPin, AInputPin: TControl);
|
|
end;
|
|
|
|
TPinShape = (psCircle, psTriangle);
|
|
TPinAlignment = (paLeft, paRight);
|
|
|
|
TAuraWorkspace = class;
|
|
|
|
TAstToAuraNodeVisitor = class(TInterfacedObject, IAstVisitor)
|
|
public
|
|
type
|
|
TChildVisitorProc = reference to procedure(const Visitor: IAstVisitor);
|
|
TAuraNodeList = TList<TAuraNode>;
|
|
TCreateParentNodeProc = reference to function(const InputNodes: TAuraNodeList): TAuraNode;
|
|
TVerticalAlignment = (vaCenter, vaTop);
|
|
|
|
private
|
|
const
|
|
// Pin Visuals
|
|
cPinSize = 10;
|
|
cDataPinColor = TAlphaColors.Dodgerblue;
|
|
cExecPinColor = TAlphaColors.Lightgreen;
|
|
|
|
// Node Layout
|
|
cHorizontalPadding = 25; // Padding inside the node title bar
|
|
cPinOffsetY = 18; // Vertical distance between pins
|
|
cVerticalPadding = 20; // General vertical padding inside container nodes
|
|
|
|
// Specific Node Heights
|
|
cDefaultNodeHeight = 45; // Default height for simple nodes like BinaryExpr
|
|
cIfNodeHeight = 60; // Taller height for If nodes with more pins
|
|
|
|
private
|
|
FWorkspace: TAuraWorkspace;
|
|
FParentControl: TControl;
|
|
FCurrentPos: TPointF;
|
|
FSpacing: TPointF;
|
|
FLastNode: TAuraNode;
|
|
FConnections: TList<TPinConnection>;
|
|
FCurrentExec: TList<TControl>;
|
|
|
|
function VisitContainerNode(
|
|
const Title, Details: string;
|
|
const InPin, OutPin: String;
|
|
IsExec: Boolean;
|
|
const ChildVisitorProc: TChildVisitorProc
|
|
): TAuraNode;
|
|
function VisitOperatorNode(
|
|
const InputExpressions: TArray<IExpressionNode>;
|
|
const CreateParentProc: TCreateParentNodeProc;
|
|
Alignment: TVerticalAlignment = vaCenter
|
|
): TAuraNode;
|
|
|
|
function BuildNodeControl(const Title, Details: string): TAuraNode;
|
|
function CreateNodeControl(const Title, Details: string): TAuraNode;
|
|
function CreatePin(
|
|
ParentNode: TAuraNode;
|
|
Shape: TPinShape;
|
|
Alignment: TPinAlignment;
|
|
Color: TAlphaColor;
|
|
const Tag: string;
|
|
OffsetY: Single = 0
|
|
): TShape;
|
|
|
|
function CreateInput(ParentNode: TAuraNode; const Caption: string; OffsetY: Single = 0): TControl;
|
|
function CreateOutput(ParentNode: TAuraNode; OffsetY: Single = 0): TControl;
|
|
function CreateEntry(ParentNode: TAuraNode; OffsetY: Single = 0; connect: Boolean = true): TControl;
|
|
function CreateExit(ParentNode: TAuraNode; const Caption: string; OffsetY: Single = 0): TControl;
|
|
|
|
function FindPinByTag(ParentNode: TAuraNode; const Tag: string): TControl;
|
|
function ConnectData(InputPin: TControl; OutputNode: TAuraNode): TControl;
|
|
public
|
|
constructor Create(
|
|
AWorkspace: TAuraWorkspace;
|
|
AParentControl: TControl;
|
|
const AStartPosition: TPointF;
|
|
AConnections: TList<TPinConnection>;
|
|
const ACurrentExec: TArray<TControl>
|
|
);
|
|
destructor Destroy; override;
|
|
|
|
// Public access to the collected connections
|
|
property Connections: TList<TPinConnection> read FConnections;
|
|
|
|
{ IAstVisitor }
|
|
function VisitConstant(const Node: IConstantNode): TAstValue;
|
|
function VisitIdentifier(const Node: IIdentifierNode): TAstValue;
|
|
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue;
|
|
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TAstValue;
|
|
function VisitIfExpression(const Node: IIfExpressionNode): TAstValue;
|
|
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue;
|
|
function VisitFunctionCall(const Node: IFunctionCallNode): TAstValue;
|
|
function VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue;
|
|
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue;
|
|
function VisitAssignment(const Node: IAssignmentNode): TAstValue;
|
|
end;
|
|
|
|
TAuraWorkspace = class(TStyledControl)
|
|
private
|
|
FConnections: TArray<TPinConnection>;
|
|
protected
|
|
procedure Paint; override;
|
|
procedure DoDeleteChildren; override;
|
|
public
|
|
procedure BuildTree(const Root: IAstNode; const Position: TPointF);
|
|
|
|
published
|
|
// 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 HelpContext;
|
|
property HelpKeyword;
|
|
property HelpType;
|
|
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 StyleLookup;
|
|
property Visible;
|
|
property Width;
|
|
property OnClick;
|
|
property OnDblClick;
|
|
property OnMouseDown;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnMouseWheel;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
System.Math;
|
|
|
|
{ TPinConnection }
|
|
|
|
constructor TPinConnection.Create(AOutputPin, AInputPin: TControl);
|
|
begin
|
|
OutputPin := AOutputPin;
|
|
InputPin := AInputPin;
|
|
end;
|
|
|
|
{ TAstToAuraNodeVisitor }
|
|
|
|
constructor TAstToAuraNodeVisitor.Create(
|
|
AWorkspace: TAuraWorkspace;
|
|
AParentControl: TControl;
|
|
const AStartPosition: TPointF;
|
|
AConnections: TList<TPinConnection>;
|
|
const ACurrentExec: TArray<TControl>
|
|
);
|
|
begin
|
|
inherited Create;
|
|
FWorkspace := AWorkspace;
|
|
FParentControl := AParentControl;
|
|
FCurrentPos := AStartPosition;
|
|
FSpacing := TPointF.Create(20, 10); // Horizontal indent, Vertical spacing
|
|
FConnections := AConnections;
|
|
FCurrentExec := TList<TControl>.Create(ACurrentExec);
|
|
end;
|
|
|
|
destructor TAstToAuraNodeVisitor.Destroy;
|
|
begin
|
|
FCurrentExec.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.BuildNodeControl(const Title, Details: string): TAuraNode;
|
|
var
|
|
fullTitle: string;
|
|
textWidth: Single;
|
|
newWidth: Single;
|
|
measureCanvas: TCanvas;
|
|
begin
|
|
Result := TAuraNode.Create(FParentControl);
|
|
Result.Parent := FParentControl;
|
|
|
|
// Build the full title string first
|
|
fullTitle := Title;
|
|
if not Details.IsEmpty then
|
|
fullTitle := fullTitle + ': ' + Details;
|
|
Result.Title := fullTitle;
|
|
|
|
// Adjust the width so that the text is completely visible.
|
|
measureCanvas := TCanvasManager.MeasureCanvas;
|
|
if Assigned(measureCanvas) then
|
|
begin
|
|
measureCanvas.Font.Assign(Result.TitleFont);
|
|
textWidth := measureCanvas.TextWidth(Result.Title);
|
|
newWidth := textWidth + (2 * cHorizontalPadding);
|
|
// Ensure the new width is not smaller than the default width of the node.
|
|
Result.Width := Max(Result.Width, newWidth);
|
|
end;
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.ConnectData(InputPin: TControl; OutputNode: TAuraNode): TControl;
|
|
begin
|
|
Result := FindPinByTag(OutputNode, 'data.out');
|
|
if Assigned(Result) then
|
|
FConnections.Add(TPinConnection.Create(Result, InputPin));
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.CreateInput(ParentNode: TAuraNode; const Caption: string; OffsetY: Single = 0): TControl;
|
|
begin
|
|
var cap := Caption;
|
|
if cap <> '' then
|
|
cap := '.' + cap;
|
|
Result := CreatePin(ParentNode, psCircle, paLeft, cDataPinColor, 'data.in' + cap, OffsetY);
|
|
Result.Hint := Caption;
|
|
Result.ShowHint := Caption <> '';
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.CreateNodeControl(const Title, Details: string): TAuraNode;
|
|
begin
|
|
Result := BuildNodeControl(Title, Details);
|
|
Result.Position.Point := FCurrentPos;
|
|
|
|
// Advance vertical position for the next node
|
|
FCurrentPos.Y := FCurrentPos.Y + Result.Height + FSpacing.Y;
|
|
|
|
FLastNode := Result;
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.CreateOutput(ParentNode: TAuraNode; OffsetY: Single = 0): TControl;
|
|
begin
|
|
Result := CreatePin(ParentNode, psCircle, paRight, cDataPinColor, 'data.out', OffsetY);
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.CreateEntry(ParentNode: TAuraNode; OffsetY: Single = 0; connect: Boolean = true): TControl;
|
|
begin
|
|
Result := CreatePin(ParentNode, psTriangle, paLeft, cExecPinColor, 'exec.in', OffsetY);
|
|
if connect then
|
|
begin
|
|
// Connect all open exits to this new entry
|
|
for var curr in FCurrentExec do
|
|
FConnections.Add(TPinConnection.Create(curr, Result));
|
|
FCurrentExec.Clear;
|
|
end;
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.CreateExit(ParentNode: TAuraNode; const Caption: string; OffsetY: Single = 0): TControl;
|
|
begin
|
|
var cap := Caption;
|
|
if cap <> '' then
|
|
cap := '.' + cap;
|
|
Result := CreatePin(ParentNode, psTriangle, paRight, cExecPinColor, 'exec.out' + cap, OffsetY);
|
|
|
|
FCurrentExec.Add(Result);
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.CreatePin(
|
|
ParentNode: TAuraNode;
|
|
Shape: TPinShape;
|
|
Alignment: TPinAlignment;
|
|
Color: TAlphaColor;
|
|
const Tag: string;
|
|
OffsetY: Single = 0
|
|
): TShape;
|
|
var
|
|
posX, posY: Single;
|
|
begin
|
|
// Calculate vertical position (centered + offset)
|
|
posY := (ParentNode.Height / 2) - (cPinSize / 2) + OffsetY;
|
|
|
|
// Calculate horizontal position
|
|
if Alignment = paLeft then
|
|
posX := 0
|
|
else // paRight
|
|
posX := ParentNode.Width - cPinSize;
|
|
|
|
// Create the shape
|
|
case Shape of
|
|
psCircle:
|
|
begin
|
|
var circle := TEllipse.Create(ParentNode);
|
|
circle.Fill.Color := Color;
|
|
circle.Stroke.Kind := TBrushKind.None;
|
|
Result := circle;
|
|
end;
|
|
psTriangle:
|
|
begin
|
|
var triangle := TPath.Create(ParentNode);
|
|
triangle.Data.Data := Format('M 0 0 L %d %d L 0 %d Z', [cPinSize, cPinSize div 2, cPinSize]);
|
|
triangle.Fill.Color := Color;
|
|
triangle.Stroke.Kind := TBrushKind.None;
|
|
Result := triangle;
|
|
end;
|
|
else
|
|
Result := nil;
|
|
exit;
|
|
end;
|
|
|
|
// Common properties
|
|
Result.Parent := ParentNode;
|
|
Result.SetBounds(posX, posY, cPinSize, cPinSize);
|
|
Result.HitTest := true;
|
|
|
|
// Use TagString to identify the control as a pin and describe its function.
|
|
Result.TagString := Tag;
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.FindPinByTag(ParentNode: TAuraNode; const Tag: string): TControl;
|
|
var
|
|
control: TControl;
|
|
begin
|
|
Result := nil;
|
|
if not Assigned(ParentNode) then
|
|
exit;
|
|
|
|
for control in ParentNode.Controls do
|
|
begin
|
|
if control.TagString = Tag then
|
|
begin
|
|
Result := control;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.VisitAssignment(const Node: IAssignmentNode): TAstValue;
|
|
begin
|
|
VisitOperatorNode(
|
|
[Node.Value],
|
|
function(const InputNodes: TAuraNodeList): TAuraNode
|
|
var
|
|
assignmentNode, valueNode: TAuraNode;
|
|
inputPin: TControl;
|
|
begin
|
|
valueNode := InputNodes[0];
|
|
assignmentNode := BuildNodeControl('Assignment', Node.Identifier.Name);
|
|
|
|
CreateEntry(assignmentNode, -8);
|
|
CreateExit(assignmentNode, '', 0);
|
|
inputPin := CreateInput(assignmentNode, Node.Identifier.Name, 8);
|
|
ConnectData(inputPin, valueNode);
|
|
|
|
Result := assignmentNode;
|
|
end,
|
|
vaTop
|
|
);
|
|
Result := TAstValue.Void;
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue;
|
|
begin
|
|
VisitOperatorNode(
|
|
[Node.Left, Node.Right],
|
|
function(const InputNodes: TAuraNodeList): TAuraNode
|
|
var
|
|
binaryExprNode, leftNode, rightNode: TAuraNode;
|
|
inputPin1, inputPin2: TControl;
|
|
begin
|
|
leftNode := InputNodes[0];
|
|
rightNode := InputNodes[1];
|
|
|
|
binaryExprNode := BuildNodeControl(Node.Operator.ToString, '');
|
|
binaryExprNode.TitleFont.Size := 20;
|
|
|
|
inputPin1 := CreateInput(binaryExprNode, '', -8); // Caption is in Hint
|
|
inputPin2 := CreateInput(binaryExprNode, '', 8);
|
|
CreateOutput(binaryExprNode, 0);
|
|
|
|
ConnectData(inputPin1, leftNode);
|
|
ConnectData(inputPin2, rightNode);
|
|
|
|
Result := binaryExprNode;
|
|
end
|
|
);
|
|
Result := TAstValue.Void;
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue;
|
|
var
|
|
blockNode: TAuraNode;
|
|
begin
|
|
// Use the helper to create and populate the container node.
|
|
// InPin and OutPin set: block acts as "virtual execution scope" with entry and exit-nodes
|
|
// InPin and OutPin empty: block acts as a simple container
|
|
blockNode :=
|
|
VisitContainerNode(
|
|
'Block',
|
|
'',
|
|
// 'enter', 'exit',
|
|
'',
|
|
'',
|
|
true,
|
|
procedure(const Visitor: IAstVisitor)
|
|
var
|
|
expression: IExpressionNode;
|
|
begin
|
|
for expression in Node.Expressions do
|
|
expression.Accept(Visitor);
|
|
end
|
|
);
|
|
|
|
// Update the state of the main visitor
|
|
FCurrentPos.Y := blockNode.Position.Y + blockNode.Height + FSpacing.Y;
|
|
FLastNode := blockNode;
|
|
|
|
Result := TAstValue.Void;
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.VisitConstant(const Node: IConstantNode): TAstValue;
|
|
var
|
|
constantNode: TAuraNode;
|
|
begin
|
|
// A constant has a data output pin.
|
|
// Data outputs are round and on the right side of the box.
|
|
constantNode := CreateNodeControl('Constant', Node.Value.ToString);
|
|
CreateOutput(constantNode, 0);
|
|
Result := TAstValue.Void;
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.VisitContainerNode(
|
|
const Title, Details: string;
|
|
const InPin, OutPin: String;
|
|
IsExec: Boolean;
|
|
const ChildVisitorProc: TChildVisitorProc
|
|
): TAuraNode;
|
|
var
|
|
containerNode: TAuraNode;
|
|
childVisitor: IAstVisitor;
|
|
childStartPos: TPointF;
|
|
maxRight: Single;
|
|
maxBottom: Single;
|
|
control: TControl;
|
|
begin
|
|
const pinNodeHeight = cPinSize + cVerticalPadding;
|
|
|
|
// Step 1: Create container node
|
|
containerNode := BuildNodeControl(Title, Details);
|
|
containerNode.Position.Point := FCurrentPos;
|
|
Result := containerNode; // Set result early
|
|
|
|
childStartPos :=
|
|
TPointF.Create(FSpacing.X, FSpacing.Y + max(IfThen(InPin <> '', pinNodeHeight, 0), IfThen(Title <> '', cVerticalPadding, 0)));
|
|
|
|
var currExec := FCurrentExec.ToArray;
|
|
if InPin <> '' then
|
|
begin
|
|
// Create a small entry node to define the start of the execution flow inside the container.
|
|
var entryNode := BuildNodeControl(InPin, '');
|
|
entryNode.Parent := containerNode;
|
|
entryNode.Position.Point := TPointF.Create(0, 0);
|
|
entryNode.Height := pinNodeHeight;
|
|
|
|
if IsExec then
|
|
begin
|
|
var entryPin := CreateEntry(containerNode, 0);
|
|
var entryExitPin := CreateExit(entryNode, '', 0);
|
|
entryPin.Position.Y := containerNode.AbsoluteToLocal(entryNode.LocalToAbsolute(entryExitPin.Position.Point)).Y;
|
|
end
|
|
else
|
|
begin
|
|
FCurrentExec.Clear;
|
|
CreateExit(entryNode, '', 0);
|
|
end;
|
|
end;
|
|
|
|
// Step 2: Create child visitor and run the closure.
|
|
// The child visitor starts its execution flow from the entry node's exit pin.
|
|
childVisitor := TAstToAuraNodeVisitor.Create(FWorkspace, containerNode, childStartPos, FConnections, FCurrentExec.ToArray);
|
|
ChildVisitorProc(childVisitor);
|
|
|
|
FCurrentExec.Clear;
|
|
FCurrentExec.AddRange((childVisitor as TAstToAuraNodeVisitor).FCurrentExec);
|
|
|
|
// Step 3: Adjust the size of the container node to fit children.
|
|
maxRight := 0;
|
|
maxBottom := 0;
|
|
for control in containerNode.Controls do
|
|
begin
|
|
if control is TAuraNode then
|
|
begin
|
|
maxRight := Max(maxRight, control.Position.X + control.Width);
|
|
maxBottom := Max(maxBottom, control.Position.Y + control.Height);
|
|
end;
|
|
end;
|
|
|
|
// The width must be at least the title width, and large enough for children.
|
|
containerNode.Width := Max(containerNode.Width, maxRight + FSpacing.X);
|
|
containerNode.Height := Max(containerNode.Height, maxBottom + FSpacing.Y + IfThen(OutPin <> '', pinNodeHeight, 0));
|
|
|
|
if OutPin <> '' then
|
|
begin
|
|
var exitNode := BuildNodeControl(OutPin, '');
|
|
exitNode.Parent := containerNode;
|
|
exitNode.Position.Point := TPointF.Create(containerNode.Width - exitNode.Width, containerNode.Height - pinNodeHeight);
|
|
exitNode.Height := pinNodeHeight;
|
|
var exitPin := CreateEntry(exitNode, 0);
|
|
|
|
if not IsExec then
|
|
begin
|
|
FCurrentExec.Clear;
|
|
FCurrentExec.AddRange(currExec);
|
|
end
|
|
else
|
|
CreateExit(containerNode, '', 0).Position.Y :=
|
|
containerNode.AbsoluteToLocal(exitNode.LocalToAbsolute(exitPin.Position.Point)).Y;
|
|
end
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TAstValue;
|
|
var
|
|
inputExpressions: TArray<IExpressionNode>;
|
|
begin
|
|
SetLength(inputExpressions, 1 + Node.Arguments.Count);
|
|
inputExpressions[0] := Node.Callee;
|
|
for var i := 0 to Node.Arguments.Count - 1 do
|
|
inputExpressions[i + 1] := Node.Arguments[i];
|
|
|
|
VisitOperatorNode(
|
|
inputExpressions,
|
|
function(const InputNodes: TAuraNodeList): TAuraNode
|
|
var
|
|
funcCallNode: TAuraNode;
|
|
calleePin: TControl;
|
|
argPin: array of TControl;
|
|
currentInputOffsetY, currentOutputOffsetY: Single;
|
|
i: Integer;
|
|
begin
|
|
funcCallNode := BuildNodeControl('FunctionCall', '');
|
|
|
|
var numInputPins := 2 + Node.Arguments.Count;
|
|
var numOutputPins := 2;
|
|
var maxPins := Max(numInputPins, numOutputPins);
|
|
funcCallNode.Height := cVerticalPadding * 2 + (maxPins - 1) * cPinOffsetY;
|
|
|
|
currentInputOffsetY := -(numInputPins - 1) / 2.0 * cPinOffsetY;
|
|
CreateEntry(funcCallNode, currentInputOffsetY);
|
|
currentInputOffsetY := currentInputOffsetY + cPinOffsetY;
|
|
calleePin := CreateInput(funcCallNode, 'Callee', currentInputOffsetY);
|
|
currentInputOffsetY := currentInputOffsetY + cPinOffsetY;
|
|
SetLength(argPin, Node.Arguments.Count);
|
|
for i := 0 to Node.Arguments.Count - 1 do
|
|
begin
|
|
argPin[i] := CreateInput(funcCallNode, 'Arg' + i.ToString, currentInputOffsetY);
|
|
currentInputOffsetY := currentInputOffsetY + cPinOffsetY;
|
|
end;
|
|
|
|
currentOutputOffsetY := -(numOutputPins - 1) / 2.0 * cPinOffsetY;
|
|
CreateExit(funcCallNode, '', currentOutputOffsetY);
|
|
currentOutputOffsetY := currentOutputOffsetY + cPinOffsetY;
|
|
CreateOutput(funcCallNode, currentOutputOffsetY);
|
|
|
|
ConnectData(calleePin, InputNodes[0]);
|
|
for i := 0 to Node.Arguments.Count - 1 do
|
|
ConnectData(argPin[i], InputNodes[i + 1]);
|
|
|
|
Result := funcCallNode;
|
|
end
|
|
);
|
|
|
|
Result := TAstValue.Void;
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.VisitIdentifier(const Node: IIdentifierNode): TAstValue;
|
|
begin
|
|
var identifierNode := CreateNodeControl('Identifier', Node.Name);
|
|
// Add a data output pin on the right side.
|
|
CreateOutput(identifierNode, 0);
|
|
Result := TAstValue.Void;
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.VisitIfExpression(const Node: IIfExpressionNode): TAstValue;
|
|
begin
|
|
var startPosition := FCurrentPos;
|
|
|
|
// Use helper for the condition part
|
|
var ifNode :=
|
|
VisitOperatorNode(
|
|
[Node.Condition],
|
|
function(const InputNodes: TAuraNodeList): TAuraNode
|
|
var
|
|
condNode: TAuraNode;
|
|
conditionInputPin: TControl;
|
|
begin
|
|
condNode := InputNodes[0];
|
|
|
|
Result := BuildNodeControl('If', '');
|
|
Result.Height := cIfNodeHeight;
|
|
CreateEntry(Result, -12);
|
|
|
|
conditionInputPin := CreateInput(Result, 'Condition', 12);
|
|
|
|
ConnectData(conditionInputPin, condNode);
|
|
end
|
|
);
|
|
var conditionEndY := FCurrentPos.Y;
|
|
|
|
// Visit the 'Then' and 'Else' execution branches, placing them to the right of the 'If' node.
|
|
var branchStartX := ifNode.Position.X + ifNode.Width + FSpacing.X;
|
|
|
|
var execPathes := TList<TControl>.Create;
|
|
|
|
// Then branch
|
|
FCurrentExec.Clear;
|
|
CreateExit(ifNode, 'Then', -12);
|
|
FCurrentPos.X := branchStartX;
|
|
FCurrentPos.Y := startPosition.Y;
|
|
Node.ThenBranch.Accept(Self);
|
|
var thenEndY := FCurrentPos.Y;
|
|
FLastNode := ifNode;
|
|
execPathes.AddRange(FCurrentExec);
|
|
|
|
// Else branch (if it exists)
|
|
var elseEndY := thenEndY;
|
|
if Assigned(Node.ElseBranch) then
|
|
begin
|
|
FCurrentExec.Clear;
|
|
CreateExit(ifNode, 'Else', 12);
|
|
FCurrentPos.X := branchStartX;
|
|
FCurrentPos.Y := thenEndY;
|
|
Node.ElseBranch.Accept(Self);
|
|
elseEndY := FCurrentPos.Y;
|
|
execPathes.AddRange(FCurrentExec);
|
|
end;
|
|
|
|
// Finalize visitor state.
|
|
FCurrentPos.X := startPosition.X;
|
|
FCurrentPos.Y := Max(conditionEndY, elseEndY);
|
|
FLastNode := ifNode;
|
|
|
|
// After a branch, the execution flow has diverged. There is no single
|
|
// execution pin to continue from, so we set it to nil.
|
|
FCurrentExec.Clear;
|
|
FCurrentExec.AddRange(execPathes);
|
|
|
|
Result := TAstValue.Void;
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue;
|
|
var
|
|
paramStr: String;
|
|
lambdaNode: TAuraNode;
|
|
i: Integer;
|
|
begin
|
|
// Prepare the parameter string for the title
|
|
paramStr := '(';
|
|
if Length(Node.Parameters) > 0 then
|
|
begin
|
|
paramStr := paramStr + Node.Parameters[0].Name;
|
|
for i := 1 to High(Node.Parameters) do
|
|
paramStr := paramStr + ', ' + Node.Parameters[i].Name;
|
|
end;
|
|
paramStr := paramStr + ')';
|
|
|
|
// Use the helper to create and populate the container node.
|
|
lambdaNode :=
|
|
VisitContainerNode(
|
|
'Lambda',
|
|
paramStr,
|
|
'call',
|
|
'return',
|
|
false,
|
|
procedure(const Visitor: IAstVisitor) begin Node.Body.Accept(Visitor); end
|
|
);
|
|
|
|
CreateOutput(lambdaNode, 0);
|
|
|
|
// Update the state of the main visitor
|
|
FCurrentPos.Y := lambdaNode.Position.Y + lambdaNode.Height + FSpacing.Y;
|
|
FLastNode := lambdaNode;
|
|
|
|
Result := TAstValue.Void;
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.VisitOperatorNode(
|
|
const InputExpressions: TArray<IExpressionNode>;
|
|
const CreateParentProc: TCreateParentNodeProc;
|
|
Alignment: TVerticalAlignment
|
|
): TAuraNode;
|
|
var
|
|
inputResultNodes: TAuraNodeList;
|
|
inputNode: IExpressionNode;
|
|
startPosition: TPointF;
|
|
endY, maxChildWidth: Single;
|
|
parentNode: TAuraNode;
|
|
begin
|
|
startPosition := FCurrentPos;
|
|
inputResultNodes := TAuraNodeList.Create;
|
|
try
|
|
// 1. Visit all input nodes and collect their visual representations.
|
|
for inputNode in InputExpressions do
|
|
begin
|
|
inputNode.Accept(Self);
|
|
inputResultNodes.Add(FLastNode);
|
|
end;
|
|
endY := FCurrentPos.Y;
|
|
|
|
// 2. Determine the layout bounds of the input nodes.
|
|
maxChildWidth := 0;
|
|
for var node in inputResultNodes do
|
|
maxChildWidth := Max(maxChildWidth, node.Position.X + node.Width);
|
|
|
|
// 3. Let the closure create the parent node (without positioning).
|
|
parentNode := CreateParentProc(inputResultNodes);
|
|
Result := parentNode;
|
|
|
|
// 4. Now position the parent node to the right of the inputs.
|
|
var parentY: Single;
|
|
if Alignment = vaCenter then
|
|
begin
|
|
var totalInputHeight := endY - startPosition.Y;
|
|
var nodeCenterY := startPosition.Y + (totalInputHeight / 2);
|
|
parentY := nodeCenterY - (parentNode.Height / 2);
|
|
end
|
|
else // vaTop
|
|
begin
|
|
parentY := startPosition.Y;
|
|
end;
|
|
parentNode.Position.Point := TPointF.Create(maxChildWidth + FSpacing.X, parentY);
|
|
|
|
// 5. Finalize visitor state for the next operation.
|
|
FCurrentPos.X := startPosition.X;
|
|
FCurrentPos.Y := Max(endY, parentNode.Position.Y + parentNode.Height + FSpacing.Y);
|
|
FLastNode := parentNode;
|
|
finally
|
|
inputResultNodes.Free;
|
|
end;
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): TAstValue;
|
|
begin
|
|
CreateNodeControl('UnaryExpr', Node.Operator.ToString);
|
|
FCurrentPos.X := FCurrentPos.X + FSpacing.X;
|
|
try
|
|
Node.Right.Accept(Self);
|
|
finally
|
|
FCurrentPos.X := FCurrentPos.X - FSpacing.X;
|
|
end;
|
|
Result := TAstValue.Void;
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue;
|
|
begin
|
|
if Assigned(Node.Initializer) then
|
|
begin
|
|
VisitOperatorNode(
|
|
[Node.Initializer],
|
|
function(const InputNodes: TAuraNodeList): TAuraNode
|
|
var
|
|
varDeclNode, initializerNode: TAuraNode;
|
|
inputPin: TControl;
|
|
begin
|
|
initializerNode := InputNodes[0];
|
|
varDeclNode := BuildNodeControl('VarDecl', Node.Identifier.Name);
|
|
|
|
CreateEntry(varDeclNode, -8);
|
|
CreateExit(varDeclNode, '', -8);
|
|
inputPin := CreateInput(varDeclNode, 'Value', 8);
|
|
ConnectData(inputPin, initializerNode);
|
|
|
|
Result := varDeclNode;
|
|
end
|
|
);
|
|
end
|
|
else
|
|
begin
|
|
// Case without initializer is a simple sequential node.
|
|
var varDeclNode := CreateNodeControl('VarDecl', Node.Identifier.Name);
|
|
CreateEntry(varDeclNode, 0);
|
|
CreateExit(varDeclNode, '', 0);
|
|
end;
|
|
Result := TAstValue.Void;
|
|
end;
|
|
|
|
{ TAuraWorkspace }
|
|
|
|
procedure TAuraWorkspace.BuildTree(const Root: IAstNode; const Position: TPointF);
|
|
begin
|
|
var connections := TList<TPinConnection>.Create;
|
|
try
|
|
Root.Accept(TAstToAuraNodeVisitor.Create(Self, Self, Position, connections, nil));
|
|
FConnections := FConnections + connections.ToArray;
|
|
finally
|
|
connections.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TAuraWorkspace.DoDeleteChildren;
|
|
begin
|
|
FConnections := nil;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TAuraWorkspace.Paint;
|
|
var
|
|
connection: TPinConnection;
|
|
startPoint, endPoint, pinCenter: TPointF;
|
|
path: TPathData;
|
|
controlPoint1, controlPoint2: TPointF;
|
|
deltaX, controlOffset: Single;
|
|
begin
|
|
inherited;
|
|
|
|
Canvas.Stroke.Kind := TBrushKind.Solid;
|
|
Canvas.Stroke.Thickness := 2;
|
|
|
|
// Gehe durch alle gespeicherten Verbindungen und zeichne sie
|
|
for connection in FConnections do
|
|
begin
|
|
// Hole die absoluten Koordinaten der Pin-Mittelpunkte
|
|
pinCenter := TPointF.Create(connection.OutputPin.Width / 2, connection.OutputPin.Height / 2);
|
|
var absoluteStart := connection.OutputPin.LocalToAbsolute(pinCenter);
|
|
|
|
pinCenter := TPointF.Create(connection.InputPin.Width / 2, connection.InputPin.Height / 2);
|
|
var absoluteEnd := connection.InputPin.LocalToAbsolute(pinCenter);
|
|
|
|
// Rechne sie in die lokalen Koordinaten der PaintBox um
|
|
startPoint := AbsoluteToLocal(absoluteStart);
|
|
endPoint := AbsoluteToLocal(absoluteEnd);
|
|
|
|
var str := connection.InputPin.TagString;
|
|
if Pos('data', str) = 0 then
|
|
Canvas.Stroke.Color := TAstToAuraNodeVisitor.cExecPinColor
|
|
else
|
|
Canvas.Stroke.Color := TAstToAuraNodeVisitor.cDataPinColor;
|
|
|
|
// Draw a Bezier curve with horizontal tangents at start and end points.
|
|
path := TPathData.Create;
|
|
try
|
|
controlOffset := max(25, 0.5 * endPoint.Distance(startPoint));
|
|
|
|
controlPoint1 := TPointF.Create(startPoint.X + controlOffset, startPoint.Y);
|
|
controlPoint2 := TPointF.Create(endPoint.X - controlOffset, endPoint.Y);
|
|
|
|
path.MoveTo(startPoint);
|
|
path.CurveTo(controlPoint1, controlPoint2, endPoint);
|
|
|
|
Canvas.DrawPath(path, 1.0);
|
|
finally
|
|
path.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
end.
|