unit Myc.Fmx.AstEditor.Core; interface uses System.SysUtils, System.Classes, System.UITypes, System.Types, System.Math, System.Math.Vectors, System.Generics.Defaults, System.Generics.Collections, FMX.Types, FMX.Controls, FMX.Objects, FMX.Graphics, FMX.StdCtrls, Myc.Ast.Nodes, Myc.Fmx.AstEditor.Workspace; const cNodePadding = 10; cTitleTopPadding = 2; cTitleBottomPadding = 4; cMinNodeWidth = 10; cMinNodeHeight = 10; type TAuraNode = class; // Forward declaration // This aggregate interface encapsulates all node-specific logic. IAuraNodeHandler = interface // Gets the original logical AST node function GetAstNode: IAstNode; // Creates the specific FMX UI for this node procedure BuildUI(OwnerNode: TAuraNode); // Reconstructs the logical AST node from the FMX UI state function ReconstructAst(OwnerNode: TAuraNode): IAstNode; // The original logical AST node property Node: IAstNode read GetAstNode; end; IAstVisualizer = interface {$region 'private'} function GetExprDepth: Integer; function GetParentControl: TControl; function GetWorkspace: TAuraWorkspace; {$endregion} function Clone(ParentControl: TControl; ExprDepth: Integer): IAstVisualizer; function CallAccept(const Node: IAstNode): TAuraNode; property ExprDepth: Integer read GetExprDepth; property ParentControl: TControl read GetParentControl; property Workspace: TAuraWorkspace read GetWorkspace; end; // Defines the layout direction for children within TAutoFitControl TLayoutOrientation = (loVertical, loHorizontal); // Defines the alignment of children on the cross-axis TLayoutAlignment = (laCenter, laFlush); // A styled control that automatically adjusts its size to fit its children, including padding. TAutoFitControl = class(TStyledControl) private FUpdatingOwnSize: Boolean; // Recursion guard FNeedRecalcSize: Boolean; // Flag for EndUpdate FOrientation: TLayoutOrientation; // Storage for Orientation FAlignment: TLayoutAlignment; // Storage for Alignment 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; end; // A movable panel with a custom-painted border. Content (like title) is added externally. TAuraNode = class(TAutoFitControl) private FBackgroundColor: TAlphaColor; FIsDragging: Boolean; FDownPos: TPointF; FBorderColor: TAlphaColor; FBorderWidth: Single; FBorderRadius: Single; FFrameless: Boolean; FVisualizer: IAstVisualizer; FHandler: IAuraNodeHandler; // --- Visual State Fields --- FErrorMessage: string; FTypeInfoText: string; procedure SetBackgroundColor(const Value: TAlphaColor); procedure SetBorderColor(const Value: TAlphaColor); procedure SetBorderWidth(const Value: Single); procedure SetBorderRadius(const Value: Single); procedure SetFrameless(const Value: Boolean); function GetNode: IAstNode; // New Setters procedure SetErrorMessage(const Value: string); procedure SetTypeInfoText(const Value: string); procedure UpdateVisualState; protected 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 SetupNode; public constructor Create(const AVisualizer: IAstVisualizer; const AHandler: IAuraNodeHandler); 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): TAuraNode; function CreateAst: IAstNode; property Visualizer: IAstVisualizer read FVisualizer; property Node: IAstNode read GetNode; // --- Visual State Properties --- property ErrorMessage: string read FErrorMessage write SetErrorMessage; property TypeInfoText: string read FTypeInfoText write SetTypeInfoText; 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; // Helper base class to reduce boilerplate in specific handlers TBaseNodeHandler = class(TInterfacedObject, IAuraNodeHandler) protected FNode: T; function GetAstNode: IAstNode; public constructor Create(const ANode: T); procedure BuildUI(OwnerNode: TAuraNode); virtual; abstract; function ReconstructAst(OwnerNode: TAuraNode): IAstNode; virtual; abstract; end; 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; 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.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; { TAuraNode } constructor TAuraNode.Create(const AVisualizer: IAstVisualizer; const AHandler: IAuraNodeHandler); begin inherited Create(AVisualizer.Workspace); Parent := AVisualizer.ParentControl; FVisualizer := AVisualizer.Clone(Self, AVisualizer.ExprDepth); FHandler := AHandler; FIsDragging := False; FBorderColor := TAlphaColors.Gray; FBorderWidth := 1; FBorderRadius := 9; FBackgroundColor := $080a0a0a; FFrameless := False; Width := cMinNodeWidth; Height := cMinNodeHeight; HitTest := True; ClipChildren := 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; var cn: Cardinal := $ea - (7 * FVisualizer.ExprDepth); var c: Cardinal := $ff000000 or (cn shl 16) or (cn shl 8) or cn; BackgroundColor := c; end; destructor TAuraNode.Destroy; begin FHandler := nil; inherited; end; function TAuraNode.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 TAuraNode.AddExpr(Parent: TControl; const Title: String; const Node: IAstNode): TAuraNode; 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 TAuraNode.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 TAuraNode.AfterConstruction; begin inherited; SetupNode; end; function TAuraNode.CreateAst: IAstNode; begin if Assigned(FHandler) then Result := FHandler.ReconstructAst(Self) else Result := TAst.Nop; end; function TAuraNode.GetNode: IAstNode; begin if Assigned(FHandler) then Result := FHandler.Node else Result := nil; end; procedure TAuraNode.SetErrorMessage(const Value: string); begin if FErrorMessage <> Value then begin FErrorMessage := Value; UpdateVisualState; Repaint; end; end; procedure TAuraNode.SetTypeInfoText(const Value: string); begin if FTypeInfoText <> Value then begin FTypeInfoText := Value; UpdateVisualState; // Type Info usually doesn't change painting, just hint end; end; procedure TAuraNode.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 TAuraNode.Paint; var rect: TRectF; effBorderColor: TAlphaColor; effBorderWidth: Single; effDash: TStrokeDash; begin inherited; Canvas.Fill.Kind := TBrushKind.None; // Determine styles based on state (Error > Standard) if FErrorMessage <> '' then begin effBorderColor := TAlphaColors.Red; effBorderWidth := 2.0; effDash := TStrokeDash.Solid; end else begin effBorderColor := FBorderColor; effBorderWidth := FBorderWidth; if FFrameless then effDash := TStrokeDash.Dot else effDash := TStrokeDash.Solid; end; if FFrameless and (FErrorMessage = '') then begin // Standard frameless drawing (only if no error) Canvas.Fill.Kind := TBrushKind.Solid; Canvas.Fill.Color := FBackgroundColor; Canvas.Stroke.Kind := TBrushKind.None; Canvas.FillRect(TRectF.Create(0, 0, Width, Height), 0, 0, [], 1.0); 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); end else begin // Draw background fill first Canvas.Fill.Kind := TBrushKind.Solid; Canvas.Fill.Color := FBackgroundColor; rect := TRectF.Create(0, 0, Width, Height); if (effBorderWidth > 0) then rect.Inflate(-effBorderWidth / 2, -effBorderWidth / 2); Canvas.FillRect(rect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round); // Draw border (Custom or Error) if (effBorderWidth > 0) and (effBorderColor <> TAlphaColors.Null) then begin rect := TRectF.Create(0, 0, Width, Height); rect.Inflate(-effBorderWidth / 2, -effBorderWidth / 2); 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); end; end; end; procedure TAuraNode.SetBorderColor(const Value: TAlphaColor); begin if FBorderColor <> Value then begin FBorderColor := Value; Repaint; end; end; procedure TAuraNode.SetBorderRadius(const Value: Single); begin if FBorderRadius <> Value then begin FBorderRadius := Value; Repaint; end; end; procedure TAuraNode.SetBorderWidth(const Value: Single); begin if FBorderWidth <> Value then begin FBorderWidth := Value; Repaint; end; end; procedure TAuraNode.SetFrameless(const Value: Boolean); begin if FFrameless <> Value then begin FFrameless := Value; Repaint; end; end; procedure TAuraNode.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); begin inherited; if Button = TMouseButton.mbLeft then begin var lControl := ObjectAtPoint(LocalToScreen(TPointF.Create(X, Y))); if Assigned(lControl) and (lControl.GetObject = Self) then begin FIsDragging := True; FDownPos := TPointF.Create(X, Y); Capture; BringToFront; end else FIsDragging := False; end; end; procedure TAuraNode.MouseMove(Shift: TShiftState; X, Y: Single); begin inherited; if FIsDragging then begin var deltaX := X - FDownPos.X; var deltaY := Y - FDownPos.Y; Position.X := Position.X + deltaX; Position.Y := Position.Y + deltaY; if ParentControl <> nil then ParentControl.Repaint; end; end; procedure TAuraNode.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); begin inherited; if (Button = TMouseButton.mbLeft) and (FIsDragging) then begin ReleaseCapture; FIsDragging := False; if ParentControl <> nil then ParentControl.Repaint; end; end; procedure TAuraNode.SetBackgroundColor(const Value: TAlphaColor); begin FBackgroundColor := Value; Repaint; end; procedure TAuraNode.SetupNode; begin if Assigned(FHandler) then FHandler.BuildUI(Self); end; { TBaseNodeHandler } constructor TBaseNodeHandler.Create(const ANode: T); begin inherited Create; FNode := ANode; end; function TBaseNodeHandler.GetAstNode: IAstNode; begin Result := FNode; end; end.