unit SpatialIndexes;

interface

uses Classes, Contnrs, Geomet;

type
	TSpatialIndexItem = class
	private
		FData: record
			case Integer of
				0: (Key: Integer);
				1: (Pointer: Pointer);
		end;
		FBounds: TDRect;
	public
		constructor Create(aKey: Integer; const aBounds: TDRect); overload;
		constructor Create(aPointer: Pointer; const aBounds: TDRect); overload;

		property Key: Integer read FData.Key;
		property Pointer: Pointer read FData.Pointer;
		property Bounds: TDRect read FBounds;
	end;

	TSpatialIndexItemList = class(Contnrs.TObjectList)
	private
		function GetItem(Index: Integer): TSpatialIndexItem;
	public
		constructor Create(anOwner: Boolean);

		function Add(anItem: TSpatialIndexItem): TSpatialIndexItem;
		function Extract(anItem: TSpatialIndexItem): TSpatialIndexItem;

		property Items[Index: Integer]: TSpatialIndexItem read GetItem; default;
	end;

	TQuadroSector = class;
	TSectorChilds = array[0..3] of TQuadroSector;
	TQuadroSector = class
	private
		FBounds: TDRect;
		FChilds: TSectorChilds;
		FItems: TSpatialIndexItemList;
	public
		constructor Create(const aBounds: TDRect);
		destructor Destroy; override;

		function Split(const anObjectsPerSector: Integer): Boolean;
		function Splited: Boolean;

		property Bounds: TDRect read FBounds;
		property Childs: TSectorChilds read FChilds;

		property Items: TSpatialIndexItemList read FItems;
	end;

	TQuadroTree = class
	private
		FRoot: TQuadroSector;
		FItemPerSector: Integer;

		procedure DeleteSectors;
	public
		constructor Create(anItemPerSector: Integer; const aRootSectorRect: TDRect);
		destructor  Destroy; override;

		procedure Clear(const aRootSectorRect: TDRect);

		function FindSector(const aContainsBounds: TDRect): TQuadroSector;
		function AddItem(const aKey: Integer; const aBounds: TDRect): TSpatialIndexItem; overload;
		function AddItem(const aPointer: Pointer; const aBounds: TDRect): TSpatialIndexItem; overload;

		property Root: TQuadroSector read FRoot;
	end;

	TQuadroTreeIntersectSectorEnum = class
	private
		FSectors: TList;
		FSector: TQuadroSector;
	public
		constructor Create;
		destructor Destroy; override;

		procedure Start(aTree: TQuadroTree; const aRect: TDRect);
		function  Next: Boolean;

		property Sector: TQuadroSector read FSector;
	end;


implementation

{ TSpatialIndexItem }

constructor TSpatialIndexItem.Create(aKey: Integer; const aBounds: TDRect);
begin
	inherited Create;
	FData.Key	:= aKey;
	FBounds := aBounds;
end;

constructor TSpatialIndexItem.Create(aPointer: Pointer;
	const aBounds: TDRect);
begin
	inherited Create;
	FData.Pointer	:= aPointer;
	FBounds := aBounds;
end;

{ TSpatialIndexItemList }

constructor TSpatialIndexItemList.Create(anOwner: Boolean);
begin
	inherited Create(anOwner);
end;

function TSpatialIndexItemList.Add(anItem: TSpatialIndexItem): TSpatialIndexItem;
begin
	Result := anItem;
	inherited Add(anItem);
end;


function TSpatialIndexItemList.Extract(anItem: TSpatialIndexItem): TSpatialIndexItem;
begin
	Result := TSpatialIndexItem(inherited Extract(anItem));
end;

function TSpatialIndexItemList.GetItem(Index: Integer): TSpatialIndexItem;
begin
	Result := TSpatialIndexItem(inherited Items[Index])
end;

{ TQuadroSector }

constructor TQuadroSector.Create(const aBounds: TDRect);
begin
	inherited Create;
	FBounds := aBounds;
	FItems := TSpatialIndexItemList.Create(True)
end;

destructor TQuadroSector.Destroy;
begin
	FItems.Free;
	inherited;
end;

function TQuadroSector.Split(const anObjectsPerSector: Integer): Boolean;
type
	TChildBounds = array[0..3] of TDRect;

	function AllBoundsEquals: Boolean;
	var
		aBounds: TDRect;
		i: Integer;
	begin
		Result := True;

		aBounds := Items[0].Bounds;
		for i := 1 to Items.Count - 1 do begin
			if not DRectIsEqual(aBounds, Items[i].Bounds) then begin
				Result := False;
				Exit;
			end;
		end;
	end;

	function GetChildBounds(out aChildBounds: TChildBounds): Boolean;
	var
		aCenter: TDPoint;
		i: Integer;
	begin
		Result := (Bounds.DX > 0) and (Bounds.DY > 0);
		if not Result then
			Exit;

		aCenter := Bounds.Center;
		for i := 0 to 3 do begin
			aChildBounds[i] := Bounds;
			with aChildBounds[i] do begin
				if i in [0, 1] then Y1 := aCenter.Y else Y2 := aCenter.Y;
				if i in [1, 3] then X1 := aCenter.X else X2 := aCenter.X;
			end
		end;
	end;

	procedure EnsureChilds(const aChildBounds: TChildBounds);
	begin
		if Assigned(FChilds[0]) then
			Exit;

		FChilds[0] := TQuadroSector.Create(aChildBounds[0]);
		FChilds[1] := TQuadroSector.Create(aChildBounds[1]);
		FChilds[2] := TQuadroSector.Create(aChildBounds[2]);
		FChilds[3] := TQuadroSector.Create(aChildBounds[3]);
	end;

	procedure MoveItems(aSectorIndex: Integer; const aChildBounds: TChildBounds);
	var
		aMoved: Boolean;
		aSectorBound: TDRect;
		anItem: TSpatialIndexItem;
		i: Integer;
	begin
		aMoved := False;

		aSectorBound := aChildBounds[aSectorIndex];
		for i := Items.Count - 1 downto 0 do begin
			anItem := Items[i];
			if DRectContainsRect(aSectorBound, anItem.Bounds) then begin
				EnsureChilds(aChildBounds);
				FChilds[aSectorIndex].Items.Add(Items.Extract(anItem));
				aMoved := True;
			end;
		end;

		if aMoved then
			FChilds[aSectorIndex].Split(anObjectsPerSector);
	end;

var
	aSubBounds: TChildBounds;
begin
	Result := False;
	if Splited or (Items.Count < anObjectsPerSector) or (Items.Count = 0) or AllBoundsEquals then
		Exit;

	if not GetChildBounds(aSubBounds) then
		Exit;

	MoveItems(0, aSubBounds);
	MoveItems(1, aSubBounds);
	MoveItems(2, aSubBounds);
	MoveItems(3, aSubBounds);

	Result := Assigned(FChilds[0]);
end;

function TQuadroSector.Splited: Boolean;
begin
	Result := Assigned(FChilds[0]);
end;

{ TQuadroTree }
constructor TQuadroTree.Create(anItemPerSector: Integer; const aRootSectorRect: TDRect);
begin
	inherited Create;
	FRoot := TQuadroSector.Create(aRootSectorRect);
  FItemPerSector := anItemPerSector;
end;


destructor TQuadroTree.Destroy;
begin
	DeleteSectors;
	inherited;
end;

procedure TQuadroTree.DeleteSectors;
var
	aList: Contnrs.TObjectList;
	aSector: TQuadroSector;
	i: Integer;
begin
	aList := Contnrs.TObjectList.Create(True);
	try
		aList.Capacity := 100;
		
		aList.Add(FRoot);
		while aList.Count > 0 do begin

			for i := aList.Count - 1 downto 0 do begin
				aSector := TQuadroSector(aList[i]);
				if aSector.Splited then begin
					aList.Add(aSector.Childs[0]);
					aList.Add(aSector.Childs[1]);
					aList.Add(aSector.Childs[2]);
					aList.Add(aSector.Childs[3]);
				end;
				aList.Delete(i);
			end;
		end;
	finally
		aList.Free;
	end;
end;


function TQuadroTree.AddItem(const aKey: Integer; const aBounds: TDRect): TSpatialIndexItem;
var
	aSector: TQuadroSector;
begin
	aSector := FindSector(aBounds);
	Result := aSector.Items.Add(TSpatialIndexItem.Create(aKey, aBounds));
	aSector.Split(FItemPerSector);
end;

function TQuadroTree.AddItem(const aPointer: Pointer;
	const aBounds: TDRect): TSpatialIndexItem;
var
	aSector: TQuadroSector;
begin
	aSector := FindSector(aBounds);
	Result := aSector.Items.Add(TSpatialIndexItem.Create(aPointer, aBounds));
	aSector.Split(FItemPerSector);
end;


procedure TQuadroTree.Clear(const aRootSectorRect: TDRect);
begin
	DeleteSectors;
	FRoot := TQuadroSector.Create(aRootSectorRect);
end;

function TQuadroTree.FindSector(const aContainsBounds: TDRect): TQuadroSector;
var
	aTestNext: Boolean;
	i: Integer;
begin
	aTestNext := True;

	Result := FRoot;
	while aTestNext and Result.Splited do begin
		aTestNext := False;
		for i := 0 to 3 do begin
			if DRectContainsRect(Result.Childs[i].Bounds, aContainsBounds) then begin
				Result := Result.Childs[i];
				aTestNext := True;
				Break;
			end;
		end;
	end;
end;



{ TQuadroTreeIntersectSectorEnum }

constructor TQuadroTreeIntersectSectorEnum.Create;
begin
	inherited Create;
	FSectors := TList.Create;
	FSectors.Capacity := 100;
	FSector := nil;
end;

destructor TQuadroTreeIntersectSectorEnum.Destroy;
begin
	FSectors.Free;
	inherited;
end;

function TQuadroTreeIntersectSectorEnum.Next: Boolean;
begin
	Result := FSectors.Count > 0;
	if Result then begin
		FSector := TQuadroSector(FSectors.First);
		FSectors.Delete(0);
	end
	else
		FSector := nil;
end;

procedure TQuadroTreeIntersectSectorEnum.Start(aTree: TQuadroTree; const aRect: TDRect);
var
	aSector: TQuadroSector;
	i, j: Integer;
begin
	FSectors.Clear;
	if DRectIntersectedWith(aRect, aTree.FRoot.Bounds) then
		FSectors.Add(aTree.FRoot);

	i := 0;
	while i < FSectors.Count - 1 do begin
		aSector := FSectors[i];
		if aSector.Splited then begin
			for j := 0 to Length(aSector.Childs) - 1 do begin
				if DRectIntersectedWith(aRect, aSector.Childs[j].Bounds) then
					FSectors.Add(aSector.Childs[j]);
			end;
		end;
		Inc(i);
	end;
	Next;
end;


end.
