From 69eebe4c0c013f2825cceefede5bf778c4561024 Mon Sep 17 00:00:00 2001 From: florian Date: Thu, 29 Dec 2022 15:19:59 +0100 Subject: [PATCH] + patch by Rika to implement missing TPointF methods, resolves #40057 + test by Rika --- rtl/objpas/types.pp | 51 +++++++- tests/test/units/types/ttpointf1.pp | 195 ++++++++++++++++++++++++++++ 2 files changed, 245 insertions(+), 1 deletion(-) create mode 100644 tests/test/units/types/ttpointf1.pp diff --git a/rtl/objpas/types.pp b/rtl/objpas/types.pp index da55652d6c..1c87f992d7 100644 --- a/rtl/objpas/types.pp +++ b/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; @@ -729,10 +738,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); diff --git a/tests/test/units/types/ttpointf1.pp b/tests/test/units/types/ttpointf1.pp new file mode 100644 index 0000000000..e4c0cfde1d --- /dev/null +++ b/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. +