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

Visual AST editing with drag'n'drop 1s Version

Browse Source
This commit is contained in:
Michael Schimmel
2025-11-30 16:00:00 +01:00
parent cd0f2ffde3
commit 438baa3609
10 changed files with 917 additions and 565 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/AST/Myc.Fmx.AstEditor.pas
+45 -268
View File
@@ -17,7 +17,8 @@ uses
FMX.Graphics,
FMX.StdCtrls,
Myc.Ast.Nodes,
Myc.Fmx.AstEditor.Workspace;
Myc.Fmx.AstEditor.Workspace,
Myc.Fmx.AstEditor.Layout;
const
cNodePadding = 10;
@@ -25,9 +26,10 @@ const
cTitleBottomPadding = 4;
cMinNodeWidth = 10;
cMinNodeHeight = 10;
cDragGutterWidth = 20; // Width of the trigger zone for dragging
type
TAstViewNode = class; // Forward declaration
TAstViewNode = class;
IAstViewNodeHandler = interface
function GetAstNode: IAstNode;
@@ -36,11 +38,17 @@ type
property Node: IAstNode read GetAstNode;
end;
IReorderable = interface
['{9FA7C504-D327-4E00-A5FE-DD2876886212}']
function CanDrag(Child: TControl): Boolean;
procedure MoveChild(SourceIndex, TargetIndex: Integer);
end;
IAstVisualizer = interface
{$region 'private'}
function GetExprDepth: Integer;
function GetParentControl: TControl;
function GetWorkspace: TAstWorkspace;
function GetWorkspace: TWorkspace;
{$endregion}
function Clone(ParentControl: TControl; ExprDepth: Integer): IAstVisualizer;
@@ -48,34 +56,7 @@ type
property ExprDepth: Integer read GetExprDepth;
property ParentControl: TControl read GetParentControl;
property Workspace: TAstWorkspace read GetWorkspace;
end;
TLayoutOrientation = (loVertical, loHorizontal);
TLayoutAlignment = (laCenter, laFlush);
TAutoFitControl = class(TStyledControl)
private
FUpdatingOwnSize: Boolean;
FNeedRecalcSize: Boolean;
FOrientation: TLayoutOrientation;
FAlignment: TLayoutAlignment;
procedure RecalcOwnSize;
procedure SetOrientation(const Value: TLayoutOrientation);
procedure SetAlignment(const Value: TLayoutAlignment);
protected
procedure ParentContentChanged; override;
procedure PaddingChanged; override;
procedure ChangeChildren; override;
procedure Loaded; override;
procedure DoEndUpdate; override;
public
constructor Create(AOwner: TComponent); override;
published
property Padding;
property Orientation: TLayoutOrientation read FOrientation write SetOrientation default TLayoutOrientation.loHorizontal;
property Alignment: TLayoutAlignment read FAlignment write SetAlignment default TLayoutAlignment.laCenter;
property Workspace: TWorkspace read GetWorkspace;
end;
TAstViewNode = class(TAutoFitControl)
@@ -106,7 +87,6 @@ type
procedure Paint; override;
procedure SetupNode;
// Overrides for interaction
procedure DoMouseEnter; override;
procedure DoMouseLeave; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
@@ -127,6 +107,7 @@ type
property Visualizer: IAstVisualizer read FVisualizer;
property Node: IAstNode read GetNode;
property Handler: IAstViewNodeHandler read FHandler;
property ErrorMessage: string read FErrorMessage write SetErrorMessage;
property TypeInfoText: string read FTypeInfoText write SetTypeInfoText;
@@ -184,193 +165,6 @@ implementation
uses
Myc.Ast;
{ TAutoFitControl }
constructor TAutoFitControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
HitTest := True;
FOrientation := TLayoutOrientation.loHorizontal;
FAlignment := TLayoutAlignment.laCenter;
end;
procedure TAutoFitControl.SetAlignment(const Value: TLayoutAlignment);
begin
if FAlignment <> Value then
begin
FAlignment := Value;
RecalcOwnSize;
end;
end;
procedure TAutoFitControl.SetOrientation(const Value: TLayoutOrientation);
begin
if FOrientation <> Value then
begin
FOrientation := Value;
RecalcOwnSize;
end;
end;
procedure TAutoFitControl.RecalcOwnSize;
var
i: Integer;
child: TControl;
childrenToLayout: TList<TControl>;
currentX, currentY: Single;
requiredWidth, requiredHeight: Single;
childWidthWithMargins, childHeightWithMargins: Single;
hasVisibleChild: Boolean;
begin
if FUpdatingOwnSize then
exit;
if IsUpdating then
begin
FNeedRecalcSize := True;
exit;
end;
FUpdatingOwnSize := True;
childrenToLayout := nil;
try
requiredWidth := Padding.Left + Padding.Right;
requiredHeight := Padding.Top + Padding.Bottom;
currentX := Padding.Left;
currentY := Padding.Top;
hasVisibleChild := False;
childrenToLayout := TList<TControl>.Create;
for i := 0 to ChildrenCount - 1 do
begin
if Children[i] is TControl then
begin
child := TControl(Children[i]);
if child.Visible and (child.Align = TAlignLayout.None) then
begin
childrenToLayout.Add(child);
hasVisibleChild := True;
end;
end;
end;
if hasVisibleChild then
begin
if FOrientation = TLayoutOrientation.loVertical then
begin
for child in childrenToLayout do
begin
child.Position.Y := currentY + child.Margins.Top;
currentY := child.Position.Y + child.Height + child.Margins.Bottom;
childWidthWithMargins := Padding.Left + child.Margins.Left + child.Width + child.Margins.Right + Padding.Right;
requiredWidth := System.Math.Max(requiredWidth, childWidthWithMargins);
end;
requiredHeight := currentY + Padding.Bottom;
if FAlignment = TLayoutAlignment.laFlush then
begin
for child in childrenToLayout do
begin
child.Position.X := Padding.Left + child.Margins.Left;
end;
end
else
begin
var contentWidth := requiredWidth - Padding.Left - Padding.Right;
for child in childrenToLayout do
begin
var childTotalWidth := child.Width + child.Margins.Left + child.Margins.Right;
var childX := Padding.Left + ((contentWidth - childTotalWidth) / 2) + child.Margins.Left;
child.Position.X := childX;
end;
end;
end
else
begin
for child in childrenToLayout do
begin
child.Position.X := currentX + child.Margins.Left;
currentX := child.Position.X + child.Width + child.Margins.Right;
childHeightWithMargins := Padding.Top + child.Margins.Top + child.Height + child.Margins.Bottom + Padding.Bottom;
requiredHeight := System.Math.Max(requiredHeight, childHeightWithMargins);
end;
requiredWidth := currentX + Padding.Right;
if FAlignment = TLayoutAlignment.laFlush then
begin
for child in childrenToLayout do
begin
child.Position.Y := Padding.Top + child.Margins.Top;
end;
end
else
begin
var contentHeight := requiredHeight - Padding.Top - Padding.Bottom;
for child in childrenToLayout do
begin
var childTotalHeight := child.Height + child.Margins.Top + child.Margins.Bottom;
var childY := Padding.Top + ((contentHeight - childTotalHeight) / 2) + child.Margins.Top;
child.Position.Y := childY;
end;
end;
end;
end
else
begin
requiredWidth := Padding.Left + Padding.Right;
requiredHeight := Padding.Top + Padding.Bottom;
end;
requiredWidth := System.Math.Max(0, requiredWidth);
requiredHeight := System.Math.Max(0, requiredHeight);
if not SameValue(requiredWidth, Width, TEpsilon.Position) or not SameValue(requiredHeight, Height, TEpsilon.Position) then
begin
FSize.SetSizeWithoutNotification(TSizeF.Create(requiredWidth, requiredHeight));
HandleSizeChanged;
end;
finally
childrenToLayout.Free;
FUpdatingOwnSize := False;
end;
end;
procedure TAutoFitControl.Loaded;
begin
inherited Loaded;
RecalcOwnSize;
end;
procedure TAutoFitControl.ChangeChildren;
begin
inherited ChangeChildren;
RecalcOwnSize;
end;
procedure TAutoFitControl.PaddingChanged;
begin
inherited PaddingChanged;
RecalcOwnSize;
end;
procedure TAutoFitControl.ParentContentChanged;
begin
inherited ParentContentChanged;
RecalcOwnSize;
end;
procedure TAutoFitControl.DoEndUpdate;
begin
inherited;
if FNeedRecalcSize then
begin
FNeedRecalcSize := False;
RecalcOwnSize;
end;
end;
{ TAstViewNode }
constructor TAstViewNode.Create(const AVisualizer: IAstVisualizer; const AHandler: IAstViewNodeHandler);
@@ -392,7 +186,6 @@ begin
Width := cMinNodeWidth;
Height := cMinNodeHeight;
// HitTest muss True sein für Hover-Effekte (IsMouseOver)
HitTest := True;
ClipChildren := True;
@@ -419,8 +212,6 @@ end;
procedure TAstViewNode.DoMouseEnter;
begin
inherited;
// Wir müssen neu zeichnen, da sich IsMouseOver geändert hat,
// FMX triggert Paint nicht automatisch bei Hover.
Repaint;
end;
@@ -431,43 +222,43 @@ begin
end;
procedure TAstViewNode.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
var
pt: TPointF;
const
cHeaderHeight = 30; // Defined height for header drag area
begin
inherited;
// Panning-Weiterleitung an den Workspace
if Assigned(FVisualizer.Workspace) then
// 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
pt := LocalToAbsolute(TPointF.Create(X, Y));
pt := FVisualizer.Workspace.AbsoluteToLocal(pt);
FVisualizer.Workspace.ExternalMouseDown(Button, Shift, pt.X, pt.Y);
// 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);
var
pt: TPointF;
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;
if Assigned(FVisualizer.Workspace) then
begin
pt := LocalToAbsolute(TPointF.Create(X, Y));
pt := FVisualizer.Workspace.AbsoluteToLocal(pt);
FVisualizer.Workspace.ExternalMouseMove(Shift, pt.X, pt.Y);
end;
end;
procedure TAstViewNode.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
var
pt: TPointF;
begin
inherited;
if Assigned(FVisualizer.Workspace) then
begin
pt := LocalToAbsolute(TPointF.Create(X, Y));
pt := FVisualizer.Workspace.AbsoluteToLocal(pt);
FVisualizer.Workspace.ExternalMouseUp(Button, Shift, pt.X, pt.Y);
end;
end;
function TAstViewNode.AddContainer(Parent: TControl; Orientation: TLayoutOrientation; Alignment: TLayoutAlignment): TAutoFitControl;
@@ -547,7 +338,6 @@ begin
begin
FTypeInfoText := Value;
UpdateVisualState;
// Type Info usually doesn't change painting, just hint
end;
end;
@@ -585,16 +375,12 @@ begin
if Assigned(Node) then
begin
case Node.Kind of
// Lists and Blocks should generally not be highlighted as a whole on hover
// because they are containers for other selectable items.
akBlockExpression, akParameterList, akArgumentList, akExpressionList, akRecordFieldList: shouldIgnoreHover := True;
end;
end;
// Determine hover state: active only if mouse is over AND it is not a container type
isHovering := IsMouseOver and (not shouldIgnoreHover);
// 1. Set base values
if FFrameless then
begin
effBorderColor := FBorderColor;
@@ -608,20 +394,13 @@ begin
effDash := TStrokeDash.Solid;
end;
// 2. Hover state (overrides base, makes frameless nodes visible)
if isHovering then
begin
// Bright white for strong contrast against dark background
effBorderColor := TAlphaColors.White;
// Make border slightly thicker for a "pop" effect
effBorderWidth := Max(2.0, FBorderWidth + 1.0);
// Always solid line when hovering, even if originally frameless
effDash := TStrokeDash.Solid;
end;
// 3. Error state (dominates everything)
if FErrorMessage <> '' then
begin
effBorderColor := TAlphaColors.Red;
@@ -629,19 +408,13 @@ begin
effDash := TStrokeDash.Solid;
end;
// --- Drawing ---
// Fill background
Canvas.Fill.Kind := TBrushKind.Solid;
Canvas.Fill.Color := FBackgroundColor;
if FFrameless and (FErrorMessage = '') and (not isHovering) then
begin
// Special case: Inactive, frameless node (e.g., simple constant)
// Draw only background, no border
Canvas.FillRect(TRectF.Create(0, 0, Width, Height), 0, 0, [], 1.0);
// Draw border only if explicit width is set (e.g. debugging)
if FBorderWidth > 0 then
begin
Canvas.Stroke.Kind := TBrushKind.Solid;
@@ -653,16 +426,12 @@ begin
end
else
begin
// Standard case: Node with border (or hovered frameless node)
rect := TRectF.Create(0, 0, Width, Height);
// Adjust to avoid clipping the border
if (effBorderWidth > 0) then
rect.Inflate(-effBorderWidth / 2, -effBorderWidth / 2);
Canvas.FillRect(rect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round);
// Draw border
if (effBorderWidth > 0) and (effBorderColor <> TAlphaColors.Null) then
begin
Canvas.Stroke.Kind := TBrushKind.Solid;
@@ -672,6 +441,14 @@ begin
Canvas.DrawRect(rect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round);
end;
end;
if isHovering and (Parent is TAutoFitControl) 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);
end;
end;
procedure TAstViewNode.SetBorderColor(const Value: TAlphaColor);