From c7a865d12ef2250435855080890941ff52b8f1a8 Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Sat, 30 Aug 2025 01:38:40 +0200 Subject: [PATCH] Ast Playground 1. visualization --- ASTPlayground/ASTPlayground.dpr | 4 +- ASTPlayground/ASTPlayground.dproj | 2 + ASTPlayground/DraggablePanel.pas | 264 ++++++++++ ASTPlayground/MainForm.fmx | 40 +- ASTPlayground/MainForm.pas | 69 ++- ASTPlayground/Myc.Ast.Visualizer.pas | 711 +++++++++++++++++++++++++++ Src/AST/Myc.Ast.Nodes.pas | 16 +- Src/Data/Myc.Data.POD.pas | 413 ++++++---------- Src/Myc.Data.Series.pas | 29 +- Src/Myc.Trade.Indicators_v2.pas | 14 +- Test/TestDataPOD.pas | 66 ++- 11 files changed, 1298 insertions(+), 330 deletions(-) create mode 100644 ASTPlayground/DraggablePanel.pas create mode 100644 ASTPlayground/Myc.Ast.Visualizer.pas diff --git a/ASTPlayground/ASTPlayground.dpr b/ASTPlayground/ASTPlayground.dpr index 60bf9cf..311c3c9 100644 --- a/ASTPlayground/ASTPlayground.dpr +++ b/ASTPlayground/ASTPlayground.dpr @@ -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} diff --git a/ASTPlayground/ASTPlayground.dproj b/ASTPlayground/ASTPlayground.dproj index 9525b4b..31f0c45 100644 --- a/ASTPlayground/ASTPlayground.dproj +++ b/ASTPlayground/ASTPlayground.dproj @@ -139,6 +139,8 @@ + + Base diff --git a/ASTPlayground/DraggablePanel.pas b/ASTPlayground/DraggablePanel.pas new file mode 100644 index 0000000..91c1047 --- /dev/null +++ b/ASTPlayground/DraggablePanel.pas @@ -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 + /// + /// A panel that can contain other controls and can be moved by dragging its background. + /// It custom-paints its own 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; + + 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. diff --git a/ASTPlayground/MainForm.fmx b/ASTPlayground/MainForm.fmx index cdedafb..52d4dea 100644 --- a/ASTPlayground/MainForm.fmx +++ b/ASTPlayground/MainForm.fmx @@ -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 diff --git a/ASTPlayground/MainForm.pas b/ASTPlayground/MainForm.pas index 7743030..f93d9c8 100644 --- a/ASTPlayground/MainForm.pas +++ b/ASTPlayground/MainForm.pas @@ -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. diff --git a/ASTPlayground/Myc.Ast.Visualizer.pas b/ASTPlayground/Myc.Ast.Visualizer.pas new file mode 100644 index 0000000..0575dcb --- /dev/null +++ b/ASTPlayground/Myc.Ast.Visualizer.pas @@ -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; + 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 + ); + // Public access to the collected connections + property Connections: TList 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; + 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 +); +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.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. diff --git a/Src/AST/Myc.Ast.Nodes.pas b/Src/AST/Myc.Ast.Nodes.pas index 957cd8c..b900dfd 100644 --- a/Src/AST/Myc.Ast.Nodes.pas +++ b/Src/AST/Myc.Ast.Nodes.pas @@ -201,14 +201,14 @@ uses System.Classes; type - // Private interface to encapsulate a string value for reference counting. - IAstTextValue = interface(IInterface) + // Private interface to encapsulate a non scalar value for reference counting. + IAstValue = interface function GetValue: string; property Value: string read GetValue; end; // Implementation of the text value interface. - TAstTextValue = class(TInterfacedObject, IAstTextValue) + TAstValue = class(TInterfacedObject, IAstValue) private FValue: string; function GetValue: string; @@ -216,15 +216,15 @@ type constructor Create(const AValue: string); end; -{ TAstTextValue } +{ TAstValue } -constructor TAstTextValue.Create(const AValue: string); +constructor TAstValue.Create(const AValue: string); begin inherited Create; FValue := AValue; end; -function TAstTextValue.GetValue: string; +function TAstValue.GetValue: string; begin Result := FValue; end; @@ -255,7 +255,7 @@ function TAstValue.AsText: String; begin if (FKind <> avkText) then raise EInvalidCast.Create('Cannot read value as Text.'); - Result := IAstTextValue(FInterface).Value; + Result := IAstValue(FInterface).Value; end; class function TAstValue.FromClosure(const AValue: IEvaluatorClosure): TAstValue; @@ -275,7 +275,7 @@ end; class function TAstValue.FromText(const AValue: String): TAstValue; begin Result.FKind := avkText; - Result.FInterface := TAstTextValue.Create(AValue); + Result.FInterface := TAstValue.Create(AValue); Result.FScalar := Default(TScalar); end; diff --git a/Src/Data/Myc.Data.POD.pas b/Src/Data/Myc.Data.POD.pas index 67cbda0..1573450 100644 --- a/Src/Data/Myc.Data.POD.pas +++ b/Src/Data/Myc.Data.POD.pas @@ -8,7 +8,7 @@ uses Myc.Data.Series; type - // POD: Plain old data (...that fits into 128 bits) + // POD: Plain old data (...that fits into 64 bits) TScalarKind = ( skInteger, @@ -26,9 +26,9 @@ type skDecimal ); - TScalarBytes = array[0..15] of Byte; - TScalarPChar = array[0..7] of Char; - TScalarString = String[15]; + TScalarBytes = array[0..7] of Byte; + TScalarPChar = array[0..3] of Char; + TScalarString = String[7]; TScalarValue = record public @@ -49,54 +49,29 @@ type class function FromBytes(const AValue: TScalarBytes): TScalarValue; static; inline; class function FromDecimal(AValue: TDecimal): TScalarValue; static; inline; - function GetAsInteger: Integer; inline; - function GetAsInt64: Int64; inline; - function GetAsUInt64: UInt64; inline; - function GetAsSingle: Single; inline; - function GetAsDouble: Double; inline; - function GetAsDateTime: TDateTime; inline; - function GetAsTimestamp: TTimestamp; inline; - function GetAsBoolean: Boolean; inline; - function GetAsChar: Char; inline; - function GetAsPChar: PChar; inline; - function GetAsString: ShortString; inline; - function GetAsBytes: TScalarBytes; inline; - function GetAsDecimal: TDecimal; inline; - - property AsInteger: Integer read GetAsInteger; - property AsInt64: Int64 read GetAsInt64; - property AsUInt64: UInt64 read GetAsUInt64; - property AsSingle: Single read GetAsSingle; - property AsDouble: Double read GetAsDouble; - property AsDateTime: TDateTime read GetAsDateTime; - property AsTimestamp: TTimestamp read GetAsTimestamp; - property AsBoolean: Boolean read GetAsBoolean; - property AsChar: Char read GetAsChar; - property AsPChar: PChar read GetAsPChar; - property AsString: ShortString read GetAsString; - property AsBytes: TScalarBytes read GetAsBytes; - property AsDecimal: TDecimal read GetAsDecimal; - - strict private + // Direct field access for performance. case TScalarKind of - skInteger: (FInteger: Integer); - skInt64: (FInt64: Int64); - skUInt64: (FUInt64: UInt64); - skSingle: (FSingle: Single); - skDouble: (FDouble: Double); - skDateTime: (FDateTime: TDateTime); - skTimestamp: (FTimestamp: TTimestamp); - skBoolean: (FBoolean: Boolean); - skChar: (FChar: Char); - skPChar: (FPChar: TScalarPChar); - skString: (FString: String[15]); - skBytes: (FBytes: TScalarBytes); - skDecimal: (FDecimal: TDecimal); + skInteger: (AsInteger: Integer); + skInt64: (AsInt64: Int64); + skUInt64: (AsUInt64: UInt64); + skSingle: (AsSingle: Single); + skDouble: (AsDouble: Double); + skDateTime: (AsDateTime: TDateTime); + skTimestamp: (AsTimestamp: TTimestamp); + skBoolean: (AsBoolean: Boolean); + skChar: (AsChar: Char); + skPChar: (AsPChar: TScalarPChar); + skString: (AsString: String[7]); + skBytes: (AsBytes: TScalarBytes); + skDecimal: (AsDecimal: TDecimal); end; // A scalar value with a type identifier. TScalar = record public + Kind: TScalarKind; + Value: TScalarValue; + // Creates a new scalar from a kind and a value. constructor Create(AKind: TScalarKind; const AValue: TScalarValue); @@ -113,19 +88,9 @@ type class function FromPChar(const AValue: TScalarPChar): TScalar; static; inline; class function FromString(const AValue: String): TScalar; static; inline; class function FromBytes(const AValue: TScalarBytes): TScalar; static; inline; - class function FromDecimal(AValue: TDecimal): TScalar; static; inline; - - function GetKind: TScalarKind; inline; - function GetValue: TScalarValue; inline; + class function FromDecimal(const AValue: TDecimal): TScalar; static; inline; function ToString: String; - - property Kind: TScalarKind read GetKind; - property Value: TScalarValue read GetValue; - - strict private - FKind: TScalarKind; - FValue: TScalarValue; end; // Basic data structures using the scalar type (these are not POD of course) @@ -133,51 +98,23 @@ type // An array of scalar values of the same kind. TScalarArray = record public + Kind: TScalarKind; + Items: TArray; + // Creates a new scalar array. constructor Create(AKind: TScalarKind; const AItems: TArray); - - function GetKind: TScalarKind; inline; - function GetItems: TArray; inline; - - property Kind: TScalarKind read GetKind; - property Items: TArray read GetItems; - - strict private - FKind: TScalarKind; - FItems: TArray; end; TScalarTuple = TArray; // A field definition for a scalar record. TScalarRecordField = record - public - // Creates a new record field definition. + Name: String; + Kind: TScalarKind; constructor Create(const AName: String; AKind: TScalarKind); - - function GetName: String; inline; - function GetKind: TScalarKind; inline; - - property Name: String read GetName; - property Kind: TScalarKind read GetKind; - - strict private - FName: String; - FKind: TScalarKind; end; - // A collection of field definitions that describe a scalar record. - TScalarRecordDefinition = record - public - // Creates a new record definition. - constructor Create(const AFields: TArray); - - function GetFields: TArray; inline; - property Fields: TArray read GetFields; - - strict private - FFields: TArray; - end; + TScalarRecordDefinition = TArray; // A record of scalar values, based on a definition. TScalarRecord = record @@ -215,272 +152,213 @@ type FItems: TSeries; end; + // A time series of scalar records, optimized for memory and access speed. + TScalarRecordSeries = record + private + FDef: TScalarRecordDefinition; + FArray: TChunkArray; + FTotalCount: Int64; + function GetDef: TScalarRecordDefinition; inline; + function GetItems(Idx: Integer): TScalarRecord; + public + constructor Create(const ADef: TScalarRecordDefinition); + procedure Add(const Item: TScalarRecord; Lookback: Int64 = -1); + property Def: TScalarRecordDefinition read GetDef; + property Items[Idx: Integer]: TScalarRecord read GetItems; default; + property TotalCount: Int64 read FTotalCount; + end; + implementation { TScalarValue } class function TScalarValue.FromBoolean(AValue: Boolean): TScalarValue; begin - Result.FBoolean := AValue; + Result.AsBoolean := AValue; end; class function TScalarValue.FromBytes(const AValue: TScalarBytes): TScalarValue; begin - Result.FBytes := AValue; + Result.AsBytes := AValue; end; class function TScalarValue.FromChar(AValue: Char): TScalarValue; begin - Result.FChar := AValue; + Result.AsChar := AValue; end; class function TScalarValue.FromDateTime(AValue: TDateTime): TScalarValue; begin - Result.FDateTime := AValue; + Result.AsDateTime := AValue; end; class function TScalarValue.FromDecimal(AValue: TDecimal): TScalarValue; begin - Result.FDecimal := AValue; + Result.AsDecimal := AValue; end; class function TScalarValue.FromDouble(AValue: Double): TScalarValue; begin - Result.FDouble := AValue; + Result.AsDouble := AValue; end; class function TScalarValue.FromInt64(AValue: Int64): TScalarValue; begin - Result.FInt64 := AValue; + Result.AsInt64 := AValue; end; class function TScalarValue.FromInteger(AValue: Integer): TScalarValue; begin - Result.FInteger := AValue; + Result.AsInteger := AValue; end; class function TScalarValue.FromPChar(const AValue: String): TScalarValue; var len, i: Integer; begin - FillChar(Result.FPChar, SizeOf(Result.FPChar), #0); + FillChar(Result.AsPChar, SizeOf(Result.AsPChar), #0); len := Length(AValue); if (len > 0) then begin - if (len > Length(Result.FPChar)) then - len := Length(Result.FPChar); + if (len > Length(Result.AsPChar)) then + len := Length(Result.AsPChar); for i := 0 to len - 1 do - Result.FPChar[i] := AValue[i + 1]; + Result.AsPChar[i] := AValue[i + 1]; end; end; class function TScalarValue.FromPChar(const AValue: TScalarPChar): TScalarValue; begin - Result.FPChar := AValue; + Result.AsPChar := AValue; end; class function TScalarValue.FromSingle(AValue: Single): TScalarValue; begin - Result.FSingle := AValue; + Result.AsSingle := AValue; end; class function TScalarValue.FromString(const AValue: String): TScalarValue; begin - Result.FString := ShortString(AValue); + Result.AsString := ShortString(AValue); end; class function TScalarValue.FromString(const AValue: TScalarString): TScalarValue; begin - Result.FString := AValue; + Result.AsString := AValue; end; class function TScalarValue.FromTimestamp(AValue: TTimestamp): TScalarValue; begin - Result.FTimestamp := AValue; + Result.AsTimestamp := AValue; end; class function TScalarValue.FromUInt64(AValue: UInt64): TScalarValue; begin - Result.FUInt64 := AValue; -end; - -function TScalarValue.GetAsBoolean: Boolean; -begin - Result := FBoolean; -end; - -function TScalarValue.GetAsBytes: TScalarBytes; -begin - Result := FBytes; -end; - -function TScalarValue.GetAsChar: Char; -begin - Result := FChar; -end; - -function TScalarValue.GetAsDateTime: TDateTime; -begin - Result := FDateTime; -end; - -function TScalarValue.GetAsDecimal: TDecimal; -begin - Result := FDecimal; -end; - -function TScalarValue.GetAsDouble: Double; -begin - Result := FDouble; -end; - -function TScalarValue.GetAsInt64: Int64; -begin - Result := FInt64; -end; - -function TScalarValue.GetAsInteger: Integer; -begin - Result := FInteger; -end; - -function TScalarValue.GetAsPChar: PChar; -begin - Result := @FPChar; -end; - -function TScalarValue.GetAsSingle: Single; -begin - Result := FSingle; -end; - -function TScalarValue.GetAsString: ShortString; -begin - Result := FString; -end; - -function TScalarValue.GetAsTimestamp: TTimestamp; -begin - Result := FTimestamp; -end; - -function TScalarValue.GetAsUInt64: UInt64; -begin - Result := FUInt64; + Result.AsUInt64 := AValue; end; { TScalar } constructor TScalar.Create(AKind: TScalarKind; const AValue: TScalarValue); begin - FKind := AKind; - FValue := AValue; + Kind := AKind; + Value := AValue; end; class function TScalar.FromBoolean(AValue: Boolean): TScalar; begin - Result.FKind := skBoolean; - Result.FValue := TScalarValue.FromBoolean(AValue); + Result.Kind := skBoolean; + Result.Value := TScalarValue.FromBoolean(AValue); end; class function TScalar.FromBytes(const AValue: TScalarBytes): TScalar; begin - Result.FKind := skBytes; - Result.FValue := TScalarValue.FromBytes(AValue); + Result.Kind := skBytes; + Result.Value := TScalarValue.FromBytes(AValue); end; class function TScalar.FromChar(AValue: Char): TScalar; begin - Result.FKind := skChar; - Result.FValue := TScalarValue.FromChar(AValue); + Result.Kind := skChar; + Result.Value := TScalarValue.FromChar(AValue); end; class function TScalar.FromDateTime(AValue: TDateTime): TScalar; begin - Result.FKind := skDateTime; - Result.FValue := TScalarValue.FromDateTime(AValue); + Result.Kind := skDateTime; + Result.Value := TScalarValue.FromDateTime(AValue); end; -class function TScalar.FromDecimal(AValue: TDecimal): TScalar; +class function TScalar.FromDecimal(const AValue: TDecimal): TScalar; begin - Result.FKind := skDecimal; - Result.FValue := TScalarValue.FromDecimal(AValue); + Result.Kind := skDecimal; + Result.Value := TScalarValue.FromDecimal(AValue); end; class function TScalar.FromDouble(AValue: Double): TScalar; begin - Result.FKind := skDouble; - Result.FValue := TScalarValue.FromDouble(AValue); + Result.Kind := skDouble; + Result.Value := TScalarValue.FromDouble(AValue); end; class function TScalar.FromInt64(AValue: Int64): TScalar; begin - Result.FKind := skInt64; - Result.FValue := TScalarValue.FromInt64(AValue); + Result.Kind := skInt64; + Result.Value := TScalarValue.FromInt64(AValue); end; class function TScalar.FromInteger(AValue: Integer): TScalar; begin - Result.FKind := skInteger; - Result.FValue := TScalarValue.FromInteger(AValue); + Result.Kind := skInteger; + Result.Value := TScalarValue.FromInteger(AValue); end; class function TScalar.FromPChar(const AValue: TScalarPChar): TScalar; begin - Result.FKind := skPChar; - Result.FValue := TScalarValue.FromPChar(AValue); + Result.Kind := skPChar; + Result.Value := TScalarValue.FromPChar(AValue); end; class function TScalar.FromSingle(AValue: Single): TScalar; begin - Result.FKind := skSingle; - Result.FValue := TScalarValue.FromSingle(AValue); + Result.Kind := skSingle; + Result.Value := TScalarValue.FromSingle(AValue); end; class function TScalar.FromString(const AValue: String): TScalar; begin - Result.FKind := skString; - Result.FValue := TScalarValue.FromString(AValue); + Result.Kind := skString; + Result.Value := TScalarValue.FromString(AValue); end; class function TScalar.FromTimestamp(AValue: TTimestamp): TScalar; begin - Result.FKind := skTimestamp; - Result.FValue := TScalarValue.FromTimestamp(AValue); + Result.Kind := skTimestamp; + Result.Value := TScalarValue.FromTimestamp(AValue); end; class function TScalar.FromUInt64(AValue: UInt64): TScalar; begin - Result.FKind := skUInt64; - Result.FValue := TScalarValue.FromUInt64(AValue); -end; - -function TScalar.GetKind: TScalarKind; -begin - Result := FKind; -end; - -function TScalar.GetValue: TScalarValue; -begin - Result := FValue; + Result.Kind := skUInt64; + Result.Value := TScalarValue.FromUInt64(AValue); end; function TScalar.ToString: String; begin - case FKind of - skInteger: Result := IntToStr(FValue.AsInteger); - skInt64: Result := IntToStr(FValue.AsInt64); - skUInt64: Result := UIntToStr(FValue.AsUInt64); - skSingle: Result := FloatToStr(FValue.AsSingle); - skDouble: Result := FloatToStr(FValue.AsDouble); - skDateTime: Result := DateTimeToStr(FValue.AsDateTime); - skTimestamp: Result := FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz', TimeStampToDateTime(FValue.AsTimestamp)); - skBoolean: Result := BoolToStr(FValue.AsBoolean, True); - skChar: Result := '''' + FValue.AsChar + ''''; - skPChar: Result := FValue.AsPChar; // Already null-terminated - skString: Result := '''' + string(FValue.AsString) + ''''; + case Kind of + skInteger: Result := IntToStr(Value.AsInteger); + skInt64: Result := IntToStr(Value.AsInt64); + skUInt64: Result := UIntToStr(Value.AsUInt64); + skSingle: Result := FloatToStr(Value.AsSingle); + skDouble: Result := FloatToStr(Value.AsDouble); + skDateTime: Result := DateTimeToStr(Value.AsDateTime); + skTimestamp: Result := FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz', TimeStampToDateTime(Value.AsTimestamp)); + skBoolean: Result := BoolToStr(Value.AsBoolean, True); + skChar: Result := '''' + Value.AsChar + ''''; + skPChar: Result := PChar(@Value.AsPChar); // Needs explicit cast/pointer + skString: Result := '''' + string(Value.AsString) + ''''; skBytes: Result := '(Bytes)'; - skDecimal: Result := FloatToStr(Double(FValue.AsDecimal)); + skDecimal: Result := FloatToStr(Double(Value.AsDecimal)); else Result := '[Unknown Scalar]'; end; @@ -490,55 +368,23 @@ end; constructor TScalarArray.Create(AKind: TScalarKind; const AItems: TArray); begin - FKind := AKind; - FItems := AItems; -end; - -function TScalarArray.GetKind: TScalarKind; -begin - Result := FKind; -end; - -function TScalarArray.GetItems: TArray; -begin - Result := FItems; + Kind := AKind; + Items := AItems; end; { TScalarRecordField } constructor TScalarRecordField.Create(const AName: String; AKind: TScalarKind); begin - FName := AName; - FKind := AKind; -end; - -function TScalarRecordField.GetName: String; -begin - Result := FName; -end; - -function TScalarRecordField.GetKind: TScalarKind; -begin - Result := FKind; -end; - -{ TScalarRecordDefinition } - -constructor TScalarRecordDefinition.Create(const AFields: TArray); -begin - FFields := AFields; -end; - -function TScalarRecordDefinition.GetFields: TArray; -begin - Result := FFields; + Name := AName; + Kind := AKind; end; { TScalarRecord } constructor TScalarRecord.Create(const ADef: TScalarRecordDefinition; const AFields: TArray); begin - Assert(Length(ADef.Fields) = Length(AFields), 'Field definition and value count must match.'); + Assert(Length(ADef) = Length(AFields), 'Field definition and value count must match.'); FDef := ADef; FFields := AFields; end; @@ -559,9 +405,9 @@ var fieldDef: TScalarRecordField; begin // Find the index of the field by name (case-insensitive) - for i := 0 to Length(FDef.Fields) - 1 do + for i := 0 to Length(FDef) - 1 do begin - fieldDef := FDef.Fields[i]; + fieldDef := FDef[i]; if (CompareText(fieldDef.Name, Name) = 0) then begin // Found it. Construct the TScalar result from the kind and value. @@ -592,7 +438,42 @@ begin Result := FItems; end; +{ TScalarRecordSeries } + +// Implements a time series of scalar records using a chunk array for efficient storage. +// Each record's fields are stored sequentially in the TChunkArray. + +constructor TScalarRecordSeries.Create(const ADef: TScalarRecordDefinition); +begin + Assert(Length(ADef) > 0); + FDef := ADef; + FArray := Default(TChunkArray); + FTotalCount := 0; +end; + +procedure TScalarRecordSeries.Add(const Item: TScalarRecord; Lookback: Int64 = -1); +begin + FArray.Add(Item.Fields, Length(FDef) * Lookback); + inc(FTotalCount); +end; + +function TScalarRecordSeries.GetDef: TScalarRecordDefinition; +begin + Result := FDef; +end; + +function TScalarRecordSeries.GetItems(Idx: Integer): TScalarRecord; +var + values: TArray; + fieldCount: Integer; +begin + fieldCount := Length(FDef); + SetLength(values, fieldCount); + Move(FArray.ItemRef[(FArray.Count - fieldCount) - (Idx * fieldCount)]^, values[0], sizeof(TScalarValue) * fieldCount); + Result.Create(FDef, values); +end; + initialization - Assert(sizeof(TScalarValue) = 16); + Assert(sizeof(TScalarValue) = 8); end. diff --git a/Src/Myc.Data.Series.pas b/Src/Myc.Data.Series.pas index bfd0db1..b1a5afc 100644 --- a/Src/Myc.Data.Series.pas +++ b/Src/Myc.Data.Series.pas @@ -4,16 +4,19 @@ interface type TChunkArray = record + type + PT = ^T; private const ChunkSize = 1024; type - TChunk = TArray; + TChunk = array of T; private FChunks: TArray; FOffset: Integer; FCount: Integer; function GetItems(Idx: Integer): T; inline; + function GetItemRef(Idx: Integer): PT; inline; public constructor Create(const AChunks: TArray; ACount: Integer; AOffset: Integer); @@ -32,6 +35,7 @@ type property Count: Integer read FCount; property Items[Idx: Integer]: T read GetItems; default; + property ItemRef[Idx: Integer]: PT read GetItemRef; end; // A series where the last added item has index 0. @@ -274,9 +278,7 @@ end; function TChunkArray.GetItems(Idx: Integer): T; begin - // Convert logical index to physical index inside chunks - var physicalIdx := Idx + FOffset; - Result := FChunks[physicalIdx div ChunkSize][physicalIdx mod ChunkSize]; + Result := GetItemRef(Idx)^; end; function TChunkArray.Copy(MaxCount: Integer): TChunkArray; @@ -341,6 +343,13 @@ begin Result.FCount := effectiveCount; end; +function TChunkArray.GetItemRef(Idx: Integer): PT; +begin + Assert((Idx >= 0) and (Idx < FCount)); + var physicalIdx := Idx + FOffset; + Result := @FChunks[physicalIdx div ChunkSize][physicalIdx mod ChunkSize]; +end; + class operator TChunkArray.Initialize(out Dest: TChunkArray); begin Dest.FOffset := 0; @@ -349,6 +358,12 @@ end; { TSeries } +constructor TSeries.Create(const AArray: TChunkArray; ATotalCount: Int64); +begin + FArray := AArray; + FTotalCount := ATotalCount; +end; + procedure TSeries.Add(const Data: T; Lookback: Int64); begin FArray.Add(Data, Lookback); @@ -361,12 +376,6 @@ begin inc(FTotalCount, Length(Data)); end; -constructor TSeries.Create(const AArray: TChunkArray; ATotalCount: Int64); -begin - FArray := AArray; - FTotalCount := ATotalCount; -end; - function TSeries.Copy(Lookback: Integer): TSeries; begin // Create a copy of the underlying chunk array, optionally truncating it. diff --git a/Src/Myc.Trade.Indicators_v2.pas b/Src/Myc.Trade.Indicators_v2.pas index 20f195d..a1f0980 100644 --- a/Src/Myc.Trade.Indicators_v2.pas +++ b/Src/Myc.Trade.Indicators_v2.pas @@ -1,4 +1,4 @@ -unit Myc.Trade.Indicators_V2; +unit Myc.Trade.Indicators_V2 deprecated; interface @@ -377,7 +377,7 @@ begin begin shortName := rttiType.Name; end; - + { // Create the main factory procedure. This is a double-nested anonymous method // that wraps the template's specific factory and worker functions. factoryProc := @@ -419,7 +419,7 @@ begin Result := DataValueFromTValue(resultAsTValue); end; end; - +} // Create the final factory instance with all type handles and extracted metadata. Result := TGenericIndicatorFactory.Create(factoryProc, shortName, name, hint, paramsDataType, argsDataType, resultDataType); end; @@ -452,7 +452,7 @@ begin var paramsAsTValue := TValue.From(Params); var paramsAsDataValue := DataValueFromTValue(paramsAsTValue); var cIndicator := FFactoryProc(paramsAsDataValue); - + { Result := function(const Args: TArgs): TResult begin @@ -461,7 +461,7 @@ begin var resultAsDataValue := cIndicator(argsAsDataValue); var resultAsTValue := resultAsDataValue.AsTValue; Result := resultAsTValue.AsType; - end; + end;} end; { TIndicatorRegistry.TItem } @@ -481,7 +481,7 @@ begin var paramsAsTValue := TValue.From(Params); var paramsAsDataValue := DataValueFromTValue(paramsAsTValue); var cIndicator := FFactory.CreateIndicator(paramsAsDataValue); - + { // Return a wrapper that handles the conversion for args and result. Result := function(const Args: TArgs): TResult @@ -491,7 +491,7 @@ begin var resultAsDataValue := cIndicator(argsAsDataValue); var resultAsTValue := resultAsDataValue.AsTValue; Result := resultAsTValue.AsType; - end; + end;} end; { TIndicatorRegistry } diff --git a/Test/TestDataPOD.pas b/Test/TestDataPOD.pas index 3d14f4d..629b227 100644 --- a/Test/TestDataPOD.pas +++ b/Test/TestDataPOD.pas @@ -50,6 +50,9 @@ type procedure TestScalarRecordAndDefinition; [Test] procedure TestScalarSeries; + + [Test] + procedure TestScalarRecordSeries; end; implementation @@ -117,7 +120,7 @@ begin skString: begin scalar := TScalar.FromString(AValueStr); - s := Copy(AValueStr, 1, 15); // ShortString truncates to 15 chars + s := Copy(AValueStr, 1, 7); // ShortString truncates to 7 chars Assert.AreEqual(AExpectedKind, scalar.Kind, 'Kind should be skString'); Assert.AreEqual(s, string(scalar.Value.AsString), 'Value mismatch for AsString'); end; @@ -223,23 +226,21 @@ var begin // 1. Create a definition recDef := - TScalarRecordDefinition.Create( - [ - TScalarRecordField.Create('ID', skInt64), - TScalarRecordField.Create('Name', skString), - TScalarRecordField.Create('Price', skDecimal) - ] - ); - Assert.AreEqual(Int64(3), Length(recDef.Fields), 'Record definition field count mismatch'); - Assert.AreEqual('Name', recDef.Fields[1].Name, 'Record definition field name mismatch'); + [ + TScalarRecordField.Create('ID', skInt64), + TScalarRecordField.Create('Name', skString), + TScalarRecordField.Create('Price', skDecimal) + ]; + Assert.AreEqual(Int64(3), Length(recDef), 'Record definition field count mismatch'); + Assert.AreEqual('Name', recDef[1].Name, 'Record definition field name mismatch'); // 2. Create a matching set of values - values := [TScalar.FromInt64(99).Value, TScalar.FromString('ProductX').Value, TScalar.FromDecimal(TDecimal.Create(1995, 2)).Value]; + values := [TScalar.FromInt64(99).Value, TScalar.FromString('Product').Value, TScalar.FromDecimal(TDecimal.Create(1995, 2)).Value]; // 3. Create the record rec := TScalarRecord.Create(recDef, values); Assert.AreEqual(Int64(3), Length(rec.Fields), 'Record field count mismatch'); - Assert.AreEqual('ProductX', string(rec.Fields[1].AsString), 'Record field value mismatch'); + Assert.AreEqual('Product', string(rec.Fields[1].AsString), 'Record field value mismatch'); Assert.AreEqual(TDecimal.Create(1995, 2), rec.Fields[2].AsDecimal, 'Record decimal field value mismatch'); // 4. Test assertion for mismatched field count @@ -277,6 +278,47 @@ begin Assert.AreEqual(101.5, scalarSeries.Items[3].AsDouble, 1E-12, 'Series item [3] mismatch'); end; +procedure TTestPOD.TestScalarRecordSeries; +var + recDef: TScalarRecordDefinition; + series: TScalarRecordSeries; + rec1, rec2, rec3: TScalarRecord; + retrievedRec: TScalarRecord; +begin + // 1. Define the structure of the records in the series + recDef := [TScalarRecordField.Create('ID', skInt64), TScalarRecordField.Create('Price', skDecimal)]; + + // 2. Create the series with the definition + series := TScalarRecordSeries.Create(recDef); + Assert.AreEqual(Int64(0), series.TotalCount, 'Initial series should be empty'); + + // 3. Create some records + rec1 := TScalarRecord.Create(recDef, [TScalarValue.FromInt64(1), TScalarValue.FromDecimal(TDecimal.Create(100, 2))]); + rec2 := TScalarRecord.Create(recDef, [TScalarValue.FromInt64(2), TScalarValue.FromDecimal(TDecimal.Create(101, 2))]); + rec3 := TScalarRecord.Create(recDef, [TScalarValue.FromInt64(3), TScalarValue.FromDecimal(TDecimal.Create(102, 2))]); + + // 4. Add records to the series + series.Add(rec1); + series.Add(rec2); + series.Add(rec3); + + // 5. Verify the state of the series + Assert.AreEqual(Int64(3), series.TotalCount, 'Series total count mismatch after adding items'); + + // 6. Check items. Index 0 is the last added item. + retrievedRec := series.Items[0]; // Should be rec3 + Assert.AreEqual(skInt64, retrievedRec['ID'].Kind, 'Item[0] ID kind mismatch'); + Assert.AreEqual(Int64(3), retrievedRec['ID'].Value.AsInt64, 'Item[0] ID value mismatch'); + Assert.AreEqual(TDecimal.Create(102, 2), retrievedRec['Price'].Value.AsDecimal, 'Item[0] Price value mismatch'); + + retrievedRec := series.Items[1]; // Should be rec2 + Assert.AreEqual(Int64(2), retrievedRec.Items['ID'].Value.AsInt64, 'Item[1] ID value mismatch'); + + retrievedRec := series.Items[2]; // Should be rec1 + Assert.AreEqual(Int64(1), retrievedRec.Items['ID'].Value.AsInt64, 'Item[2] ID value mismatch'); + Assert.AreEqual(TDecimal.Create(100, 2), retrievedRec.Items['Price'].Value.AsDecimal, 'Item[2] Price value mismatch'); +end; + initialization FormatSettings.DecimalSeparator := '.'; TDUnitX.RegisterTestFixture(TTestPOD);