source: trunk/Packages/Graphics32/GR32_Clipper.pas

unit GR32_Clipper;

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1 or LGPL 2.1 with linking exception
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * Alternatively, the contents of this file may be used under the terms of the
 * Free Pascal modified version of the GNU Lesser General Public License
 * Version 2.1 (the "FPC modified LGPL License"), in which case the provisions
 * of this license are applicable instead of those above.
 * Please see the file LICENSE.txt for additional information concerning this
 * license.
 *
 * The Original Code is GR32_Clipper
 *
 * The Initial Developer of the Original Code is
 * Angus Johnson
 *
 * Portions created by the Initial Developer are Copyright (C) 2012-2019
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{$IFDEF FPC}
  {$DEFINE USEINLINING}
{$ELSE}
  {$IF CompilerVersion >= 18}         // Delphi 2007
    // While USEINLINING has been supported since D2005, both D2005 and D2006
    // have an Inline codegen bug (QC41166) so ignore Inline until D2007.
    {$DEFINE USEINLINING}
    {$IF CompilerVersion >= 25.0}     // Delphi XE4+
      {$LEGACYIFEND ON}
    {$IFEND}
  {$IFEND}
  {$IF CompilerVersion < 14}
    Requires Delphi version 6 or above.
  {$IFEND}
{$ENDIF}

{$IFDEF DEBUG}
  {$UNDEF USEINLINING}
{$ENDIF}

interface

uses
  Classes, SysUtils, Math, GR32;

type
  TPoint64 = record X, Y: Int64; end;

  // TPath: a simple data structure to represent a series of vertices, whether
  // open (poly-line) or closed (polygon). A path may be simple or complex (self
  // intersecting). For simple polygons, path orientation (whether clockwise or
  // counterclockwise) is generally used to differentiate outer paths from inner
  // paths (holes). For complex polygons (and also for overlapping polygons),
  // explicit 'filling rules' (see below) are used to indicate regions that are
  // inside (filled) and regions that are outside (unfilled) a specific polygon.
  TPath = array of TPoint64;
  TPaths = array of TPath;
  TArrayOfPaths = array of TPaths;

  TClipType = (ctNone, ctIntersection, ctUnion, ctDifference, ctXor);
  // Note: all clipping operations except for Difference are commutative.
  TPathType = (ptSubject, ptClip);
  TFillRule = (frEvenOdd, frNonZero, frPositive, frNegative);

  EClipperLibException = class(Exception);

  TJoinType = (jtSquare, jtRound, jtRoundEx, jtMiter);
  TEndType = (etPolygon, etOpenJoined, etOpenButt, etOpenSquare, etOpenRound);


  TVertexFlag = (vfOpenStart, vfOpenEnd, vfLocMax, vfLocMin);
  TVertexFlags = set of TVertexFlag;

  PVertex = ^TVertex;
  TVertex = record
    Pt    : TPoint64;
    next  : PVertex;
    prev  : PVertex;
    flags : TVertexFlags;
  end;

  PVertexArray = ^TVertexArray;
  TVertexArray = array[0..MaxInt div sizeof(TVertex) -1] of TVertex;

  // Every closed path (or polygon) is made up of a series of vertices forming
  // edges that alternate between going up (relative to the Y-axis) and going
  // down. Edges consecutively going up or consecutively going down are called
  // 'bounds' (or sides if they're simple polygons). 'Local Minima' refer to
  // vertices where descending bounds become ascending ones.

  PLocalMinima = ^TLocalMinima;
  TLocalMinima = record
    vertex    : PVertex;
    PolyType  : TPathType;
    IsOpen    : Boolean;
  end;

  TOutRec = class;

  TOutPt = class
    Pt       : TPoint64;
    Next     : TOutPt;
    Prev     : TOutPt;
    OutRec   : TOutRec;       // used in descendant classes
  end;

  PActive = ^TActive;
  TActive = record
    op       : TOutPt;        // used in descendant classes
    Bot      : TPoint64;
    Top      : TPoint64;
    CurrX    : Int64;
    Dx       : Double;        // inverse of edge slope (zero = vertical)
    WindDx   : Integer;       // wind direction (ascending: +1; descending: -1)
    WindCnt  : Integer;       // current wind count
    WindCnt2 : Integer;       // current wind count of the opposite TPolyType
    OutRec   : TOutRec;
    // AEL: 'active edge list' (Vatti's AET - active edge table)
    //      a linked list of all edges (from left to right) that are present
    //      (or 'active') within the current scanbeam (a horizontal 'beam' that
    //      sweeps from bottom to top over the paths in the clipping operation).
    PrevInAEL: PActive;
    NextInAEL: PActive;
    // SEL: 'sorted edge list' (Vatti's ST - sorted table)
    //      linked list used when sorting edges into their new positions at the
    //      top of scanbeams, but also (re)used to process horizontals.
    PrevInSEL: PActive;
    NextInSEL: PActive;
    Jump     : PActive;       // for merge sorting (see BuildIntersectList())
    VertTop  : PVertex;
    LocMin   : PLocalMinima;  // the bottom of an edge 'bound' (also Vatti)
  end;

  PIntersectNode = ^TIntersectNode;
  TIntersectNode = record
    Edge1  : PActive;
    Edge2  : PActive;
    Pt     : TPoint64;
  end;

  PScanLine = ^TScanLine;
  TScanLine = record
    Y        : Int64;
    Next     : PScanLine;
  end;

  TOutRecState = (osUndefined, osOpen, osOuter,
    osOuterCheck, osInner, osInnerCheck);

  // OutRec: contains a path in the clipping solution. Edges in the AEL will
  // have OutRec pointers assigned when they form part of the clipping solution.
  TOutRec = class
    Idx      : Integer;
    Owner    : TOutRec;
    frontE   : PActive;
    backE    : PActive;
    Pts      : TOutPt;
    State    : TOutRecState;
  end;

  TClipper = class
  private
    FBotY               : Int64;
    FScanLine           : PScanLine;
    FLocMinListSorted   : Boolean;
    FHasOpenPaths       : Boolean;
    FCurrentLocMinIdx   : Integer;
    FClipType           : TClipType;
    FFillRule           : TFillRule;
    FIntersectList      : TList;
    FOutRecList         : TList;
    FLocMinList         : TList;
    FActives            : PActive; // see AEL above
    FSel                : PActive; // see SEL above
    FVertexList         : TList;
    procedure Reset;
    procedure InsertScanLine(const Y: Int64);
    function PopScanLine(out Y: Int64): Boolean;
    function PopLocalMinima(Y: Int64;
      out localMinima: PLocalMinima): Boolean;
    procedure DisposeScanLineList;
    procedure DisposeOutRec(index: Integer);
    procedure DisposeAllOutRecs;
    procedure DisposeVerticesAndLocalMinima;
    procedure AddPathToVertexList(const path: TArrayOfFloatPoint;
      polyType: TPathType; isOpen: Boolean);
    function IsContributingClosed(e: PActive): Boolean;
    function IsContributingOpen(e: PActive): Boolean;
    procedure SetWindCountForClosedPathEdge(e: PActive);
    procedure SetWindCountForOpenPathEdge(e: PActive);
    procedure InsertLocalMinimaIntoAEL(const botY: Int64);
    procedure InsertLeftEdge(e: PActive);
    procedure PushHorz(e: PActive); {$IFDEF USEINLINING} inline; {$ENDIF}
    function PopHorz(out e: PActive): Boolean;
      {$IFDEF USEINLINING} inline; {$ENDIF}
    procedure StartOpenPath(e: PActive; const pt: TPoint64);
    procedure UpdateEdgeIntoAEL(var e: PActive);
    procedure IntersectEdges(e1, e2: PActive;
      const pt: TPoint64; orientationCheckRequired: Boolean = false);
    procedure DeleteFromAEL(e: PActive);
    procedure AdjustCurrXAndCopyToSEL(topY: Int64);
    procedure DoIntersections(const topY: Int64);
    procedure DisposeIntersectNodes;
    procedure AddNewIntersectNode(e1, e2: PActive; topY: Int64);
    function BuildIntersectList(const topY: Int64): Boolean;
    procedure ProcessIntersectList;
    procedure SwapPositionsInAEL(e1, e2: PActive);
    procedure DoHorizontal(horzEdge: PActive);
    procedure DoTopOfScanbeam(Y: Int64);
    function DoMaxima(e: PActive): PActive;
    function AddOutPt(e: PActive; const pt: TPoint64): TOutPt;
    procedure AddLocalMinPoly(e1, e2: PActive; const pt: TPoint64;
      IsNew: Boolean = false; orientationCheckRequired: Boolean = false);
    procedure AddLocalMaxPoly(e1, e2: PActive; const pt: TPoint64);
    procedure JoinOutrecPaths(e1, e2: PActive);
    function GetIntersectNode(index: Integer): PIntersectNode;
      {$IFDEF USEINLINING} inline; {$ENDIF}
  protected
    procedure CleanUp; // unlike Clear, CleanUp preserves added paths
    procedure ExecuteInternal(clipType: TClipType;
      fillRule: TFillRule); virtual;
    function BuildResult(out closedPaths,
      openPaths: TArrayOfArrayOfFloatPoint): Boolean;
    property OutRecList: TList read FOutRecList;
    property IntersectNode[index: Integer]: PIntersectNode
      read GetIntersectNode;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    procedure Clear;
    function GetBounds: TFloatRect;

    // ADDPATH & ADDPATHS METHODS ...
    procedure AddPath(const path64: TArrayOfFloatPoint;
      polyType: TPathType = ptSubject; isOpen: Boolean = false); overload;
    procedure AddPath(const path: TArrayOfFixedPoint;
      polyType: TPathType = ptSubject; isOpen: Boolean = false); overload;
    procedure AddPaths(const paths64: TArrayOfArrayOfFloatPoint;
      polyType: TPathType = ptSubject;
      isOpen: Boolean = false); overload;
    procedure AddPaths(const paths: TArrayOfArrayOfFixedPoint;
      polyType: TPathType = ptSubject;
      isOpen: Boolean = false); overload;

    // EXECUTE METHODS ...
    function Execute(clipType: TClipType; fillRule: TFillRule;
      out closedPaths: TArrayOfArrayOfFloatPoint): Boolean; overload;
    function Execute(clipType: TClipType; fillRule: TFillRule;
      out closedPaths: TArrayOfArrayOfFixedPoint): Boolean; overload;
    function Execute(clipType: TClipType; fillRule: TFillRule;
      out closedPaths, openPaths: TArrayOfArrayOfFloatPoint): Boolean; overload;
    function Execute(clipType: TClipType; fillRule: TFillRule;
      out closedPaths, openPaths: TArrayOfArrayOfFixedPoint): Boolean; overload;
  end;

  TClipperOffset = class
  private
    FDelta: Double;
    FJoinType: TJoinType;
    FEndType  : TEndType;

    FStepSizeSin, FStepSizeCos: Extended;
    FMiterLim, FMiterLimit: Double;
    FStepsPerRad: Double;
    FArcTolerance: Double;

    FNorms: TArrayOfFloatPoint;
    FSolution: TArrayOfArrayOfFloatPoint;
    FSolutionLen: integer;

    FPathsIn: TArrayOfArrayOfFloatPoint;
    FPathIn: TArrayOfFloatPoint;
    FPathOut: TArrayOfFloatPoint;
    FPathOutLen: Integer;

    procedure AddPoint(const pt: TFloatPoint);
    procedure DoSquare(j, k: Integer);
    procedure DoMiter(j, k: Integer; cosAplus1: Double);
    procedure DoRound(j, k: Integer);
    procedure OffsetPoint(j,k: Integer);

    function CheckPaths: boolean;
    function GetLowestPolygonIdx: integer;
    procedure OffsetPaths;
    procedure BuildNormals;
    procedure ReverseNormals;
    procedure OffsetPolygon;
    procedure OffsetOpenJoined;
    procedure OffsetOpenPath;
  public
    constructor Create(MiterLimit: Double = 2.0; ArcTolerance: Double = 0.0);
    destructor Destroy; override;
    procedure AddPath(const path: TArrayOfFloatPoint);
    procedure AddPaths(const paths: TArrayOfArrayOfFloatPoint);
    procedure Clear;
    procedure Execute(delta: Double; jt: TJoinType; et: TEndType;
      out solution: TArrayOfArrayOfFloatPoint);
    property MiterLimit: Double read FMiterLimit write FMiterLimit;
    property ArcTolerance: Double read FArcTolerance write FArcTolerance;
  end;

  function InflatePaths(const paths: TArrayOfArrayOfFloatPoint;
    delta: Double; jt: TJoinType; et: TEndType;
    miterLimit: single = 0): TArrayOfArrayOfFloatPoint;

implementation

const
  Tolerance           : Double = 1.0E-15;
  DefaultArcFrac      : Double = 0.02;
  Two_Pi              : Double = 2 * PI;
  LowestIp            : TPoint64 = (X: High(Int64); Y: High(Int64));

// OVERFLOWCHECKS OFF is a necessary workaround for a compiler bug that very
// occasionally report incorrect overflow errors in Delphi versions before 10.2.
// see https://forums.embarcadero.com/message.jspa?messageID=871444
{$OVERFLOWCHECKS OFF}

resourcestring
  rsClipper_OpenPathErr = 'Only subject paths can be open.';
  rsClipper_ClippingErr = 'Undefined clipping error';

//------------------------------------------------------------------------------
//  Miscellaneous Functions ...
//------------------------------------------------------------------------------

function Point64(const fp: TFloatPoint): TPoint64; overload;
  {$IFDEF USEINLINING} inline; {$ENDIF}
begin
  Result.X := Round(fp.X * FixedOne);
  Result.Y := Round(fp.Y * FixedOne);
end;
//------------------------------------------------------------------------------

function Point64(const X, Y: Int64): TPoint64; overload;
begin
  Result.X := X;
  Result.Y := Y;
end;
//------------------------------------------------------------------------------

function FloatPoint(const pt: TPoint64): TFloatPoint; overload;
  {$IFDEF USEINLINING} inline; {$ENDIF}
begin
  Result.X := pt.X * FixedToFloat;
  Result.Y := pt.Y * FixedToFloat;
end;
//------------------------------------------------------------------------------

function FixedToFloat(const fixed: TArrayOfFixedPoint): TArrayOfFloatPoint;
var
  i, len: Integer;
begin
  len := length(fixed);
  setLength(Result, len);
  for i := 0 to len -1 do
    Result[i] := FloatPoint(fixed[i]);
end;
//------------------------------------------------------------------------------

function FloatToFixed(const float: TArrayOfFloatPoint):
  TArrayOfFixedPoint; overload;
var
  i, len: Integer;
begin
  len := length(float);
  setLength(Result, len);
  for i := 0 to len -1 do
    Result[i] := FixedPoint(float[i]);
end;
//------------------------------------------------------------------------------

function FloatToFixed(const float: TArrayOfArrayOfFloatPoint):
  TArrayOfArrayOfFixedPoint; overload;
var
  i, len: Integer;
begin
  len := length(float);
  setLength(Result, len);
  for i := 0 to len -1 do
    Result[i] := FloatToFixed(float[i]);
end;
//------------------------------------------------------------------------------

function PointsEqual(const p1, p2: TPoint64): Boolean; overload;
  {$IFDEF USEINLINING} inline; {$ENDIF}
begin
  Result := (p1.X = p2.X) and (p1.Y = p2.Y);
end;
//------------------------------------------------------------------------------

function PointsEqual(const p1, p2: TFloatPoint): Boolean; overload;
  {$IFDEF USEINLINING} inline; {$ENDIF}
begin
  Result := (p1.X = p2.X) and (p1.Y = p2.Y);
end;
//------------------------------------------------------------------------------

function IsOpen(e: PActive): Boolean; overload;
  {$IFDEF USEINLINING} inline; {$ENDIF}
begin
  Result := e.LocMin.IsOpen;
end;
//------------------------------------------------------------------------------

function IsOpen(outrec: TOutRec): Boolean; overload;
  {$IFDEF USEINLINING} inline; {$ENDIF}
begin
  Result := outrec.State = osOpen;
end;
//------------------------------------------------------------------------------

function IsOuter(outrec: TOutRec): Boolean;
  {$IFDEF USEINLINING} inline; {$ENDIF}
begin
  Result := outrec.State in [osOuter, osOuterCheck];
end;
//------------------------------------------------------------------------------

procedure SetAsOuter(outrec: TOutRec); {$IFDEF USEINLINING} inline; {$ENDIF}
begin
  outrec.State := osOuter;
end;
//------------------------------------------------------------------------------

function IsInner(outrec: TOutRec): Boolean;
  {$IFDEF USEINLINING} inline; {$ENDIF}
begin
  Result := outrec.State in [osInner, osInnerCheck];
end;
//------------------------------------------------------------------------------

procedure SetAsInner(outrec: TOutRec); {$IFDEF USEINLINING} inline; {$ENDIF}
begin
  outrec.State := osInner;
end;
//------------------------------------------------------------------------------

procedure SetCheckFlag(outrec: TOutRec); {$IFDEF USEINLINING} inline; {$ENDIF}
begin
  if outrec.State = osInner then
    outrec.State := osInnerCheck
  else if outrec.State = osOuter then
    outrec.State := osOuterCheck;
end;
//------------------------------------------------------------------------------

procedure UnsetCheckFlag(outrec: TOutRec); {$IFDEF USEINLINING} inline; {$ENDIF}
begin
  if outrec.State = osInnerCheck then outrec.State := osInner
  else if outrec.State = osOuterCheck then outrec.State := osOuter;
end;
//------------------------------------------------------------------------------

function IsHotEdge(e: PActive): Boolean; {$IFDEF USEINLINING} inline; {$ENDIF}
begin
  Result := assigned(e.OutRec);
end;
//------------------------------------------------------------------------------

function GetPrevHotEdge(e: PActive): PActive;
  {$IFDEF USEINLINING} inline; {$ENDIF}
begin
  Result := e.PrevInAEL;
  while assigned(Result) and (IsOpen(Result) or not IsHotEdge(Result)) do
    Result := Result.PrevInAEL;
end;
//------------------------------------------------------------------------------

function IsFront(e: PActive): Boolean; {$IFDEF USEINLINING} inline; {$ENDIF}
begin
  // the front edge will be the LEFT edge when it's an OUTER polygon
  // so that outer polygons will be orientated clockwise
  Result := (e = e.OutRec.frontE);
end;
//------------------------------------------------------------------------------

function IsInvalidPath(op: TOutPt): Boolean;
  {$IFDEF USEINLINING} inline; {$ENDIF}
begin
  Result := not assigned(op) or (op.Next = op);
end;
//------------------------------------------------------------------------------

(*******************************************************************************
*  Dx:                             0(90deg)                                    *
*                                  |                                           *
*               +inf (180deg) <--- o ---> -inf (0deg)                          *
*******************************************************************************)

function GetDx(const pt1, pt2: TPoint64): Double;
  {$IFDEF USEINLINING} inline; {$ENDIF}
var
  dy: Int64;
begin
  dy := (pt2.Y - pt1.Y);
  if dy <> 0 then Result := (pt2.X - pt1.X) / dy
  else if (pt2.X > pt1.X) then Result := NegInfinity
  else Result := Infinity;
end;
//------------------------------------------------------------------------------

function TopX(e: PActive; const currentY: Int64): Int64; overload;
  {$IFDEF USEINLINING} inline; {$ENDIF}
begin
  if (currentY = e.Top.Y) or (e.Top.X = e.Bot.X) then Result := e.Top.X
  else Result := e.Bot.X + Round(e.Dx*(currentY - e.Bot.Y));
end;
//------------------------------------------------------------------------------

function TopX(const pt1, pt2: TPoint64; const Y: Int64): Int64; overload;
  {$IFDEF USEINLINING} inline; {$ENDIF}
var
  dx: Double;
begin
  if (Y = pt1.Y) then Result := pt1.X
  else if (Y = pt2.Y) then Result := pt2.X
  else if (pt1.Y = pt2.Y) or (pt1.X = pt2.X) then Result := pt2.X
  else
  begin
    dx := GetDx(pt1, pt2);
    Result := pt1.X + Round(dx * (Y - pt1.Y));
  end;
end;
//------------------------------------------------------------------------------

function IsHorizontal(e: PActive): Boolean;
  {$IFDEF USEINLINING} inline; {$ENDIF}
begin
  Result := (e.Top.Y = e.Bot.Y);
end;
//------------------------------------------------------------------------------

function IsHeadingRightHorz(e: PActive): Boolean;
  {$IFDEF USEINLINING} inline; {$ENDIF}
begin
  Result := (e.Dx = NegInfinity);
end;
//------------------------------------------------------------------------------

function IsHeadingLeftHorz(e: PActive): Boolean;
  {$IFDEF USEINLINING} inline; {$ENDIF}
begin
  Result := (e.Dx = Infinity);
end;
//------------------------------------------------------------------------------

procedure SwapActives(var e1, e2: PActive);
  {$IFDEF USEINLINING} inline; {$ENDIF}
var
  e: PActive;
begin
  e := e1; e1 := e2; e2 := e;
end;
//------------------------------------------------------------------------------

function GetPolyType(const e: PActive): TPathType;
  {$IFDEF USEINLINING} inline; {$ENDIF}
begin
  Result := e.LocMin.PolyType;
end;
//------------------------------------------------------------------------------

function IsSamePolyType(const e1, e2: PActive): Boolean;
  {$IFDEF USEINLINING} inline; {$ENDIF}
begin
  Result := e1.LocMin.PolyType = e2.LocMin.PolyType;
end;
//------------------------------------------------------------------------------

function GetIntersectPoint(e1, e2: PActive): TPoint64;
var
  b1, b2, m: Double;
begin
  if (e1.Dx = e2.Dx) then
  begin
    Result := e1.Top;
    Exit;
  end
  else if e1.Dx = 0 then
  begin
    Result.X := e1.Bot.X;
    if IsHorizontal(e2) then
      Result.Y := e2.Bot.Y
    else
    begin
      with e2^ do b2 := Bot.Y - (Bot.X/Dx);
      Result.Y := round(Result.X/e2.Dx + b2);
    end;
  end
  else if e2.Dx = 0 then
  begin
    Result.X := e2.Bot.X;
    if IsHorizontal(e1) then
      Result.Y := e1.Bot.Y
    else
    begin
      with e1^ do b1 := Bot.Y - (Bot.X/Dx);
      Result.Y := round(Result.X/e1.Dx + b1);
    end;
  end else
  begin
    with e1^ do b1 := Bot.X - Bot.Y * Dx;
    with e2^ do b2 := Bot.X - Bot.Y * Dx;
    m := (b2-b1)/(e1.Dx - e2.Dx);
    Result.Y := round(m);
    if Abs(e1.Dx) < Abs(e2.Dx) then
      Result.X := round(e1.Dx * m + b1) else
      Result.X := round(e2.Dx * m + b2);
  end;
end;
//------------------------------------------------------------------------------

procedure SetDx(e: PActive);  {$IFDEF USEINLINING} inline; {$ENDIF}
begin
  e.Dx := GetDx(e.Bot, e.Top);
end;
//------------------------------------------------------------------------------

function IsLeftBound(e: PActive): Boolean; {$IFDEF USEINLINING} inline; {$ENDIF}
begin
  Result := e.WindDx > 0;
end;
//------------------------------------------------------------------------------

function NextVertex(e: PActive): PVertex; overload;
  {$IFDEF USEINLINING} inline; {$ENDIF}
begin
  if IsLeftBound(e) then
    Result := e.vertTop.next else
    Result := e.vertTop.prev;
end;
//------------------------------------------------------------------------------

function NextVertex(op: PVertex; goingFwd: Boolean): PVertex; overload;
  {$IFDEF USEINLINING} inline; {$ENDIF}
begin
  if goingFwd then Result := op.next
  else Result := op.prev;
end;
//------------------------------------------------------------------------------

function PrevVertex(op: PVertex; goingFwd: Boolean): PVertex;
  {$IFDEF USEINLINING} inline; {$ENDIF}
begin
  if goingFwd then Result := op.prev
  else Result := op.next;
end;
//------------------------------------------------------------------------------

function CrossProduct(const pt1, pt2, pt3: TPoint64): Double;
var
  x1,x2,y1,y2: Double;
begin
  x1 := pt2.X - pt1.X;
  y1 := pt2.Y - pt1.Y;
  x2 := pt3.X - pt2.X;
  y2 := pt3.Y - pt2.Y;
  Result := (x1 * y2 - y1 * x2);
end;
//---------------------------------------------------------------------------

function IsClockwise(vertex: PVertex): Boolean; overload;
  {$IFDEF USEINLINING} inline; {$ENDIF}
begin
  Result := CrossProduct(vertex.prev.Pt, vertex.Pt, vertex.next.Pt) >= 0;
end;
//----------------------------------------------------------------------

function IsClockwise(op: TOutPt): Boolean; overload;
  {$IFDEF USEINLINING} inline; {$ENDIF}
begin
  Result := CrossProduct(op.prev.Pt, op.Pt, op.next.Pt) >= 0;
end;
//----------------------------------------------------------------------

function IsMaxima(e: PActive): Boolean; {$IFDEF USEINLINING} inline; {$ENDIF}
begin
  Result := vfLocMax in e.vertTop.flags;
end;
//------------------------------------------------------------------------------

procedure TerminateHotOpen(e: PActive);
begin
  if e.OutRec.frontE = e then
    e.OutRec.frontE := nil else
    e.OutRec.backE := nil;
  e.OutRec := nil;
end;
//------------------------------------------------------------------------------

function GetMaximaPair(e: PActive): PActive;
begin
  if IsHorizontal(e) then
  begin
    // we can't be sure whether the MaximaPair is on the left or right, so ...
    Result := e.PrevInAEL;
    while assigned(Result) and (Result.CurrX >= e.Top.X) do
    begin
      if Result.vertTop = e.vertTop then Exit;  // Found!
      Result := Result.PrevInAEL;
    end;
    Result := e.NextInAEL;
    while assigned(Result) and (TopX(Result, e.Top.Y) <= e.Top.X) do
    begin
      if Result.vertTop = e.vertTop then Exit;  // Found!
      Result := Result.NextInAEL;
    end;
  end else
  begin
    Result := e.NextInAEL;
    while assigned(Result) do
    begin
      if Result.vertTop = e.vertTop then Exit;  // Found!
      Result := Result.NextInAEL;
    end;
  end;
  Result := nil;
end;
//------------------------------------------------------------------------------

function PointCount(pts: TOutPt): Integer; {$IFDEF USEINLINING} inline; {$ENDIF}
var
  p: TOutPt;
begin
  Result := 0;
  if not Assigned(pts) then Exit;
  p := pts;
  repeat
    Inc(Result);
    p := p.Next;
  until p = pts;
end;
//------------------------------------------------------------------------------

function BuildPath(op: TOutPt): TArrayOfFloatPoint;
var
  i,j, opCnt: Integer;
begin
  Result := nil;
  opCnt := PointCount(op);
  if (opCnt < 2) then Exit;
  setLength(Result, opCnt);
  Result[0] := FloatPoint(op.Pt);
  op := op.Next;
  j := 1;
  for i := 0 to opCnt -2 do
  begin
    Result[j] := FloatPoint(op.Pt);
    if not PointsEqual(Result[j], Result[j-1]) then inc(j);
    op := op.Next;
  end;
  setLength(Result, j);
end;
//------------------------------------------------------------------------------

procedure DisposeOutPt(pp: TOutPt); {$IFDEF USEINLINING} inline; {$ENDIF}
begin
  pp.Prev.Next := pp.Next;
  pp.Next.Prev := pp.Prev;
  pp.Free;
end;
//------------------------------------------------------------------------------

procedure DisposePolyPts(pp: TOutPt);  {$IFDEF USEINLINING} inline; {$ENDIF}
var
  tmpPp: TOutPt;
begin
  pp.Prev.Next := nil;
  while Assigned(pp) do
  begin
    tmpPp := pp;
    pp := pp.Next;
    tmpPp.Free;
  end;
end;
//------------------------------------------------------------------------------

function LocMinListSort(item1, item2: Pointer): Integer;
var
  dy: Int64;
begin
  dy := PLocalMinima(item2).vertex.Pt.Y - PLocalMinima(item1).vertex.Pt.Y;
  if dy < 0 then Result := -1
  else if dy > 0 then Result := 1
  else Result := 0;
end;
//------------------------------------------------------------------------------

procedure SetSides(outRec: TOutRec; startEdge, endEdge: PActive);
  {$IFDEF USEINLINING} inline; {$ENDIF}
begin
  outRec.frontE := startEdge;
  outRec.backE := endEdge;
end;
//------------------------------------------------------------------------------

procedure SwapOutRecs(e1, e2: PActive);
var
  or1, or2: TOutRec;
  e: PActive;
begin
  or1 := e1.OutRec;
  or2 := e2.OutRec;
  if (or1 = or2) then
  begin
    e := or1.frontE;
    or1.frontE := or1.backE;
    or1.backE := e;
    Exit;
  end;
  if assigned(or1) then
  begin
    if e1 = or1.frontE then
      or1.frontE := e2 else
      or1.backE := e2;
  end;
  if assigned(or2) then
  begin
    if e2 = or2.frontE then
      or2.frontE := e1 else
      or2.backE := e1;
  end;
  e1.OutRec := or2;
  e2.OutRec := or1;
end;
//------------------------------------------------------------------------------

function Area(const path: TArrayOfFloatPoint): Double; overload;
var
  i, j, highI: Integer;
  d: Double;
begin
  Result := 0.0;
  highI := High(path);
  if (highI < 2) then Exit;
  j := highI;
  for i := 0 to highI do
  begin
    d := (path[j].X + path[i].X);
    Result := Result + d * (path[j].Y - path[i].Y);
    j := i;
  end;
  Result := -Result * 0.5;
end;
//------------------------------------------------------------------------------

function Area(op: TOutPt): Double; overload;
var
  op2: TOutPt;
  d: Double;
begin
  // positive results are clockwise
  Result := 0;
  op2 := op;
  if Assigned(op2) then
  repeat
    d := op2.Prev.Pt.X + op2.Pt.X;
    Result := Result + d * (op2.Prev.Pt.Y - op2.Pt.Y);
    op2 := op2.Next;
  until op2 = op;
  Result := Result * -0.5;
end;
//------------------------------------------------------------------------------

procedure ReverseOutPts(op: TOutPt);
var
  op1, op2: TOutPt;
begin
  if not Assigned(op) then Exit;
  op1 := op;
  repeat
    op2:= op1.Next;
    op1.Next := op1.Prev;
    op1.Prev := op2;
    op1 := op2;
  until op1 = op;
end;
//------------------------------------------------------------------------------

function RecheckInnerOuter(e: PActive): Boolean;
var
  wasOuter, isOuter: Boolean;
  e2: PActive;
  area: Double;
begin
  area := GR32_Clipper.Area(e.outrec.Pts);
  Result := area <> 0;
  if not Result then Exit; // returns false when area == 0

  wasOuter := GR32_Clipper.IsOuter(e.OutRec);
  isOuter := true;
  e2 := e.PrevInAEL;
  while assigned(e2) do
  begin
   if IsHotEdge(e2) and not IsOpen(e2) then isOuter := not isOuter;
   e2 := e2.PrevInAEL;
  end;

  if isOuter <> wasOuter then
  begin
    if isOuter then SetAsOuter(e.outrec)
    else SetAsInner(e.outrec);
  end;

  e2 := GetPrevHotEdge(e);
  if isOuter then
  begin
    if assigned(e2) and IsInner(e2.OutRec) then e.OutRec.Owner := e2.OutRec
    else e.OutRec.Owner := nil;
  end else
  begin
    if not assigned(e2) then SetAsOuter(e.OutRec)
    else if IsInner(e2.OutRec) then e.OutRec.Owner := e2.OutRec.Owner
    else e.OutRec.Owner := e2.OutRec;
  end;

  if (area > 0) <> isOuter then ReverseOutPts(e.outrec.Pts);
  UnsetCheckFlag(e.OutRec);
end;
//------------------------------------------------------------------------------

procedure SwapSides(outRec: TOutRec); {$IFDEF USEINLINING} inline; {$ENDIF}
var
  e2: PActive;
begin
  e2 := outRec.frontE;
  outRec.frontE := outRec.backE;
  outRec.backE := e2;
  outRec.Pts := outRec.Pts.Next;
end;
//------------------------------------------------------------------------------

function FixSides(e: PActive): Boolean;
begin
  Result := not RecheckInnerOuter(e) or (IsOuter(e.OutRec) <> IsFront(e));
  if Result then SwapSides(e.OutRec);
end;
//------------------------------------------------------------------------------

procedure SetOwnerAndInnerOuterState(e: PActive);
var
  e2: PActive;
  outRec: TOutRec;
begin
  outRec := e.OutRec;
  if IsOpen(e) then
  begin
    outRec.Owner := nil;
    outRec.State := osOpen;
    Exit;
  end;
  // set owner ...
  if IsHeadingLeftHorz(e) then
  begin
    e2 := e.NextInAEL; // ie assess state from opposite direction
    while assigned(e2) and (not IsHotEdge(e2) or IsOpen(e2)) do
      e2 := e2.NextInAEL;
    if not assigned(e2) then outRec.Owner := nil
    else if IsOuter(e2.OutRec) = (e2.OutRec.frontE = e2) then
      outRec.Owner := e2.OutRec.Owner
    else
      outRec.Owner := e2.OutRec;
  end else
  begin
    e2 := GetPrevHotEdge(e);
    if not assigned(e2) then
      outRec.Owner := nil
    else if IsOuter(e2.OutRec) = (e2.OutRec.backE = e2) then
      outRec.Owner := e2.OutRec.Owner
    else
      outRec.Owner := e2.OutRec;
  end;

  // set inner/outer ...
  if not assigned(outRec.Owner) or IsInner(outRec.Owner) then
    outRec.State := osOuter else
    outRec.State := osInner;

end;
//------------------------------------------------------------------------------

function EdgesAdjacentInAEL(node: PIntersectNode): Boolean;
  {$IFDEF USEINLINING} inline; {$ENDIF}
begin
  with node^ do
    Result := (Edge1.NextInAEL = Edge2) or (Edge1.PrevInAEL = Edge2);
end;
//------------------------------------------------------------------------------

function IntersectListSort(node1, node2: Pointer): Integer;
begin
  Result := PIntersectNode(node2).Pt.Y - PIntersectNode(node1).Pt.Y;
  if (Result = 0) and (node1 <> node2) then
    Result := PIntersectNode(node1).Pt.X - PIntersectNode(node2).Pt.X;
end;

//------------------------------------------------------------------------------
//  TClipper methods ...
//------------------------------------------------------------------------------

constructor TClipper.Create;
begin
  FLocMinList := TList.Create;
  FOutRecList := TList.Create;
  FIntersectList := TList.Create;
  FVertexList := TList.Create;
end;
//------------------------------------------------------------------------------

destructor TClipper.Destroy;
begin
  Clear;
  FLocMinList.Free;
  FOutRecList.Free;
  FIntersectList.Free;
  FVertexList.Free;
  inherited;
end;
//------------------------------------------------------------------------------

procedure TClipper.CleanUp;
var
  dummy: Int64;
begin
  try
    // in case of exceptions ...
    while assigned(FActives) do DeleteFromAEL(FActives);
    while assigned(FScanLine) do PopScanLine(dummy);
    DisposeIntersectNodes;

    DisposeScanLineList;
    DisposeAllOutRecs;
  except
  end;
end;
//------------------------------------------------------------------------------

procedure TClipper.Clear;
begin
  CleanUp;
  DisposeVerticesAndLocalMinima;
  FCurrentLocMinIdx := 0;
  FLocMinListSorted := false;
  FHasOpenPaths := False;
end;
//------------------------------------------------------------------------------

procedure TClipper.Reset;
var
  i: Integer;
begin
  if not FLocMinListSorted then
  begin
    FLocMinList.Sort(LocMinListSort);
    FLocMinListSorted := true;
  end;
  for i := FLocMinList.Count -1 downto 0 do
    InsertScanLine(PLocalMinima(FLocMinList[i]).vertex.Pt.Y);
  FCurrentLocMinIdx := 0;
  FActives := nil;
  FSel := nil;
end;
//------------------------------------------------------------------------------

procedure TClipper.InsertScanLine(const Y: Int64);
var
  newSl, sl: PScanLine;
begin
  // The scanline list is a single-linked list of all the Y coordinates of
  // subject and clip vertices in the clipping operation (sorted descending).
  // However, only scanline Y's at Local Minima are inserted before clipping
  // starts. While scanlines are removed sequentially during the sweep, new
  // scanlines are only inserted whenever edge bounds are updated. This keeps
  // the scanline list relatively short, optimising performance.
  if not Assigned(FScanLine) then
  begin
    new(newSl);
    newSl.Y := Y;
    FScanLine := newSl;
    newSl.Next := nil;
  end else if Y > FScanLine.Y then
  begin
    new(newSl);
    newSl.Y := Y;
    newSl.Next := FScanLine;
    FScanLine := newSl;
  end else
  begin
    sl := FScanLine;
    while Assigned(sl.Next) and (Y <= sl.Next.Y) do
      sl := sl.Next;
    if Y = sl.Y then Exit; // skip duplicates
    new(newSl);
    newSl.Y := Y;
    newSl.Next := sl.Next;
    sl.Next := newSl;
  end;
end;
//------------------------------------------------------------------------------

function TClipper.PopScanLine(out Y: Int64): Boolean;
var
  sl: PScanLine;
begin
  Result := assigned(FScanLine);
  if not Result then Exit;
  Y := FScanLine.Y;
  sl := FScanLine;
  FScanLine := FScanLine.Next;
  dispose(sl);
end;
//------------------------------------------------------------------------------

function TClipper.PopLocalMinima(Y: Int64;
  out localMinima: PLocalMinima): Boolean;
begin
  Result := false;
  if FCurrentLocMinIdx = FLocMinList.Count then Exit;
  localMinima := PLocalMinima(FLocMinList[FCurrentLocMinIdx]);
  if (localMinima.vertex.Pt.Y = Y) then
  begin
    inc(FCurrentLocMinIdx);
    Result := true;
  end;
end;
//------------------------------------------------------------------------------

procedure TClipper.DisposeScanLineList;
var
  sl: PScanLine;
begin
  while Assigned(FScanLine) do
  begin
    sl := FScanLine.Next;
    Dispose(FScanLine);
    FScanLine := sl;
  end;
end;
//------------------------------------------------------------------------------

procedure TClipper.DisposeOutRec(index: Integer);
var
  outRec: TOutRec;
begin
  outRec := FOutRecList[index];
  if Assigned(outRec.Pts) then DisposePolyPts(outRec.Pts);
  outRec.Free;
end;
//------------------------------------------------------------------------------

procedure TClipper.DisposeAllOutRecs;
var
  i: Integer;
begin
  for i := 0 to FOutRecList.Count -1 do DisposeOutRec(i);
  FOutRecList.Clear;
end;
//------------------------------------------------------------------------------

procedure TClipper.DisposeVerticesAndLocalMinima;
var
  i: Integer;
begin
  for i := 0 to FLocMinList.Count -1 do
    Dispose(PLocalMinima(FLocMinList[i]));
  FLocMinList.Clear;
  for i := 0 to FVertexList.Count -1 do FreeMem(FVertexList[i]);
  FVertexList.Clear;
end;
//------------------------------------------------------------------------------

procedure TClipper.AddPathToVertexList(const path: TArrayOfFloatPoint;
  polyType: TPathType; isOpen: Boolean);
var
  i, j, pathLen: Integer;
  isFlat, goingUp, p0IsMinima, p0IsMaxima: Boolean;
  v: PVertex;
  va: PVertexArray;

  procedure AddLocMin(vert: PVertex);
  var
    lm: PLocalMinima;
  begin
    if vfLocMin in vert.flags then Exit; // ensures vertex is added only once
    Include(vert.flags, vfLocMin);
    new(lm);
    lm.vertex := vert;
    lm.PolyType := polyType;
    lm.IsOpen := isOpen;
    FLocMinList.Add(lm);                 // nb: sorted in Reset()
  end;
  //----------------------------------------------------------------------------

begin
  pathLen := length(path);
  if (pathLen < 2) then Exit;

  p0IsMinima := false;
  p0IsMaxima := false;
  i := 1;
  // find the first non-horizontal segment in the path ...
  while (i < pathLen) and (path[i].Y = path[0].Y) do inc(i);
  isFlat := i = pathLen;
  if isFlat then
  begin
    if not isOpen then Exit;    // Ignore closed paths that have ZERO area.
    goingUp := false;           // And this just stops a compiler warning.
  end else
  begin
    goingUp := path[i].Y < path[0].Y;
    if goingUp then
    begin
      i := pathLen -1;
      while path[i].Y = path[0].Y do dec(i);
      p0IsMinima := path[i].Y < path[0].Y; // p[0].Y == a minima
    end else
    begin
      i := pathLen -1;
      while path[i].Y = path[0].Y do dec(i);
      p0IsMaxima := path[i].Y > path[0].Y; // p[0].Y == a maxima
    end;
  end;

  GetMem(va, sizeof(TVertex) * pathLen);
  FVertexList.Add(va);

  va[0].Pt := Point64(path[0]);
  va[0].flags := [];
  if isOpen then
  begin
    include(va[0].flags, vfOpenStart);
    if goingUp then
      AddLocMin(@va[0]) else
      include(va[0].flags, vfLocMax);
  end;

  // nb: polygon orientation is determined later (see InsertLocalMinimaIntoAEL).
  i := 0;
  for j := 1 to pathLen -1 do
  begin
    va[j].Pt := Point64(path[j]);
    if PointsEqual(va[j].Pt, va[i].Pt) then Continue;
    va[j].flags := [];
    va[i].next := @va[j];
    va[j].prev := @va[i];
    if (path[j].Y > path[i].Y) and goingUp then
    begin
      include(va[i].flags, vfLocMax);
      goingUp := false;
    end
    else if (path[j].Y < path[i].Y) and not goingUp then
    begin
      goingUp := true;
      AddLocMin(@va[i]);
    end;
    i := j;
  end;
  // i: index of the last vertex in the path.
  va[i].next := @va[0];
  va[0].prev := @va[i];

  if isOpen then
  begin
    include(va[i].flags, vfOpenEnd);
    if goingUp then
      include(va[i].flags, vfLocMax) else
      AddLocMin(@va[i]);
  end
  else if goingUp then
  begin
    // going up so find local maxima ...
    v := @va[i];
    while (v.Next.Pt.Y <= v.Pt.Y) do v := v.next;
    include(v.flags, vfLocMax);
    if p0IsMinima then AddLocMin(@va[0]); // ie just turned to going up
  end else
  begin
    // going down so find local minima ...
    v := @va[i];
    while (v.Next.Pt.Y >= v.Pt.Y) do v := v.next;
    AddLocMin(v);
    if p0IsMaxima then include(va[0].flags, vfLocMax);
  end;
end;
//------------------------------------------------------------------------------

procedure TClipper.AddPath(const path64: TArrayOfFloatPoint;
  PolyType: TPathType; isOpen: Boolean);
begin
  if isOpen then
  begin
    if (PolyType = ptClip) then
      raise EClipperLibException.Create(rsClipper_OpenPathErr);
    FHasOpenPaths := true;
  end;
  FLocMinListSorted := false;
  AddPathToVertexList(path64, polyType, isOpen);
end;
//------------------------------------------------------------------------------

procedure TClipper.AddPath(const path: TArrayOfFixedPoint;
  PolyType: TPathType; isOpen: Boolean);
begin
  AddPathToVertexList(FixedToFloat(path), polyType, isOpen);
end;
//------------------------------------------------------------------------------

procedure TClipper.AddPaths(const paths64: TArrayOfArrayOfFloatPoint;
  polyType: TPathType; isOpen: Boolean);
var
  i: Integer;
begin
  for i := 0 to high(paths64) do AddPath(paths64[i], polyType, isOpen);
end;
//------------------------------------------------------------------------------

procedure TClipper.AddPaths(const paths: TArrayOfArrayOfFixedPoint;
  polyType: TPathType = ptSubject; isOpen: Boolean = false);
var
  i: Integer;
begin
  for i := 0 to high(paths) do AddPath(paths[i], polyType, isOpen);
end;
//------------------------------------------------------------------------------

function TClipper.IsContributingClosed(e: PActive): Boolean;
begin
  Result := false;
  case FFillRule of
    frNonZero: if abs(e.WindCnt) <> 1 then Exit;
    frPositive: if (e.WindCnt <> 1) then Exit;
    frNegative: if (e.WindCnt <> -1) then Exit;
  end;

  case FClipType of
    ctIntersection:
      case FFillRule of
        frEvenOdd, frNonZero: Result := (e.WindCnt2 <> 0);
        frPositive: Result := (e.WindCnt2 > 0);
        frNegative: Result := (e.WindCnt2 < 0);
      end;
    ctUnion:
      case FFillRule of
        frEvenOdd, frNonZero: Result := (e.WindCnt2 = 0);
        frPositive: Result := (e.WindCnt2 <= 0);
        frNegative: Result := (e.WindCnt2 >= 0);
      end;
    ctDifference:
      if GetPolyType(e) = ptSubject then
        case FFillRule of
          frEvenOdd, frNonZero: Result := (e.WindCnt2 = 0);
          frPositive: Result := (e.WindCnt2 <= 0);
          frNegative: Result := (e.WindCnt2 >= 0);
        end
      else
        case FFillRule of
          frEvenOdd, frNonZero: Result := (e.WindCnt2 <> 0);
          frPositive: Result := (e.WindCnt2 > 0);
          frNegative: Result := (e.WindCnt2 < 0);
        end;
    ctXor:
        Result := true;
  end;
end;
//------------------------------------------------------------------------------

function TClipper.IsContributingOpen(e: PActive): Boolean;
begin
    case FClipType of
      ctIntersection:
        Result := (e.WindCnt2 <> 0);
      ctXor:
        Result := (e.WindCnt <> 0) <> (e.WindCnt2 <> 0);
      ctDifference:
        Result := (e.WindCnt2 = 0);
      else // ctUnion:
        Result := (e.WindCnt = 0) and (e.WindCnt2 = 0);
    end;
end;
//------------------------------------------------------------------------------

procedure TClipper.SetWindCountForClosedPathEdge(e: PActive);
var
  e2: PActive;
begin
  // Wind counts refer to polygon regions not edges, so here an edge's WindCnt
  // indicates the higher of the wind counts for the two regions touching the
  // edge. (nb: Adjacent regions can only ever have their wind counts differ by
  // one. Also, open paths have no meaningful wind directions or counts.)

  e2 := e.PrevInAEL;
  // find the nearest closed edge of the same PolyType in AEL (heading left)
  while Assigned(e2) and (not IsSamePolyType(e2, e) or IsOpen(e2)) do
    e2 := e2.PrevInAEL;

  if not Assigned(e2) then
  begin
    e.WindCnt := e.WindDx;
    e2 := FActives;
  end
  else if (FFillRule = frEvenOdd) then
  begin
    e.WindCnt := e.WindDx;
    e.WindCnt2 := e2.WindCnt2;
    e2 := e2.NextInAEL;
  end else
  begin
    // NonZero, positive, or negative filling here ...
    // if e's WindCnt is in the SAME direction as its WindDx, then polygon
    // filling will be on the right of 'e'.
    // nb: neither e2.WindCnt nor e2.WindDx should ever be 0.
    if (e2.WindCnt * e2.WindDx < 0) then
    begin
      // opposite directions so 'e' is outside 'e2' ...
      if (Abs(e2.WindCnt) > 1) then
      begin
        // outside prev poly but still inside another.
        if (e2.WindDx * e.WindDx < 0) then
          // reversing direction so use the same WC
          e.WindCnt := e2.WindCnt else
          // otherwise keep 'reducing' the WC by 1 (ie towards 0) ...
          e.WindCnt := e2.WindCnt + e.WindDx;
      end
      // now outside all polys of same polytype so set own WC ...
      else e.WindCnt := e.WindDx;
    end else
    begin
      // 'e' must be inside 'e2'
      if (e2.WindDx * e.WindDx < 0) then
        // reversing direction so use the same WC
        e.WindCnt := e2.WindCnt
      else
        // otherwise keep 'increasing' the WC by 1 (ie away from 0) ...
        e.WindCnt := e2.WindCnt + e.WindDx;
    end;
    e.WindCnt2 := e2.WindCnt2;
    e2 := e2.NextInAEL;
  end;

  // update WindCnt2 ...
  if FFillRule = frEvenOdd then
    while (e2 <> e) do
    begin
      if IsSamePolyType(e2, e) or IsOpen(e2) then // do nothing
      else if e.WindCnt2 = 0 then e.WindCnt2 := 1
      else e.WindCnt2 := 0;
      e2 := e2.NextInAEL;
    end
  else
    while (e2 <> e) do
    begin
      if not IsSamePolyType(e2, e) and not IsOpen(e2) then
        Inc(e.WindCnt2, e2.WindDx);
      e2 := e2.NextInAEL;
    end;
end;
//------------------------------------------------------------------------------

procedure TClipper.SetWindCountForOpenPathEdge(e: PActive);
var
  e2: PActive;
  cnt1, cnt2: Integer;
begin
  e2 := FActives;
  if FFillRule = frEvenOdd then
  begin
    cnt1 := 0;
    cnt2 := 0;
    while (e2 <> e) do
    begin
      if (GetPolyType(e2) = ptClip) then inc(cnt2)
      else if not IsOpen(e2) then inc(cnt1);
      e2 := e2.NextInAEL;
    end;
    if Odd(cnt1) then e.WindCnt := 1 else e.WindCnt := 0;
    if Odd(cnt2) then e.WindCnt2 := 1 else e.WindCnt2 := 0;
  end else
  begin
    // if FClipType in [ctUnion, ctDifference] then e.WindCnt := e.WindDx;
    while (e2 <> e) do
    begin
      if (GetPolyType(e2) = ptClip) then inc(e.WindCnt2, e2.WindDx)
      else if not IsOpen(e2) then inc(e.WindCnt, e2.WindDx);
      e2 := e2.NextInAEL;
    end;
  end;
end;
//------------------------------------------------------------------------------

function IsValidAelOrder(a1, a2: PActive): Boolean;
var
  pt1, pt2: TPoint64;
  op1, op2: PVertex;
  X: Int64;
begin
  if a2.CurrX <> a1.CurrX then
  begin
    Result := a2.CurrX > a1.CurrX;
    Exit;
  end;

  pt1 := a1.Bot; pt2 := a2.Bot;
  op1 := a1.VertTop; op2 := a2.VertTop;
  while true do
  begin
    if op1.Pt.Y >= op2.Pt.Y then
    begin
      X := TopX(pt2, op2.Pt, op1.Pt.Y) - op1.Pt.X;
      Result := X > 0;
      if X <> 0 then Exit;
      if op2.Pt.Y = op1.Pt.Y then
      begin
        pt2 := op2.Pt;
        op2 := NextVertex(op2, IsLeftBound(a2));
      end;
      pt1 := op1.Pt;
      op1 := NextVertex(op1, IsLeftBound(a1));
    end else
    begin
      X := op2.Pt.X - TopX(pt1, op1.Pt, op2.Pt.Y);
      Result := X > 0;
      if X <> 0 then Exit;
      pt2 := op2.Pt;
      op2 := NextVertex(op2, IsLeftBound(a2));
    end;

    if (op1.Pt.Y > pt1.Y) then
    begin
      Result := (a1.WindDx > 0) <> IsClockwise(PrevVertex(op1, a1.WindDx > 0));
      Exit;
    end else if (op2.Pt.Y > pt2.Y) then
    begin
      Result := (a2.WindDx > 0) = IsClockwise(PrevVertex(op2, a2.WindDx > 0));
      Exit;
    end;
  end;
  Result := true;
end;
//------------------------------------------------------------------------------

procedure TClipper.InsertLeftEdge(e: PActive);
var
  e2: PActive;
begin
  if not Assigned(FActives) then
  begin
    e.PrevInAEL := nil;
    e.NextInAEL := nil;
    FActives := e;
  end
  else if IsValidAelOrder(e, FActives) then
  begin
    e.PrevInAEL := nil;
    e.NextInAEL := FActives;
    FActives.PrevInAEL := e;
    FActives := e;
  end else
  begin
    e2 := FActives;
    while Assigned(e2.NextInAEL) and IsValidAelOrder(e2.NextInAEL, e) do
      e2 := e2.NextInAEL;
    e.NextInAEL := e2.NextInAEL;
    if Assigned(e2.NextInAEL) then e2.NextInAEL.PrevInAEL := e;
    e.PrevInAEL := e2;
    e2.NextInAEL := e;
  end;
end;
//----------------------------------------------------------------------

procedure InsertRightEdge(e, e2: PActive);
begin
  e2.NextInAEL := e.NextInAEL;
  if Assigned(e.NextInAEL) then e.NextInAEL.PrevInAEL := e2;
  e2.PrevInAEL := e;
  e.NextInAEL := e2;
end;
//----------------------------------------------------------------------

procedure TClipper.InsertLocalMinimaIntoAEL(const botY: Int64);
var
  leftB, rightB: PActive;
  locMin: PLocalMinima;
  contributing: Boolean;
begin
  // Add local minima (if any) at BotY ...
  // nb: horizontal local minima edges should contain locMin.vertex.prev

  while PopLocalMinima(botY, locMin) do
  begin
    if (vfOpenStart in locMin.vertex.flags) then
    begin
      leftB := nil;
    end else
    begin
      new(leftB);
      FillChar(leftB^, sizeof(TActive), 0);
      leftB.LocMin := locMin;
      leftB.OutRec := nil;
      leftB.Bot := locMin.vertex.Pt;
      leftB.vertTop := locMin.vertex.prev; // ie descending
      leftB.Top := leftB.vertTop.Pt;
      leftB.CurrX := leftB.Bot.X;
      leftB.WindDx := -1;
      SetDx(leftB);
    end;

    if (vfOpenEnd in locMin.vertex.flags) then
    begin
      rightB := nil;
    end else
    begin
      new(rightB);
      FillChar(rightB^, sizeof(TActive), 0);
      rightB.LocMin := locMin;
      rightB.OutRec := nil;
      rightB.Bot := locMin.vertex.Pt;
      rightB.vertTop := locMin.vertex.next; // ie ascending
      rightB.Top := rightB.vertTop.Pt;
      rightB.CurrX := rightB.Bot.X;
      rightB.WindDx := 1;
      SetDx(rightB);
    end;
    // Currently LeftB is just the descending bound and RightB is the ascending.
    // Now if the LeftB isn't on the left of RightB then we need swap them.
    if assigned(leftB) and assigned(rightB) then
    begin
      if IsHorizontal(leftB) then
      begin
        if IsHeadingRightHorz(leftB) then SwapActives(leftB, rightB);
      end
      else if IsHorizontal(rightB) then
      begin
        if IsHeadingLeftHorz(rightB) then SwapActives(leftB, rightB);
      end
      else if (leftB.Dx < rightB.Dx) then SwapActives(leftB, rightB);
    end
    else if not assigned(leftB) then
    begin
      leftB := rightB;
      rightB := nil;
    end;

    InsertLeftEdge(leftB);                   // /// //
    // todo: further validation of position in AEL ???

    if IsOpen(leftB) then
    begin
      SetWindCountForOpenPathEdge(leftB);
      contributing := IsContributingOpen(leftB);
    end else
    begin
      SetWindCountForClosedPathEdge(leftB);
      contributing := IsContributingClosed(leftB);
    end;

    if assigned(rightB) then
    begin
      rightB.WindCnt := leftB.WindCnt;
      rightB.WindCnt2 := leftB.WindCnt2;
      InsertRightEdge(leftB, rightB);        // /// //
      if contributing then
        AddLocalMinPoly(leftB, rightB, leftB.Bot, true);

      if IsHorizontal(rightB) then
        PushHorz(rightB) else
        InsertScanLine(rightB.Top.Y);
    end
    else if contributing then
      StartOpenPath(leftB, leftB.Bot);

    if IsHorizontal(leftB) then
      PushHorz(leftB) else
      InsertScanLine(leftB.Top.Y);
  end;
end;
//------------------------------------------------------------------------------

procedure TClipper.PushHorz(e: PActive);
begin
  if assigned(FSel) then
    e.NextInSEL := FSel else
    e.NextInSEL := nil;
  FSel := e;
end;
//------------------------------------------------------------------------------

function TClipper.PopHorz(out e: PActive): Boolean;
begin
  Result := assigned(FSel);
  if not Result then Exit;
  e := FSel;
  FSel := FSel.NextInSEL;
end;
//------------------------------------------------------------------------------

procedure TClipper.AddLocalMinPoly(e1, e2: PActive; const pt: TPoint64;
  IsNew: Boolean = false; orientationCheckRequired: Boolean = false);
var
  outRec: TOutRec;
  op: TOutPt;
begin
  outRec := TOutRec.Create;
  outRec.Idx := FOutRecList.Add(outRec);
  outRec.Pts := nil;

  e1.OutRec := outRec;
  SetOwnerAndInnerOuterState(e1);
  // flag when orientatation needs to be rechecked later ...
  if orientationCheckRequired then SetCheckFlag(outRec);

  e2.OutRec := outRec;
  if not IsOpen(e1) then
  begin
    // Setting the owner and inner/outer states (above) is an essential
    // precursor to setting edge 'sides' (ie left and right sides of output
    // polygons) and hence the orientation of output paths ...
    if IsOuter(outRec) = IsNew then
      SetSides(outRec, e1, e2) else
      SetSides(outRec, e2, e1);
  end;

  op := TOutPt.Create;
  outRec.Pts := op;
  op.Pt := pt;
  op.Prev := op;
  op.Next := op;

  // nb: currently e1.NextInAEL == e2 but this could change on return
end;
//------------------------------------------------------------------------------

procedure TClipper.AddLocalMaxPoly(e1, e2: PActive; const pt: TPoint64);
var
  op: TOutPt;
begin
  if not IsOpen(e1) and (IsFront(e1) = IsFront(e2)) then
    if not FixSides(e1) then FixSides(e2);

  op := AddOutPt(e1, pt);
  // AddOutPt(e2, pt); // this may no longer be necessary

  if  (e1.OutRec = e2.OutRec) then
  begin
    if e1.OutRec.State in [osOuterCheck, osInnerCheck] then
      RecheckInnerOuter(e1);

    // nb: IsClockwise() is generally faster than Area() but will occasionally
    // give false positives when there are tiny self-intersections at the top...
    if IsOuter(e1.OutRec) then
    begin
      if not IsClockwise(op) and (Area(op) < 0) then
        ReverseOutPts(e1.OutRec.Pts);
    end else
    begin
      if IsClockwise(op) and (Area(op) > 0) then
        ReverseOutPts(e1.OutRec.Pts);
    end;

    e1.outRec.frontE := nil;
    e1.outRec.backE := nil;
    e1.OutRec := nil;
    e2.OutRec := nil;
  end
  // and to preserve the winding orientation of Outrec ...
  else if e1.OutRec.Idx < e2.OutRec.Idx then
    JoinOutrecPaths(e1, e2) else
    JoinOutrecPaths(e2, e1);

end;
//------------------------------------------------------------------------------

procedure TClipper.JoinOutrecPaths(e1, e2: PActive);
var
  p1_start, p1_end, p2_start, p2_end: TOutPt;
begin
  if (IsFront(e1) = IsFront(e2)) then
  begin
    // one or other 'side' must be wrong ...
    if IsOpen(e1) then SwapSides(e2.OutRec)
    else if not FixSides(e1) and not FixSides(e2) then
      raise EClipperLibException.Create(rsClipper_ClippingErr);
    if e1.OutRec.Owner = e2.OutRec then
      e1.OutRec.Owner := e2.OutRec.Owner;
  end;

  // join e2 outrec path onto e1 outrec path and then delete e2 outrec path
  // pointers. (see joining_outpt.svg)
  p1_start :=  e1.OutRec.Pts;
  p2_start :=  e2.OutRec.Pts;
  p1_end := p1_start.Next;
  p2_end := p2_start.Next;

  if IsFront(e1) then
  begin
    p2_end.Prev := p1_start;
    p1_start.Next := p2_end;
    p2_start.Next := p1_end;
    p1_end.Prev := p2_start;
    e1.OutRec.Pts := p2_start;
    e1.OutRec.frontE := e2.OutRec.frontE;
    if not IsOpen(e1) then e1.OutRec.frontE.OutRec := e1.OutRec;
    // strip duplicates ...
    if (p2_end <> p2_start) and PointsEqual(p2_end.Pt, p2_end.Prev.Pt) then
      DisposeOutPt(p2_end);
  end else
  begin
    p1_end.Prev := p2_start;
    p2_start.Next := p1_end;
    p1_start.Next := p2_end;
    p2_end.Prev := p1_start;
    e1.OutRec.backE := e2.OutRec.backE;
    if not IsOpen(e1) then e1.OutRec.backE.OutRec := e1.OutRec;
    // strip duplicates ...
    if (p1_end <> p1_start) and PointsEqual(p1_end.Pt, p1_end.Prev.Pt) then
      DisposeOutPt(p1_end);
  end;

  if PointsEqual(e1.OutRec.Pts.Pt, e1.OutRec.Pts.Prev.Pt) and
    not IsInvalidPath(e1.OutRec.Pts) then
      DisposeOutPt(e1.OutRec.Pts.Prev);

  // after joining, the e2.OutRec must contains no vertices ...
  e2.OutRec.frontE := nil;
  e2.OutRec.backE := nil;
  e2.OutRec.Pts := nil;
  e2.OutRec.Owner := e1.OutRec; // this may be redundant

  // and e1 and e2 are maxima and are about to be dropped from the Actives list.
  e1.OutRec := nil;
  e2.OutRec := nil;
end;
//------------------------------------------------------------------------------

function TClipper.AddOutPt(e: PActive; const pt: TPoint64): TOutPt;
var
  opFront, opBack: TOutPt;
  toFront: Boolean;
  outrec: TOutRec;
begin
  // Outrec.OutPts: a circular doubly-linked-list of POutPt where ...
  // opFront[.Prev]* ~~~> opBack & opBack == opFront.Next
  outrec := e.OutRec;
  toFront := IsFront(e);
  opFront := outrec.Pts;
  opBack := opFront.Next;
  if toFront and PointsEqual(pt, opFront.Pt) then
    Result := opFront
  else if not toFront and PointsEqual(pt, opBack.Pt) then
    Result := opBack
  else
  begin
    Result := TOutPt.Create;
    Result.Pt := pt;
    opBack.Prev := Result;
    Result.Prev := opFront;
    Result.Next := opBack;
    opFront.Next := Result;
    if toFront then outrec.Pts := Result;
  end;
end;
//------------------------------------------------------------------------------

procedure TClipper.StartOpenPath(e: PActive; const pt: TPoint64);
var
  outRec: TOutRec;
  op: TOutPt;
begin
  outRec := TOutRec.Create;
  outRec.Idx := FOutRecList.Add(outRec);
  outRec.Owner := nil;
  outRec.State := osOpen;
  outRec.Pts := nil;
  outRec.frontE := nil;
  outRec.backE := nil;
  e.OutRec := outRec;

  op := TOutPt.Create;
  outRec.Pts := op;
  op.Pt := pt;
  op.Prev := op;
  op.Next := op;
end;
//------------------------------------------------------------------------------

procedure TClipper.UpdateEdgeIntoAEL(var e: PActive);
begin
  e.Bot := e.Top;
  e.vertTop := NextVertex(e);
  e.Top := e.vertTop.Pt;
  e.CurrX := e.Bot.X;
  SetDx(e);
  if not IsHorizontal(e) then InsertScanLine(e.Top.Y);
end;
//------------------------------------------------------------------------------

procedure TClipper.IntersectEdges(e1, e2: PActive;
  const pt: TPoint64; orientationCheckRequired: Boolean = false);
var
  e1WindCnt, e2WindCnt, e1WindCnt2, e2WindCnt2: Integer;
begin

  // MANAGE OPEN PATH INTERSECTIONS SEPARATELY ...
  if FHasOpenPaths and (IsOpen(e1) or IsOpen(e2)) then
  begin
    if (IsOpen(e1) and IsOpen(e2) ) then Exit;
    // the following line avoids duplicating a whole lot of code ...
    if IsOpen(e2) then SwapActives(e1, e2);
    case FClipType of
      ctIntersection, ctDifference:
        if IsSamePolyType(e1, e2) or (abs(e2.WindCnt) <> 1) then Exit;
      ctUnion:
        if IsHotEdge(e1) <> ((abs(e2.WindCnt) <> 1) or
          (IsHotEdge(e1) <> (e2.WindCnt2 <> 0))) then Exit; // just works!
      ctXor:
        if (abs(e2.WindCnt) <> 1) then Exit;
    end;
    // toggle contribution ...
    if IsHotEdge(e1) then
    begin
      AddOutPt(e1, pt);
      TerminateHotOpen(e1);
    end
    else StartOpenPath(e1, pt);
    Exit;
  end;

  // UPDATE WINDING COUNTS...

  if IsSamePolyType(e1, e2) then
  begin
    if FFillRule = frEvenOdd then
    begin
      e1WindCnt := e1.WindCnt;
      e1.WindCnt := e2.WindCnt;
      e2.WindCnt := e1WindCnt;
    end else
    begin
      if e1.WindCnt + e2.WindDx = 0 then
        e1.WindCnt := -e1.WindCnt else
        Inc(e1.WindCnt, e2.WindDx);
      if e2.WindCnt - e1.WindDx = 0 then
        e2.WindCnt := -e2.WindCnt else
        Dec(e2.WindCnt, e1.WindDx);
    end;
  end else
  begin
    if FFillRule <> frEvenOdd then Inc(e1.WindCnt2, e2.WindDx)
    else if e1.WindCnt2 = 0 then e1.WindCnt2 := 1
    else e1.WindCnt2 := 0;

    if FFillRule <> frEvenOdd then Dec(e2.WindCnt2, e1.WindDx)
    else if e2.WindCnt2 = 0 then e2.WindCnt2 := 1
    else e2.WindCnt2 := 0;
  end;

  case FFillRule of
    frPositive:
      begin
        e1WindCnt := e1.WindCnt;
        e2WindCnt := e2.WindCnt;
      end;
    frNegative:
      begin
        e1WindCnt := -e1.WindCnt;
        e2WindCnt := -e2.WindCnt;
      end;
    else
      begin
        e1WindCnt := abs(e1.WindCnt);
        e2WindCnt := abs(e2.WindCnt);
      end;
  end;

  if (not IsHotEdge(e1) and not (e1WindCnt in [0,1])) or
    (not IsHotEdge(e2) and not (e2WindCnt in [0,1])) then Exit;

  // NOW PROCESS THE INTERSECTION ...

  // if both edges are 'hot' ...
  if IsHotEdge(e1) and IsHotEdge(e2) then
  begin
    if not (e1WindCnt in [0,1]) or not (e2WindCnt in [0,1]) or
      (not IsSamePolyType(e1, e2) and (fClipType <> ctXor)) then
    begin
      AddLocalMaxPoly(e1, e2, pt);
    end else if IsFront(e1) or (e1.OutRec = e2.OutRec) then
    begin
      AddLocalMaxPoly(e1, e2, pt);
      AddLocalMinPoly(e1, e2, pt);
    end else
    begin
      // right & left bounds touching, NOT maxima & minima ...
      AddOutPt(e1, pt);
      AddOutPt(e2, pt);
      SwapOutRecs(e1, e2);
    end;
  end

  // if one or other edge is 'hot' ...
  else if IsHotEdge(e1) then
  begin
    AddOutPt(e1, pt);
    SwapOutRecs(e1, e2);
  end
  else if IsHotEdge(e2) then
  begin
    AddOutPt(e2, pt);
    SwapOutRecs(e1, e2);
  end

  else // neither edge is 'hot'
  begin
    case FFillRule of
      frPositive:
      begin
        e1WindCnt2 := e1.WindCnt2;
        e2WindCnt2 := e2.WindCnt2;
      end;
      frNegative:
      begin
        e1WindCnt2 := -e1.WindCnt2;
        e2WindCnt2 := -e2.WindCnt2;
      end
      else
      begin
        e1WindCnt2 := abs(e1.WindCnt2);
        e2WindCnt2 := abs(e2.WindCnt2);
      end;
    end;

    if not IsSamePolyType(e1, e2) then
    begin
      AddLocalMinPoly(e1, e2, pt, false, orientationCheckRequired);
    end
    else if (e1WindCnt = 1) and (e2WindCnt = 1) then
      case FClipType of
        ctIntersection:
          if (e1WindCnt2 > 0) and (e2WindCnt2 > 0) then
            AddLocalMinPoly(e1, e2, pt, false, orientationCheckRequired);
        ctUnion:
          if (e1WindCnt2 <= 0) and (e2WindCnt2 <= 0) then
            AddLocalMinPoly(e1, e2, pt, false, orientationCheckRequired);
        ctDifference:
          if ((GetPolyType(e1) = ptClip) and
                (e1WindCnt2 > 0) and (e2WindCnt2 > 0)) or
              ((GetPolyType(e1) = ptSubject) and
                (e1WindCnt2 <= 0) and (e2WindCnt2 <= 0)) then
                  AddLocalMinPoly(e1, e2, pt, false, orientationCheckRequired);
        ctXor:
          AddLocalMinPoly(e1, e2, pt, false, orientationCheckRequired);
      end
  end;
end;
//------------------------------------------------------------------------------

procedure TClipper.DeleteFromAEL(e: PActive);
var
  aelPrev, aelNext: PActive;
begin
  aelPrev := e.PrevInAEL;
  aelNext := e.NextInAEL;
  if not Assigned(aelPrev) and not Assigned(aelNext) and
    (e <> FActives) then Exit; // already deleted
  if Assigned(aelPrev) then aelPrev.NextInAEL := aelNext
  else FActives := aelNext;
  if Assigned(aelNext) then aelNext.PrevInAEL := aelPrev;
  Dispose(e);
end;
//------------------------------------------------------------------------------

procedure TClipper.AdjustCurrXAndCopyToSEL(topY: Int64);
var
  e: PActive;
begin
  FSel := FActives;
  e := FActives;
  while Assigned(e) do
  begin
    e.PrevInSEL := e.PrevInAEL;
    e.NextInSEL := e.NextInAEL;
    e.CurrX := TopX(e, topY);
    e := e.NextInAEL;
  end;
end;
//------------------------------------------------------------------------------

procedure TClipper.ExecuteInternal(clipType: TClipType;
  fillRule: TFillRule);
var
  Y: Int64;
  e: PActive;
begin
  if clipType = ctNone then Exit;
  FFillRule := fillRule;
  FClipType := clipType;
  Reset;
  if not PopScanLine(Y) then Exit;
  while true do
  begin
    InsertLocalMinimaIntoAEL(Y);
    while PopHorz(e) do DoHorizontal(e);
    FBotY := Y;                       // FBotY == bottom of scanbeam
    if not PopScanLine(Y) then Break; // Y new top of scanbeam
    DoIntersections(Y);
    DoTopOfScanbeam(Y);
  end;
end;
//------------------------------------------------------------------------------

function TClipper.Execute(clipType: TClipType;
  fillRule: TFillRule; out closedPaths: TArrayOfArrayOfFloatPoint): Boolean;
var
  dummy: TArrayOfArrayOfFloatPoint;
begin
  Result := true;
  closedPaths := nil;
  try try
    ExecuteInternal(clipType, fillRule);
    BuildResult(closedPaths, dummy);
  except
    Result := false;
  end;
  finally
    CleanUp;
  end;
end;
//------------------------------------------------------------------------------

function TClipper.Execute(clipType: TClipType;
  fillRule: TFillRule; out closedPaths: TArrayOfArrayOfFixedPoint): Boolean;
var
  tmp: TArrayOfArrayOfFloatPoint;
begin
  Result := Execute(clipType, fillRule, tmp);
  closedPaths := FloatToFixed(tmp);
end;
//------------------------------------------------------------------------------

function TClipper.Execute(clipType: TClipType; fillRule: TFillRule;
  out closedPaths, openPaths: TArrayOfArrayOfFloatPoint): Boolean;
begin
  Result := true;
  closedPaths := nil;
  openPaths := nil;
  try try
    ExecuteInternal(clipType, fillRule);
    BuildResult(closedPaths, openPaths);
  except
    Result := false;
  end;
  finally
    CleanUp;
  end;
end;
//------------------------------------------------------------------------------

function TClipper.Execute(clipType: TClipType; fillRule: TFillRule;
  out closedPaths, openPaths: TArrayOfArrayOfFixedPoint): Boolean;
var
  tmp, tmp2: TArrayOfArrayOfFloatPoint;
begin
  Result := Execute(clipType, fillRule, tmp, tmp2);
  closedPaths := FloatToFixed(tmp);
  openPaths := FloatToFixed(tmp2);
end;
//------------------------------------------------------------------------------

procedure TClipper.DoIntersections(const topY: Int64);
begin
  if BuildIntersectList(topY) then
  try
    ProcessIntersectList;
  finally
    DisposeIntersectNodes;
  end;
end;
//------------------------------------------------------------------------------

procedure TClipper.DisposeIntersectNodes;
var
  i: Integer;
begin
  for i := 0 to FIntersectList.Count - 1 do
    Dispose(IntersectNode[i]);
  FIntersectList.Clear;
end;
//------------------------------------------------------------------------------

procedure TClipper.AddNewIntersectNode(e1, e2: PActive; topY: Int64);
var
  pt: TPoint64;
  node: PIntersectNode;
begin
  pt := GetIntersectPoint(e1, e2);
  // Rounding errors can occasionally place the calculated intersection
  // point either below or above the scanbeam, so check and correct ...
  if (pt.Y > FBotY) then
  begin
    // E.Curr.Y is still at the bottom of scanbeam here
    pt.Y := FBotY;
    // use the more vertical of the 2 edges to derive pt.X ...
    if (abs(e1.Dx) < abs(e2.Dx)) then
      pt.X := TopX(e1, FBotY) else
      pt.X := TopX(e2, FBotY);
  end
  else if pt.Y < topY then
  begin
    // TopY = top of scanbeam
    pt.Y := topY;
    if e1.Top.Y = topY then
      pt.X := e1.Top.X
    else if e2.Top.Y = topY then
      pt.X := e2.Top.X
    else if (abs(e1.Dx) < abs(e2.Dx)) then
      pt.X := e1.CurrX
    else
      pt.X := e2.CurrX;
  end;

  new(node);
  node.Edge1 := e1;
  node.Edge2 := e2;
  node.Pt := pt;
  FIntersectList.Add(node);
end;
//------------------------------------------------------------------------------

function TClipper.BuildIntersectList(const topY: Int64): Boolean;
var
  i, lCnt, rCnt, jumpSize: Integer;
  first, second, base, prevBase, p, n, tmp: PActive;
begin
  Result := false;
  if not Assigned(FActives) or not Assigned(FActives.NextInAEL) then Exit;

  // Calculate edge positions at the top of the current scanbeam, and from this
  // we will determine the intersections required to reach these new positions.
  AdjustCurrXAndCopyToSEL(topY);
  // Track every edge intersection between the bottom and top of each scanbeam,
  // using a stable merge sort to ensure edges are adjacent when intersecting.
  // Re merge sorts see https://stackoverflow.com/a/46319131/359538
        jumpSize := 1;
        while (true) do
  begin
    first := FSel;
    prevBase := nil;
                // sort successive larger jump counts of nodes ...
                while assigned(first) do
    begin
                        if (jumpSize = 1) then
      begin
        second := first.NextInSEL;
        if not assigned(second) then
        begin
          first.Jump := nil;
          break;
        end;
        first.Jump := second.NextInSEL;
      end else
      begin
                          second := first.Jump;
        if not assigned(second) then
        begin
          first.Jump := nil;
          break;
        end;
        first.Jump := second.Jump;
      end;

      // now sort first and second groups ...
      base := first;
                        lCnt := jumpSize; rCnt := jumpSize;
                        while (lCnt > 0) and (rCnt > 0) do
                        begin
                                if (first.CurrX > second.CurrX) then
        begin
          tmp := second.PrevInSEL;

          // create intersect 'node' events for each time 'second' needs to
          // move left, ie intersecting with its prior edge ...
          for i := 1 to lCnt do
          begin
            AddNewIntersectNode(tmp, second, topY);
            tmp := tmp.PrevInSEL;
          end;

          // now move the out of place 'second' to it's new position in SEL ...
          if (first = base) then
          begin
            if assigned(prevBase) then prevBase.Jump := second;
            base := second;
            base.Jump := first.Jump;
            if (first.PrevInSEL = nil) then FSel := second;
          end;
          tmp := second.NextInSEL;

          // first remove 'second' from list ...
          p := second.PrevInSEL;
          n := second.NextInSEL;
          p.NextInSEL := n;
          if Assigned(n) then n.PrevInSEL := p;
          // and then reinsert 'second' into list just before 'first' ...
          p := first.PrevInSEL;
          if assigned(p) then p.NextInSEL := second;
          first.PrevInSEL := second;
          second.PrevInSEL := p;
          second.NextInSEL := first;

          second := tmp;
          if not assigned(second) then break;
          dec(rCnt);
        end else
        begin
          first := first.NextInSEL;
          dec(lCnt);
        end;
      end;
      first := base.Jump;
      prevBase := base;
    end;
    if FSel.Jump = nil then Break
    else jumpSize := jumpSize shl 1;
  end;
  Result := FIntersectList.Count > 0;
end;
//------------------------------------------------------------------------------

function TClipper.GetIntersectNode(index: Integer): PIntersectNode;
begin
  Result := PIntersectNode(FIntersectList[index]);
end;
//------------------------------------------------------------------------------

procedure TClipper.ProcessIntersectList;
var
  i, j, highI: Integer;
  node: PIntersectNode;
begin
  // We now have a list of intersections required so that edges will be
  // correctly positioned at the top of the scanbeam. However, it's important
  // that edge intersections are processed from the bottom up, but it's also
  // crucial that intersections only occur between adjacent edges.

  // First we do a quicksort so intersections proceed in a bottom up order ...
  FIntersectList.Sort(IntersectListSort);

  // Now as we process these intersections, we must sometimes adjust the order
  // to ensure that intersecting edges are always adjacent ...
  highI := FIntersectList.Count - 1;
  for i := 0 to highI do
  begin
    if not EdgesAdjacentInAEL(FIntersectList[i]) then
    begin
      j := i + 1;
      while not EdgesAdjacentInAEL(FIntersectList[j]) do inc(j);
      // Swap IntersectNodes ...
      node := FIntersectList[i];
      FIntersectList[i] := FIntersectList[j];
      FIntersectList[j] := node;
    end;

    with IntersectNode[i]^ do
    begin
      // Occasionally a non-minima intersection is processed before its own
      // minima. This causes problems with orientation so we need to flag it ...
      if (i < highI) and (IntersectNode[i+1].Pt.Y > Pt.Y) then
          IntersectEdges(Edge1, Edge2, Pt, true) else
          IntersectEdges(Edge1, Edge2, Pt);
      SwapPositionsInAEL(Edge1, Edge2);
    end;
  end;
end;
//------------------------------------------------------------------------------

procedure TClipper.SwapPositionsInAEL(e1, e2: PActive);
var
  prev, next: PActive;
begin
  // preconditon: e1 must be immediately to the left of e2
  next := e2.NextInAEL;
  if Assigned(next) then next.PrevInAEL := e1;
  prev := e1.PrevInAEL;
  if Assigned(prev) then prev.NextInAEL := e2;
  e2.PrevInAEL := prev;
  e2.NextInAEL := e1;
  e1.PrevInAEL := e2;
  e1.NextInAEL := next;
  if not Assigned(e2.PrevInAEL) then FActives := e2;
end;
//------------------------------------------------------------------------------

procedure TClipper.DoHorizontal(horzEdge: PActive);
var
  e, maxPair: PActive;
  horzLeft, horzRight: Int64;
  isLeftToRight: Boolean;
  pt: TPoint64;
  isMax: Boolean;

  procedure ResetHorzDirection;
  var
    e: PActive;
  begin
    if (horzEdge.Bot.X = horzEdge.Top.X) then
    begin
      // the horizontal edge is going nowhere ...
      horzLeft := horzEdge.CurrX;
      horzRight := horzEdge.CurrX;
      e := horzEdge.NextInAEL;
      while assigned(e) and (e <> maxPair) do
        e := e.NextInAEL;
      isLeftToRight := assigned(e);
    end
    else if horzEdge.CurrX < horzEdge.Top.X then
    begin
      horzLeft := horzEdge.CurrX;
      horzRight := horzEdge.Top.X;
      isLeftToRight := true;
    end else
    begin
      horzLeft := horzEdge.Top.X;
      horzRight := horzEdge.CurrX;
      isLeftToRight := false;
    end;
  end;
  //------------------------------------------------------------------------

begin
(*******************************************************************************
* Notes: Horizontal edges (HEs) at scanline intersections (ie at the top or    *
* bottom of a scanbeam) are processed as if layered. The order in which HEs    *
* are processed doesn't matter. HEs intersect with the bottom vertices of      *
* other HEs [#] and with non-horizontal edges [*]. Once these intersections    *
* are completed, intermediate HEs are 'promoted' to the next edge in their     *
* bounds, and they in turn may be intersected [%] by other HEs.                *
*                                                                              *
* eg: 3 horizontals at a scanline:  /   |                     /          /     *
*              |                   /    |    (HE3) o=========%==========o      *
*              o=======o (HE2)    /     |         /         /                  *
*         o============#=========*======*========#=========o (HE1)             *
*        /             |        /       |       /                              *
*******************************************************************************)

  // with closed paths, simplify consecutive horizontals into a 'single' edge
  if not IsOpen(horzEdge) then
  begin
    pt := horzEdge.Bot;
    while not IsMaxima(horzEdge) and
      (NextVertex(horzEdge).Pt.Y = pt.Y) do
        UpdateEdgeIntoAEL(horzEdge);
    horzEdge.Bot := pt;
    horzEdge.CurrX := pt.X;
    // update Dx in case of direction change ...
    if horzEdge.Bot.X < horzEdge.Top.X then
      horzEdge.Dx := NegInfinity else
      horzEdge.Dx := Infinity;
  end;

  maxPair := nil;
  if IsMaxima(horzEdge) and (not IsOpen(horzEdge) or
      ([vfOpenStart, vfOpenEnd] * horzEdge.vertTop.flags = [])) then
        maxPair := GetMaximaPair(horzEdge);

  ResetHorzDirection;
  if IsHotEdge(horzEdge) then
    AddOutPt(horzEdge, Point64(horzEdge.CurrX, horzEdge.Bot.Y));

  while true do // loops through consec. horizontal edges (if open)
  begin
    isMax := IsMaxima(horzEdge);
    if isLeftToRight  then
      e := horzEdge.NextInAEL else
      e := horzEdge.PrevInAEL;

    while assigned(e) do
    begin
      // Break if we've gone past the end of the horizontal ...
      if (isLeftToRight and (e.CurrX > horzRight)) or
        (not isLeftToRight and (e.CurrX < horzLeft)) then Break;
      // or if we've got to the end of an intermediate horizontal edge ...
      if (E.CurrX = horzEdge.Top.X) and not isMax and not IsHorizontal(e) then
      begin
        pt := NextVertex(horzEdge).Pt;
        if(isLeftToRight and (TopX(E, pt.Y) >= pt.X)) or
          (not isLeftToRight and (TopX(E, pt.Y) <= pt.X)) then Break;
      end;

      if (e = maxPair) then
      begin
        if IsHotEdge(horzEdge)  then
        begin
          if isLeftToRight then
            AddLocalMaxPoly(horzEdge, e, horzEdge.Top) else
            AddLocalMaxPoly(e, horzEdge, horzEdge.Top);
        end;
        DeleteFromAEL(e);
        DeleteFromAEL(horzEdge);
        Exit;
      end;

      pt := Point64(e.CurrX, horzEdge.Bot.Y);
      if (isLeftToRight) then
      begin
        IntersectEdges(horzEdge, e, pt);
        SwapPositionsInAEL(horzEdge, e);
        e := horzEdge.NextInAEL;
      end else
      begin
        IntersectEdges(e, horzEdge, pt);
        SwapPositionsInAEL(e, horzEdge);
        e := horzEdge.PrevInAEL;
      end;
    end;

    // check if we've finished with (consecutive) horizontals ...
    if isMax or (NextVertex(horzEdge).Pt.Y <> horzEdge.Top.Y) then Break;

    // still more horizontals in bound to process ...
    UpdateEdgeIntoAEL(horzEdge);
    ResetHorzDirection;

    if IsOpen(horzEdge) then
    begin
      if IsMaxima(horzEdge) then maxPair := GetMaximaPair(horzEdge);
      if IsHotEdge(horzEdge) then AddOutPt(horzEdge, horzEdge.Bot);
    end;
  end;

  if IsHotEdge(horzEdge) then
    AddOutPt(horzEdge, horzEdge.Top);

  if not IsOpen(horzEdge) then
    UpdateEdgeIntoAEL(horzEdge) // this is the end of an intermediate horiz.
  else if not IsMaxima(horzEdge) then
    UpdateEdgeIntoAEL(horzEdge)
  else if not assigned(maxPair) then // ie open at top
    DeleteFromAEL(horzEdge)
  else if IsHotEdge(horzEdge) then
      AddLocalMaxPoly(horzEdge, maxPair, horzEdge.Top)
  else
  begin
    DeleteFromAEL(maxPair); DeleteFromAEL(horzEdge);
  end;

end;
//------------------------------------------------------------------------------

procedure TClipper.DoTopOfScanbeam(Y: Int64);
var
  e: PActive;
begin
  FSel := nil; // FSel is reused to flag horizontals (see PushHorz below)
  e := FActives;
  while Assigned(e) do
  begin
    // nb: 'e' will never be horizontal here
    if (e.Top.Y = Y) then
    begin
      // the following helps to avoid micro self-intersections
      // with negligible impact on performance ...
      e.CurrX := e.Top.X;
      if assigned(e.PrevInAEL) and (e.PrevInAEL.CurrX = e.CurrX) and
        (e.PrevInAEL.Bot.Y <> Y) and  IsHotEdge(e.PrevInAEL) then
          AddOutPt(e.PrevInAEL, e.Top);
      if assigned(e.NextInAEL) and (e.NextInAEL.CurrX = e.CurrX) and
        (e.NextInAEL.Top.Y <> Y) and IsHotEdge(e.NextInAEL) then
          AddOutPt(e.NextInAEL, e.Top);

      if IsMaxima(e) then
      begin
        e := DoMaxima(e);  // TOP OF BOUND (MAXIMA)
        Continue;
      end else
      begin
        // INTERMEDIATE VERTEX ...
        UpdateEdgeIntoAEL(e);
        if IsHotEdge(e) then AddOutPt(e, e.Bot);
        if IsHorizontal(e) then
          PushHorz(e);     // horizontals are processed later
      end;
    end;
    e := e.NextInAEL;
  end;
end;
//------------------------------------------------------------------------------

function TClipper.DoMaxima(e: PActive): PActive;
var
  eNext, ePrev, eMaxPair: PActive;
begin
  ePrev := e.PrevInAEL;
  eNext := e.NextInAEL;
  Result := eNext;

  if IsOpen(e) and ([vfOpenStart, vfOpenEnd] * e.vertTop.flags <> []) then
  begin
    if IsHotEdge(e) then AddOutPt(e, e.Top);
    if not IsHorizontal(e) then
    begin
      if IsHotEdge(e) then TerminateHotOpen(e);
      DeleteFromAEL(e);
    end;
    Exit;
  end else
  begin
    eMaxPair := GetMaximaPair(e);
    if not assigned(eMaxPair) then Exit; // EMaxPair is a horizontal ...
  end;

  // only non-horizontal maxima here.
  // process any edges between maxima pair ...
  while (eNext <> eMaxPair) do
  begin
    IntersectEdges(e, eNext, e.Top);
    SwapPositionsInAEL(e, eNext);
    eNext := e.NextInAEL;
  end;

  if IsOpen(e) then
  begin
    if IsHotEdge(e) then
    begin
      if assigned(eMaxPair) then
        AddLocalMaxPoly(e, eMaxPair, e.Top) else
        AddOutPt(e, e.Top);
    end;
    if assigned(eMaxPair) then
      DeleteFromAEL(eMaxPair);
    DeleteFromAEL(e);

    if assigned(ePrev) then
      Result := ePrev.NextInAEL else
      Result := FActives;
    Exit;
  end;

  // here E.NextInAEL == ENext == EMaxPair ...
  if IsHotEdge(e) then
    AddLocalMaxPoly(e, eMaxPair, e.Top);

  DeleteFromAEL(e);
  DeleteFromAEL(eMaxPair);
  if assigned(ePrev) then
    Result := ePrev.NextInAEL else
    Result := FActives;
end;
//------------------------------------------------------------------------------

function TClipper.BuildResult(out closedPaths,
  openPaths: TArrayOfArrayOfFloatPoint): Boolean;
var
  i, j, cntClosed, cntOpen: Integer;
  outRec: TOutRec;
begin
  try
    cntClosed := 0; cntOpen := 0;
    SetLength(closedPaths, FOutRecList.Count);
    SetLength(openPaths, FOutRecList.Count);
    for i := 0 to FOutRecList.Count -1 do
    begin
      outRec := FOutRecList[i];
      if not assigned(outRec.Pts) then Continue;

      if IsOpen(outRec) then
      begin
        openPaths[cntOpen] := BuildPath(outRec.Pts);
        if length(openPaths[cntOpen]) > 1 then inc(cntOpen);
      end else
      begin
        closedPaths[cntClosed] := BuildPath(outRec.Pts);
        j := high(closedPaths[cntClosed]);
        if (j > 1) and PointsEqual(closedPaths[cntClosed][0],
          closedPaths[cntClosed][j]) then
            setlength(closedPaths[cntClosed], j);
        if j > 1 then inc(cntClosed);
      end;
    end;
    SetLength(closedPaths, cntClosed);
    SetLength(openPaths, cntOpen);
    Result := true;
  except
    Result := false;
  end;
end;
//------------------------------------------------------------------------------

function TClipper.GetBounds: TFloatRect;
var
  i: Integer;
  v, vStart: PVertex;
begin
  if FVertexList.Count = 0 then
    Result := FloatRect(0, 0, 0, 0)
  else
    with PVertex(FVertexList[0]).Pt do
      Result := FloatRect(X, Y, X, Y);
  for i := 0 to FVertexList.Count -1 do
  begin
    vStart := FVertexList[i];
    v := vStart;
    repeat
      if v.Pt.X < Result.Left then Result.Left := v.Pt.X
      else if v.Pt.X > Result.Right then Result.Right := v.Pt.X;
      if v.Pt.Y < Result.Top then Result.Top := v.Pt.Y
      else if v.Pt.Y > Result.Bottom then Result.Bottom := v.Pt.Y;
      v := v.next;
    until v = vStart;
  end;
end;

//------------------------------------------------------------------------------
//   Miscellaneous ClipperOffset support functions
//------------------------------------------------------------------------------

const
  MinFloat = -3.49E38;
  MaxFloat =  3.49E38;

procedure AppendPath(var paths: TArrayOfArrayOfFloatPoint;
  const extra: TArrayOfFloatPoint);
var
  len: Integer;
begin
  len := length(paths);
  SetLength(paths, len +1);
  paths[len] := extra;
end;
//------------------------------------------------------------------------------

procedure StripDuplicates(var path: TArrayOfFloatPoint);
var
  i, len: integer;
begin
  len := length(path);
  i := 1;
  while i < len do
  begin
    if (path[i].X = path[i-1].X)  and (path[i].Y = path[i-1].Y) then
    begin
      dec(len);
      if (i < len) then
        Move(path[i+1], path[i], (len-i)*SizeOf(TFloatPoint));
      SetLength(path, len);
    end else
      inc(i);
  end;
end;
//------------------------------------------------------------------------------

function ReversePath(const path: TArrayOfFloatPoint): TArrayOfFloatPoint;
var
  i, highI: Integer;
begin
  highI := high(path);
  SetLength(Result, highI +1);
  for i := 0 to highI do
    Result[i] := path[highI - i];
end;
//------------------------------------------------------------------------------

function DistanceSqr(const pt1, pt2: TFloatPoint): TFloat;
begin
  Result := (pt1.X - pt2.X)*(pt1.X - pt2.X) + (pt1.Y - pt2.Y)*(pt1.Y - pt2.Y);
end;
//------------------------------------------------------------------------------

function GetUnitNormal(const pt1, pt2: TFloatPoint): TFloatPoint;
var
  dx, dy, inverseHypot: Double;
begin
  if PointsEqual(pt1, pt2) then
  begin
    Result.X := 0;
    Result.Y := 0;
    Exit;
  end;
  dx := (pt2.X - pt1.X);
  dy := (pt2.Y - pt1.Y);
  inverseHypot := 1 / Hypot(dx, dy);
  dx := dx * inverseHypot;
  dy := dy * inverseHypot;
  Result.X := dy;
  Result.Y := -dx
end;

//------------------------------------------------------------------------------
//  TClipperOffset methods
//------------------------------------------------------------------------------

constructor TClipperOffset.Create(MiterLimit: Double; ArcTolerance: Double);
begin
  inherited Create;
  if MiterLimit = 0 then MiterLimit := 2;
  FMiterLimit := MiterLimit;
  FArcTolerance := ArcTolerance;
end;
//------------------------------------------------------------------------------

destructor TClipperOffset.Destroy;
begin
  Clear;
  inherited;
end;
//------------------------------------------------------------------------------

procedure TClipperOffset.Clear;
begin
  FPathsIn := nil;
  FNorms := nil;
  FSolution := nil;
end;
//------------------------------------------------------------------------------

procedure TClipperOffset.AddPath(const path: TArrayOfFloatPoint);
begin
  if assigned(path) then
    AppendPath(FPathsIn, path);
end;
//------------------------------------------------------------------------------

procedure TClipperOffset.AddPaths(const paths: TArrayOfArrayOfFloatPoint);
var
  i: Integer;
begin
  for i := 0 to High(paths) do
    AddPath(paths[i]);
end;
//------------------------------------------------------------------------------

function TClipperOffset.GetLowestPolygonIdx: integer;
var
  i,j, len: Integer;
  pt: TFloatPoint;
  p: TArrayOfFloatPoint;
begin
  result := -1;
  pt := FloatPoint(MaxFloat, MinFloat);
  for i := 0 to high(FPathsIn) do
  begin
    if FPathsIn[i] = nil then
      Continue;
    p := FPathsIn[i];
    len := length(p);
    for j := 0 to len -1 do
    begin
      if (p[j].Y < pt.Y) then
        continue;
      if (p[j].Y > pt.Y) or (p[j].X < pt.X) then
      begin
        pt := p[j];
        result := i;
      end;
    end;
  end;
end;
//------------------------------------------------------------------------------

function TClipperOffset.CheckPaths: boolean;
var
  i,len, minLen: Integer;
  openPaths: Boolean;
begin
  Result := False;
  openPaths := not (FEndType in [etPolygon, etOpenJoined]);
  if openPaths then minLen := 1 else minLen := 3;
  for i := 0 to high(FPathsIn) do
  begin
    StripDuplicates(FPathsIn[i]);
    len := length(FPathsIn[i]);
    if not openPaths and (len > 1) and
      PointsEqual(FPathsIn[i][0], FPathsIn[i][len-1]) then
    begin
      setlength(FPathsIn[i], len -1);
      dec(len);
    end;
    if len < minLen then
      FPathsIn[i] := nil
    else
      Result := True;
  end;
end;
//------------------------------------------------------------------------------

procedure TClipperOffset.OffsetPaths;
var
  i, len: Integer;
  arcTol, absDelta, steps: Double;
  tmpEndType: TEndType;
begin
  absDelta := Abs(FDelta);
  len := length(FPathsIn);

  // if a Zero offset, then simply copy paths to FSolution and return ...
  if absDelta < Tolerance then
  begin
    FSolutionLen := 0;
    SetLength(FSolution, len);
    for i := 0 to high(FPathsIn) do
      if assigned(FPathsIn[i]) then
      begin
        FSolution[FSolutionLen] := FPathsIn[i];
        inc(FSolutionLen);
      end;
    SetLength(FSolution, FSolutionLen);
    Exit;
  end;

  // FMiterLimit: see offset_triginometry3.svg
  if FMiterLimit > 1 then FMiterLim := 2/(sqr(FMiterLimit))
  else FMiterLim := 2;

  if (FArcTolerance <= DefaultArcFrac) then
    arcTol := DefaultArcFrac else
    arcTol := FArcTolerance;

  if (FJoinType in [jtRound, jtRoundEx]) or (FEndType = etOpenRound) then
  begin
    // get steps per 360 degrees (see offset_triginometry2.svg)
    steps := PI / ArcCos(1 - arcTol / absDelta);

    // avoid excessive precision ...
    if (steps > absDelta * Pi) then steps := absDelta * Pi;
    FStepsPerRad := steps / Two_Pi;
    Math.SinCos(Two_Pi / steps, FStepSizeSin, FStepSizeCos);
    if FDelta < 0 then FStepSizeSin := -FStepSizeSin;
  end;

  if (FEndType = etOpenJoined) then
    SetLength(FSolution, len *2) else
    SetLength(FSolution, len);

  FSolutionLen := 0;
  for i := 0 to len -1 do
  begin
    FPathIn := FPathsIn[i];
    if FPathIn = nil then Continue;

    FPathOutLen := 0;
    FPathOut := nil;

    if Length(FPathIn) = 1 then
    begin
      // a simple workaround using OffsetOpenPath to construct
      // either a circle or a square point offset ...
      tmpEndType := FEndType;
      if FEndType = etOpenButt then FEndType := etOpenSquare;
      SetLength(FPathIn, 2);
      FPathIn[1] := FPathIn[0];
      SetLength(FNorms, 2);
      FNorms[0] := FloatPoint(1,0);
      OffsetOpenPath;
      FEndType := tmpEndType;
    end else
    begin
      BuildNormals;
      if FEndType = etPolygon then
        OffsetPolygon
      else if FEndType = etOpenJoined then
        OffsetOpenJoined
      else
        OffsetOpenPath;
    end;

    if FPathOutLen = 0 then Continue;

    SetLength(FPathOut, FPathOutLen);
    FSolution[FSolutionLen] := FPathOut;
    Inc(FSolutionLen);
  end;
  SetLength(FSolution, FSolutionLen);
end;
//------------------------------------------------------------------------------

procedure TClipperOffset.BuildNormals;
var
  i, len: integer;
begin
  len := Length(FPathIn);
  SetLength(FNorms, len);
  for i := 0 to len-2 do
    FNorms[i] := GetUnitNormal(FPathIn[i], FPathIn[i+1]);
  FNorms[len -1] := GetUnitNormal(FPathIn[len -1], FPathIn[0]);
end;
//------------------------------------------------------------------------------

procedure TClipperOffset.ReverseNormals;
var
  i, highI: integer;
  tmp: TFloatPoint;
begin
  FNorms := ReversePath(FNorms);
  highI := high(FNorms);
  tmp := FNorms[0];
  for i := 1 to highI  do
  begin
    FNorms[i-1].X := -FNorms[i].X;
    FNorms[i-1].Y := -FNorms[i].Y;
  end;
  FNorms[highI].X := -tmp.X;
  FNorms[highI].Y := -tmp.Y;
end;
//------------------------------------------------------------------------------

procedure TClipperOffset.OffsetPolygon;
var
  i,j: integer;
begin
  j := high(FPathIn);
  for i := 0 to high(FPathIn) do
  begin
    OffsetPoint(i, j);
    j := i;
  end;
end;
//------------------------------------------------------------------------------

procedure TClipperOffset.OffsetOpenJoined;
begin
  OffsetPolygon;
  FPathIn := ReversePath(FPathIn);

  SetLength(FPathOut, FPathOutLen);
  FSolution[FSolutionLen] := FPathOut;
  Inc(FSolutionLen);
  FPathOutLen := 0;
  FPathOut := nil;

  ReverseNormals;
  OffsetPolygon;
end;
//------------------------------------------------------------------------------

procedure TClipperOffset.OffsetOpenPath;

  procedure DoButtCap(highI: integer);
  begin
    AddPoint(FloatPoint(FPathIn[highI].X + FNorms[highI-1].X *FDelta,
      FPathIn[highI].Y + FNorms[highI-1].Y * FDelta));
    AddPoint(FloatPoint(FPathIn[highI].X - FNorms[highI-1].X *FDelta,
      FPathIn[highI].Y - FNorms[highI-1].Y * FDelta));
  end;

  procedure DoSquareCap(highI: integer; toStart: Boolean);
  var
    pt: TFloatPoint;
  const
    sc: array[boolean] of integer = (1, -1);
  begin
    pt := FloatPoint(FPathIn[highI].X + FNorms[highI-1].X *FDelta,
      FPathIn[highI].Y + FNorms[highI-1].Y * FDelta);
    AddPoint(pt);
    AddPoint(FloatPoint(pt.X - FNorms[highI-1].Y *FDelta,
      pt.Y - FNorms[highI-1].X * FDelta * sc[true]));
    pt := FloatPoint(FPathIn[highI].X - FNorms[highI-1].X *FDelta,
      FPathIn[highI].Y - FNorms[highI-1].Y * FDelta);
    AddPoint(FloatPoint(pt.X - FNorms[highI-1].Y *FDelta,
      pt.Y - FNorms[highI-1].X * FDelta * sc[true]));
    AddPoint(pt);
  end;

  procedure DoRoundCap(highI: integer); // 180 degrees
  var
    i: integer;
    steps: Integer;
    pt: TFloatPoint;
  begin
    steps := Round(FStepsPerRad * PI);
    pt.X := FNorms[highI-1].X * FDelta;
    pt.Y := FNorms[highI-1].Y * FDelta;
    for i := 1 to steps do
    begin
      AddPoint(FloatPoint(FPathIn[highI].X + pt.X, FPathIn[highI].Y + pt.Y));
      pt := FloatPoint(pt.X * FStepSizeCos - FStepSizeSin * pt.Y,
        pt.X * FStepSizeSin + pt.Y * FStepSizeCos);
    end;
  end;

var
  i,j, highI: integer;
begin
  highI := high(FPathIn);
  j := 0;
  for i := 1 to highI -1 do
  begin
    OffsetPoint(i, j);
    j := i;
  end;

  // cap the end first ...
  case FEndType of
    etOpenButt: DoButtCap(highI);
    etOpenRound: DoRoundCap(highI);
    else DoSquareCap(highI, false);
  end;

  FPathIn := ReversePath(FPathIn);
  ReverseNormals;
  j := 0;
  for i := 0 to highI -1 do
  begin
    OffsetPoint(i, j);
    j := i;
  end;

  // now cap the start ...
  case FEndType of
    etOpenButt: DoButtCap(highI);
    etOpenRound: DoRoundCap(highI);
    else DoSquareCap(highI, true);
  end;
end;
//------------------------------------------------------------------------------

procedure TClipperOffset.Execute(delta: Double; jt: TJoinType; et: TEndType;
      out solution: TArrayOfArrayOfFloatPoint);
var
  negate: Boolean;
  lowestIdx: integer;
begin
  solution := nil;
  if length(FPathsIn) = 0 then Exit;
  FJoinType := jt;
  FEndType := et;

  if (not CheckPaths) then
    exit;

  negate := false;
  if (et = etPolygon) then
  begin
    // the lowermost polygon must be an outer polygon. So we can use that as the
    // designated orientation for outer polygons (needed for tidy-up clipping)
    lowestIdx := GetLowestPolygonIdx;
    negate := (Area(FPathsIn[lowestIdx]) < 0);
    // if polygon orientations are reversed, then 'negate' ...
    // if negate then FDelta := FDelta;
  end;

  if FEndType <> etPolygon then
    FDelta := Abs(delta) else
    FDelta := delta;
  OffsetPaths;

//  solution := FSolution;

  // clean up self-intersections ...
  with TClipper.Create do
  try
    AddPaths(FSolution, ptSubject);
    if negate then
      Execute(ctUnion, frNegative, solution) else
      Execute(ctUnion, frPositive, solution);
  finally
    free;
  end;
end;
//------------------------------------------------------------------------------

procedure TClipperOffset.AddPoint(const pt: TFloatPoint);
const
  BuffLength = 32;
begin
  if FPathOutLen = length(FPathOut) then
    SetLength(FPathOut, FPathOutLen + BuffLength);
  if (FPathOutLen > 0) and PointsEqual(FPathOut[FPathOutLen-1], pt) then Exit;
  FPathOut[FPathOutLen] := pt;
  Inc(FPathOutLen);
end;
//------------------------------------------------------------------------------

procedure TClipperOffset.DoSquare(j, k: Integer);
begin
  // Two vertices, one using the prior offset's (k) normal one the current (j).
  // Do a 'normal' offset (by delta) and then another by 'de-normaling' the
  // normal hence parallel to the direction of the respective edges.
  if FDelta > 0 then
  begin
    AddPoint(FloatPoint(
      FPathIn[j].X + FDelta * (FNorms[k].X - FNorms[k].Y),
      FPathIn[j].Y + FDelta * (FNorms[k].Y + FNorms[k].X)));
    AddPoint(FloatPoint(
      FPathIn[j].X + FDelta * (FNorms[j].X + FNorms[j].Y),
      FPathIn[j].Y + FDelta * (FNorms[j].Y - FNorms[j].X)));
  end else
  begin
    AddPoint(FloatPoint(
      FPathIn[j].X + FDelta * (FNorms[k].X + FNorms[k].Y),
      FPathIn[j].Y + FDelta * (FNorms[k].Y - FNorms[k].X)));
    AddPoint(FloatPoint(
      FPathIn[j].X + FDelta * (FNorms[j].X - FNorms[j].Y),
      FPathIn[j].Y + FDelta * (FNorms[j].Y + FNorms[j].X)));
  end;
end;
//------------------------------------------------------------------------------

procedure TClipperOffset.DoMiter(j, k: Integer; cosAplus1: Double);
var
  q: Double;
begin
  // see offset_triginometry4.svg
  q := FDelta / cosAplus1; // 0 < cosAplus1 <= 2
  AddPoint(FloatPoint(FPathIn[j].X + (FNorms[k].X + FNorms[j].X)*q,
    FPathIn[j].Y + (FNorms[k].Y + FNorms[j].Y)*q));
end;
//------------------------------------------------------------------------------

procedure TClipperOffset.DoRound(j, k: Integer);
var
  i, m,n, steps: Integer;
  a, delta, sinA, cosA: Double;
  pt, pt2, pt3: TFloatPoint;
begin
  sinA := FNorms[k].X * FNorms[j].Y - FNorms[k].Y * FNorms[j].X;
  cosA := FNorms[j].X * FNorms[k].X + FNorms[j].Y * FNorms[k].Y;
  a := ArcTan2(sinA, cosA);
  steps := Round(FStepsPerRad * Abs(a));

  if (FDelta * sinA < 0) then // ie concave
  begin
    a := FDelta / (cosA +1);
    if (j = 0) then m := high(FPathIn) else m := j -1;
    if j = high(FPathIn) then n := 0 else n := j +1;

    // offset pt of concave vertex ...
    pt.X := round(FPathIn[j].X + (FNorms[k].X + FNorms[j].X)*a);
    pt.Y := round(FPathIn[j].Y + (FNorms[k].Y + FNorms[j].Y)*a);

    a := Min(DistanceSqr(FPathIn[m], FPathIn[j]),
      DistanceSqr(FPathIn[n], FPathIn[j]));

    // there's no space to draw anything ...
    if DistanceSqr(pt, FPathIn[j]) > a then
    begin
      // get the perpendicular offsets from pt2 ...
      // this creates a self-intersection that'll be clipped later
      pt2.X := round(FPathIn[j].X + FNorms[k].X * FDelta);
      pt2.Y := round(FPathIn[j].Y + FNorms[k].Y * FDelta);
      pt3.X := round(FPathIn[j].X + FNorms[j].X * FDelta);
      pt3.Y := round(FPathIn[j].Y + FNorms[j].Y * FDelta);
      AddPoint(pt2);
      AddPoint(pt3);
      Exit;
    end;

    a := Sqrt(a);
    // get the point on each edge being the distance of the shortest edge
    // from the concave vertex. (nb: unit normals to unit vectors here)
    pt2.X := round(FPathIn[j].X + FNorms[k].Y * a);
    pt2.Y := round(FPathIn[j].Y - FNorms[k].X * a);
    pt3.X := round(FPathIn[j].X - FNorms[j].Y * a);
    pt3.Y := round(FPathIn[j].Y + FNorms[j].X * a);

    // now FDelta offset these points ...
    pt2.X := round(pt2.X + FNorms[k].X * FDelta);
    pt2.Y := round(pt2.Y + FNorms[k].Y * FDelta);
    pt3.X := round(pt3.X + FNorms[j].X * FDelta);
    pt3.Y := round(pt3.Y + FNorms[j].Y * FDelta);

    if DistanceSqr(pt2, pt3) < Sqr(FDelta *2/MiterLimit) then
      delta := Sqrt(DistanceSqr(pt2, pt3))/2 else
      delta := FDelta/MiterLimit;

    a := (delta + FDelta) / (cosA +1);
    pt.X := round(FPathIn[j].X + (FNorms[k].X + FNorms[j].X)*a);
    pt.Y := round(FPathIn[j].Y + (FNorms[k].Y + FNorms[j].Y)*a);

    pt2.X := -FNorms[k].X * delta;
    pt2.Y := -FNorms[k].Y * delta;
    AddPoint(FloatPoint(pt.X + pt2.X, pt.Y + pt2.Y));
    for i := 1 to steps -1 do
    begin
      pt2 := FloatPoint(pt2.X * FStepSizeCos + FStepSizeSin * pt2.Y,
        -pt2.X * FStepSizeSin + pt2.Y * FStepSizeCos);
      AddPoint(FloatPoint(pt.X + pt2.X, pt.Y + pt2.Y));
    end;
  end else
  begin
    // a convex vertex ...
    pt := FPathIn[j];
    pt2.X := FNorms[k].X * FDelta;
    pt2.Y := FNorms[k].Y * FDelta;
    AddPoint(FloatPoint(pt.X + pt2.X, pt.Y + pt2.Y));
    for i := 1 to steps -1 do
    begin
      pt2 := FloatPoint(pt2.X * FStepSizeCos - FStepSizeSin * pt2.Y,
        pt2.X * FStepSizeSin + pt2.Y * FStepSizeCos);
      AddPoint(FloatPoint(pt.X + pt2.X, pt.Y + pt2.Y));
    end;
  end;
end;
//------------------------------------------------------------------------------

procedure TClipperOffset.OffsetPoint(j,k: Integer);
var
  sinA, cosA: Double;
begin
  // A: angle between adjoining edges (on left side WRT winding direction).
  // A == 0 deg (or A == 360 deg): collinear edges heading in same direction
  // A == 180 deg: collinear edges heading in opposite directions (ie a 'spike')
  // sin(A) < 0: convex on left.
  // cos(A) > 0: angles on both left and right sides > 90 degrees
  sinA := (FNorms[k].X * FNorms[j].Y - FNorms[j].X * FNorms[k].Y);
  cosA := (FNorms[j].X * FNorms[k].X + FNorms[j].Y * FNorms[k].Y);

  if (Abs(sinA * FDelta) < 1.0) then // angle is close to 0 or 180 deg.
  begin
    if (cosA > 0) then // given condition above the angle is approaching 0 deg.
    begin
      if FJoinType = jtRoundEx then
        DoRound(j, k)
      else
      // with angles approaching 0 deg collinear (whether concave or convex),
      // offsetting with two or more vertices (that would be so close together)
      // occasionally causes tiny self-intersections due to rounding.
      // So we offset with just a single vertex here ...
      AddPoint(FloatPoint(FPathIn[j].X + FNorms[k].X * FDelta,
        FPathIn[j].Y + FNorms[k].Y * FDelta));
      Exit;
    end;
    // else angle must be approaching 180 deg.
  end
  else if (sinA > 1.0) then sinA := 1.0
  else if (sinA < -1.0) then sinA := -1.0;

  if (FJoinType = jtRoundEx) then
  begin
    DoRound(j, k)
  end
  else if sinA * FDelta < 0 then // ie a concave offset
  begin
    AddPoint(FloatPoint(FPathIn[j].X + FNorms[k].X * FDelta,
      FPathIn[j].Y + FNorms[k].Y * FDelta));
    AddPoint(FPathIn[j]); // this improves clipping removal later
    AddPoint(FloatPoint(FPathIn[j].X + FNorms[j].X * FDelta,
      FPathIn[j].Y + FNorms[j].Y * FDelta));
  end
  else
  begin
    // convex offsets here ...
    case FJoinType of
      jtMiter:
        // see offset_triginometry3.svg
        if (1 + cosA < FMiterLim) then DoSquare(j, k)
        else DoMiter(j, k, 1 + cosA);
      jtSquare:
        // angles >= 90 deg. don't need squaring
        if cosA >= 0 then
          DoMiter(j, k, 1 + cosA) else
          DoSquare(j, k);

      else DoRound(j, k);
    end;
  end;
end;

//------------------------------------------------------------------------------
//------------------------------------------------------------------------------

function InflatePaths(const paths: TArrayOfArrayOfFloatPoint;
  delta: Double; jt: TJoinType; et: TEndType;
  miterLimit: single): TArrayOfArrayOfFloatPoint;
begin
  with TClipperOffset.Create(miterLimit) do
  try
    AddPaths(paths);
    Execute(delta, jt, et, Result);
  finally
    free;
  end;
end;
//------------------------------------------------------------------------------

end.