paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

LazMapViewer: Fix logical area operations to be compatible with reversed longitudes when the dateline is crossed. Add unit tests for it.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8806 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2023-04-25 17:15:41 +00:00
parent f704502528
commit 26a3a6a484
6 changed files with 715 additions and 59 deletions

55
components/lazmapviewer/source/mvgpsobj.pas
View File

@ -188,62 +188,34 @@ uses
function hasIntersectArea(const Area1: TRealArea; const Area2: TRealArea): boolean;
begin
Result := (Area1.TopLeft.Lon <= Area2.BottomRight.Lon) and
(Area1.BottomRight.Lon >= Area2.TopLeft.Lon) and
(Area1.TopLeft.Lat >= Area2.BottomRight.Lat) and
(Area1.BottomRight.Lat <= Area2.TopLeft.Lat);
Result := Area1.Intersects(Area2);
end;
function IntersectArea(const Area1: TRealArea; const Area2: TRealArea): TRealArea;
begin
Result := Area1;
if Result.TopLeft.Lon<Area2.topLeft.Lon then
Result.TopLeft.Lon:=Area2.topLeft.Lon;
if Result.TopLeft.Lat>Area2.topLeft.Lat then
Result.TopLeft.Lat:=Area2.topLeft.Lat;
if Result.BottomRight.Lon>Area2.BottomRight.Lon then
Result.BottomRight.Lon:=Area2.BottomRight.Lon;
if Result.BottomRight.Lat<Area2.BottomRight.Lat then
Result.BottomRight.Lat:=Area2.BottomRight.Lat;
Result := Area1.Intersection(Area2);
end;
function PtInsideArea(const aPoint: TRealPoint; const Area: TRealArea): boolean;
begin
Result := (Area.TopLeft.Lon <= aPoint.Lon) and
(Area.BottomRight.Lon >= aPoint.Lon) and
(Area.TopLeft.Lat >= aPoint.Lat) and
(Area.BottomRight.Lat <= aPoint.Lat);
Result := Area.ContainsPoint(aPoint);
end;
function AreaInsideArea(const AreaIn: TRealArea; const AreaOut: TRealArea): boolean;
begin
Result := (AreaIn.TopLeft.Lon >= AreaOut.TopLeft.Lon) and
(AreaIn.BottomRight.Lon <= AreaOut.BottomRight.Lon) and
(AreaOut.TopLeft.Lat >= AreaIn.TopLeft.Lat) and
(AreaOut.BottomRight.Lat <= AreaIn.BottomRight.Lat);
Result := AreaIn.Equal(AreaIn.Intersection(AreaOut));
end;
procedure ExtendArea(var AreaToExtend: TRealArea; const Area: TRealArea);
begin
if AreaToExtend.TopLeft.Lon>Area.TopLeft.Lon then
AreaToExtend.TopLeft.Lon:=Area.TopLeft.Lon;
if AreaToExtend.BottomRight.Lon<Area.BottomRight.Lon then
AreaToExtend.BottomRight.Lon:=Area.BottomRight.Lon;
if AreaToExtend.TopLeft.Lat<Area.TopLeft.Lat then
AreaToExtend.TopLeft.Lat:=Area.TopLeft.Lat;
if AreaToExtend.BottomRight.Lat>Area.BottomRight.Lat then
AreaToExtend.BottomRight.Lat:=Area.BottomRight.Lat;
AreaToExtend := AreaToExtend.Union(Area);
end;
function GetAreaOf(objs: TGPSObjList): TRealArea;
var
i: integer;
begin
Result.TopLeft.Lon := 0;
Result.TopLeft.Lat := 0;
Result.BottomRight.Lon := 0;
Result.BottomRight.Lat := 0;
Result.Init(0, 0, 0, 0);
if Objs.Count>0 then
begin
Result := Objs[0].BoundingBox;
@ -419,10 +391,7 @@ var
i: integer;
ptArea: TRealArea;
begin
Area.BottomRight.lon := 0;
Area.BottomRight.lat := 0;
Area.TopLeft.lon := 0;
Area.TopLeft.lat := 0;
Area.Init(0, 0, 0, 0);
Lock;
try
if Count > 0 then
@ -567,10 +536,7 @@ var
Objs: TGPSObjarray;
i: integer;
begin
Result.BottomRight.Lat := 0;
Result.BottomRight.Lon := 0;
Result.TopLeft.Lat := 0;
Result.TopLeft.Lon := 0;
Result.Init(0, 0, 0, 0);
Lock;
try
IdsToObj(Ids, Objs, AIdOwner);
@ -708,10 +674,7 @@ var
i: integer;
ptArea: TRealArea;
begin
Area.BottomRight.lon := 0;
Area.BottomRight.lat := 0;
Area.TopLeft.lon := 0;
Area.TopLeft.lat := 0;
Area.Init(0, 0, 0, 0);
if FPoints.Count > 0 then
begin
Area := FPoints[0].BoundingBox;

253
components/lazmapviewer/source/mvtypes.pas
View File

@ -39,21 +39,207 @@ Type
function GetLatRad: Extended;
procedure SetLatRad(AValue: Extended);
public
procedure Init(ALon, ALat: Double);
property LonRad: Extended read GetLonRad write SetLonRad;
property LatRad: Extended read GetLatRad write SetLatRad;
end;
{ TRealArea }
TRealArea = Record
public
TopLeft : TRealPoint;
BottomRight : TRealPoint;
public
procedure Init(ALeft, ATop, ARight, ABottom: Extended);
procedure Init(ATopLeft, ABottomRight: TRealPoint);
function ContainsPoint(APoint: TRealPoint): boolean;
function Equal(Area: TRealArea): Boolean;
function Intersection(const Area: TRealArea): TRealArea;
function Intersects(const Area: TRealArea): boolean;
function Union(const Area: TRealArea): TRealArea;
end;
implementation
{ Helper functions to simplify using the cyclic coordinates }
{ Checks whether x is between x1 and x2 (where x1 < x2) }
function LinearInRange(x, x1, x2: Extended): Boolean;
begin
Result := InRange(x, x1, x2);
end;
{ Checks whether x is between x1 and x2 where x1 and x2 can be in any order.
When x1 > x2 it is assumed that the interval crosses the dateline. }
function CyclicInRange(x, x1, x2: Extended): Boolean;
begin
if x1 <= x2 then
Result := inRange(x, x1, x2)
else
Result := (x > x1) or (x < x2);
end;
{ Checks whether the line segment between A1 and A2 intersects the line segment
between B1 and B2. It is assumed that A1 < A2 and B1 < B2. }
function LinearIntersects(A1, A2, B1, B2: Extended): Boolean;
begin
Result := InRange(A1, B1, B2) or InRange(A2, B1, B2) or
InRange(B1, A1, A2) or InRange(B2, A1, A2);
end;
{ Checks whether the line segment between A1 and A2 intersects the line segment
between B1 and B2. A1 and A2, as well as B1 and B2 can be in any order.
When the coordinate with index 2 is greater than the coordinate with index 1
it is assumed that the segment crosses the dateline. }
function CyclicIntersects(L1, R1, L2, R2: Extended): Boolean;
begin
if (L1 <= R1) and (L2 <= R2) then
Result := LinearIntersects(L1, R1, L2, R2)
else
if (L1 <= R1) and (L2 > R2) then
Result := (L2 <= R1) or (R2 >= L1)
else
if (L1 > R1) and (L2 <= R2) then
Result := (R1 >= L2) or (L1 <= R2)
else
Result := true;
end;
{ Calculates in Res1 and Res2 the endpoints of the overlap of the segments
between A1 and A2 and between B1 and B2. A1 and A2, and B1 and B2 must be
in ascending order.
The function returns false if the segments do not overlap. }
function LinearIntersection(A1, A2, B1, B2: Extended; out Res1, Res2: Extended): Boolean;
begin
Result := false;
if (A2 < B1) or (B2 < A1) then
exit;
Res1 := A1;
Res2 := A2;
if B1 > Res1 then Res1 := B1;
if B2 < Res2 then Res2 := B2;
Result := true;
end;
{ Calculates in L and R the endpoints of the overlap of the segments
between L1 and R1 and between L2 and R2. L1 and R1, and L2 and R2 can be in
any order. If L1 > R1 it is assumed that this segment crosses the dateline.
Likewise with L2/R2.
The function returns false if the segments do not overlap. }
function CyclicIntersection(L1, R1, L2, R2: Extended; out L, R: Extended): Boolean;
begin
Result := false;
if (L1 <= R1) and (L2 <= R2) then
Result := LinearIntersection(L1, R1, L2, R2, L, R)
else
if (L1 <= R1) and (L2 > R2) then
begin
if (L2 > R1) and (L1 > R2) then
exit;
Result := true;
L := L1;
R := R1;
if (L2 <= L1) or (R2 >= R1) then exit;
if L2 < R1 then R := L2;
if R2 > L1 then L := R2;
end else
if (L1 > R1) and (L2 <= R2) then
begin
if (L1 > R2) and (R1 < L2) then exit;
L := L2;
R := R2;
Result := true;
if (L1 <= L2) or (R1 >= R2) then exit;
if L1 < R2 then R := L1;
if R1 > L2 then L := R1;
end else
begin
Result := true;
L := L1;
R := R1;
if L2 > L1 then L := L2;
if R2 < R1 then R := R2;
end;
end;
{ Calculates the union of the sements between A1/A2 and between B1/B2 and
returns the endpoints of the union in Res1 and Res2. It is assumed then
A1/A2 and B1/B2 are in ascending order. }
procedure LinearUnion(A1, A2, B1, B2: Extended; out Res1, Res2: Extended);
begin
Res1 := A1;
Res2 := A2;
if B1 < Res1 then Res1 := B1;
if B2 > Res2 then Res2 := B2;
end;
{ Calculates the union of the sements between L1/R1 and between L2/R2 and
returns the endpoints of the union in L and R. L1/R1 and L2/R2 can be in any
order. When L1 > R1 then it is assumed that this segment crosses the dateline.
Likewise with L2/R2. }
procedure CyclicUnion(L1, R1, L2, R2: Extended; out L, R: Extended);
procedure SetLimits(aL, aR: Extended);
begin
L := aL;
R := aR;
end;
begin
// Both between -180 and 180 deg
if (L1 <= R1) and (L2 <= R2) then
LinearUnion(L1, R1, L2, R2, L, R)
else
// 2nd crossing dateline //-180 180
if (L1 <= R1) and (L2 > R2) then // | L1-----R1 |
begin
if L2 <= L1 then // |-R2 L2--------------------|
SetLimits(L2, R2)
else
if L2 <= R1 then
begin
if R2 < L1 then // |-R2 L2--------------|
SetLimits(L1, R2)
else // |----------R2 L2------------| // Complete overlap
SetLimits(-180.0, 180.0);
end else
begin // L2 > R1
if R2 < L1 then // |-R2 L2--| // No overlap here. Since we want to "extend", we keep L1R1
SetLimits(L1, R1)
else // |----------R2 L2--|
if R2 < R1 then
SetLimits(L2, R1)
else // R2 > R // |-------------------R2 L2--|
SetLimits(L2, R2);
end;
end else
// 1st crossing dateline
if (L1 > R1) and (L2 <= R2) then
begin
CyclicUnion(L2, R2, L1, R1, L, R);
end else
// both crossing dateline
begin
if L2 < R1 then // complete overlap
SetLimits(-180, 180)
else
begin
SetLimits(L1, R1);
if L2 < L then L := L2;
if R2 > R then R := R2;
end;
end;
end;
{ TRealPoint }
procedure TRealPoint.Init(ALon, ALat: Double);
begin
Lon := ALon;
Lat := ALat;
end;
function TRealPoint.GetLonRad: Extended;
begin
Result := DegToRad(Self.Lon);
@ -74,5 +260,72 @@ begin
Self.Lat := RadToDeg(AValue);
end;
{ TRealArea
It is assumed (and not checked) that ATop and ABottom are between -90 and 90
and ALeft and ARight between -180 and 180. When ALeft and ARight are in
reverse order it is assumed that the dateline is crossed.
}
procedure TRealArea.Init(ALeft, ATop, ARight, ABottom: Extended);
begin
TopLeft.Lon := ALeft;
TopLeft.Lat := ATop;
BottomRight.Lon := ARight;
BottomRight.Lat := ABottom;
end;
procedure TRealArea.Init(ATopLeft, ABottomRight: TRealPoint);
begin
TopLeft := ATopLeft;
BottomRight := ABottomRight;
end;
{ Checks whether the given point is inside the area (including borders). }
function TRealArea.ContainsPoint(APoint: TRealPoint): boolean;
begin
Result :=
LinearInRange(APoint.Lat, BottomRight.Lat, TopLeft.Lat) and
CyclicInRange(APoint.Lon, TopLeft.Lon, BottomRight.Lon);
end;
function TRealArea.Equal(Area: TRealArea): Boolean;
begin
Result :=
(TopLeft.Lon = Area.TopLeft.Lon) and
(TopLeft.Lat = Area.TopLeft.Lat) and
(BottomRight.Lon = Area.BottomRight.Lon) and
(BottomRight.Lat = Area.BottomRight.Lat);
end;
function TRealArea.Intersection(const Area: TRealArea): TRealArea;
var
B, T, L, R: Extended;
begin
LinearIntersection(BottomRight.Lat, TopLeft.Lat, Area.BottomRight.Lat, Area.TopLeft.Lat, B, T);
CyclicIntersection(TopLeft.Lon, BottomRight.Lon, Area.TopLeft.Lon, Area.BottomRight.Lon, L, R);
Result.Init(L, T, R, B);
end;
function TRealArea.Intersects(const Area: TRealArea): boolean;
var
A1, A2: TRealArea;
begin
Result :=
LinearIntersects(BottomRight.Lat, TopLeft.Lat, Area.BottomRight.Lat, Area.TopLeft.Lat) and
CyclicIntersects(TopLeft.Lon, BottomRight.Lon, Area.TopLeft.Lon, Area.BottomRight.Lon);
end;
{ Calculates the union with the other area. When the date line is crossed the
right longitude becomes smaller than the left longitude! }
function TRealArea.Union(const Area: TRealArea): TRealArea;
var
B, T, L, R: Extended;
begin
LinearUnion(BottomRight.Lat, TopLeft.Lat, Area.BottomRight.Lat, Area.TopLeft.Lat, B, T);
CyclicUnion(TopLeft.Lon, BottomRight.Lon, Area.TopLeft.Lon, Area.BottomRight.Lon, L, R);
Result.Init(L, T, R, B);
end;
end.

7
components/lazmapviewer/unittests/mapviewer_tests.lpi
View File

@ -37,9 +37,12 @@
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="mvmisctests_engine.pas"/>
<Filename Value="mvtests_types.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="mvtests_engine.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="mvMiscTests_Engine"/>
</Unit>
</Units>
</ProjectOptions>

3
components/lazmapviewer/unittests/mapviewer_tests.lpr
View File

@ -3,7 +3,8 @@ program mapviewer_tests;
{$mode objfpc}{$H+}
uses
Interfaces, Forms, GuiTestRunner, mvMiscTests_Engine;
Interfaces, Forms, GuiTestRunner,
mvtests_engine, mvtests_types;
{$R *.res}

20
components/lazmapviewer/unittests/mvmisctests_engine.pas → components/lazmapviewer/unittests/mvtests_engine.pas
View File

@ -1,4 +1,4 @@
unit mvMiscTests_Engine;
unit mvtests_engine;
{$mode objfpc}{$H+}
@ -8,7 +8,7 @@ uses
Classes, SysUtils, fpcunit, testutils, testregistry;
type
TMiscTests_Engine= class(TTestCase)
TMvTests_Engine= class(TTestCase)
published
procedure Test_Distance;
procedure Test_LatToStr_DMS;
@ -94,7 +94,7 @@ const
var
PointFormatsettings: TFormatSettings;
procedure TMiscTests_Engine.Test_Distance;
procedure TMvTests_Engine.Test_Distance;
const
TOLERANCE = 2;
RADIUS = 6378; // Earth radius in km, as used by the references
@ -110,7 +110,7 @@ begin
);
end;
procedure TMiscTests_Engine.Test_LatToStr_Deg;
procedure TMvTests_Engine.Test_LatToStr_Deg;
const
NO_DMS = false;
var
@ -125,7 +125,7 @@ begin
);
end;
procedure TMiscTests_Engine.Test_LatToStr_DMS;
procedure TMvTests_Engine.Test_LatToStr_DMS;
const
NEED_DMS = true;
var
@ -140,7 +140,7 @@ begin
);
end;
procedure TMiscTests_Engine.Test_LonToStr_Deg;
procedure TMvTests_Engine.Test_LonToStr_Deg;
const
NO_DMS = false;
var
@ -155,7 +155,7 @@ begin
);
end;
procedure TMiscTests_Engine.Test_LonToStr_DMS;
procedure TMvTests_Engine.Test_LonToStr_DMS;
const
NEED_DMS = true;
var
@ -170,7 +170,7 @@ begin
);
end;
procedure TMiscTests_Engine.Test_SplitGPS;
procedure TMvTests_Engine.Test_SplitGPS;
const
TOLERANCE = 1e-5;
var
@ -218,7 +218,7 @@ begin
end;
end;
procedure TMiscTests_Engine.Test_ZoomFactor;
procedure TMvTests_Engine.Test_ZoomFactor;
var
z: Integer;
f: Extended;
@ -236,6 +236,6 @@ initialization
PointFormatSettings.DecimalSeparator := '.';
DMS_Decimals := 4;
RegisterTest(TMiscTests_Engine);
RegisterTest(TMvTests_Engine);
end.

436
components/lazmapviewer/unittests/mvtests_types.pas Normal file
View File

@ -0,0 +1,436 @@
unit mvtests_types;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, fpcunit, testutils, testregistry;
type
TMvTestsArea= class(TTestCase)
published
procedure Test_PointInArea;
procedure Test_Intersection;
procedure Test_Union;
end;
implementation
uses
mvTypes;
function AreaToStr(Area: TRealArea): String;
begin
Result := Format('L=%.6f T=%.6f R=%.6f B=%.6f', [
Area.TopLeft.Lon, Area.TopLeft.Lat, Area.BottomRight.Lon, Area.BottomRight.Lat
]);
end;
procedure TMvTestsArea.Test_PointInArea;
var
counter: Integer;
a: TRealArea;
p: TRealPoint;
begin
// Regular area, point inside
counter := 1;
a.Init(0, 10, 10, 0);
p.Init(5, 5);
AssertEquals(
'Point in area test #' + IntToStr(counter) + ' mismatch',
true, // expected
a.ContainsPoint(p) // actual
);
// Regular area, point's longitude outside
inc(counter);
p.Init(15, 5);
AssertEquals(
'Point in area test #' + IntToStr(counter) + ' mismatch',
false, // expected
a.ContainsPoint(p) // actual
);
// Regular area, point's latitude outside
inc(counter);
p.Init(5, 15);
AssertEquals(
'Point in area test #' + IntToStr(counter) + ' mismatch',
false, // expected
a.ContainsPoint(p) // actual
);
// Area crossing dateline, point inside in the eastern part (left of dateline)
inc(counter);
a.Init(170, 40, -170, 30);
p.Init(175, 35);
AssertEquals(
'Point in area test #' + IntToStr(counter) + ' mismatch',
true, // expected
a.ContainsPoint(p) // actual
);
// Area crossing dateline, point inside in the western part (right of dateline)
inc(counter);
a.Init(170, 40, -170, 30);
p.Init(-175, 35);
AssertEquals(
'Point in area test #' + IntToStr(counter) + ' mismatch',
true, // expected
a.ContainsPoint(p) // actual
);
// Area crossing dateline, point at dateline (east)
inc(counter);
a.Init(170, 40, -170, 30);
p.Init(180, 35);
AssertEquals(
'Point in area test #' + IntToStr(counter) + ' mismatch',
true, // expected
a.ContainsPoint(p) // actual
);
// Area crossing dateline, point at dateline (west)
inc(counter);
a.Init(170, 40, -170, 30);
p.Init(-180, 35);
AssertEquals(
'Point in area test #' + IntToStr(counter) + ' mismatch',
true, // expected
a.ContainsPoint(p) // actual
);
// Area crossing dateline, point's longitude outside, eastern part
inc(counter);
a.Init(170, 40, -170, 30);
p.Init(160, 35);
AssertEquals(
'Point in area test #' + IntToStr(counter) + ' mismatch',
false, // expected
a.ContainsPoint(p) // actual
);
// Area crossing dateline, point's longitude outside, western part
inc(counter);
a.Init(170, 40, -170, 30);
p.Init(-160, 35);
AssertEquals(
'Point in area test #' + IntToStr(counter) + ' mismatch',
false, // expected
a.ContainsPoint(p) // actual
);
end;
procedure TMvTestsArea.Test_Union;
var
counter: Integer;
a, b, expected, actual: TRealArea;
begin
// Regular areas, separated
counter := 1; // #1
a.Init(0, 10, 10, 0);
b.Init(20, 40, 30, 20);
expected.Init(0, 40, 30, 0);
actual := a.Union(b);
AssertEquals(
'Area union test #' + IntToStr(counter) + ' mismatch',
AreaToStr(expected),
AreaToStr(actual)
);
// Regular areas, partly overlapping
inc(counter); // #2
a.Init(0, 10, 10, 0);
b.Init(5, 40, 30, 20);
expected.Init(0, 40, 30, 0);
actual := a.Union(b);
AssertEquals(
'Area union test #' + IntToStr(counter) + ' mismatch',
AreaToStr(expected),
AreaToStr(actual)
);
// Regular areas, partly overlapping
inc(counter); // #3
a.Init(5, 10, 10, 0); // | x---x |
b.Init(0, 40, 30, 20); // | x-------x |
expected.Init(0, 40, 30, 0);
actual := a.Union(b);
AssertEquals(
'Area union test #' + IntToStr(counter) + ' mismatch',
AreaToStr(expected),
AreaToStr(actual)
);
// Regular areas, partly overlapping
inc(counter); // #4
a.Init(10, 10, 40, 0); // | x----x |
b.Init(0, 40, 20, 20); // | x---x |
expected.Init(0, 40, 40, 0);
actual := a.Union(b);
AssertEquals(
'Area union test #' + IntToStr(counter) + ' mismatch',
AreaToStr(expected),
AreaToStr(actual)
);
// Regular areas, partly overlapping
inc(counter); // #5
a.Init(10, 10, 40, 0); // | x----x |
b.Init(30, 40, 60, 20); // | x-----x |
expected.Init(10, 40, 60, 0);
actual := a.Union(b);
AssertEquals(
'Area union test #' + IntToStr(counter) + ' mismatch',
AreaToStr(expected),
AreaToStr(actual)
);
// Second area crossing dateline
inc(counter); // #6
a.Init(-90, 10, 90, 0); // | x------x |
b.Init(-140, 40, -160, 20); // |--x x------------------|
expected.Init(-140, 40, -160, 0);
actual := a.Union(b);
AssertEquals(
'Area union test #' + IntToStr(counter) + ' mismatch',
AreaToStr(expected),
AreaToStr(actual)
);
// Second area crossing dateline
inc(counter); // #7
a.Init(-90, 10, 90, 0); // | x------x |
b.Init(0, 40, -160, 20); // |--x x-------------|
expected.Init(-90, 40, -160, 0);
actual := a.Union(b);
AssertEquals(
'Area union test #' + IntToStr(counter) + ' mismatch',
AreaToStr(expected),
AreaToStr(actual)
);
// Second area crossing dateline
inc(counter); // #8
a.Init(-90, 10, 90, 0); // | x------x |
b.Init(160, 40, -160, 20); // |--x x------|
expected.Init(-90, 40, 90, 0);
actual := a.Union(b);
AssertEquals(
'Area union test #' + IntToStr(counter) + ' mismatch',
AreaToStr(expected),
AreaToStr(actual)
);
// Second area crossing dateline
inc(counter); // #9
a.Init(-90, 10, 90, 0); // | x------x |
b.Init(30, 40, -30, 20); // |---------x x-----------|
expected.Init(-180, 40, 180, 0);
actual := a.Union(b);
AssertEquals(
'Area union test #' + IntToStr(counter) + ' mismatch',
AreaToStr(expected),
AreaToStr(actual)
);
// Second area crossing dateline
inc(counter); // #10
a.Init(-90, 10, 90, 0); // | x------x |
b.Init(150, 40, -30, 20); // |---------x x----|
expected.Init(150, 40, 90, 0);
actual := a.Union(b);
AssertEquals(
'Area union test #' + IntToStr(counter) + ' mismatch',
AreaToStr(expected),
AreaToStr(actual)
);
// Second area crossing dateline
inc(counter); // #11
a.Init(-90, 10, 90, 0); // | x------x |
b.Init(150, 40, 120, 20); // |-----------------x x---|
expected.Init(150, 40, 120, 0);
actual := a.Union(b);
AssertEquals(
'Area union test #' + IntToStr(counter) + ' mismatch',
AreaToStr(expected),
AreaToStr(actual)
);
// First area crossing dateline: like #6
inc(counter); // #12
a.Init(-140, 40, -160, 20); // |--x x------------------|
b.Init(-90, 10, 90, 0); // | x------x |
expected.Init(-140, 40, -160, 0);
actual := a.Union(b);
AssertEquals(
'Area union test #' + IntToStr(counter) + ' mismatch',
AreaToStr(expected),
AreaToStr(actual)
);
// Skipping other "1st area crossing" tests since arguments are just flipped
// Both areas crossing dateline
inc(counter); // #13
a.Init(170, 60, -150, 50); // |---x x----|
b.Init(160, 30, -160, 10); // |----x x-----|
expected.Init(160, 60, -150, 10);
actual := a.Union(b);
AssertEquals(
'Area union test #' + IntToStr(counter) + ' mismatch',
AreaToStr(expected),
AreaToStr(actual)
);
// Both areas crossing dateline
inc(counter); // #43
a.Init(170, 60, 0, 50); // |--------x x----|
b.Init(160, 30, -160, 10); // |----x x-----|
expected.Init(160, 60, 0, 10);
actual := a.Union(b);
AssertEquals(
'Area union test #' + IntToStr(counter) + ' mismatch',
AreaToStr(expected),
AreaToStr(actual)
);
end;
procedure TMvTestsArea.Test_Intersection;
var
counter: Integer;
a, b, expected, actual: TRealArea;
intersects: Boolean;
begin
// Regular areas, separated
counter := 1;
a.Init(0, 10, 10, 0);
b.Init(20, 40, 30, 20);
intersects := a.Intersects(b);
AssertEquals(
'Area intersection detection test #' + IntToStr(counter) + ' mismatch',
false,
intersects
);
// Regular areas, partly overlapping
inc(counter);
a.Init(0, 30, 20, 0);
b.Init(5, 40, 30, 20);
intersects := a.Intersects(b);
AssertEquals(
'Area intersection detection test #' + IntToStr(counter) + ' mismatch',
true,
intersects
);
expected.Init(5, 30, 20, 20);
actual := a.Intersection(b);
AssertEquals(
'Area intersection test #' + IntToStr(counter) + ' mismatch',
AreaToStr(expected),
AreaToStr(actual)
);
// Regular areas, partly overlapping, reverse order
inc(counter);
a.Init(5, 40, 30, 20);
b.Init(0, 30, 20, 0);
intersects := a.Intersects(b);
AssertEquals(
'Area intersection detection test #' + IntToStr(counter) + ' mismatch',
true,
intersects
);
expected.Init(5, 30, 20, 20);
actual := a.Intersection(b);
AssertEquals(
'Area intersection test #' + IntToStr(counter) + ' mismatch',
AreaToStr(expected),
AreaToStr(actual)
);
// First area crossing date line, no overlaps
inc(counter);
a.Init(160, 40, -170, 20);
b.Init(-160, 30, -150, 0);
intersects := a.Intersects(b);
AssertEquals(
'Area intersection detection test #' + IntToStr(counter) + ' mismatch',
false,
intersects
);
// First area crossing date line, overlaps on the left side of date lie
inc(counter);
a.Init(160, 40, -170, 20);
b.Init(165, 30, 170, 0);
intersects := a.Intersects(b);
AssertEquals(
'Area intersection detection test #' + IntToStr(counter) + ' mismatch',
true,
intersects
);
expected.Init(165, 30, 170, 20);
actual := a.Intersection(b);
AssertEquals(
'Area intersection test #' + IntToStr(counter) + ' mismatch',
AreaToStr(expected),
AreaToStr(actual)
);
// First area crossing date line, overlaps on the right side of date lie
inc(counter);
a.Init(160, 40, -160, 20);
b.Init(-170, 30, -165, 0);
intersects := a.Intersects(b);
AssertEquals(
'Area intersection detection test #' + IntToStr(counter) + ' mismatch',
true,
intersects
);
expected.Init(-170, 30, -165, 20);
actual := a.Intersection(b);
AssertEquals(
'Area intersection test #' + IntToStr(counter) + ' mismatch',
AreaToStr(expected),
AreaToStr(actual)
);
// Second area crossing date line, no overlaps
inc(counter);
a.Init(-160, 30, -150, 0);
b.Init(160, 40, -170, 20);
intersects := a.Intersects(b);
AssertEquals(
'Area intersection detection test #' + IntToStr(counter) + ' mismatch',
false,
intersects
);
// Second area crossing date line, overlaps on the left side of dateline
inc(counter);
a.Init(165, 30, 170, 0);
b.Init(160, 40, -170, 20);
intersects := a.Intersects(b);
AssertEquals(
'Area intersection detection test #' + IntToStr(counter) + ' mismatch',
true,
intersects
);
expected.Init(165, 30, 170, 20);
actual := a.Intersection(b);
AssertEquals(
'Area intersection test #' + IntToStr(counter) + ' mismatch',
AreaToStr(expected),
AreaToStr(actual)
);
end;
initialization
RegisterTest(TMvTestsArea);
end.