From a5fd0798757677d4fc62d0269898c6c4aac4ce25 Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Wed, 3 Sep 2025 22:55:43 +0200 Subject: [PATCH] Ast Refactoring --- ASTPlayground/ASTPlayground.dpr | 1 - ASTPlayground/ASTPlayground.dproj | 1 - ASTPlayground/DraggablePanel.pas | 300 --------------- ASTPlayground/MainForm.pas | 78 ++-- ASTPlayground/Myc.Ast.Visualizer.pas | 522 ++++++++++++++++++++------- 5 files changed, 442 insertions(+), 460 deletions(-) delete mode 100644 ASTPlayground/DraggablePanel.pas 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.