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

AST development

Browse Source
This commit is contained in:
Michael Schimmel
2025-09-01 12:55:22 +02:00
parent d5f2763aa2
commit 3b3d94291d
4 changed files with 202 additions and 134 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ASTPlayground/DraggablePanel.pas
+78 -39
View File
@@ -29,6 +29,8 @@ type
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);
@@ -37,6 +39,7 @@ type
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;
@@ -56,6 +59,9 @@ type
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;
@@ -104,7 +110,7 @@ begin
// Default border settings
FBorderColor := TAlphaColors.Gray;
FBorderWidth := 1;
FBorderRadius := 0; // Sharp corners by default
FBorderRadius := 9; // Sharp corners by default
// Default title settings
FTitle := 'Node';
@@ -115,6 +121,9 @@ begin
FTitleFont.OnChanged := TitleFontChanged;
FTitleFontColor := TAlphaColors.Black;
// Default state for frameless mode
FFrameless := False;
Width := 80;
Height := 45;
@@ -130,6 +139,62 @@ begin
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
@@ -139,6 +204,15 @@ begin
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
@@ -148,11 +222,11 @@ begin
end;
end;
procedure TAuraNode.SetBorderRadius(const Value: Single);
procedure TAuraNode.SetFrameless(const Value: Boolean);
begin
if FBorderRadius <> Value then
if FFrameless <> Value then
begin
FBorderRadius := Value;
FFrameless := Value;
Repaint;
end;
end;
@@ -185,41 +259,6 @@ begin
Repaint;
end;
procedure TAuraNode.Paint;
var
rect, titleRect: TRectF;
begin
inherited; // Allow styled painting to occur first (if any)
// 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;
// Use DrawRoundRect to support both sharp and rounded corners
Canvas.DrawRect(rect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round);
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, FBorderWidth, Width, FBorderWidth + 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.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
inherited;
ASTPlayground/MainForm.pas
+1
View File
@@ -369,6 +369,7 @@ begin
Memo1.Lines.Add('--- Factory Pattern Demo ---');
sw.Start;
root :=
TAst.Block(
[
ASTPlayground/Myc.Ast.Visualizer.pas
+122 -95
View File
@@ -30,9 +30,15 @@ type
TAstToAuraNodeVisitor = class(TInterfacedObject, IAstVisitor)
public
type
// Holds the result of a node visitation, separating layout and connection concerns.
TAuraNodeResult = record
LayoutNode: TAuraNode;
OutputPin: TControl;
end;
TAuraNodeResultList = TList<TAuraNodeResult>;
TChildVisitorProc = reference to procedure(const Visitor: IAstVisitor);
TAuraNodeList = TList<TAuraNode>;
TCreateParentNodeProc = reference to function(const InputNodes: TAuraNodeList): TAuraNode;
// The lambda now returns the full result, including the output pin reference.
TCreateParentNodeProc = reference to function(const InputNodes: TAuraNodeResultList): TAuraNodeResult;
TVerticalAlignment = (vaCenter, vaTop);
private
@@ -56,7 +62,7 @@ type
FParentControl: TControl;
FCurrentPos: TPointF;
FSpacing: TPointF;
FLastNode: TAuraNode;
FLastResult: TAuraNodeResult;
FConnections: TList<TPinConnection>;
FCurrentExec: TList<TControl>;
@@ -88,8 +94,6 @@ type
function CreateEntry(ParentNode: TAuraNode; OffsetY: Single = 0; connect: Boolean = true): TControl;
function CreateExit(ParentNode: TAuraNode; const Caption: string; OffsetY: Single = 0): TControl;
function FindPinByTag(ParentNode: TAuraNode; const Tag: string): TControl;
function ConnectData(InputPin: TControl; OutputNode: TAuraNode): TControl;
public
constructor Create(
AWorkspace: TAuraWorkspace;
@@ -192,6 +196,8 @@ begin
FSpacing := TPointF.Create(20, 10); // Horizontal indent, Vertical spacing
FConnections := AConnections;
FCurrentExec := TList<TControl>.Create(ACurrentExec);
FLastResult.LayoutNode := nil;
FLastResult.OutputPin := nil;
end;
destructor TAstToAuraNodeVisitor.Destroy;
@@ -228,13 +234,6 @@ begin
end;
end;
function TAstToAuraNodeVisitor.ConnectData(InputPin: TControl; OutputNode: TAuraNode): TControl;
begin
Result := FindPinByTag(OutputNode, 'data.out');
if Assigned(Result) then
FConnections.Add(TPinConnection.Create(Result, InputPin));
end;
function TAstToAuraNodeVisitor.CreateInput(ParentNode: TAuraNode; const Caption: string; OffsetY: Single = 0): TControl;
begin
var cap := Caption;
@@ -253,7 +252,8 @@ begin
// Advance vertical position for the next node
FCurrentPos.Y := FCurrentPos.Y + Result.Height + FSpacing.Y;
FLastNode := Result;
FLastResult.LayoutNode := Result;
FLastResult.OutputPin := nil; // Default: a new node has no specific data output pin
end;
function TAstToAuraNodeVisitor.CreateOutput(ParentNode: TAuraNode; OffsetY: Single = 0): TControl;
@@ -334,42 +334,28 @@ begin
Result.TagString := Tag;
end;
function TAstToAuraNodeVisitor.FindPinByTag(ParentNode: TAuraNode; const Tag: string): TControl;
var
control: TControl;
begin
Result := nil;
if not Assigned(ParentNode) then
exit;
for control in ParentNode.Controls do
begin
if control.TagString = Tag then
begin
Result := control;
exit;
end;
end;
end;
function TAstToAuraNodeVisitor.VisitAssignment(const Node: IAssignmentNode): TAstValue;
begin
VisitOperatorNode(
[Node.Value],
function(const InputNodes: TAuraNodeList): TAuraNode
function(const InputResults: TAuraNodeResultList): TAuraNodeResult
var
assignmentNode, valueNode: TAuraNode;
assignmentNode: TAuraNode;
inputPin: TControl;
valueResult: TAuraNodeResult;
begin
valueNode := InputNodes[0];
valueResult := InputResults[0];
assignmentNode := BuildNodeControl('Assignment', Node.Identifier.Name);
CreateEntry(assignmentNode, -8);
CreateExit(assignmentNode, '', 0);
inputPin := CreateInput(assignmentNode, Node.Identifier.Name, 8);
ConnectData(inputPin, valueNode);
Result := assignmentNode;
if Assigned(valueResult.OutputPin) then
FConnections.Add(TPinConnection.Create(valueResult.OutputPin, inputPin));
Result.LayoutNode := assignmentNode;
Result.OutputPin := nil; // An assignment has no data output
end,
vaTop
);
@@ -380,25 +366,30 @@ function TAstToAuraNodeVisitor.VisitBinaryExpression(const Node: IBinaryExpressi
begin
VisitOperatorNode(
[Node.Left, Node.Right],
function(const InputNodes: TAuraNodeList): TAuraNode
function(const InputResults: TAuraNodeResultList): TAuraNodeResult
var
binaryExprNode, leftNode, rightNode: TAuraNode;
binaryExprNode: TAuraNode;
inputPin1, inputPin2: TControl;
leftResult, rightResult: TAuraNodeResult;
outPin: TControl;
begin
leftNode := InputNodes[0];
rightNode := InputNodes[1];
leftResult := InputResults[0];
rightResult := InputResults[1];
binaryExprNode := BuildNodeControl(Node.Operator.ToString, '');
binaryExprNode.TitleFont.Size := 20;
inputPin1 := CreateInput(binaryExprNode, '', -8); // Caption is in Hint
inputPin2 := CreateInput(binaryExprNode, '', 8);
CreateOutput(binaryExprNode, 0);
outPin := CreateOutput(binaryExprNode, 0);
ConnectData(inputPin1, leftNode);
ConnectData(inputPin2, rightNode);
if Assigned(leftResult.OutputPin) then
FConnections.Add(TPinConnection.Create(leftResult.OutputPin, inputPin1));
if Assigned(rightResult.OutputPin) then
FConnections.Add(TPinConnection.Create(rightResult.OutputPin, inputPin2));
Result := binaryExprNode;
Result.LayoutNode := binaryExprNode;
Result.OutputPin := outPin;
end
);
Result := TAstValue.Void;
@@ -407,15 +398,16 @@ end;
function TAstToAuraNodeVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue;
var
blockNode: TAuraNode;
childLastResult: TAuraNodeResult;
begin
childLastResult.LayoutNode := nil;
childLastResult.OutputPin := nil;
// Use the helper to create and populate the container node.
// InPin and OutPin set: block acts as "virtual execution scope" with entry and exit-nodes
// InPin and OutPin empty: block acts as a simple container
blockNode :=
VisitContainerNode(
'Block',
'', // No title for blocks
'',
// 'enter', 'exit',
'',
'',
true,
@@ -425,12 +417,19 @@ begin
begin
for expression in Node.Expressions do
expression.Accept(Visitor);
// Capture the full result of the last expression inside the block.
childLastResult := (Visitor as TAstToAuraNodeVisitor).FLastResult;
end
);
// Blocks are drawn without title and border, with a transparent fill.
blockNode.Frameless := true;
// Update the state of the main visitor
FCurrentPos.Y := blockNode.Position.Y + blockNode.Height + FSpacing.Y;
FLastNode := blockNode;
FLastResult.LayoutNode := blockNode; // The layout node is the container itself.
FLastResult.OutputPin := childLastResult.OutputPin; // The connection pin is from the internal node.
Result := TAstValue.Void;
end;
@@ -439,10 +438,8 @@ function TAstToAuraNodeVisitor.VisitConstant(const Node: IConstantNode): TAstVal
var
constantNode: TAuraNode;
begin
// A constant has a data output pin.
// Data outputs are round and on the right side of the box.
constantNode := CreateNodeControl('Constant', Node.Value.ToString);
CreateOutput(constantNode, 0);
FLastResult.OutputPin := CreateOutput(constantNode, 0);
Result := TAstValue.Void;
end;
@@ -546,13 +543,14 @@ begin
VisitOperatorNode(
inputExpressions,
function(const InputNodes: TAuraNodeList): TAuraNode
function(const InputResults: TAuraNodeResultList): TAuraNodeResult
var
funcCallNode: TAuraNode;
calleePin: TControl;
argPin: array of TControl;
currentInputOffsetY, currentOutputOffsetY: Single;
i: Integer;
outPin: TControl;
begin
funcCallNode := BuildNodeControl('FunctionCall', '');
@@ -576,13 +574,16 @@ begin
currentOutputOffsetY := -(numOutputPins - 1) / 2.0 * cPinOffsetY;
CreateExit(funcCallNode, '', currentOutputOffsetY);
currentOutputOffsetY := currentOutputOffsetY + cPinOffsetY;
CreateOutput(funcCallNode, currentOutputOffsetY);
outPin := CreateOutput(funcCallNode, currentOutputOffsetY);
ConnectData(calleePin, InputNodes[0]);
if Assigned(InputResults[0].OutputPin) then
FConnections.Add(TPinConnection.Create(InputResults[0].OutputPin, calleePin));
for i := 0 to Node.Arguments.Count - 1 do
ConnectData(argPin[i], InputNodes[i + 1]);
if Assigned(InputResults[i + 1].OutputPin) then
FConnections.Add(TPinConnection.Create(InputResults[i + 1].OutputPin, argPin[i]));
Result := funcCallNode;
Result.LayoutNode := funcCallNode;
Result.OutputPin := outPin;
end
);
@@ -592,8 +593,7 @@ end;
function TAstToAuraNodeVisitor.VisitIdentifier(const Node: IIdentifierNode): TAstValue;
begin
var identifierNode := CreateNodeControl('Identifier', Node.Name);
// Add a data output pin on the right side.
CreateOutput(identifierNode, 0);
FLastResult.OutputPin := CreateOutput(identifierNode, 0);
Result := TAstValue.Void;
end;
@@ -605,20 +605,24 @@ begin
var ifNode :=
VisitOperatorNode(
[Node.Condition],
function(const InputNodes: TAuraNodeList): TAuraNode
function(const InputResults: TAuraNodeResultList): TAuraNodeResult
var
condNode: TAuraNode;
conditionInputPin: TControl;
condResult: TAuraNodeResult;
ifNode: TAuraNode;
begin
condNode := InputNodes[0];
condResult := InputResults[0];
ifNode := BuildNodeControl('If', '');
ifNode.Height := cIfNodeHeight;
CreateEntry(ifNode, -12);
Result := BuildNodeControl('If', '');
Result.Height := cIfNodeHeight;
CreateEntry(Result, -12);
conditionInputPin := CreateInput(ifNode, 'Condition', 12);
conditionInputPin := CreateInput(Result, 'Condition', 12);
if Assigned(condResult.OutputPin) then
FConnections.Add(TPinConnection.Create(condResult.OutputPin, conditionInputPin));
ConnectData(conditionInputPin, condNode);
Result.LayoutNode := ifNode;
Result.OutputPin := nil;
end
);
var conditionEndY := FCurrentPos.Y;
@@ -635,7 +639,7 @@ begin
FCurrentPos.Y := startPosition.Y;
Node.ThenBranch.Accept(Self);
var thenEndY := FCurrentPos.Y;
FLastNode := ifNode;
FLastResult.LayoutNode := ifNode;
execPathes.AddRange(FCurrentExec);
// Else branch (if it exists)
@@ -654,10 +658,10 @@ begin
// Finalize visitor state.
FCurrentPos.X := startPosition.X;
FCurrentPos.Y := Max(conditionEndY, elseEndY);
FLastNode := ifNode;
FLastResult.LayoutNode := ifNode;
FLastResult.OutputPin := nil; // An if-expression has no data output itself
// After a branch, the execution flow has diverged. There is no single
// execution pin to continue from, so we set it to nil.
// After a branch, the execution flow has diverged.
FCurrentExec.Clear;
FCurrentExec.AddRange(execPathes);
@@ -691,11 +695,11 @@ begin
procedure(const Visitor: IAstVisitor) begin Node.Body.Accept(Visitor); end
);
CreateOutput(lambdaNode, 0);
// Update the state of the main visitor
FCurrentPos.Y := lambdaNode.Position.Y + lambdaNode.Height + FSpacing.Y;
FLastNode := lambdaNode;
FLastResult.LayoutNode := lambdaNode;
FLastResult.OutputPin := CreateOutput(lambdaNode, 0);
Result := TAstValue.Void;
end;
@@ -706,30 +710,33 @@ function TAstToAuraNodeVisitor.VisitOperatorNode(
Alignment: TVerticalAlignment
): TAuraNode;
var
inputResultNodes: TAuraNodeList;
inputResults: TAuraNodeResultList;
inputNode: IExpressionNode;
startPosition: TPointF;
endY, maxChildWidth: Single;
parentNode: TAuraNode;
createResult: TAuraNodeResult;
begin
startPosition := FCurrentPos;
inputResultNodes := TAuraNodeList.Create;
inputResults := TAuraNodeResultList.Create;
try
// 1. Visit all input nodes and collect their visual representations.
for inputNode in InputExpressions do
begin
inputNode.Accept(Self);
inputResultNodes.Add(FLastNode);
inputResults.Add(FLastResult);
end;
endY := FCurrentPos.Y;
// 2. Determine the layout bounds of the input nodes.
maxChildWidth := 0;
for var node in inputResultNodes do
maxChildWidth := Max(maxChildWidth, node.Position.X + node.Width);
for var res in inputResults do
if Assigned(res.LayoutNode) then
maxChildWidth := Max(maxChildWidth, res.LayoutNode.Position.X + res.LayoutNode.Width);
// 3. Let the closure create the parent node (without positioning).
parentNode := CreateParentProc(inputResultNodes);
createResult := CreateParentProc(inputResults);
parentNode := createResult.LayoutNode;
Result := parentNode;
// 4. Now position the parent node to the right of the inputs.
@@ -747,23 +754,39 @@ begin
parentNode.Position.Point := TPointF.Create(maxChildWidth + FSpacing.X, parentY);
// 5. Finalize visitor state for the next operation.
FCurrentPos.X := startPosition.X;
FCurrentPos.Y := Max(endY, parentNode.Position.Y + parentNode.Height + FSpacing.Y);
FLastNode := parentNode;
FLastResult.LayoutNode := parentNode;
FLastResult.OutputPin := createResult.OutputPin;
finally
inputResultNodes.Free;
inputResults.Free;
end;
end;
function TAstToAuraNodeVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): TAstValue;
begin
CreateNodeControl('UnaryExpr', Node.Operator.ToString);
FCurrentPos.X := FCurrentPos.X + FSpacing.X;
try
Node.Right.Accept(Self);
finally
FCurrentPos.X := FCurrentPos.X - FSpacing.X;
end;
VisitOperatorNode(
[Node.Right],
function(const InputResults: TAuraNodeResultList): TAuraNodeResult
var
unaryExprNode: TAuraNode;
inputPin: TControl;
rightResult: TAuraNodeResult;
outPin: TControl;
begin
rightResult := InputResults[0];
unaryExprNode := BuildNodeControl(Node.Operator.ToString, '');
unaryExprNode.TitleFont.Size := 20;
inputPin := CreateInput(unaryExprNode, '', 0);
outPin := CreateOutput(unaryExprNode, 0);
if Assigned(rightResult.OutputPin) then
FConnections.Add(TPinConnection.Create(rightResult.OutputPin, inputPin));
Result.LayoutNode := unaryExprNode;
Result.OutputPin := outPin;
end
);
Result := TAstValue.Void;
end;
@@ -773,20 +796,24 @@ begin
begin
VisitOperatorNode(
[Node.Initializer],
function(const InputNodes: TAuraNodeList): TAuraNode
function(const InputResults: TAuraNodeResultList): TAuraNodeResult
var
varDeclNode, initializerNode: TAuraNode;
varDeclNode: TAuraNode;
inputPin: TControl;
initializerResult: TAuraNodeResult;
begin
initializerNode := InputNodes[0];
initializerResult := InputResults[0];
varDeclNode := BuildNodeControl('VarDecl', Node.Identifier.Name);
CreateEntry(varDeclNode, -8);
CreateExit(varDeclNode, '', -8);
inputPin := CreateInput(varDeclNode, 'Value', 8);
ConnectData(inputPin, initializerNode);
Result := varDeclNode;
if Assigned(initializerResult.OutputPin) then
FConnections.Add(TPinConnection.Create(initializerResult.OutputPin, inputPin));
Result.LayoutNode := varDeclNode;
Result.OutputPin := nil;
end
);
end