unit Myc.Fmx.AstEditor.Node; 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, Myc.Fmx.AstEditor.Layout; const cNodePadding = 10; cTitleTopPadding = 2; cTitleBottomPadding = 4; cMinNodeWidth = 10; cMinNodeHeight = 10; cDragGutterWidth = 20; // Width of the trigger zone for dragging type TAstViewNode = class; IAstViewNodeHandler = interface function GetAstNode: IAstNode; procedure BuildUI(OwnerNode: TAstViewNode); function ReconstructAst(OwnerNode: TAstViewNode): IAstNode; 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: TWorkspace; {$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: TWorkspace read GetWorkspace; end; TAstViewNode = class(TAutoFitControl) private FBackgroundColor: TAlphaColor; FBorderColor: TAlphaColor; FBorderWidth: Single; FBorderRadius: Single; FFrameless: Boolean; FVisualizer: IAstVisualizer; FHandler: IAstViewNodeHandler; FErrorMessage: string; FTypeInfoText: string; FIsFocused: Boolean; 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; procedure SetIsFocused(const Value: Boolean); protected procedure Paint; 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; function CreateAst: IAstNode; 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; 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 = 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; { 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; FIsFocused := 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 TAstViewNode.Destroy; begin FHandler := nil; 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; 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; end; end; procedure TAstViewNode.SetIsFocused(const Value: Boolean); begin if FIsFocused <> Value then begin FIsFocused := Value; Repaint; 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 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; end else begin effBorderColor := FBorderColor; effBorderWidth := FBorderWidth; effDash := TStrokeDash.Solid; end; // 2. Hover Overlay if isHovering then begin 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; 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; end; Canvas.Fill.Kind := TBrushKind.Solid; Canvas.Fill.Color := FBackgroundColor; if FFrameless and (FErrorMessage = '') and (not isHovering) and (not FIsFocused) then begin Canvas.FillRect(TRectF.Create(0, 0, Width, Height), 0, 0, [], 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); end; end else begin 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); 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; 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); 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.