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

Ast editor custom draw

Browse Source
This commit is contained in:
Michael Schimmel
2025-12-06 17:32:04 +01:00
parent 9ed563bcc1
commit e40f56eaeb
10 changed files with 1629 additions and 1439 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 -1
View File
@@ -32,7 +32,8 @@ uses
Myc.Fmx.AstEditor.Layout in '..\Src\AST\Myc.Fmx.AstEditor.Layout.pas',
Myc.Fmx.AstEditor.Node in '..\Src\AST\Myc.Fmx.AstEditor.Node.pas',
Myc.Fmx.AstEditor in '..\Src\AST\Myc.Fmx.AstEditor.pas',
Myc.Ast.Refactoring.Remove in '..\Src\AST\Myc.Ast.Refactoring.Remove.pas';
Myc.Ast.Refactoring.Remove in '..\Src\AST\Myc.Ast.Refactoring.Remove.pas',
Myc.Fmx.AstEditor.Render in '..\Src\AST\Myc.Fmx.AstEditor.Render.pas';
{$R *.res}
ASTPlayground/ASTPlayground.dproj
+1
View File
@@ -163,6 +163,7 @@
<DCCReference Include="..\Src\AST\Myc.Fmx.AstEditor.Node.pas"/>
<DCCReference Include="..\Src\AST\Myc.Fmx.AstEditor.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Refactoring.Remove.pas"/>
<DCCReference Include="..\Src\AST\Myc.Fmx.AstEditor.Render.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
Src/AST/Myc.Ast.Dumper.pas
-1
View File
@@ -30,7 +30,6 @@ type
function FormatAddress(const Addr: TResolvedAddress): string;
protected
// Override abstract PROCEDURES from TAstVisitor
function VisitConstant(const Node: IConstantNode): TVoid; override;
function VisitIdentifier(const Node: IIdentifierNode): TVoid; override;
function VisitKeyword(const Node: IKeywordNode): TVoid; override;
Src/AST/Myc.Fmx.AstEditor.Handlers.pas
+74 -186
View File
@@ -9,20 +9,18 @@ uses
System.UITypes,
System.Generics.Collections,
FMX.Types,
FMX.Controls,
FMX.StdCtrls,
FMX.Graphics,
Myc.Data.Value,
Myc.Data.Keyword,
Myc.Ast,
Myc.Ast.Nodes,
Myc.Ast.Identities,
Myc.Fmx.AstEditor.Layout,
Myc.Fmx.AstEditor.Node;
Myc.Fmx.AstEditor.Render, // The new Virtual Engine
Myc.Fmx.AstEditor.Node; // The View Node
type
// --- Abstract List Base ---
// Now implements IReorderable to support drag & drop reordering
// Implements IReorderable to support drag & drop reordering within the virtual tree
TNodeListHandler<T: IAstNode> = class(TBaseNodeHandler<INodeList<T>>, IReorderable)
protected
FChildNodes: TList<TAstViewNode>;
@@ -35,7 +33,7 @@ type
function ReconstructAst(OwnerNode: TAstViewNode): IAstNode; override; abstract;
// IReorderable Implementation
function CanDrag(Child: TControl): Boolean;
function CanDrag(Child: TVisualNode): Boolean;
procedure MoveChild(SourceIndex, TargetIndex: Integer);
end;
@@ -75,7 +73,7 @@ type
TRecordFieldHandler = class(TBaseNodeHandler<IRecordFieldNode>)
private
FKeyLabel: TLabel;
FKeyLabel: TTextNode;
FValueNode: TAstViewNode;
public
procedure BuildUI(OwnerNode: TAstViewNode); override;
@@ -322,8 +320,7 @@ begin
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth);
OwnerNode.BeginUpdate;
try
// No BeginUpdate/EndUpdate needed for TVisualNode, just property setting
OwnerNode.Frameless := True;
OwnerNode.Orientation := GetOrientation;
OwnerNode.Alignment := GetAlignment;
@@ -351,18 +348,17 @@ begin
lbl.Opacity := 0.5;
end;
end;
finally
OwnerNode.EndUpdate;
end;
end;
// IReorderable Implementation
function TNodeListHandler<T>.CanDrag(Child: TControl): Boolean;
function TNodeListHandler<T>.CanDrag(Child: TVisualNode): Boolean;
begin
// Allow dragging only if the child is one of our managed ViewNodes
Result := (Child is TAstViewNode) and FChildNodes.Contains(TAstViewNode(Child));
// Only allow dragging if the child is one of our managed ViewNodes
if Child is TAstViewNode then
Result := FChildNodes.Contains(TAstViewNode(Child))
else
Result := False;
end;
procedure TNodeListHandler<T>.MoveChild(SourceIndex, TargetIndex: Integer);
@@ -385,8 +381,7 @@ begin
FChildNodes.Delete(SourceIndex);
FChildNodes.Insert(TargetIndex, item);
// The visual order update will happen upon the next ReconstructAst -> Compile -> BuildUI cycle
// triggered by the controller.
// The visual order update happens via the controller's compilation cycle
end;
{ TParameterListHandler }
@@ -482,26 +477,20 @@ var
visu: IAstVisualizer;
begin
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth);
OwnerNode.BeginUpdate;
try
OwnerNode.Frameless := True;
OwnerNode.Orientation := loHorizontal;
OwnerNode.Alignment := laCenter;
FKeyLabel := OwnerNode.AddLabel(OwnerNode, ':' + FNode.Key.Value.Name);
FKeyLabel.Font.Style := FKeyLabel.Font.Style + [TFontStyle.fsBold];
FKeyLabel.StyledSettings := FKeyLabel.StyledSettings - [TStyledSetting.FontColor];
FKeyLabel.FontColor := TAlphaColors.Mediumvioletred;
FKeyLabel.FontSettings.Font.Style := [TFontStyle.fsBold];
FKeyLabel.Color := TAlphaColors.Mediumvioletred;
FValueNode := visu.CallAccept(FNode.Value);
finally
OwnerNode.EndUpdate;
end;
end;
function TRecordFieldHandler.ReconstructAst(OwnerNode: TAstViewNode): IAstNode;
begin
// Updated to use new Factory Overload to preserve Identity
Result := TAst.RecordField(FNode.Identity, FNode.Key, FValueNode.CreateAst);
end;
@@ -511,11 +500,8 @@ procedure TConstantNodeHandler.BuildUI(OwnerNode: TAstViewNode);
var
valueStr: string;
isConcise: Boolean;
titleLabel: TLabel;
valueLabel: TLabel;
titleLabel: TTextNode;
begin
OwnerNode.BeginUpdate;
try
valueStr := FNode.Value.ToString;
isConcise := ((FNode.Value.Kind = TDataValueKind.vkScalar) or (Pos(sLineBreak, valueStr) = 0)) and (Length(valueStr) < 40);
@@ -530,14 +516,9 @@ begin
OwnerNode.Orientation := loVertical;
titleLabel := OwnerNode.AddLabel(OwnerNode, 'Const');
titleLabel.Font.Style := titleLabel.Font.Style + [TFontStyle.fsBold];
titleLabel.FontSettings.Font.Style := [TFontStyle.fsBold];
valueLabel := OwnerNode.AddLabel(OwnerNode, valueStr);
valueLabel.AutoSize := False;
valueLabel.WordWrap := True;
end;
finally
OwnerNode.EndUpdate;
OwnerNode.AddLabel(OwnerNode, valueStr);
end;
end;
@@ -550,13 +531,8 @@ end;
procedure TIdentifierNodeHandler.BuildUI(OwnerNode: TAstViewNode);
begin
OwnerNode.BeginUpdate;
try
OwnerNode.Frameless := True;
OwnerNode.AddLabel(OwnerNode, FNode.Name);
finally
OwnerNode.EndUpdate;
end;
end;
function TIdentifierNodeHandler.ReconstructAst(OwnerNode: TAstViewNode): IAstNode;
@@ -568,17 +544,11 @@ end;
procedure TKeywordNodeHandler.BuildUI(OwnerNode: TAstViewNode);
var
lbl: TLabel;
lbl: TTextNode;
begin
OwnerNode.BeginUpdate;
try
OwnerNode.Frameless := True;
lbl := OwnerNode.AddLabel(OwnerNode, ':' + FNode.Value.Name);
lbl.StyledSettings := lbl.StyledSettings - [TStyledSetting.FontColor];
lbl.FontColor := TAlphaColors.Mediumvioletred;
finally
OwnerNode.EndUpdate;
end;
lbl.Color := TAlphaColors.Mediumvioletred;
end;
function TKeywordNodeHandler.ReconstructAst(OwnerNode: TAstViewNode): IAstNode;
@@ -590,19 +560,14 @@ end;
procedure TNopNodeHandler.BuildUI(OwnerNode: TAstViewNode);
var
lbl: TLabel;
lbl: TTextNode;
begin
OwnerNode.BeginUpdate;
try
OwnerNode.Frameless := True;
OwnerNode.Alignment := TLayoutAlignment.laCenter;
OwnerNode.Orientation := TLayoutOrientation.loHorizontal;
lbl := OwnerNode.AddLabel(OwnerNode, '...');
lbl.Font.Style := lbl.Font.Style + [TFontStyle.fsBold];
lbl.Margins.Rect := TRectF.Create(8, 4, 8, 4);
finally
OwnerNode.EndUpdate;
end;
lbl.FontSettings.Font.Style := [TFontStyle.fsBold];
lbl.Margins := TMarginRect.Create(8, 4, 8, 4);
end;
function TNopNodeHandler.ReconstructAst(OwnerNode: TAstViewNode): IAstNode;
@@ -615,23 +580,19 @@ end;
procedure TBlockExpressionNodeHandler.BuildUI(OwnerNode: TAstViewNode);
var
visu: IAstVisualizer;
titleLabel: TLabel;
titleLabel: TTextNode;
begin
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth + 1);
OwnerNode.BeginUpdate;
try
OwnerNode.Frameless := False;
OwnerNode.Orientation := loVertical;
OwnerNode.Alignment := laFlush;
titleLabel := OwnerNode.AddLabel(OwnerNode, 'do');
titleLabel.Font.Style := titleLabel.Font.Style + [TFontStyle.fsBold];
titleLabel.FontSettings.Font.Style := [TFontStyle.fsBold];
FExpressionsNode := visu.CallAccept(FNode.Expressions);
FExpressionsNode.Frameless := True;
finally
OwnerNode.EndUpdate;
end;
end;
function TBlockExpressionNodeHandler.ReconstructAst(OwnerNode: TAstViewNode): IAstNode;
@@ -643,8 +604,6 @@ end;
procedure TIfExpressionNodeHandler.BuildUI(OwnerNode: TAstViewNode);
begin
OwnerNode.BeginUpdate;
try
OwnerNode.Frameless := False;
OwnerNode.Orientation := loVertical;
OwnerNode.Alignment := laFlush;
@@ -653,9 +612,6 @@ begin
FThenNode := OwnerNode.AddExpr(OwnerNode, 'then', FNode.ThenBranch);
if Assigned(FNode.ElseBranch) then
FElseNode := OwnerNode.AddExpr(OwnerNode, 'else', FNode.ElseBranch);
finally
OwnerNode.EndUpdate;
end;
end;
function TIfExpressionNodeHandler.ReconstructAst(OwnerNode: TAstViewNode): IAstNode;
@@ -677,8 +633,7 @@ var
visu: IAstVisualizer;
begin
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth + 1);
OwnerNode.BeginUpdate;
try
OwnerNode.Frameless := True;
OwnerNode.Orientation := loHorizontal;
FConditionNode := visu.CallAccept(FNode.Condition);
@@ -686,9 +641,6 @@ begin
FThenNode := visu.CallAccept(FNode.ThenBranch);
OwnerNode.AddLabel(OwnerNode, ':');
FElseNode := visu.CallAccept(FNode.ElseBranch);
finally
OwnerNode.EndUpdate;
end;
end;
function TTernaryExpressionNodeHandler.ReconstructAst(OwnerNode: TAstViewNode): IAstNode;
@@ -701,12 +653,11 @@ end;
procedure TLambdaExpressionNodeHandler.BuildUI(OwnerNode: TAstViewNode);
var
visu: IAstVisualizer;
titleContainer: TAutoFitControl;
lbl: TLabel;
titleContainer: TAutoFitLayout;
lbl: TTextNode;
begin
visu := OwnerNode.Visualizer.Clone(OwnerNode, 0);
OwnerNode.BeginUpdate;
try
OwnerNode.Frameless := False;
OwnerNode.Orientation := loVertical;
OwnerNode.Alignment := laFlush;
@@ -714,7 +665,7 @@ begin
titleContainer := OwnerNode.AddContainer(OwnerNode, loHorizontal, laCenter);
lbl := OwnerNode.AddLabel(titleContainer, 'fn');
lbl.Font.Style := lbl.Font.Style + [TFontStyle.fsBold];
lbl.FontSettings.Font.Style := [TFontStyle.fsBold];
// Parameters: Delegate to List Handler
var paramVisu := visu.Clone(titleContainer, 0);
@@ -723,9 +674,6 @@ begin
// Body
FBodyNode := visu.CallAccept(FNode.Body);
FBodyNode.Frameless := False;
finally
OwnerNode.EndUpdate;
end;
end;
function TLambdaExpressionNodeHandler.ReconstructAst(OwnerNode: TAstViewNode): IAstNode;
@@ -749,23 +697,19 @@ end;
procedure TFunctionCallNodeHandler.BuildUI(OwnerNode: TAstViewNode);
var
visu: IAstVisualizer;
callLabel: TLabel;
callLabel: TTextNode;
begin
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth + 1);
OwnerNode.BeginUpdate;
try
OwnerNode.Frameless := True;
OwnerNode.Orientation := loHorizontal;
callLabel := OwnerNode.AddLabel(OwnerNode, 'call ');
callLabel.Font.Style := callLabel.Font.Style + [TFontStyle.fsBold];
callLabel.FontSettings.Font.Style := [TFontStyle.fsBold];
FCalleeNode := visu.CallAccept(FNode.Callee);
FArgumentsNode := visu.CallAccept(FNode.Arguments);
finally
OwnerNode.EndUpdate;
end;
end;
function TFunctionCallNodeHandler.ReconstructAst(OwnerNode: TAstViewNode): IAstNode;
@@ -787,19 +731,15 @@ end;
procedure TMacroExpansionNodeHandler.BuildUI(OwnerNode: TAstViewNode);
var
visu: IAstVisualizer;
titleLabel: TLabel;
titleLabel: TTextNode;
begin
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth + 1);
OwnerNode.BeginUpdate;
try
OwnerNode.Frameless := False;
OwnerNode.Orientation := loVertical;
titleLabel := OwnerNode.AddLabel(OwnerNode, 'Macro Expansion');
titleLabel.Font.Style := titleLabel.Font.Style + [TFontStyle.fsBold];
titleLabel.FontSettings.Font.Style := [TFontStyle.fsBold];
FExpandedBodyNode := visu.CallAccept(FNode.ExpandedBody);
finally
OwnerNode.EndUpdate;
end;
end;
function TMacroExpansionNodeHandler.ReconstructAst(OwnerNode: TAstViewNode): IAstNode;
@@ -812,21 +752,17 @@ end;
procedure TRecurNodeHandler.BuildUI(OwnerNode: TAstViewNode);
var
visu: IAstVisualizer;
titleLabel: TLabel;
titleLabel: TTextNode;
begin
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth + 1);
OwnerNode.BeginUpdate;
try
OwnerNode.Frameless := True;
OwnerNode.Orientation := loHorizontal;
titleLabel := OwnerNode.AddLabel(OwnerNode, 'recur');
titleLabel.Font.Style := titleLabel.Font.Style + [TFontStyle.fsBold];
titleLabel.FontSettings.Font.Style := [TFontStyle.fsBold];
FArgumentsNode := visu.CallAccept(FNode.Arguments);
finally
OwnerNode.EndUpdate;
end;
end;
function TRecurNodeHandler.ReconstructAst(OwnerNode: TAstViewNode): IAstNode;
@@ -839,17 +775,16 @@ end;
procedure TVariableDeclarationNodeHandler.BuildUI(OwnerNode: TAstViewNode);
var
visu: IAstVisualizer;
varLabel: TLabel;
varLabel: TTextNode;
begin
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth + 1);
OwnerNode.BeginUpdate;
try
OwnerNode.Frameless := True;
OwnerNode.Orientation := loHorizontal;
varLabel := OwnerNode.AddLabel(OwnerNode, 'var');
varLabel.Font.Style := varLabel.Font.Style + [TFontStyle.fsBold];
varLabel.FontSettings.Font.Style := [TFontStyle.fsBold];
FTargetNode := visu.CallAccept(FNode.Target);
if Assigned(FNode.Initializer) then
@@ -859,9 +794,6 @@ begin
end
else
FInitializerNode := nil;
finally
OwnerNode.EndUpdate;
end;
end;
function TVariableDeclarationNodeHandler.ReconstructAst(OwnerNode: TAstViewNode): IAstNode;
@@ -882,16 +814,12 @@ var
visu: IAstVisualizer;
begin
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth + 1);
OwnerNode.BeginUpdate;
try
OwnerNode.Frameless := True;
OwnerNode.Orientation := loHorizontal;
FTargetNode := visu.CallAccept(FNode.Target);
OwnerNode.AddLabel(OwnerNode, ':=');
FValueNode := visu.CallAccept(FNode.Value);
finally
OwnerNode.EndUpdate;
end;
end;
function TAssignmentNodeHandler.ReconstructAst(OwnerNode: TAstViewNode): IAstNode;
@@ -904,27 +832,23 @@ end;
procedure TMacroDefinitionNodeHandler.BuildUI(OwnerNode: TAstViewNode);
var
visu: IAstVisualizer;
titleLabel: TLabel;
titleContainer: TAutoFitControl;
titleLabel: TTextNode;
titleContainer: TAutoFitLayout;
begin
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth + 1);
OwnerNode.BeginUpdate;
try
OwnerNode.Frameless := False;
OwnerNode.Orientation := loVertical;
titleContainer := OwnerNode.AddContainer(OwnerNode, loHorizontal, laCenter);
titleLabel := OwnerNode.AddLabel(titleContainer, 'Macro Def: ' + FNode.Name.Name);
titleLabel.Font.Style := titleLabel.Font.Style + [TFontStyle.fsBold];
titleLabel.FontSettings.Font.Style := [TFontStyle.fsBold];
// Parameters List
var paramVisu := visu.Clone(titleContainer, visu.ExprDepth);
FParamsNode := paramVisu.CallAccept(FNode.Parameters);
FBodyNode := visu.CallAccept(FNode.Body);
finally
OwnerNode.EndUpdate;
end;
end;
function TMacroDefinitionNodeHandler.ReconstructAst(OwnerNode: TAstViewNode): IAstNode;
@@ -937,19 +861,15 @@ end;
procedure TQuasiquoteNodeHandler.BuildUI(OwnerNode: TAstViewNode);
var
visu: IAstVisualizer;
titleLabel: TLabel;
titleLabel: TTextNode;
begin
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth + 1);
OwnerNode.BeginUpdate;
try
OwnerNode.Frameless := False;
OwnerNode.Orientation := loVertical;
titleLabel := OwnerNode.AddLabel(OwnerNode, 'Quasiquote');
titleLabel.Font.Style := titleLabel.Font.Style + [TFontStyle.fsBold];
titleLabel.FontSettings.Font.Style := [TFontStyle.fsBold];
FExpressionNode := visu.CallAccept(FNode.Expression);
finally
OwnerNode.EndUpdate;
end;
end;
function TQuasiquoteNodeHandler.ReconstructAst(OwnerNode: TAstViewNode): IAstNode;
@@ -962,26 +882,25 @@ end;
procedure TUnquoteNodeHandler.BuildUI(OwnerNode: TAstViewNode);
var
visu: IAstVisualizer;
leftBracket, rightBracket: TLabel;
leftBracket, rightBracket: TTextNode;
begin
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth + 1);
OwnerNode.BeginUpdate;
try
OwnerNode.Frameless := True;
OwnerNode.Orientation := loHorizontal;
leftBracket := OwnerNode.AddLabel(OwnerNode, '<');
leftBracket.Padding.Right := 0;
leftBracket.Margins.Right := 0;
// We cannot assign to fields of record properties directly.
// Replace the entire margin record.
// Default from AddLabel is (cNodePadding, cTitleTopPadding, cNodePadding, cTitleBottomPadding)
// We want Right Margin = 0.
leftBracket.Margins := TMarginRect.Create(cNodePadding, cTitleTopPadding, 0, cTitleBottomPadding);
FExpressionNode := visu.CallAccept(FNode.Expression);
rightBracket := OwnerNode.AddLabel(OwnerNode, '>');
rightBracket.Padding.Left := 0;
rightBracket.Margins.Left := 0;
finally
OwnerNode.EndUpdate;
end;
// We want Left Margin = 0.
rightBracket.Margins := TMarginRect.Create(0, cTitleTopPadding, cNodePadding, cTitleBottomPadding);
end;
function TUnquoteNodeHandler.ReconstructAst(OwnerNode: TAstViewNode): IAstNode;
@@ -994,19 +913,15 @@ end;
procedure TUnquoteSplicingNodeHandler.BuildUI(OwnerNode: TAstViewNode);
var
visu: IAstVisualizer;
titleLabel: TLabel;
titleLabel: TTextNode;
begin
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth + 1);
OwnerNode.BeginUpdate;
try
OwnerNode.Frameless := False;
OwnerNode.Orientation := loVertical;
titleLabel := OwnerNode.AddLabel(OwnerNode, 'Unquote-Splicing');
titleLabel.Font.Style := titleLabel.Font.Style + [TFontStyle.fsBold];
titleLabel.FontSettings.Font.Style := [TFontStyle.fsBold];
FExpressionNode := visu.CallAccept(FNode.Expression);
finally
OwnerNode.EndUpdate;
end;
end;
function TUnquoteSplicingNodeHandler.ReconstructAst(OwnerNode: TAstViewNode): IAstNode;
@@ -1021,17 +936,13 @@ var
visu: IAstVisualizer;
begin
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth + 1);
OwnerNode.BeginUpdate;
try
OwnerNode.Frameless := True;
OwnerNode.Orientation := loHorizontal;
FBaseNode := visu.CallAccept(FNode.Base);
OwnerNode.AddLabel(OwnerNode, '[');
FIndexNode := visu.CallAccept(FNode.Index);
OwnerNode.AddLabel(OwnerNode, ']');
finally
OwnerNode.EndUpdate;
end;
end;
function TIndexerNodeHandler.ReconstructAst(OwnerNode: TAstViewNode): IAstNode;
@@ -1046,21 +957,16 @@ var
visu: IAstVisualizer;
begin
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth + 1);
OwnerNode.BeginUpdate;
try
OwnerNode.Frameless := True;
OwnerNode.Orientation := loHorizontal;
FBaseNode := visu.CallAccept(FNode.Base);
OwnerNode.AddLabel(OwnerNode, '.');
OwnerNode.AddLabel(OwnerNode, FNode.Member.Value.Name);
finally
OwnerNode.EndUpdate;
end;
end;
function TMemberAccessNodeHandler.ReconstructAst(OwnerNode: TAstViewNode): IAstNode;
begin
// Reuse Identifier, Reuse Member Keyword (via TAst.Keyword with Identity)
Result := TAst.MemberAccess(FNode.Identity, FBaseNode.CreateAst, TAst.Keyword(FNode.Member.Identity.AsKeyword), FNode.StaticType);
end;
@@ -1071,17 +977,13 @@ var
visu: IAstVisualizer;
begin
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth + 1);
OwnerNode.BeginUpdate;
try
OwnerNode.Frameless := False;
OwnerNode.Orientation := loVertical;
OwnerNode.Alignment := laFlush;
// Delegate to RecordFieldList
FFieldsNode := visu.CallAccept(FNode.Fields);
finally
OwnerNode.EndUpdate;
end;
end;
function TRecordLiteralNodeHandler.ReconstructAst(OwnerNode: TAstViewNode): IAstNode;
@@ -1100,17 +1002,12 @@ end;
procedure TCreateSeriesNodeHandler.BuildUI(OwnerNode: TAstViewNode);
var
titleLabel: TLabel;
titleLabel: TTextNode;
begin
OwnerNode.BeginUpdate;
try
OwnerNode.Frameless := False;
OwnerNode.Orientation := loVertical;
titleLabel := OwnerNode.AddLabel(OwnerNode, 'Create Series: ' + FNode.Definition);
titleLabel.Font.Style := titleLabel.Font.Style + [TFontStyle.fsBold];
finally
OwnerNode.EndUpdate;
end;
titleLabel.FontSettings.Font.Style := [TFontStyle.fsBold];
end;
function TCreateSeriesNodeHandler.ReconstructAst(OwnerNode: TAstViewNode): IAstNode;
@@ -1123,25 +1020,21 @@ end;
procedure TAddSeriesItemNodeHandler.BuildUI(OwnerNode: TAstViewNode);
var
visu: IAstVisualizer;
titleLabel: TLabel;
titleLabel: TTextNode;
begin
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth + 1);
OwnerNode.BeginUpdate;
try
OwnerNode.Frameless := False;
OwnerNode.Orientation := loVertical;
titleLabel := OwnerNode.AddLabel(OwnerNode, 'Add Item to: ' + FNode.Series.Name);
titleLabel.Font.Style := titleLabel.Font.Style + [TFontStyle.fsBold];
titleLabel.FontSettings.Font.Style := [TFontStyle.fsBold];
FValueNode := visu.CallAccept(FNode.Value);
if Assigned(FNode.Lookback) then
FLookbackNode := visu.CallAccept(FNode.Lookback)
else
FLookbackNode := nil;
finally
OwnerNode.EndUpdate;
end;
end;
function TAddSeriesItemNodeHandler.ReconstructAst(OwnerNode: TAstViewNode): IAstNode;
@@ -1167,17 +1060,12 @@ end;
procedure TSeriesLengthNodeHandler.BuildUI(OwnerNode: TAstViewNode);
var
titleLabel: TLabel;
titleLabel: TTextNode;
begin
OwnerNode.BeginUpdate;
try
OwnerNode.Frameless := False;
OwnerNode.Orientation := loVertical;
titleLabel := OwnerNode.AddLabel(OwnerNode, 'Length of: ' + FNode.Series.Name);
titleLabel.Font.Style := titleLabel.Font.Style + [TFontStyle.fsBold];
finally
OwnerNode.EndUpdate;
end;
titleLabel.FontSettings.Font.Style := [TFontStyle.fsBold];
end;
function TSeriesLengthNodeHandler.ReconstructAst(OwnerNode: TAstViewNode): IAstNode;
Src/AST/Myc.Fmx.AstEditor.Node.pas
+174 -260
View File
@@ -12,13 +12,11 @@ uses
System.Generics.Defaults,
System.Generics.Collections,
FMX.Types,
FMX.Controls,
FMX.Objects,
FMX.Graphics,
FMX.StdCtrls,
FMX.TextLayout,
Myc.Ast.Nodes,
Myc.Fmx.AstEditor.Workspace,
Myc.Fmx.AstEditor.Layout;
Myc.Fmx.AstEditor.Render,
Myc.Fmx.AstEditor.Workspace;
const
cNodePadding = 10;
@@ -26,7 +24,7 @@ const
cTitleBottomPadding = 4;
cMinNodeWidth = 10;
cMinNodeHeight = 10;
cDragGutterWidth = 20; // Width of the trigger zone for dragging
cDragGutterWidth = 20;
type
TAstViewNode = class;
@@ -40,26 +38,26 @@ type
IReorderable = interface
['{9FA7C504-D327-4E00-A5FE-DD2876886212}']
function CanDrag(Child: TControl): Boolean;
function CanDrag(Child: TVisualNode): Boolean;
procedure MoveChild(SourceIndex, TargetIndex: Integer);
end;
IAstVisualizer = interface
{$region 'private'}
function GetExprDepth: Integer;
function GetParentControl: TControl;
function GetParentNode: TVisualNode;
function GetWorkspace: TWorkspace;
{$endregion}
function Clone(ParentControl: TControl; ExprDepth: Integer): IAstVisualizer;
function Clone(ParentNode: TVisualNode; ExprDepth: Integer): IAstVisualizer;
function CallAccept(const Node: IAstNode): TAstViewNode;
property ExprDepth: Integer read GetExprDepth;
property ParentControl: TControl read GetParentControl;
property ParentNode: TVisualNode read GetParentNode;
property Workspace: TWorkspace read GetWorkspace;
end;
TAstViewNode = class(TAutoFitControl)
TAstViewNode = class(TAutoFitLayout)
private
FBackgroundColor: TAlphaColor;
FBorderColor: TAlphaColor;
@@ -73,6 +71,7 @@ type
FTypeInfoText: string;
FIsFocused: Boolean;
FIsHovered: Boolean;
procedure SetBackgroundColor(const Value: TAlphaColor);
procedure SetBorderColor(const Value: TAlphaColor);
@@ -83,28 +82,27 @@ type
procedure SetErrorMessage(const Value: string);
procedure SetTypeInfoText(const Value: string);
procedure UpdateVisualState;
procedure SetIsFocused(const Value: Boolean);
procedure InvalidateVisuals;
protected
procedure Paint; override;
procedure DoPaint(Canvas: TCanvas; const Offset: TPointF); override;
procedure SetupNode;
procedure DoMouseEnter; override;
procedure DoMouseLeave; 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;
public
constructor Create(const AVisualizer: IAstVisualizer; const AHandler: IAstViewNodeHandler); 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): TAstViewNode;
procedure MouseEnter; override;
procedure MouseLeave; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
procedure MouseMove(Shift: TShiftState; X, Y: Single); override;
function AddLabel(Parent: TVisualNode; const Txt: String): TTextNode;
function AddContainer(Parent: TVisualNode; Orientation: TLayoutOrientation; Alignment: TLayoutAlignment): TAutoFitLayout;
function AddExpr(Parent: TVisualNode; const Title: String; const Node: IAstNode): TAstViewNode;
function CreateAst: IAstNode;
@@ -116,42 +114,11 @@ type
property TypeInfoText: string read FTypeInfoText write SetTypeInfoText;
property IsFocused: Boolean read FIsFocused write SetIsFocused;
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;
TBaseNodeHandler<T: IAstNode> = class(TInterfacedObject, IAstViewNodeHandler)
@@ -173,9 +140,10 @@ uses
constructor TAstViewNode.Create(const AVisualizer: IAstVisualizer; const AHandler: IAstViewNodeHandler);
begin
inherited Create(AVisualizer.Workspace);
inherited Create(AVisualizer.Workspace as IVisualHost);
Parent := AVisualizer.ParentControl;
if Assigned(AVisualizer.ParentNode) then
AVisualizer.ParentNode.AddChild(Self);
FVisualizer := AVisualizer.Clone(Self, AVisualizer.ExprDepth);
FHandler := AHandler;
@@ -187,25 +155,18 @@ begin
FFrameless := False;
FIsFocused := False;
FIsHovered := False;
Width := cMinNodeWidth;
Height := cMinNodeHeight;
Size := TSizeF.Create(cMinNodeWidth, cMinNodeHeight);
HitTest := True;
ClipChildren := True;
HitTestEnabled := 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;
Margins := TMarginRect.Create(4, 4, 4, 4);
Padding := TMarginRect.Create(3, 3, 3, 3);
var cn: Cardinal := $ea - (7 * FVisualizer.ExprDepth);
var c: Cardinal := $ff000000 or (cn shl 16) or (cn shl 8) or cn;
BackgroundColor := c;
FBackgroundColor := c;
end;
destructor TAstViewNode.Destroy;
@@ -214,103 +175,18 @@ begin
inherited;
end;
procedure TAstViewNode.DoMouseEnter;
begin
inherited;
Repaint;
end;
procedure TAstViewNode.DoMouseLeave;
begin
inherited;
Repaint;
end;
procedure TAstViewNode.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
const
cHeaderHeight = 30; // Defined height for header drag area
begin
// Check for Drag Start.
// Condition: Left Click AND we are part of a container (list)
if (Button = TMouseButton.mbLeft) and (Parent is TAutoFitControl) then
begin
// Hit-Test: Either Gutter (Left) OR Header area (Top)
if (X < cDragGutterWidth) or (Y < cHeaderHeight) then
begin
if Assigned(FVisualizer.Workspace) then
begin
FVisualizer.Workspace.BeginDragNode(Self);
Exit;
end;
end;
end;
inherited;
end;
procedure TAstViewNode.MouseMove(Shift: TShiftState; X, Y: Single);
const
cHeaderHeight = 30;
begin
// Cursor Logic (Hover Feedback)
if (Parent is TAutoFitControl) and ((X < cDragGutterWidth) or (Y < cHeaderHeight)) then
Cursor := crSizeAll
else
Cursor := crDefault;
inherited;
end;
procedure TAstViewNode.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
inherited;
end;
function TAstViewNode.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 TAstViewNode.AddExpr(Parent: TControl; const Title: String; const Node: IAstNode): TAstViewNode;
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 TAstViewNode.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 TAstViewNode.AfterConstruction;
begin
inherited;
SetupNode;
end;
procedure TAstViewNode.SetupNode;
begin
if Assigned(FHandler) then
FHandler.BuildUI(Self);
end;
function TAstViewNode.CreateAst: IAstNode;
begin
if Assigned(FHandler) then
@@ -327,154 +203,142 @@ begin
Result := nil;
end;
procedure TAstViewNode.SetErrorMessage(const Value: string);
function TAstViewNode.AddContainer(Parent: TVisualNode; Orientation: TLayoutOrientation; Alignment: TLayoutAlignment): TAutoFitLayout;
begin
if FErrorMessage <> Value then
begin
FErrorMessage := Value;
UpdateVisualState;
Repaint;
end;
Result := TAutoFitLayout.Create(Host);
Parent.AddChild(Result);
Result.Orientation := Orientation;
Result.Alignment := Alignment;
Result.HitTestEnabled := False;
end;
procedure TAstViewNode.SetTypeInfoText(const Value: string);
function TAstViewNode.AddExpr(Parent: TVisualNode; const Title: String; const Node: IAstNode): TAstViewNode;
begin
if FTypeInfoText <> Value then
begin
FTypeInfoText := Value;
UpdateVisualState;
end;
var cont := AddContainer(Parent, loHorizontal, laCenter);
var lbl := AddLabel(cont, Title);
lbl.FontSettings.Font.Style := [TFontStyle.fsBold];
Result := FVisualizer.Clone(cont, FVisualizer.ExprDepth + 1).CallAccept(Node);
end;
procedure TAstViewNode.SetIsFocused(const Value: Boolean);
function TAstViewNode.AddLabel(Parent: TVisualNode; const Txt: String): TTextNode;
begin
if FIsFocused <> Value then
begin
FIsFocused := Value;
Repaint;
end;
Result := TTextNode.Create(Host);
Parent.AddChild(Result);
Result.Margins := TMarginRect.Create(cNodePadding, cTitleTopPadding, cNodePadding, cTitleBottomPadding);
Result.Padding := TMarginRect.Create(0, 0, 0, 0);
Result.Text := Txt;
end;
procedure TAstViewNode.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 TAstViewNode.Paint;
procedure TAstViewNode.DoPaint(Canvas: TCanvas; const Offset: TPointF);
var
rect: TRectF;
effBorderColor: TAlphaColor;
effBorderWidth: Single;
effDash: TStrokeDash;
isHovering: Boolean;
shouldIgnoreHover: Boolean;
Rect: TRectF;
EffBorderColor: TAlphaColor;
EffBorderWidth: Single;
EffDash: TStrokeDash;
ShouldIgnoreHover: Boolean;
begin
inherited;
Rect := TRectF.Create(Offset, Size.Width, Size.Height);
shouldIgnoreHover := False;
ShouldIgnoreHover := False;
if Assigned(Node) then
begin
case Node.Kind of
akBlockExpression, akParameterList, akArgumentList, akExpressionList, akRecordFieldList: shouldIgnoreHover := True;
akBlockExpression, akParameterList, akArgumentList, akExpressionList, akRecordFieldList: ShouldIgnoreHover := True;
end;
end;
isHovering := IsMouseOver and (not shouldIgnoreHover);
// 1. Determine Base Style
if FFrameless then
begin
effBorderColor := FBorderColor;
effBorderWidth := FBorderWidth;
effDash := TStrokeDash.Dot;
EffBorderColor := FBorderColor;
EffBorderWidth := FBorderWidth;
EffDash := TStrokeDash.Dot;
end
else
begin
effBorderColor := FBorderColor;
effBorderWidth := FBorderWidth;
effDash := TStrokeDash.Solid;
EffBorderColor := FBorderColor;
EffBorderWidth := FBorderWidth;
EffDash := TStrokeDash.Solid;
end;
// 2. Hover Overlay
if isHovering then
if FIsHovered and (not ShouldIgnoreHover) then
begin
effBorderColor := TAlphaColors.White;
effBorderWidth := Max(2.0, FBorderWidth + 1.0);
effDash := TStrokeDash.Solid;
EffBorderColor := TAlphaColors.White;
EffBorderWidth := Max(2.0, FBorderWidth + 1.0);
EffDash := TStrokeDash.Solid;
end;
// 3. Error Overlay (High Priority for Color)
if FErrorMessage <> '' then
begin
effBorderColor := TAlphaColors.Red;
effBorderWidth := 2.0;
effDash := TStrokeDash.Solid;
EffBorderColor := TAlphaColors.Red;
EffBorderWidth := 2.0;
EffDash := TStrokeDash.Solid;
end;
// 4. Focus Overlay (Highest Priority for Visibility/Color)
// Note: If Error is present, Focus will override color to Blue to indicate "Active Cursor".
// Error text is available in Hint.
if FIsFocused then
begin
effBorderColor := TAlphaColors.Dodgerblue;
effBorderWidth := 2.0;
effDash := TStrokeDash.Solid;
EffBorderColor := TAlphaColors.Dodgerblue;
EffBorderWidth := 2.0;
EffDash := TStrokeDash.Solid;
end;
Canvas.Fill.Kind := TBrushKind.Solid;
Canvas.Fill.Color := FBackgroundColor;
if FFrameless and (FErrorMessage = '') and (not isHovering) and (not FIsFocused) then
if FFrameless and (FErrorMessage = '') and (not FIsHovered) and (not FIsFocused) then
begin
Canvas.FillRect(TRectF.Create(0, 0, Width, Height), 0, 0, [], 1.0);
Canvas.FillRect(Rect, 0, 0, AllCorners, 1.0);
if FBorderWidth > 0 then
begin
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);
Canvas.Stroke.Color := EffBorderColor;
Canvas.Stroke.Thickness := EffBorderWidth;
Canvas.Stroke.Dash := EffDash;
Canvas.DrawRect(Rect, 0, 0, AllCorners, 1.0);
end;
end
else
begin
rect := TRectF.Create(0, 0, Width, Height);
if (effBorderWidth > 0) then
rect.Inflate(-effBorderWidth / 2, -effBorderWidth / 2);
var DrawRect := Rect;
if EffBorderWidth > 0 then
DrawRect.Inflate(-EffBorderWidth / 2, -EffBorderWidth / 2);
Canvas.FillRect(rect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round);
Canvas.FillRect(DrawRect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round);
if (effBorderWidth > 0) and (effBorderColor <> TAlphaColors.Null) then
if (EffBorderWidth > 0) and (EffBorderColor <> TAlphaColors.Null) then
begin
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);
Canvas.Stroke.Color := EffBorderColor;
Canvas.Stroke.Thickness := EffBorderWidth;
Canvas.Stroke.Dash := EffDash;
Canvas.DrawRect(DrawRect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round);
end;
end;
if isHovering and (Parent is TAutoFitControl) then
if FIsHovered and (Parent is TAutoFitLayout) then
begin
Canvas.Fill.Color := TAlphaColors.DimGray;
Canvas.FillEllipse(TRectF.Create(4, 6, 8, 10), 1.0);
Canvas.FillEllipse(TRectF.Create(4, 12, 8, 16), 1.0);
Canvas.FillEllipse(TRectF.Create(4, 18, 8, 22), 1.0);
Canvas.FillEllipse(TRectF.Create(Offset.X + 4, Offset.Y + 6, Offset.X + 12, Offset.Y + 14), 1.0);
Canvas.FillEllipse(TRectF.Create(Offset.X + 4, Offset.Y + 16, Offset.X + 12, Offset.Y + 24), 1.0);
end;
end;
procedure TAstViewNode.InvalidateVisuals;
begin
if Assigned(Host) then
Host.InvalidateRect(AbsoluteRect);
end;
procedure TAstViewNode.SetBackgroundColor(const Value: TAlphaColor);
begin
if FBackgroundColor <> Value then
begin
FBackgroundColor := Value;
InvalidateVisuals;
end;
end;
@@ -483,7 +347,7 @@ begin
if FBorderColor <> Value then
begin
FBorderColor := Value;
Repaint;
InvalidateVisuals;
end;
end;
@@ -492,7 +356,7 @@ begin
if FBorderRadius <> Value then
begin
FBorderRadius := Value;
Repaint;
InvalidateVisuals;
end;
end;
@@ -501,7 +365,17 @@ begin
if FBorderWidth <> Value then
begin
FBorderWidth := Value;
Repaint;
RequestLayout;
InvalidateVisuals;
end;
end;
procedure TAstViewNode.SetErrorMessage(const Value: string);
begin
if FErrorMessage <> Value then
begin
FErrorMessage := Value;
InvalidateVisuals;
end;
end;
@@ -510,20 +384,60 @@ begin
if FFrameless <> Value then
begin
FFrameless := Value;
Repaint;
InvalidateVisuals;
end;
end;
procedure TAstViewNode.SetBackgroundColor(const Value: TAlphaColor);
procedure TAstViewNode.SetIsFocused(const Value: Boolean);
begin
FBackgroundColor := Value;
Repaint;
if FIsFocused <> Value then
begin
FIsFocused := Value;
InvalidateVisuals;
end;
end;
procedure TAstViewNode.SetupNode;
procedure TAstViewNode.SetTypeInfoText(const Value: string);
begin
if Assigned(FHandler) then
FHandler.BuildUI(Self);
if FTypeInfoText <> Value then
begin
FTypeInfoText := Value;
end;
end;
procedure TAstViewNode.MouseEnter;
begin
FIsHovered := True;
InvalidateVisuals;
end;
procedure TAstViewNode.MouseLeave;
begin
FIsHovered := False;
InvalidateVisuals;
end;
procedure TAstViewNode.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
const
cHeaderHeight = 30;
begin
if (Button = TMouseButton.mbLeft) and (Parent is TAutoFitLayout) then
begin
if (X < cDragGutterWidth) or (Y < cHeaderHeight) then
begin
if Assigned(FVisualizer.Workspace) then
begin
FVisualizer.Workspace.BeginDragNode(Self);
Exit;
end;
end;
end;
inherited;
end;
procedure TAstViewNode.MouseMove(Shift: TShiftState; X, Y: Single);
begin
inherited;
end;
{ TBaseNodeHandler<T> }
Src/AST/Myc.Fmx.AstEditor.Render.pas
+626
View File
@@ -0,0 +1,626 @@
unit Myc.Fmx.AstEditor.Render;
interface
uses
System.Types,
System.UITypes,
System.Classes,
System.SysUtils,
System.Math,
System.Generics.Collections,
FMX.Types,
FMX.Graphics,
FMX.TextLayout;
type
TVisualNode = class;
// Interface for the host (e.g. TWorkspace) to request repaints/layouts
IVisualHost = interface
['{A9E2BD60-281B-42A2-9DB5-3100E8EF1519}']
procedure InvalidateRect(const R: TRectF);
procedure RequestLayout;
function GetCanvas: TCanvas;
end;
// Helper structure for margins and padding
TMarginRect = record
Left, Top, Right, Bottom: Single;
function Width: Single; inline;
function Height: Single; inline;
class function Create(L, T, R, B: Single): TMarginRect; static; inline;
class operator Initialize(out Dest: TMarginRect);
end;
// The base class for all virtual UI elements (Flyweight)
TVisualNode = class
private
FHost: IVisualHost;
FParent: TVisualNode;
FChildren: TList<TVisualNode>;
// Data stored as Position and Size (Layout Model)
// Direct field access is preferred within the unit
FPosition: TPointF;
FSize: TSizeF;
FPadding: TMarginRect;
FMargins: TMarginRect;
FVisible: Boolean;
FHitTest: Boolean;
FTag: NativeInt;
FOpacity: Single;
procedure SetParent(const Value: TVisualNode);
protected
procedure SetHost(const Value: IVisualHost); virtual;
// Called to paint the node-specific content (background, etc.)
procedure DoPaint(Canvas: TCanvas; const Offset: TPointF); virtual;
public
constructor Create(AHost: IVisualHost = nil); virtual;
destructor Destroy; override;
// Layout system
procedure RequestLayout;
procedure RecalcLayout; virtual;
// Geometry
function GetAbsolutePosition: TPointF;
function LocalToAbsolute(const P: TPointF): TPointF;
function AbsoluteToLocal(const P: TPointF): TPointF;
function AbsoluteRect: TRectF;
function HitTest(const P: TPointF): TVisualNode; virtual;
// Rendering pipeline
// Offset is the absolute position of the parent content area
procedure Paint(Canvas: TCanvas; const Offset: TPointF);
// Child Management
procedure AddChild(Child: TVisualNode);
procedure RemoveChild(Child: TVisualNode);
procedure DeleteChildren;
function GetChildCount: Integer; inline;
function GetChild(Index: Integer): TVisualNode; inline;
// Interaction stubs (called by the host)
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); virtual;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); virtual;
procedure MouseMove(Shift: TShiftState; X, Y: Single); virtual;
procedure MouseEnter; virtual;
procedure MouseLeave; virtual;
property Host: IVisualHost read FHost;
property Parent: TVisualNode read FParent;
// Direct field access via properties
property Position: TPointF read FPosition write FPosition;
property Size: TSizeF read FSize write FSize;
property Padding: TMarginRect read FPadding write FPadding;
property Margins: TMarginRect read FMargins write FMargins;
property Visible: Boolean read FVisible write FVisible;
property HitTestEnabled: Boolean read FHitTest write FHitTest;
property Opacity: Single read FOpacity write FOpacity;
property Tag: NativeInt read FTag write FTag;
end;
// Lightweight replacement for TLabel
TTextNode = class(TVisualNode)
private
FText: string;
FLayout: TTextLayout;
FFontSettings: TTextSettings; // Stores font properties
FColor: TAlphaColor;
FIsLayoutDirty: Boolean;
procedure SetText(const Value: string);
procedure SetColor(const Value: TAlphaColor);
protected
procedure DoPaint(Canvas: TCanvas; const Offset: TPointF); override;
procedure UpdateTextLayout(Canvas: TCanvas);
public
constructor Create(AHost: IVisualHost = nil); override;
destructor Destroy; override;
procedure RecalcLayout; override;
property Text: string read FText write SetText;
property Color: TAlphaColor read FColor write SetColor;
property FontSettings: TTextSettings read FFontSettings;
end;
TLayoutOrientation = (loVertical, loHorizontal);
TLayoutAlignment = (laCenter, laFlush);
// The Layout Manager
TAutoFitLayout = class(TVisualNode)
private
FOrientation: TLayoutOrientation;
FAlignment: TLayoutAlignment;
procedure SetOrientation(const Value: TLayoutOrientation);
procedure SetAlignment(const Value: TLayoutAlignment);
protected
// TAutoFitLayout is a container, draws no background by default, but propagates Paint to children
procedure DoPaint(Canvas: TCanvas; const Offset: TPointF); override;
public
constructor Create(AHost: IVisualHost = nil); override;
procedure RecalcLayout; override;
// Calculates the insertion index for drag & drop based on coordinates
function GetInsertionIndex(const LocalP: TPointF): Integer;
property Orientation: TLayoutOrientation read FOrientation write SetOrientation;
property Alignment: TLayoutAlignment read FAlignment write SetAlignment;
end;
implementation
{ TMarginRect }
class function TMarginRect.Create(L, T, R, B: Single): TMarginRect;
begin
Result.Left := L;
Result.Top := T;
Result.Right := R;
Result.Bottom := B;
end;
class operator TMarginRect.Initialize(out Dest: TMarginRect);
begin
Dest.Left := 0;
Dest.Top := 0;
Dest.Right := 0;
Dest.Bottom := 0;
end;
function TMarginRect.Height: Single;
begin
Result := Top + Bottom;
end;
function TMarginRect.Width: Single;
begin
Result := Left + Right;
end;
{ TVisualNode }
constructor TVisualNode.Create(AHost: IVisualHost);
begin
inherited Create;
FHost := AHost;
FChildren := TList<TVisualNode>.Create;
FVisible := True;
FHitTest := True;
FOpacity := 1.0;
FPosition := TPointF.Create(0, 0);
FSize := TSizeF.Create(10, 10);
end;
destructor TVisualNode.Destroy;
begin
// Recursive release
for var i := 0 to FChildren.Count - 1 do
FChildren[i].Free;
FChildren.Free;
inherited;
end;
procedure TVisualNode.SetParent(const Value: TVisualNode);
begin
if FParent <> Value then
begin
FParent := Value;
// Propagate host if parent has one
if (FHost = nil) and Assigned(FParent) then
SetHost(FParent.Host);
end;
end;
procedure TVisualNode.SetHost(const Value: IVisualHost);
begin
FHost := Value;
for var Child in FChildren do
Child.SetHost(Value);
end;
procedure TVisualNode.AddChild(Child: TVisualNode);
begin
if Child.Parent <> nil then
Child.Parent.RemoveChild(Child);
FChildren.Add(Child);
Child.SetParent(Self);
RequestLayout;
end;
procedure TVisualNode.RemoveChild(Child: TVisualNode);
begin
FChildren.Remove(Child);
Child.FParent := nil;
RequestLayout;
end;
procedure TVisualNode.DeleteChildren;
begin
for var i := 0 to FChildren.Count - 1 do
FChildren[i].Free;
FChildren.Clear;
RequestLayout;
end;
function TVisualNode.GetChild(Index: Integer): TVisualNode;
begin
Result := FChildren[Index];
end;
function TVisualNode.GetChildCount: Integer;
begin
Result := FChildren.Count;
end;
procedure TVisualNode.RequestLayout;
begin
if Assigned(FParent) then
FParent.RequestLayout
else if Assigned(FHost) then
FHost.RequestLayout;
end;
procedure TVisualNode.RecalcLayout;
begin
// Base implementation: Does nothing.
// Subclasses (Layouts) must implement calculation here.
end;
function TVisualNode.GetAbsolutePosition: TPointF;
var
Curr: TVisualNode;
begin
Result := FPosition;
Curr := FParent;
while Assigned(Curr) do
begin
// Add parent position + padding (since we are in the content area)
Result := Result + Curr.FPosition + TPointF.Create(Curr.Padding.Left, Curr.Padding.Top);
Curr := Curr.Parent;
end;
end;
function TVisualNode.LocalToAbsolute(const P: TPointF): TPointF;
begin
Result := GetAbsolutePosition + P;
end;
function TVisualNode.AbsoluteToLocal(const P: TPointF): TPointF;
begin
Result := P - GetAbsolutePosition;
end;
function TVisualNode.AbsoluteRect: TRectF;
begin
Result := TRectF.Create(GetAbsolutePosition, FSize.Width, FSize.Height);
end;
procedure TVisualNode.Paint(Canvas: TCanvas; const Offset: TPointF);
var
AbsPos: TPointF;
ChildOffset: TPointF;
Child: TVisualNode;
begin
if not FVisible then
exit;
// Absolute position of this node
AbsPos := Offset + FPosition;
// 1. Background / Own content
DoPaint(Canvas, AbsPos);
// 2. Draw children
if FChildren.Count > 0 then
begin
// The 0,0 point for children is shifted by padding
ChildOffset := AbsPos + TPointF.Create(FPadding.Left, FPadding.Top);
for Child in FChildren do
Child.Paint(Canvas, ChildOffset);
end;
end;
procedure TVisualNode.DoPaint(Canvas: TCanvas; const Offset: TPointF);
begin
// Stub
end;
function TVisualNode.HitTest(const P: TPointF): TVisualNode;
var
i: Integer;
Child: TVisualNode;
LocalP: TPointF;
ContentOrigin: TPointF;
begin
Result := nil;
if not FVisible or not FHitTest then
exit;
// P is relative to Position of this node. Check if P is inside rect.
if not TRectF.Create(0, 0, FSize.Width, FSize.Height).Contains(P) then
exit;
ContentOrigin := TPointF.Create(FPadding.Left, FPadding.Top);
// Check children in reverse Z-order (topmost first)
for i := FChildren.Count - 1 downto 0 do
begin
Child := FChildren[i];
// Transformation into child coordinates
LocalP := P - ContentOrigin - Child.FPosition;
Result := Child.HitTest(LocalP);
if Result <> nil then
exit;
end;
// If no child hit, it's us
Result := Self;
end;
procedure TVisualNode.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
end;
procedure TVisualNode.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
end;
procedure TVisualNode.MouseMove(Shift: TShiftState; X, Y: Single);
begin
end;
procedure TVisualNode.MouseEnter;
begin
end;
procedure TVisualNode.MouseLeave;
begin
end;
{ TTextNode }
constructor TTextNode.Create(AHost: IVisualHost);
begin
inherited;
FHitTest := False; // Text is usually passive
FIsLayoutDirty := True;
FFontSettings := TTextSettings.Create(nil);
FColor := TAlphaColors.Black;
end;
destructor TTextNode.Destroy;
begin
FreeAndNil(FLayout);
FreeAndNil(FFontSettings);
inherited;
end;
procedure TTextNode.SetText(const Value: string);
begin
if FText <> Value then
begin
FText := Value;
FIsLayoutDirty := True;
RequestLayout;
end;
end;
procedure TTextNode.SetColor(const Value: TAlphaColor);
begin
if FColor <> Value then
begin
FColor := Value;
if Assigned(FHost) then
FHost.InvalidateRect(AbsoluteRect);
end;
end;
procedure TTextNode.UpdateTextLayout(Canvas: TCanvas);
begin
if FIsLayoutDirty or (FLayout = nil) then
begin
if FLayout = nil then
FLayout := TTextLayoutManager.DefaultTextLayout.Create(Canvas);
FLayout.BeginUpdate;
try
FLayout.Text := FText;
FLayout.Font.Assign(FFontSettings.Font);
FLayout.Color := FColor;
FLayout.WordWrap := False;
finally
FLayout.EndUpdate;
end;
FIsLayoutDirty := False;
end;
end;
procedure TTextNode.RecalcLayout;
begin
if Assigned(FHost) then
begin
UpdateTextLayout(FHost.GetCanvas);
FSize.Width := FLayout.TextRect.Width + FPadding.Width;
FSize.Height := FLayout.TextRect.Height + FPadding.Height;
// Safety net for empty strings
if FSize.Width < 1 then
FSize.Width := 5;
if FSize.Height < 1 then
FSize.Height := 10;
end;
end;
procedure TTextNode.DoPaint(Canvas: TCanvas; const Offset: TPointF);
begin
UpdateTextLayout(Canvas);
var P := Offset + TPointF.Create(FPadding.Left, FPadding.Top);
// Set position and color on layout, then render
FLayout.TopLeft := P;
FLayout.Color := FColor;
FLayout.RenderLayout(Canvas);
end;
{ TAutoFitLayout }
constructor TAutoFitLayout.Create(AHost: IVisualHost);
begin
inherited;
FOrientation := loHorizontal;
FAlignment := laCenter;
end;
procedure TAutoFitLayout.SetOrientation(const Value: TLayoutOrientation);
begin
if FOrientation <> Value then
begin
FOrientation := Value;
RequestLayout;
end;
end;
procedure TAutoFitLayout.SetAlignment(const Value: TLayoutAlignment);
begin
if FAlignment <> Value then
begin
FAlignment := Value;
RequestLayout;
end;
end;
procedure TAutoFitLayout.DoPaint(Canvas: TCanvas; const Offset: TPointF);
begin
// TAutoFitLayout is a container, draws no background by default.
inherited DoPaint(Canvas, Offset);
end;
procedure TAutoFitLayout.RecalcLayout;
var
Child: TVisualNode;
CurrentX, CurrentY: Single;
ReqW, ReqH: Single;
begin
// 1. Recursion: Calculate children
for Child in FChildren do
begin
if Child.Visible then
Child.RecalcLayout;
end;
CurrentX := 0;
CurrentY := 0;
ReqW := 0;
ReqH := 0;
// 2. Stacking Logic
if FOrientation = loVertical then
begin
for Child in FChildren do
begin
if not Child.Visible then
continue;
// Set Y-Position
Child.FPosition := TPointF.Create(Child.Margins.Left, CurrentY + Child.Margins.Top);
var ChildTotalH := Child.Size.Height + Child.Margins.Top + Child.Margins.Bottom;
var ChildTotalW := Child.Size.Width + Child.Margins.Left + Child.Margins.Right;
CurrentY := CurrentY + ChildTotalH;
ReqW := Max(ReqW, ChildTotalW);
end;
ReqH := CurrentY;
// 3. Alignment Logic (Cross-Axis)
if FAlignment = laCenter then
begin
for Child in FChildren do
begin
if not Child.Visible then
continue;
var ChildTotalW := Child.Size.Width + Child.Margins.Left + Child.Margins.Right;
var OffsetX := (ReqW - ChildTotalW) * 0.5;
Child.FPosition := TPointF.Create(Child.Margins.Left + OffsetX, Child.FPosition.Y);
end;
end;
end
else // Horizontal
begin
for Child in FChildren do
begin
if not Child.Visible then
continue;
// Set X-Position
Child.FPosition := TPointF.Create(CurrentX + Child.Margins.Left, Child.Margins.Top);
var ChildTotalW := Child.Size.Width + Child.Margins.Left + Child.Margins.Right;
var ChildTotalH := Child.Size.Height + Child.Margins.Top + Child.Margins.Bottom;
CurrentX := CurrentX + ChildTotalW;
ReqH := Max(ReqH, ChildTotalH);
end;
ReqW := CurrentX;
// 3. Alignment Logic (Cross-Axis)
if FAlignment = laCenter then
begin
for Child in FChildren do
begin
if not Child.Visible then
continue;
var ChildTotalH := Child.Size.Height + Child.Margins.Top + Child.Margins.Bottom;
var OffsetY := (ReqH - ChildTotalH) * 0.5;
Child.FPosition := TPointF.Create(Child.FPosition.X, Child.Margins.Top + OffsetY);
end;
end;
end;
// 4. Set own size
FSize.Width := ReqW + FPadding.Width;
FSize.Height := ReqH + FPadding.Height;
end;
function TAutoFitLayout.GetInsertionIndex(const LocalP: TPointF): Integer;
var
i: Integer;
Child: TVisualNode;
Center: Single;
ContentP: TPointF;
begin
// Assumption: Append to end as default
Result := FChildren.Count;
// Convert coords to content area
ContentP := LocalP - TPointF.Create(FPadding.Left, FPadding.Top);
for i := 0 to FChildren.Count - 1 do
begin
Child := FChildren[i];
if not Child.Visible then
continue;
if FOrientation = loVertical then
begin
Center := Child.FPosition.Y + (Child.Size.Height * 0.5);
if ContentP.Y < Center then
exit(i);
end
else
begin
Center := Child.FPosition.X + (Child.Size.Width * 0.5);
if ContentP.X < Center then
exit(i);
end;
end;
end;
end.
Src/AST/Myc.Fmx.AstEditor.Visualizer.pas
+76 -65
View File
@@ -9,65 +9,79 @@ uses
Myc.Data.Value,
Myc.Ast.Nodes,
Myc.Ast.Visitor,
Myc.Fmx.AstEditor.Workspace,
Myc.Fmx.AstEditor.Node,
Myc.Fmx.AstEditor.Handlers;
Myc.Fmx.AstEditor.Render, // Virtual Engine
Myc.Fmx.AstEditor.Node, // View Nodes
Myc.Fmx.AstEditor.Handlers, // Handlers
Myc.Fmx.AstEditor.Workspace; // Host
type
// Inherits from the generic TAstVisitor<TAstViewNode>
// Implementation of the Factory/Visitor for the Virtual Tree
TAstVisualizer = class(TAstVisitor<TAstViewNode>, IAstVisualizer)
private
FExprDepth: Integer;
FParentControl: TControl;
FWorkspace: TWorkspace; // Changed from TAstWorkspace to TWorkspace
FParentNode: TVisualNode; // Changed from TControl
FWorkspace: TWorkspace;
function CallAccept(const Node: IAstNode): TAstViewNode;
// IAstVisualizer Implementation
function GetExprDepth: Integer;
function GetParentControl: TControl;
function GetWorkspace: TWorkspace; // Changed signature
procedure SetExprDepth(const Value: Integer);
procedure SetParentControl(const Value: TControl);
function GetParentNode: TVisualNode;
function GetWorkspace: TWorkspace;
protected
// Visitor implementations for each AST node type.
// --- Visitor Implementations ---
function VisitConstant(const Node: IConstantNode): TAstViewNode; override;
function VisitIdentifier(const Node: IIdentifierNode): TAstViewNode; override;
function VisitKeyword(const Node: IKeywordNode): TAstViewNode; override;
// --- List Visitors (NEW) ---
// Lists
function VisitParameterList(const Node: IParameterList): TAstViewNode; override;
function VisitArgumentList(const Node: IArgumentList): TAstViewNode; override;
function VisitExpressionList(const Node: IExpressionList): TAstViewNode; override;
function VisitRecordFieldList(const Node: IRecordFieldList): TAstViewNode; override;
function VisitRecordField(const Node: IRecordFieldNode): TAstViewNode; override;
// Control Flow
function VisitIfExpression(const Node: IIfExpressionNode): TAstViewNode; override;
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TAstViewNode; override;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstViewNode; override;
function VisitFunctionCall(const Node: IFunctionCallNode): TAstViewNode; override;
function VisitMacroExpansionNode(const Node: IMacroExpansionNode): TAstViewNode; override;
function VisitBlockExpression(const Node: IBlockExpressionNode): TAstViewNode; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstViewNode; override;
function VisitAssignment(const Node: IAssignmentNode): TAstViewNode; override;
function VisitMacroDefinition(const Node: IMacroDefinitionNode): TAstViewNode; override;
function VisitQuasiquote(const Node: IQuasiquoteNode): TAstViewNode; override;
function VisitUnquote(const Node: IUnquoteNode): TAstViewNode; override;
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TAstViewNode; override;
function VisitIndexer(const Node: IIndexerNode): TAstViewNode; override;
function VisitMemberAccess(const Node: IMemberAccessNode): TAstViewNode; override;
function VisitRecordLiteral(const Node: IRecordLiteralNode): TAstViewNode; override;
function VisitCreateSeries(const Node: ICreateSeriesNode): TAstViewNode; override;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TAstViewNode; override;
function VisitSeriesLength(const Node: ISeriesLengthNode): TAstViewNode; override;
function VisitRecurNode(const Node: IRecurNode): TAstViewNode; override;
function VisitNop(const Node: INopNode): TAstViewNode; override;
// Functions
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstViewNode; override;
function VisitFunctionCall(const Node: IFunctionCallNode): TAstViewNode; override;
function VisitMacroExpansionNode(const Node: IMacroExpansionNode): TAstViewNode; override;
// Declarations
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstViewNode; override;
function VisitAssignment(const Node: IAssignmentNode): TAstViewNode; override;
function VisitMacroDefinition(const Node: IMacroDefinitionNode): TAstViewNode; override;
// Metaprogramming
function VisitQuasiquote(const Node: IQuasiquoteNode): TAstViewNode; override;
function VisitUnquote(const Node: IUnquoteNode): TAstViewNode; override;
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TAstViewNode; override;
// Data Access
function VisitIndexer(const Node: IIndexerNode): TAstViewNode; override;
function VisitMemberAccess(const Node: IMemberAccessNode): TAstViewNode; override;
function VisitRecordLiteral(const Node: IRecordLiteralNode): TAstViewNode; override;
// Series
function VisitCreateSeries(const Node: ICreateSeriesNode): TAstViewNode; override;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TAstViewNode; override;
function VisitSeriesLength(const Node: ISeriesLengthNode): TAstViewNode; override;
public
constructor Create(AWorkspace: TWorkspace; AParentControl: TControl; AExprDepth: Integer);
constructor Create(AWorkspace: TWorkspace; AParentNode: TVisualNode; AExprDepth: Integer);
destructor Destroy; override;
function Clone(ParentControl: TControl; ExprDepth: Integer): IAstVisualizer;
function Clone(ParentNode: TVisualNode; ExprDepth: Integer): IAstVisualizer;
property ExprDepth: Integer read GetExprDepth write SetExprDepth;
property ParentControl: TControl read GetParentControl write SetParentControl;
property ExprDepth: Integer read GetExprDepth;
property ParentNode: TVisualNode read GetParentNode;
property Workspace: TWorkspace read GetWorkspace;
end;
@@ -75,11 +89,11 @@ implementation
{ TAstVisualizer }
constructor TAstVisualizer.Create(AWorkspace: TWorkspace; AParentControl: TControl; AExprDepth: Integer);
constructor TAstVisualizer.Create(AWorkspace: TWorkspace; AParentNode: TVisualNode; AExprDepth: Integer);
begin
inherited Create;
FWorkspace := AWorkspace;
FParentControl := AParentControl;
FParentNode := AParentNode;
FExprDepth := AExprDepth;
end;
@@ -95,21 +109,18 @@ begin
if not Assigned(Node) then
exit(nil);
// Dynamic dispatch via Visitor pattern
dataValue := Node.Accept(Self);
if dataValue.Kind = TDataValueKind.vkGeneric then
begin
Result := dataValue.AsGeneric<TAstViewNode>;
end
Result := dataValue.AsGeneric<TAstViewNode>
else
begin
Result := nil;
end;
end;
function TAstVisualizer.Clone(ParentControl: TControl; ExprDepth: Integer): IAstVisualizer;
function TAstVisualizer.Clone(ParentNode: TVisualNode; ExprDepth: Integer): IAstVisualizer;
begin
Result := TAstVisualizer.Create(FWorkspace, ParentControl, ExprDepth);
Result := TAstVisualizer.Create(FWorkspace, ParentNode, ExprDepth);
end;
function TAstVisualizer.GetExprDepth: Integer;
@@ -117,9 +128,9 @@ begin
Result := FExprDepth;
end;
function TAstVisualizer.GetParentControl: TControl;
function TAstVisualizer.GetParentNode: TVisualNode;
begin
Result := FParentControl;
Result := FParentNode;
end;
function TAstVisualizer.GetWorkspace: TWorkspace;
@@ -127,17 +138,7 @@ 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 ---
// --- Visitor Implementation Helpers ---
function TAstVisualizer.VisitConstant(const Node: IConstantNode): TAstViewNode;
begin
@@ -154,7 +155,7 @@ begin
Result := TAstViewNode.Create(Self, TKeywordNodeHandler.Create(Node));
end;
// --- List Visitors ---
// Lists
function TAstVisualizer.VisitParameterList(const Node: IParameterList): TAstViewNode;
begin
@@ -181,7 +182,7 @@ begin
Result := TAstViewNode.Create(Self, TRecordFieldHandler.Create(Node));
end;
// --- Node Visitors ---
// Control Flow
function TAstVisualizer.VisitBlockExpression(const Node: IBlockExpressionNode): TAstViewNode;
begin
@@ -198,6 +199,18 @@ begin
Result := TAstViewNode.Create(Self, TTernaryExpressionNodeHandler.Create(Node));
end;
function TAstVisualizer.VisitRecurNode(const Node: IRecurNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TRecurNodeHandler.Create(Node));
end;
function TAstVisualizer.VisitNop(const Node: INopNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TNopNodeHandler.Create(Node));
end;
// Functions
function TAstVisualizer.VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TLambdaExpressionNodeHandler.Create(Node));
@@ -213,6 +226,8 @@ begin
Result := TAstViewNode.Create(Self, TMacroExpansionNodeHandler.Create(Node));
end;
// Declarations
function TAstVisualizer.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TVariableDeclarationNodeHandler.Create(Node));
@@ -228,6 +243,8 @@ begin
Result := TAstViewNode.Create(Self, TMacroDefinitionNodeHandler.Create(Node));
end;
// Metaprogramming
function TAstVisualizer.VisitQuasiquote(const Node: IQuasiquoteNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TQuasiquoteNodeHandler.Create(Node));
@@ -243,6 +260,8 @@ begin
Result := TAstViewNode.Create(Self, TUnquoteSplicingNodeHandler.Create(Node));
end;
// Data Access
function TAstVisualizer.VisitIndexer(const Node: IIndexerNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TIndexerNodeHandler.Create(Node));
@@ -258,6 +277,8 @@ begin
Result := TAstViewNode.Create(Self, TRecordLiteralNodeHandler.Create(Node));
end;
// Series
function TAstVisualizer.VisitCreateSeries(const Node: ICreateSeriesNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TCreateSeriesNodeHandler.Create(Node));
@@ -273,14 +294,4 @@ begin
Result := TAstViewNode.Create(Self, TSeriesLengthNodeHandler.Create(Node));
end;
function TAstVisualizer.VisitRecurNode(const Node: IRecurNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TRecurNodeHandler.Create(Node));
end;
function TAstVisualizer.VisitNop(const Node: INopNode): TAstViewNode;
begin
Result := TAstViewNode.Create(Self, TNopNodeHandler.Create(Node));
end;
end.
Src/AST/Myc.Fmx.AstEditor.Workspace.pas
+377 -341
View File
@@ -14,146 +14,84 @@ uses
FMX.Objects,
FMX.Graphics,
FMX.Forms,
Myc.Fmx.AstEditor.Layout;
Myc.Fmx.AstEditor.Render;
type
TOnPaintConnectionsEvent = procedure(ASender: TObject; ACanvas: TCanvas) of object;
TOnDragDropEvent = procedure(ASource, ATarget: TControl; AIndex: Integer) of object;
TOnDragDropEvent = procedure(ASource, ATarget: TVisualNode; AIndex: Integer) of object;
TAstWorld = class(TControl)
private
FOnPaintConnections: TOnPaintConnectionsEvent;
// VISUAL: Drop Marker State
FShowDropMarker: Boolean;
FDropP1, FDropP2: TPointF;
protected
procedure Paint; override;
procedure AfterPaint; override;
public
constructor Create(AOwner: TComponent); override;
procedure InvalidateConnections;
property OnPaintConnections: TOnPaintConnectionsEvent read FOnPaintConnections write FOnPaintConnections;
end;
TWorkspace = class(TControl)
TWorkspace = class(TControl, IVisualHost)
private
const
MinZoom = 0.1;
MaxZoom = 5.0;
ZoomStep = 0.1;
private
FRootLayer: TAstWorld;
FRootNode: TVisualNode;
FContentOffset: TPointF;
FZoom: Single;
FIsPanning: Boolean;
FLastMousePos: TPointF;
FMouseOverNode: TVisualNode;
FCapturedNode: TVisualNode;
FIsDraggingNode: Boolean;
FDragSource: TControl;
FDragVisual: TControl;
FDragSource: TVisualNode;
FDragVisualBitmap: TBitmap;
FDragVisualPos: TPointF;
FDragOffset: TPointF;
FCurrentDropTarget: TControl;
FCurrentDropTarget: TVisualNode;
FCurrentDropIndex: Integer;
FShowDropMarker: Boolean;
FDropP1, FDropP2: TPointF;
FOnPaintConnections: TOnPaintConnectionsEvent;
FOnNodeDragDrop: TOnDragDropEvent;
function GetZoom: Single;
procedure SetZoom(const Value: Single);
function GetContentOffset: TPointF;
procedure SetContentOffset(const Value: TPointF);
function GetOnPaintConnections: TOnPaintConnectionsEvent;
procedure SetOnPaintConnections(const Value: TOnPaintConnectionsEvent);
// IVisualHost
procedure InvalidateRect(const R: TRectF);
function GetCanvas: TCanvas;
procedure SetZoom(const Value: Single);
procedure SetContentOffset(const Value: TPointF);
procedure SetRootNode(const Value: TVisualNode);
procedure UpdateDropMarker(const WorldPos: TPointF);
procedure StopDrag;
procedure UpdateDropMarker(const ScreenPos: TPointF);
protected
procedure Loaded; override;
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 MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); override;
procedure Resize; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure BeginDragNode(ASource: TVisualNode);
procedure InvalidateConnections;
// Moved to public for Editor access
function ScreenToWorld(const APoint: TPointF): TPointF;
procedure BeginDragNode(ASource: TControl);
procedure RequestLayout;
property World: TAstWorld read FRootLayer;
property Zoom: Single read GetZoom write SetZoom;
property ContentOffset: TPointF read GetContentOffset write SetContentOffset;
property OnPaintConnections: TOnPaintConnectionsEvent read GetOnPaintConnections write SetOnPaintConnections;
property RootNode: TVisualNode read FRootNode write SetRootNode;
property Zoom: Single read FZoom write SetZoom;
property ContentOffset: TPointF read FContentOffset write SetContentOffset;
property OnPaintConnections: TOnPaintConnectionsEvent read FOnPaintConnections write FOnPaintConnections;
property OnNodeDragDrop: TOnDragDropEvent read FOnNodeDragDrop write FOnNodeDragDrop;
end;
implementation
{ TAstWorld }
constructor TAstWorld.Create(AOwner: TComponent);
begin
inherited;
HitTest := False;
Locked := True;
Stored := False;
ClipChildren := False;
Width := 100;
Height := 100;
FShowDropMarker := False;
end;
procedure TAstWorld.Paint;
begin
inherited;
if (csDesigning in ComponentState) then
DrawDesignBorder;
// Connections should be BEHIND the nodes, so Paint is the correct place.
if Assigned(FOnPaintConnections) then
FOnPaintConnections(Self, Canvas);
end;
procedure TAstWorld.AfterPaint;
var
ScaleFactor: Single;
Radius: Single;
Thickness: Single;
begin
inherited;
// --- DRAW DROP MARKER (IN FRONT OF NODES) ---
if FShowDropMarker then
begin
// Calculate visual sizes inversely proportional to zoom
if Scale.X > 0 then
ScaleFactor := 1 / Scale.X
else
ScaleFactor := 1;
Thickness := 3 * ScaleFactor;
Radius := 4 * ScaleFactor;
Canvas.Stroke.Kind := TBrushKind.Solid;
Canvas.Stroke.Color := TAlphaColors.Red;
Canvas.Stroke.Thickness := Thickness;
Canvas.Stroke.Cap := TStrokeCap.Round;
// Draw Line
Canvas.DrawLine(FDropP1, FDropP2, 1.0);
// Draw Circles at ends
Canvas.Fill.Kind := TBrushKind.Solid;
Canvas.Fill.Color := TAlphaColors.Red;
Canvas.FillEllipse(TRectF.Create(FDropP1.X - Radius, FDropP1.Y - Radius, FDropP1.X + Radius, FDropP1.Y + Radius), 1.0);
Canvas.FillEllipse(TRectF.Create(FDropP2.X - Radius, FDropP2.Y - Radius, FDropP2.X + Radius, FDropP2.Y + Radius), 1.0);
end;
end;
procedure TAstWorld.InvalidateConnections;
begin
Repaint;
end;
uses
Myc.Fmx.AstEditor.Node;
{ TWorkspace }
@@ -162,260 +100,234 @@ begin
inherited Create(AOwner);
ClipChildren := True;
HitTest := True;
CanFocus := True; // Enable Keyboard Input
CanFocus := True;
AutoCapture := True;
FRootLayer := TAstWorld.Create(Self);
FRootLayer.Parent := Self;
FRootLayer.SetBounds(0, 0, 100, 100);
FRootLayer.Scale.Point := TPointF.Create(1, 1);
FZoom := 1.0;
FContentOffset := TPointF.Zero;
FRootNode := TVisualNode.Create(Self);
end;
destructor TWorkspace.Destroy;
begin
FreeAndNil(FRootNode);
FreeAndNil(FDragVisualBitmap);
inherited;
end;
procedure TWorkspace.Loaded;
function TWorkspace.GetCanvas: TCanvas;
begin
Result := Canvas;
end;
procedure TWorkspace.InvalidateRect(const R: TRectF);
begin
Repaint;
end;
procedure TWorkspace.RequestLayout;
begin
if Assigned(FRootNode) then
begin
FRootNode.RecalcLayout;
Repaint;
end;
end;
procedure TWorkspace.SetRootNode(const Value: TVisualNode);
begin
if FRootNode <> Value then
begin
if Assigned(FRootNode) then
FRootNode.Free;
FRootNode := Value;
RequestLayout;
end;
end;
procedure TWorkspace.SetZoom(const Value: Single);
begin
if FZoom <> Value then
begin
FZoom := EnsureRange(Value, MinZoom, MaxZoom);
Repaint;
end;
end;
procedure TWorkspace.SetContentOffset(const Value: TPointF);
begin
if FContentOffset <> Value then
begin
FContentOffset := Value;
Repaint;
end;
end;
procedure TWorkspace.Paint;
var
State: TCanvasSaveState;
DragRect: TRectF;
begin
inherited;
if FRootLayer <> nil then
FRootLayer.BringToFront;
if (csDesigning in ComponentState) then
begin
Canvas.Stroke.Kind := TBrushKind.Solid;
Canvas.Stroke.Color := TAlphaColors.Gray;
Canvas.Stroke.Dash := TStrokeDash.Dash;
Canvas.DrawRect(LocalRect, 0, 0, AllCorners, 1.0);
end;
State := Canvas.SaveState;
try
Canvas.IntersectClipRect(LocalRect);
Canvas.MultiplyMatrix(TMatrix.CreateScaling(FZoom, FZoom));
Canvas.MultiplyMatrix(TMatrix.CreateTranslation(FContentOffset.X, FContentOffset.Y));
if Assigned(FOnPaintConnections) then
FOnPaintConnections(Self, Canvas);
if Assigned(FRootNode) then
FRootNode.Paint(Canvas, TPointF.Zero);
if FShowDropMarker then
begin
Canvas.Stroke.Kind := TBrushKind.Solid;
Canvas.Stroke.Color := TAlphaColors.Red;
Canvas.Stroke.Thickness := 3 / FZoom;
Canvas.Stroke.Cap := TStrokeCap.Round;
Canvas.DrawLine(FDropP1, FDropP2, 1.0);
Canvas.Fill.Color := TAlphaColors.Red;
var R: Single := 4 / FZoom;
Canvas.FillEllipse(TRectF.Create(FDropP1.X - R, FDropP1.Y - R, FDropP1.X + R, FDropP1.Y + R), 1.0);
Canvas.FillEllipse(TRectF.Create(FDropP2.X - R, FDropP2.Y - R, FDropP2.X + R, FDropP2.Y + R), 1.0);
end;
if FIsDraggingNode and Assigned(FDragVisualBitmap) then
begin
DragRect := TRectF.Create(FDragVisualPos, FDragVisualBitmap.Width, FDragVisualBitmap.Height);
Canvas.DrawBitmap(FDragVisualBitmap, TRectF.Create(0, 0, FDragVisualBitmap.Width, FDragVisualBitmap.Height), DragRect, 0.7);
end;
finally
Canvas.RestoreState(State);
end;
end;
function TWorkspace.ScreenToWorld(const APoint: TPointF): TPointF;
begin
Result := ScreenToLocal(APoint);
Result := FRootLayer.AbsoluteToLocal(LocalToAbsolute(Result));
end;
procedure TWorkspace.BeginDragNode(ASource: TControl);
var
Snapshot: TBitmap;
DragImg: TImage;
MouseWorld: TPointF;
AbsPos, WorldPos: TPointF;
LocalP: TPointF;
begin
if FIsDraggingNode or FIsPanning then
Exit;
FIsDraggingNode := True;
FDragSource := ASource;
Root.Captured := Self;
Snapshot := ASource.MakeScreenshot;
DragImg := TImage.Create(nil);
DragImg.Parent := FRootLayer;
DragImg.Bitmap := Snapshot;
DragImg.WrapMode := TImageWrapMode.Stretch;
DragImg.HitTest := False;
DragImg.Opacity := 0.7;
DragImg.BringToFront;
AbsPos := ASource.LocalToAbsolute(TPointF.Zero);
WorldPos := FRootLayer.AbsoluteToLocal(AbsPos);
DragImg.SetBounds(WorldPos.X, WorldPos.Y, ASource.Width, ASource.Height);
FDragVisual := DragImg;
MouseWorld := ScreenToWorld(Screen.MousePos);
FDragOffset := MouseWorld - WorldPos;
ASource.Opacity := 0.4;
LocalP := ScreenToLocal(APoint);
Result := (LocalP - FContentOffset) / FZoom;
end;
procedure TWorkspace.UpdateDropMarker(const ScreenPos: TPointF);
var
Obj: IControl;
TargetCtrl: TControl;
TargetLocalPos: TPointF;
IsHorizontal: Boolean;
InsertAfter: Boolean;
PTL, PBR: TPointF;
P1, P2: TPointF;
SourceParent: TControl;
TargetContainer: TAutoFitControl;
procedure TWorkspace.Resize;
begin
FRootLayer.FShowDropMarker := False;
FCurrentDropTarget := nil;
FCurrentDropIndex := -1;
if FDragSource = nil then
Exit;
if not (FDragSource.Parent is TControl) then
Exit;
SourceParent := TControl(FDragSource.Parent);
// 1. Find Drop Target
Obj := ObjectAtPoint(ScreenPos);
if (Obj = nil) or not (Obj.GetObject is TControl) then
Exit;
TargetCtrl := TControl(Obj.GetObject);
// 2. Walk up hierarchy
while (TargetCtrl <> nil) and (TargetCtrl.Parent <> SourceParent) do
begin
TargetCtrl := TargetCtrl.ParentControl;
if TargetCtrl = FRootLayer then
Exit;
end;
if TargetCtrl = nil then
Exit;
if TargetCtrl = FDragSource then
Exit;
FCurrentDropTarget := TargetCtrl;
// 3. Determine Geometry using TAutoFitControl info
TargetLocalPos := TargetCtrl.AbsoluteToLocal(ScreenPos);
IsHorizontal := True; // Default fallback
if SourceParent is TAutoFitControl then
begin
TargetContainer := TAutoFitControl(SourceParent);
if TargetContainer.Orientation = TLayoutOrientation.loHorizontal then
IsHorizontal := True
else
IsHorizontal := False;
end;
// Split logic
if IsHorizontal then
InsertAfter := TargetLocalPos.X > (TargetCtrl.Width / 2)
else
InsertAfter := TargetLocalPos.Y > (TargetCtrl.Height / 2);
// 4. Calculate Index
if InsertAfter then
FCurrentDropIndex := TargetCtrl.Index + 1
else
FCurrentDropIndex := TargetCtrl.Index;
// 5. Calculate Marker Visuals
var AbsTL := TargetCtrl.LocalToAbsolute(TPointF.Zero);
var AbsBR := TargetCtrl.LocalToAbsolute(TPointF.Create(TargetCtrl.Width, TargetCtrl.Height));
PTL := FRootLayer.AbsoluteToLocal(AbsTL);
PBR := FRootLayer.AbsoluteToLocal(AbsBR);
if IsHorizontal then
begin
// Vertical Line
var XPos := PTL.X;
if InsertAfter then
XPos := PBR.X;
if InsertAfter then
XPos := XPos + 2
else
XPos := XPos - 2;
P1 := TPointF.Create(XPos, PTL.Y);
P2 := TPointF.Create(XPos, PBR.Y);
end
else
begin
// Horizontal Line
var YPos := PTL.Y;
if InsertAfter then
YPos := PBR.Y;
if InsertAfter then
YPos := YPos + 2
else
YPos := YPos - 2;
P1 := TPointF.Create(PTL.X, YPos);
P2 := TPointF.Create(PBR.X, YPos);
end;
FRootLayer.FDropP1 := P1;
FRootLayer.FDropP2 := P2;
FRootLayer.FShowDropMarker := True;
end;
procedure TWorkspace.StopDrag;
begin
if not FIsDraggingNode then
Exit;
if Assigned(FDragVisual) then
begin
FDragVisual.Parent := nil;
FDragVisual.Free;
FDragVisual := nil;
end;
if Assigned(FDragSource) then
FDragSource.Opacity := 1.0;
FRootLayer.FShowDropMarker := False;
FRootLayer.Repaint;
if Assigned(FOnNodeDragDrop) and Assigned(FCurrentDropTarget) and (FCurrentDropIndex >= 0) then
FOnNodeDragDrop(FDragSource, FCurrentDropTarget, FCurrentDropIndex);
FIsDraggingNode := False;
FDragSource := nil;
FCurrentDropTarget := nil;
Root.Captured := nil;
inherited;
Repaint;
end;
procedure TWorkspace.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
var
WorldP: TPointF;
Hit: TVisualNode;
begin
inherited;
// Capture Keyboard Focus
if CanFocus then
SetFocus;
if not FIsDraggingNode and (Button in [TMouseButton.mbLeft, TMouseButton.mbMiddle]) then
WorldP := ScreenToWorld(LocalToScreen(TPointF.Create(X, Y)));
if (Button in [TMouseButton.mbLeft, TMouseButton.mbMiddle]) and (ssCtrl in Shift) then
begin
FIsPanning := True;
FLastMousePos := TPointF.Create(X, Y);
Root.Captured := Self;
Exit;
end;
if Assigned(FRootNode) then
begin
Hit := FRootNode.HitTest(WorldP);
if Assigned(Hit) then
begin
FCapturedNode := Hit;
var NodeLocal := Hit.AbsoluteToLocal(WorldP);
Hit.MouseDown(Button, Shift, NodeLocal.X, NodeLocal.Y);
end
else if Button = TMouseButton.mbLeft then
begin
FIsPanning := True;
FLastMousePos := TPointF.Create(X, Y);
Root.Captured := Self;
end;
end;
end;
procedure TWorkspace.MouseMove(Shift: TShiftState; X, Y: Single);
var
LCurrentPos: TPointF;
LDelta: TPointF;
LWorldPos: TPointF;
WorldP: TPointF;
LocalP: TPointF;
Hit: TVisualNode;
Delta: TPointF;
begin
inherited;
LocalP := TPointF.Create(X, Y);
WorldP := ScreenToWorld(LocalToScreen(LocalP));
if FIsDraggingNode then
begin
if Assigned(FDragVisual) then
begin
LWorldPos := ScreenToWorld(Screen.MousePos);
FDragVisual.Position.Point := LWorldPos - FDragOffset;
end;
UpdateDropMarker(Screen.MousePos);
FRootLayer.Repaint;
FDragVisualPos := WorldP - FDragOffset;
UpdateDropMarker(WorldP);
Repaint;
end
else if FIsPanning then
begin
LCurrentPos := TPointF.Create(X, Y);
LDelta := LCurrentPos - FLastMousePos;
Delta := LocalP - FLastMousePos;
FContentOffset := FContentOffset + Delta;
FLastMousePos := LocalP;
Repaint;
end
else
begin
if Assigned(FCapturedNode) then
begin
var NodeLocal := FCapturedNode.AbsoluteToLocal(WorldP);
FCapturedNode.MouseMove(Shift, NodeLocal.X, NodeLocal.Y);
end
else if Assigned(FRootNode) then
begin
Hit := FRootNode.HitTest(WorldP);
if Hit <> FMouseOverNode then
begin
if Assigned(FMouseOverNode) then
FMouseOverNode.MouseLeave;
FMouseOverNode := Hit;
if Assigned(FMouseOverNode) then
FMouseOverNode.MouseEnter;
end;
FRootLayer.Position.Point := FRootLayer.Position.Point + LDelta;
FLastMousePos := LCurrentPos;
if Assigned(FMouseOverNode) then
begin
var NodeLocal := FMouseOverNode.AbsoluteToLocal(WorldP);
FMouseOverNode.MouseMove(Shift, NodeLocal.X, NodeLocal.Y);
end;
end;
end;
end;
procedure TWorkspace.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
var
WorldP: TPointF;
begin
inherited;
WorldP := ScreenToWorld(LocalToScreen(TPointF.Create(X, Y)));
if FIsDraggingNode then
begin
StopDrag;
@@ -424,68 +336,192 @@ begin
begin
FIsPanning := False;
Root.Captured := nil;
end
else if Assigned(FCapturedNode) then
begin
var NodeLocal := FCapturedNode.AbsoluteToLocal(WorldP);
FCapturedNode.MouseUp(Button, Shift, NodeLocal.X, NodeLocal.Y);
FCapturedNode := nil;
end;
end;
procedure TWorkspace.MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
var
LOldZoom, LNewZoom: Single;
LScaleRatio: Single;
LMousePosLocal: TPointF;
LOffset: TPointF;
OldZoom: Single;
LocalP, OffsetLocal: TPointF;
begin
LOldZoom := Zoom;
OldZoom := FZoom;
if WheelDelta > 0 then
LNewZoom := LOldZoom + ZoomStep
SetZoom(FZoom + ZoomStep)
else
LNewZoom := LOldZoom - ZoomStep;
SetZoom(FZoom - ZoomStep);
LNewZoom := EnsureRange(LNewZoom, MinZoom, MaxZoom);
if not SameValue(LNewZoom, LOldZoom, TEpsilon.Vector) then
if not SameValue(OldZoom, FZoom, TEpsilon.Position) then
begin
LMousePosLocal := ScreenToLocal(Screen.MousePos);
LOffset := LMousePosLocal - FRootLayer.Position.Point;
LScaleRatio := LNewZoom / LOldZoom;
FRootLayer.Position.Point := LMousePosLocal - (LOffset * LScaleRatio);
SetZoom(LNewZoom);
LocalP := ScreenToLocal(Screen.MousePos);
OffsetLocal := LocalP - FContentOffset;
FContentOffset := LocalP - (OffsetLocal * (FZoom / OldZoom));
Repaint;
end;
Handled := True;
if not Handled then
inherited;
end;
function TWorkspace.GetZoom: Single;
procedure TWorkspace.BeginDragNode(ASource: TVisualNode);
var
Bitmap: TBitmap;
Scale: Single;
begin
Result := FRootLayer.Scale.X;
if FIsDraggingNode or FIsPanning then
Exit;
if ASource = nil then
Exit;
FIsDraggingNode := True;
FDragSource := ASource;
Root.Captured := Self;
Scale := Scene.GetSceneScale;
Bitmap := TBitmap.Create(Round(ASource.Size.Width * Scale), Round(ASource.Size.Height * Scale));
Bitmap.BitmapScale := Scale;
if Bitmap.Canvas.BeginScene then
try
Bitmap.Canvas.Clear(0);
ASource.Paint(Bitmap.Canvas, TPointF.Zero);
finally
Bitmap.Canvas.EndScene;
end;
FDragVisualBitmap := Bitmap;
var MouseWorld := ScreenToWorld(Screen.MousePos);
var NodeWorld := ASource.GetAbsolutePosition;
FDragOffset := MouseWorld - NodeWorld;
FDragVisualPos := NodeWorld;
ASource.Opacity := 0.4;
ASource.RequestLayout;
end;
procedure TWorkspace.SetZoom(const Value: Single);
procedure TWorkspace.UpdateDropMarker(const WorldPos: TPointF);
var
Hit: TVisualNode;
TargetContainer: TAutoFitLayout;
IsHorizontal: Boolean;
InsertIndex: Integer;
Child: TVisualNode;
P1, P2: TPointF;
AbsP: TPointF;
begin
FRootLayer.Scale.Point := TPointF.Create(Value, Value);
FShowDropMarker := False;
FCurrentDropTarget := nil;
FCurrentDropIndex := -1;
if FDragSource = nil then
Exit;
Hit := FRootNode.HitTest(WorldPos);
if Hit = nil then
Exit;
if (Hit is TAutoFitLayout) then
TargetContainer := TAutoFitLayout(Hit)
else if (Hit.Parent is TAutoFitLayout) then
TargetContainer := TAutoFitLayout(Hit.Parent)
else
Exit;
if TargetContainer = FDragSource then
Exit;
FCurrentDropTarget := TargetContainer;
IsHorizontal := TargetContainer.Orientation = loHorizontal;
var TargetLocal := TargetContainer.AbsoluteToLocal(WorldPos);
InsertIndex := TargetContainer.GetInsertionIndex(TargetLocal);
FCurrentDropIndex := InsertIndex;
if InsertIndex < TargetContainer.GetChildCount then
begin
Child := TargetContainer.GetChild(InsertIndex);
AbsP := Child.GetAbsolutePosition;
if IsHorizontal then
begin
P1 := AbsP;
P2 := AbsP + TPointF.Create(0, Child.Size.Height);
end
else
begin
P1 := AbsP;
P2 := AbsP + TPointF.Create(Child.Size.Width, 0);
end;
end
else if TargetContainer.GetChildCount > 0 then
begin
Child := TargetContainer.GetChild(TargetContainer.GetChildCount - 1);
AbsP := Child.GetAbsolutePosition;
if IsHorizontal then
begin
P1 := AbsP + TPointF.Create(Child.Size.Width + Child.Margins.Right, 0);
P2 := P1 + TPointF.Create(0, Child.Size.Height);
end
else
begin
P1 := AbsP + TPointF.Create(0, Child.Size.Height + Child.Margins.Bottom);
P2 := P1 + TPointF.Create(Child.Size.Width, 0);
end;
end
else
begin
AbsP := TargetContainer.GetAbsolutePosition + TPointF.Create(TargetContainer.Padding.Left, TargetContainer.Padding.Top);
if IsHorizontal then
begin
P1 := AbsP;
P2 := AbsP + TPointF.Create(0, 20);
end
else
begin
P1 := AbsP;
P2 := AbsP + TPointF.Create(20, 0);
end;
end;
FDropP1 := P1;
FDropP2 := P2;
FShowDropMarker := True;
end;
function TWorkspace.GetContentOffset: TPointF;
procedure TWorkspace.StopDrag;
begin
Result := FRootLayer.Position.Point;
if not FIsDraggingNode then
Exit;
FreeAndNil(FDragVisualBitmap);
if Assigned(FDragSource) then
begin
FDragSource.Opacity := 1.0;
if Assigned(FOnNodeDragDrop) and Assigned(FCurrentDropTarget) and (FCurrentDropIndex >= 0) then
begin
FOnNodeDragDrop(FDragSource, FCurrentDropTarget, FCurrentDropIndex);
end;
end;
FShowDropMarker := False;
FIsDraggingNode := False;
FDragSource := nil;
FCurrentDropTarget := nil;
Root.Captured := nil;
Repaint;
end;
procedure TWorkspace.SetContentOffset(const Value: TPointF);
procedure TWorkspace.InvalidateConnections;
begin
FRootLayer.Position.Point := Value;
end;
function TWorkspace.GetOnPaintConnections: TOnPaintConnectionsEvent;
begin
Result := FRootLayer.OnPaintConnections;
end;
procedure TWorkspace.SetOnPaintConnections(const Value: TOnPaintConnectionsEvent);
begin
FRootLayer.OnPaintConnections := Value;
Repaint;
end;
end.
Src/AST/Myc.Fmx.AstEditor.pas
+127 -413
View File
@@ -21,9 +21,10 @@ uses
Myc.Ast.Scope,
Myc.Ast.Environment,
Myc.Ast.Refactoring.Remove,
Myc.Fmx.AstEditor.Render,
Myc.Fmx.AstEditor.Node,
Myc.Fmx.AstEditor.Layout,
Myc.Fmx.AstEditor.Workspace;
Myc.Fmx.AstEditor.Workspace,
Myc.Fmx.AstEditor.Visualizer;
type
TAstEditor = class(TControl)
@@ -49,37 +50,29 @@ type
FRootViewNode: TAstViewNode;
FFocusedNode: TAstViewNode;
// State Tracking
FCurrentAst: IAstNode;
// Undo/Redo Stacks
FUndoStack: TUndoStack;
FRedoStack: TUndoStack;
FIsUndoing: Boolean;
// Events
FOnPaintConnections: TOnPaintConnectionsEvent;
FOnWorkspaceMouseDown: TMouseEvent;
procedure CollectNodes(Parent: TControl);
procedure CollectNodes(Parent: TVisualNode);
procedure ClearVisuals;
procedure ApplyErrors(const Log: ICompilerLog);
procedure ApplyTypes(const TypedAst: IAstNode);
procedure RootResized(Sender: TObject);
// Internal Event Wiring
procedure HandleNodeDragDrop(ASource, ATarget: TControl; AIndex: Integer);
procedure HandleNodeDragDrop(ASource, ATarget: TVisualNode; AIndex: Integer);
procedure HandleKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState);
procedure HandleWorkspacePaintConnections(ASender: TObject; ACanvas: TCanvas);
procedure HandleWorkspaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
procedure HandleNodeMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
procedure CommitSnapshot;
// --- Navigation Helper ---
procedure EnsureVisible(Node: TAstViewNode);
function GetParentNode(StartNode: TAstViewNode): TAstViewNode;
function GetFirstChild(StartNode: TAstViewNode): TAstViewNode;
function GetNextVerticalNeighbor(StartNode: TAstViewNode): TAstViewNode;
function GetPrevVerticalNeighbor(StartNode: TAstViewNode): TAstViewNode;
function GetNextLinearNode(StartNode: TAstViewNode): TAstViewNode;
@@ -88,18 +81,16 @@ type
procedure SetOnPaintConnections(const Value: TOnPaintConnectionsEvent);
protected
procedure Paint; override; // For design-time border
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
// Must be called after creation to link the AST Environment
procedure Init(const AEnv: TAstEnvironment);
procedure ValidateAndShow;
// AClearHistory=False ensures stacks are kept (e.g. after internal edits)
procedure SetRoot(const AstNode: IAstNode; AClearHistory: Boolean = True);
procedure Undo;
@@ -123,7 +114,6 @@ type
property Enabled;
property Opacity;
// Expose events relevant to the outside world
property OnPaintConnections: TOnPaintConnectionsEvent read FOnPaintConnections write SetOnPaintConnections;
property OnMouseDown: TMouseEvent read FOnWorkspaceMouseDown write FOnWorkspaceMouseDown;
end;
@@ -131,8 +121,7 @@ type
implementation
uses
Myc.Data.Value,
Myc.Fmx.AstEditor.Visualizer;
Myc.Data.Value;
{ TAstEditor }
@@ -143,14 +132,12 @@ begin
Height := 300;
ClipChildren := True;
// Create Internal Workspace
FWorkspace := TWorkspace.Create(Self);
FWorkspace.Parent := Self;
FWorkspace.Align := TAlignLayout.Client;
FWorkspace.Stored := False;
FWorkspace.Locked := True;
// Wire Internal Events
FWorkspace.OnNodeDragDrop := HandleNodeDragDrop;
FWorkspace.OnKeyDown := HandleKeyDown;
FWorkspace.OnPaintConnections := HandleWorkspacePaintConnections;
@@ -205,21 +192,18 @@ begin
if FWorkspace.CanFocus then
FWorkspace.SetFocus;
var WorldP := FWorkspace.ScreenToWorld(FWorkspace.LocalToScreen(TPointF.Create(X, Y)));
var Hit := FWorkspace.RootNode.HitTest(WorldP);
if (Button = TMouseButton.mbLeft) and (Hit is TAstViewNode) then
begin
SetFocusedNode(TAstViewNode(Hit));
end;
if Assigned(FOnWorkspaceMouseDown) then
FOnWorkspaceMouseDown(Self, Button, Shift, X, Y);
end;
procedure TAstEditor.HandleNodeMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
if FWorkspace.CanFocus then
FWorkspace.SetFocus;
if (Button = TMouseButton.mbLeft) and (Sender is TAstViewNode) then
begin
SetFocusedNode(TAstViewNode(Sender));
end;
end;
procedure TAstEditor.CommitSnapshot;
begin
if Assigned(FCurrentAst) and (not FIsUndoing) then
@@ -242,7 +226,7 @@ begin
FRedoStack.Push(FCurrentAst);
prevAst := FUndoStack.Pop;
SetRoot(prevAst); // Default Clear=True, but guarded by FIsUndoing
SetRoot(prevAst);
finally
FIsUndoing := False;
end;
@@ -277,64 +261,57 @@ begin
Result := FRedoStack.Count > 0;
end;
procedure TAstEditor.HandleNodeDragDrop(ASource, ATarget: TControl; AIndex: Integer);
procedure TAstEditor.HandleNodeDragDrop(ASource, ATarget: TVisualNode; AIndex: Integer);
var
SourceParent: TControl;
SourceView, TargetView: TAstViewNode;
ContainerOwner: TAstViewNode;
Reorderable: IReorderable;
SourceIdx, TargetIdx: Integer;
SourceIdx: Integer;
NewAst: IAstNode;
begin
if (ASource = nil) or (AIndex < 0) then
exit;
if not (ASource is TAstViewNode) then
exit;
if not (ASource.Parent is TControl) then
if not (ATarget is TAstViewNode) then
exit;
SourceParent := TControl(ASource.Parent);
ContainerOwner := nil;
SourceView := TAstViewNode(ASource);
TargetView := TAstViewNode(ATarget);
ContainerOwner := TargetView;
if (SourceParent is TAstViewNode) then
begin
ContainerOwner := TAstViewNode(SourceParent);
if not Supports(ContainerOwner.Handler, IReorderable, Reorderable) then
ContainerOwner := nil;
exit;
if Reorderable.CanDrag(SourceView) and (SourceView.Parent = TargetView) then
begin
// Find current index of SourceView in Target
SourceIdx := -1;
for var i := 0 to TargetView.GetChildCount - 1 do
begin
if TargetView.GetChild(i) = SourceView then
begin
SourceIdx := i;
Break;
end;
end;
if (ContainerOwner = nil) and (SourceParent.Parent is TAstViewNode) then
begin
ContainerOwner := TAstViewNode(SourceParent.Parent);
if not Supports(ContainerOwner.Handler, IReorderable, Reorderable) then
ContainerOwner := nil;
end;
if (ContainerOwner <> nil) and (Reorderable <> nil) then
begin
if Reorderable.CanDrag(ASource) then
begin
SourceIdx := ASource.Index;
TargetIdx := AIndex;
if SourceIdx <> TargetIdx then
if SourceIdx >= 0 then
begin
CommitSnapshot;
Reorderable.MoveChild(SourceIdx, TargetIdx);
NewAst := FRootViewNode.CreateAst;
Reorderable.MoveChild(SourceIdx, AIndex);
// IMPORTANT: Pass False to preserve the undo stack we just updated
NewAst := FRootViewNode.CreateAst;
SetRoot(NewAst, False);
end;
end;
end;
end;
procedure TAstEditor.HandleKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState);
var
NewRoot: IAstNode;
begin
// Undo / Redo Handling
// Undo / Redo
if (ssCtrl in Shift) then
begin
if (Key = vkZ) then
@@ -361,7 +338,7 @@ begin
end;
end;
// Delete Handling
// Delete
if (Key = vkDelete) then
begin
if Assigned(FFocusedNode) and Assigned(FFocusedNode.Node) and Assigned(FCurrentAst) then
@@ -369,7 +346,6 @@ begin
CommitSnapshot;
if TAstNodeRemover.TryRemove(FCurrentAst, FFocusedNode.Node, NewRoot) then
begin
// IMPORTANT: Pass False to preserve the undo stack we just updated
SetRoot(NewRoot, False);
end;
end;
@@ -391,7 +367,6 @@ var
begin
FCurrentAst := AstNode;
// Only clear if explicitly requested AND not currently performing an undo/redo
if AClearHistory and (not FIsUndoing) then
begin
FUndoStack.Clear;
@@ -399,45 +374,38 @@ begin
end;
FFocusedNode := nil;
FWorkspace.RootNode := nil;
FWorkspace.World.DeleteChildren;
if Assigned(FRootViewNode) then
FRootViewNode.OnResized := nil;
FRootViewNode := nil;
if not Assigned(AstNode) then
exit;
Visualizer := TAstVisualizer.Create(FWorkspace, FWorkspace.World, 0);
Visualizer := TAstVisualizer.Create(FWorkspace, nil, 0);
FRootViewNode := Visualizer.CallAccept(AstNode);
if Assigned(FRootViewNode) then
begin
FWorkspace.World.Size := FRootViewNode.Size;
FRootViewNode.OnResized := RootResized;
FRootViewNode.Position.Point := TPointF.Create(50, 50);
end;
if Assigned(FRootViewNode) then
FWorkspace.RootNode := FRootViewNode;
FRootViewNode.Position := TPointF.Create(50, 50);
ValidateAndShow;
end;
end;
procedure TAstEditor.CollectNodes(Parent: TControl);
procedure TAstEditor.CollectNodes(Parent: TVisualNode);
var
i: Integer;
child: TControl;
child: TVisualNode;
viewNode: TAstViewNode;
begin
for i := 0 to Parent.ChildrenCount - 1 do
for i := 0 to Parent.GetChildCount - 1 do
begin
if Parent.Children[i] is TControl then
begin
child := TControl(Parent.Children[i]);
child := Parent.GetChild(i);
if child is TAstViewNode then
begin
viewNode := TAstViewNode(child);
viewNode.OnMouseDown := HandleNodeMouseDown;
if Assigned(viewNode.Node) and Assigned(viewNode.Node.Identity) then
begin
@@ -445,10 +413,9 @@ begin
end;
end;
if child.ChildrenCount > 0 then
if child.GetChildCount > 0 then
CollectNodes(child);
end;
end;
end;
procedure TAstEditor.ClearVisuals;
@@ -495,11 +462,6 @@ begin
end;
end;
procedure TAstEditor.RootResized(Sender: TObject);
begin
FWorkspace.World.Size := FRootViewNode.Size;
end;
procedure TAstEditor.ValidateAndShow;
var
logicalAst: IAstNode;
@@ -510,7 +472,7 @@ begin
logicalAst := FRootViewNode.CreateAst;
FNodeMap.Clear;
CollectNodes(FWorkspace.World);
CollectNodes(FWorkspace.RootNode);
ClearVisuals;
@@ -527,6 +489,9 @@ begin
var compiled := FEnv.Link(specAst.AsLambdaExpression, log);
ApplyErrors(log);
FWorkspace.RootNode.RecalcLayout;
FWorkspace.InvalidateConnections;
except
on E: ECompilationFailed do
begin
@@ -537,13 +502,9 @@ begin
end;
end;
FWorkspace.World.Repaint;
FWorkspace.RequestLayout;
end;
// =================================================================================================
// == NAVIGATION IMPLEMENTATION
// =================================================================================================
procedure TAstEditor.SetFocusedNode(Node: TAstViewNode);
begin
if FFocusedNode = Node then
@@ -565,338 +526,96 @@ procedure TAstEditor.EnsureVisible(Node: TAstViewNode);
const
cMargin = 40;
var
NodeRect, ViewRect: TRectF;
Delta: TPointF;
NodeRect: TRectF;
begin
if (Node = nil) or (FWorkspace = nil) then
Exit;
NodeRect := Node.AbsoluteRect;
ViewRect := FWorkspace.AbsoluteRect;
ViewRect.Inflate(-cMargin, -cMargin);
Delta := TPointF.Zero;
var ScreenCenter := TRectF.Create(0, 0, FWorkspace.Width, FWorkspace.Height).CenterPoint;
var NodeCenterWorld := NodeRect.CenterPoint;
if NodeRect.Width > ViewRect.Width then
Delta.X := ViewRect.CenterPoint.X - NodeRect.CenterPoint.X
else if NodeRect.Left < ViewRect.Left then
Delta.X := ViewRect.Left - NodeRect.Left
else if NodeRect.Right > ViewRect.Right then
Delta.X := ViewRect.Right - NodeRect.Right;
if NodeRect.Height > ViewRect.Height then
Delta.Y := ViewRect.CenterPoint.Y - NodeRect.CenterPoint.Y
else if NodeRect.Top < ViewRect.Top then
Delta.Y := ViewRect.Top - NodeRect.Top
else if NodeRect.Bottom > ViewRect.Bottom then
Delta.Y := ViewRect.Bottom - NodeRect.Bottom;
if not (SameValue(Delta.X, 0, TEpsilon.Position) and SameValue(Delta.Y, 0, TEpsilon.Position)) then
begin
FWorkspace.ContentOffset := FWorkspace.ContentOffset + Delta;
end;
end;
function TAstEditor.GetParentNode(StartNode: TAstViewNode): TAstViewNode;
var
curr: TControl;
begin
Result := nil;
if StartNode = nil then
Exit;
curr := StartNode.ParentControl;
while (curr <> nil) and (curr <> FWorkspace.World) do
begin
if curr is TAstViewNode then
Exit(TAstViewNode(curr));
curr := curr.ParentControl;
end;
end;
function TAstEditor.GetFirstChild(StartNode: TAstViewNode): TAstViewNode;
function FindFirst(Parent: TControl): TAstViewNode;
var
i: Integer;
begin
Result := nil;
for i := 0 to Parent.ChildrenCount - 1 do
begin
if Parent.Children[i] is TAstViewNode then
Exit(TAstViewNode(Parent.Children[i]))
else if (Parent.Children[i] is TControl) and (TControl(Parent.Children[i]).ChildrenCount > 0) then
begin
Result := FindFirst(TControl(Parent.Children[i]));
if Result <> nil then
Exit;
end;
end;
end;
begin
Result := FindFirst(StartNode);
end;
function FindFirstViewNode(Container: TControl): TAstViewNode;
var
i: Integer;
Child: TControl;
begin
Result := nil;
if Container is TAstViewNode then
Exit(TAstViewNode(Container));
for i := 0 to Container.ChildrenCount - 1 do
begin
if Container.Children[i] is TControl then
begin
Child := TControl(Container.Children[i]);
if Child.Visible then
begin
Result := FindFirstViewNode(Child);
if Result <> nil then
Exit;
end;
end;
end;
end;
function FindLastViewNode(Container: TControl): TAstViewNode;
var
i: Integer;
Child: TControl;
begin
Result := nil;
if Container is TAstViewNode then
exit(TAstViewNode(Container));
for i := Container.ChildrenCount - 1 downto 0 do
begin
if Container.Children[i] is TControl then
begin
Child := TControl(Container.Children[i]);
if Child.Visible then
begin
var Found := FindLastViewNode(Child);
if Found <> nil then
Exit(Found);
end;
end;
end;
end;
function FindNextSiblingInList(Parent: TControl; AfterControl: TControl): TAstViewNode;
var
i, StartIndex: Integer;
Candidate: TControl;
begin
Result := nil;
StartIndex := -1;
for i := 0 to Parent.ChildrenCount - 1 do
if Parent.Children[i] = AfterControl then
begin
StartIndex := i;
Break;
end;
if StartIndex >= 0 then
begin
for i := StartIndex + 1 to Parent.ChildrenCount - 1 do
begin
if Parent.Children[i] is TControl then
begin
Candidate := TControl(Parent.Children[i]);
if Candidate.Visible then
begin
Result := FindFirstViewNode(Candidate);
if Result <> nil then
Exit;
end;
end;
end;
end;
end;
function FindPrevSiblingInList(Parent: TControl; BeforeControl: TControl): TAstViewNode;
var
i, StartIndex: Integer;
Candidate: TControl;
begin
Result := nil;
StartIndex := -1;
for i := 0 to Parent.ChildrenCount - 1 do
if Parent.Children[i] = BeforeControl then
begin
StartIndex := i;
Break;
end;
if StartIndex >= 0 then
begin
for i := StartIndex - 1 downto 0 do
begin
if Parent.Children[i] is TControl then
begin
Candidate := TControl(Parent.Children[i]);
if Candidate.Visible then
begin
Result := FindLastViewNode(Candidate);
if Result <> nil then
Exit;
end;
end;
end;
end;
end;
function TAstEditor.GetNextVerticalNeighbor(StartNode: TAstViewNode): TAstViewNode;
var
Current, Parent: TControl;
begin
Result := nil;
Current := StartNode;
while (Current <> nil) and (Current <> FWorkspace.World) do
begin
Parent := Current.ParentControl;
if Parent = nil then
Break;
if (Parent is TAutoFitControl) and (TAutoFitControl(Parent).Orientation = TLayoutOrientation.loVertical) then
begin
Result := FindNextSiblingInList(Parent, Current);
if Result <> nil then
Exit;
end;
Current := Parent;
end;
if Result = nil then
Result := GetNextLinearNode(StartNode)
end;
function TAstEditor.GetPrevVerticalNeighbor(StartNode: TAstViewNode): TAstViewNode;
var
Current, Parent: TControl;
begin
Result := nil;
Current := StartNode;
while (Current <> nil) and (Current <> FWorkspace.World) do
begin
Parent := Current.ParentControl;
if Parent = nil then
Break;
if (Parent is TAutoFitControl) and (TAutoFitControl(Parent).Orientation = TLayoutOrientation.loVertical) then
begin
Result := FindPrevSiblingInList(Parent, Current);
if Result <> nil then
Exit;
end;
Current := Parent;
end;
if Result = nil then
Result := GetPrevLinearNode(StartNode)
FWorkspace.ContentOffset := ScreenCenter - (NodeCenterWorld * FWorkspace.Zoom);
end;
function TAstEditor.GetNextLinearNode(StartNode: TAstViewNode): TAstViewNode;
var
CurrentControl, ParentControl: TControl;
i, StartIndex: Integer;
Candidate: TControl;
begin
Result := GetFirstChild(StartNode);
if Result <> nil then
Exit;
CurrentControl := StartNode;
while (CurrentControl <> nil) and (CurrentControl <> FWorkspace.World) do
function FindFirst(Node: TVisualNode): TAstViewNode;
begin
ParentControl := CurrentControl.ParentControl;
if ParentControl = nil then
Break;
StartIndex := -1;
for i := 0 to ParentControl.ChildrenCount - 1 do
if ParentControl.Children[i] = CurrentControl then
if Node is TAstViewNode then
Exit(TAstViewNode(Node));
for var i := 0 to Node.GetChildCount - 1 do
begin
StartIndex := i;
Break;
end;
if StartIndex >= 0 then
begin
for i := StartIndex + 1 to ParentControl.ChildrenCount - 1 do
begin
if ParentControl.Children[i] is TControl then
begin
Candidate := TControl(ParentControl.Children[i]);
if Candidate.Visible then
begin
Result := FindFirstViewNode(Candidate);
Result := FindFirst(Node.GetChild(i));
if Result <> nil then
Exit;
end;
end;
end;
end;
CurrentControl := ParentControl;
end;
Result := nil;
end;
function FindNext(Node: TVisualNode): TAstViewNode;
var
Parent: TVisualNode;
Idx: Integer;
begin
Result := nil;
if Node.GetChildCount > 0 then
begin
Result := FindFirst(Node.GetChild(0));
if Result <> nil then
Exit;
end;
Parent := Node.Parent;
while Parent <> nil do
begin
Idx := -1;
for var k := 0 to Parent.GetChildCount - 1 do
if Parent.GetChild(k) = Node then
begin
Idx := k;
break;
end;
if (Idx >= 0) and (Idx < Parent.GetChildCount - 1) then
begin
for var k := Idx + 1 to Parent.GetChildCount - 1 do
begin
Result := FindFirst(Parent.GetChild(k));
if Result <> nil then
Exit;
end;
end;
Node := Parent;
Parent := Node.Parent;
end;
end;
begin
for var i := 0 to StartNode.GetChildCount - 1 do
begin
Result := FindFirst(StartNode.GetChild(i));
if Result <> nil then
Exit;
end;
Result := FindNext(StartNode);
end;
function TAstEditor.GetPrevLinearNode(StartNode: TAstViewNode): TAstViewNode;
var
CurrentControl, ParentControl: TControl;
i, StartIndex: Integer;
Candidate: TControl;
begin
CurrentControl := StartNode;
while (CurrentControl <> nil) and (CurrentControl <> FWorkspace.World) do
begin
ParentControl := CurrentControl.ParentControl;
if ParentControl = nil then
Break;
StartIndex := -1;
for i := 0 to ParentControl.ChildrenCount - 1 do
if ParentControl.Children[i] = CurrentControl then
begin
StartIndex := i;
Break;
end;
if StartIndex >= 0 then
begin
for i := StartIndex - 1 downto 0 do
begin
if ParentControl.Children[i] is TControl then
begin
Candidate := TControl(ParentControl.Children[i]);
if Candidate.Visible then
begin
Result := FindLastViewNode(Candidate);
if Result <> nil then
Exit;
end;
end;
end;
end;
if ParentControl is TAstViewNode then
Exit(TAstViewNode(ParentControl));
CurrentControl := ParentControl;
end;
Result := nil;
end;
function TAstEditor.GetNextVerticalNeighbor(StartNode: TAstViewNode): TAstViewNode;
begin
Result := GetNextLinearNode(StartNode);
end;
function TAstEditor.GetPrevVerticalNeighbor(StartNode: TAstViewNode): TAstViewNode;
begin
Result := GetPrevLinearNode(StartNode);
end;
procedure TAstEditor.Navigate(Key: Word; Shift: TShiftState);
var
Current: TAstViewNode;
@@ -923,19 +642,14 @@ begin
Exit;
end;
if Key = vkEscape then
begin
Target := GetParentNode(Current);
if Target <> nil then
SetFocusedNode(Target);
Exit;
end;
case Key of
vkLeft: Target := GetPrevLinearNode(Current);
vkRight: Target := GetNextLinearNode(Current);
vkUp: Target := GetPrevVerticalNeighbor(Current);
vkDown: Target := GetNextVerticalNeighbor(Current);
vkEscape:
if Current.Parent is TAstViewNode then
Target := TAstViewNode(Current.Parent);
end;
if Target <> nil then