unit GeoAlgOpGraph;

interface

uses Windows, GeomCmd, Geomet, Complex, ILists,
		XLists, Classes, Contnrs, SpatialIndexes
		{$IFDEF PROFILE}, TimeCounters{$ENDIF};

const
	OperationsEpsilon = 1E-4;

type
	TDPointList = class
	private
		FPoints: array of TDPoint;
		FCount: Integer;

		FEpsilon: Double;
		FQuadroTree: TQuadroTree;

		function GetPoint(i: Integer): TDPoint;
	public
		constructor Create;
		destructor Destroy; override;

		procedure Clear(const aMaxBounds: TDRect; anEpsilon: Double; aCapacity: Integer);
		function  Add(const aPoint: TDPoint): Integer;
		function  IndexOf(const aPoint: TDPoint): Integer; overload;

		property Points[i: Integer]: TDPoint read GetPoint; default;
		property Count: Integer read FCount;
	end;

	TConnectBriefList = class
	private
		FItems: array of TGConnectBrief;
		FCount: Integer;

		FQuadroTree: TQuadroTree;
		FPoints: TDPointList;

		function GetItem(i: Integer): TGConnectBrief;
		function GetCbBounds(cb: TGConnectBrief): TDRect;
	public
		constructor Create(aPoints: TDPointList);
		destructor Destroy; override;

		procedure Clear(const aBounds: TDRect; aCapacity: Integer);
		function Add(const pt: TGConnectBrief): Integer;
		function IndexOf(const pt: TGConnectBrief): Integer;
		property Items[i: Integer]: TGConnectBrief read GetItem; default;
	end;

	TComplexPart = class(TContour)
	private
		FBounds: TDRect;
	public
		constructor Create(aContour: TContour; const aBounds: TDRect);

		function ContainsPoint(const aPoint: TDPoint): Boolean;
	end;

	TComplexPartList = class(TObjectList)
	private
		FBounds: TDRect;
		FBoundsAssigned: Boolean;
	public
		constructor Create;

		procedure Assign(aContour: TContour);
		function ContainsPoint(const aPoint: TDPoint): Boolean;
	end;

type
	TGOperationType = (gotInclude, gotExclude, gotSomeclude);
	TGOperationTable = array [0..3, 0..3] of TGOperationType;
	TGOperationPriority = array[0..3, 0..3] of Integer;

	type TGBoolOperation = ( gboOR, gboAND, gboSUB, gboXOR);
	TGUnionGraph = class
	private
		FErrorList: TStrings;
		FEpsilon: Double;

		procedure AddError(const s: String);
	protected
		bepList : TGBelongEdgePairList;
		rectList : TTDRectList;

		FPointList: TDPointList; // список точек
		FEdgeList: TConnectBriefList; // общий список ребер, вместо координат точек используется ссылки на FPointList
		FEdgeChainList: TGConnectLongList; // список цепочек ребер
		FContourEdges: array[0..1] of TLongintList; // список ребер (ссылок на FEdgeList) принадлежащих заданному контуру

		ptFirst,ptLast: TDPoint;
		boolAnyConnect: Boolean;
		OperationPriority: TGOperationPriority;

		FComplexParts: array[0..1] of TComplexPartList;

		function AddPoint(const pt: TDPoint):Integer;
		function AddConnectBrief(cb: TGConnectBrief; indexShape: Integer;
			const bep: TGBelongEdgePair):Integer; overload;
		function AddConnectBrief(cb: TGConnectBrief; indexShape: Integer;
			anIsHole: Boolean):Integer; overload;

		function SmartCBListIndexOf(const cb: TGConnectBrief):Integer;

		procedure AddEdge(indexShape: Integer; const anEdge: TDEdge; anIsHole: Boolean);
		function MakeGConnectBrief(const cf:TGConnectFull): TGConnectBrief;
		function BelongInfoOnePoint(const pt: TDPoint;
																	cbiIndex: Integer): TGBelongType;
		function IndexOfEdge(const edgeFind: Integer): Integer;
		function GetBelongEdge(const cb: TGConnectBrief; cbiIndex :Integer):
																																	TGBelongType;
		procedure MakeBelongEdgeInfo;
		function SplitTwoEdges(iEdge1, iEdge2: Integer): Boolean;
		procedure SplitAllEdges;
		function GetOperationType(const bp: TGBelongPair): TGOperationType;
		function GetOperationPriority(const bp: TGBelongPair): Integer;
		procedure CheckCBIndex(i: Integer);
		function PruneNumLongEdges: Boolean;
		function PruneNumLongEdgesBig: Boolean;
		procedure PruneNumLongEdgesAllPrepare;
		procedure PruneNumLongEdgesAllOperation;
		function MakeGConnectFull(const cb:TGConnectBrief): TGConnectFull;
		function Connect(i1, i2: Integer): Boolean;
		procedure ExcludeEdges;
		function ArrangeOneEdge(cl: TGConnectLong; var clTo: TGConnectLong;
																				pt: Integer; var ptNext: Integer): Boolean;
		procedure ArrangeConnectLong(var cl: TGConnectLong);
		procedure ArrangeInConnectLongList(clList: TGConnectLongList);
		procedure OperationCommon( const _OperationPriority: TGOperationPriority);
		procedure AddFromConnectLongToTComplex(complex: TContour; cl: TGConnectLong);
		procedure MakeComplexRes(contourRes: TContour);
		procedure Prepare;
		procedure AddContour(complex: TContour; aShapeIndex: Integer);
	public
		constructor Create(anErrorList: TStrings);
		destructor Destroy;override;
		procedure Operation(op: TGBoolOperation);
		procedure AddComplexes(complex1, complex2: TContour; anEpsilon: Double);
	end;

	TGUnionGraphBig = class
	private
		FErrorList: TStrings;
		FIgnoreSingularContours: Boolean;
		FEpsilon: Double;
	protected

		operation: TGBoolOperation;
		boolFirst: Boolean;
	public
		contourRes: TContour;
		constructor Create(anErrorList: TStrings; anEpsilon: Double);
		destructor Destroy;override;

		procedure Clear;
		procedure AddContour(complex: TContour);
		procedure SetOperation(op: TGBoolOperation);
		property  IgnoreSingularContours: Boolean read FIgnoreSingularContours write FIgnoreSingularContours;
	end;

implementation

uses Math, SysUtils;

{$IFDEF PROFILE}
var
	CounterAddComplexes: TTimeCounter;
	CounterPrepare: TTimeCounter;
	CounterOperation: TTimeCounter;
	CounterSplit: TTimeCounter;
	CounterBelongEdge: TTimeCounter;
	CounterBelongPoint: TTimeCounter;
	CounterPruneNum: TTimeCounter;
{$ENDIF}
const
	kExclude  = -1;
	kError    = -2;

	cgopOR : TGOperationPriority = (
		( kError,   kError, kExclude, kExclude  ),
		( kError,   kError, 0,        0         ),
		( kExclude, 0,      1,        kExclude  ),
		( kExclude, 0,      kExclude, 1         )
		);
	cgopAND : TGOperationPriority = (
		( kError, kError,   0,        0        ),
		( kError, kError,   kExclude, kExclude ),
		( 0,      kExclude, 1,        kExclude ),
		( 0,      kExclude, kExclude, 1        )
		);
	cgopSUB : TGOperationPriority = (
		( kError,   kError, 0,        0),
		( kError,   kError, kExclude, kExclude ),
		( kExclude, 0,      kExclude, 1        ),
		( kExclude, 0,      1,        kExclude )
		);
	cgopXOR : TGOperationPriority = (
		( kError, kError, 1,        1       ),
		( kError, kError, 0,        0       ),
		( 1,       0,     kExclude, kExclude  ),
		( 1,       0,     kExclude, kExclude  )
		);

procedure CheckBounds(anIndex, aCount: Integer);
begin
	Assert((anIndex >= 0) and (anIndex < aCount));
	if not ((anIndex >= 0) and (anIndex < aCount)) then
		raise Exception.CreateFmt('Index "%d" out of bounds [%d, %d)', [anIndex, 0, aCount]);
end;

constructor TGUnionGraph.Create(anErrorList: TStrings);
begin
	FErrorList := anErrorList;
	FPointList := TDPointList.Create;
	FEdgeList := TConnectBriefList.Create(FPointList);
	rectList := TTDRectList.Create;
	FContourEdges[0] := TLongintList.Create;
	FContourEdges[1] := TLongintList.Create;

	FEdgeChainList := TGConnectLongList.Create;

	bepList :=  TGBelongEdgePairList.Create;
	FComplexParts[0] := TComplexPartList.Create;
	FComplexParts[1] := TComplexPartList.Create;
end;

destructor TGUnionGraph.Destroy;
begin
	bepList.Free;
	FPointList.Free;

	FEdgeChainList.Free;
	FEdgeList.Free;
	rectList.Free;
	FContourEdges[0].Free;
	FContourEdges[1].Free;
	FComplexParts[0].Free;
  FComplexParts[1].Free;
end;

procedure TGUnionGraph.AddError(const s: String);
begin
	if Assigned(FErrorList) then
		FErrorList.Add(s);
end;

function TGUnionGraph.AddPoint(const pt: TDPoint):Integer;
begin
	Result := FPointList.IndexOf(pt);
	if Result < 0 then
		Result := FPointList.Add(pt);
end;

function TGUnionGraph.SmartCBListIndexOf(const cb: TGConnectBrief):Integer;
begin
	Result := FEdgeList.IndexOf(cb);
	if Result < 0 then
		Result := FEdgeList.IndexOf(ReverseConnectBrief(cb));
end;

function InvertBEP(const bep: TGBelongEdgePair): TGBelongEdgePair;
var
	i: Integer;
begin
	for i := 0 to 1 do
		case bep.aBelong[i] of
			gbeNot:
				Result.aBelong[i] := gbeNot;
			gbeBoundObject:
				Result.aBelong[i] := gbeBoundHole;
			gbeBoundHole:
				Result.aBelong[i] := gbeBoundObject;
		end;
end;


function TGUnionGraph.AddConnectBrief(cb: TGConnectBrief; indexShape: Integer;
	const bep: TGBelongEdgePair):Integer;
var
	index: Integer;
	bep2, bepNew: TGBelongEdgePair;
	rectBounds: TDRect;
	cf: TGConnectFull;
begin
	if cb.Pt1 = cb.Pt2 then
		raise Exception.Create('PtFrom = PtTo in Command');

	if (cb.ConnectType = gctArc) and (abs(cb.Arc.Convexity) < kMinZone) then
		cb.Arc.Convexity := 0;

	index := SmartCBListIndexOf(cb);
	if index < 0 then begin
		cf := MakeGConnectFull(cb);
		rectBounds := GetBoundsOfConnectFull(cf);
		rectList.Add(rectBounds);
		index := FEdgeList.Add(cb);
		bepList.Add(bep)
	end
	else begin
		if CompareTGConnectBriefNotStrict(cb, FEdgeList[index]) <> 0 then
			bepNew := InvertBEP(bep)
		else
			bepNew := bep;

		bep2 := bepList[index];
		if bep2.aBelong[indexShape] = gbeNot then begin
			if (bepNew.aBelong[1-indexShape] <> gbeNot) and
				 (bep2.aBelong[1-indexShape] <> bepNew.aBelong[1-indexShape])
			then
				raise Exception.Create('AddConnectBrief'); // maybe need add more conbditions;

			bep2.aBelong[indexShape] := bepNew.aBelong[indexShape];
		end
		else begin
			AddError('Ребро обходится дважды');

			bep2.aBelong[indexShape] := gbeNot;
			Result := FContourEdges[indexShape].IndexOf(index);
			if Result < 0 then
				raise Exception.Create('TGUnionGraph.AddConnectBrief: Ребро обходится дважды(коллизия) ');
			FContourEdges[indexShape].Delete(Result);
			Exit;
		end;
		bepList[index] := bep2;
	end;

	Result := FContourEdges[indexShape].IndexOf(index);
	if Result < 0 then
		Result := FContourEdges[indexShape].Add(index);
end;

// boolSetBEP = False
function TGUnionGraph.AddConnectBrief(cb: TGConnectBrief; indexShape: Integer;
	anIsHole: Boolean):Integer;
var
	index: Integer;
	bep: TGBelongEdgePair;
	boolCurrentHoleTmp: Boolean;
	rectBounds: TDRect;
	cf: TGConnectFull;
begin
	if cb.Pt1 = cb.Pt2 then
		raise Exception.Create('PtFrom = PtTo in Command');

	if (cb.ConnectType = gctArc) and (abs(cb.Arc.Convexity) < kMinZone) then
		cb.Arc.Convexity := 0;

	index := SmartCBListIndexOf(cb);
	if index < 0 then begin
		cf := MakeGConnectFull(cb);
		rectBounds := GetBoundsOfConnectFull(cf);
		rectList.Add(rectBounds);
		index := FEdgeList.Add(cb);

		bep.aBelong[1-indexShape] := gbeNot;
		if anIsHole then
			bep.aBelong[indexShape] := gbeBoundHole
		else
			bep.aBelong[indexShape] := gbeBoundObject;
		bepList.Add(bep);
	end
	else begin
		if CompareTGConnectBriefNotStrict(cb, FEdgeList[index]) <> 0 then
			boolCurrentHoleTmp := not anIsHole
		else
			boolCurrentHoleTmp := anIsHole;

		bep := bepList[index];
		if bep.aBelong[indexShape] = gbeNot then begin
			if boolCurrentHoleTmp then
				bep.aBelong[indexShape] := gbeBoundHole
			else
				bep.aBelong[indexShape] := gbeBoundObject
		end
		else begin
			AddError('Ребро обходится дважды');

			bep.aBelong[indexShape] := gbeNot;
			Result := FContourEdges[indexShape].IndexOf(index);
			if Result < 0 then
				raise Exception.Create('TGUnionGraph.AddConnectBrief: Ребро обходится дважды(коллизия) ');
			FContourEdges[indexShape].Delete(Result);
			Exit;
		end;
		bepList[index] := bep;
	end;

	Result := FContourEdges[indexShape].IndexOf(index);
	if Result < 0 then
		Result := FContourEdges[indexShape].Add(index);
end;


procedure TGUnionGraph.CheckCBIndex(i: Integer);
begin
	if (i < 0) or (i > 1) then
		raise Exception.Create('Incorrect CBIndex');
end;

procedure TGUnionGraph.AddEdge(indexShape: Integer; const anEdge: TDEdge; anIsHole: Boolean);
var
	cb: TGConnectBrief;
begin
	cb.Pt1 := AddPoint(anEdge.P1);
	cb.Pt2 := AddPoint(anEdge.P2);
	if cb.Pt1 = cb.Pt2 then
		Exit;

	if anEdge.IsLine then
		cb.ConnectType := gctLine
	else begin
		cb.ConnectType := gctArc;
		cb.Arc.Convexity := anEdge.C;
	end;
	AddConnectBrief(cb, indexShape, anIsHole);
end;

procedure TGUnionGraph.AddContour(complex: TContour; aShapeIndex: Integer);
var
	shapeList: TList;
	nestingList: TLongintList;
	anEdge: TContourEdgeEnum;
	anIsHole: Boolean;
	j: Integer;
begin
	CheckCBIndex(aShapeIndex);
	FComplexParts[aShapeIndex].Assign(complex);
	shapeList := TList.Create;
	try
		SplitContourToShapes(complex, shapeList);
		nestingList := TLongintList.Create;
		try
			GetShapesNesting(shapeList, nestingList);
			for j := 0 to shapeList.Count - 1 do begin
				anIsHole := ((nestingList[j] and 1) = 1) xor
								IsComplexClockWise(TContour(shapeList[j]));

				anEdge.Init(shapeList[j]);
				while not anEdge.EndOfContour do begin
					AddEdge(aShapeIndex, anEdge, anIsHole);
					anEdge.Next;
				end;
			end;
		finally
			nestingList.Free;
		end
	finally
		FreeListAndItems(shapeList);
	end;
end;

procedure TGUnionGraph.AddComplexes(complex1, complex2: TContour; anEpsilon: Double);
var
	aBounds1, aBounds2: TDRect;
	aBounds: TDRect;
	aMin: Double;
begin
	if not complex1.GetBounds(aBounds1) then
		aBounds1.Clear;

	if not complex2.GetBounds(aBounds2) then
		aBounds2.Clear;

	aMin := MinValue([aBounds1.DX, aBounds1.DY, aBounds2.DX, aBounds2.DY]);

	if aMin < 1e-8 then
		raise Exception.Create('Размер контура по одной из осей меньше чем 1e-8');

	dMinZone := aMin*kMinZone;
	aBounds := aBounds1;
	DRectUnionWith(aBounds, aBounds2);

	FEpsilon := anEpsilon;

	FPointList.Clear(aBounds, dMinZone, complex1.PointCount + complex2.PointCount);
	FEdgeList.Clear(aBounds, complex1.PointCount + complex2.PointCount);

	AddContour(complex1, 0);
	AddContour(complex2, 1);
end;

function TGUnionGraph.SplitTwoEdges(iEdge1, iEdge2: Integer): Boolean;

	function SplitOneEdge(index: Integer;ptIndex: Integer;
																									 indexShape: Integer): Boolean;
	var
		cb: TGConnectBrief;
		cf, cf1, cf2: TGConnectFull;
		pt: TDpoint;
		bep: TGBelongEdgePair;
		cb1, cb2: TGConnectBrief;
	begin
		Result := False;
		cb := FEdgeList[FContourEdges[indexShape][index]];
		bep := bepList[FContourEdges[indexShape][index]];

		if (ptIndex = cb.Pt1) or (ptIndex = cb.Pt2) then
			Exit;

		pt := FPointList[ptIndex];
		cf := MakeGConnectFull(cb);

		if not SplitConnectFull(cf, pt, cf1, cf2, FEpsilon) then
			Exit;

		cb1 := MakeGConnectBrief(cf1);
		cb2 := MakeGConnectBrief(cf2);

		FContourEdges[indexShape].Delete(index);
		AddConnectBrief(cb1, indexShape, bep);
		AddConnectBrief(cb2, indexShape, bep);
		Result := True;
	end;

var
	pt: TDPoint;
	cb1,cb2: TGConnectBrief;
	ptIndex, realEdge1, realEdge2 : Integer;
	boolResult1, boolResult2: Boolean;
	rect1, rect2: TDRect;
begin
	Result := False;
	realEdge1 := FContourEdges[0][iEdge1];
	realEdge2 := FContourEdges[1][iEdge2];

	if realEdge1 = realEdge2 then
		Exit;

	rect1 := rectList[realEdge1];
	rect2 := rectList[realEdge2];
	rect1.Inflate(dMinZone, dMinZone);

	if (not DRectIntersectedWith(rect1, rect2)) then
		Exit;

	cb1 := FEdgeList[realEdge1];
	cb2 := FEdgeList[realEdge2];

	if not IntersectConnects(MakeGConnectFull(cb1), MakeGConnectFull(cb2), pt) then
		Exit;

	ptIndex := AddPoint(pt);

	boolResult1 := SplitOneEdge(iEdge1, ptIndex, 0);
	boolResult2 := SplitOneEdge(iEdge2, ptIndex, 1);
	Result := boolResult1 or boolResult2;
end;

procedure TGUnionGraph.SplitAllEdges;
var
	iEdge1, iEdge2 : Integer;
begin
	iEdge1 := 0;
	while iEdge1 < FContourEdges[0].Count do begin
		iEdge2 := 0;
		while iEdge2 < FContourEdges[1].Count do begin
			if SplitTwoEdges(iEdge1, iEdge2) then begin
				iEdge2 := 0;
			end
			else
				inc(iEdge2);
		end;
		inc(iEdge1);
	end;
end;


function TGUnionGraph.MakeGConnectFull(const cb:TGConnectBrief): TGConnectFull;
begin
	Result.Pt1 := FPointList[cb.Pt1];
	Result.Pt2 := FPointList[cb.Pt2];
	Result.ConnectType := cb.ConnectType;
	if cb.ConnectType = gctArc then
		Result.Arc.Convexity := cb.Arc.Convexity;
end;

function TGUnionGraph.MakeGConnectBrief(const cf:TGConnectFull): TGConnectBrief;
begin
	Result.Pt1 := FPointList.IndexOf(cf.Pt1);
	Result.Pt2 := FPointList.IndexOf(cf.Pt2);
	if (Result.Pt1 < 0) or (Result.Pt2 < 0) then raise Exception.Create('MakeGConnectBrief net tochek');
	Result.ConnectType := cf.ConnectType;
	if cf.ConnectType = gctArc then
		Result.Arc.Convexity := cf.Arc.Convexity;
end;

function TGUnionGraph.BelongInfoOnePoint(const pt: TDPoint;
																	cbiIndex: Integer): TGBelongType;
begin
{$IFDEF PROFILE}	CounterBelongPoint.Start; {$ENDIF}
	if FComplexParts[cbiIndex].ContainsPoint(pt) then
		Result := cbtInside
	else
		Result := cbtOutside;
{$IFDEF PROFILE}	CounterBelongPoint.Stop; {$ENDIF}
end;

function TGUnionGraph.IndexOfEdge(const edgeFind: Integer): Integer;
begin
	for Result := 0 to FEdgeChainList.Count-1 do begin
		if FEdgeChainList[Result].edgeList.IndexOf(edgeFind) <> -1 then
			Exit;
	end;
	Result := -1;
end;

function ConvertFromBelongEdgeToBelongType(const be: TGBelongEdge):TGBelongType;
begin
	if be = gbeBoundObject then
		Result := cbtBoundObject
	else if be = gbeBoundHole then
		Result := cbtBoundHole
	else raise Exception.Create('ConvertFromBelongEdgeToBelongType');
end;

function TGUnionGraph.GetBelongEdge(const cb: TGConnectBrief; cbiIndex :Integer):
																																	TGBelongType;
var
	index,indexEdge: Integer;
begin
{$IFDEF PROFILE}	CounterBelongEdge.Start; {$ENDIF}
	indexEdge := SmartCBListIndexOf(cb);
	index := FContourEdges[cbiIndex].IndexOf(indexEdge);
	if index >= 0 then
		Result := ConvertFromBelongEdgeToBelongType(bepList[indexEdge].aBelong[cbiIndex])
	else
		Result := BelongInfoOnePoint(GetAnyOfConnectFull(MakeGConnectFull(cb)), cbiIndex);

{$IFDEF PROFILE}	CounterBelongEdge.Stop; {$ENDIF}
end;


procedure TGUnionGraph.MakeBelongEdgeInfo;
var
	iShape, iEdge, index, edgeIndex: Integer;
	cl: TGConnectLong;
begin
{$IFDEF PROFILE}	CounterSplit.Start; {$ENDIF}
	SplitAllEdges;
{$IFDEF PROFILE}	CounterSplit.Stop; {$ENDIF}
	for iShape := 0 to 1 do
		for iEdge := 0 to FContourEdges[iShape].Count-1 do begin
			edgeIndex := FContourEdges[iShape][iEdge];
			index := IndexOfEdge(edgeIndex); // test this function
			if index >= 0 then begin
				cl := FEdgeChainList[index];
				cl.BelongPair.aBelong[iShape] :=
					ConvertFromBelongEdgeToBelongType(bepList[edgeIndex].aBelong[iShape]);
				FEdgeChainList[index] := cl;
			end
			else with FEdgeList[edgeIndex] do begin
				cl.Create;
				cl.Pt1 := Pt1;
				cl.Pt2 := Pt2;
				cl.edgeList.Add(edgeIndex);
				cl.BelongPair.aBelong[iShape] :=
					ConvertFromBelongEdgeToBelongType(bepList[edgeIndex].aBelong[iShape]);
				cl.BelongPair.aBelong[1-iShape] :=
													GetBelongEdge(FEdgeList[edgeIndex], 1-iShape);
				FEdgeChainList.Add(cl);
			end;
		end;
end;

function TGUnionGraph.Connect(i1, i2: Integer): Boolean;
var
	cl1,cl2 : TGConnectLong;
	i: Integer;
begin
	Result := False;
	cl1 := FEdgeChainList[i1];
	cl2 := FEdgeChainList[i2];
	if (not boolAnyConnect) and (not cl1.BelongPair.IsEqual(cl2.BelongPair)) then
		Exit;
	if (cl1.Pt1 = cl2.Pt1) then        cl1.Pt1 := cl2.Pt2
	else if (cl1.Pt1 = cl2.Pt2) then   cl1.Pt1 := cl2.Pt1
	else if (cl1.Pt2 = cl2.Pt1) then   cl1.Pt2 := cl2.Pt2
	else if (cl1.Pt2 = cl2.Pt2) then   cl1.Pt2 := cl2.Pt1
	else raise Exception.Create('Stranno');
	for i := 0 to cl2.edgeList.Count-1 do
		cl1.edgeList.Add(cl2.edgeList[i]);
	FEdgeChainList[i1] := cl1;
	FEdgeChainList.DeleteDestroy(i2);
	Result := True;
end;

type
	PXIntegerArray = ^TXIntegerArray;
	TXIntegerArray = array [0..MaxInt div sizeof(Integer) - 1] of Integer;

function TGUnionGraph.PruneNumLongEdges: Boolean;
var
	numNeighbours: array of Integer;
	iEdgeLong: Integer;
	finded: Integer;
	i, j: Integer;
	aFinded: array[0..1] of Integer;
const
	kMore2 :Integer = 3;
begin
	Result := False;
	SetLength(numNeighbours, FPointList.Count);

	for iEdgeLong := 0 to FEdgeChainList.Count-1 do
		with FEdgeChainList[iEdgeLong] do begin
			if Pt1 = Pt2 then
				numNeighbours[Pt1] := kMore2;

			Inc(numNeighbours[Pt1]);
			Inc(numNeighbours[Pt2]);
		end;

	for i := 0 to FPointList.Count - 1 do begin
		if (numNeighbours[i] = 2) then begin
			finded := 0;
			for j := 0 to FEdgeChainList.Count-1 do begin
				if (FEdgeChainList[j].Pt1 = i) or (FEdgeChainList[j].Pt2 = i) then begin
					aFinded[finded] := j;
					Inc(finded);
					if finded = 2 then
						break;
				end;
			end;
			if finded <> 2 then raise Exception.Create('Very Bad');
			if Connect(aFinded[0], aFinded[1]) then begin
				Result := True;
				Exit;
			end;
		end;
	end;
end;

function TGUnionGraph.PruneNumLongEdgesBig: Boolean;
var
	numNeighbours: array of Integer;
	finded,iEdgeLong: Integer;
	i, j, priority: Integer;
	aFinded: array[0..1] of Integer;
	aMin: array[0..1] of Integer;
begin
	Result := False;
	SetLength(numNeighbours, FPointList.Count);

	for iEdgeLong := 0 to FEdgeChainList.Count-1 do
		with FEdgeChainList[iEdgeLong] do begin
			if Pt1 = Pt2 then
				Continue;
			numNeighbours[Pt1] := numNeighbours[Pt1] + 1;
			numNeighbours[Pt2] := numNeighbours[Pt2] + 1;
		end;

	for i := 0 to FPointList.Count-1 do begin
 //   if( numNeighbours[i] = 2) then raise Exception.Create(' numNeighbours[i] = 2 ');
		if( numNeighbours[i] >= 2) then begin
			finded := 0;
			aMin[0] := 99999;
			aMin[1] := 99999;
			for j := 0 to FEdgeChainList.Count-1 do begin
				if (FEdgeChainList[j].Pt1 = FEdgeChainList[j].Pt2) then               Continue;
				if (FEdgeChainList[j].Pt1 <> i) and (FEdgeChainList[j].Pt2 <> i) then Continue;
				priority := GetOperationPriority(FEdgeChainList[j].BelongPair);
				if priority >= aMin[0] then Continue;
				if priority < aMin[1] then begin
					aFinded[0] := aFinded[1];
					aMin[0] := aMin[1];
					aFinded[1] := j;
					aMin[1] := priority;
				end
				else begin
					aFinded[0] := j;
					aMin[0] := priority;
				end;
				inc(finded);
			end;
			if finded < 2 then raise Exception.Create('Very Bad: finded < 2 ');
			if Connect(aFinded[0],aFinded[1]) then begin
				Result := True;
				Exit;
			end;
		end;
	end;
end;

function TGUnionGraph.GetOperationType(const bp: TGBelongPair): TGOperationType;
var
	priority: Integer;
begin
	priority := OperationPriority[ord(bp.aBelong[0]), ord(bp.aBelong[1])];
	if priority = kError  then raise Exception.Create('Priority = error');
	if priority = kExclude then Result := gotExclude
	else                        Result := gotInclude;
end;

function TGUnionGraph.GetOperationPriority(const bp: TGBelongPair): Integer;
begin
	Result := OperationPriority[ord(bp.aBelong[0]), ord(bp.aBelong[1])];
	if Result < 0  then raise Exception.Create('Priority < 0');
end;

procedure TGUnionGraph.ExcludeEdges;
var
	iEdgeLong: Integer;
begin
	iEdgeLong := 0;
	while(iEdgeLong < FEdgeChainList.Count) do
		with FEdgeChainList[iEdgeLong] do begin
			if GetOperationType(BelongPair) = gotExclude then
				FEdgeChainList.DeleteDestroy(iEdgeLong)
			else
				inc(iEdgeLong);
		end;
end;

procedure TGUnionGraph.PruneNumLongEdgesAllPrepare;
begin
	while PruneNumLongEdges do;
end;

procedure TGUnionGraph.PruneNumLongEdgesAllOperation;
begin
	ExcludeEdges;
	while PruneNumLongEdges do;
	while PruneNumLongEdgesBig do;
end;

function TGUnionGraph.ArrangeOneEdge(cl: TGConnectLong; var clTo: TGConnectLong;
																				pt: Integer; var ptNext: Integer): Boolean;
var
	iEdge: Integer;
begin
	for iEdge := 0 to cl.edgeList.Count-1 do begin
		with FEdgeList[cl.edgeList[iEdge]] do begin
			if (Pt1 = pt)       then ptNext := Pt2
			else if (Pt2 = pt)  then ptNext := Pt1
			else Continue;
			clTo.edgeList.Add(cl.edgeList[iEdge]);
			cl.edgeList.Delete(iEdge);
			Result := True;
			Exit;
		end;
	end;
	Result := False;
end;

procedure TGUnionGraph.ArrangeConnectLong(var cl: TGConnectLong);
var
	clTmp: TGConnectLong;
	ptLast, ptNext : Integer;
begin
	clTmp.Create;
	clTmp.Pt1 := cl.Pt1;
	clTmp.Pt2 := cl.Pt2;
	clTmp.BelongPair := cl.BelongPair;
	PtLast := cl.Pt1;
	while cl.edgeList.Count > 0 do begin
		if not ArrangeOneEdge(cl,clTmp,ptLast,ptNext) then
			raise Exception.Create('Error ArrangeConnectLong');
		ptLast := ptNext;
	end;
	cl.Destroy;
	cl := clTmp;
end;

procedure TGUnionGraph.ArrangeInConnectLongList(clList: TGConnectLongList);
var
	cl: TGConnectLong;
	i : Integer;
begin
	for i := 0 to clList.Count - 1 do begin
		cl := clList[i];
		ArrangeConnectLong(cl);
		clList[i] := cl;
	end;
end;

procedure TGUnionGraph.Prepare;
begin
	BoolAnyConnect := False;
	MakeBelongEdgeInfo;
{$IFDEF PROFILE}	CounterPruneNum.Start; {$ENDIF}
	PruneNumLongEdgesAllPrepare;
{$IFDEF PROFILE}	CounterPruneNum.Stop; {$ENDIF}
end;

procedure TGUnionGraph.OperationCommon( const _OperationPriority: TGOperationPriority);
begin
	OperationPriority := _OperationPriority;
	BoolAnyConnect := True;
	PruneNumLongEdgesAllOperation;

	arrangeInConnectLongList(FEdgeChainList);
end;

procedure TGUnionGraph.Operation(op: TGBoolOperation);
begin
	case op of
		gboOR:
			OperationCommon(cgopOR);
		gboAND:
			OperationCommon(cgopAND);
		gboSUB:
			OperationCommon(cgopSUB);
		gboXOR:
			OperationCommon(cgopXOR);
		else
			raise Exception.Create('Bad Operation');
	end;
end;

procedure TGUnionGraph.AddFromConnectLongToTComplex(complex: TContour; cl: TGConnectLong);
var
	ptLast,iEdge: Integer;
	boolRev : Boolean;
	Point1,Point2: TDPoint;
	cb: TGConnectBrief;
	aDistance: Double;
begin
	if cl.Pt1 <> cl.Pt2 then begin
		aDistance := FPointList[cl.Pt1].DistanceFrom(FPointList[cl.Pt2]);
		if aDistance < FEpsilon then
			cl.Pt2 := cl.Pt1
		else
			Exit;
	end;
	ptLast:= cl.Pt1;
	Point1 := FPointList[ptLast];
	complex.AddCommand(ContourMoveTo(Point1));
	for iEdge:= 0 to cl.edgeList.Count - 1 do begin
		with FEdgeList[cl.edgeList[iEdge]] do begin
			if (Pt1 = ptLast) then       boolRev := False
			else if (Pt2 = ptLast)  then boolRev := True
			else raise Exception.Create('Bad Connect long');
			cb := FEdgeList[cl.edgeList[iEdge]];
			if boolRev then
				cb := ReverseConnectBrief(cb);
			Point1 := FPointList[cb.Pt1];
			Point2 := FPointList[cb.Pt2];
			ptLast := cb.Pt2;
			if cb.ConnectType = gctLine then
				if iEdge < cl.edgeList.Count - 1 then
					complex.AddCommand(ContourLineTo(Point2))
				else
					complex.AddCommand(ContourCloseByLine)
			else
				if iEdge < cl.edgeList.Count - 1 then
					complex.AddCommand(ContourArcTo(Point2,cb.Arc.Convexity))
				else
					complex.AddCommand(ContourCloseByArc(cb.Arc.Convexity));
		end;
	end;
end;

procedure TGUnionGraph.MakeComplexRes(contourRes: TContour);
var
	i: Integer;
begin
	for i := 0 to FEdgeChainList.Count - 1 do
		AddFromConnectLongToTComplex(contourRes, FEdgeChainList[i]);
end;

constructor TGUnionGraphBig.Create(anErrorList: TStrings; anEpsilon: Double);
begin
	FErrorList := anErrorList;
  FEpsilon := anEpsilon;
	contourRes := TContour.Create;
	boolFirst := True;
end;

destructor TGUnionGraphBig.Destroy;
begin
	contourRes.Free;
end;

procedure TGUnionGraphBig.Clear;
begin
	contourRes.Clear;
	boolFirst := True;
end;

procedure TGUnionGraphBig.SetOperation(op: TGBoolOperation);
begin
	operation := op;
end;

procedure TGUnionGraphBig.AddContour(complex: TContour);

	function IsSingularContour(aContour: TContour): Boolean;
	var
		aBounds: TDRect;
	begin
		Result := not aContour.GetBounds(aBounds);
		if not Result then
			Result := min(aBounds.DX, aBounds.DY) < 1E-8;
	end;

var
	graph: TGUnionGraph;
	complexRes2: TContour;
begin
	if FIgnoreSingularContours and IsSingularContour(complex) then
		Exit;

	if boolFirst then begin
		contourRes.Assign(complex);
		boolFirst := False;
	end
	else begin
		complexRes2 := TContour.Create;
		try
			graph := TGUnionGraph.Create(FErrorList);
			try
{$IFDEF PROFILE} 	CounterAddComplexes.Start; {$ENDIF}
				graph.AddComplexes(contourRes, complex, FEpsilon);
{$IFDEF PROFILE}	CounterAddComplexes.Stop; {$ENDIF}

{$IFDEF PROFILE} CounterPrepare.Start; {$ENDIF}
				graph.Prepare;
{$IFDEF PROFILE} CounterPrepare.Stop;{$ENDIF}

{$IFDEF PROFILE} CounterOperation.Start; {$ENDIF}
				graph.Operation(operation);
{$IFDEF PROFILE} CounterOperation.Stop; {$ENDIF}

				graph.MakeComplexRes(complexRes2);
			finally
				graph.Free;
			end;
		finally
			if FIgnoreSingularContours and IsSingularContour(complexRes2) then 
				complexRes2.Free
			else begin
				contourRes.Free;
				contourRes := complexRes2;
			end;
		end;
	end;
end;

{ TDPointList }

constructor TDPointList.Create;
begin
	inherited Create;
	FQuadroTree := TQuadroTree.Create(10, DRect(-1000000, 100000, 100000, 100000));
	FEpsilon := kMinZone;
	SetLength(FPoints, 0);
	FCount := 0;
end;

destructor TDPointList.Destroy;
begin
	FQuadroTree.Free;
	inherited;
end;

procedure TDPointList.Clear(const aMaxBounds: TDRect; anEpsilon: Double; aCapacity: Integer);
begin
	SetLength(FPoints, Max(0, aCapacity));
	FQuadroTree.Clear(aMaxBounds);
  FEpsilon := anEpsilon;
	FCount := 0;
end;

function TDPointList.Add(const aPoint: TDPoint): Integer;
var
	aBounds: TDRect;
begin
	if FCount >= Length(FPoints) then
		SetLength(FPoints, Max(1, Length(FPoints))*2);
	Result := FCount;
	FPoints[Result] := aPoint;

	aBounds.Assign(aPoint.x, aPoint.y, aPoint.x, aPoint.y);
	aBounds.Inflate(FEpsilon, FEpsilon);
	FQuadroTree.AddItem(Result, aBounds);

	Inc(FCount);
end;

function TDPointList.GetPoint(i: Integer): TDPoint;
begin
	CheckBounds(i, FCount);
	Result := FPoints[i];
end;

function TDPointList.IndexOf(const aPoint: TDPoint): Integer;
var
	aSector: TQuadroSector;
	aBounds: TDRect;
	aMin, aTemp: Double;
	i, j: Integer;
begin
	aMin := 0;
	aBounds.Assign(aPoint.x, aPoint.y, aPoint.x, aPoint.y);
	aBounds.Inflate(FEpsilon, FEpsilon);

	aSector := FQuadroTree.FindSector(aBounds);

	Result := -1;
	if Assigned(aSector) and (aSector.Items.Count > 0) then begin
		j := -1;
		for i := 0 to aSector.Items.Count - 1 do begin
			Result := aSector.Items[i].Key;
			if FPoints[Result].IsEqual(aPoint) then
				Exit;

			if FPoints[Result].CloselyTo(aPoint, FEpsilon) then begin
				aTemp := FPoints[Result].DistanceFrom(aPoint);
				if (j = -1) or (aTemp < aMin) then begin
					aMin := aTemp;
					j := Result;
				end;
			end;
		end;
		Result := j;
	end;
end;

{ TConnectBriefList }

constructor TConnectBriefList.Create(aPoints: TDPointList);
begin
	inherited Create;
	FQuadroTree := TQuadroTree.Create(10, DRect(-1000000, -1000000, 1000000, 1000000));
	FPoints := aPoints;
	FCount := 0;
end;

destructor TConnectBriefList.Destroy;
begin
	FQuadroTree.Free;
	inherited;
end;

function TConnectBriefList.Add(const pt: TGConnectBrief): Integer;
begin
	if FCount >= Length(FItems) then
		SetLength(FItems, Max(1, Length(FItems))*2);
	Result := FCount;
	FItems[Result] := pt;

	FQuadroTree.AddItem(Result, GetCbBounds(pt));

	Inc(FCount);
end;

procedure TConnectBriefList.Clear(const aBounds: TDRect;
	aCapacity: Integer);
begin
	SetLength(FItems, aCapacity);
	FCount := 0;
	FQuadroTree.Clear(aBounds);
end;

function TConnectBriefList.GetItem(i: Integer): TGConnectBrief;
begin
	CheckBounds(i, FCount);
	Result := FItems[i];
end;

function TConnectBriefList.IndexOf(const pt: TGConnectBrief): Integer;
var
	aSector: TQuadroSector;
	i: Integer;
begin
	aSector := FQuadroTree.FindSector(GetCbBounds(pt));
	Result := -1;
	if Assigned(aSector) then begin
		for i := 0 to aSector.Items.Count - 1 do begin
			Result := aSector.Items[i].Key;
			if CompareTGConnectBriefNotStrict(FItems[Result], pt) = 0 then
				Exit;
		end;
		Result := -1;
	end;
end;

function TConnectBriefList.GetCbBounds(cb: TGConnectBrief): TDRect;
var
	cf: TGConnectFull;
begin
	cf.Pt1 := FPoints[cb.Pt1];
	cf.Pt2 := FPoints[cb.Pt2];
	cf.ConnectType := cb.ConnectType;
	if cb.ConnectType = gctArc then
		cf.Arc.Convexity := cb.Arc.Convexity;

	Result := GetBoundsOfConnectFull(cf);
end;


{ TComplexPart }

constructor TComplexPart.Create(aContour: TContour; const aBounds: TDRect);
begin
	inherited Create;
	Assign(aContour);
	FBounds := aBounds;
end;

function TComplexPart.ContainsPoint(const aPoint: TDPoint): Boolean;
begin
	Result := FBounds.Contains(aPoint) and (inherited ContainsPoint(aPoint) <> prNone);
end;


{ TComplexPartList }

constructor TComplexPartList.Create;
begin
	inherited Create(True);
end;

procedure TComplexPartList.Assign(aContour: TContour);
var
	aBounds: TDRect;
	aRect: TDRect;
	aClipRect: TDRect;
	aDY: Double;
begin
	Clear;
	FBoundsAssigned := aContour.GetBounds(FBounds);
	if FBoundsAssigned then begin
		if aContour.PointCount < 500 then
			Add(TComplexPart.Create(aContour, FBounds))
		else begin
			aDY := FBounds.DY / (aContour.PointCount / 250);
			aRect := FBounds;

			repeat
				aRect.y2 := aRect.y1 + aDY;

				aClipRect := aRect;
				aClipRect.Inflate(0, 2*dMinZone);

				ClippingContour.Assign(aContour);
				MakeClipping(aClipRect, FBounds);
				if ClippingContour.GetBounds(aBounds) then
					Add(TComplexPart.Create(ClippingContour, aBounds));

				aRect.y1 := aRect.y2;
			until aRect.y1 > FBounds.y2;
		end;
	end;
end;

function TComplexPartList.ContainsPoint(const aPoint: TDPoint): Boolean;
var
	i: Integer;
begin
	Result := FBoundsAssigned and FBounds.Contains(aPoint);
	if Result then begin
		for i := 0 to Count - 1 do
			if TComplexPart(Items[i]).ContainsPoint(aPoint) then
				Exit;

		Result := False;
	end;
end;


initialization
{$IFDEF PROFILE}
	CounterAddComplexes := Counters.EnsureCounter('All').EnsureCounter('AddComplexes');
	CounterPrepare := Counters.EnsureCounter('All').EnsureCounter('Prepare');
	CounterOperation := Counters.EnsureCounter('All').EnsureCounter('Operation');
	CounterBelongEdge := CounterPrepare.EnsureCounter('BelongEdge');
	CounterPruneNum := CounterPrepare.EnsureCounter('PruneNum');
	CounterSplit := CounterBelongEdge.EnsureCounter('Split');
	CounterBelongPoint := CounterBelongEdge.EnsureCounter('BelongInfoOnePoint');
{$ENDIF}
end.
