+ patch by Rika to implement missing TPointF methods, resolves #40057

  + test by Rika

(cherry picked from commit 69eebe4c0c013f2825cceefede5bf778c4561024)

rtl/objpas/types.pp

@@ -132,6 +132,15 @@ type
           function  Floor   : TPoint;
           function  Round   : TPoint;
           function  Length  : Single;
+
+          function Rotate(angle: single): TPointF;
+          function Reflect(const normal: TPointF): TPointF;
+          function MidPoint(const b: TPointF): TPointF;
+          class function PointInCircle(const pt, center: TPointF; radius: single): Boolean; static;
+          class function PointInCircle(const pt, center: TPointF; radius: integer): Boolean; static;
+          function Angle(const b: TPointF): Single;
+          function AngleCosine(const b: TPointF): single;
+
           class function Create(const ax, ay: Single): TPointF; overload; static; inline;
           class function Create(const apt: TPoint): TPointF; overload; static; inline;
           class operator = (const apt1, apt2 : TPointF) : Boolean;
@@ -711,10 +720,50 @@ begin
 end;
 
 function TPointF.Length: Single;
-begin     //distance(self) ?
+begin
   result:=sqrt(sqr(x)+sqr(y));
 end;
 
+function TPointF.Rotate(angle: single): TPointF;
+var
+  sina, cosa: single;
+begin
+  sincos(angle, sina, cosa);
+  result.x := x * cosa - y * sina;
+  result.y := x * sina + y * cosa;
+end;
+
+function TPointF.Reflect(const normal: TPointF): TPointF;
+begin
+  result := self + (-2 * normal ** self) * normal;
+end;
+
+function TPointF.MidPoint(const b: TPointF): TPointF;
+begin
+  result.x := 0.5 * (x + b.x);
+  result.y := 0.5 * (y + b.y);
+end;
+
+class function TPointF.PointInCircle(const pt, center: TPointF; radius: single): Boolean;
+begin
+  result := sqr(center.x - pt.x) + sqr(center.y - pt.y) < sqr(radius);
+end;
+
+class function TPointF.PointInCircle(const pt, center: TPointF; radius: integer): Boolean;
+begin
+  result := sqr(center.x - pt.x) + sqr(center.y - pt.y) < sqr(single(radius));
+end;
+
+function TPointF.Angle(const b: TPointF): Single;
+begin
+  result := ArcTan2(y - b.y, x - b.x);
+end;
+
+function TPointF.AngleCosine(const b: TPointF): single;
+begin
+  result := EnsureRange((self ** b) / sqrt((sqr(x) + sqr(y)) * (sqr(b.x) + sqr(b.y))), -1, 1);
+end;
+
 class operator TPointF.= (const apt1, apt2 : TPointF) : Boolean;
 begin
   result:=SameValue(apt1.x,apt2.x) and SameValue(apt1.y,apt2.y);

tests/test/units/types/ttpointf1.pp

@@ -0,0 +1,195 @@
+{$mode objfpc} {$longstrings on}
+uses
+	Types, Math;
+
+var
+	anythingFailed: boolean = false;
+
+	procedure Fail(const msg: string);
+	begin
+		writeln(msg);
+		anythingFailed := true;
+	end;
+
+	function ToString(const pt: TPointF): string;
+	begin
+		WriteStr(result, '(', pt.x, ', ', pt.y, ')');
+	end;
+
+	function SamePoint(const a, b: TPointF; eps: single = 0): boolean;
+	begin
+		result := SameValue(a.x, b.x, eps) and SameValue(a.y, b.y, eps);
+	end;
+
+	procedure TestTPointF_Angle_AngleCosine;
+	type
+		TestRec = record
+			a, b: TPointF;
+			anBaOx, cosAnAB: single;
+		end;
+	const
+		Tests: array[0 .. 1] of TestRec =
+		(
+			(a: (x: 1; y: -2); b: (x: 3; y: 4); anBaOx: -1.892546892; cosAnAB: -1 / sqrt(5)),
+			(a: (x: 1; y: 2); b: (x: 3; y: 4); anBaOx: -3 * pi / 4; cosAnAB: 11 / (5 * sqrt(5)))
+		);
+	var
+		t: TestRec;
+		gotAnBaOx, gotCosAnAB: single;
+		msg: string;
+	begin
+		for t in Tests do
+		begin
+			gotAnBaOx := t.a.Angle(t.b);
+			if not SameValue(gotAnBaOx, t.anBaOx) then
+			begin
+				WriteStr(msg, 'TPointF', ToString(t.a), '.Angle', ', ', ToString(t.b), ' = ', gotAnBaOx, ', expected ', t.anBaOx, '.');
+				Fail(msg);
+			end;
+
+			gotCosAnAB := t.a.AngleCosine(t.b);
+			if not SameValue(gotCosAnAB, t.cosAnAB) then
+			begin
+				WriteStr(msg, 'TPointF', ToString(t.a), '.AngleCosine', ToString(t.b), ' = ', gotCosAnAB, ', expected ', t.cosAnAB, '.');
+				Fail(msg);
+			end;
+		end;
+	end;
+
+	procedure TestTPointF_MidPoint;
+	type
+		TestRec = record
+			a, b, mid: TPointF;
+		end;
+	const
+		Tests: array[0 .. 0] of TestRec =
+		(
+			(a: (x: 1; y: 2); b: (x: 3; y: 4); mid: (x: 2; y: 3))
+		);
+	var
+		t: TestRec;
+		gotMid: TPointF;
+		msg: string;
+	begin
+		for t in Tests do
+		begin
+			gotMid := t.a.MidPoint(t.b);
+			if not SamePoint(gotMid, t.mid) then
+			begin
+				WriteStr(msg, 'TPointF', ToString(t.a), '.MidPoint', ToString(t.b), ' = ', ToString(gotMid), ', expected ', ToString(t.mid), '.');
+				Fail(msg);
+			end;
+		end;
+	end;
+
+	procedure TestTPointF_PointInCircle;
+	type
+		TestRec = record
+			center: TPointF;
+			radius: float;
+			point: TPointF;
+			PiC: boolean;
+		end;
+	const
+		Tests: array[0 .. 16] of TestRec =
+		(
+			(center: (x: 10; y: 20); radius: 0;    point: (x: 10; y: 20); PiC: false),
+			(center: (x: 10; y: 20); radius: 2;    point: (x: 12; y: 20); PiC: false),
+			(center: (x: 10; y: 20); radius: 2;    point: (x:  8; y: 20); PiC: false),
+			(center: (x: 10; y: 20); radius: 2;    point: (x: 10; y: 22); PiC: false),
+			(center: (x: 10; y: 20); radius: 2;    point: (x: 10; y: 18); PiC: false),
+			(center: (x: 10; y: 20); radius: 2;    point: (x: 10 + sqrt(2.01); y: 20 + sqrt(2.01)); PiC: false),
+			(center: (x: 10; y: 20); radius: 2;    point: (x: 10 - sqrt(2.01); y: 20 + sqrt(2.01)); PiC: false),
+			(center: (x: 10; y: 20); radius: 2;    point: (x: 10 - sqrt(2.01); y: 20 - sqrt(2.01)); PiC: false),
+			(center: (x: 10; y: 20); radius: 2;    point: (x: 10 + sqrt(2.01); y: 20 - sqrt(2.01)); PiC: false),
+			(center: (x: 10; y: 20); radius: 2.02; point: (x: 12; y: 20); PiC: true),
+			(center: (x: 10; y: 20); radius: 2.02; point: (x:  8; y: 20); PiC: true),
+			(center: (x: 10; y: 20); radius: 2.02; point: (x: 10; y: 22); PiC: true),
+			(center: (x: 10; y: 20); radius: 2.02; point: (x: 10; y: 18); PiC: true),
+			(center: (x: 10; y: 20); radius: 2.02; point: (x: 10 + sqrt(2.01); y: 20 + sqrt(2.01)); PiC: true),
+			(center: (x: 10; y: 20); radius: 2.02; point: (x: 10 - sqrt(2.01); y: 20 + sqrt(2.01)); PiC: true),
+			(center: (x: 10; y: 20); radius: 2.02; point: (x: 10 - sqrt(2.01); y: 20 - sqrt(2.01)); PiC: true),
+			(center: (x: 10; y: 20); radius: 2.02; point: (x: 10 + sqrt(2.01); y: 20 - sqrt(2.01)); PiC: true)
+		);
+	var
+		t: TestRec;
+		gotPiC: boolean;
+		msg: string;
+	begin
+		for t in Tests do
+		begin
+			gotPiC := TPointF.PointInCircle(t.point, t.center, t.radius);
+			if gotPiC <> t.PiC then
+			begin
+				WriteStr(msg, 'TPointF.PointInCircle(', ToString(t.point), ', ', ToString(t.center), ', ', t.radius, ') = ', pChar('-+')[ord(gotPiC)], ', expected ', pChar('-+')[ord(t.PiC)], '.');
+				Fail(msg);
+			end;
+		end;
+	end;
+
+	procedure TestTPointF_Rotate;
+	type
+		TestRec = record
+			point: TPointF;
+			angle: float;
+			rotated: TPointF;
+		end;
+	const
+		Tests: array[0 .. 1] of TestRec =
+		(
+			(point: (x: 1; y: 2); angle: 2 * pi + 1; rotated: (x: -1.142639637; y: 1.92207551)),
+			(point: (x: 1; y: 2); angle: 2 * pi - 1; rotated: (x: 2.22324419; y: 0.2391340137))
+		);
+	var
+		t: TestRec;
+		got: TPointF;
+		msg: string;
+	begin
+		for t in Tests do
+		begin
+			got := t.point.Rotate(t.angle);
+			if not SamePoint(got, t.rotated) then
+			begin
+				WriteStr(msg, 'TPointF', ToString(t.point), '.Rotate(', t.angle, ') = ', ToString(got), ', expected ', ToString(t.rotated), '.');
+				Fail(msg);
+			end;
+		end;
+	end;
+
+	procedure TestTPointF_Reflect;
+	type
+		TestRec = record
+			point, normal, reflected: TPointF;
+		end;
+	const
+		Tests: array[0 .. 1] of TestRec =
+		(
+			(point: (x: 1; y: 2); normal: (x: sqrt(2) / 2; y: sqrt(2) / 2); reflected: (x: -2; y: -1)),
+			(point: (x: 1; y: 2); normal: (x: -sqrt(2) / 2; y: sqrt(2) / 2); reflected: (x: 2; y: 1))
+		);
+	var
+		t: TestRec;
+		got: TPointF;
+		msg: string;
+	begin
+		for t in Tests do
+		begin
+			got := t.point.Reflect(t.normal);
+			if not SamePoint(got, t.reflected) then
+			begin
+				WriteStr(msg, 'TPointF', ToString(t.point), '.Reflect', ToString(t.normal), ' = ', ToString(got), ', expected ', ToString(t.reflected), '.');
+				Fail(msg);
+			end;
+		end;
+	end;
+
+begin
+	TestTPointF_Angle_AngleCosine;
+	TestTPointF_MidPoint;
+	TestTPointF_PointInCircle;
+	TestTPointF_Rotate;
+	TestTPointF_Reflect;
+	if not anythingFailed then writeln('ok');
+	if anythingFailed then halt(1);
+end.
+