Ast control refactoring
This commit is contained in:
@@ -11,7 +11,10 @@ uses
|
|||||||
Myc.Fmx.AstEditor in 'Myc.Fmx.AstEditor.pas',
|
Myc.Fmx.AstEditor in 'Myc.Fmx.AstEditor.pas',
|
||||||
Myc.Ast.ViewModel in '..\Src\AST\Myc.Ast.ViewModel.pas',
|
Myc.Ast.ViewModel in '..\Src\AST\Myc.Ast.ViewModel.pas',
|
||||||
Myc.Data.Value in 'Myc.Data.Value.pas',
|
Myc.Data.Value in 'Myc.Data.Value.pas',
|
||||||
Myc.Ast.Debugger in '..\Src\AST\Myc.Ast.Debugger.pas';
|
Myc.Ast.Debugger in '..\Src\AST\Myc.Ast.Debugger.pas',
|
||||||
|
Myc.Fmx.AstEditor.Node in 'Myc.Fmx.AstEditor.Node.pas',
|
||||||
|
Myc.Fmx.AstEditor.Workspace in 'Myc.Fmx.AstEditor.Workspace.pas',
|
||||||
|
Myc.Fmx.AstEditor.Text in 'Myc.Fmx.AstEditor.Text.pas';
|
||||||
|
|
||||||
{$R *.res}
|
{$R *.res}
|
||||||
|
|
||||||
|
|||||||
@@ -143,6 +143,9 @@
|
|||||||
<DCCReference Include="..\Src\AST\Myc.Ast.ViewModel.pas"/>
|
<DCCReference Include="..\Src\AST\Myc.Ast.ViewModel.pas"/>
|
||||||
<DCCReference Include="Myc.Data.Value.pas"/>
|
<DCCReference Include="Myc.Data.Value.pas"/>
|
||||||
<DCCReference Include="..\Src\AST\Myc.Ast.Debugger.pas"/>
|
<DCCReference Include="..\Src\AST\Myc.Ast.Debugger.pas"/>
|
||||||
|
<DCCReference Include="Myc.Fmx.AstEditor.Node.pas"/>
|
||||||
|
<DCCReference Include="Myc.Fmx.AstEditor.Workspace.pas"/>
|
||||||
|
<DCCReference Include="Myc.Fmx.AstEditor.Text.pas"/>
|
||||||
<BuildConfiguration Include="Base">
|
<BuildConfiguration Include="Base">
|
||||||
<Key>Base</Key>
|
<Key>Base</Key>
|
||||||
</BuildConfiguration>
|
</BuildConfiguration>
|
||||||
@@ -198,6 +201,12 @@
|
|||||||
<Overwrite>true</Overwrite>
|
<Overwrite>true</Overwrite>
|
||||||
</Platform>
|
</Platform>
|
||||||
</DeployFile>
|
</DeployFile>
|
||||||
|
<DeployFile LocalName="Win64\Debug\ASTPlayground.rsm" Configuration="Debug" Class="DebugSymbols">
|
||||||
|
<Platform Name="Win64">
|
||||||
|
<RemoteName>ASTPlayground.rsm</RemoteName>
|
||||||
|
<Overwrite>true</Overwrite>
|
||||||
|
</Platform>
|
||||||
|
</DeployFile>
|
||||||
<DeployFile LocalName="Win64\Release\ASTPlayground.exe" Configuration="Release" Class="ProjectOutput">
|
<DeployFile LocalName="Win64\Release\ASTPlayground.exe" Configuration="Release" Class="ProjectOutput">
|
||||||
<Platform Name="Win64">
|
<Platform Name="Win64">
|
||||||
<RemoteName>ASTPlayground.exe</RemoteName>
|
<RemoteName>ASTPlayground.exe</RemoteName>
|
||||||
|
|||||||
@@ -22,6 +22,8 @@ uses
|
|||||||
FMX.Memo,
|
FMX.Memo,
|
||||||
FMX.Controls.Presentation,
|
FMX.Controls.Presentation,
|
||||||
Myc.Fmx.AstEditor,
|
Myc.Fmx.AstEditor,
|
||||||
|
Myc.Fmx.AstEditor.Node,
|
||||||
|
Myc.Fmx.AstEditor.Workspace,
|
||||||
Myc.Data.Scalar,
|
Myc.Data.Scalar,
|
||||||
Myc.Data.Value,
|
Myc.Data.Value,
|
||||||
Myc.Ast.Nodes,
|
Myc.Ast.Nodes,
|
||||||
|
|||||||
@@ -0,0 +1,303 @@
|
|||||||
|
unit Myc.Fmx.AstEditor.Node;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.SysUtils,
|
||||||
|
System.Classes,
|
||||||
|
System.UITypes,
|
||||||
|
System.Types,
|
||||||
|
System.Math.Vectors,
|
||||||
|
FMX.Types,
|
||||||
|
FMX.Controls,
|
||||||
|
FMX.Objects,
|
||||||
|
FMX.Graphics;
|
||||||
|
|
||||||
|
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);
|
||||||
|
Capture;
|
||||||
|
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
|
||||||
|
ReleaseCapture;
|
||||||
|
FIsDragging := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -0,0 +1,185 @@
|
|||||||
|
unit Myc.Fmx.AstEditor.Text;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.SysUtils,
|
||||||
|
Myc.Data.Value,
|
||||||
|
Myc.Data.Scalar,
|
||||||
|
Myc.Ast.Nodes;
|
||||||
|
|
||||||
|
type
|
||||||
|
// This visitor converts an AST expression subtree into a single string.
|
||||||
|
TAstToTextVisitor = class(TInterfacedObject, IAstVisitor)
|
||||||
|
public
|
||||||
|
{ IAstVisitor }
|
||||||
|
function VisitConstant(const Node: IConstantNode): TDataValue;
|
||||||
|
function VisitIdentifier(const Node: IIdentifierNode): TDataValue;
|
||||||
|
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
|
||||||
|
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
|
||||||
|
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
|
||||||
|
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
|
||||||
|
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
|
||||||
|
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
|
||||||
|
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
|
||||||
|
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
|
||||||
|
function VisitAssignment(const Node: IAssignmentNode): TDataValue;
|
||||||
|
function VisitIndexer(const Node: IIndexerNode): TDataValue;
|
||||||
|
function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
|
||||||
|
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
|
||||||
|
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
|
||||||
|
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ TAstToTextVisitor }
|
||||||
|
|
||||||
|
function TAstToTextVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
|
||||||
|
var
|
||||||
|
seriesStr, valueStr, lookbackStr: string;
|
||||||
|
begin
|
||||||
|
seriesStr := Node.Series.Accept(Self).AsText;
|
||||||
|
valueStr := Node.Value.Accept(Self).AsText;
|
||||||
|
lookbackStr := '';
|
||||||
|
if Assigned(Node.Lookback) then
|
||||||
|
lookbackStr := ', ' + Node.Lookback.Accept(Self).AsText;
|
||||||
|
Result := Format('%s.add(%s%s)', [seriesStr, valueStr, lookbackStr]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstToTextVisitor.VisitAssignment(const Node: IAssignmentNode): TDataValue;
|
||||||
|
begin
|
||||||
|
Result := Node.Identifier.Name + ' := ' + Node.Value.Accept(Self).AsText;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstToTextVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
|
||||||
|
begin
|
||||||
|
var leftStr := Node.Left.Accept(Self).AsText;
|
||||||
|
var rightStr := Node.Right.Accept(Self).AsText;
|
||||||
|
Result := '(' + leftStr + ' ' + Node.Operator.ToString + ' ' + rightStr + ')';
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstToTextVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
|
||||||
|
begin
|
||||||
|
Result := '{...}';
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstToTextVisitor.VisitConstant(const Node: IConstantNode): TDataValue;
|
||||||
|
begin
|
||||||
|
Result := Node.Value.ToString;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstToTextVisitor.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
|
||||||
|
begin
|
||||||
|
Result := 'new series(' + Node.Definition + ')';
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstToTextVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
sb: TStringBuilder;
|
||||||
|
calleeStr: string;
|
||||||
|
begin
|
||||||
|
calleeStr := Node.Callee.Accept(Self).AsText;
|
||||||
|
|
||||||
|
sb := TStringBuilder.Create;
|
||||||
|
try
|
||||||
|
sb.Append(calleeStr);
|
||||||
|
sb.Append('(');
|
||||||
|
for i := 0 to High(Node.Arguments) do
|
||||||
|
begin
|
||||||
|
sb.Append(Node.Arguments[i].Accept(Self).AsText);
|
||||||
|
if i < High(Node.Arguments) then
|
||||||
|
sb.Append(', ');
|
||||||
|
end;
|
||||||
|
sb.Append(')');
|
||||||
|
Result := sb.ToString;
|
||||||
|
finally
|
||||||
|
sb.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstToTextVisitor.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
|
||||||
|
begin
|
||||||
|
Result := Node.Name;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstToTextVisitor.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
|
||||||
|
begin
|
||||||
|
Result := Node.Condition.Accept(Self).AsText;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstToTextVisitor.VisitIndexer(const Node: IIndexerNode): TDataValue;
|
||||||
|
var
|
||||||
|
baseStr, indexStr: string;
|
||||||
|
begin
|
||||||
|
baseStr := Node.Base.Accept(Self).AsText;
|
||||||
|
indexStr := Node.Index.Accept(Self).AsText;
|
||||||
|
Result := Format('%s[%s]', [baseStr, indexStr]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstToTextVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
sb: TStringBuilder;
|
||||||
|
begin
|
||||||
|
sb := TStringBuilder.Create;
|
||||||
|
try
|
||||||
|
sb.Append(#$03BB + '(');
|
||||||
|
if Length(Node.Parameters) > 0 then
|
||||||
|
begin
|
||||||
|
for i := 0 to High(Node.Parameters) do
|
||||||
|
begin
|
||||||
|
sb.Append(Node.Parameters[i].Name);
|
||||||
|
if i < High(Node.Parameters) then
|
||||||
|
sb.Append(', ');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
sb.Append(') => {...}');
|
||||||
|
Result := sb.ToString;
|
||||||
|
finally
|
||||||
|
sb.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstToTextVisitor.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
|
||||||
|
var
|
||||||
|
baseStr: string;
|
||||||
|
begin
|
||||||
|
baseStr := Node.Base.Accept(Self).AsText;
|
||||||
|
Result := Format('%s.%s', [baseStr, Node.Member.Name]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstToTextVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
|
||||||
|
var
|
||||||
|
seriesStr: string;
|
||||||
|
begin
|
||||||
|
seriesStr := Node.Series.Accept(Self).AsText;
|
||||||
|
Result := Format('length(%s)', [seriesStr]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstToTextVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
|
||||||
|
begin
|
||||||
|
var condStr := Node.Condition.Accept(Self).AsText;
|
||||||
|
var thenStr := Node.ThenBranch.Accept(Self).AsText;
|
||||||
|
var elseStr := Node.ElseBranch.Accept(Self).AsText;
|
||||||
|
Result := Format('(%s ? %s : %s)', [condStr, thenStr, elseStr]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstToTextVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
|
||||||
|
begin
|
||||||
|
Result := Node.Operator.ToString + ' ' + Node.Right.Accept(Self).AsText;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstToTextVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
|
||||||
|
var
|
||||||
|
initStr: string;
|
||||||
|
begin
|
||||||
|
if Assigned(Node.Initializer) then
|
||||||
|
initStr := ' := ' + Node.Initializer.Accept(Self).AsText
|
||||||
|
else
|
||||||
|
initStr := '';
|
||||||
|
Result := 'var ' + Node.Identifier.Name + initStr;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -0,0 +1,245 @@
|
|||||||
|
unit Myc.Fmx.AstEditor.Workspace;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.SysUtils,
|
||||||
|
System.Classes,
|
||||||
|
System.Types,
|
||||||
|
System.UITypes,
|
||||||
|
System.Math.Vectors,
|
||||||
|
System.Generics.Collections,
|
||||||
|
FMX.Types,
|
||||||
|
FMX.Controls,
|
||||||
|
FMX.Graphics,
|
||||||
|
FMX.Objects,
|
||||||
|
Myc.Ast.Nodes;
|
||||||
|
|
||||||
|
type
|
||||||
|
TPinConnection = record
|
||||||
|
OutputPin: TControl;
|
||||||
|
InputPin: TControl;
|
||||||
|
constructor Create(AOutputPin, AInputPin: TControl);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Enum to select the visualization style.
|
||||||
|
TVisualizationMode = (vmDetailed, vmControlFlow);
|
||||||
|
|
||||||
|
TAuraWorkspace = class(TStyledControl)
|
||||||
|
private
|
||||||
|
FConnections: TArray<TPinConnection>;
|
||||||
|
FPanning: TSizeF;
|
||||||
|
FIsPanning: Boolean;
|
||||||
|
FLastPanPos: TPointF;
|
||||||
|
FZoom: Single;
|
||||||
|
protected
|
||||||
|
procedure Paint; override;
|
||||||
|
procedure DoDeleteChildren; 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;
|
||||||
|
procedure MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); override;
|
||||||
|
procedure DblClick; override;
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TComponent); override;
|
||||||
|
procedure BuildTree(const Root: IAstNode; const Position: TPointF; AMode: TVisualizationMode);
|
||||||
|
function GetChildrenMatrix(var Matrix: TMatrix; var Simple: Boolean): Boolean; override;
|
||||||
|
function Zoom(Factor: Single): Boolean;
|
||||||
|
|
||||||
|
published
|
||||||
|
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,
|
||||||
|
FMX.Platform,
|
||||||
|
Myc.Fmx.AstEditor;
|
||||||
|
|
||||||
|
{ TPinConnection }
|
||||||
|
|
||||||
|
constructor TPinConnection.Create(AOutputPin, AInputPin: TControl);
|
||||||
|
begin
|
||||||
|
OutputPin := AOutputPin;
|
||||||
|
InputPin := AInputPin;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TAuraWorkspace }
|
||||||
|
|
||||||
|
constructor TAuraWorkspace.Create(AOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
FZoom := 1.0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
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;
|
||||||
|
|
||||||
|
function TAuraWorkspace.GetChildrenMatrix(var Matrix: TMatrix; var Simple: Boolean): Boolean;
|
||||||
|
begin
|
||||||
|
Matrix := TMatrix.CreateScaling(FZoom, FZoom) * TMatrix.CreateTranslation(FPanning.cx, FPanning.cy);
|
||||||
|
Simple := (FZoom = 1.0) and (FPanning.cx = 0) and (FPanning.cy = 0);
|
||||||
|
Result := true;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TAuraWorkspace.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
if (Button = TMouseButton.mbLeft) and (ObjectAtPoint(LocalToScreen(TPointF.Create(X, Y))) = Self as IControl) then
|
||||||
|
begin
|
||||||
|
FIsPanning := True;
|
||||||
|
FLastPanPos := TPointF.Create(X, Y);
|
||||||
|
Cursor := crHandPoint;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TAuraWorkspace.MouseMove(Shift: TShiftState; X, Y: Single);
|
||||||
|
var
|
||||||
|
delta: TPointF;
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
|
||||||
|
if FIsPanning then
|
||||||
|
begin
|
||||||
|
delta := TPointF.Create(X - FLastPanPos.X, Y - FLastPanPos.Y);
|
||||||
|
FPanning.cx := FPanning.cx + delta.X;
|
||||||
|
FPanning.cy := FPanning.cy + delta.Y;
|
||||||
|
FLastPanPos := TPointF.Create(X, Y);
|
||||||
|
RecalcAbsolute;
|
||||||
|
RecalcUpdateRect;
|
||||||
|
Repaint;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TAuraWorkspace.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
if (Button = TMouseButton.mbLeft) and (FIsPanning) then
|
||||||
|
begin
|
||||||
|
FIsPanning := False;
|
||||||
|
Cursor := crDefault;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TAuraWorkspace.MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
Handled := Zoom(IfThen(WheelDelta > 0, FZoom * 1.1, FZoom / 1.1));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TAuraWorkspace.DblClick;
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
Zoom(1.0);
|
||||||
|
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;
|
||||||
|
|
||||||
|
for connection in FConnections do
|
||||||
|
begin
|
||||||
|
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);
|
||||||
|
|
||||||
|
startPoint := AbsoluteToLocal(absoluteStart);
|
||||||
|
endPoint := AbsoluteToLocal(absoluteEnd);
|
||||||
|
|
||||||
|
var str := connection.InputPin.TagString;
|
||||||
|
if Pos('data', str) = 0 then
|
||||||
|
Canvas.Stroke.Color := cExecPinColor
|
||||||
|
else
|
||||||
|
Canvas.Stroke.Color := cDataPinColor;
|
||||||
|
|
||||||
|
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;
|
||||||
|
|
||||||
|
function TAuraWorkspace.Zoom(Factor: Single): Boolean;
|
||||||
|
var
|
||||||
|
MouseService: IFMXMouseService;
|
||||||
|
begin
|
||||||
|
Result := TPlatformServices.Current.SupportsPlatformService(IFMXMouseService, MouseService);
|
||||||
|
if Result then
|
||||||
|
begin
|
||||||
|
var MousePos := ScreenToLocal(MouseService.GetMousePos);
|
||||||
|
Factor := Max(0.2, Min(3.0, Factor));
|
||||||
|
FPanning.cx := MousePos.X * (1 - Factor / FZoom) + FPanning.cx * (Factor / FZoom);
|
||||||
|
FPanning.cy := MousePos.Y * (1 - Factor / FZoom) + FPanning.cy * (Factor / FZoom);
|
||||||
|
FZoom := Factor;
|
||||||
|
RecalcAbsolute;
|
||||||
|
RecalcUpdateRect;
|
||||||
|
Repaint;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
File diff suppressed because it is too large
Load Diff
Reference in New Issue
Block a user