unit ComplexAlg;

interface

uses
	SysUtils, Classes, Complex, GeomCmd, AClasses, {$IFDEF PROFILE}TimeCounters,{$ENDIF} SpatialIndexes;

type
	TContourRelation = (crlNone, crlContains, crlIntersects, crlTouches);

	TGConnectPosType = ( cptFirst, cptNormal, cptClose);

procedure Complex_Or(aC1, aC2: TContour; aResult: TContour);
procedure Complex_And(aC1, aC2: TContour; aResult: TContour);
procedure Complex_Sub(aC1, aC2: TContour; aResult: TContour);
procedure Complex_Xor(aC1, aC2: TContour; aResult: TContour);

procedure Complex_OrList(aC: TContour; aList: TList; aResult: TContour; aCallback: TSimpleCallback);
procedure Complex_AndList(aC: TContour; aList: TList; aResult: TContour; aCallback: TSimpleCallback);
procedure Complex_SubList(aC: TContour; aList: TList; aResult: TContour; aCallback: TSimpleCallback);
procedure Complex_XorList(aC: TContour; aList: TList; aResult: TContour; aCallback: TSimpleCallback);

procedure Complex_Split(aC: TContour; aContList, aHoleList: TList);

function Complex_GetSquare(aC: TContour): Double;
function Complex_GetPerimeter(aC: TContour): Double;
function Complex_GetRelation(aC1, aC2: TContour): TContourRelation;

procedure Complex_BufferZone(aC: TContour; zoneSize: Double; aResult: TContour);

implementation

uses
	Contnrs, XLists, GeoAlgOpGraph, Geomet, Math;

{$IFDEF PROFILE}
var
	CounterAll: TTimeCounter;

{$ENDIF}

procedure ComplexCommonOperation(aC1, aC2: TContour; aResult: TContour; aOp: TGBoolOperation);
var
	aGraph: TGUnionGraphBig;
begin
	aGraph := TGUnionGraphBig.Create(nil, OperationsEpsilon);
	try
		aGraph.SetOperation(aOp);
		aGraph.AddContour(aC1);
		aGraph.AddContour(aC2);
		aResult.Clear;
		aResult.Assign(aGraph.ContourRes);
	finally
		aGraph.Free;
	end;
end;

procedure Complex_Or(aC1, aC2: TContour; aResult: TContour);
begin
	ComplexCommonOperation(aC1, aC2, aResult, gboOR);
end;

procedure Complex_And(aC1, aC2: TContour; aResult: TContour);
begin
	ComplexCommonOperation(aC1, aC2, aResult, gboAND);
end;

procedure Complex_Sub(aC1, aC2: TContour; aResult: TContour);
begin
	ComplexCommonOperation(aC1, aC2, aResult, gboSUB);
end;

procedure Complex_Xor(aC1, aC2: TContour; aResult: TContour);
begin
	ComplexCommonOperation(aC1, aC2, aResult, gboXOR);
end;

procedure ComplexCommonListOperation(aC: TContour; aList: TList; aResult: TContour;
																				aCallback: TSimpleCallback; aOp: TGBoolOperation);
var
	aGraphMain: TGUnionGraphBig;
	aGraph: TGUnionGraphBig;
	aComplex2: TContour;
	i: Integer;
const
	sException = 'Процесс прерван';
begin
	if aList.Count = 0 then
		raise Exception.Create('Пустой список');

	aGraphMain := TGUnionGraphBig.Create(nil, OperationsEpsilon);
	try
		if Assigned(aCallBack) and aCallBack.Callback(cbpBegin, aList.Count) then raise Exception.Create(sException);
		aGraph:= TGUnionGraphBig.Create(nil, OperationsEpsilon);
		try
			if aList.Count = 1 then
				aComplex2 := TContour(aList[0])
			else begin
				aGraph.SetOperation(gboOR);
				for i:=0 to aList.Count-1 do begin
					aGraph.AddContour(TContour(aList[i]));
					if i > 0 then
						if Assigned(aCallBack) and aCallBack.Callback(cbpProcess, i) then raise Exception.Create(sException);
				end;
				aComplex2 := aGraph.ContourRes;
			end;
			aGraphMain.SetOperation(aOp);
			aGraphMain.AddContour(aC);
			aGraphMain.AddContour(aComplex2);
		finally
			aGraph.Free;
		end;
		aResult.Assign(aGraphMain.ContourRes);
		if Assigned(aCallBack) and aCallBack.Callback(cbpEnd, aList.Count) then raise Exception.Create(sException);
	finally
		aGraphMain.Free;
	end;
end;

procedure Complex_OrList(aC: TContour; aList: TList; aResult: TContour; aCallback: TSimpleCallback);
begin
	ComplexCommonListOperation(aC, aList, aResult, aCallback, gboOr);
end;

procedure Complex_AndList(aC: TContour; aList: TList; aResult: TContour; aCallback: TSimpleCallback);
begin
	ComplexCommonListOperation(aC, aList, aResult, aCallback, gboAnd);
end;

procedure Complex_SubList(aC: TContour; aList: TList; aResult: TContour; aCallback: TSimpleCallback);
begin
	ComplexCommonListOperation(aC, aList, aResult, aCallback, gboSub);
end;

procedure Complex_XorList(aC: TContour; aList: TList; aResult: TContour; aCallback: TSimpleCallback);
begin
	ComplexCommonListOperation(aC, aList, aResult, aCallback, gboXor);
end;

procedure Complex_Split(aC: TContour; aContList, aHoleList: TList);
var
	i: Integer;
	aShapeList: TList;
	aNestingList: TLongintList;
begin
	aContList.Clear;
	aHoleList.Clear;
	aShapeList := TList.Create;
	try
		SplitContourToShapes(aC, aShapeList);
		aNestingList := TLongintList.Create;
		try
			GetShapesNesting(aShapeList, aNestingList);
			for i := 0 to aShapeList.Count - 1 do
				if (aNestingList[i] and 1) = 0 then
					aContList.Add(aShapeList[i])
				else
					aHoleList.Add(aShapeList[i]);
		finally
			aNestingList.Free;
		end
	finally
		aShapeList.Free;
	end;
end;

function Complex_GetSquare(aC: TContour): Double;
var
	i: Integer;
	aContList, aHoleList: TList;
begin
	aContList := TList.Create;
	aHoleList := TList.Create;
	try
		Complex_Split(aC, aContList, aHoleList);
		Result := 0;
		for i := 0 to aContList.Count - 1 do
			Result := Result + abs(TContour(aContList[i]).GetSquare);
		for i := 0 to aHoleList.Count - 1 do
			Result := Result - abs(TContour(aHoleList[i]).GetSquare);
	finally
		FreeListAndItems(aHoleList);
		FreeListAndItems(aContList);
	end;
end;

function Complex_GetPerimeter(aC: TContour): Double;
begin
	Result := aC.GetPerimeter;
end;

function Complex_GetRelation(aC1, aC2: TContour): TContourRelation;
begin
	raise Exception.Create('GetRelation не реализована');
end;

type
	TTBufferZoneEnum = class
	protected
		complex: TContour;
		zoneSize: Double;
		graph: TGUnionGraphBig;
	protected
		constructor Create(_complex: TContour; _zoneSize: Double);
		procedure Build;

		destructor Destroy;override;
	end;

constructor TTBufferZoneEnum.Create(_complex: TContour;_zoneSize: Double);
begin
	inherited Create;
	complex := _complex;
	zoneSize := _zoneSize;
	graph := TGUnionGraphBig.Create(nil, 1E-4);
	graph.SetOperation(gboOR);
	graph.IgnoreSingularContours := True;
end;

destructor TTBufferZoneEnum.Destroy;
begin
	graph.Free;
end;

procedure TTBufferZoneEnum.Build;

	procedure AddContour;
	var
		shapeListFirst: TList;
		i: Integer;
	begin
		shapeListFirst := TList.Create;
		try
			SplitComplexToShapes1(complex, shapeListFirst);
			for i := 0 to shapeListFirst.Count - 1 do
				if IsContourClosed(shapeListFirst[i]) then
					graph.AddContour(shapeListFirst[i]);
		finally
			FreeListAndItems(shapeListFirst);
		end;
	end;

	function GetDirectionAngle(const anEdge: TDEdge; boolFirst: Boolean): Double;
	var
		cf: TDEdge;
		delta: Double;
		c: TDPoint;
	begin
		if boolFirst then
			cf := anEdge
		else
			cf := DEdgeReverse(anEdge);

		if cf.IsLine then
			Result := GetAngle(cf.P1, cf.P2)
		else begin
			if not GetCenter2(cf.P1, cf.P2, cf.C, delta, c) then
				raise Exception.Create('GetConnectDirectionAngle: GetCenter2 failed');

			Result := GetAngle(c, cf.P1);
			if Result > 0 then
				Result := Result + Pi/2
			else
				Result := Result - Pi/2;
		end;
	end;

	function CreateOnePointContour(const APt: TDPoint; ADirect: Double): TContour;
	var
		radius, t: Double;
		cs: TCoordSys;
		pt1,pt2: TDPoint;
		aConvexity: Double;
	begin
		Result := TContour.Create;
		try
			cs.InitAngle(APt, ADirect);
			radius := zoneSize ;
			t := radius/sqrt(2);
			pt1 := cs.ToGlobal(DPoint(t, t));

			Result.AddCommand(ContourMoveTo(pt1));
			pt2 := cs.ToGlobal(DPoint(t, -t));
			if GetConvexity(pt1, cs.ToGlobal(DPoint(radius,0)), pt2, aConvexity) then
				Result.AddArcTo(pt2, aConvexity)
			else
				Result.AddLineTo(pt2);
			if GetConvexity(pt2, cs.ToGlobal(DPoint(-radius,0)), pt1, aConvexity) then
				Result.AddCloseByArc(aConvexity)
			else
				Result.AddCloseByLine;
		except
			Result.Free;
			raise;
		end;
	end;


	function CreateContour(anEdge: TEdge): TContour;
	var
		cs: TCoordSys;
		ptNew: TDPoint;
	begin
		Result := TContour.Create;
		try
			if anEdge.IsLine then begin
				cs.InitPoints(anEdge.P1, anEdge.P2);
				Result.AddCommand(ContourMoveTo(cs.ToGlobal(DPoint(0, zoneSize))));
				Result.AddCommand(ContourLineTo(cs.ToGlobal(DPoint(0,-zoneSize))));
				Result.AddCommand(ContourLineTo(cs.ToGlobal(DPoint(cs.ToLocal(anEdge.P2).X, -zoneSize))));
				Result.AddCommand(ContourLineTo(cs.ToGlobal(DPoint(cs.ToLocal(anEdge.P2).X, +zoneSize))));
				Result.AddCommand(ContourCloseByLine);
			end else begin
			 cs.InitPoints(anEdge.Center, anEdge.P1);
			 if abs(anEdge.Center.DistanceFrom(anEdge.P1) - zoneSize) < kMinZone then begin
				 Result.AddCommand(ContourMoveTo(anEdge.Center));
				 ptNew := cs.ToGlobal(DPoint(cs.ToLocal(anEdge.P1).X + zoneSize, 0));
				 Result.AddCommand(ContourLineTo(ptNew));
				 cs.InitPoints(anEdge.Center, anEdge.P2);
				 ptNew := cs.ToGlobal(DPoint(cs.ToLocal(anEdge.P2).X + zoneSize, 0));
				 Result.AddCommand(ContourArcTo(ptNew, anEdge.C));
				 Result.AddCommand(ContourCloseByLine);
			 end
			 else if anEdge.Center.DistanceFrom(anEdge.P1) <= zoneSize then begin
				 Result.AddCommand(ContourMoveTo(anEdge.P1));
				 ptNew := cs.ToGlobal(DPoint(cs.ToLocal(anEdge.P1).X + zoneSize,0));
				 Result.AddCommand(ContourLineTo(ptNew));
				 cs.InitPoints(anEdge.Center, anEdge.P2);
				 ptNew := cs.ToGlobal(DPoint(cs.ToLocal(anEdge.P2).X + zoneSize,0));
				 Result.AddCommand(ContourArcTo(ptNew, anEdge.C));
				 Result.AddCommand(ContourLineTo(anEdge.P2));
				 Result.AddCommand(ContourCloseByLine);
			 end
			 else begin
				 ptNew := cs.ToGlobal(DPoint(cs.ToLocal(anEdge.P1).X - zoneSize,0));
				 Result.AddCommand(ContourMoveTo(ptNew));
				 ptNew := cs.ToGlobal(DPoint(cs.ToLocal(anEdge.P1).X + zoneSize,0));
				 Result.AddCommand(ContourLineTo(ptNew));
				 cs.InitPoints(anEdge.Center, anEdge.P2);
				 ptNew := cs.ToGlobal(DPoint(cs.ToLocal(anEdge.P2).X + zoneSize,0));
				 Result.AddCommand(ContourArcTo(ptNew, anEdge.C));
				 ptNew := cs.ToGlobal(DPoint(cs.ToLocal(anEdge.P2).X - zoneSize,0));
				 Result.AddCommand(ContourLineTo(ptNew));
				 Result.AddCommand(ContourCloseByArc(-anEdge.C));
			 end;
			end;
		except
			Result.Free;
			raise;
		end;
	end;

	procedure BuildSector(aList: Contnrs.TObjectList; aParent, aSector: TQuadroSector);
	var
		aContour: TContour;
		aBounds: TDRect;
		i: Integer;
	begin
		if aSector.Splited then begin
			BuildSector(aList, aSector, aSector.Childs[0]);
			BuildSector(aList, aSector, aSector.Childs[1]);
			BuildSector(aList, aSector, aSector.Childs[2]);
			BuildSector(aList, aSector, aSector.Childs[3]);
		end;

		if aSector.Items.Count = 0 then
			Exit;

		graph.Clear;
		for i := 0 to aSector.Items.Count - 1 do begin
			aContour := aSector.Items[i].Pointer;
			graph.AddContour(aContour);
			aList.Remove(aContour);
		end;

		aContour := TContour.Create;
		aContour.Assign(graph.contourRes);
		aList.Add(aContour);
		if Assigned(aParent) and aContour.GetBounds(aBounds) then
			aParent.Items.Add(TSpatialIndexItem.Create(aContour, aBounds));
	end;

var
	anEnum: TContourEdgeEnum;
	aTree: TQuadroTree;
	aBounds: TDRect;

	aList: Contnrs.TObjectList;
	aContour: TContour;
	i: Integer;
begin
	aList := Contnrs.TObjectList.Create(True);
	try
		anEnum.Init(complex);
		while not anEnum.EndOfContour do begin
			if anEnum.IsFirstPartEdge then
				aList.Add(CreateOnePointContour(anEnum.P1, GetDirectionAngle(anEnum, True)));

			if not anEnum.IsLastPartEdge or not anEnum.IsClosingEdge then
				aList.Add(CreateOnePointContour(anEnum.P2, GetDirectionAngle(anEnum, True)));

			aContour := CreateContour(anEnum);
			if aContour.GetBounds(aBounds) and (Min(aBounds.DX, aBounds.DY) > 1e-8) then
				aList.Add(aContour)
			else
				aContour.Free;
				
			anEnum.Next;
		end;
		Complex.GetBounds(aBounds);
		aBounds.Inflate(zoneSize, zoneSize);

{$IFDEF PROFILE}
		CounterAll.Start;
		try
{$ENDIF}

		aTree := TQuadroTree.Create(1, aBounds);
		try
			for i := 0 to aList.Count - 1 do begin
				aContour := TContour(aList[i]);
				if aContour.GetBounds(aBounds) then
					aTree.AddItem(aList[i], aBounds);
			end;
			BuildSector(aList, nil, aTree.Root);

			AddContour;
		finally
			aTree.Free;
		end;

{$IFDEF PROFILE}
		finally
			CounterAll.Stop;
			ShowCounters;
		end;
{$ENDIF}
	finally
		aList.Free;
	end;
end;

procedure Complex_BufferZone(aC: TContour; zoneSize: Double; aResult: TContour);
var
	bze: TTBufferZoneEnum;
begin
	bze := TTBufferZoneEnum.Create(aC,zoneSize);
	try
		bze.Build;
		aResult.Assign(bze.graph.contourRes);
	finally
		bze.Free;
	end;
end;

initialization
{$IFDEF PROFILE}
	CounterAll := Counters.EnsureCounter('All');
{$ENDIF}


end.
