diff --git a/source/Clipper/Clipper.Core.pas b/source/Clipper/Clipper.Core.pas index 3e1b8313..5a078bce 100644 --- a/source/Clipper/Clipper.Core.pas +++ b/source/Clipper/Clipper.Core.pas @@ -2,8 +2,8 @@ (******************************************************************************* * Author : Angus Johnson * -* Version : Clipper2 - beta * -* Date : 27 July 2022 * +* Version : Clipper2 - ver.1.0.4 * +* Date : 3 September 2022 * * Copyright : Angus Johnson 2010-2022 * * Purpose : Core Clipper Library module * * Contains structures and functions used throughout the library * @@ -30,7 +30,7 @@ TPoint64 = record TPointD = record X, Y: double; {$IFDEF USINGZ} - Z: double; + Z: Int64; {$ENDIF} end; @@ -71,6 +71,7 @@ TPointD = record Bottom : Int64; function Contains(const pt: TPoint64): Boolean; overload; function Contains(const rec: TRect64): Boolean; overload; + function AsPath: TPath64; property Width: Int64 read GetWidth; property Height: Int64 read GetHeight; property IsEmpty: Boolean read GetIsEmpty; @@ -88,7 +89,9 @@ TPointD = record Top : double; Right : double; Bottom : double; - function PtInside(const pt: TPointD): Boolean; + function Contains(const pt: TPointD): Boolean; overload; + function Contains(const rec: TRectD): Boolean; overload; + function AsPath: TPathD; property Width: double read GetWidth; property Height: double read GetHeight; property IsEmpty: Boolean read GetIsEmpty; @@ -116,6 +119,8 @@ function CrossProduct(const pt1, pt2, pt3: TPoint64): double; overload; {$IFDEF INLINING} inline; {$ENDIF} function CrossProduct(const pt1, pt2, pt3: TPointD): double; overload; {$IFDEF INLINING} inline; {$ENDIF} +function CrossProduct(const vec1, vec2: TPointD): double; overload; + {$IFDEF INLINING} inline; {$ENDIF} function CrossProduct(vec1x, vec1y, vec2x, vec2y: double): double; overload; {$IFDEF INLINING} inline; {$ENDIF} @@ -129,19 +134,22 @@ function DistanceSqr(const pt1, pt2: TPointD): double; overload; function DistanceFromLineSqrd(const pt, linePt1, linePt2: TPoint64): double; overload; function DistanceFromLineSqrd(const pt, linePt1, linePt2: TPointD): double; overload; -function SegmentsIntersect(const s1a, s1b, s2a, s2b: TPoint64): boolean; +function SegmentsIntersect(const s1a, s1b, s2a, s2b: TPoint64; + inclusive: Boolean = false): boolean; {$IFDEF INLINING} inline; {$ENDIF} function PointsEqual(const pt1, pt2: TPoint64): Boolean; overload; {$IFDEF INLINING} inline; {$ENDIF} -function PointsNearEqual(const pt1, pt2: TPointD; distanceSqrd: double): Boolean; +function PointsNearEqual(const pt1, pt2: TPointD): Boolean; overload; + {$IFDEF INLINING} inline; {$ENDIF} +function PointsNearEqual(const pt1, pt2: TPointD; distanceSqrd: double): Boolean; overload; {$IFDEF INLINING} inline; {$ENDIF} {$IFDEF USINGZ} function Point64(const X, Y: Int64; Z: Int64 = 0): TPoint64; overload; {$IFDEF INLINING} inline; {$ENDIF} -function Point64(const X, Y: Double; Z: double = 0.0): TPoint64; overload; +function Point64(const X, Y: Double; Z: Int64 = 0): TPoint64; overload; {$IFDEF INLINING} inline; {$ENDIF} -function PointD(const X, Y: Double; Z: double = 0.0): TPointD; overload; +function PointD(const X, Y: Double; Z: Int64 = 0): TPointD; overload; {$IFDEF INLINING} inline; {$ENDIF} {$ELSE} function Point64(const X, Y: Int64): TPoint64; overload; {$IFDEF INLINING} inline; {$ENDIF} @@ -149,6 +157,8 @@ function Point64(const X, Y: Double): TPoint64; overload; {$IFDEF INLINING} inli function PointD(const X, Y: Double): TPointD; overload; {$IFDEF INLINING} inline; {$ENDIF} {$ENDIF} +function Negate(const pt: TPointD): TPointD; {$IFDEF INLINING} inline; {$ENDIF} + function Point64(const pt: TPointD): TPoint64; overload; {$IFDEF INLINING} inline; {$ENDIF} function PointD(const pt: TPoint64): TPointD; overload; {$IFDEF INLINING} inline; {$ENDIF} @@ -165,6 +175,12 @@ function GetBounds(const paths: TPaths64): TRect64; overload; function GetBounds(const paths: TPathsD): TRectD; overload; function GetBounds(const path: TPath64): TRect64; overload; +function TranslatePoint(const pt: TPoint64; dx, dy: Int64): TPoint64; overload; +function TranslatePoint(const pt: TPointD; dx, dy: double): TPointD; overload; + +procedure RotatePt(var pt: TPointD; const center: TPointD; sinA, cosA: double); +procedure RotatePath(var path: TPathD; const center: TPointD; sinA, cosA: double); + procedure InflateRect(var rec: TRect64; dx, dy: Int64); overload; {$IFDEF INLINING} inline; {$ENDIF} procedure InflateRect(var rec: TRectD; dx, dy: double); overload; @@ -204,11 +220,6 @@ function ScalePathsD(const paths: TPathsD; sx, sy: double): TPathsD; overload; function ScalePathsD(const paths: TPaths64; scale: double): TPathsD; overload; function ScalePathsD(const paths: TPathsD; scale: double): TPathsD; overload; -function TranslatePath(const path: TPath64; dx, dy: Int64): TPath64; overload; -function TranslatePath(const path: TPathD; dx, dy: double): TPathD; overload; -function TranslatePaths(const paths: TPaths64; dx, dy: Int64): TPaths64; overload; -function TranslatePaths(const paths: TPathsD; dx, dy: double): TPathsD; overload; - function Path64(const pathD: TPathD): TPath64; function PathD(const path: TPath64): TPathD; function Paths64(const pathsD: TPathsD): TPaths64; @@ -245,12 +256,16 @@ procedure AppendPaths(var paths: TPaths64; const extra: TPaths64); overload; procedure AppendPaths(var paths: TPathsD; const extra: TPathsD); overload; function ArrayOfPathsToPaths(const ap: TArrayOfPaths): TPaths64; -function GetIntersectPoint(const ln1a, ln1b, ln2a, ln2b: TPoint64): TPointD; +function GetIntersectPoint64(const ln1a, ln1b, ln2a, ln2b: TPoint64): TPoint64; +function GetIntersectPointD(const ln1a, ln1b, ln2a, ln2b: TPoint64): TPointD; overload; +function GetIntersectPointD(const ln1a, ln1b, ln2a, ln2b: TPointD): TPointD; overload; function PointInPolygon(const pt: TPoint64; const polygon: TPath64): TPointInPolygonResult; function RamerDouglasPeucker(const path: TPath64; epsilon: double): TPath64; overload; function RamerDouglasPeucker(const paths: TPaths64; epsilon: double): TPaths64; overload; +function RamerDouglasPeucker(const path: TPathD; epsilon: double): TPathD; overload; +function RamerDouglasPeucker(const paths: TPathsD; epsilon: double): TPathsD; overload; procedure GetSinCos(angle: double; out sinA, cosA: double); function Ellipse(const rec: TRect64; steps: integer = 0): TPath64; overload; @@ -258,9 +273,16 @@ function Ellipse(const rec: TRectD; steps: integer = 0): TPathD; overload; const MaxInt64 = 9223372036854775807; + invalid64 = MaxInt64; + invalidD = infinity; + + NullPointD : TPointD = (X: 0; Y: 0); NullRect64 : TRect64 = (left: 0; top: 0; right: 0; Bottom: 0); + InvalidPt64 : TPoint64 = (X: invalid64; Y: invalid64); + InvalidPtD : TPointD = (X: invalidD; Y: invalidD); + NullRectD : TRectD = (left: 0; top: 0; right: 0; Bottom: 0); - Tolerance : Double = 1.0E-15; + Tolerance : Double = 1.0E-12; implementation @@ -304,6 +326,16 @@ function TRect64.Contains(const rec: TRect64): Boolean; result := (rec.Left >= Left) and (rec.Right <= Right) and (rec.Top >= Top) and (rec.Bottom <= Bottom); end; +//------------------------------------------------------------------------------ + +function TRect64.AsPath: TPath64; +begin + SetLength(Result, 4); + Result[0] := Point64(Left, Top); + Result[1] := Point64(Right, Top); + Result[2] := Point64(Right, Bottom); + Result[3] := Point64(Left, Bottom); +end; //------------------------------------------------------------------------------ // TRectD methods ... @@ -333,11 +365,28 @@ function TRectD.GetMidPoint: TPointD; end; //------------------------------------------------------------------------------ -function TRectD.PtInside(const pt: TPointD): Boolean; +function TRectD.Contains(const pt: TPointD): Boolean; begin result := (pt.X > Left) and (pt.X < Right) and (pt.Y > Top) and (pt.Y < Bottom); end; +//------------------------------------------------------------------------------ + +function TRectD.Contains(const rec: TRectD): Boolean; +begin + result := (rec.Left >= Left) and (rec.Right <= Right) and + (rec.Top >= Top) and (rec.Bottom <= Bottom); +end; +//------------------------------------------------------------------------------ + +function TRectD.AsPath: TPathD; +begin + SetLength(Result, 4); + Result[0] := PointD(Left, Top); + Result[1] := PointD(Right, Top); + Result[2] := PointD(Right, Bottom); + Result[3] := PointD(Left, Bottom); +end; //------------------------------------------------------------------------------ // Miscellaneous Functions ... @@ -355,6 +404,13 @@ function PointsEqual(const pt1, pt2: TPoint64): Boolean; end; //------------------------------------------------------------------------------ +function PointsNearEqual(const pt1, pt2: TPointD): Boolean; +begin + Result := (Abs(pt1.X - pt2.X) < Tolerance) and + (Abs(pt1.Y - pt2.Y) < Tolerance); +end; +//------------------------------------------------------------------------------ + function PointsNearEqual(const pt1, pt2: TPointD; distanceSqrd: double): Boolean; begin Result := Sqr(pt1.X - pt2.X) + Sqr(pt1.Y - pt2.Y) < distanceSqrd; @@ -416,7 +472,7 @@ function ValueBetween(val, end1, end2: Int64): Boolean; function ValueEqualOrBetween(val, end1, end2: Int64): Boolean; begin Result := (val = end1) or (val = end2) or - (val > end1) = (val < end2); + ((val > end1) = (val < end2)); end; //------------------------------------------------------------------------------ @@ -425,7 +481,7 @@ function ScalePoint(const pt: TPoint64; scale: double): TPointD; Result.X := pt.X * scale; Result.Y := pt.Y * scale; {$IFDEF USINGZ} - Result.Z := pt.Z * scale; + Result.Z := pt.Z; {$ENDIF} end; //------------------------------------------------------------------------------ @@ -566,7 +622,7 @@ function ScalePathD(const path: TPath64; scale: double): TPathD; result[i].X := path[i].X * scale; result[i].Y := path[i].Y * scale; {$IFDEF USINGZ} - result[i].Z := path[i].Z * scale; + result[i].Z := path[i].Z; {$ENDIF} end; end; @@ -582,7 +638,7 @@ function ScalePathD(const path: TPathD; scale: double): TPathD; result[i].X := path[i].X * scale; result[i].Y := path[i].Y * scale; {$IFDEF USINGZ} - result[i].Z := path[i].Z * scale; + result[i].Z := path[i].Z; {$ENDIF} end; end; @@ -639,7 +695,7 @@ function ScalePaths(const paths: TPaths64; scale: double): TPaths64; result[i][j].X := Round(paths[i][j].X * scale); result[i][j].Y := Round(paths[i][j].Y * scale); {$IFDEF USINGZ} - result[i][j].Z := Round(paths[i][j].Z * scale); + result[i][j].Z := paths[i][j].Z; {$ENDIF} end; end; @@ -659,7 +715,7 @@ function ScalePaths(const paths: TPathsD; scale: double): TPaths64; result[i][j].X := Round(paths[i][j].X * scale); result[i][j].Y := Round(paths[i][j].Y * scale); {$IFDEF USINGZ} - result[i][j].Z := Round(paths[i][j].Z * scale); + result[i][j].Z := paths[i][j].Z; {$ENDIF} end; end; @@ -679,7 +735,7 @@ function ScalePathsD(const paths: TPaths64; scale: double): TPathsD; overload; result[i][j].X := paths[i][j].X * scale; result[i][j].Y := paths[i][j].Y * scale; {$IFDEF USINGZ} - result[i][j].Z := paths[i][j].Z * scale; + result[i][j].Z := paths[i][j].Z; {$ENDIF} end; end; @@ -699,91 +755,13 @@ function ScalePathsD(const paths: TPathsD; scale: double): TPathsD; overload; result[i][j].X := paths[i][j].X * scale; result[i][j].Y := paths[i][j].Y * scale; {$IFDEF USINGZ} - result[i][j].Z := paths[i][j].Z * scale; + result[i][j].Z := paths[i][j].Z; {$ENDIF} end; end; end; //------------------------------------------------------------------------------ -function TranslatePath(const path: TPath64; dx, dy: Int64): TPath64; -var - i: integer; -begin - if (dx = 0) and (dy = 0) then - begin - result := path; // nb: reference counted - Exit; - end; - - setlength(result, length(path)); - for i := 0 to high(path) do - begin - result[i].X := path[i].X + dx; - result[i].Y := path[i].Y + dy; - end; -end; -//------------------------------------------------------------------------------ - -function TranslatePath(const path: TPathD; dx, dy: double): TPathD; -var - i: integer; -begin - if (dx = 0) and (dy = 0) then - begin - result := path; // nb: reference counted - Exit; - end; - - setlength(result, length(path)); - for i := 0 to high(path) do - begin - result[i].X := path[i].X + dx; - result[i].Y := path[i].Y + dy; - end; -end; -//------------------------------------------------------------------------------ - -function TranslatePaths(const paths: TPaths64; dx, dy: Int64): TPaths64; -var - i,j: integer; -begin - if (dx = 0) and (dy = 0) then - begin - result := paths; // nb: reference counted - Exit; - end; - - setlength(result, length(paths)); - for i := 0 to high(paths) do - begin - setlength(result[i], length(paths[i])); - for j := 0 to high(paths[i]) do - begin - result[i][j].X := paths[i][j].X + dx; - result[i][j].Y := paths[i][j].Y + dy; - end; - end; -end; -//------------------------------------------------------------------------------ - -function TranslatePaths(const paths: TPathsD; dx, dy: double): TPathsD; -var - i,j: integer; -begin - setlength(result, length(paths)); - for i := 0 to high(paths) do - begin - setlength(result[i], length(paths[i])); - for j := 0 to high(paths[i]) do - begin - result[i][j].X := paths[i][j].X + dx; - result[i][j].Y := paths[i][j].Y + dy; - end; - end; -end; -//------------------------------------------------------------------------------ - function Path64(const pathD: TPathD): TPath64; var i, len: integer; @@ -994,15 +972,15 @@ function Point64(const X, Y: Int64; Z: Int64): TPoint64; end; //------------------------------------------------------------------------------ -function Point64(const X, Y: Double; Z: double): TPoint64; +function Point64(const X, Y: Double; Z: Int64): TPoint64; begin Result.X := Round(X); Result.Y := Round(Y); - Result.Z := Round(Z); + Result.Z := Z; end; //------------------------------------------------------------------------------ -function PointD(const X, Y: Double; Z: Double): TPointD; +function PointD(const X, Y: Double; Z: Int64): TPointD; begin Result.X := X; Result.Y := Y; @@ -1014,7 +992,7 @@ function Point64(const pt: TPointD): TPoint64; begin Result.X := Round(pt.X); Result.Y := Round(pt.Y); - Result.Z := Round(pt.Z); + Result.Z := pt.Z; end; //------------------------------------------------------------------------------ @@ -1064,6 +1042,13 @@ function PointD(const pt: TPoint64): TPointD; //------------------------------------------------------------------------------ {$ENDIF} +function Negate(const pt: TPointD): TPointD; +begin + Result.X := -pt.X; + Result.Y := -pt.Y; +end; +//------------------------------------------------------------------------------ + function Rect64(const left, top, right, bottom: Int64): TRect64; begin Result.Left := left; @@ -1195,6 +1180,19 @@ function GetBounds(const path: TPath64): TRect64; end; //------------------------------------------------------------------------------ +function TranslatePoint(const pt: TPoint64; dx, dy: Int64): TPoint64; +begin + Result.X := pt.X + dx; + Result.Y := pt.Y + dy; +end; +//------------------------------------------------------------------------------ + +function TranslatePoint(const pt: TPointD; dx, dy: double): TPointD; +begin + Result.X := pt.X + dx; + Result.Y := pt.Y + dy; +end; +//------------------------------------------------------------------------------ procedure InflateRect(var rec: TRect64; dx, dy: Int64); begin @@ -1225,6 +1223,15 @@ procedure RotatePt(var pt: TPointD; const center: TPointD; sinA, cosA: double); end; //------------------------------------------------------------------------------ +procedure RotatePath(var path: TPathD; const center: TPointD; sinA, cosA: double); +var + i: integer; +begin + for i := 0 to High(path) do + RotatePt(path[i], center, sinA, cosA); +end; +//------------------------------------------------------------------------------ + function RotateRect(const rec: TRectD; angleRad: double): TRectD; var i: integer; @@ -1407,6 +1414,12 @@ function CrossProduct(const pt1, pt2, pt3: TPointD): double; end; //------------------------------------------------------------------------------ +function CrossProduct(const vec1, vec2: TPointD): double; +begin + result := (vec1.X * vec2.Y - vec1.Y * vec2.X); +end; +//------------------------------------------------------------------------------ + function CrossProduct(vec1x, vec1y, vec2x, vec2y: double): double; begin result := (vec1x * vec2y - vec1y * vec2x); @@ -1496,15 +1509,96 @@ function CleanPath(const path: TPath64): TPath64; end; //------------------------------------------------------------------------------ -function SegmentsIntersect(const s1a, s1b, s2a, s2b: TPoint64): boolean; +function SegmentsIntersect(const s1a, s1b, s2a, s2b: TPoint64; + inclusive: Boolean): boolean; begin - // nb: result excludes overlapping collinear segments - result := (CrossProduct(s1a, s2a, s2b) * CrossProduct(s1b, s2a, s2b) < 0) and - (CrossProduct(s2a, s1a, s1b) * CrossProduct(s2b, s1a, s1b) < 0); + if inclusive then + result := (CrossProduct(s1a, s2a, s2b) * CrossProduct(s1b, s2a, s2b) <= 0) and + (CrossProduct(s2a, s1a, s1b) * CrossProduct(s2b, s1a, s1b) <= 0) + else + result := (CrossProduct(s1a, s2a, s2b) * CrossProduct(s1b, s2a, s2b) < 0) and + (CrossProduct(s2a, s1a, s1b) * CrossProduct(s2b, s1a, s1b) < 0); end; //------------------------------------------------------------------------------ -function GetIntersectPoint(const ln1a, ln1b, ln2a, ln2b: TPoint64): TPointD; +function GetIntersectPoint64(const ln1a, ln1b, ln2a, ln2b: TPoint64): TPoint64; +var + x, m1,b1,m2,b2: double; +begin + // 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 := Round(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 := Round(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 Abs(m1 - m2) > 1.0E-15 then + begin + x := (b2 - b1)/(m1 - m2); + Result.X := Round(x); + Result.Y := Round(m1 * x + b1); + end else + begin + Result.X := Round((ln1a.X + ln1b.X) * 0.5); + Result.Y := Round((ln1a.Y + ln1b.Y) * 0.5); + end; + end; +end; +//------------------------------------------------------------------------------ + +function GetIntersectPointD(const ln1a, ln1b, ln2a, ln2b: TPoint64): TPointD; +var + m1,b1,m2,b2: double; +begin + // 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 Abs(m1 - m2) > 1.0E-15 then + begin + Result.X := (b2 - b1)/(m1 - m2); + Result.Y := m1 * Result.X + b1; + end else + begin + Result.X := (ln1a.X + ln1b.X) * 0.5; + Result.Y := (ln1a.Y + ln1b.Y) * 0.5; + end; + end; +end; +//------------------------------------------------------------------------------ + +function GetIntersectPointD(const ln1a, ln1b, ln2a, ln2b: TPointD): TPointD; overload; var m1,b1,m2,b2: double; begin @@ -1663,7 +1757,7 @@ function Ellipse(const rec: TRectD; steps: integer): TPathD; end; //------------------------------------------------------------------------------ -function PerpendicDistFromLineSqrd(const pt, line1, line2: TPoint64): double; +function PerpendicDistFromLineSqrd(const pt, line1, line2: TPoint64): double; overload; var a,b,c,d: double; begin @@ -1706,6 +1800,49 @@ procedure RDP(const path: TPath64; startIdx, endIdx: integer; end; //------------------------------------------------------------------------------ +function PerpendicDistFromLineSqrd(const pt, line1, line2: TPointD): double; overload; +var + a,b,c,d: double; +begin + a := pt.X - line1.X; + b := pt.Y - line1.Y; + c := line2.X - line1.X; + d := line2.Y - line1.Y; + if (c = 0) and (d = 0) then + result := 0 else + result := Sqr(a * d - c * b) / (c * c + d * d); +end; +//------------------------------------------------------------------------------ + +procedure RDP(const path: TPathD; startIdx, endIdx: integer; + epsilonSqrd: double; var boolArray: TArrayOfBoolean); overload; +var + i, idx: integer; + d, maxD: double; +begin + idx := 0; + maxD := 0; + while (endIdx > startIdx) and + PointsNearEqual(path[startIdx], path[endIdx]) do + begin + boolArray[endIdx] := false; + dec(endIdx); + end; + for i := startIdx +1 to endIdx -1 do + begin + // PerpendicDistFromLineSqrd - avoids expensive Sqrt() + d := PerpendicDistFromLineSqrd(path[i], path[startIdx], path[endIdx]); + if d <= maxD then Continue; + maxD := d; + idx := i; + end; + if maxD < epsilonSqrd then Exit; + boolArray[idx] := true; + if idx > startIdx + 1 then RDP(path, startIdx, idx, epsilonSqrd, boolArray); + if endIdx > idx + 1 then RDP(path, idx, endIdx, epsilonSqrd, boolArray); +end; +//------------------------------------------------------------------------------ + function RamerDouglasPeucker(const path: TPath64; epsilon: double): TPath64; var i,j, len: integer; @@ -1744,5 +1881,43 @@ function RamerDouglasPeucker(const paths: TPaths64; epsilon: double): TPaths64; end; //------------------------------------------------------------------------------ +function RamerDouglasPeucker(const path: TPathD; epsilon: double): TPathD; overload; +var + i,j, len: integer; + boolArray: TArrayOfBoolean; +begin + len := length(path); + if len < 5 then + begin + result := Copy(path, 0, len); + Exit; + end; + SetLength(boolArray, len); // already zero initialized + boolArray[0] := true; + boolArray[len -1] := true; + RDP(path, 0, len -1, Sqr(epsilon), boolArray); + j := 0; + SetLength(Result, len); + for i := 0 to len -1 do + if boolArray[i] then + begin + Result[j] := path[i]; + inc(j); + end; + SetLength(Result, j); +end; +//------------------------------------------------------------------------------ + +function RamerDouglasPeucker(const paths: TPathsD; epsilon: double): TPathsD; overload; +var + i, len: integer; +begin + len := Length(paths); + SetLength(Result, len); + for i := 0 to len -1 do + Result[i] := RamerDouglasPeucker(paths[i], epsilon); +end; +//------------------------------------------------------------------------------ + end. diff --git a/source/Clipper/Clipper.Engine.pas b/source/Clipper/Clipper.Engine.pas index 35441ade..419f7162 100644 --- a/source/Clipper/Clipper.Engine.pas +++ b/source/Clipper/Clipper.Engine.pas @@ -2,8 +2,8 @@ (******************************************************************************* * Author : Angus Johnson * -* Version : Clipper2 - beta * -* Date : 27 July 2022 * +* Version : Clipper2 - ver.1.0.4 * +* Date : 24 September 2022 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2010-2022 * * Purpose : This is the main polygon clipping module * @@ -18,7 +18,6 @@ interface Classes, Math, Clipper.Core; type - //PathType: // 1. only subject paths may be open // 2. for closed paths, all boolean clipping operations except for @@ -175,7 +174,7 @@ TClipperBase = class FSucceeded : Boolean; FReverseSolution : Boolean; {$IFDEF USINGZ} - FZFunc : TZCallback64; + fZCallback : TZCallback64; {$ENDIF} procedure Reset; procedure InsertScanLine(const Y: Int64); @@ -240,7 +239,7 @@ TClipperBase = class procedure BuildTree(polytree: TPolyPathBase; out openPaths: TPaths64); {$IFDEF USINGZ} procedure SetZ( e1, e2: PActive; var intersectPt: TPoint64); - property OnZFill : TZCallback64 read FZFunc write FZFunc; + property ZCallback : TZCallback64 read fZCallback write fZCallback; {$ENDIF} property Succeeded : Boolean read FSucceeded; public @@ -269,7 +268,7 @@ TClipper64 = class(TClipperBase) // for integer coordinates function Execute(clipType: TClipType; fillRule: TFillRule; var solutionTree: TPolyTree64; out openSolutions: TPaths64): Boolean; overload; virtual; {$IFDEF USINGZ} - property ZFillFunc; + property ZCallback; {$ENDIF} end; @@ -279,9 +278,9 @@ TPolyPathBase = class FParent : TPolyPathBase; FChildList : TList; function GetChildCnt: Integer; - function GetChild(index: Integer): TPolyPathBase; function GetIsHole: Boolean; protected + function GetChild(index: Integer): TPolyPathBase; function AddChild(const path: TPath64): TPolyPathBase; virtual; abstract; property ChildList: TList read FChildList; property Parent: TPolyPathBase read FParent write FParent; @@ -290,16 +289,18 @@ TPolyPathBase = class destructor Destroy; override; procedure Clear; virtual; property IsHole: Boolean read GetIsHole; - property ChildCount: Integer read GetChildCnt; - property Child[index: Integer]: TPolyPathBase read GetChild; + property Count: Integer read GetChildCnt; + property Child[index: Integer]: TPolyPathBase read GetChild; default; end; TPolyPath64 = class(TPolyPathBase) {$IFDEF STRICT}strict{$ENDIF} private FPath : TPath64; + function GetChild64(index: Integer): TPolyPath64; protected function AddChild(const path: TPath64): TPolyPathBase; override; public + property Child[index: Integer]: TPolyPath64 read GetChild64; default; property Polygon: TPath64 read FPath; end; @@ -320,7 +321,10 @@ TClipperD = class(TClipperBase) // for floating point coordinates FScale: double; FInvScale: double; {$IFDEF USINGZ} - FZFuncD : TZCallbackD; + fZCallback : TZCallbackD; + procedure ZCB(const bot1, top1, bot2, top2: TPoint64; + var intersectPt: TPoint64); + procedure CheckCallback; {$ENDIF} public procedure AddSubject(const pathD: TPathD); overload; @@ -338,20 +342,20 @@ TClipperD = class(TClipperBase) // for floating point coordinates function Execute(clipType: TClipType; fillRule: TFillRule; var solutionsTree: TPolyTreeD; out openSolutions: TPathsD): Boolean; overload; {$IFDEF USINGZ} - procedure ProxyZFillFunc(const bot1, top1, bot2, top2: TPoint64; - var intersectPt: TPoint64); - property ZFillFunc : TZCallbackD read FZFuncD write FZFuncD; + property ZCallback : TZCallbackD read fZCallback write fZCallback; {$ENDIF} end; TPolyPathD = class(TPolyPathBase) {$IFDEF STRICT}strict{$ENDIF} private FPath : TPathD; + function GetChildD(index: Integer): TPolyPathD; protected FScale : double; function AddChild(const path: TPath64): TPolyPathBase; override; public property Polygon: TPathD read FPath; + property Child[index: Integer]: TPolyPathD read GetChildD; default; end; TPolyTreeD = class(TPolyPathD) @@ -382,6 +386,13 @@ implementation // Miscellaneous Functions ... //------------------------------------------------------------------------------ +function UnsafeGet(List: TList; Index: Integer): Pointer; + {$IFDEF INLINING} inline; {$ENDIF} +begin + Result := List.List[Index]; +end; +//------------------------------------------------------------------------------ + function IsOpen(e: PActive): Boolean; overload; {$IFDEF INLINING} inline; {$ENDIF} begin Result := e.locMin.isOpen; @@ -506,6 +517,22 @@ function IsSamePolyType(const e1, e2: PActive): Boolean; end; //------------------------------------------------------------------------------ +function DblToInt64(val: double): Int64; {$IFDEF INLINE} inline; {$ENDIF} +var + exp: integer; + i64: UInt64 absolute val; +begin + //https://en.wikipedia.org/wiki/Double-precision_floating-point_format + Result := 0; + if i64 = 0 then Exit; + exp := Integer(Cardinal(i64 shr 52) and $7FF) - 1023; + //nb: when exp == 1024 then val == INF or NAN. + if exp < 0 then Exit; + Result := ((i64 and $1FFFFFFFFFFFFF) shr (52 - exp)) or (UInt64(1) shl exp); + if val < 0 then Result := -Result; +end; +//------------------------------------------------------------------------------ + function GetIntersectPoint(e1, e2: PActive): TPoint64; var b1, b2, m: Double; @@ -541,10 +568,13 @@ function GetIntersectPoint(e1, e2: PActive): TPoint64; 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); + //Result.Y := Round(m); //Round(m); + Result.Y := DblToInt64(m); //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); + Result.X := DblToInt64(e1.dx * m + b1) else + Result.X := DblToInt64(e2.dx * m + b2); +// Result.X := Round(e1.dx * m + b1) else +// Result.X := Round(e2.dx * m + b2); end; end; //------------------------------------------------------------------------------ @@ -999,46 +1029,22 @@ procedure SwapFrontBackSides(outRec: POutRec); {$IFDEF INLINING} inline; {$ENDIF function EdgesAdjacentInAEL(node: PIntersectNode): Boolean; {$IFDEF INLINING} inline; {$ENDIF} -begin - with node^ do - Result := (active1.nextInAEL = active2) or (active1.prevInAEL = active2); -end; -//------------------------------------------------------------------------------ - -function IntersectListSort(node1, node2: Pointer): Integer; var - i1: PIntersectNode absolute node1; - i2: PIntersectNode absolute node2; - i: Int64; + active1, active2: PActive; begin - // note to self - can't return int64 values :) - i := i2.pt.Y - i1.pt.Y; - if (i = 0) then - begin - if (i1 = i2) then - begin - Result := 0; - Exit; - end; - // Sort by X too. Not essential, but it significantly - // speeds up the secondary sort in ProcessIntersectList . - i := i1.pt.X - i2.pt.X; - end; - - if i > 0 then Result := 1 - else if i < 0 then Result := -1 - else result := 0; + active1 := node.active1; + active2 := node.active2; + Result := (active1.nextInAEL = active2) or (active1.prevInAEL = active2); end; //------------------------------------------------------------------------------ -function TestJoinWithPrev1(e: PActive; currY: int64): Boolean; +function TestJoinWithPrev1(e: PActive): Boolean; begin // this is marginally quicker than TestJoinWithPrev2 // but can only be used when e.PrevInAEL.currX is accurate Result := IsHotEdge(e) and not IsOpen(e) and Assigned(e.prevInAEL) and (e.prevInAEL.currX = e.currX) and IsHotEdge(e.prevInAEL) and not IsOpen(e.prevInAEL) and - (currY - e.top.Y > 1) and (currY - e.prevInAEL.top.Y > 1) and (CrossProduct(e.prevInAEL.top, e.bot, e.top) = 0); end; //------------------------------------------------------------------------------ @@ -1054,14 +1060,13 @@ function TestJoinWithPrev2(e: PActive; const currPt: TPoint64): Boolean; end; //------------------------------------------------------------------------------ -function TestJoinWithNext1(e: PActive; currY: Int64): Boolean; +function TestJoinWithNext1(e: PActive): Boolean; begin // this is marginally quicker than TestJoinWithNext2 // but can only be used when e.NextInAEL.currX is accurate Result := IsHotEdge(e) and Assigned(e.nextInAEL) and IsHotEdge(e.nextInAEL) and not IsOpen(e) and not IsOpen(e.nextInAEL) and - (currY - e.top.Y > 1) and (currY - e.nextInAEL.top.Y > 1) and (e.nextInAEL.currX = e.currX) and (CrossProduct(e.nextInAEL.top, e.bot, e.top) = 0); end; @@ -1199,7 +1204,7 @@ procedure TClipperBase.Reset; end; for i := FLocMinList.Count -1 downto 0 do - InsertScanLine(PLocalMinima(FLocMinList[i]).vertex.pt.Y); + InsertScanLine(PLocalMinima(UnsafeGet(FLocMinList, i)).vertex.pt.Y); FCurrentLocMinIdx := 0; FActives := nil; FSel := nil; @@ -1216,7 +1221,7 @@ function XYCoordsEqual(const pt1, pt2: TPoint64): Boolean; procedure TClipperBase.SetZ(e1, e2: PActive; var intersectPt: TPoint64); begin - if not Assigned(FZFunc) then Exit; + if not Assigned(fZCallback) then Exit; // prioritize subject vertices over clip vertices // and pass the subject vertices before clip vertices in the callback @@ -1226,14 +1231,14 @@ procedure TClipperBase.SetZ(e1, e2: PActive; var intersectPt: TPoint64); else if (XYCoordsEqual(intersectPt, e1.top)) then intersectPt.Z := e1.top.Z else if (XYCoordsEqual(intersectPt, e2.bot)) then intersectPt.Z := e2.bot.Z else if (XYCoordsEqual(intersectPt, e2.top)) then intersectPt.Z := e2.top.Z; - FZFunc(e1.bot, e1.top, e2.bot, e2.top, intersectPt); + fZCallback(e1.bot, e1.top, e2.bot, e2.top, intersectPt); end else begin if (XYCoordsEqual(intersectPt, e2.bot)) then intersectPt.Z := e2.bot.Z else if (XYCoordsEqual(intersectPt, e2.top)) then intersectPt.Z := e2.top.Z else if (XYCoordsEqual(intersectPt, e1.bot)) then intersectPt.Z := e1.bot.Z else if (XYCoordsEqual(intersectPt, e1.top)) then intersectPt.Z := e1.top.Z; - FZFunc(e2.bot, e2.top, e1.bot, e1.top, intersectPt); + fZCallback(e2.bot, e2.top, e1.bot, e1.top, intersectPt); end; end; //------------------------------------------------------------------------------ @@ -1293,7 +1298,7 @@ function TClipperBase.PopLocalMinima(Y: Int64; begin Result := false; if FCurrentLocMinIdx = FLocMinList.Count then Exit; - localMinima := PLocalMinima(FLocMinList[FCurrentLocMinIdx]); + localMinima := PLocalMinima(UnsafeGet(FLocMinList, FCurrentLocMinIdx)); if (localMinima.vertex.pt.Y = Y) then begin inc(FCurrentLocMinIdx); @@ -1318,20 +1323,21 @@ procedure TClipperBase.DisposeScanLineList; procedure TClipperBase.DisposeOutRecsAndJoiners; var i: Integer; + outrec: POutRec; begin // just in case joiners haven't already been disposed for i := 0 to FJoinerList.Count -1 do - if Assigned(FJoinerList[i]) then - Dispose(PJoiner(FJoinerList[i])); + if Assigned(UnsafeGet(FJoinerList, i)) then + Dispose(PJoiner(UnsafeGet(FJoinerList, i))); FJoinerList.Clear; FHorzTrials := nil; for i := 0 to FOutRecList.Count -1 do - with POutRec(FOutRecList[i])^ do - begin - if Assigned(pts) then DisposeOutPts(pts); - Dispose(POutRec(FOutRecList[i])); - end; + begin + outrec := UnsafeGet(FOutRecList, i); + if Assigned(outrec.pts) then DisposeOutPts(outrec.pts); + Dispose(outrec); + end; FOutRecList.Clear; end; //------------------------------------------------------------------------------ @@ -1341,10 +1347,10 @@ procedure TClipperBase.DisposeVerticesAndLocalMinima; i: Integer; begin for i := 0 to FLocMinList.Count -1 do - Dispose(PLocalMinima(FLocMinList[i])); + Dispose(PLocalMinima(UnsafeGet(FLocMinList, i))); FLocMinList.Clear; for i := 0 to FVertexArrayList.Count -1 do - FreeMem(FVertexArrayList[i]); + FreeMem(UnsafeGet(FVertexArrayList, i)); FVertexArrayList.Clear; end; //------------------------------------------------------------------------------ @@ -1730,7 +1736,7 @@ procedure TClipperBase.InsertLocalMinimaIntoAEL(const botY: Int64); AddLocalMinPoly(leftB, rightB, leftB.bot, true); if not IsHorizontal(leftB) and - TestJoinWithPrev1(leftB, botY) then + TestJoinWithPrev1(leftB) then begin op := AddOutPt(leftB.prevInAEL, leftB.bot); AddJoin(op, leftB.outrec.pts); @@ -1745,7 +1751,7 @@ procedure TClipperBase.InsertLocalMinimaIntoAEL(const botY: Int64); end; if not IsHorizontal(rightB) and - TestJoinWithNext1(rightB, botY) then + TestJoinWithNext1(rightB) then begin op := AddOutPt(rightB.nextInAEL, rightB.bot); AddJoin(rightB.outrec.pts, op); @@ -1882,7 +1888,7 @@ procedure TClipperBase.CleanCollinear(outRec: POutRec); if (CrossProduct(op2.prev.pt, op2.pt, op2.next.pt) = 0) and (PointsEqual(op2.pt,op2.prev.pt) or PointsEqual(op2.pt,op2.next.pt) or - not preserveCollinear or + not FPreserveCollinear or (DotProduct(op2.prev.pt, op2.pt, op2.next.pt) < 0)) then begin if op2 = outRec.pts then outRec.pts := op2.prev; @@ -1914,11 +1920,11 @@ procedure TClipperBase.FixSelfIntersects(var op: POutPt); prevOp := splitOp.prev; nextNextOp := splitOp.next.next; Result := prevOp; - ip := Point64(Clipper.Core.GetIntersectPoint( + ip := Point64(Clipper.Core.GetIntersectPointD( prevOp.pt, splitOp.pt, splitOp.next.pt, nextNextOp.pt)); {$IFDEF USINGZ} - if Assigned(FZFunc) then - FZFunc(prevOp.Pt, splitOp.Pt, splitOp.Next.Pt, nextNextOp.Pt, ip.Pt); + if Assigned(fZCallback) then + fZCallback(prevOp.Pt, splitOp.Pt, splitOp.Next.Pt, nextNextOp.Pt, ip); {$ENDIF} area1 := Area(op); area2 := AreaTriangle(ip, splitOp.pt, splitOp.next.pt); @@ -1978,7 +1984,7 @@ procedure TClipperBase.FixSelfIntersects(var op: POutPt); op2 := op; while true do begin - // 3 edged polygons can't self-intersect + // triangles can't self-intersect if (op2.prev = op2.next.next) then Break else if SegmentsIntersect(op2.prev.pt, op2.pt, @@ -2245,9 +2251,9 @@ procedure TClipperBase.ProcessJoinList; begin for i := 0 to FJoinerList.Count -1 do begin - if Assigned(FJoinerList[i]) then + if Assigned(UnsafeGet(FJoinerList, i)) then begin - joiner := FJoinerList[i]; + joiner := UnsafeGet(FJoinerList, i); outrec := ProcessJoin(joiner); CleanCollinear(outRec); end; @@ -2374,7 +2380,7 @@ function CollinearSegsOverlap(const seg1a, seg1b, end; //------------------------------------------------------------------------------ -function PointBetween(const pt, corner1, corner2: TPoint64): Boolean; +function PointEqualOrBetween(const pt, corner1, corner2: TPoint64): Boolean; {$IFDEF INLINING} inline; {$ENDIF} begin // nb: points may not be collinear @@ -2383,6 +2389,15 @@ function PointBetween(const pt, corner1, corner2: TPoint64): Boolean; end; //------------------------------------------------------------------------------ +function PointBetween(const pt, corner1, corner2: TPoint64): Boolean; + {$IFDEF INLINING} inline; {$ENDIF} +begin + // nb: points may not be collinear + Result := ValueBetween(pt.X, corner1.X, corner2.X) and + ValueBetween(pt.Y, corner1.Y, corner2.Y); +end; +//------------------------------------------------------------------------------ + function CheckDisposeAdjacent(var op: POutPt; guard: POutPt; outRec: POutRec): Boolean; begin @@ -2470,7 +2485,7 @@ function TClipperBase.ProcessJoin(joiner: PJoiner): POutRec; // by inserting an extra vertex if needed if not PointsEqual(op1.prev.pt, op2.next.pt) then begin - if PointBetween(op1.prev.pt, op2.pt, op2.next.pt) then + if PointEqualOrBetween(op1.prev.pt, op2.pt, op2.next.pt) then op2.next := InsertOp(op1.prev.pt, op2) else op1.prev := InsertOp(op2.next.pt, op1.prev); end; @@ -2494,18 +2509,23 @@ function TClipperBase.ProcessJoin(joiner: PJoiner): POutRec; op1.prev := op2; op2.next := op1; - SafeDeleteOutPtJoiners(op2); - DisposeOutPt(op2); - if (or1.idx < or2.idx) then begin or1.pts := op1; or2.pts := nil; + if Assigned(or1.owner) and + (not Assigned(or2.owner) or + (or2.owner.idx < or1.owner.idx)) then + or1.owner := or2.owner; or2.owner := or1 end else begin or2.pts := op1; or1.pts := nil; + if Assigned(or2.owner) and + (not Assigned(or1.owner) or + (or1.owner.idx < or2.owner.idx)) then + or2.owner := or1.owner; or1.owner := or2; end; end; @@ -2522,7 +2542,7 @@ function TClipperBase.ProcessJoin(joiner: PJoiner): POutRec; // by inserting an extra vertex if needed if not PointsEqual(op1.next.pt, op2.prev.pt) then begin - if PointBetween(op2.prev.pt, op1.pt, op1.next.pt) then + if PointEqualOrBetween(op2.prev.pt, op1.pt, op1.next.pt) then op1.next := InsertOp(op2.prev.pt, op1) else op2.prev := InsertOp(op1.next.pt, op2.prev); end; @@ -2546,19 +2566,27 @@ function TClipperBase.ProcessJoin(joiner: PJoiner): POutRec; op1.next := op2; op2.prev := op1; - SafeDeleteOutPtJoiners(op2); - DisposeOutPt(op2); +// SafeDeleteOutPtJoiners(op2); +// DisposeOutPt(op2); if or1.idx < or2.idx then begin or1.pts := op1; or2.pts := nil; + if Assigned(or1.owner) and + (not Assigned(or2.owner) or + (or2.owner.idx < or1.owner.idx)) then + or1.owner := or2.owner; or2.owner := or1; end else begin Result := or2; or2.pts := op1; or1.pts := nil; + if Assigned(or2.owner) and + (not Assigned(or1.owner) or + (or1.owner.idx < or2.owner.idx)) then + or2.owner := or1.owner; or1.owner := or2; end; end; @@ -2662,7 +2690,7 @@ procedure TClipperBase.UpdateEdgeIntoAEL(var e: PActive); SetDx(e); if IsHorizontal(e) then Exit; InsertScanLine(e.top.Y); - if TestJoinWithPrev1(e, e.bot.Y) then + if TestJoinWithPrev1(e) then begin op1 := AddOutPt(e.prevInAEL, e.bot); op2 := AddOutPt(e, e.bot); @@ -2855,7 +2883,7 @@ function TClipperBase.IntersectEdges(e1, e2: PActive; pt: TPoint64): POutPt; begin Result := AddOutPt(e1, pt); {$IFDEF USINGZ} - SetZ(e1, e2, op.pt); + SetZ(e1, e2, Result.pt); {$ENDIF} SwapOutRecs(e1, e2); end @@ -2863,7 +2891,7 @@ function TClipperBase.IntersectEdges(e1, e2: PActive; pt: TPoint64): POutPt; begin Result := AddOutPt(e2, pt); {$IFDEF USINGZ} - SetZ(e1, e2, op.pt); + SetZ(e1, e2, Result.pt); {$ENDIF} SwapOutRecs(e1, e2); end @@ -3009,7 +3037,7 @@ procedure TClipperBase.DisposeIntersectNodes; i: Integer; begin for i := 0 to FIntersectList.Count - 1 do - Dispose(PIntersectNode(FIntersectList[i])); + Dispose(PIntersectNode(UnsafeGet(FIntersectList,i))); FIntersectList.Clear; end; //------------------------------------------------------------------------------ @@ -3137,39 +3165,72 @@ function TClipperBase.BuildIntersectList(const topY: Int64): Boolean; end; //------------------------------------------------------------------------------ +function IntersectListSort(node1, node2: Pointer): Integer; +var + pt1, pt2: PPoint64; + i: Int64; +begin + if node1 = node2 then + begin + Result := 0; + Exit; + end; + pt1 := @PIntersectNode(node1).pt; + pt2 := @PIntersectNode(node2).pt; + i := pt2.Y - pt1.Y; + // note to self - can't return int64 values :) + if i > 0 then Result := 1 + else if i < 0 then Result := -1 + else if (pt1 = pt2) then Result := 0 + else + begin + // Sort by X too. Not essential, but it significantly + // speeds up the secondary sort in ProcessIntersectList . + i := pt1.X - pt2.X; + if i > 0 then Result := 1 + else if i < 0 then Result := -1 + else Result := 0; + end; +end; +//------------------------------------------------------------------------------ + procedure TClipperBase.ProcessIntersectList; var - i, j, highI: Integer; - node: PIntersectNode; + i: Integer; + nodeQ: PIntersectNode; + nodeI, nodeJ: ^PIntersectNode; op1, op2: POutpt; begin - // The list of required intersections now needs to be processed in a specific - // order such that intersection points with the largest Y coords are processed - // before those with the smallest Y coords. However, it's critical that edges - // are adjacent at the time of intersection. + // The list of required intersections now needs to be processed in a + // specific order such that intersection points with the largest Y coords + // are processed before those with the smallest Y coords. However, + // it's critical that edges are adjacent at the time of intersection, but + // that can only be checked during processing (when edge positions change). // First we do a quicksort so that intersections will be processed - // generally from largest Y to smallest (as long as they're adjacent) + // mostly from largest Y to smallest FIntersectList.Sort(IntersectListSort); - highI := FIntersectList.Count - 1; - for i := 0 to highI do + nodeI := @FIntersectList.List[0]; + for i := 0 to FIntersectList.Count - 1 do begin - // make sure edges are adjacent, otherwise - // change the intersection order before proceeding - if not EdgesAdjacentInAEL(FIntersectList[i]) then + // during processing, make sure edges are adjacent before + // proceeding, and swapping the order if they aren't adjacent. + if not EdgesAdjacentInAEL(nodeI^) then begin - j := i + 1; - while not EdgesAdjacentInAEL(FIntersectList[j]) do inc(j); + nodeJ := nodeI; + repeat + inc(nodeJ); + until EdgesAdjacentInAEL(nodeJ^); + // now swap intersection order - node := FIntersectList[i]; - FIntersectList[i] := FIntersectList[j]; - FIntersectList[j] := node; + nodeQ := nodeI^; + nodeI^ := nodeJ^; + nodeJ^ := nodeQ; end; // now process the intersection - node := FIntersectList[i]; - with node^ do + with nodeI^^ do begin IntersectEdges(active1, active2, pt); SwapPositionsInAEL(active1, active2); @@ -3189,6 +3250,7 @@ procedure TClipperBase.ProcessIntersectList; AddJoin(op1, op2); end; end; + inc(nodeI); end; // Edges should once again be correctly ordered (left to right) in the AEL. end; @@ -3221,11 +3283,12 @@ function HorzIsSpike(horzEdge: PActive): Boolean; end; //------------------------------------------------------------------------------ -function TrimHorz(horzEdge: PActive; preserveCollinear: Boolean): Boolean; +procedure TrimHorz(horzEdge: PActive; preserveCollinear: Boolean); var pt: TPoint64; + wasTrimmed: Boolean; begin - Result := false; + wasTrimmed := false; pt := NextVertex(horzEdge).pt; while (pt.Y = horzEdge.top.Y) do begin @@ -3237,11 +3300,11 @@ function TrimHorz(horzEdge: PActive; preserveCollinear: Boolean): Boolean; horzEdge.vertTop := NextVertex(horzEdge); horzEdge.top := pt; - Result := true; + wasTrimmed := true; if IsMaxima(horzEdge) then Break; pt := NextVertex(horzEdge).pt; - end; - if (Result) then SetDx(horzEdge); // +/-infinity + end; + if wasTrimmed then SetDx(horzEdge); // +/-infinity end; //------------------------------------------------------------------------------ @@ -3597,7 +3660,7 @@ procedure TClipperBase.DoHorizontal(horzEdge: PActive); AddTrialHorzJoin(op); if not IsHorizontal(e) and - TestJoinWithPrev1(e, Y) then + TestJoinWithPrev1(e) then begin op := AddOutPt(e.prevInAEL, pt); op2 := AddOutPt(e, pt); @@ -3617,7 +3680,7 @@ procedure TClipperBase.DoHorizontal(horzEdge: PActive); AddTrialHorzJoin(op); if not IsHorizontal(e) and - TestJoinWithNext1(e, Y) then + TestJoinWithNext1(e) then begin op := AddOutPt(e, pt); op2 := AddOutPt(e.nextInAEL, pt); @@ -3672,12 +3735,12 @@ procedure TClipperBase.DoHorizontal(horzEdge: PActive); UpdateEdgeIntoAEL(horzEdge); // this is the end of an intermediate horiz. if IsOpen(horzEdge) then Exit; - if isLeftToRight and TestJoinWithNext1(horzEdge, Y) then + if isLeftToRight and TestJoinWithNext1(horzEdge) then begin op2 := AddOutPt(horzEdge.nextInAEL, horzEdge.bot); AddJoin(op, op2); end - else if not isLeftToRight and TestJoinWithPrev1(horzEdge, Y) then + else if not isLeftToRight and TestJoinWithPrev1(horzEdge) then begin op2 := AddOutPt(horzEdge.prevInAEL, horzEdge.bot); AddJoin(op2, op); @@ -3803,7 +3866,7 @@ function TClipperBase.BuildPaths(out closedPaths, openPaths: TPaths64): Boolean; SetLength(openPaths, FOutRecList.Count); for i := 0 to FOutRecList.Count -1 do begin - outRec := FOutRecList[i]; + outRec := UnsafeGet(FOutRecList, i); if not assigned(outRec.pts) then Continue; if outRec.isOpen then @@ -3840,27 +3903,36 @@ function Path1InsidePath2(const or1, or2: POutRec): Boolean; if pipResult <> pipOn then Break; op := op.next; until op = or1.pts; - Result := pipResult = pipInside; + if (pipResult = pipOn) then + begin + Result := Area(op) < Area(or2.pts); + end else + Result := pipResult = pipInside; end; //------------------------------------------------------------------------------ function GetBounds(const path: TPath64): TRect64; var i: integer; + pX, pY: PInt64; begin if Length(path) = 0 then begin Result := NullRect64; Exit; end; - result := Rect64(MaxInt64, MaxInt64, -MaxInt64, -MaxInt64); + pX := @path[0].X; + pY := @path[0].Y; + for i := 0 to High(path) do begin - if (path[i].X < result.left) then result.left := path[i].X - else if (path[i].X > result.right) then result.right := path[i].X; - if (path[i].Y < result.top) then result.top := path[i].Y - else if (path[i].Y > result.bottom) then result.bottom := path[i].Y; + + if (pX^ < result.left) then result.left := pX^; + if (pX^ > result.right) then result.right := pX^; + if (pY^ < result.top) then result.top := pY^; + if (pY^ > result.bottom) then result.bottom := pY^; + inc(pX, 2); inc(pY, 2); end; end; //------------------------------------------------------------------------------ @@ -3940,7 +4012,7 @@ procedure TClipperBase.BuildTree(polytree: TPolyPathBase; out openPaths: TPaths6 for i := 0 to FOutRecList.Count -1 do begin - outRec := FOutRecList[i]; + outRec := UnsafeGet(FOutRecList, i); if not assigned(outRec.pts) then Continue; if outRec.isOpen then @@ -3969,9 +4041,9 @@ procedure TClipperBase.BuildTree(polytree: TPolyPathBase; out openPaths: TPaths6 begin j := outRec.owner.idx; outRec.idx := j; - FOutRecList[i] := FOutRecList[j]; + FOutRecList[i] := UnsafeGet(FOutRecList, j); FOutRecList[j] := outRec; - outRec := FOutRecList[i]; + outRec := UnsafeGet(FOutRecList, i); outRec.idx := i; outRec.owner := GetRealOutRec(outRec.owner); BuildPath(outRec.pts, FReverseSolution, false, outRec.path); @@ -4001,7 +4073,7 @@ function TClipperBase.GetBounds: TRect64; Result := Rect64(MaxInt64, MaxInt64, -MaxInt64, -MaxInt64); for i := 0 to FVertexArrayList.Count -1 do begin - vStart := FVertexArrayList[i]; + vStart := UnsafeGet(FVertexArrayList, i); v := vStart; repeat if v.pt.X < Result.Left then Result.Left := v.pt.X @@ -4131,12 +4203,21 @@ destructor TPolyPathBase.Destroy; end; //------------------------------------------------------------------------------ +type + PPolyPathBase = ^TPolyPathBase; + procedure TPolyPathBase.Clear; var i: integer; + ppb: PPolyPathBase; begin + if FChildList.Count = 0 then Exit; + ppb := @FChildList.List[0]; for i := 0 to FChildList.Count -1 do - TPolyPathBase(FChildList[i]).Free; + begin + ppb^.Free; + inc(ppb); + end; FChildList.Clear; end; //------------------------------------------------------------------------------ @@ -4180,6 +4261,12 @@ function TPolyPath64.AddChild(const path: TPath64): TPolyPathBase; TPolyPath64(Result).FPath := path;; ChildList.Add(Result); end; +//------------------------------------------------------------------------------ + +function TPolyPath64.GetChild64(index: Integer): TPolyPath64; +begin + Result := TPolyPath64(GetChild(index)); +end; //------------------------------------------------------------------------------ // TClipperD methods @@ -4197,20 +4284,34 @@ constructor TClipperD.Create(roundingDecimalPrecision: integer); //------------------------------------------------------------------------------ {$IFDEF USINGZ} -procedure TClipperD.ProxyZFillFunc(const bot1, top1, bot2, top2: TPoint64; +procedure TClipperD.CheckCallback; +begin + // only when the user defined ZCallback function has been assigned + // do we assign the proxy callback ZCB to ClipperBase + if Assigned(ZCallback) then + inherited ZCallback := ZCB else + inherited ZCallback := nil; +end; +//------------------------------------------------------------------------------ + +procedure TClipperD.ZCB(const bot1, top1, bot2, top2: TPoint64; var intersectPt: TPoint64); var tmp: TPointD; begin - // de-scale coordinates + if not assigned(fZCallback) then Exit; + // de-scale (x & y) + // temporarily convert integers to their initial float values + // this will slow clipping marginally but will make it much easier + // to understand the coordinates passed to the callback function tmp := ScalePoint(intersectPt, FInvScale); - FZFuncD( + //do the callback + fZCallback( ScalePoint(bot1, FInvScale), ScalePoint(top1, FInvScale), ScalePoint(bot2, FInvScale), ScalePoint(top2, FInvScale), tmp); - // re-scale - intersectPt.Z := Round(tmp.Z * FScale); + intersectPt.Z := tmp.Z; end; //------------------------------------------------------------------------------ {$ENDIF} @@ -4275,7 +4376,6 @@ procedure TClipperD.AddClip(const pathsD: TPathsD); end; //------------------------------------------------------------------------------ -{$IFDEF USINGZ} function TClipperD.Execute(clipType: TClipType; fillRule: TFillRule; out closedSolutions: TPathsD): Boolean; var @@ -4290,13 +4390,13 @@ function TClipperD.Execute(clipType: TClipType; fillRule: TFillRule; var solClosed, solOpen: TPaths64; begin +{$IFDEF USINGZ} + CheckCallback; +{$ENDIF} closedSolutions := nil; openSolutions := nil; try try - if Assigned(ZFillFunc) then - inherited ZFillFunc := ProxyZFillFunc else - inherited ZFillFunc := nil; - ExecuteInternal(clipType, fillRule); + ExecuteInternal(clipType, fillRule, false); Result := BuildPaths(solClosed, solOpen); if not Result then Exit; closedSolutions := ScalePathsD(solClosed, FInvScale); @@ -4304,64 +4404,6 @@ function TClipperD.Execute(clipType: TClipType; fillRule: TFillRule; except Result := false; end; - finally - CleanUp; - end; -end; -//------------------------------------------------------------------------------ - -function TClipperD.Execute(clipType: TClipType; fillRule: TFillRule; - var solutionsTree: TPolyTreeD; out openSolutions: TPathsD): Boolean; -var - open_Paths: TPaths64; -begin - if not assigned(solutionsTree) then RaiseError(rsClipper_PolyTreeErr); - solutionsTree.Clear; - FUsingPolytree := true; - solutionsTree.SetScale(fScale); - openSolutions := nil; - try try - if Assigned(ZFillFunc) then - inherited ZFillFunc := ProxyZFillFunc else - inherited ZFillFunc := nil; - ExecuteInternal(clipType, fillRule); - BuildTree(solutionsTree, open_Paths); - openSolutions := ScalePathsD(open_Paths, FInvScale); - Result := true; - except - Result := false; - end; - finally - CleanUp; - end; -end; -//------------------------------------------------------------------------------ -{$ELSE} - -function TClipperD.Execute(clipType: TClipType; fillRule: TFillRule; - out closedSolutions: TPathsD): Boolean; -var - dummyP: TPathsD; -begin - Result := Execute(clipType, fillRule, closedSolutions, dummyP); -end; -//------------------------------------------------------------------------------ - -function TClipperD.Execute(clipType: TClipType; fillRule: TFillRule; - out closedSolutions, openSolutions: TPathsD): Boolean; -var - closedP, openP: TPaths64; -begin - closedSolutions := nil; - try try - ExecuteInternal(clipType, fillRule, false); - Result := BuildPaths(closedP, openP); - if not Result then Exit; - closedSolutions := ScalePathsD(closedP, FInvScale); - openSolutions := ScalePathsD(openP, FInvScale); - except - Result := false; - end; finally ClearSolution; end; @@ -4375,9 +4417,12 @@ function TClipperD.Execute(clipType: TClipType; fillRule: TFillRule; begin if not assigned(solutionsTree) then Raise EClipperLibException(rsClipper_PolyTreeErr); - +{$IFDEF USINGZ} + CheckCallback; +{$ENDIF} solutionsTree.Clear; - solutionsTree.SetScale(FScale); + FUsingPolytree := true; + solutionsTree.SetScale(fScale); openSolutions := nil; try try ExecuteInternal(clipType, fillRule, true); @@ -4391,7 +4436,6 @@ function TClipperD.Execute(clipType: TClipType; fillRule: TFillRule; ClearSolution; end; end; -{$ENDIF} //------------------------------------------------------------------------------ // TPolyPathD methods @@ -4405,6 +4449,12 @@ function TPolyPathD.AddChild(const path: TPath64): TPolyPathBase; TPolyPathD(Result).FPath := ScalePathD(path, 1/FScale); ChildList.Add(Result); end; +//------------------------------------------------------------------------------ + +function TPolyPathD.GetChildD(index: Integer): TPolyPathD; +begin + Result := TPolyPathD(GetChild(index)); +end; //------------------------------------------------------------------------------ // TPolyTreeD diff --git a/source/Clipper/Clipper.Minkowski.pas b/source/Clipper/Clipper.Minkowski.pas index 7b2399a2..da3e40be 100644 --- a/source/Clipper/Clipper.Minkowski.pas +++ b/source/Clipper/Clipper.Minkowski.pas @@ -2,8 +2,8 @@ (******************************************************************************* * Author : Angus Johnson * -* Version : Clipper2 - beta * -* Date : 20 June 2022 * +* Version : Clipper2 - ver.1.0.0 * +* Date : 3 August 2022 * * Copyright : Angus Johnson 2010-2022 * * Purpose : Minkowski Addition and Difference * * License : http://www.boost.org/LICENSE_1_0.txt * diff --git a/source/Clipper/Clipper.Offset.pas b/source/Clipper/Clipper.Offset.pas index 6593daa5..634922e6 100644 --- a/source/Clipper/Clipper.Offset.pas +++ b/source/Clipper/Clipper.Offset.pas @@ -2,11 +2,11 @@ (******************************************************************************* * Author : Angus Johnson * -* Version : Clipper2 - beta * -* Date : 23 July 2022 * +* Version : Clipper2 - ver.1.0.4 * +* Date : 25 September 2022 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2010-2022 * -* Purpose : Offset paths and clipping solutions * +* Purpose : Path Offset (Inflate/Shrink) * * License : http://www.boost.org/LICENSE_1_0.txt * *******************************************************************************) @@ -27,7 +27,7 @@ interface // etJoined : offsets both sides of a path, with joined ends // etPolygon: offsets only one side of a closed path - TPathGroup = class + TGroup = class paths : TPaths64; reversed : Boolean; joinType : TJoinType; @@ -37,7 +37,8 @@ TPathGroup = class TClipperOffset = class private - fDelta : Double; + fGrpDelta : Double; + fAbsGrpDelta : Double; fMinLenSqrd : double; fJoinType : TJoinType; fTmpLimit : Double; @@ -58,12 +59,12 @@ TClipperOffset = class procedure AddPoint(const pt: TPoint64); overload; {$IFDEF INLINING} inline; {$ENDIF} procedure DoSquare(j, k: Integer); - procedure DoMiter(j, k: Integer; cosAplus1: Double); + 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(pathGroup: TPathGroup; delta: double); + procedure DoGroupOffset(group: TGroup; groupDelta: double); procedure OffsetPolygon; procedure OffsetOpenJoined; procedure OffsetOpenPath(endType: TEndType); @@ -112,7 +113,37 @@ implementation function DotProduct(const vec1, vec2: TPointD): double; {$IFDEF INLINING} inline; {$ENDIF} begin - result := (vec1.X * vec2.X + vec1.Y * vec2.Y); + 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; //------------------------------------------------------------------------------ @@ -149,31 +180,27 @@ function GetLowestPolygonIdx(const paths: TPaths64): integer; begin p := paths[i]; for j := 0 to High(p) do - if (p[j].Y < lp.Y) then continue - else if ((p[j].Y > lp.Y) or (p[j].X < lp.X)) then - begin - Result := i; - lp := p[j]; - end; + begin + if (p[j].Y < lp.Y) or + ((p[j].Y = lp.Y) and (p[j].X >= lp.X)) then Continue; + Result := i; + lp := p[j]; + end; end; end; //------------------------------------------------------------------------------ -function CopyPaths(const paths: TPathsD): TPathsD; -var - i, len: integer; +function UnsafeGet(List: TList; Index: Integer): Pointer; + {$IFDEF INLINING} inline; {$ENDIF} begin - len := Length(paths); - SetLength(Result, len); - for i := 0 to len -1 do - Result[i] := Copy(paths[i], 0, Length(paths[i])); + Result := List.List[Index]; end; //------------------------------------------------------------------------------ -// TPathGroup methods +// TGroup methods //------------------------------------------------------------------------------ -constructor TPathGroup.Create(jt: TJoinType; et: TEndType); +constructor TGroup.Create(jt: TJoinType; et: TEndType); begin Self.joinType := jt; Self.endType := et; @@ -209,7 +236,7 @@ procedure TClipperOffset.Clear; i: integer; begin for i := 0 to fInGroups.Count -1 do - TPathGroup(fInGroups[i]).Free; + TGroup(UnsafeGet(fInGroups, i)).Free; fInGroups.Clear; fSolution := nil; end; @@ -230,62 +257,76 @@ procedure TClipperOffset.AddPath(const path: TPath64; procedure TClipperOffset.AddPaths(const paths: TPaths64; joinType: TJoinType; endType: TEndType); var - group: TPathGroup; + group: TGroup; begin if Length(paths) = 0 then Exit; - group := TPathGroup.Create(joinType, endType); + group := TGroup.Create(joinType, endType); AppendPaths(group.paths, paths); fInGroups.Add(group); end; //------------------------------------------------------------------------------ -procedure TClipperOffset.DoGroupOffset(pathGroup: TPathGroup; delta: double); +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); +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); +end; +//------------------------------------------------------------------------------ + +procedure TClipperOffset.DoGroupOffset(group: TGroup; groupDelta: double); var i, len, lowestIdx: Integer; - r, absDelta, arcTol, area, steps: Double; + r, arcTol, area, steps: Double; IsClosedPaths: Boolean; begin - if pathgroup.endType <> etPolygon then - delta := Abs(delta) * 0.5; + if group.endType <> etPolygon then + groupDelta := Abs(groupDelta) * 0.5; - IsClosedPaths := (pathgroup.endType in [etPolygon, etJoined]); + IsClosedPaths := (group.endType in [etPolygon, etJoined]); if IsClosedPaths 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(pathgroup.paths); + lowestIdx := GetLowestPolygonIdx(group.paths); if lowestIdx < 0 then Exit; // nb: don't use the default orientation here ... - area := Clipper.Core.Area(pathgroup.paths[lowestIdx]); + area := Clipper.Core.Area(group.paths[lowestIdx]); if area = 0 then Exit; - pathgroup.reversed := (area < 0); - if pathgroup.reversed then delta := -delta; + group.reversed := (area < 0); + if group.reversed then groupDelta := -groupDelta; end else - pathgroup.reversed := false; + group.reversed := false; - fDelta := delta; - absDelta := Abs(fDelta); - fJoinType := pathGroup.joinType; + fGrpDelta := groupDelta; + fAbsGrpDelta := Abs(fGrpDelta); + fJoinType := group.joinType; if fArcTolerance > 0 then arcTol := fArcTolerance else - arcTol := Log10(2 + absDelta) * 0.25; // empirically derived + arcTol := Log10(2 + fAbsGrpDelta) * 0.25; // empirically derived // calculate a sensible number of steps (for 360 deg for the given offset - if (pathgroup.joinType = jtRound) or (pathgroup.endType = etRound) then + if (group.joinType = jtRound) or (group.endType = etRound) then begin // get steps per 180 degrees (see offset_triginometry2.svg) - steps := PI / ArcCos(1 - arcTol / absDelta); + steps := PI / ArcCos(1 - arcTol / fAbsGrpDelta); fStepsPerRad := steps * InvTwoPi; end; fOutPaths := nil; - for i := 0 to High(pathgroup.paths) do + for i := 0 to High(group.paths) do begin - fInPath := StripDuplicates(pathgroup.paths[i], IsClosedPaths); + fInPath := StripDuplicates(group.paths[i], IsClosedPaths); len := Length(fInPath); if (fInPath = nil) or - ((pathGroup.endType in [etPolygon, etJoined]) and (len < 3)) then Continue; + ((group.endType in [etPolygon, etJoined]) and (len < 3)) then Continue; fNorms := nil; fOutPath := nil; @@ -294,10 +335,10 @@ procedure TClipperOffset.DoGroupOffset(pathGroup: TPathGroup; delta: double); //if a single vertex then build a circle or a square ... if len = 1 then begin - if (pathgroup.endType = etRound) then + if (group.endType = etRound) then begin - r := absDelta; - if (pathGroup.endType = etPolygon) then + r := fAbsGrpDelta; + if (group.endType = etPolygon) then r := r * 0.5; with fInPath[0] do fOutPath := Path64(Ellipse(RectD(X-r, Y-r, X+r, Y+r))); @@ -306,10 +347,10 @@ procedure TClipperOffset.DoGroupOffset(pathGroup: TPathGroup; delta: double); SetLength(fOutPath, 4); with fInPath[0] do begin - fOutPath[0] := Point64(X-fDelta,Y-fDelta); - fOutPath[1] := Point64(X+fDelta,Y-fDelta); - fOutPath[2] := Point64(X+fDelta,Y+fDelta); - fOutPath[3] := Point64(X-fDelta,Y+fDelta); + fOutPath[0] := Point64(X-fGrpDelta,Y-fGrpDelta); + fOutPath[1] := Point64(X+fGrpDelta,Y-fGrpDelta); + fOutPath[2] := Point64(X+fGrpDelta,Y+fGrpDelta); + fOutPath[3] := Point64(X-fGrpDelta,Y+fGrpDelta); end; end; AppendPath(fOutPaths, fOutPath); @@ -317,15 +358,12 @@ procedure TClipperOffset.DoGroupOffset(pathGroup: TPathGroup; delta: double); end else begin BuildNormals; - if pathgroup.endType = etPolygon then - begin - OffsetPolygon; - end - else if pathgroup.endType = etJoined then - begin - OffsetOpenJoined; - end else - OffsetOpenPath(pathgroup.endType); + if group.endType = etPolygon then + OffsetPolygon + else if group.endType = etJoined then + OffsetOpenJoined + else + OffsetOpenPath(group.endType); end; if fOutPathLen = 0 then Continue; @@ -340,9 +378,9 @@ procedure TClipperOffset.DoGroupOffset(pathGroup: TPathGroup; delta: double); try PreserveCollinear := fPreserveCollinear; // the solution should retain the orientation of the input - ReverseSolution := fReverseSolution <> pathGroup.reversed; + ReverseSolution := fReverseSolution <> group.reversed; AddSubject(fOutPaths); - if pathGroup.reversed then + if group.reversed then Execute(ctUnion, frNegative, fOutPaths) else Execute(ctUnion, frPositive, fOutPaths); finally @@ -390,67 +428,61 @@ procedure TClipperOffset.OffsetOpenJoined; //------------------------------------------------------------------------------ procedure TClipperOffset.OffsetOpenPath(endType: TEndType); - - procedure DoButtEnd(highI: integer); - begin - AddPoint(fInPath[highI].X + fNorms[highI-1].X *fDelta, - fInPath[highI].Y + fNorms[highI-1].Y * fDelta); - AddPoint(fInPath[highI].X - fNorms[highI-1].X *fDelta, - fInPath[highI].Y - fNorms[highI-1].Y * fDelta); - end; - - procedure DoButtStart; - begin - AddPoint(fInPath[0].X + fNorms[1].X *fDelta, - fInPath[0].Y + fNorms[1].Y * fDelta); - AddPoint(fInPath[0].X - fNorms[1].X *fDelta, - fInPath[0].Y - fNorms[1].Y * fDelta); - end; - var i, k, highI: integer; begin highI := high(fInPath); - k := 0; - for i := 1 to highI -1 do - OffsetPoint(i, k); - k := highI -1; - fNorms[highI].X := -fNorms[k].X; - fNorms[highI].Y := -fNorms[k].Y; - - // cap the end first ... + // do the line start cap case endType of - etButt: DoButtEnd(highI); - etRound: DoRound(highI, k, PI); - else DoSquare(highI, k); + etButt: + begin + with fInPath[0] do AddPoint(Point64( + X - fNorms[0].X * fGrpDelta, + Y - fNorms[0].Y * fGrpDelta)); + AddPoint(GetPerpendic(fInPath[0], fNorms[0], fGrpDelta)); + end; + etRound: DoRound(0,0, PI); + else DoSquare(0, 0); end; - // reverse normals ... - for i := highI -1 downto 1 do + // 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].X := -fNorms[1].X; - fNorms[0].Y := -fNorms[1].Y; - k := highI; - for i := highI -1 downto 1 do - OffsetPoint(i, k); + fNorms[0] := fNorms[highI]; - // now cap the start ... + // do the line end cap case endType of - etButt: DoButtStart; - etRound: DoRound(0, 1, PI); - else doSquare(0, 1); + etButt: + begin + with fInPath[highI] do AddPoint(Point64( + X - fNorms[highI].X *fGrpDelta, + Y - fNorms[highI].Y *fGrpDelta)); + AddPoint(GetPerpendic(fInPath[highI], fNorms[highI], fGrpDelta)); + end; + etRound: DoRound(highI,highI, PI); + else DoSquare(highI, highI); end; + + // offset the left side going back + k := 0; + for i := highI downto 1 do //and stop at 1! + OffsetPoint(i, k); end; //------------------------------------------------------------------------------ function TClipperOffset.Execute(delta: Double): TPaths64; var i: integer; - group: TPathGroup; + group: TGroup; begin fSolution := nil; Result := nil; @@ -459,10 +491,12 @@ function TClipperOffset.Execute(delta: Double): TPaths64; fMinLenSqrd := 1; if abs(delta) < Tolerance then begin - // if delta ~= 0, just copy paths to Result + // if delta == 0, just copy paths to Result for i := 0 to fInGroups.Count -1 do - with TPathGroup(fInGroups[i]) do - AppendPaths(fSolution, paths); + begin + group := TGroup(UnsafeGet(fInGroups, i)); + AppendPaths(fSolution, group.paths); + end; Result := fSolution; Exit; end; @@ -475,7 +509,7 @@ function TClipperOffset.Execute(delta: Double): TPaths64; // nb: delta will depend on whether paths are polygons or open for i := 0 to fInGroups.Count -1 do begin - group := TPathGroup(fInGroups[i]); + group := TGroup(UnsafeGet(fInGroups, i)); DoGroupOffset(group, delta); end; @@ -488,9 +522,9 @@ function TClipperOffset.Execute(delta: Double): TPaths64; // the solution should retain the orientation of the input ReverseSolution := - fReverseSolution <> TPathGroup(fInGroups[0]).reversed; + fReverseSolution <> TGroup(fInGroups[0]).reversed; AddSubject(fSolution); - if TPathGroup(fInGroups[0]).reversed then + if TGroup(UnsafeGet(fInGroups, 0)).reversed then Execute(ctUnion, frNegative, fSolution) else Execute(ctUnion, frPositive, fSolution); finally @@ -523,38 +557,100 @@ procedure TClipperOffset.AddPoint(const pt: TPoint64); end; //------------------------------------------------------------------------------ +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); +end; +//------------------------------------------------------------------------------ + procedure TClipperOffset.DoSquare(j, k: Integer); +var + vec, pt1,pt2,pt3,pt4, pt,ptQ : TPointD; 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 + if k = j then begin - AddPoint( - fInPath[j].X + fDelta * (fNorms[k].X - fNorms[k].Y), - fInPath[j].Y + fDelta * (fNorms[k].Y + fNorms[k].X)); + vec.X := fNorms[0].Y; //squaring a line end + vec.Y := -fNorms[0].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; - AddPoint( - fInPath[j].X + fDelta * (fNorms[j].X + fNorms[j].Y), - fInPath[j].Y + fDelta * (fNorms[j].Y - fNorms[j].X)); + // now offset the original vertex delta units along unit vector + ptQ := PointD(fInPath[j]); + ptQ := TranslatePoint(ptQ, fAbsGrpDelta * vec.X, fAbsGrpDelta * vec.Y); + + // get perpendicular vertices + pt1 := TranslatePoint(ptQ, fGrpDelta * vec.Y, fGrpDelta * -vec.X); + pt2 := TranslatePoint(ptQ, fGrpDelta * -vec.Y, fGrpDelta * vec.X); + + // get 2 vertices along one edge offset + pt3 := GetPerpendicD(fInPath[k], fNorms[k], fGrpDelta); + + if (j = k) then + begin + pt4.X := pt3.X + vec.X * fGrpDelta; + pt4.Y := pt3.Y + vec.Y * fGrpDelta; + // get the intersection point + pt := IntersectPoint(pt1, pt2, pt3, pt4); + with ReflectPoint(pt, ptQ) do AddPoint(X, Y); + AddPoint(pt.X, pt.Y); end else begin - AddPoint( - fInPath[j].X + fDelta * (fNorms[k].X + fNorms[k].Y), - fInPath[j].Y + fDelta * (fNorms[k].Y - fNorms[k].X)); - AddPoint( - fInPath[j].X + fDelta * (fNorms[j].X - fNorms[j].Y), - fInPath[j].Y + fDelta * (fNorms[j].Y + fNorms[j].X)); + pt4 := GetPerpendicD(fInPath[j], fNorms[k], fGrpDelta); + // get the intersection point + pt := IntersectPoint(pt1, pt2, pt3, pt4); + AddPoint(pt.X, pt.Y); + //get the second intersect point through reflecion + with ReflectPoint(pt, ptQ) do AddPoint(X, Y); end; end; //------------------------------------------------------------------------------ -procedure TClipperOffset.DoMiter(j, k: Integer; cosAplus1: Double); +procedure TClipperOffset.DoMiter(j, k: Integer; cosA: Double); var q: Double; begin // see offset_triginometry4.svg - q := fDelta / cosAplus1; + q := fGrpDelta / (cosA +1); AddPoint(fInPath[j].X + (fNorms[k].X + fNorms[j].X)*q, fInPath[j].Y + (fNorms[k].Y + fNorms[j].Y)*q); end; @@ -565,75 +661,69 @@ procedure TClipperOffset.DoRound(j, k: Integer; angle: double); i, steps: Integer; stepSin, stepCos: double; pt: TPoint64; - pt2: TPointD; + pt2: TPointD; begin - // even though angle may be negative this is a convex join + // nb: even though angle may be negative this is a convex join pt := fInPath[j]; - pt2 := PointD(fNorms[k].X * fDelta, fNorms[k].Y * fDelta); - AddPoint(pt.X + pt2.X, pt.Y + pt2.Y); - - steps := Round(fStepsPerRad * abs(angle) + 0.501); + pt2 := PointD(fNorms[k].X * fGrpDelta, fNorms[k].Y * fGrpDelta); + if j = k then pt2 := Negate(pt2); + steps := Ceil(fStepsPerRad * abs(angle)); GetSinCos(angle / steps, stepSin, stepCos); + AddPoint(pt.X + pt2.X, pt.Y + pt2.Y); for i := 0 to steps -1 do begin pt2 := PointD(pt2.X * stepCos - stepSin * pt2.Y, pt2.X * stepSin + pt2.Y * stepCos); AddPoint(pt.X + pt2.X, pt.Y + pt2.Y); end; - pt2 := PointD(fNorms[j].X * fDelta, fNorms[j].Y * fDelta); - AddPoint(pt.X + pt2.X, pt.Y + pt2.Y); + AddPoint(GetPerpendic(pt, fNorms[j], fGrpDelta)); end; //------------------------------------------------------------------------------ procedure TClipperOffset.OffsetPoint(j: Integer; var k: integer); var sinA, cosA: Double; - p1, p2: TPoint64; + almostNoAngle: Boolean; 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); + 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 sinA * fDelta < 0 then // ie a concave offset + almostNoAngle := ValueAlmostZero(cosA - 1); + // when there's almost no angle of deviation or it's concave + if almostNoAngle or (sinA * fGrpDelta < 0) then begin - p1 := Point64( - fInPath[j].X + fNorms[k].X * fDelta, - fInPath[j].Y + fNorms[k].Y * fDelta); - p2:= Point64( - fInPath[j].X + fNorms[j].X * fDelta, - fInPath[j].Y + fNorms[j].Y * fDelta); - AddPoint(p1); - if not PointsEqual(p1, p2) then - begin - AddPoint(fInPath[j]); // this aids with clipping removal later - AddPoint(p2); - end; - end else + //concave + AddPoint(GetPerpendic(fInPath[j], fNorms[k], fGrpDelta)); + // create a simple self-intersection that will be cleaned up later + if not almostNoAngle then AddPoint(fInPath[j]); + AddPoint(GetPerpendic(fInPath[j], fNorms[j], fGrpDelta)); + end + else // convex offset begin - cosA := DotProduct(fNorms[j], fNorms[k]); - // convex offsets here ... - case fJoinType of - jtMiter: - // see offset_triginometry3.svg - if (1 + cosA < fTmpLimit) then - DoSquare(j, k) else - DoMiter(j, k, 1 + cosA); - jtSquare: - begin - // angles >= 90 deg. don't need squaring - if cosA >= 0 then - DoMiter(j, k, 1 + cosA) else - DoSquare(j, k); - end - else - DoRound(j, k, ArcTan2(sinA, cosA)); - end; + if (fJoinType = jtRound) then + DoRound(j, k, ArcTan2(sinA, cosA)) + // only miter when the angle isn't too acute (and exceeds ML) + else if (fJoinType = jtMiter) and (cosA > fTmpLimit -1) then + DoMiter(j, k, cosA) + // only do squaring when the angle of deviation > 90 degrees + else if (cosA < -0.001) then + DoSquare(j, k) + else + // don't square shallow angles that are safe to miter + DoMiter(j, k, cosA); end; k := j; end; diff --git a/source/Clipper/Clipper.pas b/source/Clipper/Clipper.pas index 6132285b..f4fba660 100644 --- a/source/Clipper/Clipper.pas +++ b/source/Clipper/Clipper.pas @@ -2,8 +2,8 @@ (******************************************************************************* * Author : Angus Johnson * -* Version : Clipper2 - beta * -* Date : 27 July 2022 * +* Version : Clipper2 - ver.1.0.3 * +* Date : 20 August 2022 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2010-2022 * * Purpose : This module provides a simple interface to the Clipper Library * @@ -56,12 +56,12 @@ interface ctDifference = Clipper.Core.ctDifference; ctXor = Clipper.Core.ctXor; -function BooleanOp(clipType: TClipType; fillRule: TFillRule; - const subjects, clips: TPaths64): TPaths64; overload; -function BooleanOp(clipType: TClipType; fillRule: TFillRule; - const subjects, clips: TPathsD; decimalPrec: integer = 2): TPathsD; overload; -procedure BooleanOp(clipType: TClipType; fillRule: TFillRule; - const subjects, clips: TPaths64; polytree: TPolyTree64); overload; +function BooleanOp(clipType: TClipType; + const subjects, clips: TPaths64; fillRule: TFillRule): TPaths64; overload; +function BooleanOp(clipType: TClipType; const subjects, clips: + TPathsD; fillRule: TFillRule; decimalPrec: integer = 2): TPathsD; overload; +procedure BooleanOp(clipType: TClipType; const subjects, clips: TPaths64; + fillRule: TFillRule; polytree: TPolyTree64); overload; function Intersect(const subjects, clips: TPaths64; fillRule: TFillRule): TPaths64; overload; @@ -92,19 +92,24 @@ function InflatePaths(const paths: TPathsD; delta: Double; jt: TJoinType = jtRound; et: TEndType = etPolygon; miterLimit: double = 2.0; precision: integer = 2): TPathsD; overload; +function TranslatePath(const path: TPath64; dx, dy: Int64): TPath64; overload; +function TranslatePath(const path: TPathD; dx, dy: double): TPathD; overload; +function TranslatePaths(const paths: TPaths64; dx, dy: Int64): TPaths64; overload; +function TranslatePaths(const paths: TPathsD; dx, dy: double): TPathsD; overload; + function MinkowskiSum(const pattern, path: TPath64; pathIsClosed: Boolean): TPaths64; -function PolyTreeToPaths(PolyTree: TPolyTree64): TPaths64; -function PolyTreeDToPathsD(PolyTree: TPolyTreeD): TPathsD; +function PolyTreeToPaths64(PolyTree: TPolyTree64): TPaths64; +function PolyTreeToPathsD(PolyTree: TPolyTreeD): TPathsD; function MakePath(const ints: TArrayOfInteger): TPath64; overload; function MakePath(const dbls: TArrayOfDouble): TPathD; overload; function TrimCollinear(const p: TPath64; - is_open_path: Boolean = false): TPath64; overload; + isOpenPath: Boolean = false): TPath64; overload; function TrimCollinear(const path: TPathD; - precision: integer; is_open_path: Boolean = false): TPathD; overload; + precision: integer; isOpenPath: Boolean = false): TPathD; overload; function PointInPolygon(const pt: TPoint64; const polygon: TPath64): TPointInPolygonResult; @@ -155,12 +160,12 @@ procedure AddPolyNodeToPaths(Poly: TPolyPath64; var Paths: TPaths64); SetLength(Paths, i +1); Paths[i] := Poly.Polygon; end; - for i := 0 to Poly.ChildCount - 1 do - AddPolyNodeToPaths(TPolyPath64(Poly.Child[i]), Paths); + for i := 0 to Poly.Count - 1 do + AddPolyNodeToPaths(Poly[i], Paths); end; //------------------------------------------------------------------------------ -function PolyTreeToPaths(PolyTree: TPolyTree64): TPaths64; +function PolyTreeToPaths64(PolyTree: TPolyTree64): TPaths64; begin Result := nil; AddPolyNodeToPaths(PolyTree, Result); @@ -177,12 +182,12 @@ procedure AddPolyNodeToPathsD(Poly: TPolyPathD; var Paths: TPathsD); SetLength(Paths, i +1); Paths[i] := Poly.Polygon; end; - for i := 0 to Poly.ChildCount - 1 do - AddPolyNodeToPathsD(TPolyPathD(Poly.Child[i]), Paths); + for i := 0 to Poly.Count - 1 do + AddPolyNodeToPathsD(Poly[i], Paths); end; //------------------------------------------------------------------------------ -function PolyTreeDToPathsD(PolyTree: TPolyTreeD): TPathsD; +function PolyTreeToPathsD(PolyTree: TPolyTreeD): TPathsD; begin Result := nil; AddPolyNodeToPathsD(PolyTree, Result); @@ -190,8 +195,8 @@ function PolyTreeDToPathsD(PolyTree: TPolyTreeD): TPathsD; //------------------------------------------------------------------------------ //------------------------------------------------------------------------------ -function BooleanOp(clipType: TClipType; fillRule: TFillRule; - const subjects, clips: TPaths64): TPaths64; +function BooleanOp(clipType: TClipType; + const subjects, clips: TPaths64; fillRule: TFillRule): TPaths64; begin with TClipper64.Create do try @@ -204,8 +209,8 @@ function BooleanOp(clipType: TClipType; fillRule: TFillRule; end; //------------------------------------------------------------------------------ -function BooleanOp(clipType: TClipType; fillRule: TFillRule; - const subjects, clips: TPathsD; decimalPrec: integer = 2): TPathsD; +function BooleanOp(clipType: TClipType; const subjects, clips: TPathsD; + fillRule: TFillRule; decimalPrec: integer = 2): TPathsD; begin with TClipperD.Create(decimalPrec) do try @@ -218,8 +223,8 @@ function BooleanOp(clipType: TClipType; fillRule: TFillRule; end; //------------------------------------------------------------------------------ -procedure BooleanOp(clipType: TClipType; fillRule: TFillRule; - const subjects, clips: TPaths64; polytree: TPolyTree64); +procedure BooleanOp(clipType: TClipType; const subjects, clips: TPaths64; + fillRule: TFillRule; polytree: TPolyTree64); var dummy: TPaths64; begin @@ -236,66 +241,66 @@ procedure BooleanOp(clipType: TClipType; fillRule: TFillRule; function Intersect(const subjects, clips: TPaths64; fillRule: TFillRule): TPaths64; begin - Result := BooleanOp(ctIntersection, fillRule, subjects, clips); + Result := BooleanOp(ctIntersection, subjects, clips, fillRule); end; //------------------------------------------------------------------------------ function Union(const subjects, clips: TPaths64; fillRule: TFillRule): TPaths64; begin - Result := BooleanOp(ctUnion, fillRule, subjects, clips); + Result := BooleanOp(ctUnion, subjects, clips, fillRule); end; //------------------------------------------------------------------------------ function Union(const subjects: TPaths64; fillRule: TFillRule): TPaths64; begin - Result := BooleanOp(ctUnion, fillRule, subjects, nil); + Result := BooleanOp(ctUnion, subjects, nil, fillRule); end; //------------------------------------------------------------------------------ function Difference(const subjects, clips: TPaths64; fillRule: TFillRule): TPaths64; begin - Result := BooleanOp(ctDifference, fillRule, subjects, clips); + Result := BooleanOp(ctDifference, subjects, clips, fillRule); end; //------------------------------------------------------------------------------ function XOR_(const subjects, clips: TPaths64; fillRule: TFillRule): TPaths64; begin - Result := BooleanOp(ctXor, fillRule, subjects, clips); + Result := BooleanOp(ctXor, subjects, clips, fillRule); end; //------------------------------------------------------------------------------ function Intersect(const subjects, clips: TPathsD; fillRule: TFillRule; decimalPrec: integer = 2): TPathsD; begin - Result := BooleanOp(ctIntersection, fillRule, subjects, clips, decimalPrec); + Result := BooleanOp(ctIntersection, subjects, clips, fillRule, decimalPrec); end; //------------------------------------------------------------------------------ function Union(const subjects, clips: TPathsD; fillRule: TFillRule; decimalPrec: integer = 2): TPathsD; begin - Result := BooleanOp(ctUnion, fillRule, subjects, clips, decimalPrec); + Result := BooleanOp(ctUnion, subjects, clips, fillRule, decimalPrec); end; //------------------------------------------------------------------------------ function Union(const subjects: TPathsD; fillRule: TFillRule; decimalPrec: integer = 2): TPathsD; begin - Result := BooleanOp(ctUnion, fillRule, subjects, nil, decimalPrec); + Result := BooleanOp(ctUnion, subjects, nil, fillRule, decimalPrec); end; //------------------------------------------------------------------------------ function Difference(const subjects, clips: TPathsD; fillRule: TFillRule; decimalPrec: integer = 2): TPathsD; begin - Result := BooleanOp(ctDifference, fillRule, subjects, clips, decimalPrec); + Result := BooleanOp(ctDifference, subjects, clips, fillRule, decimalPrec); end; //------------------------------------------------------------------------------ function XOR_(const subjects, clips: TPathsD; fillRule: TFillRule; decimalPrec: integer = 2): TPathsD; begin - Result := BooleanOp(ctXor, fillRule, subjects, clips, decimalPrec); + Result := BooleanOp(ctXor, subjects, clips, fillRule, decimalPrec); end; //------------------------------------------------------------------------------ //------------------------------------------------------------------------------ @@ -340,6 +345,60 @@ function InflatePaths(const paths: TPathsD; delta: Double; end; //------------------------------------------------------------------------------ +function TranslatePath(const path: TPath64; dx, dy: Int64): TPath64; +var + i, len: integer; +begin + len := length(path); + setLength(result, len); + for i := 0 to len -1 do + begin + result[i].x := path[i].x + dx; + result[i].y := path[i].y + dy; + end; +end; +//------------------------------------------------------------------------------ + +function TranslatePath(const path: TPathD; dx, dy: double): TPathD; +var + i, len: integer; +begin + len := length(path); + setLength(result, len); + for i := 0 to len -1 do + begin + result[i].x := path[i].x + dx; + result[i].y := path[i].y + dy; + end; +end; +//------------------------------------------------------------------------------ + +function TranslatePaths(const paths: TPaths64; dx, dy: Int64): TPaths64; +var + i, len: integer; +begin + len := length(paths); + setLength(result, len); + for i := 0 to len -1 do + begin + result[i] := TranslatePath(paths[i], dx, dy); + end; +end; +//------------------------------------------------------------------------------ + +function TranslatePaths(const paths: TPathsD; dx, dy: double): TPathsD; +var + i, len: integer; +begin + len := length(paths); + setLength(result, len); + for i := 0 to len -1 do + begin + result[i] := TranslatePath(paths[i], dx, dy); + end; +end; +//------------------------------------------------------------------------------ + function MinkowskiSum(const pattern, path: TPath64; pathIsClosed: Boolean): TPaths64; begin @@ -347,14 +406,14 @@ function MinkowskiSum(const pattern, path: TPath64; end; //------------------------------------------------------------------------------ -function TrimCollinear(const p: TPath64; is_open_path: Boolean = false): TPath64; +function TrimCollinear(const p: TPath64; isOpenPath: Boolean = false): TPath64; var i,j, len: integer; begin len := Length(p); i := 0; - if not is_open_path then + if not isOpenPath then begin while (i < len -1) and (CrossProduct(p[len -1], p[i], p[i+1]) = 0) do inc(i); @@ -363,7 +422,7 @@ function TrimCollinear(const p: TPath64; is_open_path: Boolean = false): TPath64 end; if (len - i < 3) then begin - if not is_open_path or (len < 2) or PointsEqual(p[0], p[1]) then + if not isOpenPath or (len < 2) or PointsEqual(p[0], p[1]) then Result := nil else Result := p; Exit; @@ -380,7 +439,7 @@ function TrimCollinear(const p: TPath64; is_open_path: Boolean = false): TPath64 result[j] := p[i]; end; - if is_open_path then + if isOpenPath then begin inc(j); result[j] := p[len-1]; @@ -400,14 +459,14 @@ function TrimCollinear(const p: TPath64; is_open_path: Boolean = false): TPath64 //------------------------------------------------------------------------------ function TrimCollinear(const path: TPathD; - precision: integer; is_open_path: Boolean = false): TPathD; + precision: integer; isOpenPath: Boolean = false): TPathD; var p: TPath64; scale: double; begin scale := power(10, precision); p := ScalePath(path, scale); - p := TrimCollinear(p, is_open_path); + p := TrimCollinear(p, isOpenPath); Result := ScalePathD(p, 1/scale); end; //------------------------------------------------------------------------------ diff --git a/source/Img32.CQ.pas b/source/Img32.CQ.pas index 5f1e1927..c4083429 100644 --- a/source/Img32.CQ.pas +++ b/source/Img32.CQ.pas @@ -2,8 +2,8 @@ (******************************************************************************* * Author : Angus Johnson * -* Version : 4.2 * -* Date : 30 May 2022 * +* Version : 4.3 * +* Date : 27 September 2022 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2019-2021 * * Purpose : Color reduction for TImage32 * diff --git a/source/Img32.Clipper2.pas b/source/Img32.Clipper2.pas index d4658c9c..5d17b61a 100644 --- a/source/Img32.Clipper2.pas +++ b/source/Img32.Clipper2.pas @@ -2,8 +2,8 @@ (******************************************************************************* * Author : Angus Johnson * -* Version : 4.2 * -* Date : 30 May 2022 * +* Version : 4.3 * +* Date : 27 September 2022 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2019-2022 * * Purpose : Wrapper module for the Clipper library * diff --git a/source/Img32.Draw.pas b/source/Img32.Draw.pas index f6d9d3a5..ecff1923 100644 --- a/source/Img32.Draw.pas +++ b/source/Img32.Draw.pas @@ -2,8 +2,8 @@ (******************************************************************************* * Author : Angus Johnson * -* Version : 4.2 * -* Date : 30 May 2022 * +* Version : 4.3 * +* Date : 27 September 2022 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2019-2021 * * * @@ -1025,25 +1025,23 @@ procedure Rasterize(const paths: TPathsD; const clipRec: TRect; begin byteBuffer[j] := Min(255, Round(Abs(accum) * 318)); end; - frPositive: - begin {$IFDEF REVERSE_ORIENTATION} - if accum < -0.002 then - byteBuffer[j] := Min(255, Round(-accum * 318)); + frPositive: {$ELSE} - if accum > 0.002 then - byteBuffer[j] := Min(255, Round(accum * 318)); -{$ENDIF} - end; frNegative: +{$ENDIF} begin -{$IFDEF REVERSE_ORIENTATION} if accum > 0.002 then byteBuffer[j] := Min(255, Round(accum * 318)); + end; +{$IFDEF REVERSE_ORIENTATION} + frNegative: {$ELSE} + frPositive: +{$ENDIF} + begin if accum < -0.002 then byteBuffer[j] := Min(255, Round(-accum * 318)); -{$ENDIF} end; end; end; diff --git a/source/Img32.Extra.pas b/source/Img32.Extra.pas index a81620f3..2818fb12 100644 --- a/source/Img32.Extra.pas +++ b/source/Img32.Extra.pas @@ -2,8 +2,8 @@ (******************************************************************************* * Author : Angus Johnson * -* Version : 4.2 * -* Date : 28 July 2022 * +* Version : 4.3 * +* Date : 27 September 2022 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2019-2021 * * * diff --git a/source/Img32.FMX.pas b/source/Img32.FMX.pas index aa809344..80c96b3b 100644 --- a/source/Img32.FMX.pas +++ b/source/Img32.FMX.pas @@ -2,8 +2,8 @@ (******************************************************************************* * Author : Angus Johnson * -* Version : 4.2 * -* Date : 30 May 2022 * +* Version : 4.3 * +* Date : 27 September 2022 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2019-2022 * * Purpose : Image file format support for TImage32 and FMX * @@ -20,6 +20,7 @@ interface FMX.Platform, FMX.Types, FMX.Surfaces, FMX.Graphics, Img32; type + TImageFormat_FMX = class(TImageFormat) private fExt: string; @@ -119,7 +120,6 @@ procedure TImageFormat_FMX.SaveToStream(stream: TStream; img32: TImage32); try surf.SetSize(img32.Width, img32.Height, TPixelFormat.BGRA); Move(img32.PixelBase^, surf.Scanline[0]^, img32.Width * img32.Height * 4); - if Ext = '' then cm.SaveToStream(stream, surf, 'PNG') else cm.SaveToStream(stream, surf, Ext); @@ -138,7 +138,6 @@ class function TImageFormat_FMX.CopyToClipboard(img32: TImage32): Boolean; Result := assigned(img32) and not img32.IsEmpty and TPlatformServices.Current.SupportsPlatformService(IFMXClipboardService, svc); if not Result then Exit; - surf := TBitmapSurface.Create; try surf.SetSize(img32.Width, img32.Height, TPixelFormat.BGRA); @@ -162,7 +161,6 @@ class function TImageFormat_FMX.CanPasteFromClipboard: Boolean; end else Result := false; end; - //------------------------------------------------------------------------------ class function TImageFormat_FMX.PasteFromClipboard(img32: TImage32): Boolean; @@ -175,10 +173,8 @@ class function TImageFormat_FMX.PasteFromClipboard(img32: TImage32): Boolean; if not assigned(img32) or not TPlatformServices.Current.SupportsPlatformService( IFMXClipboardService, svc) then Exit; - value := svc.GetClipboard; if not Value.IsObject then Exit; - if Value.IsType and ((Value.AsType.PixelFormat = TPixelFormat.RGBA) or (Value.AsType.PixelFormat = TPixelFormat.BGRA)) then @@ -198,8 +194,8 @@ procedure AssignImage32ToFmxBitmap(img: TImage32; bmp: TBitmap); src, dst: TBitmapData; //TBitmapData is a record. begin if not Assigned(img) or not Assigned(bmp) then Exit; - - src := TBitmapData.Create(img.Width, img.Height, TPixelFormat.BGRA); + //src := TBitmapData.Create(img.Width, img.Height, TPixelFormat.BGRA); + src := TBitmapData.Create(img.Width, img.Height, TPixelFormat.RGBA); src.Data := img.PixelBase; src.Pitch := img.Width * 4; bmp.SetSize(img.Width, img.Height); @@ -210,9 +206,9 @@ procedure AssignImage32ToFmxBitmap(img: TImage32; bmp: TBitmap); bmp.Unmap(dst); end; end; + //------------------------------------------------------------------------------ //------------------------------------------------------------------------------ - procedure CheckScreenScale; var ScreenService: IFMXScreenService; @@ -237,4 +233,3 @@ initialization {$ENDIF} end. - diff --git a/source/Img32.Fmt.BMP.pas b/source/Img32.Fmt.BMP.pas index 2990eb99..c35a66e5 100644 --- a/source/Img32.Fmt.BMP.pas +++ b/source/Img32.Fmt.BMP.pas @@ -2,8 +2,8 @@ (******************************************************************************* * Author : Angus Johnson * -* Version : 4.2 * -* Date : 30 May 2022 * +* Version : 3.0 * +* Date : 20 July 2021 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2019-2021 * * Purpose : BMP file format extension for TImage32 * diff --git a/source/Img32.Fmt.GIF.pas b/source/Img32.Fmt.GIF.pas index dc148063..c841b1f6 100644 --- a/source/Img32.Fmt.GIF.pas +++ b/source/Img32.Fmt.GIF.pas @@ -1,30 +1,23 @@ unit Img32.Fmt.GIF; - (******************************************************************************* * Author : Angus Johnson * -* Version : 4.2 * -* Date : 30 May 2022 * +* Version : 4.3 * +* Date : 27 September 2022 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2019-2022 * * Purpose : GIF file format extension for TImage32 * * License : http://www.boost.org/LICENSE_1_0.txt * *******************************************************************************) - interface - {$I Img32.inc} - {$IF COMPILERVERSION = 15} implementation {$ELSE} - uses - SysUtils, Classes, Windows, Math, - Img32, Graphics, + SysUtils, Classes, Windows, Math, Img32, + {$IFDEF USES_NAMESPACES} Vcl.Graphics, {$ELSE}Graphics, {$ENDIF} {$IFDEF DELPHI_GIF} GifImg {$ELSE} GifImage {$ENDIF}; - type - TImageFormat_GIF = class(TImageFormat) public class function IsValidImageStream(stream: TStream): Boolean; override; @@ -34,13 +27,10 @@ TImageFormat_GIF = class(TImageFormat) class function CanPasteFromClipboard: Boolean; override; class function PasteFromClipboard(img32: TImage32): Boolean; override; end; - implementation - //------------------------------------------------------------------------------ // Loading (reading) GIF images from file ... //------------------------------------------------------------------------------ - class function TImageFormat_GIF.IsValidImageStream(stream: TStream): Boolean; var savedPos: integer; @@ -54,7 +44,6 @@ class function TImageFormat_GIF.IsValidImageStream(stream: TStream): Boolean; result := flag = $38464947; end; //------------------------------------------------------------------------------ - function TImageFormat_GIF.LoadFromStream(stream: TStream; img32: TImage32): Boolean; var gif: TGIFImage; @@ -105,11 +94,9 @@ function TImageFormat_GIF.LoadFromStream(stream: TStream; img32: TImage32): Bool bmpT.Free; end; end; - //------------------------------------------------------------------------------ // Saving (writing) gif images to file ... //------------------------------------------------------------------------------ - procedure TImageFormat_GIF.SaveToStream(stream: TStream; img32: TImage32); var gif: TGIFImage; @@ -134,27 +121,22 @@ procedure TImageFormat_GIF.SaveToStream(stream: TStream; img32: TImage32); end; end; //------------------------------------------------------------------------------ - class function TImageFormat_GIF.CopyToClipboard(img32: TImage32): Boolean; begin result := false; //not implemented end; //------------------------------------------------------------------------------ - class function TImageFormat_GIF.CanPasteFromClipboard: Boolean; begin result := false; end; //------------------------------------------------------------------------------ - class function TImageFormat_GIF.PasteFromClipboard(img32: TImage32): Boolean; begin result := false; //not implemented end; - //------------------------------------------------------------------------------ //------------------------------------------------------------------------------ - initialization TImage32.RegisterImageFormatClass('GIF', TImageFormat_GIF, cpLow); @@ -162,6 +144,3 @@ initialization end. - - - diff --git a/source/Img32.Fmt.JPG.pas b/source/Img32.Fmt.JPG.pas index 019f6a42..4fcb8abc 100644 --- a/source/Img32.Fmt.JPG.pas +++ b/source/Img32.Fmt.JPG.pas @@ -2,8 +2,8 @@ (******************************************************************************* * Author : Angus Johnson * -* Version : 4.0 * -* Date : 22 December 2021 * +* Version : 4.3 * +* Date : 27 September 2022 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2019-2021 * * Purpose : JPG/JPEG file format extension for TImage32 * diff --git a/source/Img32.Fmt.PNG.pas b/source/Img32.Fmt.PNG.pas index eb4ad5fe..39e44789 100644 --- a/source/Img32.Fmt.PNG.pas +++ b/source/Img32.Fmt.PNG.pas @@ -2,8 +2,8 @@ (******************************************************************************* * Author : Angus Johnson * -* Version : 4.0 * -* Date : 10 January 2022 * +* Version : 4.3 * +* Date : 27 September 2022 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2019-2022 * * Purpose : PNG file format extension for TImage32 * diff --git a/source/Img32.Fmt.QOI.pas b/source/Img32.Fmt.QOI.pas index aa65ab89..671c9691 100644 --- a/source/Img32.Fmt.QOI.pas +++ b/source/Img32.Fmt.QOI.pas @@ -1,8 +1,8 @@ unit Img32.Fmt.QOI; (******************************************************************************* * Author : Angus Johnson * -* Version : 4.2 * -* Date : 30 May 2022 * +* Version : 4.3 * +* Date : 27 September 2022 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2019-2022 * * Purpose : QOI file format extension for TImage32 * diff --git a/source/Img32.Fmt.SVG.pas b/source/Img32.Fmt.SVG.pas index 106949b0..92667a98 100644 --- a/source/Img32.Fmt.SVG.pas +++ b/source/Img32.Fmt.SVG.pas @@ -2,8 +2,8 @@ (******************************************************************************* * Author : Angus Johnson * -* Version : 4.2 * -* Date : 30 May 2022 * +* Version : 4.3 * +* Date : 27 September 2022 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2019-2022 * * Purpose : SVG file format extension for TImage32 * diff --git a/source/Img32.Layers.pas b/source/Img32.Layers.pas index 47f64e43..49c00112 100644 --- a/source/Img32.Layers.pas +++ b/source/Img32.Layers.pas @@ -2,8 +2,8 @@ (******************************************************************************* * Author : Angus Johnson * -* Version : 4.2 * -* Date : 28 July 2022 * +* Version : 4.3 * +* Date : 27 September 2022 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2019-2022 * * * diff --git a/source/Img32.Resamplers.pas b/source/Img32.Resamplers.pas index 213ee126..ab66f013 100644 --- a/source/Img32.Resamplers.pas +++ b/source/Img32.Resamplers.pas @@ -2,8 +2,8 @@ (******************************************************************************* * Author : Angus Johnson * -* Version : 4.2 * -* Date : 30 May 2022 * +* Version : 4.3 * +* Date : 27 September 2022 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2019-2021 * * Purpose : For image transformations (scaling, rotating etc.) * @@ -15,7 +15,7 @@ interface {$I Img32.inc} uses - SysUtils, Classes, Types, Img32; + SysUtils, Classes, Img32; //BoxDownSampling: As the name implies, this routine is only intended for //image down-sampling (ie when shrinking images) where it generally performs @@ -34,7 +34,7 @@ function BicubicResample(img: TImage32; x256, y256: Integer): TColor32; implementation uses - Img32.Vector, Img32.Transform; + Img32.Transform; //------------------------------------------------------------------------------ // NearestNeighbor resampler @@ -422,5 +422,3 @@ initialization DefaultResampler := rBilinearResampler; end. - - diff --git a/source/Img32.SVG.Core.pas b/source/Img32.SVG.Core.pas index a8b1edca..4df66c03 100644 --- a/source/Img32.SVG.Core.pas +++ b/source/Img32.SVG.Core.pas @@ -2,8 +2,8 @@ (******************************************************************************* * Author : Angus Johnson * -* Version : 4.2 * -* Date : 2 July 2022 * +* Version : 4.3 * +* Date : 27 September 2022 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2019-2022 * * * diff --git a/source/Img32.SVG.Path.pas b/source/Img32.SVG.Path.pas index 2e3ffa2f..abd95598 100644 --- a/source/Img32.SVG.Path.pas +++ b/source/Img32.SVG.Path.pas @@ -2,8 +2,8 @@ (******************************************************************************* * Author : Angus Johnson * -* Version : 4.2 * -* Date : 30 May 2022 * +* Version : 4.0 * +* Date : 28 December 2021 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2019-2021 * * * @@ -21,7 +21,7 @@ interface uses SysUtils, Classes, Types, Math, {$IFDEF XPLAT_GENERICS} Generics.Collections, Generics.Defaults,{$ENDIF} - Img32, Img32.SVG.Core, Img32.Vector, Img32.Text, Img32.Transform; + Img32, Img32.SVG.Core, Img32.Vector, Img32.Text; {$IFDEF ZEROBASEDSTR} {$ZEROBASEDSTRINGS OFF} @@ -276,10 +276,7 @@ implementation resourcestring rsSvgPathRangeError = 'TSvgPath.GetPath range error'; rsSvgSubPathRangeError = 'TSvgSubPath.GetSeg range error'; - rsSvgSegmentRangeError = 'TSvgSegment.GetVal range error'; - -const - buffSize = 8; + //rsSvgSegmentRangeError = 'TSvgSegment.GetVal range error'; //------------------------------------------------------------------------------ // Miscellaneous functions ... @@ -1217,7 +1214,7 @@ function TSvgSubPath.GetSimplePath: TPathD; var i: integer; begin - Result := MakePath([GetFirstPt.X, GetFirstPt.Y]); + Result := Img32.Vector.MakePath([GetFirstPt.X, GetFirstPt.Y]); for i := 0 to High(fSegs) do AppendPath(Result, fSegs[i].GetOnPathCtrlPts); end; diff --git a/source/Img32.SVG.Reader.pas b/source/Img32.SVG.Reader.pas index 6fe1ac0d..d988dad6 100644 --- a/source/Img32.SVG.Reader.pas +++ b/source/Img32.SVG.Reader.pas @@ -2,8 +2,8 @@ (******************************************************************************* * Author : Angus Johnson * -* Version : 4.0 * -* Date : 10 January 2022 * +* Version : 4.3 * +* Date : 27 September 2022 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2019-2022 * * * @@ -4721,4 +4721,3 @@ function TSvgReader.GetIsEmpty: Boolean; //------------------------------------------------------------------------------ end. - diff --git a/source/Img32.Text.pas b/source/Img32.Text.pas index 4e4b4160..a1fa942f 100644 --- a/source/Img32.Text.pas +++ b/source/Img32.Text.pas @@ -2,8 +2,8 @@ (******************************************************************************* * Author : Angus Johnson * -* Version : 4.0 * -* Date : 10 January 2022 * +* Version : 4.3 * +* Date : 27 September 2022 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2019-2022 * * * diff --git a/source/Img32.Transform.pas b/source/Img32.Transform.pas index 81362f03..be4f195b 100644 --- a/source/Img32.Transform.pas +++ b/source/Img32.Transform.pas @@ -2,8 +2,8 @@ (******************************************************************************* * Author : Angus Johnson * -* Version : 4.2 * -* Date : 30 May 2022 * +* Version : 4.3 * +* Date : 27 September 2022 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2019-2021 * * * @@ -65,11 +65,9 @@ interface const srcPts, dstPts: TPathD; const margins: TRect): Boolean; function SplineVertTransform(img: TImage32; const topSpline: TPathD; - splineType: TSplineType; backColor: TColor32; reverseFill: Boolean; - out offset: TPoint): Boolean; + splineType: TSplineType; backColor: TColor32; out offset: TPoint): Boolean; function SplineHorzTransform(img: TImage32; const leftSpline: TPathD; - splineType: TSplineType; backColor: TColor32; reverseFill: Boolean; - out offset: TPoint): Boolean; + splineType: TSplineType; backColor: TColor32; out offset: TPoint): Boolean; function ExtractAngleFromMatrix(const mat: TMatrixD): double; function ExtractScaleFromMatrix(const mat: TMatrixD): TSizeD; @@ -686,8 +684,7 @@ function InterpolatePathForY(const path: TPathD): TPathD; //------------------------------------------------------------------------------ function SplineVertTransform(img: TImage32; const topSpline: TPathD; - splineType: TSplineType; backColor: TColor32; reverseFill: Boolean; - out offset: TPoint): Boolean; + splineType: TSplineType; backColor: TColor32; out offset: TPoint): Boolean; var i,j, w,h, len: integer; y, q: double; @@ -755,8 +752,7 @@ function SplineVertTransform(img: TImage32; const topSpline: TPathD; //------------------------------------------------------------------------------ function SplineHorzTransform(img: TImage32; const leftSpline: TPathD; - splineType: TSplineType; backColor: TColor32; reverseFill: Boolean; - out offset: TPoint): Boolean; + splineType: TSplineType; backColor: TColor32; out offset: TPoint): Boolean; var i,j, len, w,h: integer; x, q, prevY: double; diff --git a/source/Img32.Vector.pas b/source/Img32.Vector.pas index 2be04310..d0806d1d 100644 --- a/source/Img32.Vector.pas +++ b/source/Img32.Vector.pas @@ -3,7 +3,7 @@ (******************************************************************************* * Author : Angus Johnson * * Version : 4.3 * -* Date : 13 September 2022 * +* Date : 27 September 2022 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2019-2022 * * * @@ -1953,6 +1953,13 @@ function Grow(const path, normals: TPathD; delta: double; for i := iLo to iHi do begin + + if PointsNearEqual(path[i], path[prevI], 0.01) then + begin + prevI := i; + Continue; + end; + growRec.aSin := CrossProduct(norms[prevI], norms[i]); growRec.aCos := DotProduct(norms[prevI], norms[i]); diff --git a/source/Img32.inc b/source/Img32.inc index 771a778b..47326ce7 100644 --- a/source/Img32.inc +++ b/source/Img32.inc @@ -55,6 +55,7 @@ {$IF declared(FireMonkeyVersion)} //defined in FMX.Types {$DEFINE FMX} {$IFEND} + {$DEFINE USES_NAMESPACES} {$DEFINE FORMATSETTINGS} {$DEFINE TROUNDINGMODE} {$DEFINE UITYPES} //added UITypes unit diff --git a/source/Img32.pas b/source/Img32.pas index a3df70cb..d0088605 100644 --- a/source/Img32.pas +++ b/source/Img32.pas @@ -3,7 +3,7 @@ (******************************************************************************* * Author : Angus Johnson * * Version : 4.3 * -* Date : 21 September 2022 * +* Date : 27 September 2022 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2019-2022 * * * @@ -20,8 +20,15 @@ interface uses Types, SysUtils, Classes, - {$IFDEF MSWINDOWS} Windows,{$ENDIF} {$IFDEF USING_VCL_LCL} Graphics, Forms,{$ENDIF} - {$IFDEF XPLAT_GENERICS} Generics.Collections, Generics.Defaults, Character,{$ENDIF} + {$IFDEF MSWINDOWS} Windows,{$ENDIF} + {$IFDEF USING_VCL_LCL} + {$IFDEF USES_NAMESPACES} Vcl.Graphics, Vcl.Forms, + {$ELSE}Graphics, Forms, + {$ENDIF} + {$ENDIF} + {$IFDEF XPLAT_GENERICS} + Generics.Collections, Generics.Defaults, Character, + {$ENDIF} {$IFDEF UITYPES} UITypes,{$ENDIF} Math; type diff --git a/source/Packages/Img32_Library.dpk b/source/Packages/Img32_Library.dpk index 745ec2fa..b5553b23 100644 --- a/source/Packages/Img32_Library.dpk +++ b/source/Packages/Img32_Library.dpk @@ -33,25 +33,29 @@ requires contains Img32 in '..\Img32.pas', - Img32.Clipper in '..\Img32.Clipper.pas', + Img32.CQ in '..\Img32.CQ.pas', Img32.Draw in '..\Img32.Draw.pas', Img32.Extra in '..\Img32.Extra.pas', Img32.Fmt.BMP in '..\Img32.Fmt.BMP.pas', + Img32.Fmt.GIF in '..\Img32.Fmt.Gif.pas', + Img32.Fmt.JPG in '..\Img32.Fmt.JPG.pas', + Img32.Fmt.PNG in '..\Img32.Fmt.PNG.pas', + Img32.Fmt.QOI in '..\Img32.Fmt.QOI.pas', Img32.Fmt.SVG in '..\Img32.Fmt.SVG.pas', Img32.Layers in '..\Img32.Layers.pas', Img32.Resamplers in '..\Img32.Resamplers.pas', + Img32.Storage in '..\Img32.Storage.pas', Img32.SVG.Core in '..\Img32.SVG.Core.pas', Img32.SVG.Path in '..\Img32.SVG.Path.pas', - Img32.SVG.PathDesign in '..\Img32.SVG.PathDesign.pas', Img32.SVG.Reader in '..\Img32.SVG.Reader.pas', - Img32.SVG.Writer in '..\Img32.SVG.Writer.pas', Img32.Text in '..\Img32.Text.pas', Img32.Transform in '..\Img32.Transform.pas', Img32.Vector in '..\Img32.Vector.pas', + Img32.Clipper2 in '..\Img32.Clipper2.pas', Clipper in '..\Clipper\Clipper.pas', - ClipperCore in '..\Clipper\ClipperCore.pas', - ClipperOffset in '..\Clipper\ClipperOffset.pas'; + Clipper.Core in '..\Clipper\Clipper.Core.pas', + Clipper.Engine in '..\Clipper\Clipper.Engine.pas', + Clipper.Offset in '..\Clipper\Clipper.Offset.pas', + Clipper.Minkowski in '..\Clipper\Clipper.Minkowski.pas'; end. - - diff --git a/source/Packages/Img32_VCL_Dsgn.dpk b/source/Packages/Img32_VCL_Dsgn.dpk index da1b568a..11dd0bfe 100644 --- a/source/Packages/Img32_VCL_Dsgn.dpk +++ b/source/Packages/Img32_VCL_Dsgn.dpk @@ -1,7 +1,7 @@ package Img32_VCL_Dsgn; - {$R *.res} {$R '..\Img32.Panels.dcr'} +{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} {$ALIGN 8} {$ASSERTIONS ON} {$BOOLEVAL OFF} @@ -23,8 +23,9 @@ package Img32_VCL_Dsgn; {$WRITEABLECONST OFF} {$MINENUMSIZE 1} {$IMAGEBASE $400000} -{$IMPLICITBUILD OFF} {$DEFINE DEBUG} +{$ENDIF IMPLICITBUILDING} +{$IMPLICITBUILD OFF} requires rtl, @@ -36,4 +37,3 @@ contains end. -