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);