New visualizer

This commit is contained in:
Michael Schimmel
2025-10-29 23:07:49 +01:00
parent a47cd3f1f4
commit f1735e2678
9 changed files with 1932 additions and 167 deletions
File diff suppressed because one or more lines are too long
+1 -2
View File
@@ -20,8 +20,7 @@ uses
Myc.Fmx.AstEditor.Text in 'Myc.Fmx.AstEditor.Text.pas',
Myc.Utils in '..\Src\Myc.Utils.pas',
Myc.Ast.Script in '..\Src\AST\Myc.Ast.Script.pas',
Myc.Ast.Types in '..\Src\AST\Myc.Ast.Types.pas',
Myc.Fmx.AstVisualizer in 'Myc.Fmx.AstVisualizer.pas';
Myc.Ast.Types in '..\Src\AST\Myc.Ast.Types.pas';
{$R *.res}
-1
View File
@@ -151,7 +151,6 @@
<DCCReference Include="..\Src\Myc.Utils.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Script.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Types.pas"/>
<DCCReference Include="Myc.Fmx.AstVisualizer.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
-1
View File
@@ -36,7 +36,6 @@ uses
FMX.Layouts,
FMX.Objects,
Myc.Ast.Debugger,
Myc.Fmx.AstVisualizer,
Myc.Fmx.AstEditor.Node,
Myc.Fmx.AstEditor.Workspace,
FMX.DialogService,
File diff suppressed because it is too large Load Diff
@@ -91,7 +91,7 @@ implementation
uses
System.Math,
FMX.Platform,
Myc.Fmx.AstVisualizer;
Myc.Fmx.AstEditor.Node;
{ TPinConnection }
@@ -111,7 +111,8 @@ end;
procedure TAuraWorkspace.Build(const RootNode: IAstNode; const Position: TPointF);
begin
RootNode.Accept(TAstVisualizer.CreateVisitor(Self, Position));
var visu := TAstVisualizer.Create(Self, Self, 0) as IAstVisualizer;
visu.CallAccept(RootNode);
end;
procedure TAuraWorkspace.DoDeleteChildren;
+87 -145
View File
@@ -1,4 +1,4 @@
unit Myc.Fmx.AstVisualizer;
unit Myc.Fmx.AstVisualizer deprecated;
interface
@@ -25,14 +25,13 @@ uses
type
// Visits the AST and creates visual TAuraNode representations on a TAuraWorkspace.
TAstVisualizer = class(TAstVisitor)
TAstVisualizer = class(TAstVisitor, IAstVisualizer)
private
FWorkspace: TAuraWorkspace;
FParentControl: TControl; // The current parent FMX control for newly created nodes
FCurrentPos: TPointF; // Current position for the next node relative to FParentControl
FNodeVerticalGap: Single; // Vertical gap between nodes
FCurrentPos: TPointF;
FExprDepth: Integer;
FWorkspace: TAuraWorkspace;
FNodeVerticalGap: Single;
FParentControl: TControl;
// Helper to create and initialize a TAuraNode for a given AST node.
function CreateNode(const Node: IAstNode): TAuraNode;
function AddLabel(const ParentNode: TAuraNode; const Txt: String): TLabel;
@@ -44,7 +43,12 @@ type
// Calls Accept on the node and returns the resulting TAuraNode.
function CallAccept(const Node: IAstNode): TAuraNode;
function GetCurrentPos: TPointF;
function GetExprDepth: Integer;
function GetParentControl: TControl;
procedure SetCurrentPos(const Value: TPointF);
procedure SetExprDepth(const Value: Integer);
procedure SetParentControl(const Value: TControl);
protected
// Visitor implementations for each AST node type.
function VisitConstant(const Node: IConstantNode): TDataValue; override;
@@ -71,10 +75,22 @@ type
function VisitRecurNode(const Node: IRecurNode): TDataValue; override;
public
constructor Create(AWorkspace: TAuraWorkspace; AParentControl: TControl; const AStartPosition: TPointF);
constructor Create(
AWorkspace: TAuraWorkspace;
AParentControl: TControl;
const AStartPosition: TPointF;
ANodeVerticalGap: Single = 15;
AExprDepth: Integer = 0
);
destructor Destroy; override;
function Clone: IAstVisualizer;
class function CreateVisitor(AWorkspace: TAuraWorkspace; const StartPosition: TPointF): IAstVisitor;
property CurrentPos: TPointF read GetCurrentPos write SetCurrentPos;
property ExprDepth: Integer read GetExprDepth write SetExprDepth;
property ParentControl: TControl read GetParentControl write SetParentControl;
end;
implementation
@@ -89,24 +105,25 @@ uses
Myc.Fmx.AstEditor.Text;
const
cNodePadding = 10; // Reduced padding
cTitleTopPadding = 2;
cTitleBottomPadding = 4;
cChildAreaTopPadding = 5;
cNodeVerticalGap = 10; // Reduced gap
cMinNodeWidth = 10;
cMinNodeHeight = 10;
{ TAstVisualizer }
constructor TAstVisualizer.Create(AWorkspace: TAuraWorkspace; AParentControl: TControl; const AStartPosition: TPointF);
constructor TAstVisualizer.Create(
AWorkspace: TAuraWorkspace;
AParentControl: TControl;
const AStartPosition: TPointF;
ANodeVerticalGap: Single = 15;
AExprDepth: Integer = 0
);
begin
inherited Create;
FWorkspace := AWorkspace;
FParentControl := AParentControl;
FCurrentPos := AStartPosition;
FNodeVerticalGap := 15; // Vertical gap between child nodes
FExprDepth := 0;
FNodeVerticalGap := ANodeVerticalGap;
FExprDepth := AExprDepth;
end;
destructor TAstVisualizer.Destroy;
@@ -264,6 +281,26 @@ begin
end;
end;
function TAstVisualizer.Clone: IAstVisualizer;
begin
Result := TAstVisualizer.Create(FWorkspace, FParentControl, FCurrentPos, FNodeVerticalGap, FExprDepth);
end;
function TAstVisualizer.GetCurrentPos: TPointF;
begin
Result := FCurrentPos;
end;
function TAstVisualizer.GetExprDepth: Integer;
begin
Result := FExprDepth;
end;
function TAstVisualizer.GetParentControl: TControl;
begin
Result := FParentControl;
end;
// Generic processing logic for AST nodes with children. Returns the created TAuraNode.
function TAstVisualizer.ProcessStub(const ATitle: string; const ANode: IAstNode; const AChildren: TArray<IAstNode>): TAuraNode;
var
@@ -308,157 +345,62 @@ begin
Result := auraNode; // Return the created node
end;
procedure TAstVisualizer.SetCurrentPos(const Value: TPointF);
begin
FCurrentPos := Value;
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): TDataValue;
var
auraNode: TAuraNode;
valueStr: string;
isConcise: Boolean;
begin
valueStr := Node.Value.ToString;
// Check if it's a number or a single-line text and not excessively long
isConcise := ((Node.Value.Kind = TDataValueKind.vkScalar) or (Pos(sLineBreak, valueStr) = 0)) and (Length(valueStr) < 40);
var auraNode := TAuraConstantNode.CreateConstantNode(FWorkspace, Node, Self);
auraNode := CreateNode(Node); // Create node without title
auraNode.BeginUpdate;
try
if isConcise then
begin
// Display value directly in a centered label, frameless node
auraNode.Frameless := true;
AddLabel(auraNode, valueStr);
end
else
begin
// Use standard framed node with Title label + Value label
auraNode.Frameless := False;
// Title Label
var titleLabelHeight := AddTitleLabel(auraNode, 'Constant');
// Value Label
var valueLabel := AddLabel(auraNode, valueStr);
valueLabel.Position.Y := valueLabel.Position.Y + titleLabelHeight;
valueLabel.AutoSize := False; // ***Important: Disable AutoSize when Align=Client***
valueLabel.WordWrap := True; // Allow wrapping for long text
end;
AdjustParentNodeSize(auraNode, []); // Adjust based on labels' sizes
finally
auraNode.EndUpdate;
end;
// Move current position down for the next sibling node
FCurrentPos.Y := FCurrentPos.Y + auraNode.Height + FNodeVerticalGap;
Result := TDataValue.FromGeneric<TAuraNode>(auraNode); // Return the created node
end;
function TAstVisualizer.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
var
auraNode: TAuraNode;
auraNode: TAuraIdentifierNode; // Use specific type
begin
// Leaf node, direct creation without ProcessStub
auraNode := CreateNode(Node);
auraNode.Frameless := True; // Make identifiers frameless like concise constants
auraNode.BeginUpdate;
try
auraNode.Frameless := true;
AddLabel(auraNode, Node.Name);
AdjustParentNodeSize(auraNode, []); // Fallback just in case
finally
auraNode.EndUpdate;
end;
// Create the specific node type using its factory
auraNode := TAuraIdentifierNode.CreateIdentifierNode(FWorkspace, Node, Self);
// Move current position down for the next sibling node
FCurrentPos.Y := FCurrentPos.Y + auraNode.Height + FNodeVerticalGap;
Result := TDataValue.FromGeneric<TAuraNode>(auraNode); // Return the created node
Result := TDataValue.FromGeneric<TAuraNode>(auraNode); // Return as generic TAuraNode
end;
function TAstVisualizer.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
var
auraNode: TAuraNode;
leftNode: TAuraNode; // Use TAuraNode directly
operatorLabel: TLabel;
rightNode: TAuraNode; // Use TAuraNode directly
savedParent: TControl;
auraNode: TAuraBinaryExpressionNode; // Use specific type
savedPos: TPointF;
currentX: Single; // Track horizontal position
maxHeightInRow: Single; // Track max height for row alignment
yPos: Single; // Y position for elements in this row
begin
// Create the main node, frameless as it primarily serves as a container
auraNode := CreateNode(Node);
auraNode.BeginUpdate;
inc(FExprDepth);
try
auraNode.Frameless := true;
// Store position before creating the node
savedPos := FCurrentPos;
// Start position for children inside the node
currentX := cNodePadding;
yPos := cNodePadding; // Initial Y position
maxHeightInRow := 0;
// Create the specific node type using its factory
auraNode := TAuraBinaryExpressionNode.CreateBinaryExpressionNode(FWorkspace, Node, Self);
// 1. Left Expression Node (Visited Recursively)
savedParent := FParentControl;
savedPos := FCurrentPos; // Store original position for siblings
FParentControl := auraNode; // Children are added to this node
FCurrentPos := TPointF.Create(currentX, yPos); // Set position for the child node
// Move current position down for the next sibling node
// Use the position saved *before* creating this node, plus the node's final height
FCurrentPos.Y := savedPos.Y + auraNode.Height + FNodeVerticalGap;
leftNode := CallAccept(Node.Left); // Use CallAccept and store result
if Assigned(leftNode) then
begin
// Update currentX based on the right edge of the left control + gap
currentX := leftNode.Position.X + leftNode.Width + leftNode.Margins.Right + cNodePadding;
maxHeightInRow := Max(maxHeightInRow, leftNode.Height + leftNode.Margins.Top + leftNode.Margins.Bottom);
end;
// 2. Operator Label
operatorLabel := AddLabel(auraNode, Node.Operator.ToString);
operatorLabel.Position.Point := TPointF.Create(currentX, yPos); // Position next to left operand
currentX := operatorLabel.Position.X + operatorLabel.Width + operatorLabel.Margins.Right + cNodePadding; // Update X pos
maxHeightInRow := Max(maxHeightInRow, operatorLabel.Height + operatorLabel.Margins.Top + operatorLabel.Margins.Bottom);
// 3. Right Expression Node (Visited Recursively)
// FParentControl is already auraNode
FCurrentPos := TPointF.Create(currentX, yPos); // Set position for the child node
rightNode := CallAccept(Node.Right); // Use CallAccept and store result
if Assigned(rightNode) then
begin
// Update currentX based on the right edge of the right control
currentX := rightNode.Position.X + rightNode.Width + rightNode.Margins.Right;
maxHeightInRow := Max(maxHeightInRow, rightNode.Height + rightNode.Margins.Top + rightNode.Margins.Bottom);
end;
FParentControl := savedParent; // Restore parent for siblings
FCurrentPos := savedPos; // Restore position for siblings
// --- Adjust parent size ---
auraNode.Width := Max(cMinNodeWidth, currentX + cNodePadding); // Total width needed + right padding
auraNode.Height := Max(cMinNodeHeight, maxHeightInRow + 2 * cNodePadding); // Max height + top/bottom padding
// --- Optional Vertical Centering ---
var centerOffsetY: Single := (auraNode.Height / 2);
if Assigned(leftNode) then
leftNode.Position.Y :=
centerOffsetY - (leftNode.Height + leftNode.Margins.Top + leftNode.Margins.Bottom) / 2 + leftNode.Margins.Top;
if Assigned(operatorLabel) then
operatorLabel.Position.Y :=
centerOffsetY
- (operatorLabel.Height + operatorLabel.Margins.Top + operatorLabel.Margins.Bottom) / 2
+ operatorLabel.Margins.Top;
if Assigned(rightNode) then
rightNode.Position.Y :=
centerOffsetY - (rightNode.Height + rightNode.Margins.Top + rightNode.Margins.Bottom) / 2 + rightNode.Margins.Top;
// --- End Optional Vertical Centering ---
finally
dec(FExprDepth);
auraNode.EndUpdate;
end;
// Move current position down for the next sibling node in the outer scope
FCurrentPos.Y := savedPos.Y + auraNode.Height + FNodeVerticalGap; // Use savedPos.Y for vertical alignment with siblings
Result := TDataValue.FromGeneric<TAuraNode>(auraNode); // Return the created node
Result := TDataValue.FromGeneric<TAuraNode>(auraNode); // Return as generic TAuraNode
end;
function TAstVisualizer.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
+2 -2
View File
@@ -105,7 +105,7 @@ type
function GetOperator: TScalar.TBinaryOp;
function GetRight: IAstNode;
public
constructor Create(ALeft: IAstNode; AOperator: TScalar.TBinaryOp; ARight: IAstNode);
constructor Create(const ALeft: IAstNode; AOperator: TScalar.TBinaryOp; const ARight: IAstNode);
function Accept(const Visitor: IAstVisitor): TDataValue; override;
end;
@@ -369,7 +369,7 @@ end;
{ TBinaryExpressionNode }
constructor TBinaryExpressionNode.Create(ALeft: IAstNode; AOperator: TScalar.TBinaryOp; ARight: IAstNode);
constructor TBinaryExpressionNode.Create(const ALeft: IAstNode; AOperator: TScalar.TBinaryOp; const ARight: IAstNode);
begin
inherited Create;
FLeft := ALeft;
+2 -1
View File
@@ -143,7 +143,8 @@ begin
if FKind <> vkGeneric then
raise EInvalidCast.Create('Cannot read value as generic of ' + String(PTypeInfo(TypeInfo(T)).Name) + '.');
{$ifdef DEBUG}
if TVal<T>(FInterface).TypeHandle <> TypeInfo(T) then
var val := TVal<T>(FInterface);
if val.TypeHandle <> TypeInfo(T) then
raise EInvalidCast.Create('Generic type is not a ' + String(PTypeInfo(TypeInfo(T)).Name) + '.');
{$endif}
Result := TVal<T>(FInterface).Value;