(******************************************************************************
Модуль:      u_TileStorageSAS4WinCE
Назначение:  SASPlanet
Автор:       Dima2000
Версия:      v2
Дата:        09.05.2012

Модуль  содержит  класс TCacheSAS4WinCE, реализующий работу с пакованыым кэшем
для  SAS4WinCE/SAS4Andriod.  Для работы большинства операций требуется наличие
файла индекса.

*******************************************************************************
История изменений.

v3      11.05.2012
[*] Переделка под дельфи2007 и классы Планеты.

v2	09.05.2012
[*] Переделал поиск с линейного на двоичный.
[*] Готовы проверка наличия тайла и чтение тайла (в string).
[*] Сделал закрытие индекса по таймауту.
[*] Думаю сделал формирование карты заполнения. Не совсем хорошо, но ...
[*] Наверное и GetTileInfo будет работать.

v1	05.05.2012
[+] Начало разработки.

Обозначения:
[+] - добавление функционала
[-] - удаление функционала
[!] - исправление ошибок
[*] - исправление (не ошибок), улучшение
{!} - отладочные строки, можно безопасно удалить
*******************************************************************************
ToDo:
+1. Чтение тайла.
+2. Построение карты заполнения в заданном box[z].
-3. Тоже самое, но по файлу данных (в аргументе).
-4. Чтение тайлов из файлов данных без наличия индекса.
-5. Построение какого-то варианта карты заполнения только по .d??.
+6. Использовать метод Sync, по нему проверять таймаут (GetTickCount) и если да,
    то закрывать индекс. Соответственно везде обновлять таймсет.
+7. Переписать процедурки поиска!
8. Объединить процедурки поиска в одну.
+9. Разобраться с ITileInfoBasic и добавить метод GetTileInfo.
******************************************************************************)

unit u_TileStorageSAS4WinCE;

interface

uses
	Windows,
	Types,
	SysUtils,
	GR32,
	i_BinaryData,
	i_FillingMapColorer,
	i_OperationNotifier,
	i_SimpleTileStorageConfig,
	i_CoordConverter,
	i_MapVersionInfo,
	i_ContentTypeInfo,
	i_TileInfoBasic,
	i_TileFileNameGeneratorsList,
	i_ContentTypeManager,
	i_InternalPerformanceCounter,
	u_GlobalCahceConfig,
	u_MapTypeCacheConfig,
	u_TileStorageAbstract;

type
	{Типы дублируются с TSAS4WinCE}
	TTableZX = packed record
		n: integer;	// Значение
		ptr: integer;	// Смещение таблицы в файле индекса
	end;
	TTableY = packed record
		n: integer;	// Значение
		d: integer;	// Номер файла данных
		ptr: integer;	// Смещение тайла в файле данных
		size: integer;	// Длина файла тайла
	end;

	{Базовый класс исключений}
	ETileStorageSAS4WinCE = class(Exception);

	TTileStorageSAS4WinCE = class(TTileStorageAbstract)
	private
		{Путь и имя файлов, без расширения!}
		fPathFileName: string;
		FI, FD: file;
		{Флаг открытого индекса}
		fOpenFI: boolean;
		{Время последнего обращения к индексу}
		fLastTime: cardinal;
		{Кэшируем таблички в памяти, а Z[] храним сразу всю}
		Tz: array [0..23] of TTableZX;
		Tx: array of TTableZX;
		Ty: array of TTableY;
		{Размер данных в таблицах кэширования}
		fSizeZ: integer;
		fSizeX: integer;
		fSizeY: integer;
		{Какая именно таблица прочитана в буфер}
		fPtrX: integer;
		fPtrY: integer;
		{Данные об найденном тайле}
		fTile: TTableY;
		{Тип тайлов, передаётся конструктору, что там - бог весть}
		FMainContentType: IContentTypeInfoBasic;

		{Отроем файл индекса и заодно прочитаем таблицу Z}
		function OpenFI(): boolean;
		{Закрывает открытый индекс и освобождает память}
		procedure CloseFI();
		{Найти в таблице указанный z и прочитать таблицу Tx[z]}
		function LoadTx(const z: integer): integer;
		{Найти в таблице указанный x и прочитать таблицу Ty[z,x]}
		function LoadTy(const x: integer): integer;
	public
		{Строка с названием модуля (для отображения в диалоге SAS?)}
		class function Name(): string;
		{Выдать строку с информацией о версии}
		class function Version(): string;
		constructor Create(
			const AConfig: ISimpleTileStorageConfig;
			AGlobalCacheConfig: TGlobalCahceConfig;
			const ATileNameGeneratorList: ITileFileNameGeneratorsList;
			const AContentTypeManager: IContentTypeManager;
			const APerfCounterList: IInternalPerformanceCounterList
		);
		{Закрывает открытые файлы и освобождает память}
		destructor Destroy; override;
		{Проверка по индексу существования тайла и заполнение fTile}
		function TileExists(const AXY: TPoint; const AZoom: byte): boolean;
		{Читает тайл с диска}
		function LoadTile(const AXY: TPoint; const AZoom: byte; const AVersionInfo: IMapVersionInfo; out ATileInfo: ITileInfoBasic): IBinaryData; override;
		{Получить информацию о тайле - только размер}
		function GetTileInfo(const AXY: TPoint; const AZoom: byte; const AVersionInfo: IMapVersionInfo): ITileInfoBasic; override;
		{Сформировать массив с инфой о тайлах в box}
		function GetTileRectInfo(const ARect: TRect; const AZoom: byte; const AVersionInfo: IMapVersionInfo): ITileRectInfo; override;
		procedure Sync();

		{Путь и имя (без расширения) используемых файлов (переданное .Create)}
		property PathFileName: string read fPathFileName;
	end;


implementation

uses
	u_TileRectInfoShort,
	u_BinaryDataByMemStream,
	u_MapVersionFactorySimpleString,
	u_TileStorageTypeAbilities,
	u_TileInfoBasic;

const
	unit_name = 'Support packed cache SAS4WinCE/SAS4Android';
	unit_ver = 'v3';
	{Начальное значение и инкремент размера таблиц кэширования индекса}
	IncSize = 1000;
	{Сколько времени держать индекс открытым, в тиках GetTickCount}
	TimeOpenIndex = 3000;


{Поиск в табличках Z и X}
function FindZX(
	const table: array of TTableZX;	// Где искать
	const tlen: integer;		// Размер таблицы
	const n: integer		// Что искать
): integer;	// Вернёт -1 если не нашла или индекс в таблице если нашла
var
	i, l, r, x: integer;
begin
	Result := -1; // Пока ничего не найдено
	l := 0; r := tlen;
	if r <= l then Exit; // Искать негде
	if table[l].n > n then Exit; // Меньше минимума
	if table[r-1].n < n then Exit; // Больше максимума
	while l < r do begin
		i := l + (r - l) div 2;
		x := table[i].n;
		Result := i;
		if x = n then Exit; // Нашли
		if x < n then	l := i+1
		else		r := i;
	end;
	Result := -1; // Не нашли
end;

{Поиск в табличке Y, потом объединю с предыдущим}
function FindY(
	const table: array of TTableY;	// Где искать
	const tlen: integer;		// Размер таблицы
	const n: integer		// Что искать
): integer;	// Вернёт -1 если не нашла или индекс в таблице если нашла
var
	i, l, r, x: integer;
begin
	Result := -1; // Пока ничего не найдено
	l := 0; r := tlen;
	if r <= l then Exit; // Искать негде
	if table[l].n > n then Exit; // Меньше минимума
	if table[r-1].n < n then Exit; // Больше максимума
	while l < r do begin
		i := l + (r - l) div 2;
		x := table[i].n;
		Result := i;
		if x = n then Exit; // Нашли
		if x < n then	l := i+1
		else		r := i;
	end;
	Result := -1; // Не нашли
end;

{Проверка координат и зума на допустимость}
function CheckZXY(const AXY: TPoint; const AZoom: byte): boolean;
var
//!	p: TPoint;
//!	z: byte;
	max: integer;
begin
//!	p := AXY; z := AZoom;
//!	Result := .CheckTilePosStrict(p, z, false); // как его вызвать-то?!
	Result := false;
	if AZoom > 23 then Exit;
	if (AXY.X < 0) or (AXY.Y < 0) then Exit;
	max := (1 shl AZoom) - 1;
	if (AXY.X > max) or (AXY.Y > max) then Exit;
	Result := true;
end;

{Проверка координат и зума на допустимость}
function CheckRect(const ARect: TRect; const AZoom: byte): boolean;
var
//!	r: TRect;
//!	z: byte;
	max: integer;
begin
//!	r := ARect; z := AZoom;
//!	Result := TCoordConverterBasic.CheckTileRect(r, z); // Как его вызвать-то?!
	Result := false;
	if AZoom > 23 then Exit;
	if ARect.Left < 0 then Exit;
	if ARect.Top  < 0 then Exit;
	if ARect.Left >= ARect.Right  then Exit;
	if ARect.Top  >= ARect.Bottom then Exit;
	max := 1 shl AZoom;
	if ARect.Right  > max then Exit;
	if ARect.Bottom > max then Exit;
end;


{Получить строку с версий класса}
class function TTileStorageSAS4WinCE.Version(): string;
begin
	Result := unit_ver;
end;

{Получить строку с именем/описанием класса}
class function TTileStorageSAS4WinCE.Name(): string;
begin
	Result := unit_name;
end;


{Отроем файл индекса и заодно прочитаем таблицу Z}
function TTileStorageSAS4WinCE.OpenFI(): boolean;
begin
	Result := true;
	fLastTime := GetTickCount;
	if fOpenFI then Exit; {Индекс уже открыт, ничего делать не надо}
	try
		{Откроем файл индекса}
		AssignFile(FI, fPathFileName + '.inx');
		try
			Reset(FI, 1);
			{Читаем таблицу Z}
			Blockread(FI, fSizeZ, 4);
			if fSizeZ > 0 then
				Blockread(FI, Tz[0], fSizeZ * SizeOf(TTableZX));
			fOpenFI := true;
		except
			CloseFile(FI);
			raise;
		end;
	except
		Result := false; {Открыть файл индекса не удалось}
	end;
	{При переоткрытии индекса надо перечитать все таблицы}
	fSizeX := 0;
	fSizeY := 0;
	fPtrX := 0;
	fPtrY := 0;
end;


{Закрывает открытый индекс и освобождает память}
procedure TTileStorageSAS4WinCE.CloseFI();
begin
	if fOpenFI then CloseFile(FI);
	fOpenFI := false;
	{Освободить всю занятую таблицами память}
	SetLength(Tx, 0);
	SetLength(Ty, 0);
	fSizeX := 0;
	fSizeY := 0;
	fPtrX := 0;
	fPtrY := 0;
end;


{Найти в таблице указанный z и прочитать таблицу Tx[z]}
function TTileStorageSAS4WinCE.LoadTx(const z: integer): integer;
var
	i: integer;
begin
	Result := -1;
	i := FindZX(Tz, fSizeZ, z);
	if i < 0 then Exit; // Такого z не нашли
	if Tz[i].ptr = 0 then Exit; // Указатель на таблицу X пустой
	if fPtrX <> Tz[i].ptr then begin // В буфере другая таблица X?
		try
			{Запомним какую таблицу прочитали в буфер}
			fPtrX := Tz[i].ptr;
			Seek(FI, fPtrX);
			Blockread(FI, fSizeX, 4);
			if fSizeX = 0 then Exit; {Таблица X пустая}
			{Если в файле таблица длиннее буфера, то увеличим буфер}
			if fSizeX > Length(Tx) then SetLength(Tx, fSizeX);
			Blockread(FI, Tx[0], fSizeX * SizeOf(TTableZX));
		except
			fPtrX := 0;
			fSizeX := 0;
		end;
	end;
	Result := i; // Нашли и прочитали таблицу
end;


{Найти в таблице указанный x и прочитать таблицу Ty[z,x]}
function TTileStorageSAS4WinCE.LoadTy(const x: integer): integer;
var
	i: integer;
begin
	Result := -1;
	i := FindZX(Tx, fSizeX, x);
	if i < 0 then Exit; // Такого x не нашли
	if Tx[i].ptr = 0 then Exit; // Указатель на таблицу Y пустой
	if fPtrY <> Tx[i].ptr then begin // В буфере другая таблица Y?
		try
			{Запомним какую таблицу прочитали в буфер}
			fPtrY := Tx[i].ptr;
			Seek(FI, fPtrY);
			Blockread(FI, fSizeY, 4);
			if fSizeY = 0 then Exit; {Таблица Y пустая}
			{Если в файле таблица длиннее буфера, то увеличим буфер}
			if fSizeY > Length(Ty) then SetLength(Ty, fSizeY);
			Blockread(FI, Ty[0], fSizeY * SizeOf(TTableY));
		except
			fPtrY := 0;
			fSizeY := 0;
		end;
	end;
	Result := i; // Нашли и прочитали таблицу
end;


{Задаёт путь к файлам кэша и инициализация переменных}
constructor TTileStorageSAS4WinCE.Create(
      const AConfig: ISimpleTileStorageConfig;
      AGlobalCacheConfig: TGlobalCahceConfig;
      const ATileNameGeneratorList: ITileFileNameGeneratorsList;
      const AContentTypeManager: IContentTypeManager;
      const APerfCounterList: IInternalPerformanceCounterList
);
begin
	inherited Create(
		TTileStorageTypeAbilitiesFileFolder.Create,
		TMapVersionFactorySimpleString.Create,
		AConfig
	);
	FMainContentType := AContentTypeManager.GetInfoByExt(Config.TileFileExt);
	{Дальше инициализация внутренних переменных класса}
	fPathFileName := ''; //!
	{Выделить немного памяти заранее}
	SetLength(Tx, IncSize);
	SetLength(Ty, IncSize);
	fOpenFI := false;
end;


{Закрывает открытые файлы и освобождает память}
destructor TTileStorageSAS4WinCE.Destroy;
begin
	CloseFI;
	inherited Destroy;
end;


function TTileStorageSAS4WinCE.TileExists(const AXY: TPoint; const AZoom: byte): boolean;
{Побочным эффектом является заполнение fTile инфой о найденном в индексе тайле.}
var
	n: integer;
begin
	Result := false;
	{Проверка переданных координат}
	if not CheckZXY(AXY, AZoom) then Exit;
	{Если индекс закрыт - откроем его}
	if not OpenFI() then Exit; {Проблема при открытии файла индекса}
	if LoadTx(AZoom + 1) < 0 then Exit;
	if LoadTy(AXY.X) < 0 then Exit;
	n := FindY(Ty, fSizeY, AXY.Y);
	if n < 0 then Exit; {Такого Y[z,x] в индексе нету}
	{Необходимый побочный эффект}
	fTile := Ty[n];
	Result := true;
end;


function TTileStorageSAS4WinCE.GetTileInfo(const AXY: TPoint; const AZoom: byte; const AVersionInfo: IMapVersionInfo): ITileInfoBasic;
begin
	{Проверка наличия тайла имеет нужный побочный эффект - заполнение fTile}
	if TileExists(AXY, AZoom) then
		Result := TTileInfoBasicExists.Create(0, fTile.size, nil, FMainContentType)
	else
		Result := TTileInfoBasicNotExists.Create(0, nil);
end;


function TTileStorageSAS4WinCE.LoadTile(const AXY: TPoint; const AZoom: byte; const AVersionInfo: IMapVersionInfo; out ATileInfo: ITileInfoBasic): IBinaryData;
var
	s: string;
begin
	Result := nil;
	ATileInfo := TTileInfoBasicNotExists.Create(0, nil);
	{Проверка наличия тайла имеет нужный побочный эффект - заполнение fTile}
	if not TileExists(AXY, AZoom) then Exit;
	{Нашли, придётся лезть в файл данных}
	s := IntToStr(fTile.d);
	if fTile.d < 10 then s := '0' + s;
	try
//{!}		Writeln(fPathFileName + '.d' + s, ':0x', IntToHex(fTile.ptr,1),':',fTile.size);
		AssignFile(FD, fPathFileName + '.d' + s);
		Reset(FD, 1);
		Seek(FD, fTile.ptr);
		SetLength(s, fTile.size);
		Blockread(FD, s[1], fTile.size);
		Result := TBinaryDataByMemStream.CreateFromMem(fTile.size, @s[1]);
		ATileInfo := TTileInfoBasicExists.Create(0, fTile.size, nil, FMainContentType);
	finally
		CloseFile(FD);
	end;
end;


procedure TTileStorageSAS4WinCE.Sync();
begin
	if fOpenFI and (GetTickCount > fLastTime + TimeOpenIndex) then CloseFI;
end;


{Сформировать массив с инфой о тайлах в box}
function TTileStorageSAS4WinCE.GetTileRectInfo(const ARect: TRect; const AZoom: byte; const AVersionInfo: IMapVersionInfo): ITileRectInfo;
var
	VCount: TPoint;
	{Преобразование координат в индекс массива}
	function XYtoI(xx, yy: integer): integer;
	begin
		Result := (yy - ARect.Top) * VCount.X + (xx - ARect.Left);
	end;
var
	VItems: PTileInfoShortInternalArray;
	VItemNo: TTileInfoShortInternal;
	x, y, i: integer;
	fx, fy: integer; // Флаги существования в индексе таблиц X,Y
begin
	Result := nil;
	if not CheckRect(ARect, AZoom) then Exit; // Кривые координаты
	VCount.X := ARect.Right - ARect.Left;
	VCount.Y := ARect.Bottom - ARect.Top;
	{Если индекс закрыт - откроем его}
	if not OpenFI() then Exit; // Проблема при открытии файла индекса
	{Для ускорения присваиваний в циклах подготовим пустой элемент}
	VItemNo.FLoadDate := 0;
	VItemNo.FSize := 0;
	VItemNo.FInfoType := titNotExists;
	{Выделяем память на весь массив тайлов}
	VItems := GetMemory(VCount.X * VCount.Y * SizeOf(TTileInfoShortInternal));
	{Проверка существования z, таблицы x для него и загрузка таблицы x в память}
	fx := LoadTx(AZoom + 1);
	if fx < 0 then begin
		{Нет такого z, или для него нет таблицы x, заполним весь массив пустышкой}
		for i := 0 to VCount.X * VCount.Y - 1 do VItems[i] := VItemNo;
	end else begin
		{И z есть, и какие-то x есть, будем проверять}
		for x := ARect.Left to ARect.Right - 1 do begin
			{Проверка существования x, таблицы y для него и загрузка таблицы y в память}
			fx := LoadTy(x);
			if fx < 0 then begin
				{Нету такого x или нету для него таблицы y - заполним пустышкой сразу все y}
				for y := ARect.Top to ARect.Bottom - 1 do
					VItems[XYtoI(x,y)] := VItemNo;
				Continue; // Продолжим для следующего x
			end;
			{Вот тут можно оптимизировать: не лезть поиском для всех y, а разбить проход на три фазы:
			<Ty[0], Ty, >Ty[fSizeY-1], при этом первая и третья лишь заполняют пустышкой результирующий массив,
			а вторая может идти линейно по Ty и все отсутствующие в Ty интервалы сразу заполнять пустышкой}
			for y := ARect.Top to ARect.Bottom - 1 do begin
				i := XYtoI(x,y);
				fy := FindY(Ty, fSizeY, y);
				if fy < 0 then begin
					VItems[i] := VItemNo; // Нет такого y в таблице
				end else begin
					VItems[i].FLoadDate := 0;
					VItems[i].FSize := Ty[fy].size;
					VItems[i].FInfoType := titExists;
				end;
			end;
		end;
	end;
	Result := TTileRectInfoShort.CreateWithOwn(ARect, AZoom, nil, FMainContentType, VItems);
	FreeMemory(VItems);
end;


end.