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

Refactoring + Panning in Workspace

Browse Source
This commit is contained in:
Michael Schimmel
2025-09-05 21:00:07 +02:00
parent f2357a543e
commit 6b77391e91
6 changed files with 253 additions and 145 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ASTPlayground/Myc.Ast.Visualizer.pas
+135 -17
View File
@@ -7,6 +7,7 @@ uses
System.Classes,
System.UITypes,
System.Types,
System.Math.Vectors,
System.Generics.Collections,
FMX.Types,
FMX.Controls,
@@ -114,11 +115,26 @@ type
TAuraWorkspace = class(TStyledControl)
private
FConnections: TArray<TPinConnection>;
// If the mouse is dragging the background (i.e., no child control is being dragged),
// then FPanning should be dragged.
FPanning: TSizeF;
// Added for panning implementation.
FIsPanning: Boolean;
FLastPanPos: TPointF;
// Added for zooming implementation.
FZoom: Single;
protected
procedure Paint; override;
procedure DoDeleteChildren; override;
// Add a zoom factor that, along with FPanning, zooms the children via the mouse wheel.
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;
public
constructor Create(AOwner: TComponent); override;
procedure BuildTree(const Root: IAstNode; const Position: TPointF; AMode: TVisualizationMode);
function GetChildrenMatrix(var Matrix: TMatrix; var Simple: Boolean): Boolean; override;
published
// Standard control properties
@@ -267,6 +283,7 @@ implementation
uses
System.Math,
System.StrUtils,
FMX.Platform,
Myc.Data.Scalar;
type
@@ -303,34 +320,34 @@ begin
lookbackStr := '';
if Assigned(Node.Lookback) then
lookbackStr := ', ' + Node.Lookback.Accept(Self).AsText;
Result := TAstValue.FromText(Format('%s.add(%s%s)', [seriesStr, valueStr, lookbackStr]));
Result := Format('%s.add(%s%s)', [seriesStr, valueStr, lookbackStr]);
end;
function TAstToTextVisitor.VisitAssignment(const Node: IAssignmentNode): TAstValue;
begin
Result := TAstValue.FromText(Node.Identifier.Name + ' := ' + Node.Value.Accept(Self).AsText);
Result := Node.Identifier.Name + ' := ' + Node.Value.Accept(Self).AsText;
end;
function TAstToTextVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue;
begin
var leftStr := Node.Left.Accept(Self).AsText;
var rightStr := Node.Right.Accept(Self).AsText;
Result := TAstValue.FromText('(' + leftStr + ' ' + Node.Operator.ToString + ' ' + rightStr + ')');
Result := '(' + leftStr + ' ' + Node.Operator.ToString + ' ' + rightStr + ')';
end;
function TAstToTextVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue;
begin
Result := TAstValue.FromText('{...}');
Result := '{...}';
end;
function TAstToTextVisitor.VisitConstant(const Node: IConstantNode): TAstValue;
begin
Result := TAstValue.FromText(Node.Value.ToString);
Result := Node.Value.ToString;
end;
function TAstToTextVisitor.VisitCreateSeries(const Node: ICreateSeriesNode): TAstValue;
begin
Result := TAstValue.FromText('new series(' + Node.Definition + ')');
Result := 'new series(' + Node.Definition + ')';
end;
function TAstToTextVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TAstValue;
@@ -352,7 +369,7 @@ begin
sb.Append(', ');
end;
sb.Append(')');
Result := TAstValue.FromText(sb.ToString);
Result := sb.ToString;
finally
sb.Free;
end;
@@ -360,12 +377,12 @@ end;
function TAstToTextVisitor.VisitIdentifier(const Node: IIdentifierNode): TAstValue;
begin
Result := TAstValue.FromText(Node.Name);
Result := Node.Name;
end;
function TAstToTextVisitor.VisitIfExpression(const Node: IIfExpressionNode): TAstValue;
begin
Result := TAstValue.FromText(Node.Condition.Accept(Self).AsText);
Result := Node.Condition.Accept(Self).AsText;
end;
function TAstToTextVisitor.VisitIndexer(const Node: IIndexerNode): TAstValue;
@@ -374,7 +391,7 @@ var
begin
baseStr := Node.Base.Accept(Self).AsText;
indexStr := Node.Index.Accept(Self).AsText;
Result := TAstValue.FromText(Format('%s[%s]', [baseStr, indexStr]));
Result := Format('%s[%s]', [baseStr, indexStr]);
end;
function TAstToTextVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue;
@@ -396,7 +413,7 @@ begin
end;
end;
sb.Append(') => {...}');
Result := TAstValue.FromText(sb.ToString);
Result := sb.ToString;
finally
sb.Free;
end;
@@ -407,7 +424,7 @@ var
baseStr: string;
begin
baseStr := Node.Base.Accept(Self).AsText;
Result := TAstValue.FromText(Format('%s.%s', [baseStr, Node.Member.Name]));
Result := Format('%s.%s', [baseStr, Node.Member.Name]);
end;
function TAstToTextVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): TAstValue;
@@ -416,7 +433,7 @@ var
begin
// Get the string representation of the series identifier by visiting the node.
seriesStr := Node.Series.Accept(Self).AsText;
Result := TAstValue.FromText(Format('length(%s)', [seriesStr]));
Result := Format('length(%s)', [seriesStr]);
end;
function TAstToTextVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TAstValue;
@@ -424,12 +441,12 @@ begin
var condStr := Node.Condition.Accept(Self).AsText;
var thenStr := Node.ThenBranch.Accept(Self).AsText;
var elseStr := Node.ElseBranch.Accept(Self).AsText;
Result := TAstValue.FromText(Format('(%s ? %s : %s)', [condStr, thenStr, elseStr]));
Result := Format('(%s ? %s : %s)', [condStr, thenStr, elseStr]);
end;
function TAstToTextVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): TAstValue;
begin
Result := TAstValue.FromText(Node.Operator.ToString + ' ' + Node.Right.Accept(Self).AsText);
Result := Node.Operator.ToString + ' ' + Node.Right.Accept(Self).AsText;
end;
function TAstToTextVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue;
@@ -440,7 +457,7 @@ begin
initStr := ' := ' + Node.Initializer.Accept(Self).AsText
else
initStr := '';
Result := TAstValue.FromText('var ' + Node.Identifier.Name + initStr);
Result := 'var ' + Node.Identifier.Name + initStr;
end;
{ TPinConnection }
@@ -479,7 +496,7 @@ begin
Height := 45;
// The panel must be able to receive mouse events.
HitTest := True;
// HitTest := True;
// Clip children to the panel's bounds.
ClipChildren := True;
end;
@@ -619,6 +636,7 @@ begin
begin
FIsDragging := True;
FDownPos := TPointF.Create(X, Y);
Capture;
end;
end;
end;
@@ -626,6 +644,7 @@ end;
procedure TAuraNode.MouseMove(Shift: TShiftState; X, Y: Single);
begin
inherited;
if FIsDragging then
begin
var deltaX := X - FDownPos.X;
@@ -644,12 +663,20 @@ begin
inherited;
if (Button = TMouseButton.mbLeft) and (FIsDragging) then
begin
ReleaseCapture;
FIsDragging := False;
end;
end;
{ TAuraWorkspace }
constructor TAuraWorkspace.Create(AOwner: TComponent);
begin
inherited;
// Initialize zoom factor.
FZoom := 1.0;
end;
procedure TAuraWorkspace.BuildTree(const Root: IAstNode; const Position: TPointF; AMode: TVisualizationMode);
begin
var connections := TList<TPinConnection>.Create;
@@ -667,6 +694,97 @@ begin
inherited;
end;
function TAuraWorkspace.GetChildrenMatrix(var Matrix: TMatrix; var Simple: Boolean): Boolean;
begin
// Combine scaling (zoom) and translation (pan) into a single matrix.
// The order is important: scale first, then translate.
Matrix := TMatrix.CreateScaling(FZoom, FZoom) * TMatrix.CreateTranslation(FPanning.cx, FPanning.cy);
Simple := (FZoom = 1.0) and (FPanning.cx = 0) and (FPanning.cy = 0);
Result := true;
end;
procedure TAuraWorkspace.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
inherited;
// Start panning if left button is pressed on the background
if (Button = TMouseButton.mbLeft) and (ObjectAtPoint(LocalToScreen(TPointF.Create(X, Y))) = Self as IControl) then
begin
FIsPanning := True;
FLastPanPos := TPointF.Create(X, Y);
Cursor := crHandPoint;
end;
end;
procedure TAuraWorkspace.MouseMove(Shift: TShiftState; X, Y: Single);
var
delta: TPointF;
begin
inherited;
if FIsPanning then
begin
// Calculate movement delta
delta := TPointF.Create(X - FLastPanPos.X, Y - FLastPanPos.Y);
// Update panning offset
FPanning.cx := FPanning.cx + delta.X;
FPanning.cy := FPanning.cy + delta.Y;
// Store current position for next move
FLastPanPos := TPointF.Create(X, Y);
// Trigger repaint to apply the new transformation matrix
RecalcAbsolute;
RecalcUpdateRect;
Repaint;
end;
end;
procedure TAuraWorkspace.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
inherited;
// Stop panning
if (Button = TMouseButton.mbLeft) and (FIsPanning) then
begin
FIsPanning := False;
Cursor := crDefault;
end;
end;
procedure TAuraWorkspace.MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
var
oldZoom: Single;
MouseService: IFMXMouseService;
begin
inherited;
if TPlatformServices.Current.SupportsPlatformService(IFMXMouseService, MouseService) then
begin
var MousePos := ScreenToLocal(MouseService.GetMousePos);
oldZoom := FZoom;
// Calculate new zoom
if WheelDelta > 0 then
FZoom := FZoom * 1.1
else
FZoom := FZoom / 1.1;
// Clamp zoom level to a reasonable range
FZoom := Max(0.2, Min(3.0, FZoom));
// Adjust panning to keep the point under the cursor stationary
FPanning.cx := MousePos.X * (1 - FZoom / oldZoom) + FPanning.cx * (FZoom / oldZoom);
FPanning.cy := MousePos.Y * (1 - FZoom / oldZoom) + FPanning.cy * (FZoom / oldZoom);
// Trigger repaint to apply the new transformation matrix
RecalcAbsolute;
RecalcUpdateRect;
Repaint;
Handled := True;
end;
end;
procedure TAuraWorkspace.Paint;
var
connection: TPinConnection;