From 3b3d94291d2e9ad6ab55c38f04ca9acff43d323e Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Mon, 1 Sep 2025 12:55:22 +0200 Subject: [PATCH] AST development --- ASTPlayground/DraggablePanel.pas | 117 ++++++++++----- ASTPlayground/MainForm.pas | 1 + ASTPlayground/Myc.Ast.Visualizer.pas | 217 +++++++++++++++------------ KI/Prompt-Delphi-Entwicklung.md | 1 + 4 files changed, 202 insertions(+), 134 deletions(-) diff --git a/ASTPlayground/DraggablePanel.pas b/ASTPlayground/DraggablePanel.pas index 99013fd..30a81d7 100644 --- a/ASTPlayground/DraggablePanel.pas +++ b/ASTPlayground/DraggablePanel.pas @@ -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; diff --git a/ASTPlayground/MainForm.pas b/ASTPlayground/MainForm.pas index 3e46067..5ede722 100644 --- a/ASTPlayground/MainForm.pas +++ b/ASTPlayground/MainForm.pas @@ -369,6 +369,7 @@ begin Memo1.Lines.Add('--- Factory Pattern Demo ---'); sw.Start; + root := TAst.Block( [ diff --git a/ASTPlayground/Myc.Ast.Visualizer.pas b/ASTPlayground/Myc.Ast.Visualizer.pas index 267949b..0e5552b 100644 --- a/ASTPlayground/Myc.Ast.Visualizer.pas +++ b/ASTPlayground/Myc.Ast.Visualizer.pas @@ -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; TChildVisitorProc = reference to procedure(const Visitor: IAstVisitor); - TAuraNodeList = TList; - 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; FCurrentExec: TList; @@ -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.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 diff --git a/KI/Prompt-Delphi-Entwicklung.md b/KI/Prompt-Delphi-Entwicklung.md index 897f9ad..dccf999 100644 --- a/KI/Prompt-Delphi-Entwicklung.md +++ b/KI/Prompt-Delphi-Entwicklung.md @@ -48,6 +48,7 @@ - Folgende Schlüsselwörter müssen klein geschrieben werden: and, or, not, mod, div, in, as, is, array of, sizeof(), inc(), dec(), exit, inc, dec, shl, shr - Compiler-Direktiven (z.B. $region) sollen immer klein geschrieben werden. + - Achte darauf keine Schlüsselwörter als Bezeichner (type, Result, if, etc) zu verwenden, da Delphi das nicht unterstützt. * Ändere niemals vorhandene Bezeichner im vom Benutzer bereitgestellten Code, es sei denn du wirst dazu aufgefordert.