Ast Refactoring
This commit is contained in:
Michael Schimmel
@@ -8,7 +8,6 @@ uses
|
||||
Myc.Ast.Printer in '..\Src\AST\Myc.Ast.Printer.pas',
|
||||
Myc.Ast.Nodes in '..\Src\AST\Myc.Ast.Nodes.pas',
|
||||
Myc.Ast.Scope in '..\Src\AST\Myc.Ast.Scope.pas',
|
||||
DraggablePanel in 'DraggablePanel.pas',
|
||||
Myc.Ast.Visualizer in 'Myc.Ast.Visualizer.pas';
|
||||
|
||||
{$R *.res}
|
||||
|
||||
@@ -139,7 +139,6 @@
|
||||
<DCCReference Include="..\Src\AST\Myc.Ast.Printer.pas"/>
|
||||
<DCCReference Include="..\Src\AST\Myc.Ast.Nodes.pas"/>
|
||||
<DCCReference Include="..\Src\AST\Myc.Ast.Scope.pas"/>
|
||||
<DCCReference Include="DraggablePanel.pas"/>
|
||||
<DCCReference Include="Myc.Ast.Visualizer.pas"/>
|
||||
<BuildConfiguration Include="Base">
|
||||
<Key>Base</Key>
|
||||
|
||||
@@ -1,300 +0,0 @@
|
||||
unit DraggablePanel;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.Classes,
|
||||
System.UITypes,
|
||||
System.Types,
|
||||
FMX.Types,
|
||||
FMX.Controls,
|
||||
FMX.StdCtrls,
|
||||
FMX.Graphics,
|
||||
FMX.Objects;
|
||||
|
||||
type
|
||||
// A movable panel with a custom-painted border and title.
|
||||
TAuraNode = class(TStyledControl)
|
||||
private
|
||||
// Flag to indicate if the control is currently being dragged.
|
||||
FIsDragging: Boolean;
|
||||
// Stores the mouse coordinates at the beginning of the drag operation.
|
||||
FDownPos: TPointF;
|
||||
// Properties for the custom-drawn border.
|
||||
FBorderColor: TAlphaColor;
|
||||
FBorderWidth: Single;
|
||||
FBorderRadius: Single;
|
||||
// Properties for the title
|
||||
FTitle: string;
|
||||
FTitleFont: TFont;
|
||||
FTitleFontColor: TAlphaColor;
|
||||
// If true, the node is drawn without a border and with a transparent background.
|
||||
FFrameless: Boolean;
|
||||
|
||||
procedure SetBorderColor(const Value: TAlphaColor);
|
||||
procedure SetBorderWidth(const Value: Single);
|
||||
procedure SetBorderRadius(const Value: Single);
|
||||
procedure SetTitle(const Value: string);
|
||||
procedure SetTitleFont(const Value: TFont);
|
||||
procedure SetTitleFontColor(const Value: TAlphaColor);
|
||||
procedure TitleFontChanged(Sender: TObject);
|
||||
procedure SetFrameless(const Value: Boolean);
|
||||
protected
|
||||
procedure Paint; override;
|
||||
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
|
||||
procedure MouseMove(Shift: TShiftState; X, Y: Single); override;
|
||||
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
published
|
||||
// Custom border properties
|
||||
property BorderColor: TAlphaColor read FBorderColor write SetBorderColor;
|
||||
property BorderWidth: Single read FBorderWidth write SetBorderWidth;
|
||||
property BorderRadius: Single read FBorderRadius write SetBorderRadius;
|
||||
|
||||
// Title properties
|
||||
property Title: string read FTitle write SetTitle;
|
||||
property TitleFont: TFont read FTitleFont write SetTitleFont;
|
||||
property TitleFontColor: TAlphaColor read FTitleFontColor write SetTitleFontColor;
|
||||
|
||||
// Behavior properties
|
||||
property Frameless: Boolean read FFrameless write SetFrameless;
|
||||
|
||||
// Standard control properties
|
||||
property Align;
|
||||
property Anchors;
|
||||
property ClipChildren default True;
|
||||
property Cursor default crDefault;
|
||||
property DragMode default TDragMode.dmManual;
|
||||
property Enabled;
|
||||
property Height;
|
||||
property HelpContext;
|
||||
property HelpKeyword;
|
||||
property HelpType;
|
||||
property Hint;
|
||||
property HitTest default True;
|
||||
property Locked;
|
||||
property Margins;
|
||||
property Opacity;
|
||||
property Padding;
|
||||
property PopupMenu;
|
||||
property Position;
|
||||
property RotationAngle;
|
||||
property RotationCenter;
|
||||
property Scale;
|
||||
property Size;
|
||||
property StyleLookup;
|
||||
property Visible;
|
||||
property Width;
|
||||
property OnClick;
|
||||
property OnDblClick;
|
||||
property OnMouseDown;
|
||||
property OnMouseMove;
|
||||
property OnMouseUp;
|
||||
property OnMouseWheel;
|
||||
property OnMouseEnter;
|
||||
property OnMouseLeave;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TAuraNode }
|
||||
|
||||
constructor TAuraNode.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FIsDragging := False;
|
||||
|
||||
// Default border settings
|
||||
FBorderColor := TAlphaColors.Gray;
|
||||
FBorderWidth := 1;
|
||||
FBorderRadius := 9; // Sharp corners by default
|
||||
|
||||
// Default title settings
|
||||
FTitle := 'Node';
|
||||
FTitleFont := TFont.Create;
|
||||
FTitleFont.Family := 'Segoe UI';
|
||||
FTitleFont.Size := 11;
|
||||
FTitleFont.Style := [TFontStyle.fsBold];
|
||||
FTitleFont.OnChanged := TitleFontChanged;
|
||||
FTitleFontColor := TAlphaColors.Black;
|
||||
|
||||
// Default state for frameless mode
|
||||
FFrameless := False;
|
||||
|
||||
Width := 80;
|
||||
Height := 45;
|
||||
|
||||
// The panel must be able to receive mouse events.
|
||||
HitTest := True;
|
||||
// Clip children to the panel's bounds.
|
||||
ClipChildren := True;
|
||||
end;
|
||||
|
||||
destructor TAuraNode.Destroy;
|
||||
begin
|
||||
FTitleFont.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TAuraNode.Paint;
|
||||
var
|
||||
rect, titleRect: TRectF;
|
||||
effectiveBorderWidth: Single;
|
||||
begin
|
||||
inherited; // Allow styled painting to occur first (if any)
|
||||
|
||||
if FFrameless then
|
||||
begin
|
||||
Canvas.Fill.Kind := TBrushKind.Solid;
|
||||
Canvas.Fill.Color := $20C0C0C0; // Transparent Silver
|
||||
Canvas.Stroke.Kind := TBrushKind.None;
|
||||
|
||||
// In frameless mode, draw a transparent background and ignore the border.
|
||||
Canvas.FillRect(TRectF.Create(0, 0, Width, Height), 0, 0, [], 1.0);
|
||||
effectiveBorderWidth := 0;
|
||||
end
|
||||
else
|
||||
begin
|
||||
// Custom painting for the border
|
||||
if (FBorderWidth > 0) and (FBorderColor <> TAlphaColors.Null) then
|
||||
begin
|
||||
rect := TRectF.Create(0, 0, Width, Height);
|
||||
// Inflate inwards so the border is fully visible within the control's bounds
|
||||
rect.Inflate(-FBorderWidth / 2, -FBorderWidth / 2);
|
||||
|
||||
Canvas.Stroke.Kind := TBrushKind.Solid;
|
||||
Canvas.Stroke.Color := FBorderColor;
|
||||
Canvas.Stroke.Thickness := FBorderWidth;
|
||||
|
||||
if FFrameless then
|
||||
begin
|
||||
Canvas.Fill.Kind := TBrushKind.Solid;
|
||||
Canvas.Fill.Color := $20C0C0C0; // Transparent Silver
|
||||
Canvas.FillRect(rect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round);
|
||||
end
|
||||
else
|
||||
Canvas.DrawRect(rect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round);
|
||||
end;
|
||||
effectiveBorderWidth := FBorderWidth;
|
||||
end;
|
||||
|
||||
// Draw the title
|
||||
if not FTitle.IsEmpty then
|
||||
begin
|
||||
// Define the rectangle for the title at the top of the control
|
||||
titleRect := TRectF.Create(0, effectiveBorderWidth, Width, effectiveBorderWidth + FTitleFont.Size * 1.8);
|
||||
|
||||
Canvas.Font.Assign(FTitleFont);
|
||||
Canvas.Fill.Color := FTitleFontColor;
|
||||
|
||||
// Draw the text centered horizontally and vertically within the title rectangle
|
||||
Canvas.FillText(titleRect, FTitle, False, 1.0, [], TTextAlign.Center, TTextAlign.Center);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAuraNode.SetBorderColor(const Value: TAlphaColor);
|
||||
begin
|
||||
if FBorderColor <> Value then
|
||||
begin
|
||||
FBorderColor := Value;
|
||||
Repaint;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAuraNode.SetBorderRadius(const Value: Single);
|
||||
begin
|
||||
if FBorderRadius <> Value then
|
||||
begin
|
||||
FBorderRadius := Value;
|
||||
Repaint;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAuraNode.SetBorderWidth(const Value: Single);
|
||||
begin
|
||||
if FBorderWidth <> Value then
|
||||
begin
|
||||
FBorderWidth := Value;
|
||||
Repaint;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAuraNode.SetFrameless(const Value: Boolean);
|
||||
begin
|
||||
if FFrameless <> Value then
|
||||
begin
|
||||
FFrameless := Value;
|
||||
Repaint;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAuraNode.SetTitle(const Value: string);
|
||||
begin
|
||||
if FTitle <> Value then
|
||||
begin
|
||||
FTitle := Value;
|
||||
Repaint;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAuraNode.SetTitleFont(const Value: TFont);
|
||||
begin
|
||||
FTitleFont.Assign(Value);
|
||||
end;
|
||||
|
||||
procedure TAuraNode.SetTitleFontColor(const Value: TAlphaColor);
|
||||
begin
|
||||
if FTitleFontColor <> Value then
|
||||
begin
|
||||
FTitleFontColor := Value;
|
||||
Repaint;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAuraNode.TitleFontChanged(Sender: TObject);
|
||||
begin
|
||||
Repaint;
|
||||
end;
|
||||
|
||||
procedure TAuraNode.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||
begin
|
||||
inherited;
|
||||
if Button = TMouseButton.mbLeft then
|
||||
begin
|
||||
if ObjectAtPoint(LocalToScreen(TPointF.Create(X, Y))) = Self as IControl then
|
||||
begin
|
||||
FIsDragging := True;
|
||||
FDownPos := TPointF.Create(X, Y);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAuraNode.MouseMove(Shift: TShiftState; X, Y: Single);
|
||||
begin
|
||||
inherited;
|
||||
if FIsDragging then
|
||||
begin
|
||||
var deltaX := X - FDownPos.X;
|
||||
var deltaY := Y - FDownPos.Y;
|
||||
|
||||
Position.X := Position.X + deltaX;
|
||||
Position.Y := Position.Y + deltaY;
|
||||
|
||||
if ParentControl <> nil then
|
||||
ParentControl.Repaint;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAuraNode.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||
begin
|
||||
inherited;
|
||||
if (Button = TMouseButton.mbLeft) and (FIsDragging) then
|
||||
begin
|
||||
FIsDragging := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
+45
-33
@@ -21,7 +21,6 @@ uses
|
||||
FMX.ScrollBox,
|
||||
FMX.Memo,
|
||||
FMX.Controls.Presentation,
|
||||
DraggablePanel,
|
||||
Myc.Ast.Visualizer,
|
||||
Myc.Data.Scalar,
|
||||
Myc.Ast.Nodes,
|
||||
@@ -691,51 +690,55 @@ begin
|
||||
recordDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson(TypeInfo(TOHLCV)));
|
||||
series := TScalarRecordSeries.Create(recordDef);
|
||||
|
||||
// 2. Create the setup AST with O(1) SMA implementation
|
||||
// 2. Create the setup AST with the optimized O(1) SMA implementation
|
||||
setupAst :=
|
||||
TAst.Block(
|
||||
[
|
||||
// This factory is now much simpler. It only manages sum and a counter.
|
||||
TAst.VarDecl(
|
||||
TAst.Identifier('CreateSMA_O1'),
|
||||
TAst.Identifier('CreateSMA'),
|
||||
TAst.LambdaExpr(
|
||||
[TAst.Identifier('len')],
|
||||
TAst.Block(
|
||||
[
|
||||
TAst.VarDecl(TAst.Identifier('sum'), TAst.Constant(TScalar.FromDouble(0.0))),
|
||||
TAst.VarDecl(TAst.Identifier('values'), TAst.CreateSeries('double')),
|
||||
TAst.VarDecl(TAst.Identifier('count'), TAst.Constant(TScalar.FromInt64(0))),
|
||||
// The returned closure now takes the full series and the new value.
|
||||
TAst.LambdaExpr(
|
||||
[TAst.Identifier('val')],
|
||||
[TAst.Identifier('series'), TAst.Identifier('val')],
|
||||
TAst.Block(
|
||||
[
|
||||
TAst.Assign(
|
||||
TAst.Identifier('sum'),
|
||||
TAst.BinaryExpr(TAst.Identifier('sum'), boAdd, TAst.Identifier('val'))
|
||||
),
|
||||
TAst.Assign(
|
||||
TAst.Identifier('count'),
|
||||
TAst.BinaryExpr(TAst.Identifier('count'), boAdd, TAst.Constant(TScalar.FromInt64(1)))
|
||||
),
|
||||
// If the indicator is "full", subtract the value that just fell out of the window (at index 'len').
|
||||
TAst.IfExpr(
|
||||
TAst.BinaryExpr(
|
||||
TAst.SeriesLength(TAst.Identifier('values')),
|
||||
boGreaterOrEqual,
|
||||
TAst.Identifier('len')
|
||||
),
|
||||
TAst.BinaryExpr(TAst.Identifier('count'), boGreater, TAst.Identifier('len')),
|
||||
TAst.Assign(
|
||||
TAst.Identifier('sum'),
|
||||
TAst.BinaryExpr(
|
||||
TAst.Identifier('sum'),
|
||||
boSubtract,
|
||||
TAst.Indexer(
|
||||
TAst.Identifier('values'),
|
||||
TAst.BinaryExpr(
|
||||
TAst.Identifier('len'),
|
||||
boSubtract,
|
||||
TAst.Constant(TScalar.FromInt64(1))
|
||||
)
|
||||
)
|
||||
TAst.Indexer(TAst.Identifier('series'), TAst.Identifier('len'))
|
||||
)
|
||||
),
|
||||
nil
|
||||
),
|
||||
TAst.Assign(
|
||||
// Calculate and return the average. Divisor is capped at 'len'.
|
||||
TAst.BinaryExpr(
|
||||
TAst.Identifier('sum'),
|
||||
TAst.BinaryExpr(TAst.Identifier('sum'), boAdd, TAst.Identifier('val'))
|
||||
),
|
||||
TAst.AddSeriesItem(TAst.Identifier('values'), TAst.Identifier('val'), TAst.Identifier('len')),
|
||||
TAst.BinaryExpr(TAst.Identifier('sum'), boDivide, TAst.SeriesLength(TAst.Identifier('values')))
|
||||
boDivide,
|
||||
TAst.TernaryExpr(
|
||||
TAst.BinaryExpr(TAst.Identifier('count'), boLess, TAst.Identifier('len')),
|
||||
TAst.Identifier('count'),
|
||||
TAst.Identifier('len')
|
||||
)
|
||||
)
|
||||
]
|
||||
)
|
||||
)
|
||||
@@ -743,34 +746,43 @@ begin
|
||||
)
|
||||
)
|
||||
),
|
||||
// Instantiation remains the same.
|
||||
TAst.VarDecl(
|
||||
TAst.Identifier('smaFast'),
|
||||
TAst.FunctionCall(TAst.Identifier('CreateSMA_O1'), [TAst.Constant(TScalar.FromInt64(smaFastLength))])
|
||||
TAst.FunctionCall(TAst.Identifier('CreateSMA'), [TAst.Constant(TScalar.FromInt64(smaFastLength))])
|
||||
),
|
||||
TAst.VarDecl(
|
||||
TAst.Identifier('smaSlow'),
|
||||
TAst.FunctionCall(TAst.Identifier('CreateSMA_O1'), [TAst.Constant(TScalar.FromInt64(smaSlowLength))])
|
||||
TAst.FunctionCall(TAst.Identifier('CreateSMA'), [TAst.Constant(TScalar.FromInt64(smaSlowLength))])
|
||||
),
|
||||
// The main strategy now passes the full close series to the indicators.
|
||||
TAst.VarDecl(
|
||||
TAst.Identifier('maCrossStrategy'),
|
||||
TAst.LambdaExpr(
|
||||
[TAst.Identifier('ohlcv')],
|
||||
TAst.Block(
|
||||
[
|
||||
TAst.VarDecl(
|
||||
TAst.Identifier('closeSeries'),
|
||||
TAst.MemberAccess(TAst.Identifier('ohlcv'), TAst.Identifier('Close'))
|
||||
),
|
||||
TAst.VarDecl(
|
||||
TAst.Identifier('currentClose'),
|
||||
TAst.MemberAccess(
|
||||
TAst.Indexer(TAst.Identifier('ohlcv'), TAst.Constant(TScalar.FromInt64(0))),
|
||||
TAst.Identifier('Close')
|
||||
)
|
||||
TAst.Indexer(TAst.Identifier('closeSeries'), TAst.Constant(TScalar.FromInt64(0)))
|
||||
),
|
||||
TAst.VarDecl(
|
||||
TAst.Identifier('valSmaFast'),
|
||||
TAst.FunctionCall(TAst.Identifier('smaFast'), [TAst.Identifier('currentClose')])
|
||||
TAst.FunctionCall(
|
||||
TAst.Identifier('smaFast'),
|
||||
[TAst.Identifier('closeSeries'), TAst.Identifier('currentClose')]
|
||||
)
|
||||
),
|
||||
TAst.VarDecl(
|
||||
TAst.Identifier('valSmaSlow'),
|
||||
TAst.FunctionCall(TAst.Identifier('smaSlow'), [TAst.Identifier('currentClose')])
|
||||
TAst.FunctionCall(
|
||||
TAst.Identifier('smaSlow'),
|
||||
[TAst.Identifier('closeSeries'), TAst.Identifier('currentClose')]
|
||||
)
|
||||
),
|
||||
TAst.TernaryExpr(
|
||||
TAst.BinaryExpr(TAst.Identifier('valSmaFast'), boGreater, TAst.Identifier('valSmaSlow')),
|
||||
@@ -827,8 +839,8 @@ begin
|
||||
FGScope.SetValue('current_series', TAstValue.FromRecordSeries(series));
|
||||
resultValue := callAst.Accept(visitor);
|
||||
|
||||
// Memo1.Lines.Add(Format('Tick %d/%d: Close = %.2f, Signal = %s', [i, numRecs, ohlcvRec.Close, resultValue.ToString]));
|
||||
// Application.ProcessMessages;
|
||||
Memo1.Lines.Add(Format('Tick %d/%d: Close = %.2f, Signal = %s', [i, numRecs, ohlcvRec.Close, resultValue.ToString]));
|
||||
Application.ProcessMessages;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@@ -12,8 +12,7 @@ uses
|
||||
FMX.Controls,
|
||||
FMX.Objects,
|
||||
FMX.Graphics,
|
||||
Myc.Ast.Nodes,
|
||||
DraggablePanel;
|
||||
Myc.Ast.Nodes;
|
||||
|
||||
type
|
||||
TPinConnection = record
|
||||
@@ -28,7 +27,135 @@ type
|
||||
// New enum to select the visualization style.
|
||||
TVisualizationMode = (vmDetailed, vmControlFlow);
|
||||
|
||||
TAuraWorkspace = class;
|
||||
// A movable panel with a custom-painted border and title.
|
||||
TAuraNode = class(TStyledControl)
|
||||
private
|
||||
// Flag to indicate if the control is currently being dragged.
|
||||
FIsDragging: Boolean;
|
||||
// Stores the mouse coordinates at the beginning of the drag operation.
|
||||
FDownPos: TPointF;
|
||||
// Properties for the custom-drawn border.
|
||||
FBorderColor: TAlphaColor;
|
||||
FBorderWidth: Single;
|
||||
FBorderRadius: Single;
|
||||
// Properties for the title
|
||||
FTitle: string;
|
||||
FTitleFont: TFont;
|
||||
FTitleFontColor: TAlphaColor;
|
||||
// If true, the node is drawn without a border and with a transparent background.
|
||||
FFrameless: Boolean;
|
||||
|
||||
procedure SetBorderColor(const Value: TAlphaColor);
|
||||
procedure SetBorderWidth(const Value: Single);
|
||||
procedure SetBorderRadius(const Value: Single);
|
||||
procedure SetTitle(const Value: string);
|
||||
procedure SetTitleFont(const Value: TFont);
|
||||
procedure SetTitleFontColor(const Value: TAlphaColor);
|
||||
procedure TitleFontChanged(Sender: TObject);
|
||||
procedure SetFrameless(const Value: Boolean);
|
||||
protected
|
||||
procedure Paint; override;
|
||||
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
|
||||
procedure MouseMove(Shift: TShiftState; X, Y: Single); override;
|
||||
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
published
|
||||
// Custom border properties
|
||||
property BorderColor: TAlphaColor read FBorderColor write SetBorderColor;
|
||||
property BorderWidth: Single read FBorderWidth write SetBorderWidth;
|
||||
property BorderRadius: Single read FBorderRadius write SetBorderRadius;
|
||||
|
||||
// Title properties
|
||||
property Title: string read FTitle write SetTitle;
|
||||
property TitleFont: TFont read FTitleFont write SetTitleFont;
|
||||
property TitleFontColor: TAlphaColor read FTitleFontColor write SetTitleFontColor;
|
||||
|
||||
// Behavior properties
|
||||
property Frameless: Boolean read FFrameless write SetFrameless;
|
||||
|
||||
// Standard control properties
|
||||
property Align;
|
||||
property Anchors;
|
||||
property ClipChildren default True;
|
||||
property Cursor default crDefault;
|
||||
property DragMode default TDragMode.dmManual;
|
||||
property Enabled;
|
||||
property Height;
|
||||
property HelpContext;
|
||||
property HelpKeyword;
|
||||
property HelpType;
|
||||
property Hint;
|
||||
property HitTest default True;
|
||||
property Locked;
|
||||
property Margins;
|
||||
property Opacity;
|
||||
property Padding;
|
||||
property PopupMenu;
|
||||
property Position;
|
||||
property RotationAngle;
|
||||
property RotationCenter;
|
||||
property Scale;
|
||||
property Size;
|
||||
property StyleLookup;
|
||||
property Visible;
|
||||
property Width;
|
||||
property OnClick;
|
||||
property OnDblClick;
|
||||
property OnMouseDown;
|
||||
property OnMouseMove;
|
||||
property OnMouseUp;
|
||||
property OnMouseWheel;
|
||||
property OnMouseEnter;
|
||||
property OnMouseLeave;
|
||||
end;
|
||||
|
||||
TAuraWorkspace = class(TStyledControl)
|
||||
private
|
||||
FConnections: TArray<TPinConnection>;
|
||||
protected
|
||||
procedure Paint; override;
|
||||
procedure DoDeleteChildren; override;
|
||||
public
|
||||
procedure BuildTree(const Root: IAstNode; const Position: TPointF; AMode: TVisualizationMode);
|
||||
|
||||
published
|
||||
// Standard control properties
|
||||
property Align;
|
||||
property Anchors;
|
||||
property ClipChildren default True;
|
||||
property Cursor default crDefault;
|
||||
property DragMode default TDragMode.dmManual;
|
||||
property Enabled;
|
||||
property Height;
|
||||
property HelpContext;
|
||||
property HelpKeyword;
|
||||
property HelpType;
|
||||
property Hint;
|
||||
property HitTest default True;
|
||||
property Locked;
|
||||
property Margins;
|
||||
property Opacity;
|
||||
property Padding;
|
||||
property PopupMenu;
|
||||
property Position;
|
||||
property RotationAngle;
|
||||
property RotationCenter;
|
||||
property Scale;
|
||||
property Size;
|
||||
property StyleLookup;
|
||||
property Visible;
|
||||
property Width;
|
||||
property OnClick;
|
||||
property OnDblClick;
|
||||
property OnMouseDown;
|
||||
property OnMouseMove;
|
||||
property OnMouseUp;
|
||||
property OnMouseWheel;
|
||||
property OnMouseEnter;
|
||||
property OnMouseLeave;
|
||||
end;
|
||||
|
||||
TAstToAuraNodeVisitor = class(TInterfacedObject, IAstVisitor)
|
||||
public
|
||||
@@ -135,52 +262,6 @@ type
|
||||
function VisitSeriesLength(const Node: ISeriesLengthNode): TAstValue;
|
||||
end;
|
||||
|
||||
TAuraWorkspace = class(TStyledControl)
|
||||
private
|
||||
FConnections: TArray<TPinConnection>;
|
||||
protected
|
||||
procedure Paint; override;
|
||||
procedure DoDeleteChildren; override;
|
||||
public
|
||||
procedure BuildTree(const Root: IAstNode; const Position: TPointF; AMode: TVisualizationMode);
|
||||
|
||||
published
|
||||
// Standard control properties
|
||||
property Align;
|
||||
property Anchors;
|
||||
property ClipChildren default True;
|
||||
property Cursor default crDefault;
|
||||
property DragMode default TDragMode.dmManual;
|
||||
property Enabled;
|
||||
property Height;
|
||||
property HelpContext;
|
||||
property HelpKeyword;
|
||||
property HelpType;
|
||||
property Hint;
|
||||
property HitTest default True;
|
||||
property Locked;
|
||||
property Margins;
|
||||
property Opacity;
|
||||
property Padding;
|
||||
property PopupMenu;
|
||||
property Position;
|
||||
property RotationAngle;
|
||||
property RotationCenter;
|
||||
property Scale;
|
||||
property Size;
|
||||
property StyleLookup;
|
||||
property Visible;
|
||||
property Width;
|
||||
property OnClick;
|
||||
property OnDblClick;
|
||||
property OnMouseDown;
|
||||
property OnMouseMove;
|
||||
property OnMouseUp;
|
||||
property OnMouseWheel;
|
||||
property OnMouseEnter;
|
||||
property OnMouseLeave;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
@@ -192,7 +273,6 @@ type
|
||||
// This visitor converts an AST expression subtree into a single string.
|
||||
TAstToTextVisitor = class(TInterfacedObject, IAstVisitor)
|
||||
public
|
||||
constructor Create;
|
||||
{ IAstVisitor }
|
||||
function VisitConstant(const Node: IConstantNode): TAstValue;
|
||||
function VisitIdentifier(const Node: IIdentifierNode): TAstValue;
|
||||
@@ -212,11 +292,6 @@ type
|
||||
function VisitSeriesLength(const Node: ISeriesLengthNode): TAstValue;
|
||||
end;
|
||||
|
||||
constructor TAstToTextVisitor.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
end;
|
||||
|
||||
{ TAstToTextVisitor }
|
||||
|
||||
function TAstToTextVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TAstValue;
|
||||
@@ -376,6 +451,273 @@ begin
|
||||
InputPin := AInputPin;
|
||||
end;
|
||||
|
||||
{ TAuraNode }
|
||||
|
||||
constructor TAuraNode.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FIsDragging := False;
|
||||
|
||||
// Default border settings
|
||||
FBorderColor := TAlphaColors.Gray;
|
||||
FBorderWidth := 1;
|
||||
FBorderRadius := 9; // Sharp corners by default
|
||||
|
||||
// Default title settings
|
||||
FTitle := 'Node';
|
||||
FTitleFont := TFont.Create;
|
||||
FTitleFont.Family := 'Segoe UI';
|
||||
FTitleFont.Size := 11;
|
||||
FTitleFont.Style := [TFontStyle.fsBold];
|
||||
FTitleFont.OnChanged := TitleFontChanged;
|
||||
FTitleFontColor := TAlphaColors.Black;
|
||||
|
||||
// Default state for frameless mode
|
||||
FFrameless := False;
|
||||
|
||||
Width := 80;
|
||||
Height := 45;
|
||||
|
||||
// The panel must be able to receive mouse events.
|
||||
HitTest := True;
|
||||
// Clip children to the panel's bounds.
|
||||
ClipChildren := True;
|
||||
end;
|
||||
|
||||
destructor TAuraNode.Destroy;
|
||||
begin
|
||||
FTitleFont.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TAuraNode.Paint;
|
||||
var
|
||||
rect, titleRect: TRectF;
|
||||
effectiveBorderWidth: Single;
|
||||
begin
|
||||
inherited; // Allow styled painting to occur first (if any)
|
||||
|
||||
if FFrameless then
|
||||
begin
|
||||
Canvas.Fill.Kind := TBrushKind.Solid;
|
||||
Canvas.Fill.Color := $20C0C0C0; // Transparent Silver
|
||||
Canvas.Stroke.Kind := TBrushKind.None;
|
||||
|
||||
// In frameless mode, draw a transparent background and ignore the border.
|
||||
Canvas.FillRect(TRectF.Create(0, 0, Width, Height), 0, 0, [], 1.0);
|
||||
effectiveBorderWidth := 0;
|
||||
end
|
||||
else
|
||||
begin
|
||||
// Custom painting for the border
|
||||
if (FBorderWidth > 0) and (FBorderColor <> TAlphaColors.Null) then
|
||||
begin
|
||||
rect := TRectF.Create(0, 0, Width, Height);
|
||||
// Inflate inwards so the border is fully visible within the control's bounds
|
||||
rect.Inflate(-FBorderWidth / 2, -FBorderWidth / 2);
|
||||
|
||||
Canvas.Stroke.Kind := TBrushKind.Solid;
|
||||
Canvas.Stroke.Color := FBorderColor;
|
||||
Canvas.Stroke.Thickness := FBorderWidth;
|
||||
|
||||
if FFrameless then
|
||||
begin
|
||||
Canvas.Fill.Kind := TBrushKind.Solid;
|
||||
Canvas.Fill.Color := $20C0C0C0; // Transparent Silver
|
||||
Canvas.FillRect(rect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round);
|
||||
end
|
||||
else
|
||||
Canvas.DrawRect(rect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round);
|
||||
end;
|
||||
effectiveBorderWidth := FBorderWidth;
|
||||
end;
|
||||
|
||||
// Draw the title
|
||||
if not FTitle.IsEmpty then
|
||||
begin
|
||||
// Define the rectangle for the title at the top of the control
|
||||
titleRect := TRectF.Create(0, effectiveBorderWidth, Width, effectiveBorderWidth + FTitleFont.Size * 1.8);
|
||||
|
||||
Canvas.Font.Assign(FTitleFont);
|
||||
Canvas.Fill.Color := FTitleFontColor;
|
||||
|
||||
// Draw the text centered horizontally and vertically within the title rectangle
|
||||
Canvas.FillText(titleRect, FTitle, False, 1.0, [], TTextAlign.Center, TTextAlign.Center);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAuraNode.SetBorderColor(const Value: TAlphaColor);
|
||||
begin
|
||||
if FBorderColor <> Value then
|
||||
begin
|
||||
FBorderColor := Value;
|
||||
Repaint;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAuraNode.SetBorderRadius(const Value: Single);
|
||||
begin
|
||||
if FBorderRadius <> Value then
|
||||
begin
|
||||
FBorderRadius := Value;
|
||||
Repaint;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAuraNode.SetBorderWidth(const Value: Single);
|
||||
begin
|
||||
if FBorderWidth <> Value then
|
||||
begin
|
||||
FBorderWidth := Value;
|
||||
Repaint;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAuraNode.SetFrameless(const Value: Boolean);
|
||||
begin
|
||||
if FFrameless <> Value then
|
||||
begin
|
||||
FFrameless := Value;
|
||||
Repaint;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAuraNode.SetTitle(const Value: string);
|
||||
begin
|
||||
if FTitle <> Value then
|
||||
begin
|
||||
FTitle := Value;
|
||||
Repaint;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAuraNode.SetTitleFont(const Value: TFont);
|
||||
begin
|
||||
FTitleFont.Assign(Value);
|
||||
end;
|
||||
|
||||
procedure TAuraNode.SetTitleFontColor(const Value: TAlphaColor);
|
||||
begin
|
||||
if FTitleFontColor <> Value then
|
||||
begin
|
||||
FTitleFontColor := Value;
|
||||
Repaint;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAuraNode.TitleFontChanged(Sender: TObject);
|
||||
begin
|
||||
Repaint;
|
||||
end;
|
||||
|
||||
procedure TAuraNode.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||
begin
|
||||
inherited;
|
||||
if Button = TMouseButton.mbLeft then
|
||||
begin
|
||||
if ObjectAtPoint(LocalToScreen(TPointF.Create(X, Y))) = Self as IControl then
|
||||
begin
|
||||
FIsDragging := True;
|
||||
FDownPos := TPointF.Create(X, Y);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAuraNode.MouseMove(Shift: TShiftState; X, Y: Single);
|
||||
begin
|
||||
inherited;
|
||||
if FIsDragging then
|
||||
begin
|
||||
var deltaX := X - FDownPos.X;
|
||||
var deltaY := Y - FDownPos.Y;
|
||||
|
||||
Position.X := Position.X + deltaX;
|
||||
Position.Y := Position.Y + deltaY;
|
||||
|
||||
if ParentControl <> nil then
|
||||
ParentControl.Repaint;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAuraNode.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||
begin
|
||||
inherited;
|
||||
if (Button = TMouseButton.mbLeft) and (FIsDragging) then
|
||||
begin
|
||||
FIsDragging := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TAuraWorkspace }
|
||||
|
||||
procedure TAuraWorkspace.BuildTree(const Root: IAstNode; const Position: TPointF; AMode: TVisualizationMode);
|
||||
begin
|
||||
var connections := TList<TPinConnection>.Create;
|
||||
try
|
||||
Root.Accept(TAstToAuraNodeVisitor.Create(Self, Self, Position, connections, nil, AMode));
|
||||
FConnections := FConnections + connections.ToArray;
|
||||
finally
|
||||
connections.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAuraWorkspace.DoDeleteChildren;
|
||||
begin
|
||||
FConnections := nil;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TAuraWorkspace.Paint;
|
||||
var
|
||||
connection: TPinConnection;
|
||||
startPoint, endPoint, pinCenter: TPointF;
|
||||
path: TPathData;
|
||||
controlPoint1, controlPoint2: TPointF;
|
||||
controlOffset: Single;
|
||||
begin
|
||||
inherited;
|
||||
|
||||
Canvas.Stroke.Kind := TBrushKind.Solid;
|
||||
Canvas.Stroke.Thickness := 2;
|
||||
|
||||
// Go through all stored connections and draw them
|
||||
for connection in FConnections do
|
||||
begin
|
||||
// Get the absolute coordinates of the pin centers
|
||||
pinCenter := TPointF.Create(connection.OutputPin.Width / 2, connection.OutputPin.Height / 2);
|
||||
var absoluteStart := connection.OutputPin.LocalToAbsolute(pinCenter);
|
||||
|
||||
pinCenter := TPointF.Create(connection.InputPin.Width / 2, connection.InputPin.Height / 2);
|
||||
var absoluteEnd := connection.InputPin.LocalToAbsolute(pinCenter);
|
||||
|
||||
// Convert them to the local coordinates of the workspace
|
||||
startPoint := AbsoluteToLocal(absoluteStart);
|
||||
endPoint := AbsoluteToLocal(absoluteEnd);
|
||||
|
||||
var str := connection.InputPin.TagString;
|
||||
if Pos('data', str) = 0 then
|
||||
Canvas.Stroke.Color := TAstToAuraNodeVisitor.cExecPinColor
|
||||
else
|
||||
Canvas.Stroke.Color := TAstToAuraNodeVisitor.cDataPinColor;
|
||||
|
||||
// Draw a Bezier curve with horizontal tangents at start and end points.
|
||||
path := TPathData.Create;
|
||||
try
|
||||
controlOffset := max(25, 0.5 * endPoint.Distance(startPoint));
|
||||
|
||||
controlPoint1 := TPointF.Create(startPoint.X + controlOffset, startPoint.Y);
|
||||
controlPoint2 := TPointF.Create(endPoint.X - controlOffset, endPoint.Y);
|
||||
|
||||
path.MoveTo(startPoint);
|
||||
path.CurveTo(controlPoint1, controlPoint2, endPoint);
|
||||
|
||||
Canvas.DrawPath(path, 1.0);
|
||||
finally
|
||||
path.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TAstToAuraNodeVisitor }
|
||||
|
||||
constructor TAstToAuraNodeVisitor.Create(
|
||||
@@ -1432,74 +1774,4 @@ begin
|
||||
Result := TAstValue.Void;
|
||||
end;
|
||||
|
||||
{ TAuraWorkspace }
|
||||
|
||||
procedure TAuraWorkspace.BuildTree(const Root: IAstNode; const Position: TPointF; AMode: TVisualizationMode);
|
||||
begin
|
||||
var connections := TList<TPinConnection>.Create;
|
||||
try
|
||||
Root.Accept(TAstToAuraNodeVisitor.Create(Self, Self, Position, connections, nil, AMode));
|
||||
FConnections := FConnections + connections.ToArray;
|
||||
finally
|
||||
connections.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAuraWorkspace.DoDeleteChildren;
|
||||
begin
|
||||
FConnections := nil;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TAuraWorkspace.Paint;
|
||||
var
|
||||
connection: TPinConnection;
|
||||
startPoint, endPoint, pinCenter: TPointF;
|
||||
path: TPathData;
|
||||
controlPoint1, controlPoint2: TPointF;
|
||||
controlOffset: Single;
|
||||
begin
|
||||
inherited;
|
||||
|
||||
Canvas.Stroke.Kind := TBrushKind.Solid;
|
||||
Canvas.Stroke.Thickness := 2;
|
||||
|
||||
// Go through all stored connections and draw them
|
||||
for connection in FConnections do
|
||||
begin
|
||||
// Get the absolute coordinates of the pin centers
|
||||
pinCenter := TPointF.Create(connection.OutputPin.Width / 2, connection.OutputPin.Height / 2);
|
||||
var absoluteStart := connection.OutputPin.LocalToAbsolute(pinCenter);
|
||||
|
||||
pinCenter := TPointF.Create(connection.InputPin.Width / 2, connection.InputPin.Height / 2);
|
||||
var absoluteEnd := connection.InputPin.LocalToAbsolute(pinCenter);
|
||||
|
||||
// Convert them to the local coordinates of the workspace
|
||||
startPoint := AbsoluteToLocal(absoluteStart);
|
||||
endPoint := AbsoluteToLocal(absoluteEnd);
|
||||
|
||||
var str := connection.InputPin.TagString;
|
||||
if Pos('data', str) = 0 then
|
||||
Canvas.Stroke.Color := TAstToAuraNodeVisitor.cExecPinColor
|
||||
else
|
||||
Canvas.Stroke.Color := TAstToAuraNodeVisitor.cDataPinColor;
|
||||
|
||||
// Draw a Bezier curve with horizontal tangents at start and end points.
|
||||
path := TPathData.Create;
|
||||
try
|
||||
controlOffset := max(25, 0.5 * endPoint.Distance(startPoint));
|
||||
|
||||
controlPoint1 := TPointF.Create(startPoint.X + controlOffset, startPoint.Y);
|
||||
controlPoint2 := TPointF.Create(endPoint.X - controlOffset, endPoint.Y);
|
||||
|
||||
path.MoveTo(startPoint);
|
||||
path.CurveTo(controlPoint1, controlPoint2, endPoint);
|
||||
|
||||
Canvas.DrawPath(path, 1.0);
|
||||
finally
|
||||
path.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user