Ast editor unit refactoring

This commit is contained in:
Michael Schimmel
2025-11-28 13:45:33 +01:00
parent 13b2ef3bf0
commit 833ce8aada
11 changed files with 2063 additions and 2643 deletions
File diff suppressed because one or more lines are too long
+5 -4
View File
@@ -12,9 +12,6 @@ uses
Myc.Ast.RTL in '..\Src\AST\Myc.Ast.RTL.pas', Myc.Ast.RTL in '..\Src\AST\Myc.Ast.RTL.pas',
Myc.Ast.Dumper in '..\Src\AST\Myc.Ast.Dumper.pas', Myc.Ast.Dumper in '..\Src\AST\Myc.Ast.Dumper.pas',
Myc.Ast.RTL.Core in '..\Src\AST\Myc.Ast.RTL.Core.pas', Myc.Ast.RTL.Core in '..\Src\AST\Myc.Ast.RTL.Core.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',
Myc.Utils in '..\Src\Myc.Utils.pas', Myc.Utils in '..\Src\Myc.Utils.pas',
Myc.Ast.Script in '..\Src\AST\Myc.Ast.Script.pas', Myc.Ast.Script in '..\Src\AST\Myc.Ast.Script.pas',
Myc.Ast.Types in '..\Src\AST\Myc.Ast.Types.pas', Myc.Ast.Types in '..\Src\AST\Myc.Ast.Types.pas',
@@ -28,7 +25,11 @@ uses
Myc.Ast.Environment in '..\Src\AST\Myc.Ast.Environment.pas', Myc.Ast.Environment in '..\Src\AST\Myc.Ast.Environment.pas',
Myc.Ast.Debugger in '..\Src\AST\Myc.Ast.Debugger.pas', Myc.Ast.Debugger in '..\Src\AST\Myc.Ast.Debugger.pas',
Myc.Ast.Analysis.Purity in '..\Src\AST\Myc.Ast.Analysis.Purity.pas', Myc.Ast.Analysis.Purity in '..\Src\AST\Myc.Ast.Analysis.Purity.pas',
Myc.Ast.Identities in '..\Src\AST\Myc.Ast.Identities.pas'; Myc.Ast.Identities in '..\Src\AST\Myc.Ast.Identities.pas',
Myc.Fmx.AstEditor.Core in '..\Src\AST\Myc.Fmx.AstEditor.Core.pas',
Myc.Fmx.AstEditor.Handlers in '..\Src\AST\Myc.Fmx.AstEditor.Handlers.pas',
Myc.Fmx.AstEditor.Visualizer in '..\Src\AST\Myc.Fmx.AstEditor.Visualizer.pas',
Myc.Fmx.AstEditor.Workspace in '..\Src\AST\Myc.Fmx.AstEditor.Workspace.pas';
{$R *.res} {$R *.res}
+4 -3
View File
@@ -142,9 +142,6 @@
<DCCReference Include="..\Src\AST\Myc.Ast.RTL.pas"/> <DCCReference Include="..\Src\AST\Myc.Ast.RTL.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Dumper.pas"/> <DCCReference Include="..\Src\AST\Myc.Ast.Dumper.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.RTL.Core.pas"/> <DCCReference Include="..\Src\AST\Myc.Ast.RTL.Core.pas"/>
<DCCReference Include="Myc.Fmx.AstEditor.Node.pas"/>
<DCCReference Include="Myc.Fmx.AstEditor.Workspace.pas"/>
<DCCReference Include="Myc.Fmx.AstEditor.Text.pas"/>
<DCCReference Include="..\Src\Myc.Utils.pas"/> <DCCReference Include="..\Src\Myc.Utils.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Script.pas"/> <DCCReference Include="..\Src\AST\Myc.Ast.Script.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Types.pas"/> <DCCReference Include="..\Src\AST\Myc.Ast.Types.pas"/>
@@ -159,6 +156,10 @@
<DCCReference Include="..\Src\AST\Myc.Ast.Debugger.pas"/> <DCCReference Include="..\Src\AST\Myc.Ast.Debugger.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Analysis.Purity.pas"/> <DCCReference Include="..\Src\AST\Myc.Ast.Analysis.Purity.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Identities.pas"/> <DCCReference Include="..\Src\AST\Myc.Ast.Identities.pas"/>
<DCCReference Include="..\Src\AST\Myc.Fmx.AstEditor.Core.pas"/>
<DCCReference Include="..\Src\AST\Myc.Fmx.AstEditor.Handlers.pas"/>
<DCCReference Include="..\Src\AST\Myc.Fmx.AstEditor.Visualizer.pas"/>
<DCCReference Include="..\Src\AST\Myc.Fmx.AstEditor.Workspace.pas"/>
<BuildConfiguration Include="Base"> <BuildConfiguration Include="Base">
<Key>Base</Key> <Key>Base</Key>
</BuildConfiguration> </BuildConfiguration>
+1 -1
View File
@@ -32,7 +32,7 @@ uses
Myc.Ast.Script, Myc.Ast.Script,
FMX.Layouts, FMX.Layouts,
FMX.Objects, FMX.Objects,
Myc.Fmx.AstEditor.Node, Myc.Fmx.AstEditor.Core,
Myc.Fmx.AstEditor.Workspace, Myc.Fmx.AstEditor.Workspace,
FMX.DialogService, FMX.DialogService,
FMX.ListView.Types, FMX.ListView.Types,
File diff suppressed because it is too large Load Diff
-265
View File
@@ -1,265 +0,0 @@
unit Myc.Fmx.AstEditor.Text;
interface
uses
System.SysUtils,
Myc.Data.Value,
Myc.Data.Scalar,
Myc.Ast.Visitor,
Myc.Ast.Nodes;
type
// This visitor converts an AST expression subtree into a single string.
// It inherits from the generic visitor, returning a 'string' for each node.
TAstToTextVisitor = class(TAstVisitor<string>)
protected
function VisitConstant(const Node: IConstantNode): string; override;
function VisitIdentifier(const Node: IIdentifierNode): string; override;
function VisitKeyword(const Node: IKeywordNode): string; override;
function VisitIfExpression(const Node: IIfExpressionNode): string; override;
function VisitTernaryExpression(const Node: ITernaryExpressionNode): string; override;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): string; override;
function VisitMacroDefinition(const Node: IMacroDefinitionNode): string; override;
function VisitFunctionCall(const Node: IFunctionCallNode): string; override;
function VisitMacroExpansionNode(const Node: IMacroExpansionNode): string; override;
function VisitBlockExpression(const Node: IBlockExpressionNode): string; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): string; override;
function VisitAssignment(const Node: IAssignmentNode): string; override;
function VisitIndexer(const Node: IIndexerNode): string; override;
function VisitMemberAccess(const Node: IMemberAccessNode): string; override;
function VisitQuasiquote(const Node: IQuasiquoteNode): string; override;
function VisitUnquote(const Node: IUnquoteNode): string; override;
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): string; override;
function VisitCreateSeries(const Node: ICreateSeriesNode): string; override;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): string; override;
function VisitSeriesLength(const Node: ISeriesLengthNode): string; override;
function VisitRecurNode(const Node: IRecurNode): string; override;
function VisitRecordLiteral(const Node: IRecordLiteralNode): string; override;
end;
implementation
uses
System.Classes, // For TStringBuilder
Myc.Data.Keyword;
{ TAstToTextVisitor }
function TAstToTextVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): string;
var
seriesStr, valueStr, lookbackStr: string;
begin
seriesStr := Accept(Node.Series);
valueStr := Accept(Node.Value);
lookbackStr := '';
if Assigned(Node.Lookback) then
lookbackStr := ', ' + Accept(Node.Lookback);
Result := Format('%s.add(%s%s)', [seriesStr, valueStr, lookbackStr]);
end;
function TAstToTextVisitor.VisitAssignment(const Node: IAssignmentNode): string;
begin
Result := Accept(Node.Target) + ' := ' + Accept(Node.Value);
end;
function TAstToTextVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): string;
begin
Result := '{...}';
end;
function TAstToTextVisitor.VisitConstant(const Node: IConstantNode): string;
begin
Result := Node.Value.ToString;
end;
function TAstToTextVisitor.VisitCreateSeries(const Node: ICreateSeriesNode): string;
begin
Result := 'new series(' + Node.Definition + ')';
end;
function TAstToTextVisitor.VisitFunctionCall(const Node: IFunctionCallNode): string;
var
i: Integer;
sb: TStringBuilder;
calleeStr: string;
begin
calleeStr := Accept(Node.Callee);
sb := TStringBuilder.Create;
try
sb.Append(calleeStr);
sb.Append('(');
for i := 0 to High(Node.Arguments) do
begin
sb.Append(Accept(Node.Arguments[i]));
if i < High(Node.Arguments) then
sb.Append(', ');
end;
sb.Append(')');
Result := sb.ToString;
finally
sb.Free;
end;
end;
function TAstToTextVisitor.VisitMacroExpansionNode(const Node: IMacroExpansionNode): string;
begin
// To represent a macro expansion as a single line of text, the most
// informative representation is the original call itself. We can simply
// delegate to the VisitFunctionCall implementation to format it.
Result := VisitFunctionCall(Node.CallNode);
end;
function TAstToTextVisitor.VisitRecurNode(const Node: IRecurNode): string;
var
i: Integer;
sb: TStringBuilder;
begin
sb := TStringBuilder.Create;
try
sb.Append('recur(');
for i := 0 to High(Node.Arguments) do
begin
sb.Append(Accept(Node.Arguments[i]));
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): string;
begin
Result := Node.Name;
end;
function TAstToTextVisitor.VisitIfExpression(const Node: IIfExpressionNode): string;
begin
Result := Accept(Node.Condition);
end;
function TAstToTextVisitor.VisitIndexer(const Node: IIndexerNode): string;
var
baseStr, indexStr: string;
begin
baseStr := Accept(Node.Base);
indexStr := Accept(Node.Index);
Result := Format('%s[%s]', [baseStr, indexStr]);
end;
function TAstToTextVisitor.VisitKeyword(const Node: IKeywordNode): string;
begin
Result := ':' + Node.Value.Name;
end;
function TAstToTextVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): string;
var
i: Integer;
sb: TStringBuilder;
begin
sb := TStringBuilder.Create;
try
sb.Append(WideChar($03BB) + '('); // Lambda char
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.VisitMacroDefinition(const Node: IMacroDefinitionNode): string;
var
i: Integer;
sb: TStringBuilder;
begin
// Added text representation for macro definitions.
sb := TStringBuilder.Create;
try
sb.Append('defmacro ');
sb.Append(Node.Name.Name);
sb.Append('(');
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): string;
var
baseStr: string;
begin
baseStr := Accept(Node.Base);
Result := Format('%s.%s', [baseStr, Node.Member.Value.Name]);
end;
function TAstToTextVisitor.VisitQuasiquote(const Node: IQuasiquoteNode): string;
begin
Result := '`' + Accept(Node.Expression);
end;
function TAstToTextVisitor.VisitRecordLiteral(const Node: IRecordLiteralNode): string;
begin
Result := '{...}';
end;
function TAstToTextVisitor.VisitUnquote(const Node: IUnquoteNode): string;
begin
Result := '~' + Accept(Node.Expression);
end;
function TAstToTextVisitor.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): string;
begin
Result := '~@' + Accept(Node.Expression);
end;
function TAstToTextVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): string;
var
seriesStr: string;
begin
seriesStr := Accept(Node.Series);
Result := Format('length(%s)', [seriesStr]);
end;
function TAstToTextVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): string;
begin
var condStr := Accept(Node.Condition);
var thenStr := Accept(Node.ThenBranch);
var elseStr := Accept(Node.ElseBranch);
Result := Format('(%s ? %s : %s)', [condStr, thenStr, elseStr]);
end;
function TAstToTextVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): string;
var
initStr: string;
begin
if Assigned(Node.Initializer) then
initStr := ' := ' + Accept(Node.Initializer)
else
initStr := '';
Result := 'var ' + Accept(Node.Target) + initStr;
end;
end.
+706
View File
@@ -0,0 +1,706 @@
unit Myc.Fmx.AstEditor.Core;
interface
uses
System.SysUtils,
System.Classes,
System.UITypes,
System.Types,
System.Math,
System.Math.Vectors,
System.Generics.Defaults,
System.Generics.Collections,
FMX.Types,
FMX.Controls,
FMX.Objects,
FMX.Graphics,
FMX.StdCtrls,
Myc.Ast.Nodes,
Myc.Fmx.AstEditor.Workspace;
const
cNodePadding = 10;
cTitleTopPadding = 2;
cTitleBottomPadding = 4;
cMinNodeWidth = 10;
cMinNodeHeight = 10;
type
TAuraNode = class; // Forward declaration
// This aggregate interface encapsulates all node-specific logic.
IAuraNodeHandler = interface
// Gets the original logical AST node
function GetAstNode: IAstNode;
// Creates the specific FMX UI for this node
procedure BuildUI(OwnerNode: TAuraNode);
// Reconstructs the logical AST node from the FMX UI state
function ReconstructAst(OwnerNode: TAuraNode): IAstNode;
// The original logical AST node
property Node: IAstNode read GetAstNode;
end;
IAstVisualizer = interface
{$region 'private'}
function GetExprDepth: Integer;
function GetParentControl: TControl;
function GetWorkspace: TAuraWorkspace;
{$endregion}
function Clone(ParentControl: TControl; ExprDepth: Integer): IAstVisualizer;
function CallAccept(const Node: IAstNode): TAuraNode;
property ExprDepth: Integer read GetExprDepth;
property ParentControl: TControl read GetParentControl;
property Workspace: TAuraWorkspace read GetWorkspace;
end;
// Defines the layout direction for children within TAutoFitControl
TLayoutOrientation = (loVertical, loHorizontal);
// Defines the alignment of children on the cross-axis
TLayoutAlignment = (laCenter, laFlush);
// A styled control that automatically adjusts its size to fit its children, including padding.
TAutoFitControl = class(TStyledControl)
private
FUpdatingOwnSize: Boolean; // Recursion guard
FNeedRecalcSize: Boolean; // Flag for EndUpdate
FOrientation: TLayoutOrientation; // Storage for Orientation
FAlignment: TLayoutAlignment; // Storage for Alignment
procedure RecalcOwnSize;
procedure SetOrientation(const Value: TLayoutOrientation);
procedure SetAlignment(const Value: TLayoutAlignment);
protected
procedure ParentContentChanged; override;
procedure PaddingChanged; override;
procedure ChangeChildren; override;
procedure Loaded; override;
procedure DoEndUpdate; override;
public
constructor Create(AOwner: TComponent); override;
published
property Padding;
property Orientation: TLayoutOrientation read FOrientation write SetOrientation default TLayoutOrientation.loHorizontal;
property Alignment: TLayoutAlignment read FAlignment write SetAlignment default TLayoutAlignment.laCenter;
end;
// A movable panel with a custom-painted border. Content (like title) is added externally.
TAuraNode = class(TAutoFitControl)
private
FBackgroundColor: TAlphaColor;
FIsDragging: Boolean;
FDownPos: TPointF;
FBorderColor: TAlphaColor;
FBorderWidth: Single;
FBorderRadius: Single;
FFrameless: Boolean;
FVisualizer: IAstVisualizer;
FHandler: IAuraNodeHandler;
// --- Visual State Fields ---
FErrorMessage: string;
FTypeInfoText: string;
procedure SetBackgroundColor(const Value: TAlphaColor);
procedure SetBorderColor(const Value: TAlphaColor);
procedure SetBorderWidth(const Value: Single);
procedure SetBorderRadius(const Value: Single);
procedure SetFrameless(const Value: Boolean);
function GetNode: IAstNode;
// New Setters
procedure SetErrorMessage(const Value: string);
procedure SetTypeInfoText(const Value: string);
procedure UpdateVisualState;
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;
procedure SetupNode;
public
constructor Create(const AVisualizer: IAstVisualizer; const AHandler: IAuraNodeHandler); reintroduce;
destructor Destroy; override;
procedure AfterConstruction; override;
function AddLabel(Parent: TControl; const Txt: String): TLabel;
function AddContainer(Parent: TControl; Orientation: TLayoutOrientation; Alignment: TLayoutAlignment): TAutoFitControl;
function AddExpr(Parent: TControl; const Title: String; const Node: IAstNode): TAuraNode;
function CreateAst: IAstNode;
property Visualizer: IAstVisualizer read FVisualizer;
property Node: IAstNode read GetNode;
// --- Visual State Properties ---
property ErrorMessage: string read FErrorMessage write SetErrorMessage;
property TypeInfoText: string read FTypeInfoText write SetTypeInfoText;
published
property BorderColor: TAlphaColor read FBorderColor write SetBorderColor;
property BorderWidth: Single read FBorderWidth write SetBorderWidth;
property BorderRadius: Single read FBorderRadius write SetBorderRadius;
property BackgroundColor: TAlphaColor read FBackgroundColor write SetBackgroundColor;
property Frameless: Boolean read FFrameless write SetFrameless;
property Align;
property Anchors;
property ClipChildren default True;
property Cursor default crDefault;
property DragMode default TDragMode.dmManual;
property Enabled;
property Height;
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 Visible;
property Width;
property OnClick;
property OnDblClick;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseEnter;
property OnMouseLeave;
end;
// Helper base class to reduce boilerplate in specific handlers
TBaseNodeHandler<T: IAstNode> = class(TInterfacedObject, IAuraNodeHandler)
protected
FNode: T;
function GetAstNode: IAstNode;
public
constructor Create(const ANode: T);
procedure BuildUI(OwnerNode: TAuraNode); virtual; abstract;
function ReconstructAst(OwnerNode: TAuraNode): IAstNode; virtual; abstract;
end;
implementation
uses
Myc.Ast;
{ TAutoFitControl }
constructor TAutoFitControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
HitTest := True;
FOrientation := TLayoutOrientation.loHorizontal;
FAlignment := TLayoutAlignment.laCenter;
end;
procedure TAutoFitControl.SetAlignment(const Value: TLayoutAlignment);
begin
if FAlignment <> Value then
begin
FAlignment := Value;
RecalcOwnSize;
end;
end;
procedure TAutoFitControl.SetOrientation(const Value: TLayoutOrientation);
begin
if FOrientation <> Value then
begin
FOrientation := Value;
RecalcOwnSize;
end;
end;
procedure TAutoFitControl.RecalcOwnSize;
var
i: Integer;
child: TControl;
childrenToLayout: TList<TControl>;
currentX, currentY: Single;
requiredWidth, requiredHeight: Single;
childWidthWithMargins, childHeightWithMargins: Single;
hasVisibleChild: Boolean;
begin
if FUpdatingOwnSize then
exit;
if IsUpdating then
begin
FNeedRecalcSize := True;
exit;
end;
FUpdatingOwnSize := True;
childrenToLayout := nil;
try
requiredWidth := Padding.Left + Padding.Right;
requiredHeight := Padding.Top + Padding.Bottom;
currentX := Padding.Left;
currentY := Padding.Top;
hasVisibleChild := False;
childrenToLayout := TList<TControl>.Create;
for i := 0 to ChildrenCount - 1 do
begin
if Children[i] is TControl then
begin
child := TControl(Children[i]);
if child.Visible and (child.Align = TAlignLayout.None) then
begin
childrenToLayout.Add(child);
hasVisibleChild := True;
end;
end;
end;
if hasVisibleChild then
begin
if FOrientation = TLayoutOrientation.loVertical then
begin
for child in childrenToLayout do
begin
child.Position.Y := currentY + child.Margins.Top;
currentY := child.Position.Y + child.Height + child.Margins.Bottom;
childWidthWithMargins := Padding.Left + child.Margins.Left + child.Width + child.Margins.Right + Padding.Right;
requiredWidth := System.Math.Max(requiredWidth, childWidthWithMargins);
end;
requiredHeight := currentY + Padding.Bottom;
if FAlignment = TLayoutAlignment.laFlush then
begin
for child in childrenToLayout do
begin
child.Position.X := Padding.Left + child.Margins.Left;
end;
end
else
begin
var contentWidth := requiredWidth - Padding.Left - Padding.Right;
for child in childrenToLayout do
begin
var childTotalWidth := child.Width + child.Margins.Left + child.Margins.Right;
var childX := Padding.Left + ((contentWidth - childTotalWidth) / 2) + child.Margins.Left;
child.Position.X := childX;
end;
end;
end
else
begin
for child in childrenToLayout do
begin
child.Position.X := currentX + child.Margins.Left;
currentX := child.Position.X + child.Width + child.Margins.Right;
childHeightWithMargins := Padding.Top + child.Margins.Top + child.Height + child.Margins.Bottom + Padding.Bottom;
requiredHeight := System.Math.Max(requiredHeight, childHeightWithMargins);
end;
requiredWidth := currentX + Padding.Right;
if FAlignment = TLayoutAlignment.laFlush then
begin
for child in childrenToLayout do
begin
child.Position.Y := Padding.Top + child.Margins.Top;
end;
end
else
begin
var contentHeight := requiredHeight - Padding.Top - Padding.Bottom;
for child in childrenToLayout do
begin
var childTotalHeight := child.Height + child.Margins.Top + child.Margins.Bottom;
var childY := Padding.Top + ((contentHeight - childTotalHeight) / 2) + child.Margins.Top;
child.Position.Y := childY;
end;
end;
end;
end
else
begin
requiredWidth := Padding.Left + Padding.Right;
requiredHeight := Padding.Top + Padding.Bottom;
end;
requiredWidth := System.Math.Max(0, requiredWidth);
requiredHeight := System.Math.Max(0, requiredHeight);
if not SameValue(requiredWidth, Width, TEpsilon.Position) or not SameValue(requiredHeight, Height, TEpsilon.Position) then
begin
FSize.SetSizeWithoutNotification(TSizeF.Create(requiredWidth, requiredHeight));
HandleSizeChanged;
end;
finally
childrenToLayout.Free;
FUpdatingOwnSize := False;
end;
end;
procedure TAutoFitControl.Loaded;
begin
inherited Loaded;
RecalcOwnSize;
end;
procedure TAutoFitControl.ChangeChildren;
begin
inherited ChangeChildren;
RecalcOwnSize;
end;
procedure TAutoFitControl.PaddingChanged;
begin
inherited PaddingChanged;
RecalcOwnSize;
end;
procedure TAutoFitControl.ParentContentChanged;
begin
inherited ParentContentChanged;
RecalcOwnSize;
end;
procedure TAutoFitControl.DoEndUpdate;
begin
inherited;
if FNeedRecalcSize then
begin
FNeedRecalcSize := False;
RecalcOwnSize;
end;
end;
{ TAuraNode }
constructor TAuraNode.Create(const AVisualizer: IAstVisualizer; const AHandler: IAuraNodeHandler);
begin
inherited Create(AVisualizer.Workspace);
Parent := AVisualizer.ParentControl;
FVisualizer := AVisualizer.Clone(Self, AVisualizer.ExprDepth);
FHandler := AHandler;
FIsDragging := False;
FBorderColor := TAlphaColors.Gray;
FBorderWidth := 1;
FBorderRadius := 9;
FBackgroundColor := $080a0a0a;
FFrameless := False;
Width := cMinNodeWidth;
Height := cMinNodeHeight;
HitTest := True;
ClipChildren := True;
Margins.Left := 4;
Margins.Top := 4;
Margins.Right := 4;
Margins.Bottom := 4;
Padding.Left := 3;
Padding.Top := 3;
Padding.Right := 3;
Padding.Bottom := 3;
var cn: Cardinal := $ea - (7 * FVisualizer.ExprDepth);
var c: Cardinal := $ff000000 or (cn shl 16) or (cn shl 8) or cn;
BackgroundColor := c;
end;
destructor TAuraNode.Destroy;
begin
FHandler := nil;
inherited;
end;
function TAuraNode.AddContainer(Parent: TControl; Orientation: TLayoutOrientation; Alignment: TLayoutAlignment): TAutoFitControl;
begin
Result := TAutoFitControl.Create(Self);
Result.Parent := Parent;
Result.Orientation := Orientation;
Result.Alignment := Alignment;
Result.HitTest := False;
end;
function TAuraNode.AddExpr(Parent: TControl; const Title: String; const Node: IAstNode): TAuraNode;
begin
var cont := AddContainer(Parent, loHorizontal, laCenter);
var lbl := AddLabel(cont, Title);
lbl.Font.Style := lbl.Font.Style + [TFontStyle.fsBold];
Result := FVisualizer.Clone(cont, FVisualizer.ExprDepth + 1).CallAccept(Node);
end;
function TAuraNode.AddLabel(Parent: TControl; const Txt: String): TLabel;
begin
Result := TLabel.Create(Self);
Result.Parent := Parent;
Result.Position.Point := TPoint.Create(cNodePadding, cNodePadding);
Result.Margins.Left := cNodePadding;
Result.Margins.Right := cNodePadding;
Result.Margins.Top := cTitleTopPadding;
Result.Margins.Bottom := cTitleBottomPadding;
Result.WordWrap := False;
Result.AutoSize := True;
Result.HitTest := False;
Result.StyledSettings := Result.StyledSettings - [TStyledSetting.Style];
Result.Text := Txt;
Result.ApplyStyleLookup;
end;
procedure TAuraNode.AfterConstruction;
begin
inherited;
SetupNode;
end;
function TAuraNode.CreateAst: IAstNode;
begin
if Assigned(FHandler) then
Result := FHandler.ReconstructAst(Self)
else
Result := TAst.Nop;
end;
function TAuraNode.GetNode: IAstNode;
begin
if Assigned(FHandler) then
Result := FHandler.Node
else
Result := nil;
end;
procedure TAuraNode.SetErrorMessage(const Value: string);
begin
if FErrorMessage <> Value then
begin
FErrorMessage := Value;
UpdateVisualState;
Repaint;
end;
end;
procedure TAuraNode.SetTypeInfoText(const Value: string);
begin
if FTypeInfoText <> Value then
begin
FTypeInfoText := Value;
UpdateVisualState;
// Type Info usually doesn't change painting, just hint
end;
end;
procedure TAuraNode.UpdateVisualState;
begin
if FErrorMessage <> '' then
begin
Hint := 'Error: ' + FErrorMessage;
ShowHint := True;
end
else if FTypeInfoText <> '' then
begin
Hint := 'Type: ' + FTypeInfoText;
ShowHint := True;
end
else
begin
Hint := '';
ShowHint := False;
end;
end;
procedure TAuraNode.Paint;
var
rect: TRectF;
effBorderColor: TAlphaColor;
effBorderWidth: Single;
effDash: TStrokeDash;
begin
inherited;
Canvas.Fill.Kind := TBrushKind.None;
// Determine styles based on state (Error > Standard)
if FErrorMessage <> '' then
begin
effBorderColor := TAlphaColors.Red;
effBorderWidth := 2.0;
effDash := TStrokeDash.Solid;
end
else
begin
effBorderColor := FBorderColor;
effBorderWidth := FBorderWidth;
if FFrameless then
effDash := TStrokeDash.Dot
else
effDash := TStrokeDash.Solid;
end;
if FFrameless and (FErrorMessage = '') then
begin
// Standard frameless drawing (only if no error)
Canvas.Fill.Kind := TBrushKind.Solid;
Canvas.Fill.Color := FBackgroundColor;
Canvas.Stroke.Kind := TBrushKind.None;
Canvas.FillRect(TRectF.Create(0, 0, Width, Height), 0, 0, [], 1.0);
Canvas.Stroke.Kind := TBrushKind.Solid;
Canvas.Stroke.Color := effBorderColor;
Canvas.Stroke.Thickness := effBorderWidth;
Canvas.Stroke.Dash := effDash;
Canvas.DrawRect(TRectF.Create(0, 0, Width, Height), 0, 0, [], 1.0);
end
else
begin
// Draw background fill first
Canvas.Fill.Kind := TBrushKind.Solid;
Canvas.Fill.Color := FBackgroundColor;
rect := TRectF.Create(0, 0, Width, Height);
if (effBorderWidth > 0) then
rect.Inflate(-effBorderWidth / 2, -effBorderWidth / 2);
Canvas.FillRect(rect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round);
// Draw border (Custom or Error)
if (effBorderWidth > 0) and (effBorderColor <> TAlphaColors.Null) then
begin
rect := TRectF.Create(0, 0, Width, Height);
rect.Inflate(-effBorderWidth / 2, -effBorderWidth / 2);
Canvas.Stroke.Kind := TBrushKind.Solid;
Canvas.Stroke.Color := effBorderColor;
Canvas.Stroke.Thickness := effBorderWidth;
Canvas.Stroke.Dash := effDash;
Canvas.DrawRect(rect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round);
end;
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.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
inherited;
if Button = TMouseButton.mbLeft then
begin
var lControl := ObjectAtPoint(LocalToScreen(TPointF.Create(X, Y)));
if Assigned(lControl) and (lControl.GetObject = Self) then
begin
FIsDragging := True;
FDownPos := TPointF.Create(X, Y);
Capture;
BringToFront;
end
else
FIsDragging := False;
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;
if ParentControl <> nil then
ParentControl.Repaint;
end;
end;
procedure TAuraNode.SetBackgroundColor(const Value: TAlphaColor);
begin
FBackgroundColor := Value;
Repaint;
end;
procedure TAuraNode.SetupNode;
begin
if Assigned(FHandler) then
FHandler.BuildUI(Self);
end;
{ TBaseNodeHandler<T> }
constructor TBaseNodeHandler<T>.Create(const ANode: T);
begin
inherited Create;
FNode := ANode;
end;
function TBaseNodeHandler<T>.GetAstNode: IAstNode;
begin
Result := FNode;
end;
end.
File diff suppressed because it is too large Load Diff
+249
View File
@@ -0,0 +1,249 @@
unit Myc.Fmx.AstEditor.Visualizer;
interface
uses
System.SysUtils,
System.Classes,
FMX.Controls,
Myc.Data.Value,
Myc.Ast.Nodes,
Myc.Ast.Visitor,
Myc.Fmx.AstEditor.Workspace,
Myc.Fmx.AstEditor.Core,
Myc.Fmx.AstEditor.Handlers;
type
// Inherits from the generic TAstVisitor<TAuraNode>
TAstVisualizer = class(TAstVisitor<TAuraNode>, IAstVisualizer)
private
FExprDepth: Integer;
FParentControl: TControl;
FWorkspace: TAuraWorkspace;
function CallAccept(const Node: IAstNode): TAuraNode;
function GetExprDepth: Integer;
function GetParentControl: TControl;
function GetWorkspace: TAuraWorkspace;
procedure SetExprDepth(const Value: Integer);
procedure SetParentControl(const Value: TControl);
protected
// Visitor implementations for each AST node type.
function VisitConstant(const Node: IConstantNode): TAuraNode; override;
function VisitIdentifier(const Node: IIdentifierNode): TAuraNode; override;
function VisitKeyword(const Node: IKeywordNode): TAuraNode; override;
function VisitIfExpression(const Node: IIfExpressionNode): TAuraNode; override;
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TAuraNode; override;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TAuraNode; override;
function VisitFunctionCall(const Node: IFunctionCallNode): TAuraNode; override;
function VisitMacroExpansionNode(const Node: IMacroExpansionNode): TAuraNode; override;
function VisitBlockExpression(const Node: IBlockExpressionNode): TAuraNode; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAuraNode; override;
function VisitAssignment(const Node: IAssignmentNode): TAuraNode; override;
function VisitMacroDefinition(const Node: IMacroDefinitionNode): TAuraNode; override;
function VisitQuasiquote(const Node: IQuasiquoteNode): TAuraNode; override;
function VisitUnquote(const Node: IUnquoteNode): TAuraNode; override;
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TAuraNode; override;
function VisitIndexer(const Node: IIndexerNode): TAuraNode; override;
function VisitMemberAccess(const Node: IMemberAccessNode): TAuraNode; override;
function VisitRecordLiteral(const Node: IRecordLiteralNode): TAuraNode; override;
function VisitCreateSeries(const Node: ICreateSeriesNode): TAuraNode; override;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TAuraNode; override;
function VisitSeriesLength(const Node: ISeriesLengthNode): TAuraNode; override;
function VisitRecurNode(const Node: IRecurNode): TAuraNode; override;
function VisitNop(const Node: INopNode): TAuraNode; override;
public
constructor Create(AWorkspace: TAuraWorkspace; AParentControl: TControl; AExprDepth: Integer);
destructor Destroy; override;
function Clone(ParentControl: TControl; ExprDepth: Integer): IAstVisualizer;
property ExprDepth: Integer read GetExprDepth write SetExprDepth;
property ParentControl: TControl read GetParentControl write SetParentControl;
property Workspace: TAuraWorkspace read GetWorkspace;
end;
implementation
{ TAstVisualizer }
constructor TAstVisualizer.Create(AWorkspace: TAuraWorkspace; AParentControl: TControl; AExprDepth: Integer);
begin
inherited Create;
FWorkspace := AWorkspace;
FParentControl := AParentControl;
FExprDepth := AExprDepth;
end;
destructor TAstVisualizer.Destroy;
begin
inherited;
end;
function TAstVisualizer.CallAccept(const Node: IAstNode): TAuraNode;
var
dataValue: TDataValue;
begin
if not Assigned(Node) then
exit(nil);
dataValue := Node.Accept(Self);
if dataValue.Kind = TDataValueKind.vkGeneric then
begin
Result := dataValue.AsGeneric<TAuraNode>;
end
else
begin
Result := nil;
end;
end;
function TAstVisualizer.Clone(ParentControl: TControl; ExprDepth: Integer): IAstVisualizer;
begin
Result := TAstVisualizer.Create(FWorkspace, ParentControl, ExprDepth);
end;
function TAstVisualizer.GetExprDepth: Integer;
begin
Result := FExprDepth;
end;
function TAstVisualizer.GetParentControl: TControl;
begin
Result := FParentControl;
end;
function TAstVisualizer.GetWorkspace: TAuraWorkspace;
begin
Result := FWorkspace;
end;
procedure TAstVisualizer.SetExprDepth(const Value: Integer);
begin
FExprDepth := Value;
end;
procedure TAstVisualizer.SetParentControl(const Value: TControl);
begin
FParentControl := Value;
end;
// --- Visitor Implementations ---
function TAstVisualizer.VisitConstant(const Node: IConstantNode): TAuraNode;
begin
Result := TAuraNode.Create(Self, TConstantNodeHandler.Create(Node));
end;
function TAstVisualizer.VisitIdentifier(const Node: IIdentifierNode): TAuraNode;
begin
Result := TAuraNode.Create(Self, TIdentifierNodeHandler.Create(Node));
end;
function TAstVisualizer.VisitKeyword(const Node: IKeywordNode): TAuraNode;
begin
Result := TAuraNode.Create(Self, TKeywordNodeHandler.Create(Node));
end;
function TAstVisualizer.VisitBlockExpression(const Node: IBlockExpressionNode): TAuraNode;
begin
Result := TAuraNode.Create(Self, TBlockExpressionNodeHandler.Create(Node));
end;
function TAstVisualizer.VisitIfExpression(const Node: IIfExpressionNode): TAuraNode;
begin
Result := TAuraNode.Create(Self, TIfExpressionNodeHandler.Create(Node));
end;
function TAstVisualizer.VisitTernaryExpression(const Node: ITernaryExpressionNode): TAuraNode;
begin
Result := TAuraNode.Create(Self, TTernaryExpressionNodeHandler.Create(Node));
end;
function TAstVisualizer.VisitLambdaExpression(const Node: ILambdaExpressionNode): TAuraNode;
begin
Result := TAuraNode.Create(Self, TLambdaExpressionNodeHandler.Create(Node));
end;
function TAstVisualizer.VisitFunctionCall(const Node: IFunctionCallNode): TAuraNode;
begin
Result := TAuraNode.Create(Self, TFunctionCallNodeHandler.Create(Node));
end;
function TAstVisualizer.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TAuraNode;
begin
Result := TAuraNode.Create(Self, TMacroExpansionNodeHandler.Create(Node));
end;
function TAstVisualizer.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAuraNode;
begin
Result := TAuraNode.Create(Self, TVariableDeclarationNodeHandler.Create(Node));
end;
function TAstVisualizer.VisitAssignment(const Node: IAssignmentNode): TAuraNode;
begin
Result := TAuraNode.Create(Self, TAssignmentNodeHandler.Create(Node));
end;
function TAstVisualizer.VisitMacroDefinition(const Node: IMacroDefinitionNode): TAuraNode;
begin
Result := TAuraNode.Create(Self, TMacroDefinitionNodeHandler.Create(Node));
end;
function TAstVisualizer.VisitQuasiquote(const Node: IQuasiquoteNode): TAuraNode;
begin
Result := TAuraNode.Create(Self, TQuasiquoteNodeHandler.Create(Node));
end;
function TAstVisualizer.VisitUnquote(const Node: IUnquoteNode): TAuraNode;
begin
Result := TAuraNode.Create(Self, TUnquoteNodeHandler.Create(Node));
end;
function TAstVisualizer.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TAuraNode;
begin
Result := TAuraNode.Create(Self, TUnquoteSplicingNodeHandler.Create(Node));
end;
function TAstVisualizer.VisitIndexer(const Node: IIndexerNode): TAuraNode;
begin
Result := TAuraNode.Create(Self, TIndexerNodeHandler.Create(Node));
end;
function TAstVisualizer.VisitMemberAccess(const Node: IMemberAccessNode): TAuraNode;
begin
Result := TAuraNode.Create(Self, TMemberAccessNodeHandler.Create(Node));
end;
function TAstVisualizer.VisitRecordLiteral(const Node: IRecordLiteralNode): TAuraNode;
begin
Result := TAuraNode.Create(Self, TRecordLiteralNodeHandler.Create(Node));
end;
function TAstVisualizer.VisitCreateSeries(const Node: ICreateSeriesNode): TAuraNode;
begin
Result := TAuraNode.Create(Self, TCreateSeriesNodeHandler.Create(Node));
end;
function TAstVisualizer.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TAuraNode;
begin
Result := TAuraNode.Create(Self, TAddSeriesItemNodeHandler.Create(Node));
end;
function TAstVisualizer.VisitSeriesLength(const Node: ISeriesLengthNode): TAuraNode;
begin
Result := TAuraNode.Create(Self, TSeriesLengthNodeHandler.Create(Node));
end;
function TAstVisualizer.VisitRecurNode(const Node: IRecurNode): TAuraNode;
begin
Result := TAuraNode.Create(Self, TRecurNodeHandler.Create(Node));
end;
function TAstVisualizer.VisitNop(const Node: INopNode): TAuraNode;
begin
Result := TAuraNode.Create(Self, TNopNodeHandler.Create(Node));
end;
end.
@@ -91,7 +91,8 @@ implementation
uses uses
System.Math, System.Math,
FMX.Platform, FMX.Platform,
Myc.Fmx.AstEditor.Node; Myc.Fmx.AstEditor.Core,
Myc.Fmx.AstEditor.Visualizer;
{ TPinConnection } { TPinConnection }
@@ -112,7 +113,10 @@ end;
procedure TAuraWorkspace.Build(const RootNode: IAstNode; const Position: TPointF); procedure TAuraWorkspace.Build(const RootNode: IAstNode; const Position: TPointF);
begin begin
var visu := TAstVisualizer.Create(Self, Self, 0) as IAstVisualizer; var visu := TAstVisualizer.Create(Self, Self, 0) as IAstVisualizer;
visu.CallAccept(RootNode); var node := visu.CallAccept(RootNode);
if Assigned(node) then
node.Position.Point := Position;
end; end;
procedure TAuraWorkspace.DoDeleteChildren; procedure TAuraWorkspace.DoDeleteChildren;
@@ -125,7 +129,7 @@ function TAuraWorkspace.GetChildrenMatrix(var Matrix: TMatrix; var Simple: Boole
begin begin
Matrix := TMatrix.CreateScaling(FZoom, FZoom) * TMatrix.CreateTranslation(FPanning.cx, FPanning.cy); Matrix := TMatrix.CreateScaling(FZoom, FZoom) * TMatrix.CreateTranslation(FPanning.cx, FPanning.cy);
Simple := (FZoom = 1.0) and (FPanning.cx = 0) and (FPanning.cy = 0); Simple := (FZoom = 1.0) and (FPanning.cx = 0) and (FPanning.cy = 0);
Result := true; Result := True;
end; end;
procedure TAuraWorkspace.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); procedure TAuraWorkspace.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
@@ -225,15 +229,15 @@ end;
function TAuraWorkspace.Zoom(Factor: Single): Boolean; function TAuraWorkspace.Zoom(Factor: Single): Boolean;
var var
MouseService: IFMXMouseService; mouseService: IFMXMouseService;
begin begin
Result := TPlatformServices.Current.SupportsPlatformService(IFMXMouseService, MouseService); Result := TPlatformServices.Current.SupportsPlatformService(IFMXMouseService, mouseService);
if Result then if Result then
begin begin
var MousePos := ScreenToLocal(MouseService.GetMousePos); var mousePos := ScreenToLocal(mouseService.GetMousePos);
Factor := Max(0.2, Min(3.0, Factor)); Factor := Max(0.2, Min(3.0, Factor));
FPanning.cx := MousePos.X * (1 - Factor / FZoom) + FPanning.cx * (Factor / FZoom); FPanning.cx := mousePos.X * (1 - Factor / FZoom) + FPanning.cx * (Factor / FZoom);
FPanning.cy := MousePos.Y * (1 - Factor / FZoom) + FPanning.cy * (Factor / FZoom); FPanning.cy := mousePos.Y * (1 - Factor / FZoom) + FPanning.cy * (Factor / FZoom);
FZoom := Factor; FZoom := Factor;
RecalcAbsolute; RecalcAbsolute;
RecalcUpdateRect; RecalcUpdateRect;