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

LazMapViewer: Reorganize cache directory to <provider>/<zoom> hierarchy

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9544 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2024-12-18 16:54:43 +00:00
parent ba135c8c70
commit 58f351f6c9
3 changed files with 42 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
components/lazmapviewer/source/mvcache.pas
View File

@ -65,6 +65,7 @@ Type
Procedure GetFromCache(MapProvider: TMapProvider; const TileId: TTileId; out item: TPictureCacheItem);
function GetPreviewFromCache(MapProvider: TMapProvider; var TileId: TTileId; out ARect: TRect): boolean;
function InCache(MapProvider: TMapProvider; const TileId: TTileId): Boolean;
procedure Prepare(MapProvider: TMapProvider);
property UseDisk: Boolean read FUseDisk write FUseDisk;
property BasePath: String read FBasePath write FBasePath;
@ -80,8 +81,9 @@ uses
GraphType, DateUtils, FPReadJPEG;
const
MEMCACHE_MAX = 64; // Tiles kept in memory
MEMCACHE_MAX = 64; // Tiles kept in memory
MEMCACHE_SWEEP_CNT = 10; // Max tiles to be swept at once
FLAT_CACHE = false; // all cache files in flat folder, or grouped by provider and zoom
function IsValidPNG(AStream: TStream): Boolean;
var
@ -303,10 +305,14 @@ end;
function TPictureCache.GetFileName(MapProvider: TMapProvider;
const TileId: TTileId): String;
var
prov: String;
begin
Result := Format('%s_%d_%d_%d',
[MapProvider2FileName(MapProvider), TileId.X, TileId.Y, TileId.Z]
);
prov := MapProvider2FileName(MapProvider);
if FLAT_CACHE then
Result := Format('%s_%d_%d_%d', [prov, TileId.X, TileId.Y, TileId.Z])
else
Result := SetDirSeparators(Format('%s/%d/%d_%d', [prov, TileID.Z, TileID.X, TileID.Y]));
end;
procedure TPictureCache.CheckCacheSize(Sender: TObject);
@ -361,7 +367,9 @@ begin
begin
if Assigned(item) then
begin
lFile := TFileStream.Create(BasePath + FileName, fmCreate);
FileName := BasePath + FileName;
ForceDirectories(ExtractFileDir(FileName)); // <--- to be removed !!!
lFile := TFileStream.Create(FileName, fmCreate);
try
Stream.Position := 0;
lFile.CopyFrom(Stream, 0);
@ -481,5 +489,25 @@ begin
Result := DiskCached(FileName);
end;
{ Makes sure that the subfolders needed by the given map provider exist in
the cache directory. }
procedure TPictureCache.Prepare(MapProvider: TMapProvider);
var
prov, dir: String;
zoom, zoomMin, zoomMax: Integer;
begin
if (not FLAT_CACHE) or (MapProvider = nil) then
exit;
prov := MapProvider2FileName(MapProvider);
dir := BasePath + prov;
ForceDirectories(dir);
MapProvider.GetZoomInfos(zoomMin, zoomMax);
for zoom := zoomMin to zoomMax do
begin
if not DirectoryExists(dir + IntToStr(zoom)) then
CreateDir(dir + IntToStr(zoom));
end;
end;
end.

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

@ -154,6 +154,7 @@ type
function LonLatToScreen(APt: TRealPoint): TPoint; deprecated 'Use LatLonToScreen';
function LatLonToWorldScreen(APt: TRealPoint): TPoint;
function LonLatToWorldScreen(APt: TRealPoint): TPoint; deprecated 'Use LatLonToWorldScreen';
procedure PrepareCache(AMapProvider: TMapProvider);
function ReadProvidersFromXML(AFileName: String; out AMsg: String): Boolean;
procedure Redraw;
Procedure RegisterProviders;
@ -946,6 +947,11 @@ Begin
SetCenter(nCenter);
end;
procedure TMapViewerEngine.PrepareCache(AMapProvider: TMapProvider);
begin
Cache.Prepare(AMapProvider);
end;
function TMapViewerEngine.ReadProvidersFromXML(AFileName: String;
out AMsg: String): Boolean;
@ -1263,7 +1269,7 @@ end;
procedure TMapViewerEngine.SetCachePath(AValue: String);
begin
Cache.BasePath := aValue;
Cache.BasePath := SetDirSeparators(aValue);
end;
procedure TMapViewerEngine.SetCenter(ACenter: TRealPoint);
@ -1315,6 +1321,7 @@ begin
MapWin.MapProvider := Provider;
if Assigned(Provider) then
begin
PrepareCache(Provider);
ConstraintZoom(MapWin);
CalculateWin(MapWin);
Redraw(MapWin);

16
components/lazmapviewer/source/mvmapviewer.pas
View File

@ -5,6 +5,7 @@
(C) 2014 ti_dic@hotmail.com
(C) 2019 Werner Pamler (user wp at Lazarus forum https://forum.lazarus.freepascal.org)
(C) 2023 Yuliyan Ivanov (user alpine at Lazarus forum https://forum.lazarus.freepascal.org)
(C) 2024 Ekkehard Domning (edo-at-domis.de)
License: modified LGPL with linking exception (like RTL, FCL and LCL)
@ -14,8 +15,6 @@
See also: https://wiki.lazarus.freepascal.org/FPC_modified_LGPL
}
// ToDo: Make Active work at designtime.
// "Deprecated" warnings:
// - function names containing "LonLat" were copied and named to contain "LatLon"
// (will be removed in v1.0)
@ -2216,18 +2215,6 @@ begin
result := Engine.MapProvider;
end;
{
function TMapView.GetOnCenterMove: TNotifyEvent;
begin
Result := Engine.OnCenterMove;
end;
function TMapView.GetOnCenterMoving: TCenterMovingEvent;
begin
Result := Engine.OnCenterMoving;
end;
}
procedure TMapView.DoZoomChange(Sender: TObject);
begin
GetPluginManager.ZoomChange(Self);
@ -3630,7 +3617,6 @@ begin
Result := FindObjsAtScreenPt(X, Y, ATolerance, true);
end;
procedure TMapView.CenterOnObj(obj: TGPSObj);
var
Area: TRealArea;