unit GeomCmd;

interface

uses Geomet, Complex, XLists, M2AddOn, Classes;

type
  TGConnectType = (gctLine,gctArc);
  PGConnect = ^TGConnect;
  TGConnect = record
    case ConnectType: TGConnectType of
      gctArc: (Arc: record Convexity : Double; end);
  end;

	TGConnectFull = record
    Pt1: TDPoint;
    Pt2: TDPoint;
    case ConnectType: TGConnectType of
      gctArc: (Arc: record Convexity : Double; end);
	end;

  PGConnectBrief = ^TGConnectBrief;
	TGConnectBrief = record
    Pt1: Integer;
    Pt2: Integer;
    case ConnectType: TGConnectType of
      gctArc: (Arc: record Convexity : Double; end);
  end;

	TGBelongType = (cbtInside, cbtOutside, cbtBoundObject, cbtBoundHole);
	PGBelongPair = ^TGBelongPair;

	TGBelongPairBase = object
		aBelong: array[0..1] of TGBelongType;
	end;
	TGBelongPair = object(TGBelongPairBase)
		public
			function IsEqual(const bp: TGBelongPairBase): Boolean;
	end;
	function GBelongPair(const bt1, bt2: TGBelongType):TGBelongPair;

	type
	TGBelongEdge = (gbeBoundObject, gbeBoundHole, gbeNot);
  PGBelongEdgePair = ^TGBelongEdgePair;

  TGBelongEdgePair = object
		aBelong: array[0..1] of TGBelongEdge;
	end;

function ReverseConnectFull(const cmd: TGConnectFull): TGConnectFull;
function GetLengthConnectFull(const cmd: TGConnectFull): Double;
function GetBoundsOfConnectFull(const cmd: TGConnectFull): TDRect;
function CompareTGConnectBriefNotStrict(const t1, t2: TGConnectBrief): Integer;
function CompareTGConnectBriefStrict(const t1, t2: TGConnectBrief): Integer;
function ReverseConnectBrief(const cmd: TGConnectBrief): TGConnectBrief;

function ConvertFromTM2ContourCommandToTComplexCommand(cmd: TM2ContourCommand): TContourCommand;
function ConvertFromTM2PointToTDPoint(p: TM2Point): TDPoint;
procedure ConvertFromTContourToIM2Contour(complex: TContour; const contour: TM2Contour);
procedure ConvertFromIM2ContourToTContour(const contour: TM2Contour; complex: TContour);
function GetConnectDirectionAngle(const cmd: TGConnectFull; boolFirst: Boolean): Double;



function ConvertFromTDPointToTM2Point(p: TDPoint): TM2Point;

function SplitConnectFull(const cf: TGConnectFull; const pt: TDPoint;
																						var cf1, cf2: TGConnectFull; anEpsilon: Double): Boolean;

function IntersectConnects(c1, c2: TGConnectFull; var ptRes: TDPoint): Boolean;
function GetMidstOfEdge(const anEdge: TEdge): TDPoint;
function GetThirdOfConnectFull(const cf: TGConnectFull): TDPoint;
function GetAnyOfConnectFull(const cf: TGConnectFull): TDPoint;

procedure FreeListAndItems(aList: TList);

// Разделяет Complex, состоящий из нескольких фигур, заканчивающихся CloseBy*
// или начинающихся MoveTo на несколько Complex'ов
procedure SplitComplexToShapes1(complex: TContour; shapeList: TList);

procedure SplitContourToShapes(complex: TContour; shapeList: TList);

procedure GetShapesNesting(shapeList: TList; nestingList: TLongintList);

function IsComplexClockwise(complex: TContour): Boolean;
function IsContourClosed(complex: TContour): Boolean;

function GetPointOfComplexCommand(cc: TContourCommand):TDPoint;

type
	TGComplexEnumerater = class
		aComplex: TContour;
    curCommand: Integer;
    boolPrevCloseBy: Boolean;
    ptFirst: TDPoint;
    ptLast: TDPoint;
  public
    constructor Create(_aComplex: TContour);
		function ConvertComplexCommandToConnectFull(const cc: TContourCommand;
                                                            var cf: TGConnectFull): Boolean;
    function GetNextConnectFull(var cf: TGConnectFull): Boolean;
	end;

implementation

uses SysUtils, M2AddOnD, Math, ILists;

// Освобождает все элементы списка и сам список

function GetPointOfComplexCommand(cc: TContourCommand):TDPoint;
begin
  case cc.CommandType of
    ctMoveTo:
			Result := cc.Point;
		ctLineTo:
			Result := cc.Point;
		ctArcTo:
			Result := cc.Point;
		else
      raise Exception.Create('GetPointOfComplexCommand: команда не является ***To');
  end;
end;

constructor TGComplexEnumerater.Create(_aComplex: TContour);
begin
  aComplex := _aComplex;
  curCommand := 0;
  boolPrevCloseBy := False;
end;

function TGComplexEnumerater.ConvertComplexCommandToConnectFull(const cc: TContourCommand;
                                                            var cf: TGConnectFull): Boolean;
begin
  Result := False;
  if (cc.CommandType = ctMoveTo ) or (curCommand = 0) then begin
		if cc.CommandType in [ctCloseByLine, ctCloseByArc] then
      raise Exception.Create('Первая команда не должна быть ''Замкнуть''');
    ptFirst := GetPointOfComplexCommand(cc);
    ptLast := ptFirst;
    Exit;
  end;
	case cc.CommandType of
    ctLineTo:
			begin
        boolPrevCloseBy := False;
        cf.Pt2 := cc.Point;
        cf.ConnectType := gctLine;
      end;
    ctArcTo:
      begin
        boolPrevCloseBy := False;
				cf.Pt2 := cc.Point;
				cf.ConnectType := gctArc;
        cf.Arc.Convexity := cc.Convexity;
			end;
    ctCloseByLine, ctCloseByArc:
      begin
        if boolPrevCloseBy then
          raise Exception.Create('Две команды ''Замкнуть подряд''');
        boolPrevCloseBy := True;
				case cc.CommandType of
          ctCloseByLine:
            begin
              cf.Pt2 := ptFirst;
							cf.ConnectType := gctLine;
            end;
          ctCloseByArc:
            begin
              cf.Pt2 := ptFirst;
              cf.ConnectType := gctArc;
              cf.Arc.Convexity := cc.Convexity;
            end;
				end;
			end;
  end;
  cf.Pt1 := ptLast;
	if cf.Pt1.IsEqual(cf.Pt2) then Exit;
  ptLast := cf.Pt2;
  Result := True;
end;

function TGComplexEnumerater.GetNextConnectFull(var cf: TGConnectFull): Boolean;
var
  boolGetCommand: Boolean;
begin
	while curCommand < aComplex.CommandCount do begin
    boolGetCommand := ConvertComplexCommandToConnectFull(aComplex.Commands[curCommand], cf);
    inc(curCommand);
    if boolGetCommand then begin
      Result := True;
      Exit;
    end;
	end;
	Result := False;
end;

procedure FreeListAndItems(aList: TList);
var
	i: Integer;
begin
	for i:=0 to aList.Count - 1 do
		TObject(aList[i]).Free;
	aList.Free;
end;

function IsComplexCommandCloseBy(cc: TContourCommand): Boolean;
begin
	Result := cc.CommandType in CloseCommands;
end;

function IsContourClosed(complex: TContour): Boolean;
begin
	if complex.CommandCount = 0 then
	begin
		Result := False;
		Exit;
	end;
	Result := IsComplexCommandCloseBy(complex.Commands[complex.CommandCount-1]);
end;

function IsComplexCommandSomeTo(cc: TContourCommand): Boolean;
begin
	Result := (cc.CommandType = ctMoveTo) or (cc.CommandType = ctLineTo) or (cc.CommandType = ctArcTo);
end;

// Разделяет Complex, состоящий из нескольких фигур, заканчивающихся CloseBy*
// или начинающихся MoveTo на несколько Complex'ов
procedure SplitComplexToShapes1(complex: TContour; shapeList: TList);
var
	i: Integer;
	complexNew: TContour;
	boolNewShape, boolFirstCommand: Boolean;
	ptPrevMoveTo: TDPoint;

begin
	i := 0;
	boolNewShape := True;
	boolFirstCommand := True;
	while i < complex.CommandCount do begin
		complexNew := TContour.Create;
		try
			while i < complex.CommandCount do begin
				with complex.Commands[i] do begin
					if (CommandType = ctMoveTo) or (boolFirstCommand and
							IsComplexCommandSomeTo(complex.Commands[i]))then begin
						ptPrevMoveTo := GetPointOfComplexCommand(complex.Commands[i]);
						if not boolNewShape then
							break;
					end;
					if boolNewShape and ((CommandType = ctLineTo) or (CommandType = ctArcTo)) then
						complexNew.AddCommand(ContourMoveTo(ptPrevMoveTo));
					complexNew.AddCommand(complex.Commands[i]);
					boolNewShape := False;
					boolFirstCommand := False;
					inc(i);
					if (CommandType = ctCloseByLine) or (CommandType = ctCloseByArc) then
						Break;
				end;
			end;
			shapeList.Add(complexNew);
			boolNewShape := True;
			boolFirstCommand := False;
		except
			complexNew.Free;
			raise;
		end;
	end;
end;

function MakeCloseByCommand(cc: TContourCommand):TContourCommand;
begin
  case cc.CommandType of
    ctLineTo:
      Result.CommandType := ctCloseByLine;
    ctArcTo: begin
      Result.CommandType := ctCloseByArc;
      Result.Convexity := cc.Convexity;
    end;
    ctCloseByLine,ctCloseByArc:
      Result := cc;
    else
      raise Exception.Create('MakeCloseByCommand: команда не должна быть Переход');
  end;
end;

procedure MovePartComplex(complex,complexTo1,complexTo2: TContour;indexBeg,indexEnd:Integer);
var
  i: Integer;
  cc: TContourCommand;
begin
  complexTo1.Clear;
	complexTo2.Clear;
  for i := 0 to complex.CommandCount-1 do begin
    cc := complex.Commands[i];
    if i = indexBeg then
      complexTo2.AddCommand(ContourMoveTo(GetPointOfComplexCommand(cc)));
    if (i > indexBeg) and (i<=indexEnd) then
      if i <> indexEnd then complexTo2.AddCommand(cc)
      else                  complexTo2.AddCommand(MakeCloseByCommand(cc))
    else
      complexTo1.AddCommand(cc);
  end;
end;

function SplitComplexToTwo(complex,complexTo1,complexTo2: TContour): Boolean;
var
  i,indexPt: Integer;
  ptList: TTDPointList;
  cc: TContourCommand;
  pt: TDPoint;
begin
  complexTo1.Clear;
	complexTo2.Clear;
  ptList := TTDPointList.Create;
  Result := False;
  try
    for i := 0 to complex.CommandCount-1 do begin
      cc := complex.Commands[i];
      if IsComplexCommandCloseBy(cc) then begin
        if i <> complex.CommandCount-1 then
          raise Exception.Create('Команда Замкнуть не является последней командой');
      end
      else begin
        pt := GetPointOfComplexCommand(cc);
        indexPt := ptList.IndexOf(pt);
        if indexPt < 0 then
          ptList.Add(pt)
        else begin
          MovePartComplex(complex,complexTo1,complexTo2,indexPt,i);
          Result := True;
          break;
        end;
      end;
		end;
  finally
    ptList.Free;
  end;
end;

function MakeMoveToFirstInComplex(complex: TContour): Boolean;
var
  cc: TContourCommand;
begin
  Result := False;
  with complex do begin
    if CommandCount <= 0 then Exit;
    cc := Commands[0];
    if (cc.CommandType = ctLineTo) or (cc.CommandType = ctArcTo) then begin
      Result := True;
      Commands[0] := ContourMoveTo(GetPointOfComplexCommand(cc));
    end;
  end;
end;

procedure AddCopyOfComplexToShapeList(complex: TContour; shapeList: TList);
var
  complex2: TContour;
begin
  complex2 := TContour.Create;
  try
    complex2.Assign(complex);
    shapeList.Add(complex2);
  except
    complex2.Free;
    raise;
  end;
end;

function IsComplexPolygonal(complex: TContour): Boolean;
begin
  Result := False;
  if complex.CommandCount <= 2 then Exit;
  if IsComplexCommandCloseBy(complex.Commands[0]) then
		raise Exception.Create('Первая команда ''Замкнуть''');
	if complex.CommandCount > 3 then begin
		Result := True;
		Exit;
	end;
//	if not IsComplexCommandCloseBy(complex.Commands[2]) then
//		raise Exception.Create('Последняя команда должна быть ''Замкнуть''');
	if complex.Commands[1].CommandType =  ctLineTo then begin
		if complex.Commands[2].CommandType =  ctCloseByLine then
			Exit;
		Result := True;
		Exit;
	end;
	if complex.Commands[1].CommandType =  ctArcTo then begin
		if (complex.Commands[2].CommandType =  ctCloseByArc) and
			(abs(complex.Commands[1].Convexity +
				complex.Commands[2].Convexity)< kMinZone) then
			Exit;
		Result := True;
		Exit;
	end;
end;


// Разделяет Complex, имеющий только одну команду CloseBy*
// на несколько Complex'ов, если Complex проходит через одну точку несколько раз
procedure SplitComplexToShapes2(complex: TContour; shapeList: TList);
var
  boolSplit: Boolean;
  complexTmp, complexSmall, complexMain: TContour;
begin
  complexTmp := TContour.Create;
  try
    complexTmp.Assign(complex);
    MakeMoveToFirstInComplex(complexTmp);
    boolSplit := True;
    while boolSplit do begin
      if not IsComplexPolygonal(complexTmp) then break;
      complexMain := TContour.Create;
      try
        complexSmall := TContour.Create;
        try
					boolSplit := SplitComplexToTwo(complexTmp,complexMain,complexSmall);
          if boolSplit then begin
						if IsComplexPolygonal(complexSmall) then
              AddCopyOfComplexToShapeList(complexSmall,shapeList);
            complexTmp.Clear;
            complexTmp.Assign(complexMain);
          end
          else
            AddCopyOfComplexToShapeList(complexTmp,shapeList);
        finally
          complexSmall.Free;
        end;
      finally
        complexMain.Free;
      end;
    end;
  finally
    complexTmp.Free;
  end;
end;

// Разделяет Complex, на элеиентарные законченные фигуры
procedure SplitContourToShapes(complex: TContour; shapeList: TList);
var
  i: Integer;
  shapeListFirst: TList;
begin
  shapeListFirst := TList.Create;
  try
    SplitComplexToShapes1(complex, shapeListFirst);
    for i := 0 to shapeListFirst.Count - 1 do
      SplitComplexToShapes2(shapeListFirst[i], shapeList);
  finally
    FreeListAndItems(shapeListFirst);
  end;
end;


function GetMidstOfArc(const pt1,pt2: TDPoint; convexity: Double): TDPoint;
var
	alpha, radius, delta: Double;
	ptCenter: TDPoint;
	aCoordSys: TCoordSys;
begin
	if abs(convexity) < kMinZone then begin
    Result.X := (pt1.X + pt2.X) / 2;
    Result.Y := (pt1.Y + pt2.Y) / 2;
  end
  else begin
    GetCenter2(pt1, pt2, convexity, delta, ptCenter);
	  aCoordSys.InitPoints(ptCenter, pt1);
  	alpha := delta / 2;
  	radius := aCoordSys.ToLocal(pt1).X;
	  Result := aCoordSys.ToGlobal(DPoint(radius*cos(alpha), radius*sin(alpha)));
  end;
end;

function GetAnyPointOfArc(const pt1,pt2: TDPoint; convexity: Double): TDPoint;
var
	alpha, radius, delta: Double;
	ptCenter: TDPoint;
	aCoordSys: TCoordSys;
begin
	if abs(convexity) < kMinZone then begin
    Result.X := (pt1.X + pt2.X) / 2;
		Result.Y := (pt1.Y + pt2.Y) / 2;
  end
  else begin
    GetCenter2(pt1, pt2, convexity, delta, ptCenter);
    aCoordSys.InitPoints(ptCenter, pt1);
    alpha := delta * 0.626357899062;
    radius := aCoordSys.ToLocal(pt1).X;
    Result := aCoordSys.ToGlobal(DPoint(radius*cos(alpha), radius*sin(alpha)));
  end;
end;


function GetAnyOfConnectFull(const cf: TGConnectFull): TDPoint;
begin
  with cf do begin
    if ConnectType = gctLine then begin
      Result.X := cf.Pt1.X + (cf.Pt2.X - cf.Pt1.X) / 3;
      Result.Y := cf.Pt1.Y + (cf.Pt2.Y - cf.Pt1.Y) / 3;
    end
		else
      Result := GetAnyPointOfArc(cf.pt1, cf.pt2, cf.Arc.convexity);
	end

end;

function GetThirdOfConnectFull(const cf: TGConnectFull): TDPoint;
begin
  with cf do begin
    if ConnectType = gctLine then begin
      Result.X := cf.Pt1.X + (cf.Pt2.X - cf.Pt1.X) / 3;
      Result.Y := cf.Pt1.Y + (cf.Pt2.Y - cf.Pt1.Y) / 3;
    end
    else
      raise Exception.Create('Не поддерживается');
  end

end;

function GetMidstOfEdge(const anEdge: TEdge): TDPoint;
var
	aCoordSys: TCoordSys;
	anAlpha: Double;
	aRadius: Double;
begin
	if anEdge.IsLine then begin
		Result.X := (anEdge.P1.X + anEdge.P2.X) / 2;
		Result.Y := (anEdge.P1.Y + anEdge.P2.Y) / 2;
	end
	else begin
		aCoordSys.InitPoints(anEdge.Center, anEdge.P1);
		anAlpha := anEdge.Delta / 2;
		aRadius := aCoordSys.ToLocal(anEdge.P1).X;
		Result := aCoordSys.ToGlobal(DPoint(aRadius*cos(anAlpha), aRadius*sin(anAlpha)));
	end;
end;

function GBelongPair(const bt1, bt2: TGBelongType):TGBelongPair;
begin
  Result.aBelong[0] := bt1;
  Result.aBelong[1] := bt2;
end;


function TGBelongPair.IsEqual(const bp: TGBelongPairBase):Boolean;
begin
  Result := (aBelong[0] = bp.aBelong[0]) and
            (aBelong[1] = bp.aBelong[1]);
end;

function GetMainPoint(const pt1b,pt1e,pt2b,pt2e,pt1,pt2:TDPoint): TDPoint;
var
	pt: TDPoint;
begin
  if pt1e.IsEqual(pt2b) or pt1e.IsEqual(pt2e)  then pt := pt1e
  else pt := pt1b;
  if pt1.IsEqual(pt) then Result := pt2
  else                    Result := pt1;
end;

function IntersectLinesOnePoint(const pt1b,pt1e,pt2b,pt2e: TDPoint;var ptRes: TDPoint ): Boolean;
var
  a1, b1, c1, a2, b2, c2, z, t, v, tZone, vZone: Extended;
begin
  a1 := pt1e.x - pt1b.x;
  b1 := pt2b.x - pt2e.x;
  c1 := pt2b.x - pt1b.x;
  a2 := pt1e.y - pt1b.y;
  b2 := pt2b.y - pt2e.y;
  c2 := pt2b.y - pt1b.y;

  z := a1 * b2 - a2 * b1;

	Result := False;
  if z = 0 then Exit;

  t := (b2 * c1 - b1 * c2) / z;
  v := (a1 * c2 - a2 * c1) / z;

  tZone := dMinZone/sqrt(a1*a1+a2*a2);
  vZone := dMinZone/sqrt(b1*b1+b2*b2);

  if (t < -tZone) or (t > 1+tZone) or
     (v < -vZone) or (v > 1+vZone) then Exit;
  Result := True;
  if (t > tZone) and (t < 1-tZone) and
     (v > vZone) and (v < 1-vZone) then begin
    ptRes := DPoint(pt1b.x + a1 * t, pt1b.y + a2 * t);
    Exit;
  end;
  raise Exception.Create('Допуск большой');
end;

function GetDistanceToLine(const ptMove,pt1,pt2: TDPoint; var dis: Double) :Boolean;
var
  vecMove,vec, vecNorm, vecCross, ptCross: TDPoint;
  projection, modul : Double;
begin
  vec := DPointSub(pt2, pt1);
  modul := DPointModul(vec);
  if Modul = 0 then raise Exception.Create('Вырожденная прямая');
  vecNorm := DPointNorm( vec);
  vecMove := DPointSub(ptMove, pt1);
  projection := DPointScalar(vecNorm, vecMove);
  if projection <= 0 then begin
    Result := False;
  end
  else if projection >= Modul then begin
    Result := False;
  end
  else begin
    vecCross := DPointMult(vecNorm,projection);
    ptCross := DPointAdd(pt1,vecCross);
    dis := DPointModul(DPointSub(ptMove, ptCross));
    Result := True;
	end;
end;

procedure TestPointsNearError(const pt1b, pt1e, pt2b, pt2e: TDPoint);
begin
  if (pt1b.DistanceFrom(pt1e) <= dMinZone) or
     (pt2b.DistanceFrom(pt2e) <= dMinZone) or
     ( (pt1b.DistanceFrom(pt2b) <= dMinZone) and (not pt1b.IsEqual(pt2b)) ) or
     ( (pt1b.DistanceFrom(pt2e) <= dMinZone) and (not pt1b.IsEqual(pt2e)) ) or
     ( (pt1e.DistanceFrom(pt2b) <= dMinZone) and (not pt1e.IsEqual(pt2b)) ) or
     ( (pt1e.DistanceFrom(pt2e) <= dMinZone) and (not pt1e.IsEqual(pt2e)) ) then
    raise Exception.Create('Точки расположены близко');
end;

function IntersectLinesMy(const pt1b, pt1e, pt2b, pt2e: TDPoint;
                                  var ptRes1, ptRes2: TDPoint ): Integer;
var
  numRes: Integer;
  aptRes: array[0..3] of TDPoint;
  pt1, pt2: TDPoint;
  boolCommon: Boolean;

  procedure AddPoint(const pt: TDPoint);
  begin
    aptRes[numRes] := pt;
    inc(numRes);
  end;

  procedure TestNearPoints(const ptTest, pt1, pt2: TDPoint);
  var
    dis: Double;
  begin
    if GetDistanceToLine(ptTest, pt1, pt2, dis) then
      if dis <= dMinZone then
        AddPoint(ptTest);
  end;
begin

  TestPointsNearError(pt1b, pt1e, pt2b, pt2e);

  numRes := 0;
  boolCommon := True;

  if pt1b.IsEqual(pt2b) then begin
    AddPoint(pt1b);
    pt1 := pt1e;
    pt2 := pt2e;
  end
  else if pt1b.IsEqual(pt2e) then begin
    AddPoint(pt1b);
    pt1 := pt1e;
    pt2 := pt2b;
  end
  else if pt1e.IsEqual(pt2b) then begin
    AddPoint(pt1e);
    pt1 := pt1b;
    pt2 := pt2e;
  end
  else if pt1e.IsEqual(pt2e) then begin
    AddPoint(pt1e);
    pt1 := pt1b;
    pt2 := pt2b;
  end
	else begin
    boolCommon := False;
    TestNearPoints(pt1b, pt2b, pt2e);
    TestNearPoints(pt1e, pt2b, pt2e);
    TestNearPoints(pt2b, pt1b, pt1e);
    TestNearPoints(pt2e, pt1b, pt1e);
  end;
  if boolCommon then begin
    if pt1.IsEqual(pt2) then
      AddPoint(pt1)
    else begin
      TestNearPoints(pt1, aptRes[0], pt2);
      TestNearPoints(pt2, aptRes[0], pt1); // test it
    end;
  end;
  if numRes > 2 then
    raise Exception.Create('numRes > 2');
  if numRes > 0 then begin
    Result := numRes;
    ptRes1 := aptRes[0];
    ptRes2 := aptRes[1];
	end
  else if IntersectLinesOnePoint(pt1b,pt1e,pt2b,pt2e,ptRes1) then
    Result := 1
  else
    Result := 0;
end;


function IntersectLines(const pt1b,pt1e,pt2b,pt2e: TDPoint;var ptRes: TDPoint ): Boolean;
var
  numPoints: Integer;
  pt1,pt2 : TDPoint;
begin
// 	numPoints := IntersectLineLine(DLine(pt1b,pt1e),DLine(pt2b,pt2e),pt1,pt2);
 	numPoints := IntersectLinesMy(pt1b, pt1e, pt2b, pt2e, pt1, pt2);
  if numPoints = 0 then Result := False
  else if numPoints = 1 then begin
    ptRes := pt1;
    Result := True;
  end
  else begin
		ptRes := GetMainPoint(pt1b, pt1e, pt2b, pt2e, pt1, pt2);
    Result := True;
  end;
end;

function GetArcConvexity(const ptCenter,pt1, pt2: TDPoint; delta: Double): Double;
begin
	if not GetConvexity(pt1,GetArcPoint2(pt1, ptCenter, pt2, delta < 0),pt2, Result) then
		raise Exception.Create('GetArcConvexity: GetConvexity failed');
end;

function IsPointBelongArc(xTest, xLim: Double; const ptCenter,pt1: TDPoint;
																																 delta: Double):Boolean;
var
  ptTest: TDPoint;
begin
  Result := False;
  if (xTest < -dMinZone) or (xTest > xLim + dMinZone) then Exit;
  ptTest := DPoint(xTest, 0);
  Result := ArcContainsPoint(ptCenter, pt1, delta, ptTest);
end;


function IntersectLineWithArcMy(const pt1b,pt1e,pt2b,pt2e:TDPoint;
                        Convexity: Double ;var ptRes1, ptRes2: TDPoint ): Integer;
var
  aCoordSys: TCoordSys;
  ptLoc1, ptLoc2,ptLocCenter: TDPoint;
  xLim, radius, tmp, x1, x2: Extended;
  delta: Double;
  aptRes: array[0..1] of TDPoint;
  numRes: Integer;

  procedure AddPoint(const pt: TDPoint);
  begin
    aptRes[numRes] := pt;
    inc(numRes);
  end;
begin
  Result := 0;

  aCoordSys.InitPoints(pt1b, pt1e);
  xLim := aCoordSys.ToLocal(pt1e).X;
  ptLoc1 := aCoordSys.ToLocal(pt2b);
	ptLoc2 := aCoordSys.ToLocal(pt2e);
	if not GetCenter2(ptLoc1, ptLoc2, Convexity, delta, ptLocCenter) then
		raise Exception.Create('IntersectLineWithArcMy: GetCenter2 failed');
  radius := ptLocCenter.DistanceFrom(PtLoc1);
  if abs(radius - abs(ptLocCenter.y)) < dMinZone then begin
    ptRes1 := DPoint( ptLocCenter.x, 0);
    if IsPointBelongArc(ptLocCenter.x, xLim, ptLocCenter, ptLoc1, delta) then begin
      // можно взять точку на окру-ти
      ptRes1 := aCoordSys.ToGlobal(ptRes1);
      Result := 1;
    end;
    Exit
  end;
  tmp := sqr(radius) - sqr(ptLocCenter.Y);
  if tmp < 0 then Exit;
  tmp := sqrt(tmp);
  x1 := ptLocCenter.X - tmp;
  x2 := ptLocCenter.X + tmp;
  numRes := 0;
  if IsPointBelongArc(x1,xLim,ptLocCenter,ptLoc1, delta) then
    AddPoint(aCoordSys.ToGlobal(DPoint(x1,0)));
  if IsPointBelongArc(x2,xLim,ptLocCenter,ptLoc1, delta) then
		AddPoint(aCoordSys.ToGlobal(DPoint(x2,0)));
  if numRes > 0 then begin
    Result := numRes;
    ptRes1 := aptRes[0];
    ptRes2 := aptRes[1];
  end
end;

function IntersectLineWithArcMy2(const pt1b,pt1e,pt2b,pt2e:TDPoint;
                        Convexity: Double ;var ptRes1, ptRes2: TDPoint ): Integer;
begin
  TestPointsNearError(pt1b, pt1e, pt2b, pt2e);
  Result := IntersectLineWithArcMy(pt1b,pt1e,pt2b,pt2e,Convexity,ptRes1, ptRes2);
  CheckResult3(pt1b,pt1e,pt2b,pt2e,Result,ptRes1, ptRes2);
end;

function IntersectLineWithArc(const pt1b,pt1e,pt2b,pt2e:TDPoint;
                        Convexity: Double ;var ptRes: TDPoint ): Boolean;
var
  pt1, pt2: TDPoint;
  numPoints: Integer;
begin
// 	numPoints := IntersectLineArc(DLine(pt1b,pt1e),DArc(pt2b,pt2e,Convexity),pt1,pt2);
 	numPoints := IntersectLineWithArcMy2(pt1b,pt1e,pt2b,pt2e,Convexity,pt1,pt2);
  if numPoints = 0 then Result := False
  else if numPoints = 1 then begin
    ptRes := pt1;
    Result := True;
  end
  else begin
    ptRes := GetMainPoint(pt1b, pt1e, pt2b, pt2e, pt1, pt2);
    Result := True;
  end;
end;

// пересечение двуг дуг без подравнивания

function IntersectArcsMy(const pt1b,pt1e:TDPoint; Convexity1: Double;
					const pt2b,pt2e:TDPoint;Convexity2: Double ;var ptRes1, ptRes2: TDPoint): Integer;
var
	aCenter1, aCenter2, pt1, pt2, ptTest1, vecH, d1Norm, ptMain: TDPoint;
	aDelta1, aDelta2: Double;
	aR1, aR2, aDis, r1p2, r2p2, aDisp2, d1, h: Extended;
	boolCommon: Boolean;

	aptRes: array[0..1] of TDPoint;
	numRes: Integer;

	procedure AddPoint(const pt: TDPoint);
	begin
		aptRes[numRes] := pt;
		inc(numRes);
	end;

	procedure TestAndAddPoint(const ptTest: TDPoint);
	begin
		if ArcContainsPoint(aCenter1, pt1b, aDelta1, ptTest) and
			 ArcContainsPoint(aCenter2, pt2b, aDelta2, ptTest) then
			AddPoint(ptTest);
	end;

	procedure TestNearPoints(const ptCenter, pt1: TDPoint; delta: Double; const ptTest: TDPoint);
	begin
		if ArcContainsPoint(ptCenter, pt1, delta, ptTest) then
			AddPoint(ptTest);
	end;
begin
	if not GetCenter2(pt1b, pt1e, Convexity1, aDelta1, aCenter1) then
		raise Exception.Create('IntersectArcsMy: GetCenter2 failed');
	aR1 := aCenter1.DistanceFrom(pt1b);
	if not GetCenter2(pt2b, pt2e, Convexity2, aDelta2, aCenter2) then
		raise Exception.Create('IntersectArcsMy: GetCenter2 failed');
	aR2 := aCenter2.DistanceFrom(pt2b);
  aDis := aCenter1.DistanceFrom(aCenter2);

  Result := 0;
  numRes := 0;
  if (abs(aDis - (aR1 + aR2)) < dMinZone) or
     (abs(aDis - abs(aR1 - aR2)) < dMinZone) then begin
    if aCenter1.DistanceFrom(aCenter2) < dMinZone then begin
      boolCommon := True;
      if pt1b.IsEqual(pt2b) then begin
        AddPoint(pt1b);
        pt1 := pt1e;
        pt2 := pt2e;
			end
      else if pt1b.IsEqual(pt2e) then begin
        AddPoint(pt1b);
        pt1 := pt1e;
        pt2 := pt2b;
      end
      else if pt1e.IsEqual(pt2b) then begin
        AddPoint(pt1e);
        pt1 := pt1b;
        pt2 := pt2e;
      end
      else if pt1e.IsEqual(pt2e) then begin
        AddPoint(pt1e);
        pt1 := pt1b;
        pt2 := pt2b;
      end
      else begin
        boolCommon := False;
        TestNearPoints(aCenter1, pt1b, aDelta1, pt2b);
        TestNearPoints(aCenter1, pt1b, aDelta1, pt2e);
        TestNearPoints(aCenter2, pt2b, aDelta2, pt1b);
				TestNearPoints(aCenter2, pt2b, aDelta2, pt1e);
      end;
      if boolCommon then begin
        if pt1.IsEqual(pt2) then
          AddPoint(pt1)
        else begin
          TestNearPoints(aCenter1, pt1b, aDelta1, pt2);
          TestNearPoints(aCenter2, pt2b, aDelta2, pt1);
        end;
      end;
    end
    else begin
      if aR1 >= aR2 then
        ptTest1 := DPointAdd(aCenter1, DPointMult(DPointNorm(DPointSub(aCenter2, aCenter1)), aR1))
      else
        ptTest1 := DPointAdd(aCenter2, DPointMult(DPointNorm(DPointSub(aCenter1, aCenter2)), aR2));
      TestAndAddPoint(ptTest1);
    end;
  end
  else begin
    if (aDis > aR1 + aR2) or
			 (aDis + aR1 < aR2) or
       (aDis + aR2 < aR1) then Exit;
    r1p2 := aR1 * aR1;
    r2p2 := aR2 * aR2;
    aDisp2 := aDis*aDis;
    d1 := (r1p2 - r2p2 + aDisp2) / (2*aDis);
    d1Norm := DPointNorm(DPointSub(aCenter2, aCenter1));
    ptMain := DPointAdd(aCenter1, DPointMult(d1Norm,d1));
    if r2p2 - r1p2 - aDisp2 > 0 then
      d1 := - d1;
    h := sqrt(r1p2 - d1*d1);
    vecH := DPointMult(DPoint(d1Norm.Y, -d1Norm.X), h);
    ptTest1 := DPointAdd(ptMain, vecH);
    TestAndAddPoint(ptTest1);
    vecH := DPoint( -vecH.X, -vecH.Y);
    TestAndAddPoint(DPointAdd(ptMain,vecH));
  end;
  if numRes > 0 then begin
    Result := numRes;
    ptRes1 := aptRes[0];
    ptRes2 := aptRes[1];
	end;
end;

function IntersectArcsMy2(const pt1b,pt1e:TDPoint; Convexity1: Double;
          const pt2b,pt2e:TDPoint;Convexity2: Double ;var ptRes1, ptRes2: TDPoint): Integer;
begin
  TestPointsNearError(pt1b, pt1e, pt2b, pt2e);
  Result := IntersectArcsMy(pt1b,pt1e,Convexity1, pt2b,pt2e,Convexity2,ptRes1, ptRes2);
  CheckResult3(pt1b,pt1e,pt2b,pt2e,Result,ptRes1, ptRes2);
end;


function IntersectArcs(const pt1b,pt1e:TDPoint; Convexity1: Double;
          const pt2b,pt2e:TDPoint;Convexity2: Double ;var ptRes: TDPoint ): Boolean;
var
  pt1, pt2: TDPoint;
  numPoints: Integer;
begin
// 	numPoints := IntersectArcArc(DArc(pt1b,pt1e,Convexity1),
//                                DArc(pt2b,pt2e,Convexity2),pt1,pt2);
 	numPoints := IntersectArcsMy2(pt1b,pt1e,Convexity1,pt2b,pt2e,Convexity2,pt1,pt2);
	if numPoints = 0 then Result := False
  else if numPoints = 1 then begin
    ptRes := pt1;
    Result := True;
  end
  else begin
    ptRes := GetMainPoint(pt1b, pt1e, pt2b, pt2e, pt1, pt2);
    Result := True;
  end;
end;

function IntersectConnects(c1, c2:TGConnectFull; var ptRes: TDPoint): Boolean;
begin
  if (c1.ConnectType = gctArc) and (abs(c1.Arc.Convexity) < kMinZone) then
    c1.ConnectType := gctLine;
  if (c2.ConnectType = gctArc) and (abs(c2.Arc.Convexity) < kMinZone) then
    c2.ConnectType := gctLine;

  if (c1.ConnectType = gctLine) and  (c2.ConnectType = gctLine) then
    Result := IntersectLines(c1.Pt1, c1.Pt2, c2.Pt1, c2.Pt2, ptRes)
  else if (c1.ConnectType = gctArc) and  (c2.ConnectType = gctArc) then
		Result := IntersectArcs(c1.Pt1, c1.Pt2, c1.Arc.Convexity,
                      c2.Pt1, c2.Pt2, c2.Arc.Convexity, ptRes)
  else if (c1.ConnectType = gctLine) then
		Result := IntersectLineWithArc(c1.Pt1, c1.Pt2, c2.Pt1, c2.Pt2, c2.Arc.Convexity, ptRes)
	else
		Result := IntersectLineWithArc(c2.Pt1, c2.Pt2, c1.Pt1, c1.Pt2, c1.Arc.Convexity, ptRes);
end;

function SplitConnectFull(const cf: TGConnectFull; const pt: TDPoint;
																						var cf1, cf2: TGConnectFull; anEpsilon: Double): Boolean;

	function GetArcConvexity(const ptCenter,pt1, pt2: TDPoint; delta: Double; out aConvexity: Double): Boolean;
	begin
		Result := GetConvexity(pt1,GetArcPoint2(pt1, ptCenter, pt2, delta < 0),pt2, aConvexity)
	end;

var
	ptCenter: TDPoint;
	delta: Double;
begin
	if pt.CloselyTo(cf.Pt1, anEpsilon) or pt.CloselyTo(cf.Pt2, anEpsilon) then begin
		Result := False;
		Exit;
	end;

	cf1.ConnectType := cf.ConnectType;
	cf2.ConnectType := cf.ConnectType;
	cf1.Pt1 := cf.Pt1;
	cf1.Pt2 := pt;
	cf2.Pt1 := pt;
	cf2.Pt2 := cf.Pt2;
	Result := True;
	if cf.ConnectType = gctArc then begin
		if abs(cf.Arc.Convexity) < kMinZone then begin
			cf1.Arc.Convexity := 0;
			cf2.Arc.Convexity := 0;
			cf1.ConnectType := gctLine;
			cf2.ConnectType := gctLine;
		end
		else begin
			if not GetCenter2(cf.Pt1, cf.Pt2, cf.Arc.Convexity, delta, ptCenter) then
				raise Exception.Create('SplitConnectFull: GetCenter2 failed');


			if not GetArcConvexity(ptCenter, cf1.Pt1, cf1.Pt2, delta, cf1.Arc.Convexity) then
				cf1.ConnectType := gctLine;

			if not GetArcConvexity(ptCenter, cf2.Pt1, cf2.Pt2, delta, cf2.Arc.Convexity) then
				cf2.ConnectType := gctLine;
		end;
	end;
end;


function GetConnectDirectionAngle(const cmd: TGConnectFull; boolFirst: Boolean): Double;
var
	cf: TGConnectFull;
	delta: Double;
	c: TDPoint;
begin
  if boolFirst then
    cf := cmd
  else
    cf := ReverseConnectFull(cmd);
  if cf.ConnectType = gctLine then
    Result := GetAngle(cf.Pt1,cf.Pt2)
	else begin
		if not GetCenter2(cf.Pt1, cf.Pt2, cf.Arc.Convexity, delta, c) then
			raise Exception.Create('GetConnectDirectionAngle: GetCenter2 failed');
		Result := GetAngle(c, cf.Pt1);
		if Result > 0 then   Result := Result + Pi/2
		else                 Result := Result - Pi/2;
	end;

end;


function GetLengthConnectFull(const cmd: TGConnectFull): Double;
var
	ptCenter: TDPoint;
	delta, radius : Double;
begin
	if (cmd.ConnectType=gctLine) or ((cmd.ConnectType=gctArc) and (cmd.Arc.Convexity = 0)) then
			Result := cmd.Pt1.DistanceFrom(cmd.Pt2)
	else begin
		if not GetCenter2(cmd.Pt1, cmd.Pt2, cmd.Arc.Convexity, delta, ptCenter) then
			raise Exception.Create('GetLengthConnectFull: GetCenter2 failed');
		radius := ptCenter.DistanceFrom(cmd.Pt1);
		Result := radius * abs(delta);
	end;
end;


function GetBoundsOfConnectFull(const cmd: TGConnectFull): TDRect;
var
	ptCenter: TDPoint;
	delta: Double;
	edge: TEdge;
begin
	if (cmd.ConnectType=gctLine) or ((cmd.ConnectType=gctArc) and (cmd.Arc.Convexity = 0)) then
			Result.AssignPoints(cmd.Pt1,cmd.Pt2)
	else begin
		GetCenter2(cmd.Pt1, cmd.Pt2, cmd.Arc.Convexity, delta, ptCenter);
		edge.P1 := cmd.Pt1;
		edge.P2 := cmd.Pt2;
		edge.Center := ptCenter;
		edge.C := cmd.Arc.Convexity;
		edge.Delta := delta;
		edge.Radius := ptCenter.DistanceFrom(cmd.Pt1);
		Result := edge.GetBounds;
	end;
	Result.Normalized;
end;

function ConvertFromTM2PointToTDPoint(p: TM2Point): TDPoint;
begin
	Result := DPoint(p.X,p.Y);
end;
function ConvertFromTDPointToTM2Point(p: TDPoint): TM2Point;
begin
  Result := M2Point(p.X,p.Y);
end;

function ConvertFromTM2ContourCommandToTComplexCommand(cmd: TM2ContourCommand): TContourCommand;
begin
  case cmd.CommandType of
    ccNone:
      Result.CommandType := ctNone;
    ccMoveTo: begin
      Result.CommandType := ctMoveTo;
      Result.Point := ConvertFromTM2PointToTDPoint(cmd.MoveTo.Point);
    end;
    ccLineTo: begin
      Result.CommandType := ctLineTo;
			Result.Point := ConvertFromTM2PointToTDPoint(cmd.LineTo.Point);
		end;
		ccArcTo: begin
			Result.CommandType := ctArcTo;
			Result.Point := ConvertFromTM2PointToTDPoint(cmd.ArcTo.Point);
			Result.Convexity := cmd.ArcTo.Convexity;
		end;
		ccCloseByLine:
			Result.CommandType := ctCloseByLine;
		ccCloseByArc: begin
			Result.CommandType := ctCloseByArc;
			Result.Convexity := cmd.CloseByArc.Convexity;
    end;
  end;
end;

function ConvertFromTComplexCommandToTM2ContourCommand(cmd: TContourCommand): TM2ContourCommand;
begin
  case cmd.CommandType of
    ctNone:
      Result.CommandType := ccNone;
    ctMoveTo: begin
      Result.CommandType := ccMoveTo;
			Result.MoveTo.Point := ConvertFromTDPointToTM2Point(cmd.Point);
		end;
		ctLineTo: begin
			Result.CommandType := ccLineTo;
			Result.LineTo.Point := ConvertFromTDPointToTM2Point(cmd.Point);
		end;
		ctArcTo: begin
			Result.CommandType := ccArcTo;
			Result.ArcTo.Point := ConvertFromTDPointToTM2Point(cmd.Point);
			Result.ArcTo.Convexity := cmd.Convexity;
		end;
		ctCloseByLine:
			Result.CommandType := ccCloseByLine;
		ctCloseByArc: begin
			Result.CommandType := ccCloseByArc;
      Result.CloseByArc.Convexity := cmd.Convexity;
    end;
  end;
end;

procedure ConvertFromTContourToIM2Contour(complex: TContour; const contour: TM2Contour);
var
  i: Integer;
begin
  for i := 0 to complex.CommandCount-1 do begin
    contour.AddCommand(ConvertFromTComplexCommandToTM2ContourCommand(complex.Commands[i]));
  end;
end;

procedure ConvertFromIM2ContourToTContour(const contour: TM2Contour; complex: TContour);
var
  aCommand :TM2ContourCommand;
  boolContinue: Boolean;
begin
  boolContinue := contour.GetFirstCommand(aCommand);
  while boolContinue  do begin
    complex.AddCommand(ConvertFromTM2ContourCommandToTComplexCommand(aCommand));
    boolContinue := contour.GetNextCommand(aCommand);
  end;
end;

function CompareTGConnectBriefNotStrict(const t1, t2: TGConnectBrief): Integer;
begin
  Result := 1;
  if (t1.Pt1 <> t2.Pt1) or (t1.Pt2 <> t2.Pt2) then Exit;
	if t1.ConnectType <> t2.ConnectType then Exit;
  case t1.ConnectType of
    gctLine:
      Result := 0;
    gctArc: begin
      if t1.Arc.Convexity = t2.Arc.Convexity then Result := 0;
			if abs(t1.Arc.Convexity - t2.Arc.Convexity) < kMinZone then Result := 0;  // !!!Test It
    end;
  end;
end;

function CompareTGConnectBriefStrict(const t1, t2: TGConnectBrief): Integer;
begin
  Result := 1;
  if (t1.Pt1 <> t2.Pt1) or (t1.Pt2 <> t2.Pt2) then Exit;
	if t1.ConnectType <> t2.ConnectType then Exit;
  case t1.ConnectType of
    gctLine:
      Result := 0;
    gctArc: begin
      if t1.Arc.Convexity = t2.Arc.Convexity then Result := 0;
    end;
  end;
end;

function ReverseConnectFull(const cmd: TGConnectFull): TGConnectFull;
begin
  Result.Pt1 := cmd.Pt2;
  Result.Pt2 := cmd.Pt1;
  Result.ConnectType := cmd.ConnectType;
  if cmd.ConnectType = gctArc then
    Result.Arc.Convexity :=  -cmd.Arc.Convexity;
end;

function ReverseConnectBrief(const cmd: TGConnectBrief): TGConnectBrief;
begin
	Result.Pt1 := cmd.Pt2;
  Result.Pt2 := cmd.Pt1;
  Result.ConnectType := cmd.ConnectType;
  if cmd.ConnectType = gctArc then
    Result.Arc.Convexity :=  -cmd.Arc.Convexity;
end;

function ComplexEdgePoint(complex: TContour): TDPoint;
var
	anEdge: TContourEdgeEnum;
begin
	anEdge.Init(complex);
	if anEdge.EndOfContour then
		raise Exception.Create('количество команд < 2');

	Result := GetMidstOfEdge(anEdge);
end;

procedure GetShapesNesting(ShapeList: TList; nestingList: TLongintList);
var
	aBounds: array of TDRect;
	aBoundCalculated: array of Boolean;
	aTestPoints: array of TDPoint;


	i, j, num: Integer;
	ptTest: TDPoint;
begin
	if shapeList.Count = 0 then
		Exit;

	if shapeList.Count = 1 then
		nestingList.Add(0)
	else begin
		SetLength(aBounds, ShapeList.Count);
		SetLength(aBoundCalculated, ShapeList.Count);
		SetLength(aTestPoints, ShapeList.Count);

		for i := 0 to ShapeList.Count - 1 do begin
			aBoundCalculated[i] := TContour(shapeList[i]).GetBounds(aBounds[i]);
			aTestPoints[i] := ComplexEdgePoint(TContour(shapeList[i]));
		end;

		for i := 0 to shapeList.Count -1 do begin
			num := 0;
			ptTest := aTestPoints[i];
			for j := 0 to shapeList.Count -1 do begin
				if i = j then
					Continue;

				if aBoundCalculated[j] and aBounds[j].Contains(ptTest) and
					(TContour(shapeList[j]).ContainsPoint(ptTest) <> prNone)
				then
					Inc(num);
			end;
			nestingList.Add(num);
		end;
	end;
end;

// Возвращает направление обхода контурa: True: по часовой (от Y к X)

function IsComplexClockwise(complex: TContour): Boolean;
begin
	Result := complex.GetSimpleSquare > 0;
end;

end.
