You've already forked lazarus-ccr
lazMapViewer: Initial commit to CCR (based on Maciej Kaczkowski (https://github.com/maciejkaczkowski/mapviewer) and ti-dic's (https://sourceforge.net/p/roadbook/code/ci/master/tree/mapviewer/) MapViewer components. Removed dependence on RGB_Graphics. Rename TMapViewer to TMapView and TMVGLGeonames to TMvGeoNames to avoid naming conflicts with original packages.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6307 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
360
components/lazmapviewer/source/mvcache.pas
Normal file
360
components/lazmapviewer/source/mvcache.pas
Normal file
@ -0,0 +1,360 @@
|
||||
{
|
||||
Picture cache manager (c) 2014 ti_dic
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the terms of the GNU Library General Public License as published by
|
||||
the Free Software Foundation; either version 2 of the License, or (at your
|
||||
option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but WITHOUT
|
||||
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
||||
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
|
||||
for more details.
|
||||
|
||||
You should have received a copy of the GNU Library General Public License
|
||||
along with this library; if not, write to the Free Software Foundation,
|
||||
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
}
|
||||
unit mvCache;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,mvmapprovider,IntfGraphics,syncObjs,mvtypes;
|
||||
|
||||
Type
|
||||
|
||||
{ TPictureCache }
|
||||
|
||||
TPictureCache = Class(TComponent)
|
||||
private
|
||||
FMemMaxElem : integer;
|
||||
Crit : TCriticalSection;
|
||||
Cache : TStringList;
|
||||
FBasePath: String;
|
||||
FUseDisk: Boolean;
|
||||
FUseThreads: Boolean;
|
||||
procedure SetUseThreads(AValue: Boolean);
|
||||
Procedure EnterCrit;
|
||||
Procedure LeaveCrit;
|
||||
protected
|
||||
function GetNewImgFor(aStream : TStream) : TLazIntfImage;
|
||||
procedure FreeCache;
|
||||
Function MapProvider2FileName(MapProvider : TMapProvider) : String;
|
||||
Function DiskCached(const aFileName : String) : Boolean;
|
||||
procedure LoadFromDisk(const aFileName : String;out img : TLazIntfImage);
|
||||
Function GetFileName(MapProvider : TMapProvider;const TileId : TTileId) : String;
|
||||
public
|
||||
Procedure CheckCacheSize(sender : TObject);
|
||||
constructor Create(aOwner : TComponent);override;
|
||||
destructor destroy;override;
|
||||
Procedure Add(MapProvider : TMapProvider;const TileId : TTileId;Stream : TMemoryStream);
|
||||
Procedure GetFromCache(MapProvider : TMapProvider;const TileId : TTileId;out img : TLazIntfImage);
|
||||
function InCache(MapProvider : TMapProvider;const TileId : TTileId) : Boolean;
|
||||
|
||||
property UseDisk : Boolean read FUseDisk write FUseDisk;
|
||||
property BasePath : String read FBasePath write FBasePath;
|
||||
property UseThreads : Boolean read FUseThreads write SetUseThreads;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
uses FPimage,GraphType,FPReadJPEG;
|
||||
|
||||
{ TPictureCache }
|
||||
|
||||
function IsValidPNG(stream: TStream): Boolean;
|
||||
var
|
||||
s: string;
|
||||
y: Int64;
|
||||
begin
|
||||
if Assigned(stream) then
|
||||
begin
|
||||
SetLength(s, 3);
|
||||
y := stream.Position;
|
||||
stream.Position := 1;
|
||||
stream.Read(s[1], 3);
|
||||
stream.Position := y;
|
||||
Result := s = 'PNG';
|
||||
end
|
||||
else
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function IsValidJPEG(stream: TStream): Boolean;
|
||||
var
|
||||
s: string;
|
||||
y: Int64;
|
||||
begin
|
||||
if Assigned(stream) then
|
||||
begin
|
||||
SetLength(s, 4);
|
||||
y := stream.Position;
|
||||
stream.Position := 6;
|
||||
stream.Read(s[1], 4);
|
||||
stream.Position := y;
|
||||
Result := (s = 'JFIF') or (s = 'Exif');
|
||||
end
|
||||
else
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
procedure TPictureCache.SetUseThreads(AValue: Boolean);
|
||||
begin
|
||||
if FUseThreads=AValue then Exit;
|
||||
FUseThreads:=AValue;
|
||||
if aValue then
|
||||
Crit:=TCriticalSection.Create
|
||||
else
|
||||
FreeAndnil(Crit);
|
||||
end;
|
||||
|
||||
procedure TPictureCache.EnterCrit;
|
||||
begin
|
||||
if Assigned(Crit) then
|
||||
Crit.Enter;
|
||||
end;
|
||||
|
||||
procedure TPictureCache.LeaveCrit;
|
||||
begin
|
||||
if Assigned(Crit) then
|
||||
Crit.Leave;
|
||||
end;
|
||||
|
||||
function TPictureCache.GetNewImgFor(aStream: TStream): TLazIntfImage;
|
||||
var
|
||||
reader : TFPCustomImageReader;
|
||||
rawImg : TRawImage;
|
||||
begin
|
||||
result:=nil;
|
||||
Reader := nil;
|
||||
if not(assigned(aStream)) then
|
||||
exit;
|
||||
if IsValidJPEG(astream) then
|
||||
Reader := TFPReaderJPEG.create
|
||||
else
|
||||
if IsValidPNG(astream) then
|
||||
Reader := TLazReaderPNG.create;
|
||||
if Assigned(reader) then
|
||||
Begin
|
||||
try
|
||||
rawImg.Init;
|
||||
rawImg.Description.Init_BPP24_B8G8R8_BIO_TTB(TILE_SIZE,TILE_SIZE);
|
||||
Result:=TLazIntfImage.create(rawImg,true);
|
||||
Try
|
||||
Result.LoadFromStream(aStream,reader);
|
||||
except
|
||||
FreeAndNil(result);
|
||||
end;
|
||||
finally
|
||||
FreeAndNil(Reader)
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPictureCache.FreeCache;
|
||||
var i : integer;
|
||||
begin
|
||||
EnterCrit;
|
||||
Try
|
||||
For i:=0 to pred(Cache.Count) do
|
||||
begin
|
||||
Cache.Objects[i].Free;
|
||||
end;
|
||||
Cache.Clear;
|
||||
Cache.Free;
|
||||
finally
|
||||
LeaveCrit;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPictureCache.MapProvider2FileName(MapProvider: TMapProvider): String;
|
||||
var i : integer;
|
||||
begin
|
||||
Result:='';
|
||||
if Assigned(MapProvider) then
|
||||
begin
|
||||
Result:=MapProvider.Name;
|
||||
For i:=1 to length(Result) do
|
||||
if not(result[i] in ['a'..'z','A'..'Z','0'..'9','_','.']) then
|
||||
Result[i]:='-';
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPictureCache.DiskCached(const aFileNAme: String): Boolean;
|
||||
Var FullFileName : string;
|
||||
begin
|
||||
if UseDisk then
|
||||
Begin
|
||||
FullFileName:=BasePath+aFileName;
|
||||
Result:=FileExists(FullFileName);
|
||||
end
|
||||
Else
|
||||
Result:=False;
|
||||
end;
|
||||
|
||||
procedure TPictureCache.LoadFromDisk(const aFileName: String; out
|
||||
img: TLazIntfImage);
|
||||
var FullFileName : String;
|
||||
aStream : TFileStream;
|
||||
begin
|
||||
img:=nil;
|
||||
FullFileName:=BasePath+aFileName;
|
||||
if FileExists(fullFileName) then
|
||||
Begin
|
||||
aStream:=TFileStream.Create(FullFileName,fmOpenRead);
|
||||
try
|
||||
Try
|
||||
img:=GetNewImgFor(aStream);
|
||||
except
|
||||
FreeAndNil(img);
|
||||
end;
|
||||
if Assigned(img) then
|
||||
begin
|
||||
EnterCrit;
|
||||
Try
|
||||
Cache.AddObject(aFileName,img);
|
||||
finally
|
||||
LeaveCrit;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
aStream.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPictureCache.GetFileName(MapProvider: TMapProvider;const TileId: TTileId
|
||||
): String;
|
||||
begin
|
||||
Result:=MapProvider2FileName(MapProvider)+'_'+inttostr(TileId.X)+'_'+inttostr(TileId.Y)+'_'+inttostr(TileId.Z);
|
||||
end;
|
||||
|
||||
procedure TPictureCache.CheckCacheSize(Sender : TObject);
|
||||
var i ,idx : integer;
|
||||
begin
|
||||
EnterCrit;
|
||||
try
|
||||
if Cache.Count>FMemMaxElem then
|
||||
Begin
|
||||
For i:=1 to 10 do
|
||||
Begin
|
||||
idx:=pred(Cache.Count);
|
||||
if idx>1 then
|
||||
Begin
|
||||
Cache.Objects[idx].free;
|
||||
Cache.Delete(idx);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
LeaveCrit;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TPictureCache.Create(aOwner: TComponent);
|
||||
begin
|
||||
inherited Create(aOwner);
|
||||
FMemMaxElem :=2048 div 256;
|
||||
Cache:=TStringList.create;
|
||||
end;
|
||||
|
||||
destructor TPictureCache.destroy;
|
||||
begin
|
||||
inherited destroy;
|
||||
FreeCache;
|
||||
FreeAndNil(Crit);
|
||||
end;
|
||||
|
||||
procedure TPictureCache.Add(MapProvider: TMapProvider;const TileId: TTileId;
|
||||
Stream: TMemoryStream);
|
||||
var FileName : String;
|
||||
img : TLazIntfImage;
|
||||
aFile : TFileStream;
|
||||
idx : integer;
|
||||
begin
|
||||
FileName:=GetFileName(MapProvider,TileId);
|
||||
EnterCrit;
|
||||
Try
|
||||
idx:=Cache.IndexOF(FileName);
|
||||
if idx<>-1 then
|
||||
Cache.Objects[idx].Free
|
||||
else
|
||||
Begin
|
||||
Cache.Insert(0,FileName);
|
||||
idx:=0;
|
||||
end;
|
||||
img:=GetNewImgFor(Stream);
|
||||
Cache.Objects[idx]:=img;
|
||||
finally
|
||||
LeaveCrit;
|
||||
end;
|
||||
if UseDisk then
|
||||
Begin
|
||||
if assigned(img) then
|
||||
Begin
|
||||
aFile:=TFileStream.Create(BasePath+FileName,fmCreate);
|
||||
Try
|
||||
Stream.Position:=0;
|
||||
aFile.CopyFrom(Stream,0);
|
||||
finally
|
||||
FreeAndNil(aFile);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if Not(FUseThreads) then
|
||||
CheckCacheSize(self);
|
||||
end;
|
||||
|
||||
procedure TPictureCache.GetFromCache(MapProvider: TMapProvider;const TileId: TTileId; out img: TLazIntfImage);
|
||||
var FileName : String;
|
||||
idx : integer;
|
||||
begin
|
||||
img:=nil;
|
||||
FileName:=GetFileName(MapProvider,TileId);
|
||||
EnterCrit;
|
||||
Try
|
||||
idx:=Cache.IndexOF(FileName);
|
||||
if idx<>-1 then
|
||||
Begin
|
||||
img:=TLazIntfImage(Cache.Objects[idx]);
|
||||
if Idx>FMemMaxElem div 2 then
|
||||
Begin
|
||||
Cache.Delete(idx);
|
||||
Cache.Insert(0,FileName);
|
||||
Cache.Objects[0]:=img;
|
||||
end;
|
||||
end;
|
||||
|
||||
finally
|
||||
leaveCrit;
|
||||
end;
|
||||
if idx=-1 then
|
||||
Begin
|
||||
if UseDisk then
|
||||
LoadFromDisk(FileName,img);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPictureCache.InCache(MapProvider: TMapProvider;const TileId: TTileId
|
||||
): Boolean;
|
||||
var FileName : String;
|
||||
idx : integer;
|
||||
begin
|
||||
FileName:=GetFileName(MapProvider,TileId);
|
||||
EnterCrit;
|
||||
try
|
||||
idx:=Cache.IndexOF(FileNAme);
|
||||
finally
|
||||
leaveCrit;
|
||||
end;
|
||||
if idx<>-1 then
|
||||
Result:=True
|
||||
else
|
||||
Result:=DiskCached(FileName);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user