pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

mapviewer: Replace repeated calls to IntPower(2,..) by table lookup function ZoomLevel. Add elemental unit tests.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8790 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-04-17 15:42:06 +00:00
parent a530b02b06
commit 7a09190330
6 changed files with 374 additions and 26 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
components/lazmapviewer/examples/fulldemo/main.pas
View File

@ -119,6 +119,7 @@ type
var
MainForm: TMainForm;
implementation
{$R *.lfm}
@ -145,7 +146,6 @@ var
PointFormatSettings: TFormatsettings;
CacheDir: String = HOMEDIR + 'cache/'; // share the cache in both example projects
function CalcIniName: String;
begin
Result := ChangeFileExt(Application.ExeName, '.ini');

97
components/lazmapviewer/source/mvengine.pas
View File

@ -171,27 +171,53 @@ function CalcGeoDistance(Lat1, Lon1, Lat2, Lon2: double;
function DMSToDeg(Deg, Min: Word; Sec: Double): Double;
function GPSToDMS(Angle: Double): string;
function GPSToDMS(Angle: Double; AFormatSettings: TFormatSettings): string;
function LatToStr(ALatitude: Double; DMS: Boolean): String;
function LatToStr(ALatitude: Double; DMS: Boolean; AFormatSettings: TFormatSettings): String;
function LonToStr(ALongitude: Double; DMS: Boolean): String;
function LonToStr(ALongitude: Double; DMS: Boolean; AFormatSettings: TFormatSettings): String;
function TryStrToGps(const AValue: String; out ADeg: Double): Boolean;
procedure SplitGps(AValue: Double; out ADegs, AMins, ASecs: Double);
function ZoomFactor(AZoomLevel: Integer): Int64;
var
HERE_AppID: String = '';
HERE_AppCode: String = '';
OpenWeatherMap_ApiKey: String = '';
ThunderForest_ApiKey: String = '';
DMS_Decimals: Integer = 1;
implementation
uses
Forms, laz2_xmlread, laz2_xmlwrite, laz2_dom, TypInfo,
Forms, TypInfo, laz2_xmlread, laz2_xmlwrite, laz2_dom,
mvJobs, mvGpsObj;
const
_K = 1024;
_M = _K*_K;
_G = _K*_M;
ZOOM_FACTOR: array[0..32] of Int64 = (
1, 2, 4, 8, 16, 32, 64, 128, 256, 512, // 0..9
_K, 2*_K, 4*_K, 8*_K, 16*_K, 32*_K, 64*_K, 128*_K, 256*_K, 512*_K, // 10..19
_M, 2*_M, 4*_M, 8*_M, 16*_M, 32*_M, 64*_M, 128*_M, 256*_M, 512*_M, // 20..29
_G, 2*_G, 4*_G // 31..32 // 30..32
);
function ZoomFactor(AZoomLevel: Integer): Int64;
begin
if (AZoomLevel >= Low(AZoomLevel)) and (AZoomLevel <= High(AZoomLevel)) then
Result := ZOOM_FACTOR[AZoomLevel]
else
Result := round(IntPower(2, AZoomLevel));
end;
type
{ TLaunchDownloadJob }
@ -614,8 +640,9 @@ const
MAX_LATITUDE = 85.05112878;
MIN_LONGITUDE = -180;
MAX_LONGITUDE = 180;
TWO_PI = 2.0 * pi;
var
px, py: Extended;
factor, px, py: Extended;
pt: TRealPoint;
begin
// https://epsg.io/3857
@ -624,8 +651,9 @@ begin
pt.Lat := Math.EnsureRange(ALonLat.Lat, MIN_LATITUDE, MAX_LATITUDE);
pt.Lon := Math.EnsureRange(ALonLat.Lon, MIN_LONGITUDE, MAX_LONGITUDE);
px := ( TILE_SIZE / (2 * pi)) * ( IntPower (2, AWin.Zoom) ) * (pt.LonRad + pi);
py := ( TILE_SIZE / (2 * pi)) * ( IntPower (2, AWin.Zoom) ) * (pi - ln( tan(pi/4 + pt.LatRad/2) ));
factor := TILE_SIZE / TWO_PI * ZoomFactor(AWin.Zoom);
px := factor * (pt.LonRad + pi);
py := factor * (pi - ln( tan(pi/4 + pt.LatRad/2) ));
Result.x := Round(px);
Result.y := Round(py);
@ -644,7 +672,7 @@ var
pt: TRealPoint;
cfmpx, cfmpm: Extended;
Z: Integer;
two_power_Z: Extended; // 2**Z
zoomfac: Extended; // 2**Z
begin
// https://epsg.io/3395
// https://pubs.usgs.gov/pp/1395/report.pdf, page 44
@ -652,14 +680,14 @@ begin
pt.Lon := Math.EnsureRange(ALonLat.Lon, MIN_LONGITUDE, MAX_LONGITUDE);
Z := 23 - AWin.Zoom;
two_power_Z := IntPower(2, Z);
zoomfac := ZoomFactor(Z);
cfmpx := IntPower(2, 31);
cfmpm := cfmpx / EARTH_CIRCUMFERENCE;
px := (EARTH_CIRCUMFERENCE/2 + EARTH_EQUATORIAL_RADIUS * pt.LonRad) * cfmpm / two_power_Z;
px := (EARTH_CIRCUMFERENCE/2 + EARTH_EQUATORIAL_RADIUS * pt.LonRad) * cfmpm / zoomfac;
sny := EARTH_ECCENTRICITY * sin(pt.LatRad);
lny := tan(pi/4 + pt.LatRad/2) * power((1-sny)/(1+sny), EARTH_ECCENTRICITY/2);
py := (EARTH_CIRCUMFERENCE/2 - EARTH_EQUATORIAL_RADIUS * ln(lny)) * cfmpm / two_power_Z;
py := (EARTH_CIRCUMFERENCE/2 - EARTH_EQUATORIAL_RADIUS * ln(lny)) * cfmpm / zoomfac;
Result.x := Round(px);
Result.y := Round(py);
@ -683,7 +711,7 @@ var
iMapWidth: Int64;
mPoint : TPoint;
begin
iMapWidth := Round(IntPower(2, AWin.Zoom)) * TILE_SIZE;
iMapWidth := round(ZoomFactor(AWin.Zoom)) * TILE_SIZE;
mPoint.X := (APoint.X - AWin.X) mod iMapWidth;
while mPoint.X < 0 do
@ -706,7 +734,7 @@ const
MIN_LONGITUDE = -180;
MAX_LONGITUDE = 180;
var
two_power_zoom: Extended; // 2**zoom
zoomfac: Extended;
begin
// https://epsg.io/3857
// https://pubs.usgs.gov/pp/1395/report.pdf, page 41
@ -714,9 +742,9 @@ begin
// note: coth: ** for better readability, but breaking OmniPascal in VSCode
// Result.LonRad := ( APoints.X / (( TILE_SIZE / (2*pi)) * 2**Zoom) ) - pi;
// Result.LatRad := arctan( sinh(pi - (APoints.Y/TILE_SIZE) / 2**Zoom * pi*2) );
two_power_Zoom := IntPower(2, Zoom);
Result.LonRad := ( APoint.X / (( TILE_SIZE / (2*pi)) * two_power_Zoom) ) - pi;
Result.LatRad := arctan( sinh(pi - (APoint.Y/TILE_SIZE) / two_power_Zoom * pi*2) );
zoomFac := ZoomFactor(Zoom);
Result.LonRad := ( APoint.X / (( TILE_SIZE / (2*pi)) * zoomFac) ) - pi;
Result.LatRad := arctan( sinh(pi - (APoint.Y/TILE_SIZE) / zoomFac * pi*2) );
Result.Lat := Math.EnsureRange(Result.Lat, MIN_LATITUDE, MAX_LATITUDE);
Result.Lon := Math.EnsureRange(Result.Lon, MIN_LONGITUDE, MAX_LONGITUDE);
@ -748,19 +776,19 @@ var
Cpm: Extended;
Z: Integer;
t, phi: Extended;
two_power_Z: Extended; // 2**Z
zoomFac: Extended; // 2**Z
i: Integer;
begin
// https://epsg.io/3395
// https://pubs.usgs.gov/pp/1395/report.pdf, page 44
Z := 23 - Zoom;
two_power_Z := IntPower(2, Z);
WorldSize := Round(IntPower(2, 31));
zoomFac := ZoomFactor(Z);
WorldSize := ZoomFactor(31);
Cpm := WorldSize / EARTH_CIRCUMFERENCE;
LonRad := (APoint.x / (Cpm/two_power_Z) - EARTH_CIRCUMFERENCE/2) / EARTH_EQUATORIAL_RADIUS;
LatRad := (APoint.y / (Cpm/two_power_Z) - EARTH_CIRCUMFERENCE/2);
LonRad := (APoint.x / (Cpm/zoomFac) - EARTH_CIRCUMFERENCE/2) / EARTH_EQUATORIAL_RADIUS;
LatRad := (APoint.y / (Cpm/zoomFac) - EARTH_CIRCUMFERENCE/2);
t := pi/2 - 2*arctan(exp(-LatRad/EARTH_EQUATORIAL_RADIUS));
@ -1330,6 +1358,8 @@ begin
ADegs := trunc(AValue) + 1;
end else
ADegs := trunc(AValue);
if AValue < 0 then
ADegs := -ADegs;
end;
procedure SplitGps(AValue: Double; out ADegs, AMins, ASecs: Double);
@ -1347,35 +1377,52 @@ begin
ADegs := ADegs + 1;
end;
end;
if AValue < 0 then
ADegs := -ADegs;
end;
function GPSToDMS(Angle: Double): string;
begin
Result := GPSToDMS(Angle, DefaultFormatSettings);
end;
function GPSToDMS(Angle: Double; AFormatSettings: TFormatSettings): string;
var
deg, min, sec: Double;
begin
SplitGPS(Angle, deg, min, sec);
Result := Format('%.0f° %.0f'' %.1f"', [deg, min, sec]);
Result := Format('%.0f° %.0f'' %.*f"', [deg, min, DMS_Decimals, sec], AFormatSettings);
end;
function LatToStr(ALatitude: Double; DMS: Boolean): String;
begin
Result := LatToStr(ALatitude, DMS, DefaultFormatSettings);
end;
function LatToStr(ALatitude: Double; DMS: Boolean; AFormatSettings: TFormatSettings): String;
begin
if DMS then
Result := GPSToDMS(abs(ALatitude))
Result := GPSToDMS(abs(ALatitude), AFormatSettings)
else
Result := Format('%.6f°',[abs(ALatitude)]);
Result := Format('%.6f°',[abs(ALatitude)], AFormatSettings);
if ALatitude > 0 then
Result := Result + ' N'
else
if ALatitude < 0 then
Result := Result + 'E';
Result := Result + ' S';
end;
function LonToStr(ALongitude: Double; DMS: Boolean): String;
begin
Result := LonToStr(ALongitude, DMS, DefaultFormatSettings);
end;
function LonToStr(ALongitude: Double; DMS: Boolean; AFormatSettings: TFormatSettings): String;
begin
if DMS then
Result := GPSToDMS(abs(ALongitude))
Result := GPSToDMS(abs(ALongitude), AFormatSettings)
else
Result := Format('%.6f°', [abs(ALongitude)]);
Result := Format('%.6f°', [abs(ALongitude)], AFormatSettings);
if ALongitude > 0 then
Result := Result + ' E'
else if ALongitude < 0 then

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

@ -49,6 +49,7 @@ Type
BottomRight : TRealPoint;
end;
implementation
function TRealPoint.GetLonRad: Extended;

84
components/lazmapviewer/unittests/mapviewer_tests.lpi Normal file
View File

@ -0,0 +1,84 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<Title Value="mapviewer_tests"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<BuildModes>
<Item Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
</RunParams>
<RequiredPackages>
<Item>
<PackageName Value="fpcunittestrunner"/>
</Item>
<Item>
<PackageName Value="LCL"/>
</Item>
<Item>
<PackageName Value="FCL"/>
</Item>
</RequiredPackages>
<Units>
<Unit>
<Filename Value="mapviewer_tests.lpr"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="mvmisctests_engine.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="mvMiscTests_Engine"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="mapviewer_tests"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="..\source"/>
<UnitOutputDirectory Value="ppu\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions>
<Item>
<Name Value="EAbort"/>
</Item>
<Item>
<Name Value="ECodetoolError"/>
</Item>
<Item>
<Name Value="EFOpenError"/>
</Item>
<Item>
<Name Value="EAssertionFailedError"/>
</Item>
</Exceptions>
</Debugging>
</CONFIG>

15
components/lazmapviewer/unittests/mapviewer_tests.lpr Normal file
View File

@ -0,0 +1,15 @@
program mapviewer_tests;
{$mode objfpc}{$H+}
uses
Interfaces, Forms, GuiTestRunner, mvMiscTests_Engine;
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TGuiTestRunner, TestRunner);
Application.Run;
end.

201
components/lazmapviewer/unittests/mvmisctests_engine.pas Normal file
View File

@ -0,0 +1,201 @@
unit mvMiscTests_Engine;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, fpcunit, testutils, testregistry;
type
TMiscTests_Engine= class(TTestCase)
published
procedure Test_LatToStr_DMS;
procedure Test_LatToStr_Deg;
procedure Test_LonToStr_DMS;
procedure Test_LonToStr_Deg;
procedure Test_SplitGPS;
procedure Test_ZoomFactor;
end;
implementation
uses
Math, mvEngine;
type
TLatLonRec = record
Name: String;
Lat: Double;
Lat_Deg: String;
Lat_DMS: String;
Lat_D, Lat_M: Integer;
Lat_S: Double;
Lon: Double;
Lon_Deg: String;
Lon_DMS: String;
Lon_D, Lon_M: Integer;
Lon_S: Double;
end;
var
PointFormatsettings: TFormatSettings;
const
LatLon_TestData: array[0..7] of TLatLonRec = (
(Name:'Sydney'; // https://www.latlong.net/place/sydney-nsw-australia-700.html
Lat:-33.865143; Lat_Deg:'33.865143° S'; Lat_DMS:'33° 51'' 54.5148" S'; Lat_D:-33; Lat_M:51; Lat_S:54.5148;
Lon:151.209900; Lon_Deg:'151.209900° E'; Lon_DMS:'151° 12'' 35.6400" E'; Lon_D:151; Lon_M:12; Lon_S:35.64),
(Name:'San Francisco'; // https://www.latlong.net/place/san-francisco-bay-area-ca-usa-32614.html
Lat:37.828724; Lat_Deg:'37.828724° N'; Lat_DMS:'37° 49'' 43.4064" N'; Lat_D:37; Lat_M:49; Lat_S:43.4064;
Lon:-122.355537; Lon_Deg:'122.355537° W'; Lon_DMS:'122° 21'' 19.9332" W'; Lon_D:-122; Lon_M:21; Lon_S:19.9332),
(Name:'London'; // https://www.latlong.net/place/10-downing-street-london-uk-32612.html
Lat:51.503368; Lat_Deg:'51.503368° N'; Lat_DMS:'51° 30'' 12.1248" N'; Lat_D:51; lat_M:30; Lat_S:12.1248;
Lon:-0.127721; Lon_Deg:'0.127721° W'; Lon_DMS:'0° 7'' 39.7956" W'; Lon_D:0; Lon_M:7; Lon_S:39.7956),
(Name:'Istanbul'; // https://www.latlong.net/place/istanbul-airport-turkey-32591.html
Lat:41.276901; Lat_Deg:'41.276901° N'; Lat_DMS:'41° 16'' 36.8436" N'; Lat_D:41; Lat_M:16; Lat_S:36.8436;
Lon:28.729324; Lon_Deg:'28.729324° E'; Lon_DMS:'28° 43'' 45.5664" E'; Lon_D:28; Lon_M:43; Lon_S:45.5664),
(Name:'Tokyo'; // https://www.latlong.net/place/tokyo-japan-8040.html
Lat:35.652832; Lat_Deg:'35.652832° N'; Lat_DMS:'35° 39'' 10.1952" N'; Lat_D:35; Lat_M:39; Lat_S:10.1952;
Lon:139.839478; Lon_Deg:'139.839478° E'; Lon_DMS:'139° 50'' 22.1208" E'; Lon_D:139; Lon_M:50; Lon_S:22.1208),
(Name:'Singapore'; // https://www.latlong.net/place/singapore-788.html
Lat:1.290270; Lat_Deg:'1.290270° N'; Lat_DMS:'1° 17'' 24.9720" N'; Lat_D:1; Lat_M:17; Lat_S:24.9720;
Lon:103.851959; Lon_Deg:'103.851959° E'; Lon_DMS:'103° 51'' 7.0524" E'; Lon_D:103; Lon_M:51; Lon_S:7.0524),
(Name:'Lima'; // https://www.latlong.net/place/lima-city-lima-province-peru-6919.html
Lat:-12.046374; Lat_Deg:'12.046374° S'; Lat_DMS:'12° 2'' 46.9464" S'; Lat_D:-12; Lat_M:2; Lat_S:46.9464;
Lon:-77.042793; Lon_Deg:'77.042793° W'; Lon_DMS:'77° 2'' 34.0548" W'; Lon_D:-77; Lon_M:2; Lon_S:34.0548),
(Name: 'Johannesburg'; // https://www.latlong.net/place/johannesburg-south-africa-1083.html
Lat:-26.195246; Lat_Deg:'26.195246° S'; Lat_DMS:'26° 11'' 42.8856" S'; Lat_D:-26; Lat_M:11; Lat_S:42.8856;
Lon:28.034088; Lon_Deg:'28.034088° E'; Lon_DMS:'28° 2'' 2.7168" E'; Lon_D:28; Lon_M:2; Lon_S:2.7168)
);
procedure TMiscTests_Engine.Test_LatToStr_Deg;
const
NO_DMS = false;
var
i: Integer;
begin
for i := 0 to High(LatLon_TestData) do
with LatLon_TestData[i] do
AssertEquals(
'Latitude string mismatch for ' + Name,
Lat_Deg, // expected
LatToStr(Lat, NO_DMS, PointFormatSettings) // actual
);
end;
procedure TMiscTests_Engine.Test_LatToStr_DMS;
const
NEED_DMS = true;
var
i: Integer;
begin
for i := 0 to High(LatLon_TestData) do
with LatLon_TestData[i] do
AssertEquals(
'Latitude string mismatch for ' + Name,
Lat_DMS, // expected
LatToStr(Lat, NEED_DMS, PointFormatSettings) // actual
);
end;
procedure TMiscTests_Engine.Test_LonToStr_Deg;
const
NO_DMS = false;
var
i: Integer;
begin
for i := 0 to High(LatLon_TestData) do
with LatLon_TestData[i] do
AssertEquals(
'Latitude string mismatch for ' + Name,
Lon_Deg, // expected
LonToStr(Lon, NO_DMS, PointFormatSettings) // actual
);
end;
procedure TMiscTests_Engine.Test_LonToStr_DMS;
const
NEED_DMS = true;
var
i: Integer;
begin
for i := 0 to High(LatLon_TestData) do
with LatLon_TestData[i] do
AssertEquals(
'Latitude string mismatch for ' + Name,
Lon_DMS, // expected
LonToStr(Lon, NEED_DMS, PointFormatSettings) // actual
);
end;
procedure TMiscTests_Engine.Test_SplitGPS;
const
TOLERANCE = 1e-5;
var
i: Integer;
D, M, S: double;
begin
for i := 0 to High(LatLon_TestData) do
with LatLon_TestData[i] do
begin
SplitGPS(Lat, D, M, S);
AssertEquals(
'Latitude degrees mismatch for ' + Name,
Lat_D, // expected
round(D) // actual
);
AssertEquals(
'Latitude minutes mismatch for ' + Name,
Lat_M, // expected
round(M) // actual
);
AssertEquals(
'Latitude seconds mismatch for ' + Name,
Lat_S,
S,
TOLERANCE
);
SplitGPS(Lon, D, M, S);
AssertEquals(
'Longitude degrees mismatch for ' + Name,
Lon_D, // expected
round(D) // actual
);
AssertEquals(
'Longitude minutes mismatch for ' + Name,
Lon_M, // expected
round(M) // actual
);
AssertEquals(
'Longitude seconds mismatch for ' + Name,
Lon_S,
S,
TOLERANCE
);
end;
end;
procedure TMiscTests_Engine.Test_ZoomFactor;
var
z: Integer;
f: Extended;
begin
for z := 0 to 32 do
begin
f := ZoomFactor(z);
AssertEquals('Zoomlevel lookup failure at ' + IntToStr(z), f, IntPower(2, z))
end;
end;
initialization
PointFormatSettings := DefaultFormatSettings;
PointFormatSettings.DecimalSeparator := '.';
DMS_Decimals := 4;
RegisterTest(TMiscTests_Engine);
end.