GLScene/Externals/Graphics32/Source/Clipper.Offset.pas

unit Clipper.Offset;

(*******************************************************************************
* Author    :  Angus Johnson                                                   *
* Date      :  6 July 2024                                                     *
* Website   :  http://www.angusj.com                                           *
* Copyright :  Angus Johnson 2010-2024                                         *
* Purpose   :  Path Offset (Inflate/Shrink)                                    *
* License   :  http://www.boost.org/LICENSE_1_0.txt                            *
*******************************************************************************)

{$I Clipper.inc}

interface

uses
  Classes, Clipper.Core, Clipper.Engine;

type

  TJoinType = (jtMiter, jtSquare, jtBevel, jtRound);
  //jtSquare: Joins are 'squared' at exactly the offset distance (complex code)
  //jtBevel : offset distances vary depending on the angle (simple code, faster)

  TEndType = (etPolygon, etJoined, etButt, etSquare, etRound);
  // etButt   : offsets both sides of a path, with square blunt ends
  // etSquare : offsets both sides of a path, with square extended ends
  // etRound  : offsets both sides of a path, with round extended ends
  // etJoined : offsets both sides of a path, with joined ends
  // etPolygon: offsets only one side of a closed path

  TDeltaCallback64 = function (const path: TPath64;
    const path_norms: TPathD; currIdx, prevIdx: integer): double of object;

  TDoubleArray = array of double;
  BooleanArray = array of Boolean;

  TGroup = class
	  paths         : TPaths64;
	  joinType      : TJoinType;
	  endType       : TEndType;
    reversed      : Boolean;
    lowestPathIdx : integer;
    constructor Create(const pathsIn: TPaths64; jt: TJoinType; et: TEndType);
  end;

  TClipperOffset = class
  private
    fDelta        : Double;
    fGroupDelta   : Double; //*0.5 for open paths; *-1.0 for neg areas
    fMinLenSqrd   : double;
    fJoinType     : TJoinType;
    fEndType      : TEndType;
    fTmpLimit     : Double;
    fMiterLimit   : Double;
    fArcTolerance : Double;
    fStepsPerRad  : Double;
    fStepSin      : Double;
    fStepCos      : Double;
    fNorms        : TPathD;
    fGroupList    : TListEx;
    fInPath       : TPath64;
    fOutPath      : TPath64;
    fOutPathLen   : Integer;
    fSolution     : TPaths64;
    fSolutionLen  : Integer;
    fSolutionTree : TPolyTree64;
    fPreserveCollinear  : Boolean;
    fReverseSolution    : Boolean;
    fDeltaCallback64    : TDeltaCallback64;
{$IFDEF USINGZ}
    fZCallback64 : TZCallback64;
    procedure ZCB(const bot1, top1, bot2, top2: TPoint64;
      var intersectPt: TPoint64);
    procedure AddPoint(x,y: double; z: Int64); overload;
    procedure AddPoint(const pt: TPoint64); overload;
      {$IFDEF INLINING} inline; {$ENDIF}
    procedure AddPoint(const pt: TPoint64; newZ: Int64); overload;
      {$IFDEF INLINING} inline; {$ENDIF}
{$ELSE}
    procedure AddPoint(x,y: double); overload;
    procedure AddPoint(const pt: TPoint64); overload;
      {$IFDEF INLINING} inline; {$ENDIF}
{$ENDIF}
    procedure DoSquare(j, k: Integer);
    procedure DoBevel(j, k: Integer);
    procedure DoMiter(j, k: Integer; cosA: Double);
    procedure DoRound(j, k: integer; angle: double);
    procedure OffsetPoint(j: Integer; var k: integer);

    procedure BuildNormals;
    procedure DoGroupOffset(group: TGroup);
    procedure OffsetPolygon;
    procedure OffsetOpenJoined;
    procedure OffsetOpenPath;
    function CalcSolutionCapacity: integer;
    procedure UpdateSolution; {$IFDEF INLINING} inline; {$ENDIF}

    function CheckReverseOrientation: Boolean;
    procedure ExecuteInternal(delta: Double);
  public
    constructor Create(miterLimit: double = 2.0;
      arcTolerance: double = 0.0;
      PreserveCollinear: Boolean = False;
      ReverseSolution: Boolean = False);
    destructor Destroy; override;
    procedure AddPath(const path: TPath64;
      joinType: TJoinType; endType: TEndType);
    procedure AddPaths(const paths: TPaths64;
      joinType: TJoinType; endType: TEndType);
    procedure Clear;
    procedure Execute(delta: Double; out solution: TPaths64); overload;
    procedure Execute(delta: Double; polytree: TPolyTree64); overload;
    procedure Execute(DeltaCallback: TDeltaCallback64; out solution: TPaths64); overload;

    // MiterLimit: needed for mitered offsets (see offset_triginometry3.svg)
    property MiterLimit: Double read fMiterLimit write fMiterLimit;
    // ArcTolerance: needed for rounded offsets (See offset_triginometry2.svg)
    property ArcTolerance: Double read fArcTolerance write fArcTolerance;
    property PreserveCollinear: Boolean
      read fPreserveCollinear write fPreserveCollinear;
    property ReverseSolution: Boolean
      read fReverseSolution write fReverseSolution;
    property DeltaCallback: TDeltaCallback64 read
      fDeltaCallback64 write fDeltaCallback64;
{$IFDEF USINGZ}
    property ZCallback: TZCallback64 read fZCallback64 write fZCallback64;
{$ENDIF}
  end;

implementation

uses
  Math;

resourcestring
  rsClipper_CoordRangeError =
    'Offsetting will exceed the valid coordinate range';

const
  TwoPi     : Double = 2 * PI;
  InvTwoPi  : Double = 1/(2 * PI);

//------------------------------------------------------------------------------
//  Miscellaneous offset support functions
//------------------------------------------------------------------------------

function DotProduct(const vec1, vec2: TPointD): double;
  {$IFDEF INLINING} inline; {$ENDIF}
begin
  result := vec1.X * vec2.X + vec1.Y * vec2.Y;
end;
//------------------------------------------------------------------------------

function ValueAlmostZero(val: double; epsilon: double = 0.001): Boolean;
  {$IFDEF INLINE} inline; {$ENDIF}
begin
  Result := Abs(val) < epsilon;
end;
//------------------------------------------------------------------------------

function NormalizeVector(const vec: TPointD): TPointD;
  {$IFDEF INLINE} inline; {$ENDIF}
var
  h, inverseHypot: Double;
begin
  h := Hypot(vec.X, vec.Y);
  if ValueAlmostZero(h) then
  begin
    Result := NullPointD;
    Exit;
  end;
  inverseHypot := 1 / h;
  Result.X := vec.X * inverseHypot;
  Result.Y := vec.Y * inverseHypot;
end;
//------------------------------------------------------------------------------

function GetAvgUnitVector(const vec1, vec2: TPointD): TPointD;
begin
  Result := NormalizeVector(PointD(vec1.X + vec2.X, vec1.Y + vec2.Y));
end;
//------------------------------------------------------------------------------

function GetUnitNormal(const pt1, pt2: TPoint64): TPointD;
var
  dx, dy, inverseHypot: Double;
begin
  dx := (pt2.X - pt1.X);
  dy := (pt2.Y - pt1.Y);
  if (dx = 0) and (dy = 0) then
  begin
    Result.X := 0;
    Result.Y := 0;
  end else
  begin
    inverseHypot := 1 / Hypot(dx, dy);
    Result.X := dy * inverseHypot;
    Result.Y := -dx * inverseHypot; //ie left side of vector
  end;
end;
//------------------------------------------------------------------------------

function GetLowestPolygonIdx(const paths: TPaths64): integer;
var
  i,j: integer;
  botPt: TPoint64;
begin
	Result := -1;
  botPt := Point64(MaxInt64, MinInt64);
  for i := 0 to High(paths) do
  begin
    for j := 0 to High(paths[i]) do
      with paths[i][j] do
      begin
        if (Y < botPt.Y) or
          ((Y = botPt.Y) and (X >= botPt.X)) then Continue;
        result := i;
        botPt.X := X;
        botPt.Y := Y;
      end;
  end;
end;
//------------------------------------------------------------------------------

function UnsafeGet(List: TList; Index: Integer): Pointer;
  {$IFDEF INLINING} inline; {$ENDIF}
begin
  Result := List.List[Index];
end;

//------------------------------------------------------------------------------
// TGroup methods
//------------------------------------------------------------------------------

constructor TGroup.Create(const pathsIn: TPaths64; jt: TJoinType; et: TEndType);
var
  i, len: integer;
  isJoined: boolean;
begin
  Self.joinType := jt;
  Self.endType := et;

  isJoined := et in [etPolygon, etJoined];
  len := Length(pathsIn);
  SetLength(paths, len);
  for i := 0 to len -1 do
    paths[i] := StripDuplicates(pathsIn[i], isJoined);

  reversed := false;
  if (et = etPolygon) then
  begin
    // the lowermost path must be an outer path, so if its orientation is
    // negative, then flag that the whole group is 'reversed' (so negate
    // delta etc.) as this is much more efficient than reversing every path.
	  lowestPathIdx := GetLowestPolygonIdx(pathsIn);
    reversed := (lowestPathIdx >= 0) and (Area(pathsIn[lowestPathIdx]) < 0);
  end else
    lowestPathIdx := -1;
end;

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

constructor TClipperOffset.Create(miterLimit: double;
  arcTolerance: double; PreserveCollinear: Boolean;
  ReverseSolution: Boolean);
begin
  fMiterLimit   := MiterLimit;
  fArcTolerance := ArcTolerance;
  fGroupList    := TListEx.Create;
  fPreserveCollinear := preserveCollinear;
  fReverseSolution := ReverseSolution;
end;
//------------------------------------------------------------------------------

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

procedure TClipperOffset.Clear;
var
  i: integer;
begin
  for i := 0 to fGroupList.Count -1 do
    TGroup(fGroupList[i]).Free;
  fGroupList.Clear;
  fSolution := nil;
  fSolutionLen := 0;
end;
//------------------------------------------------------------------------------

procedure TClipperOffset.AddPath(const path: TPath64;
  joinType: TJoinType; endType: TEndType);
var
  paths: TPaths64;
begin
  if not assigned(path) then Exit;
  SetLength(paths, 1);
  paths[0] := path;
  AddPaths(Paths, joinType, endType);
end;
//------------------------------------------------------------------------------

procedure TClipperOffset.AddPaths(const paths: TPaths64;
  joinType: TJoinType; endType: TEndType);
var
  group: TGroup;
begin
  if Length(paths) = 0 then Exit;
  group := TGroup.Create(paths, joinType, endType);
  fGroupList.Add(group);
end;
//------------------------------------------------------------------------------

function GetPerpendic(const pt: TPoint64; const norm: TPointD; delta: double): TPoint64; overload;
  {$IFDEF INLINING} inline; {$ENDIF}
begin
  result := Point64(pt.X + norm.X * delta, pt.Y + norm.Y * delta);
{$IFDEF USINGZ}
  result.Z := pt.Z;
{$ENDIF}
end;
//------------------------------------------------------------------------------

function GetPerpendicD(const pt: TPoint64; const norm: TPointD; delta: double): TPointD; overload;
  {$IFDEF INLINING} inline; {$ENDIF}
begin
  result := PointD(pt.X + norm.X * delta, pt.Y + norm.Y * delta);
{$IFDEF USINGZ}
  result.Z := pt.Z;
{$ENDIF}
end;
//------------------------------------------------------------------------------

procedure TClipperOffset.DoGroupOffset(group: TGroup);
var
  i,j, len, steps: Integer;
  r, stepsPer360, arcTol: Double;
  absDelta: double;
  rec: TRect64;
  pt0: TPoint64;
begin

  if group.endType = etPolygon then
  begin
    if (group.lowestPathIdx < 0) then fDelta := Abs(fDelta);
    fGroupDelta := Iif(group.reversed, -fDelta, fDelta);
  end
  else
    fGroupDelta := Abs(fDelta);

  absDelta := Abs(fGroupDelta);

  fJoinType := group.joinType;
  fEndType := group.endType;

  if (group.joinType = jtRound) or (group.endType = etRound) then
  begin
		// calculate the number of steps required to approximate a circle
    // (see http://www.angusj.com/clipper2/Docs/Trigonometry.htm)
		// arcTol - when arc_tolerance_ is undefined (0) then curve imprecision
    // will be relative to the size of the offset (delta). Obviously very
    //large offsets will almost always require much less precision.
    arcTol := Iif(fArcTolerance > 0.01,
      Min(absDelta, fArcTolerance),
      Log10(2 + absDelta) * 0.25); // empirically derived

    stepsPer360 := Pi / ArcCos(1 - arcTol / absDelta);
		if (stepsPer360 > absDelta * Pi) then
			stepsPer360 := absDelta * Pi;  // avoid excessive precision
    fStepSin := sin(TwoPi/stepsPer360);
    fStepCos := cos(TwoPi/stepsPer360);
		if (fGroupDelta < 0.0) then fStepSin := -fStepSin;
    fStepsPerRad := stepsPer360 / TwoPi;
  end;

  for i := 0 to High(group.paths) do
  begin
    fInPath := group.paths[i];
    fNorms := nil;
    len := Length(fInPath);

		//if a single vertex then build a circle or a square ...
    if len = 1 then
    begin
      if fGroupDelta < 1 then Continue;
      pt0 := fInPath[0];

      if Assigned(fDeltaCallback64) then
      begin
        fGroupDelta := fDeltaCallback64(fInPath, fNorms, 0, 0);
        if TGroup(fGroupList[0]).reversed then fGroupDelta := -fGroupDelta;
        absDelta := Abs(fGroupDelta);
      end;

      if (group.endType = etRound) then
      begin
        r := absDelta;
        steps := Ceil(fStepsPerRad * TwoPi); //#617
        fOutPath := Path64(Ellipse(
          RectD(pt0.X-r, pt0.Y-r, pt0.X+r, pt0.Y+r), steps));
{$IFDEF USINGZ}
        for j := 0 to high(fOutPath) do
          fOutPath[j].Z := pt0.Z;
{$ENDIF}
      end else
      begin
        j := Round(absDelta);
        rec := Rect64(pt0.X -j, pt0.Y -j, pt0.X+j, pt0.Y+j);
        fOutPath := rec.AsPath;
{$IFDEF USINGZ}
        for j := 0 to high(fOutPath) do
          fOutPath[j].Z := pt0.Z;
{$ENDIF}
      end;
      UpdateSolution;
      Continue;
    end; // end of offsetting a single point

    if (len = 2) and (group.endType = etJoined) then
    begin
      if fJoinType = jtRound then
        fEndType := etRound else
        fEndType := etSquare;
    end;

    BuildNormals;
    if fEndType = etPolygon then
      OffsetPolygon
    else if fEndType = etJoined then
      OffsetOpenJoined
    else
      OffsetOpenPath;
  end;
end;
//------------------------------------------------------------------------------

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

procedure TClipperOffset.UpdateSolution;
begin
  if fOutPathLen = 0 then Exit;
  SetLength(fOutPath, fOutPathLen);
  fSolution[fSolutionLen] := fOutPath;
  inc(fSolutionLen);
  fOutPath := nil;
  fOutPathLen := 0;
end;
//------------------------------------------------------------------------------

function TClipperOffset.CalcSolutionCapacity: integer;
var
  i: integer;
begin
  Result := 0;
  for i := 0 to fGroupList.Count -1 do
    with TGroup(fGroupList[i]) do
    if endType = etJoined then
      inc(Result, Length(paths) *2) else
      inc(Result, Length(paths));
end;
//------------------------------------------------------------------------------

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

procedure TClipperOffset.OffsetOpenJoined;
begin
  OffsetPolygon;
  fInPath := ReversePath(fInPath);
  // Rebuild normals // BuildNormals;
  fNorms := ReversePath(fNorms);
  fNorms := ShiftPath(fNorms, 1);
  fNorms := NegatePath(fNorms);
  OffsetPolygon;
end;
//------------------------------------------------------------------------------

procedure TClipperOffset.OffsetOpenPath;
var
  i, k, highI: integer;
begin
  highI := high(fInPath);

  if Assigned(fDeltaCallback64) then
    fGroupDelta := fDeltaCallback64(fInPath, fNorms, 0, 0);

  if (Abs(fGroupDelta) < Tolerance) and
    not Assigned(fDeltaCallback64) then
  begin
    inc(highI);
    SetLength(fOutPath, highI);
    Move(fInPath[0], fOutPath, highI + SizeOf(TPointD));
    fOutPathLen := highI;
    Exit;
  end;

  // do the line start cap
  if Assigned(fDeltaCallback64) then
    fGroupDelta := fDeltaCallback64(fInPath, fNorms, 0, 0);

  if (Abs(fGroupDelta) < Tolerance) then
    AddPoint(fInPath[0])
  else
    case fEndType of
      etButt: DoBevel(0, 0);
      etRound: DoRound(0,0, PI);
      else DoSquare(0, 0);
    end;

  // offset the left side going forward
  k := 0;
  for i := 1 to highI -1 do //nb: -1 is important
    OffsetPoint(i, k);

  // reverse the normals ...
  for i := HighI downto 1 do
  begin
    fNorms[i].X := -fNorms[i-1].X;
    fNorms[i].Y := -fNorms[i-1].Y;
  end;
  fNorms[0] := fNorms[highI];

 // do the line end cap

 if Assigned(fDeltaCallback64) then
    fGroupDelta := fDeltaCallback64(fInPath, fNorms, highI, highI);
  if Abs(fGroupDelta) < Tolerance then
  begin
    AddPoint(fInPath[highI]);
  end else
  case fEndType of
    etButt: DoBevel(highI, highI);
    etRound: DoRound(highI,highI, PI);
    else DoSquare(highI, highI);
  end;

  // offset the left side going back
  k := highI;
  for i := highI -1 downto 1 do //and stop at 1!
    OffsetPoint(i, k);

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

procedure TClipperOffset.ExecuteInternal(delta: Double);
var
  i,j: integer;
  group: TGroup;
  pathsReversed: Boolean;
  fillRule: TFillRule;
  dummy: TPaths64;
begin
  fSolution := nil;
  fSolutionLen := 0;
  if fGroupList.Count = 0 then Exit;
  SetLength(fSolution, CalcSolutionCapacity);

  fMinLenSqrd := 1;
  if abs(delta) < Tolerance then
  begin
    // if delta == 0, just copy paths to Result
    for i := 0 to fGroupList.Count -1 do
    begin
      group := TGroup(fGroupList[i]);
      for j := 0 to High(group.paths) do
      begin
        fSolution[fSolutionLen] := group.paths[i];
        inc(fSolutionLen);
      end;
    end;
    Exit;
  end;

  fDelta := delta;
  // Miter Limit: see offset_triginometry3.svg
  if fMiterLimit > 1 then
    fTmpLimit := 2 / Sqr(fMiterLimit) else
    fTmpLimit := 2.0;

  // nb: delta will depend on whether paths are polygons or open
  for i := 0 to fGroupList.Count -1 do
  begin
    group := TGroup(fGroupList[i]);
    DoGroupOffset(group);
  end;
  SetLength(fSolution, fSolutionLen);

  pathsReversed := CheckReverseOrientation();
  if pathsReversed then
    fillRule := frNegative else
    fillRule := frPositive;

  // clean up self-intersections ...
  with TClipper64.Create do
  try
    PreserveCollinear := fPreserveCollinear;
    // the solution should retain the orientation of the input
    ReverseSolution := fReverseSolution <> pathsReversed;
{$IFDEF USINGZ}
    ZCallback := ZCB;
{$ENDIF}

    AddSubject(fSolution);
    if assigned(fSolutionTree) then
      Execute(ctUnion, fillRule, fSolutionTree, dummy);
      Execute(ctUnion, fillRule, fSolution);
  finally
    free;
  end;
end;
//------------------------------------------------------------------------------

function TClipperOffset.CheckReverseOrientation: Boolean;
var
  i: integer;
begin
  Result := false;
  // find the orientation of the first closed path
  for i := 0 to fGroupList.Count -1 do
    with TGroup(fGroupList[i]) do
      if endType = etPolygon then
      begin
        Result := reversed;
        break;
      end;
end;
//------------------------------------------------------------------------------

procedure TClipperOffset.Execute(delta: Double; out solution: TPaths64);
begin
  solution := nil;
  fSolutionTree := nil;
  if fGroupList.Count = 0 then Exit;
  ExecuteInternal(delta);
  solution := fSolution;
end;
//------------------------------------------------------------------------------

procedure TClipperOffset.Execute(DeltaCallback: TDeltaCallback64; out solution: TPaths64);
begin
  fDeltaCallback64 := DeltaCallback;
  Execute(1.0, solution);
end;
//------------------------------------------------------------------------------

procedure TClipperOffset.Execute(delta: Double; polytree: TPolyTree64);
begin
  if not Assigned(polytree) then
    Raise EClipper2LibException(rsClipper_PolyTreeErr);
  fSolutionTree := polytree;
  fSolutionTree.Clear;
  ExecuteInternal(delta);
end;
//------------------------------------------------------------------------------

{$IFDEF USINGZ}
procedure TClipperOffset.ZCB(const bot1, top1, bot2, top2: TPoint64;
  var intersectPt: TPoint64);
begin
  if (bot1.Z <> 0) and
    ((bot1.Z = bot2.Z) or (bot1.Z = top2.Z)) then intersectPt.Z := bot1.Z
  else if (bot2.Z <> 0) and (bot2.Z = top1.Z) then intersectPt.Z := bot2.Z
  else if (top1.Z <> 0) and (top1.Z = top2.Z) then intersectPt.Z := top1.Z
  else if Assigned(ZCallback) then
    ZCallback(bot1, top1, bot2, top2, intersectPt);
end;
{$ENDIF}
//------------------------------------------------------------------------------

{$IFDEF USINGZ}
procedure TClipperOffset.AddPoint(x,y: double; z: Int64);
{$ELSE}
procedure TClipperOffset.AddPoint(x,y: double);
{$ENDIF}
const
  BuffLength = 32;
var
  pt: TPoint64;
begin
{$IFDEF USINGZ}
  pt := Point64(Round(x),Round(y), z);
{$ELSE}
  pt := Point64(Round(x),Round(y));
{$ENDIF}
  if fOutPathLen = length(fOutPath) then
    SetLength(fOutPath, fOutPathLen + BuffLength);
  if (fOutPathLen > 0) and
    PointsEqual(fOutPath[fOutPathLen-1], pt) then Exit;
  fOutPath[fOutPathLen] := pt;
  Inc(fOutPathLen);
end;
//------------------------------------------------------------------------------

{$IFDEF USINGZ}
procedure TClipperOffset.AddPoint(const pt: TPoint64; newZ: Int64);
begin
  AddPoint(pt.X, pt.Y, newZ);
end;
//------------------------------------------------------------------------------

procedure TClipperOffset.AddPoint(const pt: TPoint64);
begin
  AddPoint(pt.X, pt.Y, pt.Z);
end;
//------------------------------------------------------------------------------

{$ELSE}
procedure TClipperOffset.AddPoint(const pt: TPoint64);
begin
  AddPoint(pt.X, pt.Y);
end;
//------------------------------------------------------------------------------
{$ENDIF}

function IntersectPoint(const ln1a, ln1b, ln2a, ln2b: TPointD): TPointD;
var
  m1,b1,m2,b2: double;
begin
  result := NullPointD;
  //see http://astronomy.swin.edu.au/~pbourke/geometry/lineline2d/
  if (ln1B.X = ln1A.X) then
  begin
    if (ln2B.X = ln2A.X) then exit; //parallel lines
    m2 := (ln2B.Y - ln2A.Y)/(ln2B.X - ln2A.X);
    b2 := ln2A.Y - m2 * ln2A.X;
    Result.X := ln1A.X;
    Result.Y := m2*ln1A.X + b2;
  end
  else if (ln2B.X = ln2A.X) then
  begin
    m1 := (ln1B.Y - ln1A.Y)/(ln1B.X - ln1A.X);
    b1 := ln1A.Y - m1 * ln1A.X;
    Result.X := ln2A.X;
    Result.Y := m1*ln2A.X + b1;
  end else
  begin
    m1 := (ln1B.Y - ln1A.Y)/(ln1B.X - ln1A.X);
    b1 := ln1A.Y - m1 * ln1A.X;
    m2 := (ln2B.Y - ln2A.Y)/(ln2B.X - ln2A.X);
    b2 := ln2A.Y - m2 * ln2A.X;
    if m1 = m2 then exit; //parallel lines
    Result.X := (b2 - b1)/(m1 - m2);
    Result.Y := m1 * Result.X + b1;
  end;
end;
//------------------------------------------------------------------------------

function ReflectPoint(const pt, pivot: TPointD): TPointD;
begin
  Result.X := pivot.X + (pivot.X - pt.X);
  Result.Y := pivot.Y + (pivot.Y - pt.Y);
{$IFDEF USINGZ}
  Result.Z := pt.Z;
{$ENDIF}
end;
//------------------------------------------------------------------------------

procedure TClipperOffset.DoBevel(j, k: Integer);
var
  absDelta: double;
begin
  if k = j then
  begin
		absDelta :=  abs(fGroupDelta);
{$IFDEF USINGZ}
		AddPoint(
      fInPath[j].x - absDelta * fNorms[j].x,
      fInPath[j].y - absDelta * fNorms[j].y, fInPath[j].z);
		AddPoint(
      fInPath[j].x + absDelta * fNorms[j].x,
      fInPath[j].y + absDelta * fNorms[j].y, fInPath[j].z);
{$ELSE}
		AddPoint(
      fInPath[j].x - absDelta * fNorms[j].x,
      fInPath[j].y - absDelta * fNorms[j].y);
		AddPoint(
      fInPath[j].x + absDelta * fNorms[j].x,
      fInPath[j].y + absDelta * fNorms[j].y);
{$ENDIF}
  end else
  begin
{$IFDEF USINGZ}
		AddPoint(
      fInPath[j].x + fGroupDelta * fNorms[k].x,
      fInPath[j].y + fGroupDelta * fNorms[k].y, fInPath[j].z);
		AddPoint(
      fInPath[j].x + fGroupDelta * fNorms[j].x,
      fInPath[j].y + fGroupDelta * fNorms[j].y, fInPath[j].z);
{$ELSE}
		AddPoint(
      fInPath[j].x + fGroupDelta * fNorms[k].x,
      fInPath[j].y + fGroupDelta * fNorms[k].y);
		AddPoint(
      fInPath[j].x + fGroupDelta * fNorms[j].x,
      fInPath[j].y + fGroupDelta * fNorms[j].y);
{$ENDIF}
  end;
end;
//------------------------------------------------------------------------------

procedure TClipperOffset.DoSquare(j, k: Integer);
var
  vec, pt1,pt2,pt3,pt4, pt,ptQ : TPointD;
  absDelta: double;
begin
  if k = j then
  begin
    vec.X := fNorms[j].Y;     //squaring a line end
    vec.Y := -fNorms[j].X;
  end else
  begin
    // using the reciprocal of unit normals (as unit vectors)
    // get the average unit vector ...
    vec := GetAvgUnitVector(
      PointD(-fNorms[k].Y, fNorms[k].X),
      PointD(fNorms[j].Y, -fNorms[j].X));
  end;

  absDelta := Abs(fGroupDelta);
  // now offset the original vertex delta units along unit vector
  ptQ := PointD(fInPath[j]);
  ptQ := TranslatePoint(ptQ, absDelta * vec.X, absDelta * vec.Y);

  // get perpendicular vertices
  pt1 := TranslatePoint(ptQ, fGroupDelta * vec.Y, fGroupDelta * -vec.X);
  pt2 := TranslatePoint(ptQ, fGroupDelta * -vec.Y, fGroupDelta * vec.X);

  // get 2 vertices along one edge offset
  pt3 := GetPerpendicD(fInPath[k], fNorms[k], fGroupDelta);

  if (j = k) then
  begin
    pt4.X := pt3.X + vec.X * fGroupDelta;
    pt4.Y := pt3.Y + vec.Y * fGroupDelta;
    // get the intersection point
    pt := IntersectPoint(pt1, pt2, pt3, pt4);
{$IFDEF USINGZ}
    with ReflectPoint(pt, ptQ) do AddPoint(X, Y, Z);
    AddPoint(pt.X, pt.Y, pt.Z);
{$ELSE}
    with ReflectPoint(pt, ptQ) do AddPoint(X, Y);
    AddPoint(pt.X, pt.Y);
{$ENDIF}
  end else
  begin
    pt4 := GetPerpendicD(fInPath[j], fNorms[k], fGroupDelta);
    // get the intersection point
    pt := IntersectPoint(pt1, pt2, pt3, pt4);
{$IFDEF USINGZ}
    AddPoint(pt.X, pt.Y, ptQ.Z);
    //get the second intersect point through reflecion
    with ReflectPoint(pt, ptQ) do AddPoint(X, Y, ptQ.Z);
{$ELSE}
    AddPoint(pt.X, pt.Y);
    //get the second intersect point through reflecion
    with ReflectPoint(pt, ptQ) do AddPoint(X, Y);
{$ENDIF}
  end;
end;
//------------------------------------------------------------------------------

procedure TClipperOffset.DoMiter(j, k: Integer; cosA: Double);
var
  q: Double;
begin
  // see offset_triginometry4.svg
  q := fGroupDelta / (cosA +1);
{$IFDEF USINGZ}
  AddPoint(fInPath[j].X + (fNorms[k].X + fNorms[j].X)*q,
    fInPath[j].Y + (fNorms[k].Y + fNorms[j].Y)*q,
    fInPath[j].Z);
{$ELSE}
  AddPoint(fInPath[j].X + (fNorms[k].X + fNorms[j].X)*q,
    fInPath[j].Y + (fNorms[k].Y + fNorms[j].Y)*q);
{$ENDIF}
end;
//------------------------------------------------------------------------------

procedure TClipperOffset.DoRound(j, k: Integer; angle: double);
var
  i, steps: Integer;
  absDelta, arcTol, stepsPer360: double;
  pt: TPoint64;
  offDist: TPointD;
begin

  if Assigned(fDeltaCallback64) then
  begin
    // when fDeltaCallback64 is assigned, fGroupDelta won't be constant,
    // so we'll need to do the following calculations for *every* vertex.
    absDelta := Abs(fGroupDelta);
    arcTol := Iif(fArcTolerance > 0.01,
      Min(absDelta, fArcTolerance),
      Log10(2 + absDelta) * 0.25); // empirically derived
    //http://www.angusj.com/clipper2/Docs/Trigonometry.htm
    stepsPer360 := Pi / ArcCos(1 - arcTol / absDelta);
		if (stepsPer360 > absDelta * Pi) then
			stepsPer360 := absDelta * Pi;  // avoid excessive precision
    fStepSin := sin(TwoPi/stepsPer360);
    fStepCos := cos(TwoPi/stepsPer360);
		if (fGroupDelta < 0.0) then fStepSin := -fStepSin;
    fStepsPerRad := stepsPer360 / TwoPi;
  end;

	// nb: angles may be negative but this will always be a convex join
  pt := fInPath[j];
  offDist := ScalePoint(fNorms[k], fGroupDelta);
  if j = k then  offDist := Negate(offDist);
{$IFDEF USINGZ}
  AddPoint(pt.X + offDist.X, pt.Y + offDist.Y, pt.Z);
{$ELSE}
  AddPoint(pt.X + offDist.X, pt.Y + offDist.Y);
{$ENDIF}
  steps := Ceil(fStepsPerRad * abs(angle)); // #448, #456
  for i := 2 to steps do
  begin
    offDist := PointD(offDist.X * fStepCos - fStepSin * offDist.Y,
      offDist.X * fStepSin + offDist.Y * fStepCos);
{$IFDEF USINGZ}
    AddPoint(pt.X + offDist.X, pt.Y + offDist.Y, pt.Z);
{$ELSE}
    AddPoint(pt.X + offDist.X, pt.Y + offDist.Y);
{$ENDIF}
  end;
  AddPoint(GetPerpendic(pt, fNorms[j], fGroupDelta));
end;
//------------------------------------------------------------------------------

  procedure TClipperOffset.OffsetPoint(j: Integer; var k: integer);
var
  sinA, cosA: Double;
begin
  if PointsEqual(fInPath[j], fInPath[k]) then
  begin
    k := j;
    Exit;
  end;

  // Let A = change in angle where edges join
  // A == 0: ie no change in angle (flat join)
  // A == PI: edges 'spike'
  // sin(A) < 0: right turning
  // cos(A) < 0: change in angle is more than 90 degree
  sinA := CrossProduct(fNorms[k], fNorms[j]);
  cosA := DotProduct(fNorms[j], fNorms[k]);
  if (sinA > 1.0) then sinA := 1.0
  else if (sinA < -1.0) then sinA := -1.0;

  if Assigned(fDeltaCallback64) then
  begin
    fGroupDelta := fDeltaCallback64(fInPath, fNorms, j, k);
    if TGroup(fGroupList[0]).reversed then fGroupDelta := -fGroupDelta;
  end;

  if Abs(fGroupDelta) <= Tolerance then
  begin
    AddPoint(fInPath[j]);
    Exit;
  end;

  //test for concavity first (#593)
  if (cosA > -0.999) and (sinA * fGroupDelta < 0) then
  begin
    // is concave
{$IFDEF USINGZ}
    AddPoint(GetPerpendic(fInPath[j], fNorms[k], fGroupDelta), fInPath[j].Z);
{$ELSE}
    AddPoint(GetPerpendic(fInPath[j], fNorms[k], fGroupDelta));
{$ENDIF}
		// this extra point is the only simple way to ensure that path reversals
		// (ie over-shrunk paths) are fully cleaned out with the trailing union op.
		// However it's probably safe to skip this whenever an angle is almost flat.
		if (cosA < 0.99) then
      AddPoint(fInPath[j]); // (#405)
{$IFDEF USINGZ}
    AddPoint(GetPerpendic(fInPath[j], fNorms[j], fGroupDelta), fInPath[j].Z);
{$ELSE}
    AddPoint(GetPerpendic(fInPath[j], fNorms[j], fGroupDelta));
{$ENDIF}
  end
  else if (cosA > 0.999) and (fJoinType <> jtRound) then
  begin
    // almost straight - less than 2.5 degree (#424, #482, #526 & #724)
    DoMiter(j, k, cosA);
  end
  else if (fJoinType = jtMiter) then
  begin
		// miter unless the angle is sufficiently acute to exceed ML
    if (cosA > fTmpLimit -1) then DoMiter(j, k, cosA)
    else DoSquare(j, k);
  end
  else if (fJoinType = jtRound) then
    DoRound(j, k, ArcTan2(sinA, cosA))
  else if (fJoinType = jtBevel) then
    DoBevel(j, k)
  else
    DoSquare(j, k);

  k := j;
end;
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------

end.