Ast Playground 1. visualization
This commit is contained in:
Michael Schimmel
@@ -7,7 +7,9 @@ uses
|
||||
Myc.Ast.Evaluator in '..\Src\AST\Myc.Ast.Evaluator.pas',
|
||||
Myc.Ast.Printer in '..\Src\AST\Myc.Ast.Printer.pas',
|
||||
Myc.Ast.Nodes in '..\Src\AST\Myc.Ast.Nodes.pas',
|
||||
Myc.Ast.Scope in '..\Src\AST\Myc.Ast.Scope.pas';
|
||||
Myc.Ast.Scope in '..\Src\AST\Myc.Ast.Scope.pas',
|
||||
DraggablePanel in 'DraggablePanel.pas',
|
||||
Myc.Ast.Visualizer in 'Myc.Ast.Visualizer.pas';
|
||||
|
||||
{$R *.res}
|
||||
|
||||
|
||||
@@ -139,6 +139,8 @@
|
||||
<DCCReference Include="..\Src\AST\Myc.Ast.Printer.pas"/>
|
||||
<DCCReference Include="..\Src\AST\Myc.Ast.Nodes.pas"/>
|
||||
<DCCReference Include="..\Src\AST\Myc.Ast.Scope.pas"/>
|
||||
<DCCReference Include="DraggablePanel.pas"/>
|
||||
<DCCReference Include="Myc.Ast.Visualizer.pas"/>
|
||||
<BuildConfiguration Include="Base">
|
||||
<Key>Base</Key>
|
||||
</BuildConfiguration>
|
||||
|
||||
@@ -0,0 +1,264 @@
|
||||
unit DraggablePanel;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.Classes,
|
||||
System.UITypes,
|
||||
System.Types,
|
||||
FMX.Types,
|
||||
FMX.Controls,
|
||||
FMX.StdCtrls,
|
||||
FMX.Graphics,
|
||||
FMX.Objects;
|
||||
|
||||
type
|
||||
/// <summary>
|
||||
/// A panel that can contain other controls and can be moved by dragging its background.
|
||||
/// It custom-paints its own border and title.
|
||||
/// </summary>
|
||||
TAuraNode = class(TStyledControl)
|
||||
private
|
||||
// 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;
|
||||
// Properties for the title
|
||||
FTitle: string;
|
||||
FTitleFont: TFont;
|
||||
FTitleFontColor: TAlphaColor;
|
||||
|
||||
procedure SetBorderColor(const Value: TAlphaColor);
|
||||
procedure SetBorderWidth(const Value: Single);
|
||||
procedure SetBorderRadius(const Value: Single);
|
||||
procedure SetTitle(const Value: string);
|
||||
procedure SetTitleFont(const Value: TFont);
|
||||
procedure SetTitleFontColor(const Value: TAlphaColor);
|
||||
procedure TitleFontChanged(Sender: TObject);
|
||||
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;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
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;
|
||||
|
||||
// Title properties
|
||||
property Title: string read FTitle write SetTitle;
|
||||
property TitleFont: TFont read FTitleFont write SetTitleFont;
|
||||
property TitleFontColor: TAlphaColor read FTitleFontColor write SetTitleFontColor;
|
||||
|
||||
// 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
|
||||
|
||||
{ TAuraNode }
|
||||
|
||||
constructor TAuraNode.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FIsDragging := False;
|
||||
|
||||
// Default border settings
|
||||
FBorderColor := TAlphaColors.Gray;
|
||||
FBorderWidth := 1;
|
||||
FBorderRadius := 0; // Sharp corners by default
|
||||
|
||||
// Default title settings
|
||||
FTitle := 'Node';
|
||||
FTitleFont := TFont.Create;
|
||||
FTitleFont.Family := 'Segoe UI';
|
||||
FTitleFont.Size := 11;
|
||||
FTitleFont.Style := [TFontStyle.fsBold];
|
||||
FTitleFont.OnChanged := TitleFontChanged;
|
||||
FTitleFontColor := TAlphaColors.Black;
|
||||
|
||||
Width := 80;
|
||||
Height := 45;
|
||||
|
||||
// The panel must be able to receive mouse events.
|
||||
HitTest := True;
|
||||
// Clip children to the panel's bounds.
|
||||
ClipChildren := True;
|
||||
end;
|
||||
|
||||
destructor TAuraNode.Destroy;
|
||||
begin
|
||||
FTitleFont.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TAuraNode.SetBorderColor(const Value: TAlphaColor);
|
||||
begin
|
||||
if FBorderColor <> Value then
|
||||
begin
|
||||
FBorderColor := Value;
|
||||
Repaint;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAuraNode.SetBorderWidth(const Value: Single);
|
||||
begin
|
||||
if FBorderWidth <> Value then
|
||||
begin
|
||||
FBorderWidth := Value;
|
||||
Repaint;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAuraNode.SetBorderRadius(const Value: Single);
|
||||
begin
|
||||
if FBorderRadius <> Value then
|
||||
begin
|
||||
FBorderRadius := Value;
|
||||
Repaint;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAuraNode.SetTitle(const Value: string);
|
||||
begin
|
||||
if FTitle <> Value then
|
||||
begin
|
||||
FTitle := Value;
|
||||
Repaint;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAuraNode.SetTitleFont(const Value: TFont);
|
||||
begin
|
||||
FTitleFont.Assign(Value);
|
||||
end;
|
||||
|
||||
procedure TAuraNode.SetTitleFontColor(const Value: TAlphaColor);
|
||||
begin
|
||||
if FTitleFontColor <> Value then
|
||||
begin
|
||||
FTitleFontColor := Value;
|
||||
Repaint;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAuraNode.TitleFontChanged(Sender: TObject);
|
||||
begin
|
||||
Repaint;
|
||||
end;
|
||||
|
||||
procedure TAuraNode.Paint;
|
||||
var
|
||||
LRect, LTitleRect: TRectF;
|
||||
begin
|
||||
inherited; // Allow styled painting to occur first (if any)
|
||||
|
||||
// Custom painting for the border
|
||||
if (FBorderWidth > 0) and (FBorderColor <> TAlphaColors.Null) then
|
||||
begin
|
||||
LRect := TRectF.Create(0, 0, Width, Height);
|
||||
// Inflate inwards so the border is fully visible within the control's bounds
|
||||
LRect.Inflate(-FBorderWidth / 2, -FBorderWidth / 2);
|
||||
|
||||
Canvas.Stroke.Kind := TBrushKind.Solid;
|
||||
Canvas.Stroke.Color := FBorderColor;
|
||||
Canvas.Stroke.Thickness := FBorderWidth;
|
||||
|
||||
// Use DrawRoundRect to support both sharp and rounded corners
|
||||
Canvas.DrawRect(LRect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round);
|
||||
end;
|
||||
|
||||
// Draw the title
|
||||
if not FTitle.IsEmpty then
|
||||
begin
|
||||
// Define the rectangle for the title at the top of the control
|
||||
LTitleRect := TRectF.Create(0, FBorderWidth, Width, FBorderWidth + FTitleFont.Size * 1.8);
|
||||
|
||||
Canvas.Font.Assign(FTitleFont);
|
||||
Canvas.Fill.Color := FTitleFontColor;
|
||||
|
||||
// Draw the text centered horizontally and vertically within the title rectangle
|
||||
Canvas.FillText(LTitleRect, FTitle, False, 1.0, [], TTextAlign.Center, TTextAlign.Center);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAuraNode.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||
begin
|
||||
inherited;
|
||||
if (Button = TMouseButton.mbLeft) then
|
||||
begin
|
||||
if (ObjectAtPoint(LocalToScreen(TPointF.Create(X, Y))) = Self as IControl) then
|
||||
begin
|
||||
FIsDragging := True;
|
||||
FDownPos := TPointF.Create(X, Y);
|
||||
end;
|
||||
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;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAuraNode.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||
begin
|
||||
inherited;
|
||||
if (Button = TMouseButton.mbLeft) and (FIsDragging) then
|
||||
begin
|
||||
FIsDragging := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
+30
-10
@@ -2,7 +2,7 @@ object Form1: TForm1
|
||||
Left = 0
|
||||
Top = 0
|
||||
Caption = 'Form1'
|
||||
ClientHeight = 638
|
||||
ClientHeight = 883
|
||||
ClientWidth = 925
|
||||
FormFactor.Width = 320
|
||||
FormFactor.Height = 480
|
||||
@@ -10,9 +10,9 @@ object Form1: TForm1
|
||||
OnCreate = FormCreate
|
||||
DesignerMasterStyle = 0
|
||||
object Panel1: TPanel
|
||||
Align = Left
|
||||
Size.Width = 137.000000000000000000
|
||||
Size.Height = 638.000000000000000000
|
||||
Align = MostLeft
|
||||
Size.Width = 129.000000000000000000
|
||||
Size.Height = 883.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 1
|
||||
object Test1Button: TButton
|
||||
@@ -89,24 +89,44 @@ object Form1: TForm1
|
||||
OnClick = DoTriggerButtonClick
|
||||
object DoTrigger2Button: TButton
|
||||
Position.Y = 30.000000000000000000
|
||||
TabOrder = 8
|
||||
TabOrder = 5
|
||||
Text = 'Trigger2'
|
||||
TextSettings.Trimming = None
|
||||
OnClick = DoTrigger2ButtonClick
|
||||
end
|
||||
end
|
||||
object ClearButton: TButton
|
||||
Position.X = 24.000000000000000000
|
||||
Position.Y = 432.000000000000000000
|
||||
Size.Width = 80.000000000000000000
|
||||
Size.Height = 22.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 11
|
||||
Text = 'Clear'
|
||||
TextSettings.Trimming = None
|
||||
OnClick = ClearButtonClick
|
||||
end
|
||||
end
|
||||
object Panel2: TPanel
|
||||
Align = Client
|
||||
Size.Width = 796.000000000000000000
|
||||
Size.Height = 616.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 3
|
||||
end
|
||||
object Memo1: TMemo
|
||||
Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
|
||||
DataDetectorTypes = []
|
||||
StyledSettings = [Size, Style, FontColor]
|
||||
TextSettings.Font.Family = 'Consolas'
|
||||
Align = Client
|
||||
Size.Width = 788.000000000000000000
|
||||
Size.Height = 638.000000000000000000
|
||||
Align = Bottom
|
||||
Position.X = 129.000000000000000000
|
||||
Position.Y = 616.000000000000000000
|
||||
Size.Width = 796.000000000000000000
|
||||
Size.Height = 267.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 2
|
||||
Viewport.Width = 784.000000000000000000
|
||||
Viewport.Height = 634.000000000000000000
|
||||
Viewport.Width = 792.000000000000000000
|
||||
Viewport.Height = 263.000000000000000000
|
||||
end
|
||||
end
|
||||
|
||||
+53
-16
@@ -8,6 +8,7 @@ uses
|
||||
System.UITypes,
|
||||
System.Classes,
|
||||
System.Variants,
|
||||
System.Generics.Collections,
|
||||
FMX.Types,
|
||||
FMX.Controls,
|
||||
FMX.Forms,
|
||||
@@ -18,11 +19,15 @@ uses
|
||||
FMX.ScrollBox,
|
||||
FMX.Memo,
|
||||
FMX.Controls.Presentation,
|
||||
DraggablePanel,
|
||||
Myc.Ast.Visualizer,
|
||||
Myc.Data.POD,
|
||||
Myc.Ast.Nodes,
|
||||
Myc.Ast,
|
||||
Myc.Ast.Evaluator,
|
||||
Myc.Ast.Printer; // Added for TExecutionScope
|
||||
Myc.Ast.Printer,
|
||||
FMX.Layouts,
|
||||
FMX.Objects; // Added for TExecutionScope
|
||||
|
||||
type
|
||||
TForm1 = class(TForm)
|
||||
@@ -38,6 +43,9 @@ type
|
||||
CrerateTriggerExampleButton: TButton;
|
||||
DoTriggerButton: TButton;
|
||||
DoTrigger2Button: TButton;
|
||||
Panel2: TPanel;
|
||||
ClearButton: TButton;
|
||||
procedure ClearButtonClick(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure CrerateTriggerExampleButtonClick(Sender: TObject);
|
||||
procedure DebugButtonClick(Sender: TObject);
|
||||
@@ -52,6 +60,8 @@ type
|
||||
// Stores the last AST generated by Test1 or Test2 button clicks.
|
||||
FLastAst: IAstNode;
|
||||
FGScope: IExecutionScope;
|
||||
FWorkspace: TAuraWorkspace;
|
||||
procedure WorkspaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||
public
|
||||
{ Public declarations }
|
||||
end;
|
||||
@@ -67,8 +77,20 @@ uses
|
||||
|
||||
{$R *.fmx}
|
||||
|
||||
procedure TForm1.ClearButtonClick(Sender: TObject);
|
||||
begin
|
||||
FWorkspace.DeleteChildren;
|
||||
FWorkspace.Repaint;
|
||||
end;
|
||||
|
||||
procedure TForm1.FormCreate(Sender: TObject);
|
||||
begin
|
||||
FWorkspace := TAuraWorkspace.Create(Panel2);
|
||||
FWorkspace.Parent := Panel2;
|
||||
FWorkspace.Align := TAlignLayout.Client;
|
||||
|
||||
FWorkspace.OnMouseDown := WorkspaceMouseDown;
|
||||
|
||||
FGScope := T_ExecutionScope.Create(nil);
|
||||
end;
|
||||
|
||||
@@ -371,7 +393,6 @@ end;
|
||||
|
||||
procedure TForm1.CrerateTriggerExampleButtonClick(Sender: TObject);
|
||||
var
|
||||
lambdaAst: ILambdaExpressionNode;
|
||||
visitor: IAstVisitor;
|
||||
closureValue: TAstValue;
|
||||
begin
|
||||
@@ -384,26 +405,33 @@ begin
|
||||
Memo1.Lines.Clear;
|
||||
Memo1.Lines.Add('--- Creating Trigger Blueprint ---');
|
||||
|
||||
// 1. Initialize the variable 'X' to 0 directly in the scope.
|
||||
FGScope.SetValue('X', TAstValue.FromScalar(TScalar.FromInt64(0)));
|
||||
|
||||
// 2. Create a lambda that takes the summand as an argument.
|
||||
// AST for: (summand) => { X = X + summand; }
|
||||
// Using the new Assignment node to modify 'X' in its parent scope.
|
||||
lambdaAst :=
|
||||
TAst.LambdaExpr(
|
||||
[TAst.Identifier('summand')],
|
||||
TAst.Assign(TAst.Identifier('X'), TAst.BinaryExpr(TAst.Identifier('X'), boAdd, TAst.Identifier('summand')))
|
||||
var blk :=
|
||||
TAst.Block(
|
||||
[
|
||||
TAst.VarDecl(TAst.Identifier('X'), TAst.Constant(TScalar.FromInt64(0))),
|
||||
TAst.VarDecl(
|
||||
TAst.Identifier('tickHandler'),
|
||||
TAst.LambdaExpr(
|
||||
[TAst.Identifier('summand')],
|
||||
TAst.Assign(TAst.Identifier('X'), TAst.BinaryExpr(TAst.Identifier('X'), boAdd, TAst.Identifier('summand')))
|
||||
)
|
||||
)
|
||||
]
|
||||
);
|
||||
|
||||
// 3. Evaluate the lambda to create a closure and store it in the scope.
|
||||
// lambdaAst :=
|
||||
// TAst.LambdaExpr(
|
||||
// [TAst.Identifier('summand')],
|
||||
// TAst.Assign(TAst.Identifier('X'), TAst.BinaryExpr(TAst.Identifier('X'), boAdd, TAst.Identifier('summand')))
|
||||
// );
|
||||
|
||||
// Evaluate the lambda to create a closure and store it in the scope.
|
||||
// The closure captures the scope where 'X' is defined.
|
||||
visitor := TEvaluatorVisitor.Create(FGScope);
|
||||
closureValue := lambdaAst.Accept(visitor);
|
||||
FGScope.SetValue('tickHandler', closureValue);
|
||||
blk.Accept(visitor);
|
||||
|
||||
// FLastAst is not used for this parameterized example.
|
||||
FLastAst := lambdaAst;
|
||||
FLastAst := blk;
|
||||
|
||||
Memo1.Lines.Add('Variable "X" initialized to 0 in persistent scope.');
|
||||
Memo1.Lines.Add('Blueprint function "tickHandler(summand)" created.');
|
||||
@@ -470,4 +498,13 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.WorkspaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||
begin
|
||||
if Button <> TMouseButton.mbMiddle then
|
||||
exit;
|
||||
|
||||
if FLastAst <> nil then
|
||||
FWorkspace.BuildTree(FLastAst, TPointF.Create(X, Y));
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@@ -0,0 +1,711 @@
|
||||
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.
|
||||
Reference in New Issue
Block a user