Michael Schimmel
712 lines
25 KiB
ObjectPascal
712 lines
25 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
|
|
// Record to store a connection between two pins
|
|
TPinConnection = record
|
|
OutputPin: TControl;
|
|
InputPin: TControl;
|
|
constructor Create(AOutputPin, AInputPin: TControl);
|
|
end;
|
|
|
|
// Defines the shape of a pin.
|
|
TPinShape = (psCircle, psTriangle);
|
|
// Defines the horizontal alignment of a pin on a node.
|
|
TPinAlignment = (paLeft, paRight);
|
|
|
|
TAuraWorkspace = class;
|
|
|
|
TAstToAuraNodeVisitor = class(TInterfacedObject, IAstVisitor)
|
|
private
|
|
FWorkspace: TAuraWorkspace;
|
|
FParentControl: TControl;
|
|
FCurrentPos: TPointF;
|
|
FSpacing: TPointF;
|
|
FLastNode: TAuraNode;
|
|
FConnections: TList<TPinConnection>;
|
|
function CreateNodeControl(const ATitle, ADetails: string): TAuraNode;
|
|
function CreatePin(
|
|
AParentNode: TAuraNode;
|
|
AShape: TPinShape;
|
|
AAlignment: TPinAlignment;
|
|
AColor: TAlphaColor;
|
|
const ATag: string;
|
|
AOffsetY: Single = 0
|
|
): TControl;
|
|
function FindPinByTag(AParentNode: TAuraNode; const ATag: string): TControl;
|
|
function ConnectPins(InputPin: TControl; OutputNode: TAuraNode; const Tag: string): TControl;
|
|
public
|
|
constructor Create(
|
|
AWorkspace: TAuraWorkspace;
|
|
AParentControl: TControl;
|
|
const AStartPosition: TPointF;
|
|
AConnections: TList<TPinConnection>
|
|
);
|
|
// 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>
|
|
);
|
|
begin
|
|
inherited Create;
|
|
FWorkspace := AWorkspace;
|
|
FParentControl := AParentControl;
|
|
FCurrentPos := AStartPosition;
|
|
FSpacing := TPointF.Create(20, 10); // Horizontal indent, Vertical spacing
|
|
FConnections := AConnections;
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.ConnectPins(InputPin: TControl; OutputNode: TAuraNode; const Tag: string): TControl;
|
|
begin
|
|
Result := FindPinByTag(OutputNode, Tag);
|
|
if Assigned(Result) then
|
|
FConnections.Add(TPinConnection.Create(Result, InputPin));
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.CreateNodeControl(const ATitle, ADetails: string): TAuraNode;
|
|
const
|
|
// Horizontal padding on each side of the title to ensure text and pins are fully visible.
|
|
cHorizontalPadding = 25;
|
|
var
|
|
LFullTitle: string;
|
|
LTextWidth: Single;
|
|
LNewWidth: Single;
|
|
LMeasureCanvas: TCanvas;
|
|
begin
|
|
Result := TAuraNode.Create(FParentControl);
|
|
Result.Parent := FParentControl;
|
|
|
|
// Build the full title string first
|
|
LFullTitle := ATitle;
|
|
if not ADetails.IsEmpty then
|
|
LFullTitle := LFullTitle + ': ' + ADetails;
|
|
Result.Title := LFullTitle;
|
|
|
|
Result.Position.Point := FCurrentPos;
|
|
|
|
// Adjust the width so that the text and pins are completely visible.
|
|
LMeasureCanvas := TCanvasManager.MeasureCanvas;
|
|
if Assigned(LMeasureCanvas) then
|
|
begin
|
|
LMeasureCanvas.Font.Assign(Result.TitleFont);
|
|
LTextWidth := LMeasureCanvas.TextWidth(Result.Title);
|
|
LNewWidth := LTextWidth + (2 * cHorizontalPadding);
|
|
// Ensure the new width is not smaller than the default width of the node.
|
|
Result.Width := Max(Result.Width, LNewWidth);
|
|
end;
|
|
|
|
// Advance vertical position for the next node
|
|
FCurrentPos.Y := FCurrentPos.Y + Result.Height + FSpacing.Y;
|
|
|
|
FLastNode := Result;
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.CreatePin(
|
|
AParentNode: TAuraNode;
|
|
AShape: TPinShape;
|
|
AAlignment: TPinAlignment;
|
|
AColor: TAlphaColor;
|
|
const ATag: string;
|
|
AOffsetY: Single
|
|
): TControl;
|
|
const
|
|
cPinSize = 10;
|
|
var
|
|
LPosX, LPosY: Single;
|
|
begin
|
|
// Calculate vertical position (centered + offset)
|
|
LPosY := (AParentNode.Height / 2) - (cPinSize / 2) + AOffsetY;
|
|
|
|
// Calculate horizontal position
|
|
if (AAlignment = paLeft) then
|
|
LPosX := 0
|
|
else // paRight
|
|
LPosX := AParentNode.Width - cPinSize;
|
|
|
|
// Create the shape
|
|
case AShape of
|
|
psCircle:
|
|
begin
|
|
var LCircle := TEllipse.Create(AParentNode);
|
|
LCircle.Fill.Color := AColor;
|
|
LCircle.Stroke.Kind := TBrushKind.None;
|
|
Result := LCircle;
|
|
end;
|
|
psTriangle:
|
|
begin
|
|
var LTriangle := TPath.Create(AParentNode);
|
|
LTriangle.Data.Data := Format('M 0 0 L %d %d L 0 %d Z', [cPinSize, cPinSize div 2, cPinSize]);
|
|
LTriangle.Fill.Color := AColor;
|
|
LTriangle.Stroke.Kind := TBrushKind.None;
|
|
Result := LTriangle;
|
|
end;
|
|
else
|
|
Result := nil;
|
|
Exit;
|
|
end;
|
|
|
|
// Common properties
|
|
Result.Parent := AParentNode;
|
|
Result.SetBounds(LPosX, LPosY, cPinSize, cPinSize);
|
|
Result.HitTest := False;
|
|
|
|
// Use TagString to identify the control as a pin and describe its function.
|
|
Result.TagString := ATag;
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.FindPinByTag(AParentNode: TAuraNode; const ATag: string): TControl;
|
|
var
|
|
LControl: TControl;
|
|
begin
|
|
Result := nil;
|
|
if not Assigned(AParentNode) then
|
|
Exit;
|
|
|
|
for LControl in AParentNode.Controls do
|
|
begin
|
|
if (LControl.TagString = ATag) then
|
|
begin
|
|
Result := LControl;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.VisitAssignment(const Node: IAssignmentNode): TAstValue;
|
|
const
|
|
cExecPinColor = TAlphaColors.Lightgreen;
|
|
cDataPinColor = TAlphaColors.Dodgerblue;
|
|
var
|
|
LAssignmentNode, LValueNode: TAuraNode;
|
|
LInputPin: TControl;
|
|
LStartPosition: TPointF;
|
|
begin
|
|
LStartPosition := FCurrentPos;
|
|
|
|
// Visit the value expression first
|
|
Node.Value.Accept(Self);
|
|
LValueNode := FLastNode;
|
|
|
|
// Reposition for the assignment node
|
|
FCurrentPos.X := LValueNode.Position.X + LValueNode.Width + FSpacing.X;
|
|
FCurrentPos.Y := LValueNode.Position.Y;
|
|
|
|
// Create the assignment node and its pins
|
|
LAssignmentNode := CreateNodeControl('Assignment', Node.Identifier.Name);
|
|
CreatePin(LAssignmentNode, psTriangle, paLeft, cExecPinColor, 'Pin.Exec.In', -8);
|
|
CreatePin(LAssignmentNode, psTriangle, paRight, cExecPinColor, 'Pin.Exec.Out');
|
|
LInputPin := CreatePin(LAssignmentNode, psCircle, paLeft, cDataPinColor, 'Pin.Data.In', 8);
|
|
|
|
// Connect the value to the assignment
|
|
ConnectPins(LInputPin, LValueNode, 'Pin.Data.Out');
|
|
|
|
// Finalize visitor state
|
|
FCurrentPos.X := LStartPosition.X;
|
|
FCurrentPos.Y := Max(LValueNode.Position.Y + LValueNode.Height, LAssignmentNode.Position.Y + LAssignmentNode.Height) + FSpacing.Y;
|
|
FLastNode := LAssignmentNode;
|
|
|
|
Result := TAstValue.Void;
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue;
|
|
const
|
|
cDataPinColor = TAlphaColors.Dodgerblue;
|
|
cDefaultHeight = 45;
|
|
var
|
|
LBinaryExprNode, LLeftNode, LRightNode: TAuraNode;
|
|
LInputPin1, LInputPin2: TControl;
|
|
LStartPosition: TPointF;
|
|
LRightEndY, LMaxChildWidth: Single;
|
|
begin
|
|
LStartPosition := FCurrentPos;
|
|
|
|
// First, visit the child nodes to create their visual representation
|
|
// Left branch
|
|
Node.Left.Accept(Self);
|
|
LLeftNode := FLastNode;
|
|
|
|
// Right branch starts below the left branch
|
|
Node.Right.Accept(Self);
|
|
LRightNode := FLastNode;
|
|
LRightEndY := FCurrentPos.Y;
|
|
|
|
// Now, create the node for the binary operation itself
|
|
LMaxChildWidth := Max(LLeftNode.Position.X + LLeftNode.Width, LRightNode.Position.X + LRightNode.Width);
|
|
FCurrentPos.X := LMaxChildWidth + FSpacing.X;
|
|
|
|
// Vertically center the binary expression node between its children
|
|
var LTotalChildHeight := LRightEndY - LStartPosition.Y;
|
|
var LNodeCenterY := LStartPosition.Y + (LTotalChildHeight / 2);
|
|
FCurrentPos.Y := LNodeCenterY - (cDefaultHeight / 2);
|
|
|
|
LBinaryExprNode := CreateNodeControl(Node.Operator.ToString, '');
|
|
|
|
// Create pins for the binary expression node
|
|
LInputPin1 := CreatePin(LBinaryExprNode, psCircle, paLeft, cDataPinColor, 'Pin.Data.In.1', -8);
|
|
LInputPin2 := CreatePin(LBinaryExprNode, psCircle, paLeft, cDataPinColor, 'Pin.Data.In.2', 8);
|
|
CreatePin(LBinaryExprNode, psCircle, paRight, cDataPinColor, 'Pin.Data.Out', 0);
|
|
|
|
// Connect the output of the left child to the first input of the binary node
|
|
ConnectPins(LInputPin1, LLeftNode, 'Pin.Data.Out');
|
|
|
|
// Connect the output of the right child to the second input of the binary node
|
|
ConnectPins(LInputPin2, LRightNode, 'Pin.Data.Out');
|
|
|
|
// Finalize visitor state for the next node at this level
|
|
FCurrentPos.X := LStartPosition.X;
|
|
FCurrentPos.Y := Max(LRightEndY, LBinaryExprNode.Position.Y + LBinaryExprNode.Height + FSpacing.Y);
|
|
FLastNode := LBinaryExprNode;
|
|
|
|
Result := TAstValue.Void;
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue;
|
|
var
|
|
Expression: IExpressionNode;
|
|
LBlockNode: TAuraNode;
|
|
LChildVisitor: IAstVisitor;
|
|
LChildStartPos: TPointF;
|
|
LMaxRight: Single;
|
|
LMaxBottom: Single;
|
|
LControl: TControl;
|
|
begin
|
|
// A block node visually encloses all its child nodes.
|
|
// Create the container node for the block. Its size will be adjusted later.
|
|
LBlockNode := TAuraNode.Create(FParentControl);
|
|
LBlockNode.Parent := FParentControl;
|
|
LBlockNode.Title := 'Block';
|
|
LBlockNode.Position.Point := FCurrentPos;
|
|
|
|
// Create a new visitor for the child nodes. The children will be parented
|
|
// to LBlockNode and positioned relative to it, starting below the title.
|
|
LChildStartPos := TPointF.Create(FSpacing.X, FSpacing.Y + LBlockNode.TitleFont.Size * 1.8);
|
|
LChildVisitor := TAstToAuraNodeVisitor.Create(FWorkspace, LBlockNode, LChildStartPos, FConnections);
|
|
|
|
// Visit all expressions within the block using the new visitor.
|
|
for Expression in Node.Expressions do
|
|
begin
|
|
Expression.Accept(LChildVisitor);
|
|
end;
|
|
|
|
// Adjust the size of the block node to encompass all its children.
|
|
LMaxRight := 0;
|
|
LMaxBottom := 0;
|
|
for LControl in LBlockNode.Controls do
|
|
begin
|
|
if (LControl is TAuraNode) then
|
|
begin
|
|
LMaxRight := Max(LMaxRight, LControl.Position.X + LControl.Width);
|
|
LMaxBottom := Max(LMaxBottom, LControl.Position.Y + LControl.Height);
|
|
end;
|
|
end;
|
|
|
|
// Set the final size with some internal padding.
|
|
LBlockNode.Width := Max(LBlockNode.Width, LMaxRight + FSpacing.X);
|
|
LBlockNode.Height := Max(LBlockNode.Height, LMaxBottom + FSpacing.Y);
|
|
|
|
// Update the current Y position of the main visitor to be below the now correctly sized block node.
|
|
FCurrentPos.Y := LBlockNode.Position.Y + LBlockNode.Height + FSpacing.Y;
|
|
FLastNode := LBlockNode;
|
|
|
|
Result := TAstValue.Void;
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.VisitConstant(const Node: IConstantNode): TAstValue;
|
|
const
|
|
cDataPinColor = TAlphaColors.Dodgerblue;
|
|
var
|
|
LConstantNode: TAuraNode;
|
|
begin
|
|
// A constant has a data output pin.
|
|
// Data outputs are round and on the right side of the box.
|
|
LConstantNode := CreateNodeControl('Constant', Node.Value.ToString);
|
|
CreatePin(LConstantNode, psCircle, paRight, cDataPinColor, 'Pin.Data.Out', 0);
|
|
Result := TAstValue.Void;
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TAstValue;
|
|
var
|
|
Arg: IExpressionNode;
|
|
begin
|
|
CreateNodeControl('FunctionCall', '');
|
|
FCurrentPos.X := FCurrentPos.X + FSpacing.X;
|
|
try
|
|
// Callee
|
|
CreateNodeControl('Callee', '');
|
|
FCurrentPos.X := FCurrentPos.X + FSpacing.X;
|
|
try
|
|
Node.Callee.Accept(Self);
|
|
finally
|
|
FCurrentPos.X := FCurrentPos.X - FSpacing.X;
|
|
end;
|
|
|
|
// Arguments
|
|
if Node.Arguments.Count > 0 then
|
|
begin
|
|
CreateNodeControl('Arguments', '');
|
|
FCurrentPos.X := FCurrentPos.X + FSpacing.X;
|
|
try
|
|
for Arg in Node.Arguments do
|
|
Arg.Accept(Self);
|
|
finally
|
|
FCurrentPos.X := FCurrentPos.X - FSpacing.X;
|
|
end;
|
|
end;
|
|
finally
|
|
FCurrentPos.X := FCurrentPos.X - FSpacing.X;
|
|
end;
|
|
Result := TAstValue.Void;
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.VisitIdentifier(const Node: IIdentifierNode): TAstValue;
|
|
const
|
|
cDataPinColor = TAlphaColors.Dodgerblue;
|
|
begin
|
|
CreateNodeControl('Identifier', Node.Name);
|
|
// Add a data output pin on the right side.
|
|
CreatePin(FLastNode, psCircle, paRight, cDataPinColor, 'Pin.Data.Out');
|
|
Result := TAstValue.Void;
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.VisitIfExpression(const Node: IIfExpressionNode): TAstValue;
|
|
const
|
|
cExecPinColor = TAlphaColors.Lightgreen;
|
|
cDataPinColor = TAlphaColors.Dodgerblue;
|
|
cDefaultHeight = 60; // Taller to accommodate more pins
|
|
var
|
|
LIfNode, LConditionNode, LThenNode, LElseNode: TAuraNode;
|
|
LConditionInputPin, LThenOutputPin, LElseOutputPin: TControl;
|
|
LStartPosition: TPointF;
|
|
LConditionEndY, LThenEndY, LElseEndY, LMaxChildWidth: Single;
|
|
begin
|
|
LStartPosition := FCurrentPos;
|
|
|
|
// Place the input node for the condition to the left of the 'If' node.
|
|
Node.Condition.Accept(Self);
|
|
LConditionNode := FLastNode;
|
|
LConditionEndY := FCurrentPos.Y;
|
|
|
|
// Position and create the 'If' node to the right of the condition's subtree.
|
|
LMaxChildWidth := LConditionNode.Position.X + LConditionNode.Width;
|
|
FCurrentPos.X := LMaxChildWidth + FSpacing.X;
|
|
FCurrentPos.Y := LStartPosition.Y + (LConditionNode.Position.Y + LConditionNode.Height / 2) - LStartPosition.Y - (cDefaultHeight / 2);
|
|
|
|
LIfNode := CreateNodeControl('If', '');
|
|
LIfNode.Height := cDefaultHeight;
|
|
CreatePin(LIfNode, psTriangle, paLeft, cExecPinColor, 'Pin.Exec.In', -12);
|
|
LConditionInputPin := CreatePin(LIfNode, psCircle, paLeft, cDataPinColor, 'Pin.Data.In.Condition', 12);
|
|
LThenOutputPin := CreatePin(LIfNode, psTriangle, paRight, cExecPinColor, 'Pin.Exec.Out.Then', -12);
|
|
if Assigned(Node.ElseBranch) then
|
|
LElseOutputPin := CreatePin(LIfNode, psTriangle, paRight, cExecPinColor, 'Pin.Exec.Out.Else', 12)
|
|
else
|
|
LElseOutputPin := nil;
|
|
|
|
// Connect the condition's output to the 'If' node's data input.
|
|
ConnectPins(LConditionInputPin, LConditionNode, 'Pin.Data.Out');
|
|
|
|
// Visit the 'Then' and 'Else' execution branches, placing them to the right of the 'If' node.
|
|
var LBranchStartX := LIfNode.Position.X + LIfNode.Width + FSpacing.X;
|
|
|
|
// Then branch
|
|
FCurrentPos.X := LBranchStartX;
|
|
FCurrentPos.Y := LStartPosition.Y;
|
|
Node.ThenBranch.Accept(Self);
|
|
LThenNode := FLastNode;
|
|
LThenEndY := FCurrentPos.Y;
|
|
// ConnectPins(FindPinByTag(LThenNode, 'Pin.Exec.In'), LIfNode, 'Pin.Exec.Out.Then');
|
|
|
|
// Else branch (if it exists)
|
|
LElseEndY := LThenEndY;
|
|
if Assigned(Node.ElseBranch) then
|
|
begin
|
|
FCurrentPos.X := LBranchStartX;
|
|
FCurrentPos.Y := LThenEndY;
|
|
Node.ElseBranch.Accept(Self);
|
|
LElseNode := FLastNode;
|
|
LElseEndY := FCurrentPos.Y;
|
|
// ConnectPins(FindPinByTag(LElseNode, 'Pin.Exec.In'), LIfNode, 'Pin.Exec.Out.Else');
|
|
end;
|
|
|
|
// Finalize visitor state.
|
|
FCurrentPos.X := LStartPosition.X;
|
|
FCurrentPos.Y := Max(LConditionEndY, LElseEndY);
|
|
FLastNode := LIfNode;
|
|
|
|
Result := TAstValue.Void;
|
|
end;
|
|
|
|
function TAstToAuraNodeVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue;
|
|
const
|
|
cExecPinColor = TAlphaColors.Lightgreen;
|
|
cDataPinColor = TAlphaColors.Dodgerblue;
|
|
var
|
|
ParamStr: String;
|
|
LLambdaNode: TAuraNode;
|
|
LChildVisitor: IAstVisitor;
|
|
LChildStartPos: TPointF;
|
|
LMaxRight, LMaxBottom: Single;
|
|
LControl: TControl;
|
|
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 + ')';
|
|
|
|
// Create the container node for the lambda. Its size will be adjusted later.
|
|
LLambdaNode := CreateNodeControl('Lambda', ParamStr);
|
|
|
|
// Create a new visitor for the child nodes (the lambda body).
|
|
// The children will be parented to LLambdaNode and positioned relative to it.
|
|
LChildStartPos := TPointF.Create(FSpacing.X, FSpacing.Y + LLambdaNode.TitleFont.Size * 1.8);
|
|
LChildVisitor := TAstToAuraNodeVisitor.Create(FWorkspace, LLambdaNode, LChildStartPos, FConnections);
|
|
|
|
// Visit the body expression using the new visitor.
|
|
Node.Body.Accept(LChildVisitor);
|
|
|
|
// Adjust the size of the lambda node to encompass its body.
|
|
LMaxRight := 0;
|
|
LMaxBottom := 0;
|
|
for LControl in LLambdaNode.Controls do
|
|
begin
|
|
if (LControl is TAuraNode) then
|
|
begin
|
|
LMaxRight := Max(LMaxRight, LControl.Position.X + LControl.Width);
|
|
LMaxBottom := Max(LMaxBottom, LControl.Position.Y + LControl.Height);
|
|
end;
|
|
end;
|
|
|
|
// Set the final size with some internal padding.
|
|
LLambdaNode.Width := Max(LLambdaNode.Width, LMaxRight + FSpacing.X);
|
|
LLambdaNode.Height := Max(LLambdaNode.Height, LMaxBottom + FSpacing.Y);
|
|
|
|
// Add a data output pin for the resulting closure.
|
|
CreatePin(LLambdaNode, psCircle, paRight, cDataPinColor, 'Pin.Data.Out');
|
|
|
|
// Update the current Y position of the main visitor to be below the now correctly sized lambda node.
|
|
FCurrentPos.Y := LLambdaNode.Position.Y + LLambdaNode.Height + FSpacing.Y;
|
|
|
|
Result := TAstValue.Void;
|
|
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;
|
|
const
|
|
cExecPinColor = TAlphaColors.Lightgreen;
|
|
cDataPinColor = TAlphaColors.Dodgerblue;
|
|
cInitializerTreeWidth = 150;
|
|
var
|
|
LVarDeclNode, LInitializerNode: TAuraNode;
|
|
LStartPosition: TPointF;
|
|
LInitializerEndY, LVarDeclNodeEndY: Single;
|
|
LInputPin: TControl;
|
|
begin
|
|
LStartPosition := FCurrentPos;
|
|
LInitializerEndY := LStartPosition.Y;
|
|
LInitializerNode := nil;
|
|
|
|
if Assigned(Node.Initializer) then
|
|
begin
|
|
Node.Initializer.Accept(Self);
|
|
|
|
LInitializerNode := FLastNode;
|
|
LInitializerEndY := FCurrentPos.Y;
|
|
FCurrentPos.X := LStartPosition.X + cInitializerTreeWidth + FSpacing.X;
|
|
FCurrentPos.Y := LStartPosition.Y;
|
|
end;
|
|
|
|
LVarDeclNode := CreateNodeControl('VarDecl', Node.Identifier.Name);
|
|
LVarDeclNodeEndY := FCurrentPos.Y;
|
|
|
|
CreatePin(LVarDeclNode, psTriangle, paLeft, cExecPinColor, 'Pin.Exec.In', -8);
|
|
CreatePin(LVarDeclNode, psTriangle, paRight, cExecPinColor, 'Pin.Exec.Out', -8);
|
|
|
|
if Assigned(Node.Initializer) then
|
|
begin
|
|
LInputPin := CreatePin(LVarDeclNode, psCircle, paLeft, cDataPinColor, 'Pin.Data.In', 8);
|
|
ConnectPins(LInputPin, LInitializerNode, 'Pin.Data.Out');
|
|
|
|
FCurrentPos.Y := Max(LInitializerEndY, LVarDeclNodeEndY);
|
|
FCurrentPos.X := LStartPosition.X;
|
|
end;
|
|
FLastNode := LVarDeclNode;
|
|
|
|
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));
|
|
FConnections := FConnections + Connections.ToArray;
|
|
finally
|
|
Connections.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TAuraWorkspace.DoDeleteChildren;
|
|
begin
|
|
FConnections := nil;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TAuraWorkspace.Paint;
|
|
var
|
|
LConnection: TPinConnection;
|
|
LStartPoint, LEndPoint, LPinCenter: TPointF;
|
|
LPath: TPathData;
|
|
LControlPoint1, LControlPoint2: TPointF;
|
|
LDeltaX, LControlOffset: Single;
|
|
begin
|
|
inherited;
|
|
|
|
Canvas.Stroke.Kind := TBrushKind.Solid;
|
|
Canvas.Stroke.Color := TAlphaColors.Dodgerblue;
|
|
Canvas.Stroke.Thickness := 2;
|
|
|
|
// Gehe durch alle gespeicherten Verbindungen und zeichne sie
|
|
for LConnection in FConnections do
|
|
begin
|
|
// Hole die absoluten Koordinaten der Pin-Mittelpunkte
|
|
LPinCenter := TPointF.Create(LConnection.OutputPin.Width / 2, LConnection.OutputPin.Height / 2);
|
|
var LAbsoluteStart := LConnection.OutputPin.LocalToAbsolute(LPinCenter);
|
|
|
|
LPinCenter := TPointF.Create(LConnection.InputPin.Width / 2, LConnection.InputPin.Height / 2);
|
|
var LAbsoluteEnd := LConnection.InputPin.LocalToAbsolute(LPinCenter);
|
|
|
|
// Rechne sie in die lokalen Koordinaten der PaintBox um
|
|
LStartPoint := AbsoluteToLocal(LAbsoluteStart);
|
|
LEndPoint := AbsoluteToLocal(LAbsoluteEnd);
|
|
|
|
// Draw a Bezier curve with horizontal tangents at start and end points.
|
|
LPath := TPathData.Create;
|
|
try
|
|
LDeltaX := LEndPoint.X - LStartPoint.X;
|
|
LControlOffset := Max(50, Abs(LDeltaX) / 2);
|
|
|
|
LControlPoint1 := TPointF.Create(LStartPoint.X + LControlOffset, LStartPoint.Y);
|
|
LControlPoint2 := TPointF.Create(LEndPoint.X - LControlOffset, LEndPoint.Y);
|
|
|
|
LPath.MoveTo(LStartPoint);
|
|
LPath.CurveTo(LControlPoint1, LControlPoint2, LEndPoint);
|
|
|
|
Canvas.DrawPath(LPath, 1.0);
|
|
finally
|
|
LPath.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
end.
|