diff --git a/ASTPlayground/ASTPlayground.dpr b/ASTPlayground/ASTPlayground.dpr
index 311c3c9..6309384 100644
--- a/ASTPlayground/ASTPlayground.dpr
+++ b/ASTPlayground/ASTPlayground.dpr
@@ -8,7 +8,6 @@ uses
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',
- DraggablePanel in 'DraggablePanel.pas',
Myc.Ast.Visualizer in 'Myc.Ast.Visualizer.pas';
{$R *.res}
diff --git a/ASTPlayground/ASTPlayground.dproj b/ASTPlayground/ASTPlayground.dproj
index 001d1a5..88c6b6b 100644
--- a/ASTPlayground/ASTPlayground.dproj
+++ b/ASTPlayground/ASTPlayground.dproj
@@ -139,7 +139,6 @@
-
Base
diff --git a/ASTPlayground/DraggablePanel.pas b/ASTPlayground/DraggablePanel.pas
deleted file mode 100644
index 30a81d7..0000000
--- a/ASTPlayground/DraggablePanel.pas
+++ /dev/null
@@ -1,300 +0,0 @@
-unit DraggablePanel;
-
-interface
-
-uses
- System.SysUtils,
- System.Classes,
- System.UITypes,
- System.Types,
- FMX.Types,
- FMX.Controls,
- FMX.StdCtrls,
- FMX.Graphics,
- FMX.Objects;
-
-type
- // A movable panel with a custom-painted border and title.
- 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;
- // If true, the node is drawn without a border and with a transparent background.
- FFrameless: Boolean;
-
- 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);
- procedure SetFrameless(const Value: Boolean);
- protected
- procedure Paint; override;
- procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
- procedure MouseMove(Shift: TShiftState; X, Y: Single); override;
- procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
- 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;
-
- // Behavior properties
- property Frameless: Boolean read FFrameless write SetFrameless;
-
- // Standard control properties
- property Align;
- property Anchors;
- property ClipChildren default True;
- property Cursor default crDefault;
- property DragMode default TDragMode.dmManual;
- property Enabled;
- property Height;
- property 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 := 9; // 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;
-
- // Default state for frameless mode
- FFrameless := False;
-
- 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.Paint;
-var
- rect, titleRect: TRectF;
- effectiveBorderWidth: Single;
-begin
- inherited; // Allow styled painting to occur first (if any)
-
- if FFrameless then
- begin
- Canvas.Fill.Kind := TBrushKind.Solid;
- Canvas.Fill.Color := $20C0C0C0; // Transparent Silver
- Canvas.Stroke.Kind := TBrushKind.None;
-
- // In frameless mode, draw a transparent background and ignore the border.
- Canvas.FillRect(TRectF.Create(0, 0, Width, Height), 0, 0, [], 1.0);
- effectiveBorderWidth := 0;
- end
- else
- begin
- // Custom painting for the border
- if (FBorderWidth > 0) and (FBorderColor <> TAlphaColors.Null) then
- begin
- rect := TRectF.Create(0, 0, Width, Height);
- // Inflate inwards so the border is fully visible within the control's bounds
- rect.Inflate(-FBorderWidth / 2, -FBorderWidth / 2);
-
- Canvas.Stroke.Kind := TBrushKind.Solid;
- Canvas.Stroke.Color := FBorderColor;
- Canvas.Stroke.Thickness := FBorderWidth;
-
- if FFrameless then
- begin
- Canvas.Fill.Kind := TBrushKind.Solid;
- Canvas.Fill.Color := $20C0C0C0; // Transparent Silver
- Canvas.FillRect(rect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round);
- end
- else
- Canvas.DrawRect(rect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round);
- end;
- effectiveBorderWidth := FBorderWidth;
- end;
-
- // Draw the title
- if not FTitle.IsEmpty then
- begin
- // Define the rectangle for the title at the top of the control
- titleRect := TRectF.Create(0, effectiveBorderWidth, Width, effectiveBorderWidth + 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(titleRect, FTitle, False, 1.0, [], TTextAlign.Center, TTextAlign.Center);
- end;
-end;
-
-procedure TAuraNode.SetBorderColor(const Value: TAlphaColor);
-begin
- if FBorderColor <> Value then
- begin
- FBorderColor := Value;
- Repaint;
- end;
-end;
-
-procedure TAuraNode.SetBorderRadius(const Value: Single);
-begin
- if FBorderRadius <> Value then
- begin
- FBorderRadius := Value;
- Repaint;
- end;
-end;
-
-procedure TAuraNode.SetBorderWidth(const Value: Single);
-begin
- if FBorderWidth <> Value then
- begin
- FBorderWidth := Value;
- Repaint;
- end;
-end;
-
-procedure TAuraNode.SetFrameless(const Value: Boolean);
-begin
- if FFrameless <> Value then
- begin
- FFrameless := Value;
- Repaint;
- end;
-end;
-
-procedure TAuraNode.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.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.
diff --git a/ASTPlayground/MainForm.pas b/ASTPlayground/MainForm.pas
index 3214a27..e8d39fe 100644
--- a/ASTPlayground/MainForm.pas
+++ b/ASTPlayground/MainForm.pas
@@ -21,7 +21,6 @@ uses
FMX.ScrollBox,
FMX.Memo,
FMX.Controls.Presentation,
- DraggablePanel,
Myc.Ast.Visualizer,
Myc.Data.Scalar,
Myc.Ast.Nodes,
@@ -691,51 +690,55 @@ begin
recordDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson(TypeInfo(TOHLCV)));
series := TScalarRecordSeries.Create(recordDef);
- // 2. Create the setup AST with O(1) SMA implementation
+ // 2. Create the setup AST with the optimized O(1) SMA implementation
setupAst :=
TAst.Block(
[
+ // This factory is now much simpler. It only manages sum and a counter.
TAst.VarDecl(
- TAst.Identifier('CreateSMA_O1'),
+ TAst.Identifier('CreateSMA'),
TAst.LambdaExpr(
[TAst.Identifier('len')],
TAst.Block(
[
TAst.VarDecl(TAst.Identifier('sum'), TAst.Constant(TScalar.FromDouble(0.0))),
- TAst.VarDecl(TAst.Identifier('values'), TAst.CreateSeries('double')),
+ TAst.VarDecl(TAst.Identifier('count'), TAst.Constant(TScalar.FromInt64(0))),
+ // The returned closure now takes the full series and the new value.
TAst.LambdaExpr(
- [TAst.Identifier('val')],
+ [TAst.Identifier('series'), TAst.Identifier('val')],
TAst.Block(
[
+ TAst.Assign(
+ TAst.Identifier('sum'),
+ TAst.BinaryExpr(TAst.Identifier('sum'), boAdd, TAst.Identifier('val'))
+ ),
+ TAst.Assign(
+ TAst.Identifier('count'),
+ TAst.BinaryExpr(TAst.Identifier('count'), boAdd, TAst.Constant(TScalar.FromInt64(1)))
+ ),
+ // If the indicator is "full", subtract the value that just fell out of the window (at index 'len').
TAst.IfExpr(
- TAst.BinaryExpr(
- TAst.SeriesLength(TAst.Identifier('values')),
- boGreaterOrEqual,
- TAst.Identifier('len')
- ),
+ TAst.BinaryExpr(TAst.Identifier('count'), boGreater, TAst.Identifier('len')),
TAst.Assign(
TAst.Identifier('sum'),
TAst.BinaryExpr(
TAst.Identifier('sum'),
boSubtract,
- TAst.Indexer(
- TAst.Identifier('values'),
- TAst.BinaryExpr(
- TAst.Identifier('len'),
- boSubtract,
- TAst.Constant(TScalar.FromInt64(1))
- )
- )
+ TAst.Indexer(TAst.Identifier('series'), TAst.Identifier('len'))
)
),
nil
),
- TAst.Assign(
+ // Calculate and return the average. Divisor is capped at 'len'.
+ TAst.BinaryExpr(
TAst.Identifier('sum'),
- TAst.BinaryExpr(TAst.Identifier('sum'), boAdd, TAst.Identifier('val'))
- ),
- TAst.AddSeriesItem(TAst.Identifier('values'), TAst.Identifier('val'), TAst.Identifier('len')),
- TAst.BinaryExpr(TAst.Identifier('sum'), boDivide, TAst.SeriesLength(TAst.Identifier('values')))
+ boDivide,
+ TAst.TernaryExpr(
+ TAst.BinaryExpr(TAst.Identifier('count'), boLess, TAst.Identifier('len')),
+ TAst.Identifier('count'),
+ TAst.Identifier('len')
+ )
+ )
]
)
)
@@ -743,34 +746,43 @@ begin
)
)
),
+ // Instantiation remains the same.
TAst.VarDecl(
TAst.Identifier('smaFast'),
- TAst.FunctionCall(TAst.Identifier('CreateSMA_O1'), [TAst.Constant(TScalar.FromInt64(smaFastLength))])
+ TAst.FunctionCall(TAst.Identifier('CreateSMA'), [TAst.Constant(TScalar.FromInt64(smaFastLength))])
),
TAst.VarDecl(
TAst.Identifier('smaSlow'),
- TAst.FunctionCall(TAst.Identifier('CreateSMA_O1'), [TAst.Constant(TScalar.FromInt64(smaSlowLength))])
+ TAst.FunctionCall(TAst.Identifier('CreateSMA'), [TAst.Constant(TScalar.FromInt64(smaSlowLength))])
),
+ // The main strategy now passes the full close series to the indicators.
TAst.VarDecl(
TAst.Identifier('maCrossStrategy'),
TAst.LambdaExpr(
[TAst.Identifier('ohlcv')],
TAst.Block(
[
+ TAst.VarDecl(
+ TAst.Identifier('closeSeries'),
+ TAst.MemberAccess(TAst.Identifier('ohlcv'), TAst.Identifier('Close'))
+ ),
TAst.VarDecl(
TAst.Identifier('currentClose'),
- TAst.MemberAccess(
- TAst.Indexer(TAst.Identifier('ohlcv'), TAst.Constant(TScalar.FromInt64(0))),
- TAst.Identifier('Close')
- )
+ TAst.Indexer(TAst.Identifier('closeSeries'), TAst.Constant(TScalar.FromInt64(0)))
),
TAst.VarDecl(
TAst.Identifier('valSmaFast'),
- TAst.FunctionCall(TAst.Identifier('smaFast'), [TAst.Identifier('currentClose')])
+ TAst.FunctionCall(
+ TAst.Identifier('smaFast'),
+ [TAst.Identifier('closeSeries'), TAst.Identifier('currentClose')]
+ )
),
TAst.VarDecl(
TAst.Identifier('valSmaSlow'),
- TAst.FunctionCall(TAst.Identifier('smaSlow'), [TAst.Identifier('currentClose')])
+ TAst.FunctionCall(
+ TAst.Identifier('smaSlow'),
+ [TAst.Identifier('closeSeries'), TAst.Identifier('currentClose')]
+ )
),
TAst.TernaryExpr(
TAst.BinaryExpr(TAst.Identifier('valSmaFast'), boGreater, TAst.Identifier('valSmaSlow')),
@@ -827,8 +839,8 @@ begin
FGScope.SetValue('current_series', TAstValue.FromRecordSeries(series));
resultValue := callAst.Accept(visitor);
- // Memo1.Lines.Add(Format('Tick %d/%d: Close = %.2f, Signal = %s', [i, numRecs, ohlcvRec.Close, resultValue.ToString]));
- // Application.ProcessMessages;
+ Memo1.Lines.Add(Format('Tick %d/%d: Close = %.2f, Signal = %s', [i, numRecs, ohlcvRec.Close, resultValue.ToString]));
+ Application.ProcessMessages;
end;
end;
diff --git a/ASTPlayground/Myc.Ast.Visualizer.pas b/ASTPlayground/Myc.Ast.Visualizer.pas
index f739af6..6785147 100644
--- a/ASTPlayground/Myc.Ast.Visualizer.pas
+++ b/ASTPlayground/Myc.Ast.Visualizer.pas
@@ -12,8 +12,7 @@ uses
FMX.Controls,
FMX.Objects,
FMX.Graphics,
- Myc.Ast.Nodes,
- DraggablePanel;
+ Myc.Ast.Nodes;
type
TPinConnection = record
@@ -28,7 +27,135 @@ type
// New enum to select the visualization style.
TVisualizationMode = (vmDetailed, vmControlFlow);
- TAuraWorkspace = class;
+ // A movable panel with a custom-painted border and title.
+ 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;
+ // If true, the node is drawn without a border and with a transparent background.
+ FFrameless: Boolean;
+
+ 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);
+ procedure SetFrameless(const Value: Boolean);
+ protected
+ procedure Paint; override;
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
+ procedure MouseMove(Shift: TShiftState; X, Y: Single); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
+ 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;
+
+ // Behavior properties
+ property Frameless: Boolean read FFrameless write SetFrameless;
+
+ // Standard control properties
+ property Align;
+ property Anchors;
+ property ClipChildren default True;
+ property Cursor default crDefault;
+ property DragMode default TDragMode.dmManual;
+ property Enabled;
+ property Height;
+ property 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;
+
+ TAuraWorkspace = class(TStyledControl)
+ private
+ FConnections: TArray;
+ protected
+ procedure Paint; override;
+ procedure DoDeleteChildren; override;
+ public
+ procedure BuildTree(const Root: IAstNode; const Position: TPointF; AMode: TVisualizationMode);
+
+ 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;
TAstToAuraNodeVisitor = class(TInterfacedObject, IAstVisitor)
public
@@ -135,52 +262,6 @@ type
function VisitSeriesLength(const Node: ISeriesLengthNode): TAstValue;
end;
- TAuraWorkspace = class(TStyledControl)
- private
- FConnections: TArray;
- protected
- procedure Paint; override;
- procedure DoDeleteChildren; override;
- public
- procedure BuildTree(const Root: IAstNode; const Position: TPointF; AMode: TVisualizationMode);
-
- 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
@@ -192,7 +273,6 @@ type
// This visitor converts an AST expression subtree into a single string.
TAstToTextVisitor = class(TInterfacedObject, IAstVisitor)
public
- constructor Create;
{ IAstVisitor }
function VisitConstant(const Node: IConstantNode): TAstValue;
function VisitIdentifier(const Node: IIdentifierNode): TAstValue;
@@ -212,11 +292,6 @@ type
function VisitSeriesLength(const Node: ISeriesLengthNode): TAstValue;
end;
-constructor TAstToTextVisitor.Create;
-begin
- inherited Create;
-end;
-
{ TAstToTextVisitor }
function TAstToTextVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TAstValue;
@@ -376,6 +451,273 @@ begin
InputPin := AInputPin;
end;
+{ TAuraNode }
+
+constructor TAuraNode.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FIsDragging := False;
+
+ // Default border settings
+ FBorderColor := TAlphaColors.Gray;
+ FBorderWidth := 1;
+ FBorderRadius := 9; // 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;
+
+ // Default state for frameless mode
+ FFrameless := False;
+
+ 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.Paint;
+var
+ rect, titleRect: TRectF;
+ effectiveBorderWidth: Single;
+begin
+ inherited; // Allow styled painting to occur first (if any)
+
+ if FFrameless then
+ begin
+ Canvas.Fill.Kind := TBrushKind.Solid;
+ Canvas.Fill.Color := $20C0C0C0; // Transparent Silver
+ Canvas.Stroke.Kind := TBrushKind.None;
+
+ // In frameless mode, draw a transparent background and ignore the border.
+ Canvas.FillRect(TRectF.Create(0, 0, Width, Height), 0, 0, [], 1.0);
+ effectiveBorderWidth := 0;
+ end
+ else
+ begin
+ // Custom painting for the border
+ if (FBorderWidth > 0) and (FBorderColor <> TAlphaColors.Null) then
+ begin
+ rect := TRectF.Create(0, 0, Width, Height);
+ // Inflate inwards so the border is fully visible within the control's bounds
+ rect.Inflate(-FBorderWidth / 2, -FBorderWidth / 2);
+
+ Canvas.Stroke.Kind := TBrushKind.Solid;
+ Canvas.Stroke.Color := FBorderColor;
+ Canvas.Stroke.Thickness := FBorderWidth;
+
+ if FFrameless then
+ begin
+ Canvas.Fill.Kind := TBrushKind.Solid;
+ Canvas.Fill.Color := $20C0C0C0; // Transparent Silver
+ Canvas.FillRect(rect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round);
+ end
+ else
+ Canvas.DrawRect(rect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round);
+ end;
+ effectiveBorderWidth := FBorderWidth;
+ end;
+
+ // Draw the title
+ if not FTitle.IsEmpty then
+ begin
+ // Define the rectangle for the title at the top of the control
+ titleRect := TRectF.Create(0, effectiveBorderWidth, Width, effectiveBorderWidth + 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(titleRect, FTitle, False, 1.0, [], TTextAlign.Center, TTextAlign.Center);
+ end;
+end;
+
+procedure TAuraNode.SetBorderColor(const Value: TAlphaColor);
+begin
+ if FBorderColor <> Value then
+ begin
+ FBorderColor := Value;
+ Repaint;
+ end;
+end;
+
+procedure TAuraNode.SetBorderRadius(const Value: Single);
+begin
+ if FBorderRadius <> Value then
+ begin
+ FBorderRadius := Value;
+ Repaint;
+ end;
+end;
+
+procedure TAuraNode.SetBorderWidth(const Value: Single);
+begin
+ if FBorderWidth <> Value then
+ begin
+ FBorderWidth := Value;
+ Repaint;
+ end;
+end;
+
+procedure TAuraNode.SetFrameless(const Value: Boolean);
+begin
+ if FFrameless <> Value then
+ begin
+ FFrameless := Value;
+ Repaint;
+ end;
+end;
+
+procedure TAuraNode.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.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;
+
+{ TAuraWorkspace }
+
+procedure TAuraWorkspace.BuildTree(const Root: IAstNode; const Position: TPointF; AMode: TVisualizationMode);
+begin
+ var connections := TList.Create;
+ try
+ Root.Accept(TAstToAuraNodeVisitor.Create(Self, Self, Position, connections, nil, AMode));
+ 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;
+ controlOffset: Single;
+begin
+ inherited;
+
+ Canvas.Stroke.Kind := TBrushKind.Solid;
+ Canvas.Stroke.Thickness := 2;
+
+ // Go through all stored connections and draw them
+ for connection in FConnections do
+ begin
+ // Get the absolute coordinates of the pin centers
+ 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);
+
+ // Convert them to the local coordinates of the workspace
+ 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;
+
{ TAstToAuraNodeVisitor }
constructor TAstToAuraNodeVisitor.Create(
@@ -1432,74 +1774,4 @@ begin
Result := TAstValue.Void;
end;
-{ TAuraWorkspace }
-
-procedure TAuraWorkspace.BuildTree(const Root: IAstNode; const Position: TPointF; AMode: TVisualizationMode);
-begin
- var connections := TList.Create;
- try
- Root.Accept(TAstToAuraNodeVisitor.Create(Self, Self, Position, connections, nil, AMode));
- 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;
- controlOffset: Single;
-begin
- inherited;
-
- Canvas.Stroke.Kind := TBrushKind.Solid;
- Canvas.Stroke.Thickness := 2;
-
- // Go through all stored connections and draw them
- for connection in FConnections do
- begin
- // Get the absolute coordinates of the pin centers
- 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);
-
- // Convert them to the local coordinates of the workspace
- 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.