Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

New visualizer

Browse Source
This commit is contained in:
Michael Schimmel
2025-10-26 18:06:45 +01:00
parent e379e6694c
commit e95a920dc7
9 changed files with 1489 additions and 1589 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ASTPlayground/ASTPlayground.delphilsp.json
+1 -1
View File
File diff suppressed because one or more lines are too long
ASTPlayground/ASTPlayground.dpr
+2 -2
View File
@@ -8,7 +8,6 @@ uses
Myc.Ast.Evaluator in '..\Src\AST\Myc.Ast.Evaluator.pas',
Myc.Ast.Nodes in '..\Src\AST\Myc.Ast.Nodes.pas',
Myc.Ast.Scope in '..\Src\AST\Myc.Ast.Scope.pas',
Myc.Fmx.AstEditor in 'Myc.Fmx.AstEditor.pas',
Myc.Data.Value in 'Myc.Data.Value.pas',
Myc.Ast.Debugger in '..\Src\AST\Myc.Ast.Debugger.pas',
Myc.Ast.Visitor in '..\Src\AST\Myc.Ast.Visitor.pas',
@@ -21,7 +20,8 @@ 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.Ast.Types in '..\Src\AST\Myc.Ast.Types.pas',
Myc.Fmx.AstVisualizer in 'Myc.Fmx.AstVisualizer.pas';
{$R *.res}
ASTPlayground/ASTPlayground.dproj
+1 -1
View File
@@ -138,7 +138,6 @@
<DCCReference Include="..\Src\AST\Myc.Ast.Evaluator.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Nodes.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Scope.pas"/>
<DCCReference Include="Myc.Fmx.AstEditor.pas"/>
<DCCReference Include="Myc.Data.Value.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Debugger.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Visitor.pas"/>
@@ -152,6 +151,7 @@
<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>
ASTPlayground/MainForm.fmx
+13 -20
View File
@@ -89,96 +89,89 @@ object Form1: TForm1
Text = 'Clear'
OnClick = ClearButtonClick
end
object FlowOnlyBox: TCheckBox
Position.X = 24.000000000000000000
Position.Y = 8.000000000000000000
TabOrder = 11
Text = 'Flow only'
OnChange = FlowOnlyBoxChange
end
object SeriesTestButton: TButton
Position.X = 24.000000000000000000
Position.Y = 258.000000000000000000
Size.Width = 80.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
TabOrder = 13
TabOrder = 12
Text = 'Series'
OnClick = SeriesTestButtonClick
end
object OHLCButton: TButton
Position.X = 24.000000000000000000
Position.Y = 288.000000000000000000
TabOrder = 14
TabOrder = 13
Text = 'OHLC'
OnClick = OHLCButtonClick
end
object DebugBox: TCheckBox
Position.X = 24.000000000000000000
Position.Y = 439.000000000000000000
TabOrder = 15
TabOrder = 14
Text = 'Debug'
end
object FromJSONButton: TButton
Position.X = 24.000000000000000000
Position.Y = 569.000000000000000000
TabOrder = 16
TabOrder = 15
Text = 'From JSON'
OnClick = FromJSONButtonClick
end
object ToJSONButton: TButton
Position.X = 24.000000000000000000
Position.Y = 599.000000000000000000
TabOrder = 17
TabOrder = 16
Text = 'To JSON'
OnClick = ToJSONButtonClick
end
object ExternalFuncButton: TButton
Position.X = 24.000000000000000000
Position.Y = 318.000000000000000000
TabOrder = 18
TabOrder = 17
Text = 'External Func'
OnClick = ExternalFuncButtonClick
end
object InnerLambdaButton: TButton
Position.X = 24.000000000000000000
Position.Y = 348.000000000000000000
TabOrder = 19
TabOrder = 18
Text = 'Inner Lambda'
OnClick = InnerLambdaButtonClick
end
object DumpButton: TButton
Position.X = 24.000000000000000000
Position.Y = 509.000000000000000000
TabOrder = 20
TabOrder = 19
Text = 'Dump'
OnClick = DumpButtonClick
end
object FailingUpvalueButton: TButton
Position.X = 24.000000000000000000
Position.Y = 378.000000000000000000
TabOrder = 22
TabOrder = 21
Text = 'Upvalue'
OnClick = FailingUpvalueButtonClick
end
object TailCallButten: TButton
Position.X = 24.000000000000000000
Position.Y = 406.000000000000000000
TabOrder = 23
TabOrder = 22
Text = 'Tail calls'
OnClick = TailCallButtenClick
end
object SaveUserLibButton: TButton
Position.X = 24.000000000000000000
Position.Y = 629.000000000000000000
TabOrder = 24
TabOrder = 23
Text = 'Save Lib'
OnClick = SaveUserLibButtonClick
end
object LoadUserLibButton: TButton
Position.X = 24.000000000000000000
Position.Y = 659.000000000000000000
TabOrder = 25
TabOrder = 24
Text = 'LoadLib'
OnClick = LoadUserLibButtonClick
end
@@ -193,7 +186,7 @@ object Form1: TForm1
Size.Width = 113.000000000000000000
Size.Height = 184.000000000000000000
Size.PlatformDefault = False
TabOrder = 26
TabOrder = 25
OnChange = RTLListViewChange
end
end
ASTPlayground/MainForm.pas
+17 -14
View File
@@ -36,7 +36,7 @@ uses
FMX.Layouts,
FMX.Objects,
Myc.Ast.Debugger,
Myc.Fmx.AstEditor,
Myc.Fmx.AstVisualizer,
Myc.Fmx.AstEditor.Node,
Myc.Fmx.AstEditor.Workspace,
FMX.DialogService,
@@ -70,7 +70,6 @@ type
DoTrigger2Button: TButton;
Panel2: TPanel;
ClearButton: TButton;
FlowOnlyBox: TCheckBox;
SeriesTestButton: TButton;
OHLCButton: TButton;
DebugBox: TCheckBox;
@@ -112,6 +111,7 @@ type
procedure LoadUserLibButtonClick(Sender: TObject);
procedure RTLListViewChange(Sender: TObject);
private
FCurrUnboundAst: IAstNode;
FCurrAst: IAstNode;
FCurrDesc: IScopeDescriptor;
FGScope: IExecutionScope;
@@ -216,6 +216,7 @@ var
visitor: IEvaluatorVisitor;
begin
// The new, streamlined pipeline: The binder handles macro expansion internally.
FCurrUnboundAst := ANode;
// Step 1: Create a binder, passing the evaluator factory for compile-time evaluations.
binder := TAstBinder.Create(AParentScope, CreateEvaluator);
@@ -1284,13 +1285,13 @@ begin
Memo1.Lines.Clear;
try
// Execute the entire script block when it changes
var result := ExecuteAst(TAstScript.Parse(ScriptMemo.Lines.Text), FGScope);
Memo1.Lines.Add(Format('Script executed. Final result: %s', [result.ToString]));
// After execution, the FCurrAst is set by ExecuteAst, so we can visualize it
FWorkspace.DeleteChildren;
ShowVizualization(14, 14);
try
// Execute the entire script block when it changes
var result := ExecuteAst(TAstScript.Parse(ScriptMemo.Lines.Text), FGScope);
Memo1.Lines.Add(Format('Script executed. Final result: %s', [result.ToString]));
finally
ShowVizualization(14, 14);
end;
except
on E: Exception do
Memo1.Lines.Add(E.Message);
@@ -1307,13 +1308,15 @@ end;
procedure TForm1.ShowVizualization(X, Y: Single);
begin
FWorkspace.DeleteChildren;
if FCurrAst <> nil then
begin
var visu := TVisualizationMode.vmDetailed;
if FlowOnlyBox.IsChecked then
visu := TVisualizationMode.vmControlFlow;
FWorkspace.BuildTree(FCurrAst, FCurrDesc, TPointF.Create(X, Y), visu);
FWorkspace.Build(FCurrAst, TPointF.Create(X, Y));
end
else if FCurrUnboundAst <> nil then
begin
FWorkspace.Build(FCurrUnboundAst, TPointF.Create(X, Y));
end;
end;
ASTPlayground/Myc.Fmx.AstEditor.Node.pas
+50 -84
View File
@@ -14,9 +14,10 @@ uses
FMX.Graphics;
type
// A movable panel with a custom-painted border and title.
// A movable panel with a custom-painted border. Content (like title) is added externally.
TAuraNode = class(TStyledControl)
private
FBackgroundColor: TAlphaColor;
// Flag to indicate if the control is currently being dragged.
FIsDragging: Boolean;
// Stores the mouse coordinates at the beginning of the drag operation.
@@ -25,20 +26,13 @@ type
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 SetBackgroundColor(const Value: TAlphaColor);
procedure SetBorderColor(const Value: TAlphaColor);
procedure SetBorderWidth(const Value: Single);
procedure SetBorderRadius(const Value: Single);
procedure SetTitle(const Value: string);
procedure SetTitleFont(const Value: TFont);
procedure SetTitleFontColor(const Value: TAlphaColor);
procedure TitleFontChanged(Sender: TObject);
procedure SetFrameless(const Value: Boolean);
protected
procedure Paint; override;
@@ -53,11 +47,7 @@ type
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;
property BackgroundColor: TAlphaColor read FBackgroundColor write SetBackgroundColor;
// Behavior properties
property Frameless: Boolean read FFrameless write SetFrameless;
@@ -110,16 +100,8 @@ begin
// 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;
FBorderRadius := 9; // Rounded corners by default
FBackgroundColor := $080a0a0a;
// Default state for frameless mode
FFrameless := False;
@@ -128,36 +110,51 @@ begin
Height := 45;
// The panel must be able to receive mouse events.
// HitTest := True;
HitTest := True; // Make sure HitTest is True to receive mouse events
// 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;
rect: TRectF;
effectiveBorderWidth: Single;
begin
inherited; // Allow styled painting to occur first (if any)
// Clear background before drawing custom border/fill
Canvas.Fill.Kind := TBrushKind.None; // Make sure default fill is cleared if needed
//Canvas.ClearRect(TRectF.Create(0,0, Width, Height)); // Optional: Explicit clear
if FFrameless then
begin
Canvas.Fill.Kind := TBrushKind.Solid;
Canvas.Fill.Color := $20C0C0C0; // Transparent Silver
Canvas.Fill.Color := FBackgroundColor;
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);
Canvas.Stroke.Kind := TBrushKind.Solid;
Canvas.Stroke.Color := FBorderColor;
Canvas.Stroke.Thickness := 1;
Canvas.Stroke.Dash := TStrokeDash.Dot;
Canvas.DrawRect(TRectF.Create(0, 0, Width, Height), 0, 0, [], 1.0);
effectiveBorderWidth := 0;
end
else
begin
// Draw background fill first
Canvas.Fill.Kind := TBrushKind.Solid;
Canvas.Fill.Color := FBackgroundColor;
rect := TRectF.Create(0, 0, Width, Height);
// Inflate inwards slightly if border exists to avoid overlap issues
if (FBorderWidth > 0) then
rect.Inflate(-FBorderWidth / 2, -FBorderWidth / 2);
Canvas.FillRect(rect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round);
// Custom painting for the border
if (FBorderWidth > 0) and (FBorderColor <> TAlphaColors.Null) then
begin
@@ -168,31 +165,15 @@ begin
Canvas.Stroke.Kind := TBrushKind.Solid;
Canvas.Stroke.Color := FBorderColor;
Canvas.Stroke.Thickness := FBorderWidth;
Canvas.Stroke.Dash := TStrokeDash.Solid;
Canvas.DrawRect(rect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round);
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);
effectiveBorderWidth := FBorderWidth;
end
else
effectiveBorderWidth := 0;
end;
// Title drawing removed, handled by external labels now.
end;
procedure TAuraNode.SetBorderColor(const Value: TAlphaColor);
@@ -231,45 +212,22 @@ begin
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
// Only start dragging if the click is on the node itself, not its children
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;
end;
BringToFront; // Bring node to front when dragging starts
end
else
FIsDragging := False; // Ensure dragging stops if click is on a child
end;
end;
@@ -286,7 +244,7 @@ begin
Position.Y := Position.Y + deltaY;
if ParentControl <> nil then
ParentControl.Repaint;
ParentControl.Repaint; // Repaint the workspace to update connections
end;
end;
@@ -297,7 +255,15 @@ begin
begin
ReleaseCapture;
FIsDragging := False;
if ParentControl <> nil then // Repaint one last time after drag ends
ParentControl.Repaint;
end;
end;
procedure TAuraNode.SetBackgroundColor(const Value: TAlphaColor);
begin
FBackgroundColor := Value;
Repaint;
end;
end.
ASTPlayground/Myc.Fmx.AstEditor.Workspace.pas
+8 -26
View File
@@ -18,6 +18,10 @@ uses
Myc.Ast.Scope,
Myc.Ast.Binding;
const
cDataPinColor = TAlphaColors.Dodgerblue;
cExecPinColor = TAlphaColors.Lightgreen;
type
TPinConnection = record
OutputPin: TControl;
@@ -25,9 +29,6 @@ type
constructor Create(AOutputPin, AInputPin: TControl);
end;
// Enum to select the visualization style.
TVisualizationMode = (vmDetailed, vmControlFlow);
TAuraWorkspace = class(TStyledControl)
private
FConnections: TArray<TPinConnection>;
@@ -45,12 +46,7 @@ type
procedure DblClick; override;
public
constructor Create(AOwner: TComponent); override;
procedure BuildTree(
const RootNode: IAstNode;
const RootDescriptor: IScopeDescriptor;
const Position: TPointF;
AMode: TVisualizationMode
);
procedure Build(const RootNode: IAstNode; const Position: TPointF);
function GetChildrenMatrix(var Matrix: TMatrix; var Simple: Boolean): Boolean; override;
function Zoom(Factor: Single): Boolean;
@@ -95,7 +91,7 @@ implementation
uses
System.Math,
FMX.Platform,
Myc.Fmx.AstEditor;
Myc.Fmx.AstVisualizer;
{ TPinConnection }
@@ -113,23 +109,9 @@ begin
FZoom := 1.0;
end;
procedure TAuraWorkspace.BuildTree(
const RootNode: IAstNode;
const RootDescriptor: IScopeDescriptor;
const Position: TPointF;
AMode: TVisualizationMode
);
var
connections: TList<TPinConnection>;
procedure TAuraWorkspace.Build(const RootNode: IAstNode; const Position: TPointF);
begin
connections := TList<TPinConnection>.Create;
try
// Create the scope descriptor from the execution scope provided by the binder.
RootNode.Accept(TAstToAuraNodeVisitor.Create(Self, Self, Position, connections, nil, AMode, nil, nil, RootDescriptor));
FConnections := FConnections + connections.ToArray;
finally
connections.Free;
end;
RootNode.Accept(TAstVisualizer.CreateVisitor(Self, Position));
end;
procedure TAuraWorkspace.DoDeleteChildren;
ASTPlayground/Myc.Fmx.AstEditor.pas
-1441
View File
File diff suppressed because it is too large Load Diff
ASTPlayground/Myc.Fmx.AstVisualizer.pas
+1397
View File
File diff suppressed because it is too large Load Diff