unit Myc.Fmx.AstEditor; 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 TAstViewNode = class; // Forward declaration IAstViewNodeHandler = interface function GetAstNode: IAstNode; procedure BuildUI(OwnerNode: TAstViewNode); function ReconstructAst(OwnerNode: TAstViewNode): IAstNode; property Node: IAstNode read GetAstNode; end; IAstVisualizer = interface {$region 'private'} function GetExprDepth: Integer; function GetParentControl: TControl; function GetWorkspace: TAstWorkspace; {$endregion} function Clone(ParentControl: TControl; ExprDepth: Integer): IAstVisualizer; function CallAccept(const Node: IAstNode): TAstViewNode; 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; end; TAstViewNode = class(TAutoFitControl) private FBackgroundColor: TAlphaColor; FBorderColor: TAlphaColor; FBorderWidth: Single; FBorderRadius: Single; FFrameless: Boolean; FVisualizer: IAstVisualizer; FHandler: IAstViewNodeHandler; 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; procedure SetErrorMessage(const Value: string); procedure SetTypeInfoText(const Value: string); procedure UpdateVisualState; protected procedure Paint; override; procedure SetupNode; // Overrides for interaction 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; function CreateAst: IAstNode; property Visualizer: IAstVisualizer read FVisualizer; property Node: IAstNode read GetNode; 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; TBaseNodeHandler = class(TInterfacedObject, IAstViewNodeHandler) protected FNode: T; function GetAstNode: IAstNode; public constructor Create(const ANode: T); procedure BuildUI(OwnerNode: TAstViewNode); virtual; abstract; function ReconstructAst(OwnerNode: TAstViewNode): 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; { TAstViewNode } constructor TAstViewNode.Create(const AVisualizer: IAstVisualizer; const AHandler: IAstViewNodeHandler); begin inherited Create(AVisualizer.Workspace); Parent := AVisualizer.ParentControl; FVisualizer := AVisualizer.Clone(Self, AVisualizer.ExprDepth); FHandler := AHandler; FBorderColor := TAlphaColors.Gray; FBorderWidth := 1; FBorderRadius := 9; FBackgroundColor := $080a0a0a; FFrameless := False; Width := cMinNodeWidth; Height := cMinNodeHeight; // HitTest muss True sein für Hover-Effekte (IsMouseOver) 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 TAstViewNode.Destroy; begin FHandler := nil; inherited; 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; procedure TAstViewNode.DoMouseLeave; begin inherited; Repaint; end; procedure TAstViewNode.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); var pt: TPointF; begin inherited; // Panning-Weiterleitung an den Workspace if Assigned(FVisualizer.Workspace) then begin pt := LocalToAbsolute(TPointF.Create(X, Y)); pt := FVisualizer.Workspace.AbsoluteToLocal(pt); FVisualizer.Workspace.ExternalMouseDown(Button, Shift, pt.X, pt.Y); end; end; procedure TAstViewNode.MouseMove(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.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; 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; function TAstViewNode.CreateAst: IAstNode; begin if Assigned(FHandler) then Result := FHandler.ReconstructAst(Self) else Result := TAst.Nop; end; function TAstViewNode.GetNode: IAstNode; begin if Assigned(FHandler) then Result := FHandler.Node else Result := nil; end; procedure TAstViewNode.SetErrorMessage(const Value: string); begin if FErrorMessage <> Value then begin FErrorMessage := Value; UpdateVisualState; Repaint; end; end; procedure TAstViewNode.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 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; var rect: TRectF; effBorderColor: TAlphaColor; effBorderWidth: Single; effDash: TStrokeDash; isHovering: Boolean; shouldIgnoreHover: Boolean; begin inherited; shouldIgnoreHover := False; 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; effBorderWidth := FBorderWidth; effDash := TStrokeDash.Dot; end else begin effBorderColor := FBorderColor; effBorderWidth := FBorderWidth; 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; effBorderWidth := 2.0; 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; 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; 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; 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 TAstViewNode.SetBorderColor(const Value: TAlphaColor); begin if FBorderColor <> Value then begin FBorderColor := Value; Repaint; end; end; procedure TAstViewNode.SetBorderRadius(const Value: Single); begin if FBorderRadius <> Value then begin FBorderRadius := Value; Repaint; end; end; procedure TAstViewNode.SetBorderWidth(const Value: Single); begin if FBorderWidth <> Value then begin FBorderWidth := Value; Repaint; end; end; procedure TAstViewNode.SetFrameless(const Value: Boolean); begin if FFrameless <> Value then begin FFrameless := Value; Repaint; end; end; procedure TAstViewNode.SetBackgroundColor(const Value: TAlphaColor); begin FBackgroundColor := Value; Repaint; end; procedure TAstViewNode.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.