unit Complex;
interface
uses
	Geomet, Classes, Graphics, WinTypes, XLists, ArrayUtils, Clipbrd;

{	Модуль Complex.pas содержит реализацию понятия "сложный контур",
	включает операции с дугами.}


const
	CountOfSegments = 20;
	ContourCacheLimit = 20;

type
	PCommandType = ^TCommandType;
	TCommandType = (ctMoveTo, ctLineTo, ctArcTo, ctCloseByLine, ctCloseByArc, ctNone);
	TCommandProperties = set of (cpMultiple, cpHasPoint, cpHasExtraData);

const
	CommandProperties: array [TCommandType] of TCommandProperties = (
		[cpMultiple, cpHasPoint],
		[cpMultiple, cpHasPoint],
		[cpMultiple, cpHasPoint, cpHasExtraData],
		[],
		[cpHasExtraData],
		[]);
	ExtraDataSize: array [TCommandType] of Integer = (0, 0, 8, 0, 8, 0);
	ArcCommands = [ctArcTo, ctCloseByArc];
	MultipleCommands = [ctMoveTo, ctLineTo, ctArcTo];
	CommandsWithPoint = [ctMoveTo, ctLineTo, ctArcTo];
	EdgeCommands = [ctLineTo, ctArcTo, ctCloseByLine, ctCloseByArc];
	CloseCommands = [ctCloseByLine, ctCloseByArc];
	NonBreakCommands = [ctLineTo, ctArcTo];

type
	PContourInternalCommand = ^TContourInternalCommand;
	TContourInternalCommand = object
		CommandType: TCommandType;
		Point: TDPoint;
		ArcData: Word;
	end;

	PContourInternalCommandArray = ^TContourInternalCommandArray;
	TContourInternalCommandArray = array [0..MaxInt div sizeof(TContourInternalCommand) - 1] of
		TContourInternalCommand;

	PContourInternalArcData = ^TContourInternalArcData;
	TContourInternalArcData = object
		Convexity: Double;
		Center: TDPoint;
		Delta, Radius: Double
	end;

	PContourInternalArcDataArray = ^TContourInternalArcDataArray;
	TContourInternalArcDataArray = array [0..MaxInt div sizeof(TContourInternalArcData) - 1] of
		TContourInternalArcData;

	TContourCommand = record
		CommandType: TCommandType;
		Point: TDPoint;
		Convexity: Double;
	end;

	TTouchInfo = (TouchVertex, TouchEdge, TouchInside, TouchNone);
	TTouchOptions = set of TTouchInfo;
	TTouch = record
		Where: TTouchInfo;
		Index: Integer;
		Point: TDPoint;
	end;

	TPointRelation = (prNone, prInteriorPoint, prBorderPoint);

type
	TContourPartType = (cpPoint, cpPolyline, cpPolygon);
	TContourPartTypes = set of TContourPartType;
	TContour = class
	private
		FUpdateCount: Integer;
		FPointCount: Integer;
		FCommands: TRecArray;
		FArcData: TRecArray;
		FPacked: Pointer;

		function GetPointCount: Integer;
		function GetCommandCount: Integer;
		function GetCommandType(anIndex: Integer): TCommandType;
		function GetCommandPoint(anIndex: Integer): TDPoint;
		function GetCom(anIndex: Integer): TContourCommand;
		procedure SetCom(anIndex: Integer; aCommand: TContourCommand);

		procedure CorrectCenters(anIndex: Integer; aType: TCommandType);
		procedure Unpack(aPacked: Pointer);
	public
		constructor Create;
		destructor Destroy; override;

		procedure BeginUpdate;
		procedure EndUpdate;
		function GetInternalCommands: PContourInternalCommandArray;
		function GetInternalArcData: PContourInternalArcDataArray;
		procedure GetParts(aParts: TList; aFilter: TContourPartTypes);
		function HasArcs: Boolean;

		function IsEqual(c: TContour): Boolean;
		function IsInsideOrIntersected(c: TContour): Boolean;
		function IsClear: Boolean;

		procedure PrepareToUse;
		procedure CalculateCenter(anIndex: Integer);
		procedure AddRectSegment(const aR: TDRect; aClosed: Boolean);
		procedure AddCircleSegment(const aCenter: TDPoint; aRadius: Double; aClosed: Boolean);
		procedure AddPieSegment(const aCenter: TDPoint; aRadius, anAngle, aDegree: Double);

		procedure SaveToStream(aStream: TStream);
		procedure LoadFromStream(aStream: TStream);
		procedure Assign(aSrc: TContour);
		procedure Revert;														{	Изменяет направление обхода	}
		procedure Clear;
		function ApplyTransform(aTfList: TList; aPoints: TWordList): Boolean;

		function AddCommand(const aCommand: TContourCommand): Integer;
		function AddMoveTo(const aP: TDPoint): Integer;
		function AddLineTo(const aP: TDPoint): Integer;
		function AddArcTo(const aP: TDPoint; aConvexity: Double): Integer;
		function AddCloseByLine: Integer;
		function AddCloseByArc(aConvexity: Double): Integer;
		procedure AddContour(aSrc: TContour);

		procedure InsertCommand(anIndex: Integer; const aCommand: TContourCommand);
		function SetCommand(anIndex: Integer; const aCommand: TContourCommand): Boolean;
		procedure DeleteCommand(anIndex: Integer);
		procedure SetPoint(anIndex: Integer; aPoint: TDPoint);
		procedure SetConvexity(anIndex: Integer; aConvexity: Double);

		function GetBounds(var aBounds: TDRect): Boolean;
		function GetTouchInfo(aPoint: TDPoint; aDelta: Double; anOptions: TTouchOptions): TTouch; overload;
		function GetTouchInfo(aPoint: TDPoint; aDelta: Double; anOpaque: Boolean; var aMeasure: Double): TTouchInfo; overload;
		procedure ClipByRect(const aRect: TDRect);
		function ContainsPoint(aPoint: TDPoint): TPointRelation;
		function GetSimpleSquare: Double;
		function GetSquare: Double;
		function GetPerimeter: Double;

		function GetPrevPointIndex(anIndex: Integer): Integer;
		function GetNextPointIndex(anIndex: Integer): Integer;

		property PointCount: Integer read GetPointCount;
		property CommandCount: Integer read GetCommandCount;
		property Commands[anIndex: Integer]: TContourCommand read GetCom write SetCom;
		property CommandTypes[anIndex: Integer]: TCommandType read GetCommandType;
		property CommandPoints[anIndex: Integer]: TDPoint read GetCommandPoint
			write SetPoint;
	end;

	TContourPoint = object
		Point: TDPoint;
		Contour: TContour;
		Index: Integer;
		procedure Init(aContour: TContour; anIndex: Integer);
		procedure Next;
		function EndOfContour: Boolean;
	end;

	TEdgeBase = object(TDEdge)
		Center: TDPoint;
		Delta, Radius: Double;
	end;

	PEdge = ^TEdge;
	TEdge = object(TEdgeBase)
		function DistanceFromPoint(aPoint: TDPoint): Double;
		function GetClosestPoint(aPoint: TDPoint): TDPoint;
		function XDIntersected(aPoint: TDPoint): Boolean;
		function GetDirectionOut: Double;
		function GetDirectionIn: Double;
		function GetBounds: TDRect;
		function GetLength: Double;
		function GetSquare: Double;
		function Intersect(const anOther: TEdgeBase; var aP1, aP2: TDPoint): Integer;
	end;

	TEdgeList = object
	private
		FItems: array of TEdge;
		FCount: Integer;
	public
		procedure Clear(aCapacity: Integer = 0);
		function  Add(const anItem: TEdge): Integer;

		function Prev(const Index: Integer): PEdge;
		function Next(const Index: Integer): PEdge;

		function Items(const Index: Integer): PEdge;
		function Count: Integer;
	end;

	TContourEdge = object(TEdge)
	public
		Contour: TContour;
		Index, LastMoveTo: Integer;
		P1Index, P2Index: Integer;
		SkipSingularEdges: Boolean;

		function Init(aContour: TContour; anIndex: Integer; aSkipSingularEdges: Boolean): Boolean;
		procedure Next;
		function EndOfContour: Boolean;

		function IsFirstEdge: Boolean;
		function IsLastEdge: Boolean;
		function IsClosingEdge: Boolean;
	end;

	TContourSegment = object
	private
		Contour: TContour;

		procedure FindLastIndex(anIndex: Integer);
	public
		FirstIndex, LastIndex: Integer;
		Closed: Boolean;
		procedure Init(aContour: TContour; anIndex: Integer);

		procedure Next;
		function EndOfContour: Boolean;
	end;

	TContourCache = class
	private
		FUnused,
		FUsed: TList;
	public
		constructor Create(aLimit: Integer);
		destructor Destroy; override;

		function Get: TContour;
		function GetCircle(const aCenter: TDPoint; aRadius: Double; aClosed: Boolean):
			TContour;
		function GetRect(const aRect: TDRect; aClosed: Boolean): TContour;
		function GetCopy(aSrc: TContour): TContour;
		procedure Release(aContour: TContour);
	end;

	TContourEdgeEnum = object(TEdge)
	private
		FSegmentStartCommand: PContourInternalCommand;
		FEdgeAssigned: Boolean;
		FIsFirstEdgePart: Boolean;
		FIsLastEdgePart: Boolean;
		FIsClosedEdge: Boolean;

		FLastCommandWithPoint: PContourInternalCommand;
		FNextEdgeCommandIndex: Integer;

		function CheckNextEdgeCommand(aFromIndex: Integer;
			var anIsLastEdge: Boolean; var aClosedEdge: Boolean): Integer;
	public
		Contour: TContour;

		function  Init(aContour: TContour): Boolean;
		function  Next: Boolean;
		function  EndOfContour: Boolean;

		function IsFirstPartEdge: Boolean;
		function IsLastPartEdge: Boolean;
		function IsClosingEdge: Boolean;
	end;


function CommandsAreEqual(aCommand, anOtherCommand: TContourCommand): Boolean;
procedure SetConvexity(aConvexity: Double; var aCommand: TContourCommand);

function ContourLineTo(aPoint: TDPoint): TContourCommand;
function ContourMoveTo(aPoint: TDPoint): TContourCommand;
function ContourArcTo(aPoint: TDPoint; aConvexity: Double): TContourCommand;
function ContourCloseByLine: TContourCommand;
function ContourCloseByArc(aConvexity: Double): TContourCommand;

procedure MakeClipping(aRect, aBounds: TDRect);

procedure LoadContourFromFile(aContour: TContour; const aFileName: String);
procedure SaveContourToFile(aContour: TContour; const aFileName: String);

procedure FixupContour(aContour: TContour);

function GetInteriorContourPoint(const aContour: TContour; out aPoint: TDPoint;
	anEpsilon: Double = kMinZone2): Boolean;

procedure LogContour(const aFileName: String; aContour: TContour; aClearExists: Boolean = False);
procedure LogPointList(const aFileName: String; aPoints: TDPointList; aClearExists: Boolean = False);

function Edge(const aP1, aP2: TDPoint; aConvexity: Double): TEdge;

var
	ClippingContour: TContour = nil;
	ContourCache: TContourCache = nil;

implementation
uses
	Versions, SysUtils, Math, Transformer, InSysUtils;

var
	CacheContour: TContour;

function Edge(const aP1, aP2: TDPoint; aConvexity: Double): TEdge;
begin
	Result.P1 := aP1;
	Result.P2 := aP2;
	Result.C := aConvexity;
	if Result.IsArc then begin
		if GetCenter2(aP1, aP2, aConvexity, Result.Delta, Result.Center) then
			Result.Radius := aP1.DistanceFrom(Result.Center)
		else
			Result.C := 0;
	end;
end;

function GetXIntersection(const anEdge: TEdge; const aY: Double; const anEpsilon: Double): TDPointArray;  overload;

	function AddArcPoint(const aPoint: TDPoint; var aPoints: TDPointArray): Boolean;
	begin
		Result := AngleInRange(GetAngle(anEdge.Center, aPoint), GetAngle(anEdge.Center, anEdge.P1), anEdge.Delta) or
			(anEdge.P1.CloselyTo(aPoint, anEpsilon)) or (anEdge.P2.CloselyTo(aPoint, anEpsilon));
		if Result then
			aPoints.Add(aPoint);
	end;

var
	aX: Double;
	aShift: Double;
begin
	Result.Clear(2);
	if (anEdge.IsSingular) then begin
		if anEdge.P1.y = aY then
			Result.Add(anEdge.P1);
	end
	else if anEdge.IsLine then begin
		if (anEdge.P1.y <= anEdge.P2.y) and ((anEdge.P1.y - aY > anEpsilon) or (aY - anEdge.P2.y > anEpsilon)) then
			Exit
		else if (anEdge.P1.y > anEdge.P2.y) and ((anEdge.P2.y - aY > anEpsilon) or (aY - anEdge.P1.y > anEpsilon)) then
			Exit;

		if Abs(anEdge.P1.y - anEdge.P2.y) < anEpsilon then begin
			Result.Add(anEdge.P1);
			Result.Add(anEdge.P2);
			Exit;
		end;

		aX := (anEdge.P2.x - anEdge.P1.x)/(anEdge.P2.y - anEdge.P1.y)*(aY - anEdge.P1.y) + anEdge.P1.x;
		Result.Add(DPoint(aX, aY));
	end else begin
		if anEdge.Radius >= Abs(anEdge.Center.y - aY) then begin
			aShift := Sqrt(Sqr(anEdge.Radius) - Sqr(anEdge.Center.Y - aY));

			if aShift <= anEpsilon/2 then
				AddArcPoint(DPoint(anEdge.Center.x, aY), Result)
			else begin
				AddArcPoint(DPoint(anEdge.Center.x + aShift, aY), Result);
				AddArcPoint(DPoint(anEdge.Center.x - aShift, aY), Result);
			end;
		end;
	end;
end;

function GetInnerPolygonXIntersection(const aContourSegment: TContourSegment; const aY: Double; const anEpsilon: Double): TDPointArray;

	function InAdjacentHalfPlanesRelativeToY(const aP1, aP2: TDPoint): Boolean;
	begin
		Result := ((aP1.y > aY) and (aP2.y < aY)) or ((aP1.y < aY) and (aP2.y > aY))
	end;

	function IsTangentsInVertex(const aPrev, aNext: TEdge): Boolean;
	var
		aP1, aP2: TDPoint;
		a, b: Double;
	begin
		if aPrev.IsLine then
			aP1 := aPrev.P1
		else begin
			a := -(aPrev.P2.y - aPrev.Center.y);
			b := aPrev.P2.x - aPrev.Center.x;
			if aPrev.Delta < 0 then begin
				aP1.x := aPrev.P2.x + a;
				aP1.y := aPrev.P2.y + b;
			end
			else begin
				aP1.x := aPrev.P2.x - a;
				aP1.y := aPrev.P2.y - b;
			end;
		end;

		if aNext.IsLine then
			aP2 := aNext.P2
		else begin
			a := -(aNext.P1.y - aNext.Center.y);
			b := aNext.P1.x - aNext.Center.x;
			if aNext.Delta < 0 then begin
				aP2.x := aNext.P1.x - a;
				aP2.y := aNext.P1.y - b;
			end
			else begin
				aP2.x := aNext.P1.x + a;
				aP2.y := aNext.P1.y + b;
			end;
		end;

		Result := not InAdjacentHalfPlanesRelativeToY(aP1, aP2);
	end;

	function IsTangentsInArc(const aPoint: TDPoint; const anEdge: TEdge): boolean;
	begin
		Result := anEdge.IsArc and (Abs(anEdge.Center.x - aPoint.x) <= anEpsilon);
	end;

	function IsVerticalEdge(const anEdge: TDEdge): Boolean;
	begin
		Result := anEdge.IsLine and (Abs(anEdge.P1.y - anEdge.P2.y) < anEpsilon);
	end;

	procedure AddPoint(const aPoint: TDPoint; anEdge, aPrevEdge: TEdge; var aPoints: TDPointArray);
	begin
		if (anEdge.P1.CloselyTo(aPoint, anEpsilon)) then begin
			if IsTangentsInVertex(aPrevEdge, anEdge) then
				Exit;
		end else if (anEdge.P2.CloselyTo(aPoint, anEpsilon)) then
			Exit
		else if IsTangentsInArc(aPoint, anEdge) then
			Exit;

		aPoints.Add(aPoint)
	end;


var
	aContourEdge: TContourEdge;
	anEdgeList: TEdgeList;

	aPoints: TDPointArray;

	anEdge, aPrevEdge: PEdge;

	i, j: Integer;
begin
	Result.Clear;

	if not aContourSegment.Closed then
		Exit;

	anEdgeList.Clear(aContourSegment.LastIndex - aContourSegment.FirstIndex);

	aContourEdge.Init(aContourSegment.Contour, aContourSegment.FirstIndex, True);
	while aContourEdge.Index <= aContourSegment.LastIndex do begin
		if not (IsVerticalEdge(aContourEdge) and (GetXIntersection(aContourEdge, aY, anEpsilon).Count > 0)) then
			anEdgeList.Add(aContourEdge);

		aContourEdge.Next;
	end;

	i := 0;
	while i < anEdgeList.Count do begin
		anEdge := anEdgeList.Items(i);
		aPrevEdge := anEdgeList.Prev(i);

		aPoints := GetXIntersection(anEdge^, aY, anEpsilon);
		for j := 0 to aPoints.Count - 1 do
			AddPoint(aPoints.GetItem(j), anEdge^, aPrevEdge^, Result);

		Inc(i);
	end;
end;

function GetYIntersection(const anEdge: TEdge; aX: Double; anEpsilon: Double): TDPointArray;

	function AddArcPoint(const aPoint: TDPoint; var aPoints: TDPointArray): Boolean;
	begin
		Result := AngleInRange(GetAngle(anEdge.Center, aPoint), GetAngle(anEdge.Center, anEdge.P1), anEdge.Delta) or
			(anEdge.P1.DistanceFrom(aPoint) <= anEpsilon) or (anEdge.P2.DistanceFrom(aPoint) <= anEpsilon);
		if Result then
			aPoints.Add(aPoint);
	end;

var
	aY: Double;
	aShift: Double;
begin
	Result.Clear(2);
	if (anEdge.IsSingular) then begin
		if anEdge.P1.x = aX then
			Result.Add(anEdge.P1);
	end
	else if anEdge.IsLine then begin
		if (anEdge.P1.x <= anEdge.P2.x) and ((aX < anEdge.P1.x) or (aX > anEdge.P2.x)) then
			Exit
		else if (anEdge.P1.x >= anEdge.P2.x) and ((aX < anEdge.P2.x) or (aX > anEdge.P1.x)) then
			Exit;

		if Abs(anEdge.P1.x - anEdge.P2.x) < anEpsilon then begin
			Result.Add(anEdge.P1);
			Result.Add(anEdge.P2);
			Exit;
		end;

		aY := (anEdge.P2.y - anEdge.P1.y)/(anEdge.P2.x - anEdge.P1.x)*(aX - anEdge.P1.x) + anEdge.P1.y;
		Result.Add(DPoint(aX, aY));
	end else begin
		if anEdge.Radius >= Abs(anEdge.Center.x - aX) then begin
			aShift := Sqrt(Sqr(anEdge.Radius) - Sqr(anEdge.Center.x - aX));

			if aShift < anEpsilon/2 then
				AddArcPoint(DPoint(aX, anEdge.Center.y), Result)
			else begin
				AddArcPoint(DPoint(aX, anEdge.Center.y + aShift), Result);
				AddArcPoint(DPoint(aX, anEdge.Center.y - aShift), Result);
			end
		end;
	end;
end;

function SortByXAxis(const A, B: TDPoint; aData: Pointer): Integer;
begin
	Result := CompareValue(A.x, B.x);
end;

function SortByYAxis(const A, B: TDPoint; aData: Pointer): Integer;
begin
	Result := CompareValue(A.y, B.y);
end;

function GetInteriorContourPoint(const aContour: TContour; out aPoint: TDPoint; anEpsilon: Double): Boolean;

	function GetYDirectionIntersectPoints(const aSegment: TContourSegment; aX: Double): TDPointArray;
	var
		anEdge: TContourEdge;
	begin
		Result.Clear(aSegment.LastIndex - aSegment.FirstIndex);
		anEdge.Init(aSegment.Contour, aSegment.FirstIndex, True);
		while anEdge.Index <= aSegment.LastIndex do begin
			Result.Add(GetYIntersection(anEdge, aX, anEpsilon));
			anEdge.Next;
		end;
	end;


	function GetInteriorContourPartPoint(const aBounds: TDRect;
		const aSegment: TContourSegment; out aPoint: TDPoint): Boolean;
	var
		aContourPoint: TContourPoint;

		aSegmentPoints: TDPointArray;
		anIntersectPoints: TDPointArray;
		A, B: TDPoint;
		i, j: Integer;
	begin
		Result := aSegment.Closed;

		if not Result then
			Exit;

		aSegmentPoints.Clear(aSegment.LastIndex - aSegment.FirstIndex + 2);

		aSegmentPoints.Add(DPoint(aBounds.x1, aBounds.y1));
		aSegmentPoints.Add(DPoint(aBounds.x2, aBounds.y2));
		
		aContourPoint.Init(aContour, aSegment.FirstIndex);
		while aContourPoint.Index <= aSegment.LastIndex do begin
			aSegmentPoints.Add(aContourPoint.Point);
			aContourPoint.Next;
		end;

		aSegmentPoints.Sort(SortByXAxis, nil);
		for i := 0 to aSegmentPoints.Count - 2 do begin
			A := aSegmentPoints.GetItem(i);
			B := aSegmentPoints.GetItem(i + 1);

			if B.x - A.x > anEpsilon then begin
				anIntersectPoints := GetYDirectionIntersectPoints(aSegment,  (A.x + B.x)/2);
				anIntersectPoints.Sort(SortByYAxis, nil);

				j := 0;
				while j < anIntersectPoints.Count - 1 do begin
					A := anIntersectPoints.GetItem(j);
					B := anIntersectPoints.GetItem(j + 1);

					if B.y - A.y > anEpsilon then begin
						aPoint.x := (A.x + B.x)/2;
						aPoint.y := (A.y + B.y)/2;
						Exit;
					end;

					Inc(j, 2);
				end;
			end;

		end;
		Result := False;
	end;


var
	aSegment:	TContourSegment;
	aBounds: TDRect;
begin
	Result := aContour.GetBounds(aBounds);
	if not Result then
		Exit;


	aSegment.Init(aContour, 0);
	while not aSegment.EndOfContour do begin
		if GetInteriorContourPartPoint(aBounds, aSegment, aPoint) then 
			Exit;

		aSegment.Next;
	end;
	Result := False;
end;

function CommandsAreEqual(aCommand, anOtherCommand: TContourCommand): Boolean;
begin
	Result := False;
	if aCommand.CommandType <> anOtherCommand.CommandType then
		Exit;
	case aCommand.CommandType of
		ctMoveTo: Result := aCommand.Point.IsEqual(anOtherCommand.Point);
		ctLineTo: Result := aCommand.Point.IsEqual(anOtherCommand.Point);
		ctArcTo:	Result := aCommand.Point.IsEqual(anOtherCommand.Point) and
												(aCommand.Convexity = anOtherCommand.Convexity);
		ctCloseByLine: Result := True;
		ctCloseByArc:	Result := aCommand.Convexity = anOtherCommand.Convexity;
	end;
end;

procedure FixupContour(aContour: TContour);
var
	aCommand: TContourCommand;
	aStartPoint, aPrevPoint: TDPoint;
	aState: char; // состояния: 'S' - начальное состояние; 'A' - начало простого контура, 'B' -  где-то на линии; 'C' - за полигоном
	i: integer;
begin
	aContour.BeginUpdate;
	try
		aContour.PrepareToUse;

		i := 0;
		aState := 'S';
		while (i < aContour.CommandCount) do begin

			aCommand := aContour.Commands[i];
			case aCommand.CommandType of

				ctMoveTo: begin
					if (aState = 'A') and aCommand.Point.IsEqual(aPrevPoint) then begin
						aContour.DeleteCommand(i);
						continue;
					end;
					aStartPoint := aCommand.Point;
					aState := 'A';
				end;

				ctLineTo, ctArcTo: begin
					if aState in ['S', 'C'] then begin
						aCommand.CommandType := ctMoveTo;
						aContour.SetCommand(i, aCommand);
						continue;
					end
					else if aCommand.Point.IsEqual(aPrevPoint) then begin
						aContour.DeleteCommand(i);
						continue;
					end;
					aState := 'B';
				end;

				ctCloseByLine, ctCloseByArc: try
					case aState of
						'A', 'C', 'S': begin
							aContour.DeleteCommand(i);
							continue;
						end;
						'B': if aStartPoint.IsEqual(aPrevPoint) then begin
							aContour.DeleteCommand(i-1);
							continue;
						end;
					end;
				finally
					aState := 'C';
				end;

				ctNone: begin
					aContour.DeleteCommand(i);
					continue;
				end;
			end;
			aPrevPoint := aCommand.Point;
			inc(i);
		end;
	finally
		aContour.EndUpdate;
	end;
end;


procedure SetConvexity(aConvexity: Double; var aCommand: TContourCommand);
begin
	if aConvexity = 0 then
{		if aCommand.CommandType = ctArcTo then
			aCommand.CommandType := ctLineTo
		else if aCommand.CommandType = ctCloseByArc then
			aCommand.CommandType := ctCloseByLine
		else
}	else
		if aCommand.CommandType in [ctLineTo, ctMoveTo] then
			aCommand.CommandType := ctArcTo
		else if aCommand.CommandType = ctCloseByLine then
			aCommand.CommandType := ctCloseByArc;
	if aCommand.CommandType in ArcCommands then
		aCommand.Convexity := aConvexity
end;

function ContourMoveTo(aPoint: TDPoint): TContourCommand;
begin
	Result.CommandType := ctMoveTo;
	Result.Point := aPoint;
end;

function ContourLineTo(aPoint: TDPoint): TContourCommand;
begin
	Result.CommandType := ctLineTo;
	Result.Point := aPoint;
end;

function ContourArcTo(aPoint: TDPoint; aConvexity: Double): TContourCommand;
begin
	Result.CommandType := ctArcTo;
	Result.Point := aPoint;
	Result.Convexity := aConvexity;
end;

function ContourCloseByLine: TContourCommand;
begin
	Result.CommandType := ctCloseByLine;
end;

function ContourCloseByArc(aConvexity: Double): TContourCommand;
begin
	Result.CommandType := ctCloseByArc;
	Result.Convexity := aConvexity;
end;

function DistanceToEdge(const aP, aP1, aP2: TDPoint; anArc: PContourInternalArcData): Double;
var
	aDistance: Double;
begin
	if Assigned(anArc) and (Abs(anArc.Convexity) > minConvexity2) then
		if AngleInRange(GetAngle(anArc.Center, aP), GetAngle(anArc.Center, aP1), anArc.Delta) then
			Result := Abs(anArc.Radius - anArc.Center.DistanceFrom(aP))
		else begin
			Result := aP.DistanceFrom(aP1);
			aDistance := aP.DistanceFrom(aP2);
			if Result < aDistance then Result := aDistance
		end
	else
		Result := aP.DistanceFromSegment(aP1, aP2);
end;

procedure LogContour(const aFileName: String; aContour: TContour; aClearExists: Boolean = False);
var
	aFile: TextFile;
	i: Integer;
begin
	AssignFile(aFile, aFileName);
	if FileExists(aFileName) and aClearExists then
		DeleteFile(aFileName);

	if FileExists(aFileName) then
		Append(aFile)
	else
		Rewrite(aFile);

	for i := 0 to aContour.CommandCount - 1 do begin
		Write(aFile, i, ' ');
		with aContour.Commands[i] do begin
			case CommandType of
				ctMoveTo: Writeln(aFile, 'moveto ', Point.X:20:8, ' ', Point.Y:20:8);
				ctLineTo: Writeln(aFile, 'lineto ', Point.X:20:8, ' ', Point.Y:20:8);
				ctArcTo: 	Writeln(aFile, 'arcto ', Point.X:20:8, ' ', Point.Y:20:8, ' ',Convexity:20:8);
				ctCloseByLine: Writeln(aFile, 'closebyline');
				ctCloseByArc: Writeln(aFile, 'closebyarc ', Convexity:20:8);
				ctNone: Writeln(aFile, 'none');
			end;
		end;
	end;
	Writeln(aFile, ^M^J);
	Writeln(aFile, '-------------');
	Writeln(aFile, ^M^J);
	CloseFile(aFile);
end;

procedure LogPointList(const aFileName: String; aPoints: TDPointList; aClearExists: Boolean = False);
var
	aFile: TextFile;
	i: Integer;
begin
	AssignFile(aFile, aFileName);
	if FileExists(aFileName) and aClearExists then
		DeleteFile(aFileName);

	if FileExists(aFileName) then
		Append(aFile)
	else
		Rewrite(aFile);

	for i := 0 to aPoints.Count - 1 do begin
		with aPoints.Points[i] do
			Writeln(aFile, i, ' ', X:12:8, Y:12:8);
	end;
	if aPoints.Closed then
		Writeln(aFile, ' Closed');

	Writeln(aFile, ^M^J);
	Writeln(aFile, '-------------');
	Writeln(aFile, ^M^J);
	CloseFile(aFile);
end;



type
	TLinePlace = (lpOutside, lpCrossIn, lpInside, lpCrossOut, lpCrossInOut, lpCrossOutIn, lpBelongLine, lpTouchOutside, lpTouchInside);

procedure MakeClipping(aRect, aBounds: TDRect);

	procedure ClipContourWithOneEdge(aLimit: Double; anIsItX, anIsItLowLimit: Boolean);
	var
		aPointIn, aPointOut, aCenter: TDPoint;
		aConvexity: Double;
		aPolygonBegun: Boolean;
		anEdge: TContourEdgeEnum;
		aLinePlace: TLinePlace;

		function ToLocal(aPoint: TDPoint): TDPoint;
		begin
			if anIsItX then
				if anIsItLowLimit then begin
					Result.x := aPoint.x - aLimit;
					Result.y := aPoint.y
				end else begin
					Result.x := aLimit - aPoint.x;
					Result.y := -aPoint.y
				end
			else
				if anIsItLowLimit then begin
					Result.x := aPoint.y - aLimit;
					Result.y := -aPoint.x
				end else begin
					Result.x := aLimit - aPoint.y;
					Result.y := aPoint.x
				end
		end;

		function ToGlobal(aPoint: TDPoint): TDPoint;
		begin
			if anIsItX then
				if anIsItLowLimit then begin
					Result.x := aPoint.x + aLimit;
					Result.y := aPoint.y
				end else begin
					Result.x := aLimit - aPoint.x;
					Result.y := -aPoint.y
				end
			else
				if anIsItLowLimit then begin
					Result.x := -aPoint.y;
					Result.y := aPoint.x + aLimit
				end else begin
					Result.x := aPoint.y;
					Result.y := aLimit - aPoint.x
				end
		end;

		function GetLinePlace(aB, aE: TDPoint): TLinePlace;
		var
			dy: Double;
			aTempPoint: TDPoint;
		begin
			if anEdge.IsArc then
				aCenter := ToLocal(anEdge.Center);
			if (aB.x > 0) = (aE.x > 0) then begin
				if aB.x < 0 then
					Result := lpOutside
				else
					Result := lpInside;
				if anEdge.IsArc then
					if Abs(aCenter.x) < anEdge.Radius then begin
						dy := Sqrt(Sqr(anEdge.Radius) - Sqr(aCenter.x));
						aPointIn := DPoint(0, aCenter.y - dy);
						aPointOut := DPoint(0, aCenter.y + dy);
						if AngleInRange(GetAngle(aCenter, aPointIn), GetAngle(aCenter, aB), anEdge.Delta)
						then begin
							if anEdge.Delta < 0 then begin
								aTempPoint := aPointIn;
								aPointIn := aPointOut;
								aPointOut := aTempPoint
							end;
							if Result = lpInside then
								Result := lpCrossOutIn
							else
								Result := lpCrossInOut;
						end
					end
			end else begin
				if aB.x < 0 then
					Result := lpCrossIn
				else
					Result := lpCrossOut;
				if anEdge.IsArc then begin
					dy := Sqrt(Sqr(anEdge.Radius) - Sqr(aCenter.x));
					aPointIn := DPoint(0, aCenter.y - dy);
					if not AngleInRange(GetAngle(aCenter, aPointIn), GetAngle(aCenter, aB), anEdge.Delta) then
						aPointIn := DPoint(0, aCenter.y + dy)
				end else
					aPointIn := DPoint(0, aB.y - aB.x * (aE.y - aB.y) / (aE.x - aB.x));
				aPointOut := aPointIn
			end
		end;

		procedure AddCommand(const aContour: TContour; const aP: TDPoint; aConvexity: Double; aClosed: Boolean);
		begin
			if Abs(aConvexity) > minConvexity2 then begin
				if aClosed then
					aContour.AddCloseByArc(aConvexity)
				else
					aContour.AddArcTo(aP, aConvexity)
			end
			else begin
				if aClosed then
					aContour.AddCloseByLine
				else
					aContour.AddLineTo(aP);
			end;
		end;

		procedure OnCrossIn;
		begin
			if aPolygonBegun then
				ClippingContour.AddLineTo(aPointIn)
			else
				ClippingContour.AddMoveTo(aPointIn);

			if anEdge.IsArc then
				AddCommand(ClippingContour, anEdge.P2,
					GetConvexity2(aPointIn, aCenter, anEdge.P2, anEdge.Delta < 0), anEdge.IsClosingEdge)
			else
				AddCommand(ClippingContour, anEdge.P2, 0, anEdge.IsClosingEdge)
		end;

		procedure OnCrossOut;
		begin
			if not anEdge.IsArc then
				ClippingContour.AddLineTo(aPointOut)
			else begin
				aConvexity := GetConvexity2(anEdge.P1, aCenter, aPointOut, anEdge.Delta < 0);
				ClippingContour.AddArcTo(aPointOut, aConvexity)
			end;
			aPolygonBegun := True
		end;

	begin
		ClippingContour.Clear;
		aPolygonBegun := False;
		anEdge.Init(CacheContour);
		while not anEdge.EndOfContour do begin
			aLinePlace := GetLinePlace(ToLocal(anEdge.P1), ToLocal(anEdge.P2));
			if aLinePlace in [lpCrossIn, lpCrossOut, lpCrossInOut, lpCrossOutIn] then begin
				aPointIn := ToGlobal(aPointIn);
				aPointOut := ToGlobal(aPointOut);
				if anEdge.IsArc then
					aCenter := ToGlobal(aCenter);
			end;
			if anEdge.IsFirstPartEdge then begin
				aPolygonBegun := False;
				if (aLinePlace in [lpInside, lpCrossOut, lpCrossOutIn]) then
					ClippingContour.AddMoveTo(anEdge.P1);
			end;
			case aLinePlace of
				lpInside:	AddCommand(ClippingContour, anEdge.P2, anEdge.C, anEdge.IsClosingEdge);
				lpCrossIn:	OnCrossIn;
				lpCrossOut: OnCrossOut;
				lpCrossInOut: begin
						aConvexity := GetConvexity2(aPointIn, aCenter, aPointOut, anEdge.Delta < 0);
						if aPolygonBegun then
							ClippingContour.AddLineTo(aPointIn)
						else
							ClippingContour.AddMoveTo(aPointIn);
						ClippingContour.AddArcTo(aPointOut, aConvexity);
						aPolygonBegun := True
					end;
				lpCrossOutIn: begin
						OnCrossOut;
						OnCrossIn
					end;
			end;
			if anEdge.IsClosingEdge then begin
				if aPolygonBegun and (aLinePlace in [lpOutside, lpCrossOut, lpCrossInOut]) then
					ClippingContour.AddCloseByLine;
				aPolygonBegun := False
			end;
			anEdge.Next
		end
	end;

begin
	if aBounds.x1 < aRect.x1 then begin
		CacheContour.Assign(ClippingContour);
		ClipContourWithOneEdge(aRect.x1, True, True)
	end;
	if aBounds.y1 < aRect.y1 then begin
		CacheContour.Assign(ClippingContour);
		ClipContourWithOneEdge(aRect.y1, False, True)
	end;
	if aBounds.x2 > aRect.x2 then begin     //
		CacheContour.Assign(ClippingContour);
		ClipContourWithOneEdge(aRect.x2, True, False)
	end;
	if aBounds.y2 > aRect.y2 then begin
		CacheContour.Assign(ClippingContour);
		ClipContourWithOneEdge(aRect.y2, False, False)
	end;
end;

{	TContourCache }

constructor TContourCache.Create(aLimit: Integer);
begin
	inherited Create;
	FUnused := TList.Create;
	FUsed := TList.Create;
	while aLimit > 0 do begin
		FUnused.Add(TContour.Create);
		Dec(aLimit)
	end;
end;

destructor TContourCache.Destroy;
begin
	FreeObjectList(FUnused);
	FreeObjectList(FUsed);
	inherited Destroy;
end;

function TContourCache.Get: TContour;
begin
	if FUnused.Count > 0 then begin
		Result := FUnused.Last;
		FUsed.Add(Result);
		FUnused.Delete(FUnused.Count - 1)
	end
	else
		Result := TContour.Create;
end;

function TContourCache.GetCopy(aSrc: TContour): TContour;
begin
	Result := Get;
	Result.Assign(aSrc);
end;

function TContourCache.GetCircle(const aCenter: TDPoint; aRadius: Double;
	aClosed: Boolean): TContour;
begin
	Result := Get;
	Result.AddCircleSegment(aCenter, aRadius, aClosed);
end;

function TContourCache.GetRect(const aRect: TDRect; aClosed: Boolean): TContour;
begin
	Result := Get;
	Result.AddRectSegment(aRect, aClosed);
end;

procedure TContourCache.Release(aContour: TContour);
var
	i: Integer;
begin
	i := FUsed.IndexOf(aContour);
	if i >= 0 then begin
		FUnused.Add(aContour);
		FUsed.Delete(i);
		aContour.Clear;
	end
	else
		aContour.Free;
end;

procedure LoadContourFromFile(aContour: TContour; const aFileName: String);
var
	aStm: TFileStream;
	aSaveVersion: TDataVersion;
begin
	aStm := TFileStream.Create(aFileName, fmOpenRead);
	try
		aSaveVersion := DataVersion;
		try
			aStm.ReadBuffer(DataVersion, sizeof(DataVersion));
			aContour.LoadFromStream(aStm);
		finally
			DataVersion := aSaveVersion
		end
	finally
		aStm.Free
	end
end;

procedure SaveContourToFile(aContour: TContour; const aFileName: String);
var
	aStm: TFileStream;
begin
	aStm := TFileStream.Create(aFileName, fmCreate);
	try
		aStm.WriteBuffer(DataVersion, sizeof(DataVersion));
		aContour.SaveToStream(aStm);
	finally
		aStm.Free
	end
end;

{ TContourEdgeEnum }

function TContourEdgeEnum.Init(aContour: TContour): Boolean;
begin
	Contour := aContour;
	Contour.PrepareToUse;

	FSegmentStartCommand := nil;
	FLastCommandWithPoint := nil;
	FNextEdgeCommandIndex := 0;
	Next;
	Result := not EndOfContour;
end;

function TContourEdgeEnum.CheckNextEdgeCommand(aFromIndex: Integer;
	var anIsLastEdge: Boolean; var aClosedEdge: Boolean): Integer;
var
	aCommand, aNextCommand: PContourInternalCommand;
begin
	Result := aFromIndex;
	if not Assigned(FLastCommandWithPoint) then
		Exit;

	aNextCommand := nil;
	while (Result < Contour.FCommands.Count) do begin
		aCommand := PContourInternalCommand(Contour.FCommands.GetPtr(Result));
		case aCommand.CommandType of
			ctMoveTo: begin
				anIsLastEdge := True;
				Break;
			end;
			ctLineTo,	ctArcTo:
				aNextCommand := aCommand;

			ctCloseByLine, ctCloseByArc:
				aNextCommand := FSegmentStartCommand;
		end;

		if Assigned(aNextCommand) and not FLastCommandWithPoint.Point.IsEqual(aNextCommand.Point) then
			Break;

		if aCommand.CommandType in CloseCommands then
			aClosedEdge := True;

		if aCommand.CommandType in CommandsWithPoint then
			FLastCommandWithPoint := aCommand;

		Inc(Result);
	end;

	if Result >= Contour.FCommands.Count then
		FIsLastEdgePart := True;
end;

function TContourEdgeEnum.Next: Boolean;
var
	aCommand, aNextCommand: PContourInternalCommand;
	anArcData: PContourInternalArcData;
begin
	FEdgeAssigned := False;
	FIsFirstEdgePart := False;
	FIsLastEdgePart := False;
	FIsClosedEdge := False;
	aNextCommand := nil;

	while (FNextEdgeCommandIndex < Contour.FCommands.Count) and not FEdgeAssigned do begin
		aCommand := PContourInternalCommand(Contour.FCommands.GetPtr(FNextEdgeCommandIndex));

		if Assigned(FLastCommandWithPoint) then begin
			case aCommand.CommandType of
				ctLineTo,	ctArcTo:
					aNextCommand := aCommand;

				ctCloseByLine, ctCloseByArc:
					aNextCommand := FSegmentStartCommand;
			end;

			if Assigned(aNextCommand) then begin
				if FLastCommandWithPoint.Point.IsEqual(aNextCommand.Point) then
					aNextCommand := nil
				else if not FEdgeAssigned then begin
					P1 := FLastCommandWithPoint.Point;
					P2 := aNextCommand.Point;

					case aCommand.CommandType of
						ctLineTo, ctCloseByLine: C := 0;
						ctArcTo, ctCloseByArc: begin
							anArcData := PContourInternalArcData(Contour.FArcData.GetPtr(aCommand.ArcData));
							C := anArcData.Convexity;
							Center := anArcData.Center;
							Radius := anArcData.Radius;
							Delta := anArcData.Delta;
						end;
					end;
					FIsClosedEdge := aCommand.CommandType in CloseCommands;
					FIsLastEdgePart := not (aCommand.CommandType in NonBreakCommands);
					FEdgeAssigned := True;
				end;
			end;
		end;

		if aCommand.CommandType in CommandsWithPoint then begin
			FLastCommandWithPoint := aCommand;
			if (aCommand.CommandType = ctMoveTo) or (FSegmentStartCommand = nil) then begin
				FSegmentStartCommand := aCommand;
				FIsFirstEdgePart := True;
			end;
		end;

		Inc(FNextEdgeCommandIndex);
	end;
	FNextEdgeCommandIndex := CheckNextEdgeCommand(FNextEdgeCommandIndex, FIsLastEdgePart, FIsClosedEdge);
	Result := not EndOfContour;
end;

function  TContourEdgeEnum.EndOfContour: Boolean;
begin
	Result := not FEdgeAssigned;
end;

function TContourEdgeEnum.IsFirstPartEdge: Boolean;
begin
	Result := not EndOfContour and FIsFirstEdgePart;
end;

function TContourEdgeEnum.IsLastPartEdge: Boolean;
begin
	Result := EndOfContour or FIsLastEdgePart;
end;

function TContourEdgeEnum.IsClosingEdge: Boolean;
begin
	Result := FIsClosedEdge;
end;

{	TContour }

constructor TContour.Create;
begin
	inherited;
	FPointCount := 0;
	FPacked := nil;
	FCommands.Init(sizeof(TContourInternalCommand));
	FArcData.Init(sizeof(TContourInternalArcData))
end;

destructor TContour.Destroy;
begin
	if Assigned(FPacked) then
		FreeMem(FPacked);
	FCommands.Clear;
	FArcData.Clear;
	inherited Destroy
end;

procedure TContour.BeginUpdate;
begin
	Inc(FUpdateCount);
end;

procedure TContour.EndUpdate;
var
	aCommand,
	aPrevCommand: PContourInternalCommand;
	aSegmentStart: PContourInternalCommand;
	anArcData: PContourInternalArcDataArray;
	i: Integer;
begin
	Dec(FUpdateCount);
	if (FUpdateCount = 0) and (FArcData.Count > 0) then begin
		aSegmentStart := FCommands.Items;
		anArcData := FArcData.Items;
		aPrevCommand := aSegmentStart;
		aCommand := aSegmentStart;
		Inc(aCommand);
		for i := 1 to FCommands.Count - 1 do begin
			case aCommand.CommandType of
				ctMoveTo:
					begin
						aSegmentStart := aCommand;
						aPrevCommand := aCommand;
					end;
				ctLineTo:
					aPrevCommand := aCommand;
				ctArcTo:
					begin
						if aPrevCommand.CommandType in CommandsWithPoint then
							with anArcData[aCommand.ArcData] do
								if GetCenter2(aPrevCommand.Point, aCommand.Point, Convexity, Delta, Center) then
									Radius := Center.DistanceFrom(aCommand.Point)
								else begin
									aCommand.CommandType := ctLineTo;
									aCommand.ArcData := $FFFF;
								end;
						aPrevCommand := aCommand;
					end;
				ctCloseByArc:
					if (aPrevCommand.CommandType in CommandsWithPoint) and
						(aSegmentStart.CommandType in CommandsWithPoint)
					then
						with anArcData[aCommand.ArcData] do
							if GetCenter2(aPrevCommand.Point, aSegmentStart.Point, Convexity, Delta, Center) then
								Radius := Center.DistanceFrom(aPrevCommand.Point)
							else begin
								aCommand.CommandType := ctCloseByLine;
								aCommand.ArcData := $FFFF;
							end;
			end;
			Inc(aCommand);
		end;
	end;
end;

function TContour.GetInternalCommands: PContourInternalCommandArray;
begin
	if Assigned(FPacked) then
		Unpack(FPacked);
	Result := FCommands.Items;
end;

function TContour.GetInternalArcData: PContourInternalArcDataArray;
begin
	if Assigned(FPacked) then
		Unpack(FPacked);
	Result := FArcData.Items;
end;

procedure TContour.GetParts(aParts: TList; aFilter: TContourPartTypes);
var
	anArcData: PContourInternalArcDataArray;

	function IsValidPart(aFirst, aNextFirst: PContourInternalCommand;
		out aPartType: TContourPartType): Boolean;
	var
		aSecond: PContourInternalCommand;
		aLast: PContourInternalCommand;
	begin
		if aFirst = aNextFirst then
			Result := False
		else begin
			aSecond := aFirst;
			Inc(aSecond);
			if aSecond = aNextFirst then begin
				Result := aFirst.CommandType = ctMoveTo;
				if Result then
					aPartType := cpPoint;
			end
			else begin
				aLast := aNextFirst;
				Dec(aLast);
				Result := True;
				if aLast.CommandType in [ctCloseByLine, ctCloseByArc] then
					aPartType := cpPolygon
				else
					aPartType := cpPolyline
			end;
		end
	end;

	procedure AddPart(aFirst, aNextFirst: PContourInternalCommand);
	var
		aPartType: TContourPartType;
		aPart: TContour;
	begin
		if IsValidPart(aFirst, aNextFirst, aPartType) then
			if aPartType in aFilter then begin
				aPart := TContour.Create;
				aPart.BeginUpdate;
				try
					while aFirst <> aNextFirst do begin
						case aFirst.CommandType of
							ctMoveTo: aPart.AddMoveTo(aFirst.Point);
							ctLineTo: aPart.AddLineTo(aFirst.Point);
							ctArcTo: aPart.AddArcTo(aFirst.Point, anArcData[aFirst.ArcData].Convexity);
							ctCloseByLine: aPart.AddCloseByLine;
							ctCloseByArc: aPart.AddCloseByArc(anArcData[aFirst.ArcData].Convexity);
						end;
						Inc(aFirst)
					end;
				finally
					aPart.EndUpdate
				end;
				aParts.Add(aPart);
			end;
	end;

var
	aCommand: PContourInternalCommand;
	aPartStart: PContourInternalCommand;
	i: Integer;
begin
	aCommand := Pointer(GetInternalCommands);
	aPartStart := aCommand;
	anArcData := GetInternalArcData;
	for i := 0 to FCommands.Count - 1 do begin
		case aCommand.CommandType of
			ctMoveTo:
				if aPartStart <> aCommand then begin
					AddPart(aPartStart, aCommand);
					aPartStart := aCommand;
				end;
			ctCloseByLine,
			ctCloseByArc:
				begin
					Inc(aCommand);
					AddPart(aPartStart, aCommand);
					aPartStart := aCommand;
					Dec(aCommand);
				end;
		end;
		Inc(aCommand);
	end;
	AddPart(aPartStart, aCommand);
end;

function TContour.HasArcs: Boolean;
begin
	if Assigned(FPacked) then
		Unpack(FPacked);
	Result := FArcData.Count > 0;
end;

function TContour.IsClear: Boolean;
begin
	if Assigned(FPacked) then
		Unpack(FPacked);

	Result := FCommands.Count = 0;
end;

function TContour.IsEqual(c: TContour): Boolean;
var
	i: Integer;
	c1, c2: TContourCommand;
begin
	if not Assigned(c) then
		Result := IsClear
	else begin
		if Assigned(FPacked) then
			Unpack(FPacked);
		if Assigned(c.FPacked) then
			c.Unpack(c.FPacked);
		Result := (FCommands.Count = c.FCommands.Count) and (FArcData.Count = c.FArcData.Count);
		if Result and (CommandCount > 0) then begin
			for i := 0 to CommandCount - 1 do begin
				c1 := GetCom(i);
				c2 := c.GetCom(i);
				if (c1.CommandType <> c2.CommandType) or
					(c1.CommandType in CommandsWithPoint) and
					not c1.Point.IsEqual(c2.Point) or
					(c1.CommandType in ArcCommands) and
					(c1.Convexity <> c2.Convexity)
				then begin
					Result := False;
					Exit;
				end;
			end;
		end;
	end;
end;

procedure TContour.AddRectSegment(const aR: TDRect; aClosed: Boolean);
begin
	with aR do begin
		AddMoveTo(DPoint(X1, Y1));
		AddLineTo(DPoint(X2, Y1));
		AddLineTo(DPoint(X2, Y2));
		AddLineTo(DPoint(X1, Y2));
		if aClosed then
			AddCloseByLine
		else
			AddLineTo(DPoint(X1, Y1));
	end;
end;

procedure TContour.AddCircleSegment(const aCenter: TDPoint; aRadius: Double;
	aClosed: Boolean);
begin
	AddMoveTo(DPoint(aCenter.X - aRadius, aCenter.Y));
	AddArcTo(DPoint(aCenter.X + aRadius, aCenter.Y), 1);
	if aClosed then
		AddCloseByArc(1)
	else
		AddArcTo(DPoint(aCenter.X - aRadius, aCenter.Y), 1);
end;

procedure TContour.AddPieSegment(const aCenter: TDPoint; aRadius, anAngle, aDegree: Double);
var
	aPoint1, aPoint2: TDPoint;
	aConvexity: Double;
begin
	AddMoveTo(aCenter);
	aPoint1 := DPoint(aCenter.x + aRadius*cos(anAngle), aCenter.y + aRadius*sin(anAngle));
	AddLineTo(aPoint1);
	if aDegree > 0.99*2*Pi then begin
		anAngle := anAngle + aDegree;
		aPoint2 := DPoint(aCenter.x + aRadius*cos(anAngle + aDegree/2),
											aCenter.y + aRadius*sin(anAngle + aDegree/2));
		aConvexity := GetConvexity2(aPoint1, aCenter, aPoint2, False);
		AddArcTo(aPoint2, aConvexity);
		aPoint1 := aPoint2
	end;
	anAngle := anAngle + aDegree;
	aPoint2 := DPoint(aCenter.x + aRadius*cos(anAngle), aCenter.y + aRadius*sin(anAngle));

	aConvexity := GetConvexity2(aPoint1, aCenter, aPoint2, False);
	AddArcTo(aPoint2, aConvexity);
	AddCloseByLine
end;

procedure TContour.SetCom(anIndex: Integer; aCommand: TContourCommand);
begin
	SetCommand(anIndex, aCommand)
end;

procedure TContour.Assign(aSrc: TContour);
begin
	if aSrc = Self then
		Exit;

	if not Assigned(aSrc) then
		Clear
	else begin
		if Assigned(FPacked) then begin
			FreeMem(FPacked);
			FPacked := nil
		end;
		if Assigned(aSrc.FPacked) then
			Unpack(aSrc.FPacked)
		else begin
			FCommands.Assign(aSrc.FCommands);
			FArcData.Assign(aSrc.FArcData);
			FPointCount := aSrc.PointCount
		end
	end;
end;

procedure TContour.Clear;
begin
	if Assigned(FPacked) then begin
		FreeMem(FPacked);
		FPacked := nil
	end else begin
		FCommands.Count := 0;
		FArcData.Count := 0;
		FPointCount := 0
	end
end;

function TContour.GetPointCount: Integer;
begin
	if Assigned(FPacked) then
		Unpack(FPacked);
	Result := FPointCount
end;

function TContour.GetCommandCount: Integer;
begin
	if Assigned(FPacked) then
		Unpack(FPacked);
	Result := FCommands.Count
end;

function TContour.GetCom(anIndex: Integer): TContourCommand;
var
	aCommand: PContourInternalCommand;
begin
	if Assigned(FPacked) then
		Unpack(FPacked);
	if (anIndex >= 0) and (anIndex < FCommands.Count) then begin
		aCommand := FCommands.GetPtr(anIndex);
		Result.CommandType := aCommand.CommandType;
		Result.Point := aCommand.Point;
		if Result.CommandType in ArcCommands then
			Result.Convexity := PContourInternalArcData(FArcData.GetPtr(aCommand.ArcData)).Convexity
		else
			Result.Convexity := 0;
	end
	else
		raise Exception.Create('Нет команды с таким индексом')
end;

function TContour.GetCommandType(anIndex: Integer): TCommandType;
begin
	if Assigned(FPacked) then
		Unpack(FPacked);
	Result := PContourInternalCommand(FCommands.GetPtr(anIndex)).CommandType;
end;

function TContour.GetCommandPoint(anIndex: Integer): TDPoint;
begin
	if Assigned(FPacked) then
		Unpack(FPacked);
	Result := PContourInternalCommand(FCommands.GetPtr(anIndex)).Point;
end;

procedure TContour.PrepareToUse;
begin
	if Assigned(FPacked) then
		Unpack(FPacked);
end;

procedure TContour.CalculateCenter(anIndex: Integer);
var
	anEdge: TContourEdge;
	anArcData: PContourInternalArcData;
	aCommand: PContourInternalCommand;
begin
	if (anIndex >= 0) and (anIndex < FCommands.Count) then
		if anEdge.Init(Self, anIndex, False) and  anEdge.IsArc then begin
			aCommand := PContourInternalCommand(FCommands.GetPtr(anIndex));
			anArcData := FArcData.GetPtr(aCommand.ArcData);
			if GetCenter2(anEdge.P1, anEdge.P2, anArcData.Convexity, anArcData.Delta, anArcData.Center) then
				anArcData.Radius := anArcData.Center.DistanceFrom(anEdge.P1)
			else begin
				case aCommand.CommandType of
					ctArcTo: aCommand.CommandType := ctLineTo;
					ctCloseByArc: aCommand.CommandType := ctCloseByLine;
				end;
				aCommand.ArcData := $FFFF;
			end;
		end
end;

procedure TContour.Unpack(aPacked: Pointer);
var
	aCommands: Pointer;
	aPoints: PDPoint;
	aPointsSize, aCommandsSize: Integer;

	procedure SetCapacity;
	var
		aCommandsCapacity, anArcDataCapacity: Integer;
		aType: TCommandType;
		aCount: Byte;
		aPtr: Pointer;
		aLimit: Longint;
	begin
		aPtr := aCommands;
		FPointCount := 0;
		aCommandsCapacity := 0;
		anArcDataCapacity := 0;
		aLimit := LongInt(aCommands) + aCommandsSize;
		while LongInt(aPtr) < aLimit do begin
			aType := PCommandType(aPtr)^;
			Inc(Longint(aPtr), sizeof(TCommandType));
			if aType in MultipleCommands then begin
				aCount := Byte(aPtr^);
				Inc(FPointCount, aCount);
				Inc(aCommandsCapacity, aCount);
				if aType = ctArcTo then
					Inc(anArcDataCapacity, aCount);
				Inc(Longint(aPtr));
			end
			else begin
				aCount := 1;
				Inc(aCommandsCapacity);
				if aType = ctCloseByArc then
					Inc(anArcDataCapacity)
			end;
			if aType in ArcCommands then
				Inc(Longint(aPtr), aCount*sizeof(Double));
		end;
		FCommands.SetCapacity(aCommandsCapacity);
		FArcData.SetCapacity(anArcDataCapacity)
	end;

	procedure RecognizeCommands;
	var
		aDstCommand: TContourInternalCommand;
		aDstArcData: TContourInternalArcData;
		aSrcCommand: Pointer;
		aDstCommandType: TCommandType;

		aSegmentStartPoint,
		aPrevPoint,
		aCurPoint: PDPoint;
		
		aCount, i: Byte;
		aSrcLimit: Longint;
	begin
		aSrcCommand := aCommands;
		aSegmentStartPoint := aPoints;
		aPrevPoint := nil;
		aCurPoint := aSegmentStartPoint;
		aSrcLimit := Longint(aCommands) + aCommandsSize;
		while Longint(aSrcCommand) < aSrcLimit do begin
			aDstCommandType := TCommandType(aSrcCommand^);
			Inc(Longint(aSrcCommand), sizeof(TCommandType));
			if aDstCommandType in MultipleCommands then begin
				aCount := Byte(aSrcCommand^);
				Inc(Longint(aSrcCommand))
			end
			else
				aCount := 1;
			for i := 0 to aCount - 1 do begin
				aDstCommand.CommandType := aDstCommandType;
				case aDstCommandType of
					ctMoveTo:
						begin
							aDstCommand.Point := aCurPoint^;
							aDstCommand.ArcData := $FFFF;
							aSegmentStartPoint := aCurPoint;
							aPrevPoint := aCurPoint;
							Inc(aCurPoint);
						end;
					ctLineTo:
						begin
							aDstCommand.Point := aCurPoint^;
							aDstCommand.ArcData := $FFFF;
							aPrevPoint := aCurPoint;
							Inc(aCurPoint);
						end;
					ctArcTo:
						begin
							aDstCommand.Point := aCurPoint^;
							aDstArcData.Convexity := Double(aSrcCommand^);
							Inc(Longint(aSrcCommand), sizeof(Double));
							if (aPrevPoint = nil) or (Abs(aDstArcData.Convexity) < minConvexity2) then begin
								aDstCommand.CommandType := ctLineTo;
								aDstCommand.ArcData := $FFFF;
							end
							else begin
								aDstCommand.ArcData := FArcData.Count;
								with aDstArcData do begin
									if GetCenter2(aPrevPoint^, aDstCommand.Point, Convexity, Delta, Center) then begin
										Radius := Center.DistanceFrom(aDstCommand.Point);
										FArcData.Add(aDstArcData);
									end
									else begin
										aDstCommand.CommandType := ctLineTo;
										aDstCommand.ArcData := $FFFF;
									end;
								end;
							end;
							aPrevPoint := aCurPoint;
							Inc(aCurPoint);
						end;
					ctCloseByLine:
						begin
							aDstCommand.Point := aSegmentStartPoint^;
							aDstCommand.ArcData := $FFFF;
						end;
					ctCloseByArc:
						begin
							aDstCommand.Point := aSegmentStartPoint^;
							aDstArcData.Convexity := Double(aSrcCommand^);
							Inc(Longint(aSrcCommand), sizeof(Double));
							if (aPrevPoint = nil) or (Abs(aDstArcData.Convexity) < minConvexity2) then begin
								aDstCommand.CommandType := ctCloseByLine;
								aDstCommand.ArcData := $FFFF;
							end
							else begin
								aDstCommand.ArcData := FArcData.Count;
								with aDstArcData do begin
									if GetCenter2(aPrevPoint^, aDstCommand.Point, Convexity, Delta, Center) then begin
										Radius := Center.DistanceFrom(aDstCommand.Point);
										FArcData.Add(aDstArcData);
									end
									else begin
										aDstCommand.CommandType := ctCloseByLine;
										aDstCommand.ArcData := $FFFF;
									end;
								end;
							end;
						end;
				end;
				FCommands.Add(aDstCommand);
			end
		end;
	end;

var
	aPtr: Pointer;
begin
	aPointsSize := Longint(aPacked^);
	aPoints := Pointer(Longint(aPacked) + sizeof(Longint));
	aPtr := Pointer(Longint(aPacked) + sizeof(Longint) + aPointsSize);
	aCommandsSize := Longint(aPtr^);
	aCommands := Pointer(Longint(aPtr) + sizeof(Longint));
	SetCapacity;
	RecognizeCommands;
	if Assigned(FPacked) then begin
		FreeMem(FPacked);
		FPacked := nil
	end
end;

procedure TContour.LoadFromStream(aStream: TStream);
var
	aPartCount, aCount, i, j: SmallInt;
	aPoint, anArcPoint, aPrevPoint: TDPoint;
	aClosed: Boolean;
	aCode: Char;
	aConvexity, aSaveConvexity: Double;
	aPointsSize, aSize: Integer;
	aP: Pointer;
begin
	Clear;
	if DataVersion >= $0106 then begin
		aStream.ReadBuffer(aPointsSize, sizeof(aPointsSize));
		GetMem(FPacked, aPointsSize + sizeof(aPointsSize));
		PInteger(FPacked)^ := aPointsSize;
		aP := Pointer(LongInt(FPacked) + sizeof(aPointsSize));
		aStream.ReadBuffer(aP^, aPointsSize);
		aStream.ReadBuffer(aSize, sizeof(aSize));
		ReallocMem(FPacked, aPointsSize + aSize + 2*sizeof(aSize));
		aP := Pointer(LongInt(FPacked) + aPointsSize + sizeof(aSize));
		PInteger(aP)^ := aSize;
		aP := Pointer(LongInt(aP) + sizeof(aSize));
		aStream.ReadBuffer(aP^, aSize);
	end else begin
		aStream.ReadBuffer(aClosed, sizeof(aClosed));
		aStream.ReadBuffer(aPartCount, sizeof(aPartCount));
		for i := 0 to aPartCount - 1 do begin
			aSaveConvexity := 0;
			if DataVersion < $0104 then begin
				aStream.ReadBuffer(aPoint, sizeof(aPoint));
				AddMoveTo(aPoint);
				aStream.ReadBuffer(aCount, sizeof(aCount));
			end else begin
				aStream.ReadBuffer(aCount, sizeof(aCount));
				Dec(aCount);
				aStream.ReadBuffer(aCode, sizeof(aCode));
				if aCode = 'a' then
					aStream.ReadBuffer(aSaveConvexity, sizeof(aSaveConvexity));
				aStream.ReadBuffer(aPoint, sizeof(aPoint));
				AddMoveTo(aPoint);
			end;
			for j := 0 to aCount - 1 do begin
				aStream.ReadBuffer(aCode, sizeof(aCode));
				case aCode of
				's': 	begin
								aStream.ReadBuffer(aPoint, sizeof(aPoint));
								AddLineTo(aPoint);
							end;
				'a': 	begin
								if DataVersion >= $0104 then
									aStream.ReadBuffer(aConvexity, sizeof(aConvexity));
								aStream.ReadBuffer(anArcPoint, sizeof(anArcPoint));
								if DataVersion < $0104 then begin
									aPrevPoint := aPoint;
									aStream.ReadBuffer(aPoint, sizeof(aPoint));
									if not GetConvexity(aPrevPoint, anArcPoint, aPoint, aConvexity) then
										aConvexity := 0;
								end else
									aPoint := anArcPoint;
								if aConvexity = 0 then
									AddLineTo(aPoint)
								else
									AddArcTo(aPoint, aConvexity)
							end;
				end;
			end;
			if aClosed then
				if aSaveConvexity = 0 then
					AddCloseByLine
				else
					AddCloseByArc(aSaveConvexity)
		end;
	end;
end;

procedure TContour.SaveToStream(aStream: TStream);
var
	aP, aCur: Pointer;
	aSize: Integer;

	procedure PackPoints;
	var
		aPoint: TContourPoint;
		aPointPtr: PDPoint;
	begin
		aPointPtr := aP;
		aSize := 0;
		aPoint.Init(Self, 0);
		while not aPoint.EndOfContour do begin
			aPointPtr^ := aPoint.Point;
			Inc(aPointPtr);
			Inc(aSize, sizeof(TDPoint));
			aPoint.Next
		end
	end;

	procedure PackCommands;
	var
		aCount: PByte;
		aCommand: PContourInternalCommand;
		aLastCommandType: TCommandType;
		i: Integer;
	begin
		aCur := aP;
		aCount := aP;
		aLastCommandType := ctNone;
		for i := 0 to FCommands.Count - 1 do begin
			aCommand := FCommands.GetPtr(i);
			if (aCommand.CommandType <> aLastCommandType) or
					not (aLastCommandType in MultipleCommands) or
					 (aCount^ > 254) then begin
				aLastCommandType := aCommand.CommandType;
				PCommandType(aCur)^ := aLastCommandType;
				Inc(PCommandType(aCur));
				aCount := aCur;
				aCount^ := 0;
				if aLastCommandType in MultipleCommands then
					Inc(PByte(aCur))
			end;
			if aLastCommandType in MultipleCommands then
				Inc(aCount^);
			if aLastCommandType in ArcCommands then begin
				PDouble(aCur)^ := PContourInternalArcData(FArcData.GetPtr(aCommand.ArcData)).Convexity;
				Inc(PDouble(aCur))
			end
		end;
		aSize := LongInt(aCur) - LongInt(aP)
	end;

begin
	if Assigned(FPacked) then begin
		aSize := PInteger(FPacked)^ + sizeof(Integer);
		aCur := Pointer(LongInt(FPacked) + aSize);
		Inc(aSize, PInteger(aCur)^ + sizeof(Integer));
		aStream.WriteBuffer(FPacked^, aSize)
	end else begin
		GetMem(aP, FCommands.Count * sizeof(TDPoint));
		try
			PackPoints;
			aStream.WriteBuffer(aSize, sizeof(aSize));
			aStream.WriteBuffer(aP^, aSize);
			PackCommands;
			aStream.WriteBuffer(aSize, sizeof(aSize));
			aStream.WriteBuffer(aP^, aSize)
		finally
			FreeMem(aP)
		end
	end
end;

function TContour.GetBounds(var aBounds: TDRect): Boolean;
var
	anEdge: TEdge;
var
	aCommand,
	aLastCommandWithPoint: PContourInternalCommand;
	aSegmentStart: PContourInternalCommand;
	anArcData: PContourInternalArcDataArray;
	i: Integer;
begin
	if Assigned(FPacked) then
		Unpack(FPacked);

	Result := False;
	aCommand := FCommands.Items;
	for i := 0 to FCommands.Count - 1 do begin
		if aCommand.CommandType in CommandsWithPoint then
			if Result then
				aBounds.Expand(aCommand.Point)
			else begin
				Result := True;
				aBounds.AssignPoints(aCommand.Point, aCommand.Point);
			end;
		Inc(aCommand);
	end;
	anArcData := FArcData.Items;
	aCommand := FCommands.Items;
	aSegmentStart := nil;
	aLastCommandWithPoint := nil;
	for i := 0 to FCommands.Count - 1 do begin
		if Assigned(aLastCommandWithPoint) then
			case aCommand.CommandType of
				ctArcTo:
					begin
						anEdge.P1 := aLastCommandWithPoint.Point;
						anEdge.P2 := aCommand.Point;
						anEdge.Center := anArcData[aCommand.ArcData].Center;
						anEdge.C := anArcData[aCommand.ArcData].Convexity;
						anEdge.Delta := anArcData[aCommand.ArcData].Delta;
						anEdge.Radius := anArcData[aCommand.ArcData].Radius;
						DRectExpandByRect(aBounds, anEdge.GetBounds);
					end;
				ctCloseByArc:
					begin
						anEdge.P1 := aLastCommandWithPoint.Point;
						anEdge.P2 := aSegmentStart.Point;
						anEdge.Center := anArcData[aCommand.ArcData].Center;
						anEdge.C := anArcData[aCommand.ArcData].Convexity;
						anEdge.Delta := anArcData[aCommand.ArcData].Delta;
						anEdge.Radius := anArcData[aCommand.ArcData].Radius;
						DRectExpandByRect(aBounds, anEdge.GetBounds);
					end;
			end;
		if aCommand.CommandType in CommandsWithPoint then begin
			aLastCommandWithPoint := aCommand;
			if (aCommand.CommandType = ctMoveTo) or (aSegmentStart = nil) then
				aSegmentStart := aCommand;
		end;
		Inc(aCommand);
	end;
end;

function TContour.ContainsPoint(aPoint: TDPoint): TPointRelation;
var
	aSegment: TContourSegment;
	anEdge: TContourEdge;
	aPoints: TDPointArray;
	i, j: Integer;
begin
	Result := prBorderPoint;
	aSegment.Init(Self, 0);
	while not aSegment.EndOfContour do begin
		if aSegment.Closed then begin
			anEdge.Init(Self, aSegment.FirstIndex, True);
			while anEdge.Index <= aSegment.LastIndex do begin
				if anEdge.Contains(aPoint, kMinZone) then
					Exit;

				anEdge.Next
			end
		end;
		aSegment.Next;
	end;

	aPoints.Clear(0);

	aSegment.Init(Self, 0);
	while not aSegment.EndOfContour do begin
		if aSegment.Closed then
			aPoints.Add(GetInnerPolygonXIntersection(aSegment, aPoint.y, kMinZone));

		aSegment.Next;
	end;

	j := 0;
	for i := 0 to aPoints.Count - 1 do
		if aPoints.GetItem(i).x > aPoint.x then
			Inc(j);

	if (j mod 2) = 1 then
		Result := prInteriorPoint
	else
		Result := prNone;
end;

function TContour.GetTouchInfo(aPoint: TDPoint; aDelta: Double; anOptions: TTouchOptions): TTouch;
var
	aP: TContourPoint;
	anEdge: TContourEdge;
begin
	Result.Where := TouchNone;
	if TouchVertex in anOptions then begin
		aP.Init(Self, 0);
		while not aP.EndOfContour do begin
			if aP.Point.CloselyTo(aPoint, aDelta) then begin
				Result.Where := TouchVertex;
				Result.Index := aP.Index;
				Result.Point := aP.Point;
				Exit;
			end;
			aP.Next
		end
	end;
	if TouchEdge in anOptions then begin
		anEdge.Init(Self, 0, True);
		while not anEdge.EndOfContour do begin
			if anEdge.DistanceFromPoint(aPoint) <= aDelta then begin
				Result.Where := TouchEdge;
				Result.Index := anEdge.Index;
				Result.Point := anEdge.GetClosestPoint(aPoint);
				Exit;
			end;
			anEdge.Next
		end
	end;
	if TouchInside in anOptions then
		if ContainsPoint(aPoint) = prInteriorPoint then
			Result.Where := TouchInside
end;

function TContour.GetTouchInfo(aPoint: TDPoint; aDelta: Double; anOpaque: Boolean; var aMeasure: Double): TTouchInfo;
var
	aCommands: PContourInternalCommandArray;
	aFirst,
	aStart,
	aLimit,
	aPrev,
	aCommand: PContourInternalCommand;
	anArcData: PContourInternalArcDataArray;

	function IsClosedPart(c: PContourInternalCommand): Boolean;
	begin
		if anOpaque then
			while (PChar(c) < PChar(aLimit)) and (c.CommandType <> ctMoveTo) do
				if c.CommandType in CloseCommands then begin
					Result := True;
					Exit;
				end
				else
					Inc(c);
		Result := False;
	end;

var
	aCheck: Boolean;
	aP1, aP2: TDPoint;
	anArc: PContourInternalArcData;
begin
	anArcData := GetInternalArcData;
	aCommands := GetInternalCommands;
	aFirst := @aCommands[0];
	aLimit := @aCommands[CommandCount];

	aCommand := aFirst;
	while PChar(aCommand) < PChar(aLimit) do begin
		if aCommand.CommandType in CommandsWithPoint then
			if aCommand.Point.CloselyTo(aPoint, aDelta) and not IsClosedPart(aCommand) then begin
				aMeasure := aCommand.Point.DistanceFrom(aPoint);
				Result := TouchVertex;
				Exit;
			end;
		Inc(aCommand);
	end;

	aCommand := aFirst;

	aStart := aCommand;
	aPrev := aCommand;

	while PChar(aCommand) < PChar(aLimit) do begin
		aCheck := False;
		anArc := nil;

		case aCommand.CommandType of
			ctMoveTo: aStart := aCommand;
			ctLineTo,
			ctArcTo:
				if aCommand = aFirst then aStart := aCommand
				else begin
					aCheck := True;
					aP1 := aPrev.Point;
					aP2 := aCommand.Point;
					if aCommand.CommandType = ctArcTo then
						anArc := @anArcData[aCommand.ArcData];
				end;
			ctCloseByLine,
			ctCloseByArc:
				begin
					if aCommand <> aStart then begin
						aCheck := True;
						aP1 := aPrev.Point;
						aP2 := aStart.Point;
						if aCommand.CommandType = ctCloseByArc then
							anArc := @anArcData[aCommand.ArcData]
					end;
					aStart := aCommand;
					Inc(aStart);
				end;
		end;
		if aCheck then begin
			aMeasure := DistanceToEdge(aPoint, aP1, aP2, anArc);
			if (aMeasure < aDelta) and not IsClosedPart(aCommand) then begin
				Result := TouchEdge;
				Exit
			end;
		end;
		aPrev := aCommand;
		Inc(aCommand);
	end;
	if anOpaque and (ContainsPoint(aPoint) = prInteriorPoint) then begin
		Result := TouchInside;
		aMeasure := GetSquare;
	end
	else
		Result := TouchNone;
end;

function TContour.GetPrevPointIndex(anIndex: Integer): Integer;
var
	aSegment: TContourSegment;
	aCommand: PContourInternalCommand;
begin
	Result := -1;
	aSegment.Init(Self, anIndex);
	if not aSegment.EndOfContour then
		if aSegment.FirstIndex = anIndex then begin
			Result := aSegment.LastIndex;
			aCommand := FCommands.GetPtr(Result);
			if not (aCommand.CommandType in CommandsWithPoint) then
				Dec(Result);
			if Result <= aSegment.FirstIndex then
				Result := -1
		end else
			Result := anIndex - 1;
end;

function TContour.GetNextPointIndex(anIndex: Integer): Integer;
var
	aSegment: TContourSegment;
	aCommand: PContourInternalCommand;
begin
	Result := -1;
	aSegment.Init(Self, anIndex);
	if not aSegment.EndOfContour then begin
		aCommand := FCommands.GetPtr(aSegment.LastIndex);
		if (aSegment.LastIndex = anIndex) or
				((aCommand.CommandType in CloseCommands) and
				(aSegment.LastIndex = anIndex + 1)) then
			if aSegment.FirstIndex = anIndex then
				Result := -1
			else
				Result := aSegment.FirstIndex
		else
			Result := anIndex + 1;
	end
end;

procedure TContour.ClipByRect(const aRect: TDRect);
var
	aBounds: TDRect;
begin
	if GetBounds(aBounds) then
		if not DRectContainsRect(aRect, aBounds) then begin
			ClippingContour.Assign(Self);
			MakeClipping(aRect, aBounds);
			Assign(ClippingContour);
		end;
end;

function TContour.GetSimpleSquare: Double;
var
	aSegment: TContourSegment;
	anEdge: TContourEdge;
begin
	Result := 0;
	aSegment.Init(Self, 0);
	while not aSegment.EndOfContour do begin
		if aSegment.Closed then begin
			anEdge.Init(Self, aSegment.FirstIndex, True);
			while anEdge.Index <= aSegment.LastIndex do begin
				Result := Result + anEdge.GetSquare;
				anEdge.Next
			end
		end;
		aSegment.Next
	end;
end;

function TContour.IsInsideOrIntersected(c: TContour): Boolean;
var
	aCommand: PContourInternalCommand;
	i: Integer;
begin
	aCommand := Pointer(GetInternalCommands);
	for i := 0 to FCommands.Count - 1 do begin
		if aCommand.CommandType in CommandsWithPoint then
			if c.ContainsPoint(aCommand.Point) <> prNone then begin
				Result := True;
				Exit;
			end;
		Inc(aCommand);
	end;
	Result := False;
end;

function TContour.GetSquare: Double;
var
	aParts: TObjectList;
	aPart: TContour;

	aSquares: array of Double;
	anInteriorPoints: array of TDPoint;
	anInteriorPointsCalculated: array of Boolean;

	aHole: Boolean;
	i, j: Integer;
begin
	aParts := TObjectList.Create;
	try
		GetParts(aParts, [cpPolygon]);

		Result := 0;
		if aParts.Count = 1 then
			Result := abs(TContour(aParts[0]).GetSimpleSquare)
		else begin
			SetLength(aSquares, aParts.Count);
			SetLength(anInteriorPoints, aParts.Count);
			SetLength(anInteriorPointsCalculated, aParts.Count);

			for i := 0 to aParts.Count - 1 do begin
				aPart := aParts[i];

				aSquares[i] := Abs(aPart.GetSimpleSquare);
				anInteriorPointsCalculated[i] := GetInteriorContourPoint(aPart, anInteriorPoints[i]);
				if not anInteriorPointsCalculated[i] and (aSquares[i] > kMinZone2) then
					Assert(False, 'Can''t calculate interior contour point');
			end;

			// используем тот факт, что для aPart.IsInsideOrIntersected(aParts[j]) необходимо чтобы
			// aPart.GetSimpleSquare <= aParts[j].GetSimpleSquare, это позволяет лишний раз не проводить проверку
			// aPart.ContainsPoint(aParts[j]), т.к. это может оказаться довольно долго
			for i := 0 to aParts.Count - 1 do begin
				aHole := False;
				for j := 0 to aParts.Count - 1 do begin
					aPart := aParts[j];
					if (i <> j) and (aSquares[i] <= aSquares[j]) and
						anInteriorPointsCalculated[i] and (aPart.ContainsPoint(anInteriorPoints[i]) <> prNone)
					then
						aHole := not aHole;
				end;

				if aHole then
					Result := Result - aSquares[i]
				else
					Result := Result + aSquares[i]
			end;
		end;
	finally
		aParts.Free
	end;
end;

function TContour.GetPerimeter: Double;
var
	anEdge: TContourEdge;
begin
	Result := 0;
	anEdge.Init(Self, 0, True);
	while not anEdge.EndOfContour do begin
		Result := Result + anEdge.GetLength;
		anEdge.Next
	end
end;

procedure TContour.Revert;
var
	aSegment: TContourSegment;
	aResult: TContour;
	anEdge: TContourEdge;
	anInsertIndex: Integer;

	procedure RevertClosedSegment;
	var
		aBegin: Boolean;
	begin
		anEdge.Init(Self, aSegment.FirstIndex, False);
		if not anEdge.EndOfContour and (anEdge.Index <> aSegment.FirstIndex) then
			anInsertIndex := aResult.AddCommand(Commands[aSegment.FirstIndex]) + 1
		else
			anInsertIndex := aResult.FCommands.Count;
		aBegin := False;
		while not anEdge.EndOfContour and (anEdge.Index <= aSegment.LastIndex) do begin
			if aBegin then
				if anEdge.IsLine then
					aResult.InsertCommand(anInsertIndex, ContourLineTo(anEdge.P1))
				else
					aResult.InsertCommand(anInsertIndex, ContourArcTo(anEdge.P1, -anEdge.C))
			else begin
				if anEdge.IsLine then
					aResult.InsertCommand(anInsertIndex, ContourCloseByLine)
				else
					aResult.InsertCommand(anInsertIndex, ContourCloseByArc(-anEdge.C));
				aBegin := True
			end;
			anEdge.Next
		end
	end;

	procedure RevertUnclosedSegment;
	begin
		anEdge.Init(Self, aSegment.FirstIndex, False);
		anInsertIndex := aResult.FCommands.Count;
		while not anEdge.EndOfContour and (anEdge.Index <= aSegment.LastIndex) do begin
			if anEdge.IsLine then
				aResult.InsertCommand(anInsertIndex, ContourLineTo(anEdge.P1))
			else
				aResult.InsertCommand(anInsertIndex, ContourArcTo(anEdge.P1, -anEdge.C));
			if anEdge.Index = aSegment.LastIndex then
				aResult.InsertCommand(anInsertIndex, ContourMoveTo(anEdge.P2));
			anEdge.Next
		end;
	end;

begin
	aResult := TContour.Create;
	try
		aResult.FCommands.SetCapacity(FCommands.Count + 1);
		aResult.FArcData.SetCapacity(FArcData.Count);
		aSegment.Init(Self, 0);
		while not aSegment.EndOfContour do begin
			if aSegment.Closed then
				RevertClosedSegment
			else
				RevertUnclosedSegment;
			aSegment.Next
		end;
		Assign(aResult)
	finally
		aResult.Free
	end
end;

function TContour.ApplyTransform(aTfList: TList; aPoints: TWordList): Boolean;
var
	aPoint: TContourPoint;
	aTf: TTransformer;
	aP: TDPoint;
begin
	Result := False;
	aTf := nil;
	if aTfList.Count > 0 then
		aTf := TTransformer(aTfList[0]);
	aPoint.Init(Self, 0);
	while not aPoint.EndOfContour do begin
		if not Assigned(aPoints) or (aPoints.IndexOf(aPoint.Index) > -1) then begin
			if Assigned(aPoints) then
				aTf := TTransformer(aTfList[aPoints.IndexOf(aPoint.Index)]);
			aP := aTf.TransformPoint(aPoint.Point);
			if not aP.IsEqual(aPoint.Point) then begin
				SetPoint(aPoint.Index, aP);
				Result := True
			end
		end;
		aPoint.Next
	end
end;

procedure TContour.CorrectCenters(anIndex: Integer; aType: TCommandType);
var
	i: Integer;
	aCommand: PContourInternalCommand;
begin
	if (aType = ctMoveTo) or (anIndex = 0) then begin
		if anIndex + 1 < FCommands.Count then
			CalculateCenter(anIndex + 1);
		for i := anIndex + 1 to FCommands.Count - 1 do begin
			aCommand := FCommands.GetPtr(i);
			if aCommand.CommandType = ctMoveTo then
				Exit;
			if aCommand.CommandType in CloseCommands then begin
				CalculateCenter(i);
				if i + 1 < FCommands.Count then
					CalculateCenter(i + 1)
			end
		end
	end else begin
		CalculateCenter(anIndex);
		CalculateCenter(anIndex + 1)
	end
end;

procedure TContour.InsertCommand(anIndex: Integer; const aCommand: TContourCommand);
var
	anArcData: TContourInternalArcData;
	aCom: TContourInternalCommand;
begin
	if Assigned(FPacked) then
		Unpack(FPacked);
	if aCommand.CommandType in ArcCommands then begin
		anArcData.Convexity := aCommand.Convexity;
		aCom.ArcData := FArcData.Count;
		FArcData.Add(anArcData)
	end;
	if aCommand.CommandType in CommandsWithPoint then
		Inc(FPointCount);
	aCom.CommandType := aCommand.CommandType;
	aCom.Point := aCommand.Point;
	FCommands.Insert(anIndex, aCom);
	if FUpdateCount = 0 then
		CorrectCenters(anIndex, aCommand.CommandType)
end;

function TContour.AddCommand(const aCommand: TContourCommand): Integer;
var
	anArcData: TContourInternalArcData;
	aCom: TContourInternalCommand;
begin
	if Assigned(FPacked) then
		Unpack(FPacked);
	if aCommand.CommandType in ArcCommands then begin
		anArcData.Convexity := aCommand.Convexity;
		FArcData.Add(anArcData);
		aCom.ArcData := FArcData.Count - 1
	end;
	if aCommand.CommandType in CommandsWithPoint then
		Inc(FPointCount);
	aCom.CommandType := aCommand.CommandType;
	aCom.Point := aCommand.Point;
	FCommands.Add(aCom);
	Result := FCommands.Count - 1;
	if FUpdateCount = 0 then
		CalculateCenter(Result)
end;

var
	MoveToCommand: TContourCommand = (CommandType:ctMoveTo);

function TContour.AddMoveTo(const aP: TDPoint): Integer;
begin
	MoveToCommand.Point := aP;
	Result := AddCommand(MoveToCommand);
end;

var
	LineToCommand: TContourCommand = (CommandType:ctLineTo);

function TContour.AddLineTo(const aP: TDPoint): Integer;
begin
	LineToCommand.Point := aP;
	Result := AddCommand(LineToCommand);
end;

var
	AcrToCommand: TContourCommand = (CommandType:ctArcTo);

function TContour.AddArcTo(const aP: TDPoint; aConvexity: Double): Integer;
begin
	AcrToCommand.Point := aP;
	AcrToCommand.Convexity := aConvexity;
	Result := AddCommand(AcrToCommand);
end;

function TContour.AddCloseByLine: Integer;
const
	aCommand: TContourCommand = (CommandType:ctCloseByLine);
begin
	Result := AddCommand(aCommand);
end;

var
	CloseByArcCommand: TContourCommand = (CommandType:ctCloseByArc);

function TContour.AddCloseByArc(aConvexity: Double): Integer;
begin
	CloseByArcCommand.Convexity := aConvexity;
	Result := AddCommand(CloseByArcCommand);
end;

procedure TContour.AddContour(aSrc: TContour);
var
	i: Integer;
begin
	for i := 0 to aSrc.CommandCount - 1 do
		AddCommand(aSrc.Commands[i])
end;

function TContour.SetCommand(anIndex: Integer; const aCommand: TContourCommand): Boolean;
begin
	if (anIndex < 0) or (anIndex >= FCommands.Count) then
		raise Exception.Create('Неверный индекс изменяемой команды');
	Result := not CommandsAreEqual(aCommand, Commands[anIndex]);
	if Result then begin
		DeleteCommand(anIndex);
		InsertCommand(anIndex, aCommand)
	end
end;

procedure TContour.DeleteCommand(anIndex: Integer);

	procedure ShiftArcData(anIndex: Integer);
	var
		aCommand: PContourInternalCommand;
		i: Integer;
	begin
		FArcData.Delete(anIndex);
		for i := 0 to FCommands.Count - 1 do begin
			aCommand := FCommands.GetPtr(i);
			if aCommand.ArcData > anIndex then
				Dec(aCommand.ArcData)
		end
	end;

var
	aCommand: TContourInternalCommand;
begin
	if Assigned(FPacked) then
		Unpack(FPacked);
	if (anIndex < 0) or (anIndex >= FCommands.Count) then
		raise Exception.Create('Неверный индекс удаляемой команды');
	aCommand := PContourInternalCommand(FCommands.GetPtr(anIndex))^;
	if aCommand.CommandType in CommandsWithPoint then
		Dec(FPointCount);
	FCommands.Delete(anIndex);
	if aCommand.CommandType in ArcCommands then
		ShiftArcData(aCommand.ArcData);
	if FUpdateCount = 0 then
		CorrectCenters(anIndex, aCommand.CommandType)
end;

procedure TContour.SetPoint(anIndex: Integer; aPoint: TDPoint);
var
	aCommand: PContourInternalCommand;
begin
	if Assigned(FPacked) then
		Unpack(FPacked);
	if (anIndex < 0) or (anIndex >= FCommands.Count) then
		raise Exception.Create('Неверный индекс изменяемой точки');
	aCommand := FCommands.GetPtr(anIndex);
	aCommand.Point := aPoint;
	if FUpdateCount = 0 then
		CorrectCenters(anIndex, aCommand.CommandType)
end;

procedure TContour.SetConvexity(anIndex: Integer; aConvexity: Double);
var
	aCommand: PContourInternalCommand;
begin
	if Assigned(FPacked) then
		Unpack(FPacked);
	if (anIndex < 0) or (anIndex >= FCommands.Count) then
		raise Exception.Create('Неверный индекс изменяемой кривизны');
	aCommand := FCommands.GetPtr(anIndex);
	PContourInternalArcData(FArcData.GetPtr(aCommand.ArcData)).Convexity := aConvexity;
	if FUpdateCount = 0 then
		CalculateCenter(anIndex)
end;

{	TContourPoint	}

procedure TContourPoint.Init(aContour: TContour; anIndex: Integer);
begin
	if Assigned(aContour.FPacked) then
		aContour.Unpack(aContour.FPacked);
	Contour := aContour;
	Index := anIndex - 1;
	Next
end;

procedure TContourPoint.Next;
var
	aCommand: PContourInternalCommand;
begin
	Inc(Index);
	if (Index < Contour.FCommands.Count) then begin
		aCommand := PContourInternalCommand(Contour.FCommands.GetPtr(Index));
		if aCommand.CommandType in CommandsWithPoint then
			Point := aCommand.Point
		else
			Next
	end
end;

function TContourPoint.EndOfContour: Boolean;
begin
	Result := Index >= Contour.FCommands.Count
end;

{	TEdge	}

function TEdge.DistanceFromPoint(aPoint: TDPoint): Double;
var
	aDistance: Double;
begin
	if IsArc then
		if AngleInRange(GetAngle(Center, aPoint), GetAngle(Center, P1), Delta) then
			Result := Abs(Radius - Center.DistanceFrom(aPoint))
		else begin
			Result := aPoint.DistanceFrom(P1);
			aDistance := aPoint.DistanceFrom(P2);
			if Result < aDistance then Result := aDistance
		end
	else
		Result := aPoint.DistanceFromSegment(P1, P2);
end;

function TEdge.GetClosestPoint(aPoint: TDPoint): TDPoint;
var
	aCoordSys: TCoordSys;
	anAlfa: Double;
	aSin, aCos: Extended;
begin
	if IsArc then begin
		anAlfa := GetAngle(Center, aPoint);
		if AngleInRange(anAlfa, GetAngle(Center, P1), Delta) then begin
			SinCos(anAlfa, aSin, aCos);
			Result := DPoint(Center.x + Radius*aCos, Center.y + Radius*aSin)
		end else begin
			Result := P1;
			if aPoint.DistanceFrom(P1) > aPoint.DistanceFrom(P2) then
				Result := P2
		end
	end else begin
		aCoordSys.InitPoints(P1, P2);
		aCoordSys.MakeLocal(aPoint);
		if aPoint.X < 0 then
			Result := P1
		else if aPoint.X > aCoordSys.ToLocal(P2).X then
			Result := P2
		else
			Result := aCoordSys.ToGlobal(DPoint(aPoint.x, 0));
	end;
end;

function TEdge.XDIntersected(aPoint: TDPoint): Boolean;
var
	aPoint1, aPoint2: TDPoint;
	aShift: Double;
begin
	Result := False;
	if IsArc then
		if Radius >= Abs(Center.y - aPoint.y) then begin
			aShift := Sqrt(Sqr(Radius) - Sqr(Center.y - aPoint.y));
			aPoint1 := DPoint(Center.x - aShift, aPoint.y);
			aPoint2 := DPoint(Center.x + aShift, aPoint.y);
			if (aPoint1.x < aPoint.x) then
				Result :=not((aPoint.Y = P1.Y) and (Delta < 0) or
										 (aPoint.Y = P2.Y) and (Delta > 0)) and
										AngleInRange(GetAngle(Center, aPoint1), GetAngle(Center, P1), Delta);
			if (aPoint2.x < aPoint.x) then
				if not((aPoint.Y = P1.Y) and (Delta < 0) or
								(aPoint.Y = P2.Y) and (Delta > 0)) and
								AngleInRange(GetAngle(Center, aPoint2), GetAngle(Center, P1), Delta) then
					Result := not Result;
		end else
	else
		if not aPoint.IsEqual(P2) and (P1.y <> P2.y) then
			if (aPoint.y = P1.y) and (P2.y < aPoint.y) or
					(aPoint.y = P2.y) and (P1.y < aPoint.y) or
					((aPoint.y > P1.y) xor (aPoint.y > P2.y)) then
				Result := (aPoint.y - P1.y)/(P2.y - P1.y)*(P2.x - P1.x) + P1.x <= aPoint.x;
end;

function TEdge.GetDirectionOut: Double;
begin
	if IsArc then begin
		Result := GetAngle(Center, P2);
		if Delta > 0 then
			Result := Result + Pi/2
		else
			Result := Result - Pi/2
	end else
		Result := GetAngle(P1, P2);
end;

function TEdge.GetDirectionIn: Double;
begin
	if IsArc then begin
		Result := GetAngle(Center, P1);
		if Delta > 0 then
			Result := Result + Pi/2
		else
			Result := Result - Pi/2
	end else
		Result := GetAngle(P1, P2);
end;

function TEdge.Intersect(const anOther: TEdgeBase; var aP1, aP2: TDPoint): Integer;
var
	aTouched: Boolean;
begin
	Result := IntersectEdgeEdge(Self, anOther, aP1, aP2, aTouched);
end;

function TEdge.GetBounds: TDRect;
var
	alfa: Double;
	i: Integer;
const
	x: array[0..3] of Integer = (1, 0, -1, 0);
	y: array[0..3] of Integer = (0, 1, 0, -1);
begin
	Result.AssignPoints(P1, P2);
	Result.Normalized;
	if IsArc then begin
		alfa := GetAngle(Center, P1);
		for i := 0 to 3 do
			if AngleInRange(i*Pi/2, alfa, Delta) then
				Result.Expand(DPoint(Center.x + Radius*x[i], Center.y + Radius*y[i]))
	end;
end;

function TEdge.GetLength: Double;
begin
	if IsArc then
		Result := Radius * Abs(Delta)
	else
		Result := P1.DistanceFrom(P2)
end;

function TEdge.GetSquare: Double;
var
	aDelta: Double;
	aCos, aSin: Extended;
begin
	if IsArc then begin
		Result := (P2.X - P1.X)*(P2.Y + P1.Y)/2;
		aDelta := Delta / 2;
		SinCos(aDelta, aCos, aSin);
		Result := Result - Sqr(Radius)*(aDelta - aCos*aSin)
	end else
		Result := (P2.X - P1.X)*(P2.Y + P1.Y)/2
end;

{ TEdgeList }

procedure TEdgeList.Clear(aCapacity: Integer);
begin
	SetLength(FItems, Max(aCapacity, 0));
	FCount := 0;
end;

function TEdgeList.Add(const anItem: TEdge): Integer;
begin
	if FCount >= Length(FItems) then
		SetLength(FItems, Max(1, Length(FItems))*2);

	Result := FCount;
	FItems[FCount] := anItem;
	Inc(FCount);
end;

function TEdgeList.Prev(const Index: Integer): PEdge;
begin
	if Index > 0 then begin
		CheckBounds(Index, FCount);
		Result := @FItems[Index - 1]
	end
	else
		Result := @FItems[FCount - 1]
end;

function TEdgeList.Next(const Index: Integer): PEdge;
begin
	if Index < FCount - 1  then begin
		CheckBounds(Index, FCount);
		Result := @FItems[Index + 1]
	end
	else
		Result := @FItems[0];
end;

function TEdgeList.Items(const Index: Integer): PEdge;
begin
	CheckBounds(Index, FCount);
	Result := @FItems[Index];
end;

function TEdgeList.Count: Integer;
begin
	Result := FCount;
end;


{	TContourEdge	}

function TContourEdge.Init(aContour: TContour; anIndex: Integer;
	aSkipSingularEdges: Boolean): Boolean;
begin
	if Assigned(aContour.FPacked) then
		aContour.Unpack(aContour.FPacked);
	LastMoveTo := -1;
	Contour := aContour;
	Index := anIndex - 1;
	SkipSingularEdges := aSkipSingularEdges;
	Next;
	Result := not EndOfContour and (Index = anIndex)
end;

procedure TContourEdge.Next;

	procedure FindLastMoveTo(anIndex: Integer);
	begin
		while (anIndex > 0) and (PContourInternalCommand(Contour.FCommands.GetPtr(anIndex)).CommandType <> ctMoveTo) do
			Dec(anIndex);
		LastMoveTo := anIndex
	end;

var
	aCommand, aPrevCommand: PContourInternalCommand;
	anArcData: PContourInternalArcData;
begin
	if (Index >= 0) and (Index < Contour.FCommands.Count) then
		aPrevCommand := PContourInternalCommand(Contour.FCommands.GetPtr(Index))
	else
		aPrevCommand := nil;
	Inc(Index);
	if (Index < Contour.FCommands.Count) then begin
		aCommand := PContourInternalCommand(Contour.FCommands.GetPtr(Index));
		if (Index = 0) or (aCommand.CommandType = ctMoveTo) then
			LastMoveTo := Index;
		if (aCommand.CommandType in EdgeCommands) and (Index > 0) then begin
			P1Index := Index - 1;
			if aPrevCommand.CommandType in CommandsWithPoint then
				P1 := aPrevCommand.Point
			else begin
				if LastMoveTo = -1 then
					FindLastMoveTo(Index - 1);
				P1Index := LastMoveTo;
				P1 := PContourInternalCommand(Contour.FCommands.GetPtr(P1Index)).Point
			end;
			P2Index := Index;
			if aCommand.CommandType in CommandsWithPoint then
				P2 := aCommand.Point
			else begin
				if LastMoveTo = -1 then
					FindLastMoveTo(Index);
				P2Index := LastMoveTo;
				P2 := PContourInternalCommand(Contour.FCommands.GetPtr(P2Index)).Point
			end;
			if aCommand.CommandType in ArcCommands then begin
				anArcData := Contour.FArcData.GetPtr(aCommand.ArcData);
				C := anArcData.Convexity;
				Center := anArcData.Center;
				Delta := anArcData.Delta;
				Radius := anArcData.Radius
			end else
				C := 0
		end else
			Next;

		if SkipSingularEdges and (Index < Contour.FCommands.Count) and IsSingular then
			Next;
	end;
end;

function TContourEdge.EndOfContour: Boolean;
begin
	Result := Index >= Contour.FCommands.Count
end;

function TContourEdge.IsFirstEdge: Boolean;
begin
	Result := (Index = 1) or
		not (PContourInternalCommand(Contour.FCommands.GetPtr(Index - 1)).CommandType in NonBreakCommands)
end;

function TContourEdge.IsLastEdge: Boolean;
begin
	Result := (Index = Contour.CommandCount - 1) or IsClosingEdge or
		(PContourInternalCommand(Contour.FCommands.GetPtr(Index + 1)).CommandType = ctMoveTo);
end;

function TContourEdge.IsClosingEdge: Boolean;
begin
	Result := PContourInternalCommand(Contour.FCommands.GetPtr(Index)).CommandType in CloseCommands;
end;

{	TContourSegment	}

procedure TContourSegment.FindLastIndex(anIndex: Integer);
var
	aCommand: PContourInternalCommand;
	aCommands: TRecArray;
begin
	aCommands := Contour.FCommands;
	LastIndex := anIndex;
	if (anIndex >= 0) and (anIndex < aCommands.Count) then begin
		aCommand := aCommands.GetPtr(LastIndex);
		while (LastIndex < aCommands.Count - 1) and
					((aCommand.CommandType in NonBreakCommands) or
					((aCommand.CommandType = ctMoveTo) and (LastIndex = anIndex))) do begin
			Inc(LastIndex);
			aCommand := aCommands.GetPtr(LastIndex);
		end;
		if aCommand.CommandType = ctMoveTo then begin
    	if LastIndex <> 0 then
				Dec(LastIndex);
    end;
		if LastIndex >= 0 then begin
			aCommand := aCommands.GetPtr(LastIndex);
			Closed := aCommand.CommandType in CloseCommands
		end
	end else begin
		FirstIndex := 1;
		LastIndex := 0
	end
end;

procedure TContourSegment.Init(aContour: TContour; anIndex: Integer);
var
	aCommand: PContourInternalCommand;
begin
	if Assigned(aContour.FPacked) then
		aContour.Unpack(aContour.FPacked);
	Contour := aContour;
	if (anIndex >= 0) and (anIndex < Contour.FCommands.Count) then begin
		FirstIndex := anIndex;
		aCommand := Contour.FCommands.GetPtr(FirstIndex);
		while (FirstIndex > 0) and
					((aCommand.CommandType in NonBreakCommands) or
					((aCommand.CommandType in CloseCommands) and (FirstIndex = anIndex))) do begin
			Dec(FirstIndex);
			aCommand := Contour.FCommands.GetPtr(FirstIndex);
		end;
		if aCommand.CommandType in CloseCommands then
			Inc(FirstIndex);
		FindLastIndex(anIndex)
	end else begin
		FirstIndex := 1;
		LastIndex := 0
	end
end;

procedure TContourSegment.Next;
begin
	FirstIndex := LastIndex + 1;
	FindLastIndex(FirstIndex)
end;

function TContourSegment.EndOfContour: Boolean;
begin
	Result := FirstIndex > LastIndex
end;





initialization
	ClippingContour := TContour.Create;
	CacheContour := TContour.Create;
	ContourCache := TContourCache.Create(ContourCacheLimit);
finalization
	ContourCache.Free;
	ClippingContour.Free;
	CacheContour.Free
end.
