Clipper.Core.pas 71 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405
  1. unit Clipper.Core;
  2. (*******************************************************************************
  3. * Author : Angus Johnson *
  4. * Date : 13 May 2024 *
  5. * Website : http://www.angusj.com *
  6. * Copyright : Angus Johnson 2010-2024 *
  7. * Purpose : Core Clipper Library module *
  8. * Contains structures and functions used throughout the library *
  9. * License : http://www.boost.org/LICENSE_1_0.txt *
  10. *******************************************************************************)
  11. {$I Clipper.inc}
  12. interface
  13. uses
  14. SysUtils, Classes, Math;
  15. type
  16. PPoint64 = ^TPoint64;
  17. TPoint64 = record
  18. X, Y: Int64;
  19. {$IFDEF USINGZ}
  20. Z: Int64;
  21. {$ENDIF}
  22. end;
  23. PPointD = ^TPointD;
  24. TPointD = record
  25. X, Y: double;
  26. {$IFDEF USINGZ}
  27. Z: Int64;
  28. {$ENDIF}
  29. end;
  30. // Path: a simple data structure representing a series of vertices, whether
  31. // open (poly-line) or closed (polygon). Paths may be simple or complex (self
  32. // intersecting). For simple polygons, consisting of a single non-intersecting
  33. // path, path orientation is unimportant. However, for complex polygons and
  34. // for overlapping polygons, various 'filling rules' define which regions will
  35. // be inside (filled) and which will be outside (unfilled).
  36. TPath64 = array of TPoint64;
  37. TPaths64 = array of TPath64;
  38. TArrayOfPaths = array of TPaths64;
  39. TPathD = array of TPointD;
  40. TPathsD = array of TPathD;
  41. TArrayOfPathsD = array of TPathsD;
  42. // The most commonly used filling rules for polygons are EvenOdd and NonZero.
  43. // https://en.wikipedia.org/wiki/Even-odd_rule
  44. // https://en.wikipedia.org/wiki/Nonzero-rule
  45. TFillRule = (frEvenOdd, frNonZero, frPositive, frNegative);
  46. TArrayOfBoolean = array of Boolean;
  47. TArrayOfInteger = array of Integer;
  48. TArrayOfDouble = array of double;
  49. TRect64 = {$IFDEF RECORD_METHODS}record{$ELSE}object{$ENDIF}
  50. private
  51. function GetWidth: Int64; {$IFDEF INLINING} inline; {$ENDIF}
  52. function GetHeight: Int64; {$IFDEF INLINING} inline; {$ENDIF}
  53. function GetIsEmpty: Boolean; {$IFDEF INLINING} inline; {$ENDIF}
  54. function GetIsValid: Boolean; {$IFDEF INLINING} inline; {$ENDIF}
  55. function GetMidPoint: TPoint64; {$IFDEF INLINING} inline; {$ENDIF}
  56. public
  57. Left : Int64;
  58. Top : Int64;
  59. Right : Int64;
  60. Bottom : Int64;
  61. function Contains(const pt: TPoint64; inclusive: Boolean = false): Boolean; overload;
  62. function Contains(const rec: TRect64): Boolean; overload;
  63. function Intersect(const rec: TRect64): TRect64;
  64. function Intersects(const rec: TRect64): Boolean;
  65. function AsPath: TPath64;
  66. property Width: Int64 read GetWidth;
  67. property Height: Int64 read GetHeight;
  68. property IsEmpty: Boolean read GetIsEmpty;
  69. property IsValid: Boolean read GetIsValid;
  70. property MidPoint: TPoint64 read GetMidPoint;
  71. end;
  72. TRectD = {$ifdef RECORD_METHODS}record{$else}object{$endif}
  73. private
  74. function GetWidth: double; {$IFDEF INLINING} inline; {$ENDIF}
  75. function GetHeight: double; {$IFDEF INLINING} inline; {$ENDIF}
  76. function GetIsEmpty: Boolean; {$IFDEF INLINING} inline; {$ENDIF}
  77. function GetIsValid: Boolean; {$IFDEF INLINING} inline; {$ENDIF}
  78. function GetMidPoint: TPointD; {$IFDEF INLINING} inline; {$ENDIF}
  79. public
  80. Left : double;
  81. Top : double;
  82. Right : double;
  83. Bottom : double;
  84. function Contains(const pt: TPointD): Boolean; overload;
  85. function Contains(const rec: TRectD): Boolean; overload;
  86. function Intersects(const rec: TRectD): Boolean;
  87. function AsPath: TPathD;
  88. property Width: double read GetWidth;
  89. property Height: double read GetHeight;
  90. property IsEmpty: Boolean read GetIsEmpty;
  91. property IsValid: Boolean read GetIsValid;
  92. property MidPoint: TPointD read GetMidPoint;
  93. end;
  94. {$IFDEF FPC}
  95. TPointerList = array of Pointer;
  96. TListSortCompareFunc = function (Item1, Item2: Pointer): Integer;
  97. {$ELSE}
  98. {$IF COMPILERVERSION < 23} //PRIOR DELPHI XE2
  99. TPointerList = array of Pointer;
  100. TListSortCompareFunc = function (Item1, Item2: Pointer): Integer;
  101. {$IFEND}
  102. {$ENDIF}
  103. TListEx = class
  104. private
  105. fCount : integer;
  106. fCapacity : integer;
  107. fList : TPointerList;
  108. protected
  109. function UnsafeGet(idx: integer): Pointer; // no range checking
  110. procedure UnsafeSet(idx: integer; val: Pointer);
  111. procedure UnsafeDelete(index: integer); virtual;
  112. public
  113. constructor Create(capacity: integer = 0); virtual;
  114. destructor Destroy; override;
  115. procedure Clear; virtual;
  116. function Add(item: Pointer): integer;
  117. procedure Swap(idx1, idx2: integer);
  118. procedure Sort(Compare: TListSortCompare);
  119. procedure Resize(count: integer);
  120. property Count: integer read fCount;
  121. property Item[idx: integer]: Pointer read UnsafeGet; default;
  122. end;
  123. TClipType = (ctNone, ctIntersection, ctUnion, ctDifference, ctXor);
  124. TPointInPolygonResult = (pipOn, pipInside, pipOutside);
  125. EClipper2LibException = class(Exception);
  126. function Area(const path: TPath64): Double; overload;
  127. function Area(const paths: TPaths64): Double; overload;
  128. {$IFDEF INLINING} inline; {$ENDIF}
  129. function Area(const path: TPathD): Double; overload;
  130. function Area(const paths: TPathsD): Double; overload;
  131. {$IFDEF INLINING} inline; {$ENDIF}
  132. function IsPositive(const path: TPath64): Boolean; overload;
  133. {$IFDEF INLINING} inline; {$ENDIF}
  134. function IsPositive(const path: TPathD): Boolean; overload;
  135. {$IFDEF INLINING} inline; {$ENDIF}
  136. function IsCollinear(const pt1, sharedPt, pt2: TPoint64): Boolean;
  137. function CrossProduct(const pt1, pt2, pt3: TPoint64): double; overload;
  138. {$IFDEF INLINING} inline; {$ENDIF}
  139. function CrossProduct(const pt1, pt2, pt3: TPointD): double; overload;
  140. {$IFDEF INLINING} inline; {$ENDIF}
  141. function CrossProduct(const vec1, vec2: TPointD): double; overload;
  142. {$IFDEF INLINING} inline; {$ENDIF}
  143. function CrossProduct(vec1x, vec1y, vec2x, vec2y: double): double; overload;
  144. {$IFDEF INLINING} inline; {$ENDIF}
  145. function DotProduct(const pt1, pt2, pt3: TPoint64): double;
  146. {$IFDEF INLINING} inline; {$ENDIF}
  147. function DistanceSqr(const pt1, pt2: TPoint64): double; overload;
  148. {$IFDEF INLINING} inline; {$ENDIF}
  149. function DistanceSqr(const pt1, pt2: TPointD): double; overload;
  150. {$IFDEF INLINING} inline; {$ENDIF}
  151. function PerpendicDistFromLineSqrd(const pt, linePt1, linePt2: TPoint64): double; overload;
  152. function PerpendicDistFromLineSqrd(const pt, linePt1, linePt2: TPointD): double; overload;
  153. function SegmentsIntersect(const s1a, s1b, s2a, s2b: TPoint64;
  154. inclusive: Boolean = false): boolean; {$IFDEF INLINING} inline; {$ENDIF}
  155. function PointsEqual(const pt1, pt2: TPoint64): Boolean; overload;
  156. {$IFDEF INLINING} inline; {$ENDIF}
  157. function PointsNearEqual(const pt1, pt2: TPointD): Boolean; overload;
  158. {$IFDEF INLINING} inline; {$ENDIF}
  159. function PointsNearEqual(const pt1, pt2: TPointD; distanceSqrd: double): Boolean; overload;
  160. {$IFDEF INLINING} inline; {$ENDIF}
  161. {$IFDEF USINGZ}
  162. function Point64(const X, Y: Int64; Z: Int64 = 0): TPoint64; overload;
  163. {$IFDEF INLINING} inline; {$ENDIF}
  164. function Point64(const X, Y: Double; Z: Int64 = 0): TPoint64; overload;
  165. {$IFDEF INLINING} inline; {$ENDIF}
  166. function PointD(const X, Y: Double; Z: Int64 = 0): TPointD; overload;
  167. {$IFDEF INLINING} inline; {$ENDIF}
  168. {$ELSE}
  169. function Point64(const X, Y: Int64): TPoint64; overload; {$IFDEF INLINING} inline; {$ENDIF}
  170. function Point64(const X, Y: Double): TPoint64; overload; {$IFDEF INLINING} inline; {$ENDIF}
  171. function PointD(const X, Y: Double): TPointD; overload; {$IFDEF INLINING} inline; {$ENDIF}
  172. {$ENDIF}
  173. function Negate(const pt: TPoint64): TPoint64; overload; {$IFDEF INLINING} inline; {$ENDIF}
  174. function Negate(const pt: TPointD): TPointD; overload; {$IFDEF INLINING} inline; {$ENDIF}
  175. function NegatePath(const path: TPathD): TPathD; overload; {$IFDEF INLINING} inline; {$ENDIF}
  176. function Point64(const pt: TPointD): TPoint64; overload; {$IFDEF INLINING} inline; {$ENDIF}
  177. function PointD(const pt: TPoint64): TPointD; overload;
  178. {$IFDEF INLINING} inline; {$ENDIF}
  179. function Rect64(const left, top, right, bottom: Int64): TRect64; overload;
  180. {$IFDEF INLINING} inline; {$ENDIF}
  181. function Rect64(const recD: TRectD): TRect64; overload;
  182. {$IFDEF INLINING} inline; {$ENDIF}
  183. function RectD(const left, top, right, bottom: double): TRectD; overload;
  184. {$IFDEF INLINING} inline; {$ENDIF}
  185. function RectD(const rec64: TRect64): TRectD; overload;
  186. {$IFDEF INLINING} inline; {$ENDIF}
  187. function GetBounds(const paths: TArrayOfPaths): TRect64; overload;
  188. function GetBounds(const paths: TPaths64): TRect64; overload;
  189. function GetBounds(const paths: TPathsD): TRectD; overload;
  190. function GetBounds(const path: TPath64): TRect64; overload;
  191. function GetBounds(const path: TPathD): TRectD; overload;
  192. function TranslatePoint(const pt: TPoint64; dx, dy: Int64): TPoint64; overload;
  193. function TranslatePoint(const pt: TPointD; dx, dy: double): TPointD; overload;
  194. procedure RotatePt(var pt: TPointD; const center: TPointD; sinA, cosA: double);
  195. procedure RotatePath(var path: TPathD; const center: TPointD; sinA, cosA: double);
  196. procedure InflateRect(var rec: TRect64; dx, dy: Int64); overload;
  197. {$IFDEF INLINING} inline; {$ENDIF}
  198. procedure InflateRect(var rec: TRectD; dx, dy: double); overload;
  199. {$IFDEF INLINING} inline; {$ENDIF}
  200. function UnionRect(const rec, rec2: TRect64): TRect64; overload;
  201. {$IFDEF INLINING} inline; {$ENDIF}
  202. function UnionRect(const rec, rec2: TRectD): TRectD; overload;
  203. {$IFDEF INLINING} inline; {$ENDIF}
  204. function RotateRect(const rec: TRect64; angleRad: double): TRect64; overload;
  205. function RotateRect(const rec: TRectD; angleRad: double): TRectD; overload;
  206. procedure OffsetRect(var rec: TRect64; dx, dy: Int64); overload;
  207. {$IFDEF INLINING} inline; {$ENDIF}
  208. procedure OffsetRect(var rec: TRectD; dx, dy: double); overload;
  209. {$IFDEF INLINING} inline; {$ENDIF}
  210. function ScaleRect(const rec: TRect64; scale: double): TRect64; overload;
  211. {$IFDEF INLINING} inline; {$ENDIF}
  212. function ScaleRect(const rec: TRectD; scale: double): TRectD; overload;
  213. {$IFDEF INLINING} inline; {$ENDIF}
  214. function ScalePoint(const pt: TPoint64; scale: double): TPointD; overload;
  215. {$IFDEF INLINING} inline; {$ENDIF}
  216. function ScalePoint(const pt: TPointD; scale: double): TPointD; overload;
  217. {$IFDEF INLINING} inline; {$ENDIF}
  218. function ScalePath(const path: TPath64; sx, sy: double): TPath64; overload;
  219. function ScalePath(const path: TPathD; sx, sy: double): TPath64; overload;
  220. function ScalePath(const path: TPath64; scale: double): TPath64; overload;
  221. function ScalePath(const path: TPathD; scale: double): TPath64; overload;
  222. function ScalePathD(const path: TPath64; sx, sy: double): TPathD; overload;
  223. function ScalePathD(const path: TPathD; sx, sy: double): TPathD; overload;
  224. function ScalePathD(const path: TPath64; scale: double): TPathD; overload;
  225. function ScalePathD(const path: TPathD; scale: double): TPathD; overload;
  226. function ScalePaths(const paths: TPaths64; sx, sy: double): TPaths64; overload;
  227. function ScalePaths(const paths: TPathsD; sx, sy: double): TPaths64; overload;
  228. function ScalePaths(const paths: TPaths64; scale: double): TPaths64; overload;
  229. function ScalePaths(const paths: TPathsD; scale: double): TPaths64; overload;
  230. function ScalePathsD(const paths: TPaths64; sx, sy: double): TPathsD; overload;
  231. function ScalePathsD(const paths: TPathsD; sx, sy: double): TPathsD; overload;
  232. function ScalePathsD(const paths: TPaths64; scale: double): TPathsD; overload;
  233. function ScalePathsD(const paths: TPathsD; scale: double): TPathsD; overload;
  234. function Path64(const pathD: TPathD): TPath64;
  235. function PathD(const path: TPath64): TPathD;
  236. function Paths64(const path: TPath64): TPaths64; overload;
  237. function Paths64(const pathsD: TPathsD): TPaths64; overload;
  238. function PathsD(const paths: TPaths64): TPathsD; overload;
  239. function PathsD(const path: TPathD): TPathsD; overload;
  240. function StripDuplicates(const path: TPath64; isClosedPath: Boolean = false): TPath64;
  241. function StripNearDuplicates(const path: TPathD;
  242. minLenSqrd: double; isClosedPath: Boolean): TPathD;
  243. function ValueBetween(val, end1, end2: Int64): Boolean;
  244. {$IFDEF INLINING} inline; {$ENDIF}
  245. function ValueEqualOrBetween(val, end1, end2: Int64): Boolean;
  246. {$IFDEF INLINING} inline; {$ENDIF}
  247. function ReversePath(const path: TPath64): TPath64; overload;
  248. {$IFDEF INLINING} inline; {$ENDIF}
  249. function ReversePath(const path: TPathD): TPathD; overload;
  250. function ReversePaths(const paths: TPaths64): TPaths64; overload;
  251. {$IFDEF INLINING} inline; {$ENDIF}
  252. function ReversePaths(const paths: TPathsD): TPathsD; overload;
  253. {$IFDEF INLINING} inline; {$ENDIF}
  254. function ShiftPath(const path: TPath64; shift: integer): TPath64; overload;
  255. {$IFDEF INLINING} inline; {$ENDIF}
  256. function ShiftPath(const path: TPathD; shift: integer): TPathD; overload;
  257. {$IFDEF INLINING} inline; {$ENDIF}
  258. procedure AppendPoint(var path: TPath64; const pt: TPoint64); overload;
  259. {$IFDEF INLINING} inline; {$ENDIF}
  260. procedure AppendPoint(var path: TPathD; const pt: TPointD); overload;
  261. {$IFDEF INLINING} inline; {$ENDIF}
  262. function AppendPoints(const path, extra: TPath64): TPath64;
  263. {$IFDEF INLINING} inline; {$ENDIF}
  264. procedure AppendPath(var paths: TPaths64; const extra: TPath64); overload;
  265. procedure AppendPath(var paths: TPathsD; const extra: TPathD); overload;
  266. procedure AppendPaths(var paths: TPaths64; const extra: TPaths64); overload;
  267. procedure AppendPaths(var paths: TPathsD; const extra: TPathsD); overload;
  268. function ArrayOfPathsToPaths(const ap: TArrayOfPaths): TPaths64;
  269. function GetSegmentIntersectPt(const ln1a, ln1b, ln2a, ln2b: TPoint64;
  270. out ip: TPoint64): Boolean;
  271. function PointInPolygon(const pt: TPoint64; const polygon: TPath64): TPointInPolygonResult;
  272. function GetClosestPointOnSegment(const pt, seg1, seg2: TPoint64): TPoint64;
  273. {$IFDEF INLINING} inline; {$ENDIF}
  274. function RamerDouglasPeucker(const path: TPath64; epsilon: double): TPath64; overload;
  275. function RamerDouglasPeucker(const paths: TPaths64; epsilon: double): TPaths64; overload;
  276. function RamerDouglasPeucker(const path: TPathD; epsilon: double): TPathD; overload;
  277. function RamerDouglasPeucker(const paths: TPathsD; epsilon: double): TPathsD; overload;
  278. procedure GetSinCos(angle: double; out sinA, cosA: double);
  279. function Ellipse(const rec: TRect64; steps: integer = 0): TPath64; overload;
  280. function Ellipse(const rec: TRectD; steps: integer = 0): TPathD; overload;
  281. procedure QuickSort(SortList: TPointerList;
  282. L, R: Integer; const SCompare: TListSortCompareFunc);
  283. procedure CheckPrecisionRange(var precision: integer);
  284. function Iif(eval: Boolean; trueVal, falseVal: Boolean): Boolean; overload;
  285. function Iif(eval: Boolean; trueVal, falseVal: integer): integer; overload;
  286. function Iif(eval: Boolean; trueVal, falseVal: Int64): Int64; overload;
  287. function Iif(eval: Boolean; trueVal, falseVal: double): double; overload;
  288. const
  289. MaxInt64 = 9223372036854775807;
  290. MinInt64 = -MaxInt64;
  291. MaxCoord = MaxInt64 div 4;
  292. MinCoord = - MaxCoord;
  293. invalid64 = MaxInt64;
  294. invalidD = infinity;
  295. NullPointD : TPointD = (X: 0; Y: 0);
  296. NullRect64 : TRect64 = (left: 0; top: 0; right: 0; Bottom: 0);
  297. InvalidPt64 : TPoint64 = (X: invalid64; Y: invalid64);
  298. InvalidPtD : TPointD = (X: invalidD; Y: invalidD);
  299. NullRectD : TRectD = (left: 0; top: 0; right: 0; Bottom: 0);
  300. InvalidRect64 : TRect64 =
  301. (left: invalid64; top: invalid64; right: invalid64; bottom: invalid64);
  302. InvalidRectD : TRectD =
  303. (left: invalidD; top: invalidD; right: invalidD; bottom: invalidD);
  304. Tolerance : Double = 1.0E-12;
  305. //https://github.com/AngusJohnson/Clipper2/discussions/564
  306. MaxDecimalPrecision = 8;
  307. implementation
  308. resourcestring
  309. rsClipper_PrecisonErr = 'The decimal rounding value is invalid';
  310. //------------------------------------------------------------------------------
  311. // TRect64 methods ...
  312. //------------------------------------------------------------------------------
  313. function TRect64.GetWidth: Int64;
  314. begin
  315. result := right - left;
  316. end;
  317. //------------------------------------------------------------------------------
  318. function TRect64.GetHeight: Int64;
  319. begin
  320. result := bottom - top;
  321. end;
  322. //------------------------------------------------------------------------------
  323. function TRect64.GetIsEmpty: Boolean;
  324. begin
  325. result := (bottom <= top) or (right <= left);
  326. end;
  327. //------------------------------------------------------------------------------
  328. function TRect64.GetIsValid: Boolean;
  329. begin
  330. result := left <> invalid64;
  331. end;
  332. //------------------------------------------------------------------------------
  333. function TRect64.GetMidPoint: TPoint64;
  334. begin
  335. result := Point64((Left + Right) div 2, (Top + Bottom) div 2);
  336. end;
  337. //------------------------------------------------------------------------------
  338. function TRect64.Contains(const pt: TPoint64; inclusive: Boolean = false): Boolean;
  339. begin
  340. if inclusive then
  341. result := (pt.X >= Left) and (pt.X <= Right) and
  342. (pt.Y >= Top) and (pt.Y <= Bottom)
  343. else
  344. result := (pt.X > Left) and (pt.X < Right) and
  345. (pt.Y > Top) and (pt.Y < Bottom);
  346. end;
  347. //------------------------------------------------------------------------------
  348. function TRect64.Contains(const rec: TRect64): Boolean;
  349. begin
  350. result := (rec.Left >= Left) and (rec.Right <= Right) and
  351. (rec.Top >= Top) and (rec.Bottom <= Bottom);
  352. end;
  353. //------------------------------------------------------------------------------
  354. function TRect64.Intersects(const rec: TRect64): Boolean;
  355. begin
  356. Result := (Max(Left, rec.Left) <= Min(Right, rec.Right)) and
  357. (Max(Top, rec.Top) <= Min(Bottom, rec.Bottom));
  358. end;
  359. //------------------------------------------------------------------------------
  360. function TRect64.Intersect(const rec: TRect64): TRect64;
  361. begin
  362. Result.Left := Max(Left, rec.Left);
  363. Result.Top := Max(Top, rec.Top);
  364. Result.Right := Min(Right, rec.Right);
  365. Result.Bottom := Min(Bottom, rec.Bottom);
  366. if IsEmpty then Result := NullRect64;
  367. end;
  368. //------------------------------------------------------------------------------
  369. function TRect64.AsPath: TPath64;
  370. begin
  371. SetLength(Result, 4);
  372. Result[0] := Point64(Left, Top);
  373. Result[1] := Point64(Right, Top);
  374. Result[2] := Point64(Right, Bottom);
  375. Result[3] := Point64(Left, Bottom);
  376. end;
  377. //------------------------------------------------------------------------------
  378. // TRectD methods ...
  379. //------------------------------------------------------------------------------
  380. function TRectD.GetWidth: double;
  381. begin
  382. result := right - left;
  383. end;
  384. //------------------------------------------------------------------------------
  385. function TRectD.GetHeight: double;
  386. begin
  387. result := bottom - top;
  388. end;
  389. //------------------------------------------------------------------------------
  390. function TRectD.GetIsEmpty: Boolean;
  391. begin
  392. result := (bottom <= top) or (right <= left);
  393. end;
  394. //------------------------------------------------------------------------------
  395. function TRectD.GetIsValid: Boolean;
  396. begin
  397. result := left <> invalidD;
  398. end;
  399. //------------------------------------------------------------------------------
  400. function TRectD.GetMidPoint: TPointD;
  401. begin
  402. result := PointD((Left + Right) *0.5, (Top + Bottom) *0.5);
  403. end;
  404. //------------------------------------------------------------------------------
  405. function TRectD.Contains(const pt: TPointD): Boolean;
  406. begin
  407. result := (pt.X > Left) and (pt.X < Right) and
  408. (pt.Y > Top) and (pt.Y < Bottom);
  409. end;
  410. //------------------------------------------------------------------------------
  411. function TRectD.Contains(const rec: TRectD): Boolean;
  412. begin
  413. result := (rec.Left >= Left) and (rec.Right <= Right) and
  414. (rec.Top >= Top) and (rec.Bottom <= Bottom);
  415. end;
  416. //------------------------------------------------------------------------------
  417. function TRectD.Intersects(const rec: TRectD): Boolean;
  418. begin
  419. Result := (Max(Left, rec.Left) <= Min(Right, rec.Right)) and
  420. (Max(Top, rec.Top) <= Min(Bottom, rec.Bottom));
  421. end;
  422. //------------------------------------------------------------------------------
  423. function TRectD.AsPath: TPathD;
  424. begin
  425. SetLength(Result, 4);
  426. Result[0] := PointD(Left, Top);
  427. Result[1] := PointD(Right, Top);
  428. Result[2] := PointD(Right, Bottom);
  429. Result[3] := PointD(Left, Bottom);
  430. end;
  431. //------------------------------------------------------------------------------
  432. // TListEx class
  433. //------------------------------------------------------------------------------
  434. constructor TListEx.Create(capacity: integer);
  435. begin
  436. if capacity > 0 then
  437. begin
  438. fCapacity := 16;
  439. while capacity > fCapacity do fCapacity := fCapacity * 2;
  440. SetLength(fList, fCapacity);
  441. end;
  442. end;
  443. //------------------------------------------------------------------------------
  444. destructor TListEx.Destroy;
  445. begin
  446. Clear;
  447. inherited;
  448. end;
  449. //------------------------------------------------------------------------------
  450. procedure TListEx.Clear;
  451. begin
  452. fList := nil;
  453. fCount := 0;
  454. fCapacity := 0;
  455. end;
  456. //------------------------------------------------------------------------------
  457. function TListEx.Add(item: Pointer): integer;
  458. begin
  459. if fCount = fCapacity then
  460. begin
  461. if fCapacity = 0 then
  462. fCapacity := 16 else
  463. fCapacity := fCapacity *2;
  464. SetLength(fList, fCapacity);
  465. end;
  466. fList[fCount] := item;
  467. Result := fCount;
  468. inc(fCount);
  469. end;
  470. //------------------------------------------------------------------------------
  471. procedure QuickSort(SortList: TPointerList; L, R: Integer;
  472. const SCompare: TListSortCompareFunc);
  473. var
  474. I, J: Integer;
  475. P, T: Pointer;
  476. begin
  477. if L >= R then Exit;
  478. repeat
  479. if (R - L) = 1 then
  480. begin
  481. if SCompare(SortList[L], SortList[R]) > 0 then
  482. begin
  483. T := SortList[L];
  484. SortList[L] := SortList[R];
  485. SortList[R] := T;
  486. end;
  487. break;
  488. end;
  489. I := L;
  490. J := R;
  491. P := SortList[(L + R) shr 1];
  492. repeat
  493. while SCompare(SortList[I], P) < 0 do Inc(I);
  494. while SCompare(SortList[J], P) > 0 do Dec(J);
  495. if I <= J then
  496. begin
  497. if I <> J then
  498. begin
  499. T := SortList[I];
  500. SortList[I] := SortList[J];
  501. SortList[J] := T;
  502. end;
  503. Inc(I);
  504. Dec(J);
  505. end;
  506. until I > J;
  507. if (J - L) > (R - I) then
  508. begin
  509. if I < R then QuickSort(SortList, I, R, SCompare);
  510. R := J;
  511. end
  512. else
  513. begin
  514. if L < J then QuickSort(SortList, L, J, SCompare);
  515. L := I;
  516. end;
  517. until L >= R;
  518. end;
  519. //------------------------------------------------------------------------------
  520. procedure TListEx.Sort(Compare: TListSortCompare);
  521. begin
  522. if fCount < 2 then Exit;
  523. QuickSort(FList, 0, fCount - 1, Compare);
  524. end;
  525. //------------------------------------------------------------------------------
  526. procedure TListEx.Resize(count: integer);
  527. begin
  528. if (fCapacity = 0) then fCapacity := 16;
  529. while count > fCapacity do fCapacity := fCapacity * 2;
  530. SetLength(fList, fCapacity);
  531. fCount := count;
  532. end;
  533. //------------------------------------------------------------------------------
  534. function TListEx.UnsafeGet(idx: integer): Pointer;
  535. begin
  536. Result := fList[idx];
  537. end;
  538. //------------------------------------------------------------------------------
  539. procedure TListEx.UnsafeSet(idx: integer; val: Pointer);
  540. begin
  541. fList[idx] := val;
  542. end;
  543. //------------------------------------------------------------------------------
  544. procedure TListEx.UnsafeDelete(index: integer);
  545. begin
  546. dec(fCount);
  547. if index < fCount then
  548. Move(fList[index +1], fList[index], (fCount - index) * SizeOf(Pointer));
  549. end;
  550. //------------------------------------------------------------------------------
  551. procedure TListEx.Swap(idx1, idx2: integer);
  552. var
  553. p: Pointer;
  554. begin
  555. p := fList[idx1];
  556. fList[idx1] := fList[idx2];
  557. fList[idx2] := p;
  558. end;
  559. //------------------------------------------------------------------------------
  560. // Miscellaneous Functions ...
  561. //------------------------------------------------------------------------------
  562. function Iif(eval: Boolean; trueVal, falseVal: Boolean): Boolean;
  563. {$IFDEF INLINING} inline; {$ENDIF}
  564. begin
  565. if eval then Result := trueVal else Result := falseVal;
  566. end;
  567. //------------------------------------------------------------------------------
  568. function Iif(eval: Boolean; trueVal, falseVal: integer): integer;
  569. {$IFDEF INLINING} inline; {$ENDIF}
  570. begin
  571. if eval then Result := trueVal else Result := falseVal;
  572. end;
  573. //------------------------------------------------------------------------------
  574. function Iif(eval: Boolean; trueVal, falseVal: Int64): Int64;
  575. {$IFDEF INLINING} inline; {$ENDIF}
  576. begin
  577. if eval then Result := trueVal else Result := falseVal;
  578. end;
  579. //------------------------------------------------------------------------------
  580. function Iif(eval: Boolean; trueVal, falseVal: double): double;
  581. {$IFDEF INLINING} inline; {$ENDIF}
  582. begin
  583. if eval then Result := trueVal else Result := falseVal;
  584. end;
  585. //------------------------------------------------------------------------------
  586. procedure CheckPrecisionRange(var precision: integer);
  587. begin
  588. if (precision < -MaxDecimalPrecision) or (precision > MaxDecimalPrecision) then
  589. Raise EClipper2LibException(rsClipper_PrecisonErr);
  590. end;
  591. //------------------------------------------------------------------------------
  592. procedure RaiseError(const msg: string); {$IFDEF INLINING} inline; {$ENDIF}
  593. begin
  594. raise EClipper2LibException.Create(msg);
  595. end;
  596. //------------------------------------------------------------------------------
  597. function PointsEqual(const pt1, pt2: TPoint64): Boolean;
  598. begin
  599. Result := (pt1.X = pt2.X) and (pt1.Y = pt2.Y);
  600. end;
  601. //------------------------------------------------------------------------------
  602. function PointsNearEqual(const pt1, pt2: TPointD): Boolean;
  603. begin
  604. Result := (Abs(pt1.X - pt2.X) < Tolerance) and
  605. (Abs(pt1.Y - pt2.Y) < Tolerance);
  606. end;
  607. //------------------------------------------------------------------------------
  608. function PointsNearEqual(const pt1, pt2: TPointD; distanceSqrd: double): Boolean;
  609. begin
  610. Result := Sqr(pt1.X - pt2.X) + Sqr(pt1.Y - pt2.Y) < distanceSqrd;
  611. end;
  612. //------------------------------------------------------------------------------
  613. function StripDuplicates(const path: TPath64; isClosedPath: Boolean): TPath64;
  614. var
  615. i,j, len: integer;
  616. begin
  617. len := length(path);
  618. SetLength(Result, len);
  619. if len = 0 then Exit;
  620. Result[0] := path[0];
  621. j := 0;
  622. for i := 1 to len -1 do
  623. if not PointsEqual(Result[j], path[i]) then
  624. begin
  625. inc(j);
  626. Result[j] := path[i];
  627. end;
  628. if isClosedPath and PointsEqual(Result[0], path[j]) then dec(j);
  629. SetLength(Result, j +1);
  630. end;
  631. //------------------------------------------------------------------------------
  632. function StripNearDuplicates(const path: TPathD;
  633. minLenSqrd: double; isClosedPath: Boolean): TPathD;
  634. var
  635. i,j, len: integer;
  636. begin
  637. len := length(path);
  638. SetLength(Result, len);
  639. if len = 0 then Exit;
  640. Result[0] := path[0];
  641. j := 0;
  642. for i := 1 to len -1 do
  643. if not PointsNearEqual(Result[j], path[i], minLenSqrd) then
  644. begin
  645. inc(j);
  646. Result[j] := path[i];
  647. end;
  648. if isClosedPath and
  649. PointsNearEqual(Result[j], Result[0], minLenSqrd) then dec(j);
  650. SetLength(Result, j +1);
  651. end;
  652. //------------------------------------------------------------------------------
  653. function ValueBetween(val, end1, end2: Int64): Boolean;
  654. begin
  655. // nb: accommodates axis aligned between where end1 == end2
  656. Result := ((val <> end1) = (val <> end2)) and
  657. ((val > end1) = (val < end2));
  658. end;
  659. //------------------------------------------------------------------------------
  660. function ValueEqualOrBetween(val, end1, end2: Int64): Boolean;
  661. begin
  662. Result := (val = end1) or (val = end2) or
  663. ((val > end1) = (val < end2));
  664. end;
  665. //------------------------------------------------------------------------------
  666. function ScaleRect(const rec: TRect64; scale: double): TRect64;
  667. begin
  668. Result.Left := Round(rec.Left * scale);
  669. Result.Top := Round(rec.Top * scale);
  670. Result.Right := Round(rec.Right * scale);
  671. Result.Bottom := Round(rec.Bottom * scale);
  672. end;
  673. //------------------------------------------------------------------------------
  674. function ScaleRect(const rec: TRectD; scale: double): TRectD;
  675. begin
  676. Result.Left := rec.Left * scale;
  677. Result.Top := rec.Top * scale;
  678. Result.Right := rec.Right * scale;
  679. Result.Bottom := rec.Bottom * scale;
  680. end;
  681. //------------------------------------------------------------------------------
  682. function ScalePoint(const pt: TPoint64; scale: double): TPointD;
  683. begin
  684. Result.X := pt.X * scale;
  685. Result.Y := pt.Y * scale;
  686. {$IFDEF USINGZ}
  687. Result.Z := pt.Z;
  688. {$ENDIF}
  689. end;
  690. //------------------------------------------------------------------------------
  691. function ScalePoint(const pt: TPointD; scale: double): TPointD;
  692. begin
  693. Result.X := pt.X * scale;
  694. Result.Y := pt.Y * scale;
  695. {$IFDEF USINGZ}
  696. Result.Z := pt.Z;
  697. {$ENDIF}
  698. end;
  699. //------------------------------------------------------------------------------
  700. function ScalePath(const path: TPath64; sx, sy: double): TPath64;
  701. var
  702. i,len: integer;
  703. begin
  704. if sx = 0 then sx := 1;
  705. if sy = 0 then sy := 1;
  706. len := length(path);
  707. setlength(result, len);
  708. for i := 0 to len -1 do
  709. begin
  710. result[i].X := Round(path[i].X * sx);
  711. result[i].Y := Round(path[i].Y * sy);
  712. {$IFDEF USINGZ}
  713. result[i].Z := path[i].Z;
  714. {$ENDIF}
  715. end;
  716. end;
  717. //------------------------------------------------------------------------------
  718. function ScalePath(const path: TPathD; sx, sy: double): TPath64;
  719. var
  720. i,j, len: integer;
  721. begin
  722. if sx = 0 then sx := 1;
  723. if sy = 0 then sy := 1;
  724. len := length(path);
  725. setlength(result, len);
  726. if len = 0 then Exit;
  727. j := 1;
  728. result[0].X := Round(path[0].X * sx);
  729. result[0].Y := Round(path[0].Y * sy);
  730. {$IFDEF USINGZ}
  731. result[0].Z := path[0].Z;
  732. {$ENDIF}
  733. for i := 1 to len -1 do
  734. begin
  735. result[j].X := Round(path[i].X * sx);
  736. result[j].Y := Round(path[i].Y * sy);
  737. {$IFDEF USINGZ}
  738. result[j].Z := path[i].Z;
  739. {$ENDIF}
  740. if (result[j].X <> result[j-1].X) or
  741. (result[j].Y <> result[j-1].Y) then inc(j);
  742. end;
  743. setlength(result, j);
  744. end;
  745. //------------------------------------------------------------------------------
  746. function ScalePath(const path: TPath64; scale: double): TPath64;
  747. var
  748. i,j, len: integer;
  749. begin
  750. len := length(path);
  751. setlength(result, len);
  752. if len = 0 then Exit;
  753. j := 1;
  754. result[0].X := Round(path[0].X * scale);
  755. result[0].Y := Round(path[0].Y * scale);
  756. {$IFDEF USINGZ}
  757. result[0].Z := path[0].Z;
  758. {$ENDIF}
  759. for i := 1 to len -1 do
  760. begin
  761. result[j].X := Round(path[i].X * scale);
  762. result[j].Y := Round(path[i].Y * scale);
  763. {$IFDEF USINGZ}
  764. result[j].Z := path[i].Z;
  765. {$ENDIF}
  766. if (result[j].X <> result[j-1].X) or
  767. (result[j].Y <> result[j-1].Y) then inc(j);
  768. end;
  769. setlength(result, j);
  770. end;
  771. //------------------------------------------------------------------------------
  772. function ScalePath(const path: TPathD; scale: double): TPath64;
  773. var
  774. i,len: integer;
  775. begin
  776. len := length(path);
  777. setlength(result, len);
  778. for i := 0 to len -1 do
  779. begin
  780. result[i].X := Round(path[i].X * scale);
  781. result[i].Y := Round(path[i].Y * scale);
  782. {$IFDEF USINGZ}
  783. result[i].Z := path[i].Z;
  784. {$ENDIF}
  785. end;
  786. end;
  787. //------------------------------------------------------------------------------
  788. function ScalePaths(const paths: TPaths64; sx, sy: double): TPaths64;
  789. var
  790. i,len: integer;
  791. begin
  792. if sx = 0 then sx := 1;
  793. if sy = 0 then sy := 1;
  794. len := length(paths);
  795. setlength(result, len);
  796. for i := 0 to len -1 do
  797. result[i] := ScalePath(paths[i], sx, sy);
  798. end;
  799. //------------------------------------------------------------------------------
  800. function ScalePaths(const paths: TPathsD; sx, sy: double): TPaths64;
  801. var
  802. i,len: integer;
  803. begin
  804. if sx = 0 then sx := 1;
  805. if sy = 0 then sy := 1;
  806. len := length(paths);
  807. setlength(result, len);
  808. for i := 0 to len -1 do
  809. result[i] := ScalePath(paths[i], sx, sy);
  810. end;
  811. //------------------------------------------------------------------------------
  812. function ScalePathD(const path: TPath64; sx, sy: double): TPathD;
  813. var
  814. i: integer;
  815. begin
  816. setlength(result, length(path));
  817. for i := 0 to high(path) do
  818. begin
  819. result[i].X := path[i].X * sx;
  820. result[i].Y := path[i].Y * sy;
  821. {$IFDEF USINGZ}
  822. result[i].Z := path[i].Z;
  823. {$ENDIF}
  824. end;
  825. end;
  826. //------------------------------------------------------------------------------
  827. function ScalePathD(const path: TPathD; sx, sy: double): TPathD;
  828. var
  829. i: integer;
  830. begin
  831. setlength(result, length(path));
  832. for i := 0 to high(path) do
  833. begin
  834. result[i].X := path[i].X * sx;
  835. result[i].Y := path[i].Y * sy;
  836. {$IFDEF USINGZ}
  837. result[i].Z := path[i].Z;
  838. {$ENDIF}
  839. end;
  840. end;
  841. //------------------------------------------------------------------------------
  842. function ScalePathD(const path: TPath64; scale: double): TPathD;
  843. var
  844. i: integer;
  845. begin
  846. setlength(result, length(path));
  847. for i := 0 to high(path) do
  848. begin
  849. result[i].X := path[i].X * scale;
  850. result[i].Y := path[i].Y * scale;
  851. {$IFDEF USINGZ}
  852. result[i].Z := path[i].Z;
  853. {$ENDIF}
  854. end;
  855. end;
  856. //------------------------------------------------------------------------------
  857. function ScalePathD(const path: TPathD; scale: double): TPathD;
  858. var
  859. i: integer;
  860. begin
  861. setlength(result, length(path));
  862. for i := 0 to high(path) do
  863. begin
  864. result[i].X := path[i].X * scale;
  865. result[i].Y := path[i].Y * scale;
  866. {$IFDEF USINGZ}
  867. result[i].Z := path[i].Z;
  868. {$ENDIF}
  869. end;
  870. end;
  871. //------------------------------------------------------------------------------
  872. function ScalePathsD(const paths: TPaths64; sx, sy: double): TPathsD;
  873. var
  874. i,j: integer;
  875. begin
  876. if sx = 0 then sx := 1;
  877. if sy = 0 then sy := 1;
  878. setlength(result, length(paths));
  879. for i := 0 to high(paths) do
  880. begin
  881. setlength(result[i], length(paths[i]));
  882. for j := 0 to high(paths[i]) do
  883. begin
  884. result[i][j].X := (paths[i][j].X * sx);
  885. result[i][j].Y := (paths[i][j].Y * sy);
  886. {$IFDEF USINGZ}
  887. result[i][j].Z := paths[i][j].Z;
  888. {$ENDIF}
  889. end;
  890. end;
  891. end;
  892. //------------------------------------------------------------------------------
  893. function ScalePathsD(const paths: TPathsD; sx, sy: double): TPathsD;
  894. var
  895. i,j: integer;
  896. begin
  897. if sx = 0 then sx := 1;
  898. if sy = 0 then sy := 1;
  899. setlength(result, length(paths));
  900. for i := 0 to high(paths) do
  901. begin
  902. setlength(result[i], length(paths[i]));
  903. for j := 0 to high(paths[i]) do
  904. begin
  905. result[i][j].X := paths[i][j].X * sx;
  906. result[i][j].Y := paths[i][j].Y * sy;
  907. {$IFDEF USINGZ}
  908. result[i][j].Z := paths[i][j].Z;
  909. {$ENDIF}
  910. end;
  911. end;
  912. end;
  913. //------------------------------------------------------------------------------
  914. function ScalePaths(const paths: TPaths64; scale: double): TPaths64;
  915. var
  916. i,j: integer;
  917. begin
  918. setlength(result, length(paths));
  919. for i := 0 to high(paths) do
  920. begin
  921. setlength(result[i], length(paths[i]));
  922. for j := 0 to high(paths[i]) do
  923. begin
  924. result[i][j].X := Round(paths[i][j].X * scale);
  925. result[i][j].Y := Round(paths[i][j].Y * scale);
  926. {$IFDEF USINGZ}
  927. result[i][j].Z := paths[i][j].Z;
  928. {$ENDIF}
  929. end;
  930. end;
  931. end;
  932. //------------------------------------------------------------------------------
  933. function ScalePaths(const paths: TPathsD; scale: double): TPaths64;
  934. var
  935. i,j: integer;
  936. begin
  937. setlength(result, length(paths));
  938. for i := 0 to high(paths) do
  939. begin
  940. setlength(result[i], length(paths[i]));
  941. for j := 0 to high(paths[i]) do
  942. begin
  943. result[i][j].X := Round(paths[i][j].X * scale);
  944. result[i][j].Y := Round(paths[i][j].Y * scale);
  945. {$IFDEF USINGZ}
  946. result[i][j].Z := paths[i][j].Z;
  947. {$ENDIF}
  948. end;
  949. end;
  950. end;
  951. //------------------------------------------------------------------------------
  952. function ScalePathsD(const paths: TPaths64; scale: double): TPathsD; overload;
  953. var
  954. i,j: integer;
  955. begin
  956. setlength(result, length(paths));
  957. for i := 0 to high(paths) do
  958. begin
  959. setlength(result[i], length(paths[i]));
  960. for j := 0 to high(paths[i]) do
  961. begin
  962. result[i][j].X := paths[i][j].X * scale;
  963. result[i][j].Y := paths[i][j].Y * scale;
  964. {$IFDEF USINGZ}
  965. result[i][j].Z := paths[i][j].Z;
  966. {$ENDIF}
  967. end;
  968. end;
  969. end;
  970. //------------------------------------------------------------------------------
  971. function ScalePathsD(const paths: TPathsD; scale: double): TPathsD; overload;
  972. var
  973. i,j: integer;
  974. begin
  975. setlength(result, length(paths));
  976. for i := 0 to high(paths) do
  977. begin
  978. setlength(result[i], length(paths[i]));
  979. for j := 0 to high(paths[i]) do
  980. begin
  981. result[i][j].X := paths[i][j].X * scale;
  982. result[i][j].Y := paths[i][j].Y * scale;
  983. {$IFDEF USINGZ}
  984. result[i][j].Z := paths[i][j].Z;
  985. {$ENDIF}
  986. end;
  987. end;
  988. end;
  989. //------------------------------------------------------------------------------
  990. function Path64(const pathD: TPathD): TPath64;
  991. var
  992. i, len: integer;
  993. begin
  994. len := Length(pathD);
  995. setLength(Result, len);
  996. for i := 0 to len -1 do
  997. begin
  998. Result[i].X := Round(pathD[i].X);
  999. Result[i].Y := Round(pathD[i].Y);
  1000. {$IFDEF USINGZ}
  1001. Result[i].Z := pathD[i].Z;
  1002. {$ENDIF}
  1003. end;
  1004. end;
  1005. //------------------------------------------------------------------------------
  1006. function PathD(const path: TPath64): TPathD;
  1007. var
  1008. i, len: integer;
  1009. begin
  1010. len := Length(path);
  1011. setLength(Result, len);
  1012. for i := 0 to len -1 do
  1013. begin
  1014. Result[i].X := path[i].X;
  1015. Result[i].Y := path[i].Y;
  1016. {$IFDEF USINGZ}
  1017. Result[i].Z := path[i].Z;
  1018. {$ENDIF}
  1019. end;
  1020. end;
  1021. //------------------------------------------------------------------------------
  1022. function Paths64(const path: TPath64): TPaths64;
  1023. begin
  1024. setLength(Result, 1);
  1025. Result[0] := path;
  1026. end;
  1027. //------------------------------------------------------------------------------
  1028. function Paths64(const pathsD: TPathsD): TPaths64;
  1029. var
  1030. i, len: integer;
  1031. begin
  1032. len := Length(pathsD);
  1033. setLength(Result, len);
  1034. for i := 0 to len -1 do
  1035. Result[i] := Path64(pathsD[i]);
  1036. end;
  1037. //------------------------------------------------------------------------------
  1038. function PathsD(const paths: TPaths64): TPathsD;
  1039. var
  1040. i, len: integer;
  1041. begin
  1042. len := Length(paths);
  1043. setLength(Result, len);
  1044. for i := 0 to len -1 do
  1045. Result[i] := PathD(paths[i]);
  1046. end;
  1047. //------------------------------------------------------------------------------
  1048. function PathsD(const path: TPathD): TPathsD;
  1049. begin
  1050. setLength(Result, 1);
  1051. Result[0] := path;
  1052. end;
  1053. //------------------------------------------------------------------------------
  1054. function ReversePath(const path: TPath64): TPath64;
  1055. var
  1056. i, highI: Integer;
  1057. begin
  1058. highI := high(path);
  1059. SetLength(Result, highI +1);
  1060. for i := 0 to highI do
  1061. Result[i] := path[highI - i];
  1062. end;
  1063. //------------------------------------------------------------------------------
  1064. function ReversePath(const path: TPathD): TPathD;
  1065. var
  1066. i, highI: Integer;
  1067. begin
  1068. highI := high(path);
  1069. SetLength(Result, highI +1);
  1070. for i := 0 to highI do
  1071. Result[i] := path[highI - i];
  1072. end;
  1073. //------------------------------------------------------------------------------
  1074. function ReversePaths(const paths: TPaths64): TPaths64;
  1075. var
  1076. i, j, highJ: Integer;
  1077. begin
  1078. i := length(paths);
  1079. SetLength(Result, i);
  1080. for i := 0 to i -1 do
  1081. begin
  1082. highJ := high(paths[i]);
  1083. SetLength(Result[i], highJ+1);
  1084. for j := 0 to highJ do
  1085. Result[i][j] := paths[i][highJ - j];
  1086. end;
  1087. end;
  1088. //------------------------------------------------------------------------------
  1089. function ReversePaths(const paths: TPathsD): TPathsD;
  1090. var
  1091. i, j, highJ: Integer;
  1092. begin
  1093. i := length(paths);
  1094. SetLength(Result, i);
  1095. for i := 0 to i -1 do
  1096. begin
  1097. highJ := high(paths[i]);
  1098. SetLength(Result[i], highJ+1);
  1099. for j := 0 to highJ do
  1100. Result[i][j] := paths[i][highJ - j];
  1101. end;
  1102. end;
  1103. //------------------------------------------------------------------------------
  1104. function ShiftPath(const path: TPath64; shift: integer): TPath64;
  1105. var
  1106. diff, len: Integer;
  1107. begin
  1108. Result := nil;
  1109. len := Length(path);
  1110. if len = 0 then Exit;
  1111. Result := Copy(path, 0, len);
  1112. shift := shift mod len;
  1113. if shift = 0 then Exit;
  1114. if shift < 0 then shift := len + shift;
  1115. diff := len - shift;
  1116. Move(path[shift], Result[0], diff *SizeOf(TPoint64));
  1117. Move(path[0], Result[diff], shift *SizeOf(TPoint64));
  1118. end;
  1119. //------------------------------------------------------------------------------
  1120. function ShiftPath(const path: TPathD; shift: integer): TPathD;
  1121. var
  1122. diff, len: Integer;
  1123. begin
  1124. Result := nil;
  1125. len := Length(path);
  1126. if len = 0 then Exit;
  1127. Result := Copy(path, 0, len);
  1128. shift := shift mod len;
  1129. if shift = 0 then Exit;
  1130. if shift < 0 then shift := len + shift;
  1131. diff := len - shift;
  1132. Move(path[shift], Result[0], diff *SizeOf(TPointD));
  1133. Move(path[0], Result[diff], shift *SizeOf(TPointD));
  1134. end;
  1135. //------------------------------------------------------------------------------
  1136. procedure AppendPoint(var path: TPath64; const pt: TPoint64);
  1137. var
  1138. len: Integer;
  1139. begin
  1140. len := length(path);
  1141. SetLength(path, len +1);
  1142. path[len] := pt;
  1143. end;
  1144. //------------------------------------------------------------------------------
  1145. function AppendPoints(const path, extra: TPath64): TPath64;
  1146. var
  1147. len1, len2: Integer;
  1148. begin
  1149. len1 := length(path);
  1150. len2 := length(extra);
  1151. SetLength(Result, len1 + len2);
  1152. if len1 > 0 then
  1153. Move(path[0], Result[0], len1 * sizeOf(TPoint64));
  1154. if len2 > 0 then
  1155. Move(extra[0], Result[len1], len2 * sizeOf(TPoint64));
  1156. end;
  1157. //------------------------------------------------------------------------------
  1158. procedure AppendPoint(var path: TPathD; const pt: TPointD);
  1159. var
  1160. len: Integer;
  1161. begin
  1162. len := length(path);
  1163. SetLength(path, len +1);
  1164. path[len] := pt;
  1165. end;
  1166. //------------------------------------------------------------------------------
  1167. procedure AppendPath(var paths: TPaths64; const extra: TPath64);
  1168. var
  1169. len: Integer;
  1170. begin
  1171. if not Assigned(extra) then Exit;
  1172. len := length(paths);
  1173. SetLength(paths, len +1);
  1174. paths[len] := extra;
  1175. end;
  1176. //------------------------------------------------------------------------------
  1177. procedure AppendPath(var paths: TPathsD; const extra: TPathD);
  1178. var
  1179. len: Integer;
  1180. begin
  1181. if not Assigned(extra) then Exit;
  1182. len := length(paths);
  1183. SetLength(paths, len +1);
  1184. paths[len] := extra;
  1185. end;
  1186. //------------------------------------------------------------------------------
  1187. procedure AppendPaths(var paths: TPaths64; const extra: TPaths64);
  1188. var
  1189. i, len1, len2: Integer;
  1190. begin
  1191. len1 := length(paths);
  1192. len2 := length(extra);
  1193. SetLength(paths, len1 + len2);
  1194. for i := 0 to len2 -1 do
  1195. paths[len1 + i] := extra[i];
  1196. end;
  1197. //------------------------------------------------------------------------------
  1198. procedure AppendPaths(var paths: TPathsD; const extra: TPathsD);
  1199. var
  1200. i, len1, len2: Integer;
  1201. begin
  1202. len1 := length(paths);
  1203. len2 := length(extra);
  1204. SetLength(paths, len1 + len2);
  1205. for i := 0 to len2 -1 do
  1206. paths[len1 + i] := extra[i];
  1207. end;
  1208. //------------------------------------------------------------------------------
  1209. function ArrayOfPathsToPaths(const ap: TArrayOfPaths): TPaths64;
  1210. var
  1211. i,j,k, len, cnt: integer;
  1212. begin
  1213. cnt := 0;
  1214. len := length(ap);
  1215. for i := 0 to len -1 do
  1216. inc(cnt, length(ap[i]));
  1217. k := 0;
  1218. setlength(result, cnt);
  1219. for i := 0 to len -1 do
  1220. for j := 0 to length(ap[i]) -1 do
  1221. begin
  1222. result[k] := ap[i][j];
  1223. inc(k);
  1224. end;
  1225. end;
  1226. //------------------------------------------------------------------------------
  1227. {$IFDEF USINGZ}
  1228. function Point64(const X, Y: Int64; Z: Int64): TPoint64;
  1229. begin
  1230. Result.X := X;
  1231. Result.Y := Y;
  1232. Result.Z := Z;
  1233. end;
  1234. //------------------------------------------------------------------------------
  1235. function Point64(const X, Y: Double; Z: Int64): TPoint64;
  1236. begin
  1237. Result.X := Round(X);
  1238. Result.Y := Round(Y);
  1239. Result.Z := Z;
  1240. end;
  1241. //------------------------------------------------------------------------------
  1242. function PointD(const X, Y: Double; Z: Int64): TPointD;
  1243. begin
  1244. Result.X := X;
  1245. Result.Y := Y;
  1246. Result.Z := Z;
  1247. end;
  1248. //------------------------------------------------------------------------------
  1249. function Point64(const pt: TPointD): TPoint64;
  1250. begin
  1251. Result.X := Round(pt.X);
  1252. Result.Y := Round(pt.Y);
  1253. Result.Z := pt.Z;
  1254. end;
  1255. //------------------------------------------------------------------------------
  1256. function PointD(const pt: TPoint64): TPointD;
  1257. begin
  1258. Result.X := pt.X;
  1259. Result.Y := pt.Y;
  1260. Result.Z := pt.Z;
  1261. end;
  1262. //------------------------------------------------------------------------------
  1263. {$ELSE}
  1264. function Point64(const X, Y: Int64): TPoint64;
  1265. begin
  1266. Result.X := X;
  1267. Result.Y := Y;
  1268. end;
  1269. //------------------------------------------------------------------------------
  1270. function Point64(const X, Y: Double): TPoint64;
  1271. begin
  1272. Result.X := Round(X);
  1273. Result.Y := Round(Y);
  1274. end;
  1275. //------------------------------------------------------------------------------
  1276. function PointD(const X, Y: Double): TPointD;
  1277. begin
  1278. Result.X := X;
  1279. Result.Y := Y;
  1280. end;
  1281. //------------------------------------------------------------------------------
  1282. function Point64(const pt: TPointD): TPoint64;
  1283. begin
  1284. Result.X := Round(pt.X);
  1285. Result.Y := Round(pt.Y);
  1286. end;
  1287. //------------------------------------------------------------------------------
  1288. function PointD(const pt: TPoint64): TPointD;
  1289. begin
  1290. Result.X := pt.X;
  1291. Result.Y := pt.Y;
  1292. end;
  1293. //------------------------------------------------------------------------------
  1294. {$ENDIF}
  1295. function Negate(const pt: TPoint64): TPoint64;
  1296. begin
  1297. Result.X := -pt.X;
  1298. Result.Y := -pt.Y;
  1299. end;
  1300. //------------------------------------------------------------------------------
  1301. function Negate(const pt: TPointD): TPointD;
  1302. begin
  1303. Result.X := -pt.X;
  1304. Result.Y := -pt.Y;
  1305. end;
  1306. //------------------------------------------------------------------------------
  1307. function NegatePath(const path: TPathD): TPathD;
  1308. var
  1309. i: Integer;
  1310. begin
  1311. Result := path;
  1312. for i := 0 to High(Result) do
  1313. with Result[i] do
  1314. begin
  1315. X := -X;
  1316. Y := -Y;
  1317. end;
  1318. end;
  1319. //------------------------------------------------------------------------------
  1320. function Rect64(const left, top, right, bottom: Int64): TRect64;
  1321. begin
  1322. Result.Left := left;
  1323. Result.Top := top;
  1324. Result.Right := right;
  1325. Result.Bottom := bottom;
  1326. end;
  1327. //------------------------------------------------------------------------------
  1328. function Rect64(const recD: TRectD): TRect64;
  1329. begin
  1330. Result.Left := Floor(recD.left);
  1331. Result.Top := Floor(recD.top);
  1332. Result.Right := Ceil(recD.right);
  1333. Result.Bottom := Ceil(recD.bottom);
  1334. end;
  1335. //------------------------------------------------------------------------------
  1336. function RectD(const left, top, right, bottom: double): TRectD;
  1337. begin
  1338. Result.Left := left;
  1339. Result.Top := top;
  1340. Result.Right := right;
  1341. Result.Bottom := bottom;
  1342. end;
  1343. //------------------------------------------------------------------------------
  1344. function RectD(const rec64: TRect64): TRectD; overload;
  1345. begin
  1346. Result.Left := rec64.left;
  1347. Result.Top := rec64.top;
  1348. Result.Right := rec64.right;
  1349. Result.Bottom := rec64.bottom;
  1350. end;
  1351. //------------------------------------------------------------------------------
  1352. function GetBounds(const paths: TArrayOfPaths): TRect64; overload;
  1353. var
  1354. i,j,k: Integer;
  1355. p: PPoint64;
  1356. begin
  1357. Result := Rect64(MaxInt64, MaxInt64, -MaxInt64, -MaxInt64);
  1358. for i := 0 to High(paths) do
  1359. for j := 0 to High(paths[i]) do
  1360. if Assigned(paths[i][j]) then
  1361. begin
  1362. p := @paths[i][j][0];
  1363. for k := 0 to High(paths[i][j]) do
  1364. begin
  1365. if p.X < Result.Left then Result.Left := p.X;
  1366. if p.X > Result.Right then Result.Right := p.X;
  1367. if p.Y < Result.Top then Result.Top := p.Y;
  1368. if p.Y > Result.Bottom then Result.Bottom := p.Y;
  1369. inc(p);
  1370. end;
  1371. end;
  1372. if Result.Left > Result.Right then Result := NullRect64;
  1373. end;
  1374. //------------------------------------------------------------------------------
  1375. function GetBounds(const paths: TPaths64): TRect64;
  1376. var
  1377. i,j: Integer;
  1378. p: PPoint64;
  1379. begin
  1380. Result := Rect64(MaxInt64, MaxInt64, -MaxInt64, -MaxInt64);
  1381. for i := 0 to High(paths) do
  1382. if Assigned(paths[i]) then
  1383. begin
  1384. p := @paths[i][0];
  1385. for j := 0 to High(paths[i]) do
  1386. begin
  1387. if p.X < Result.Left then Result.Left := p.X;
  1388. if p.X > Result.Right then Result.Right := p.X;
  1389. if p.Y < Result.Top then Result.Top := p.Y;
  1390. if p.Y > Result.Bottom then Result.Bottom := p.Y;
  1391. inc(p);
  1392. end;
  1393. end;
  1394. if Result.Left = MaxInt64 then Result := NullRect64;
  1395. end;
  1396. //------------------------------------------------------------------------------
  1397. function GetBounds(const paths: TPathsD): TRectD;
  1398. var
  1399. i,j: Integer;
  1400. p: PPointD;
  1401. begin
  1402. Result := RectD(MaxDouble, MaxDouble, -MaxDouble, -MaxDouble);
  1403. for i := 0 to High(paths) do
  1404. if Assigned(paths[i]) then
  1405. begin
  1406. p := @paths[i][0];
  1407. for j := 0 to High(paths[i]) do
  1408. begin
  1409. if p.X < Result.Left then Result.Left := p.X;
  1410. if p.X > Result.Right then Result.Right := p.X;
  1411. if p.Y < Result.Top then Result.Top := p.Y;
  1412. if p.Y > Result.Bottom then Result.Bottom := p.Y;
  1413. inc(p);
  1414. end;
  1415. end;
  1416. if Result.Left = MaxDouble then Result := NullRectD;
  1417. end;
  1418. //------------------------------------------------------------------------------
  1419. function GetBounds(const path: TPath64): TRect64;
  1420. var
  1421. i, len: Integer;
  1422. p: PPoint64;
  1423. begin
  1424. len := Length(path);
  1425. if len = 0 then
  1426. begin
  1427. Result := NullRect64;
  1428. Exit;
  1429. end;
  1430. Result := Rect64(MaxInt64, MaxInt64, -MaxInt64, -MaxInt64);
  1431. p := @path[0];
  1432. for i := 0 to High(path) do
  1433. begin
  1434. if p.X < Result.Left then Result.Left := p.X;
  1435. if p.X > Result.Right then Result.Right := p.X;
  1436. if p.Y < Result.Top then Result.Top := p.Y;
  1437. if p.Y > Result.Bottom then Result.Bottom := p.Y;
  1438. inc(p);
  1439. end;
  1440. end;
  1441. //------------------------------------------------------------------------------
  1442. function GetBounds(const path: TPathD): TRectD;
  1443. var
  1444. i, len: Integer;
  1445. p: PPointD;
  1446. begin
  1447. len := Length(path);
  1448. if len = 0 then
  1449. begin
  1450. Result := NullRectD;
  1451. Exit;
  1452. end;
  1453. Result := RectD(infinity, infinity, -infinity, -infinity);
  1454. p := @path[0];
  1455. for i := 0 to High(path) do
  1456. begin
  1457. if p.X < Result.Left then Result.Left := p.X;
  1458. if p.X > Result.Right then Result.Right := p.X;
  1459. if p.Y < Result.Top then Result.Top := p.Y;
  1460. if p.Y > Result.Bottom then Result.Bottom := p.Y;
  1461. inc(p);
  1462. end;
  1463. end;
  1464. //------------------------------------------------------------------------------
  1465. function TranslatePoint(const pt: TPoint64; dx, dy: Int64): TPoint64;
  1466. begin
  1467. Result.X := pt.X + dx;
  1468. Result.Y := pt.Y + dy;
  1469. end;
  1470. //------------------------------------------------------------------------------
  1471. function TranslatePoint(const pt: TPointD; dx, dy: double): TPointD;
  1472. begin
  1473. Result.X := pt.X + dx;
  1474. Result.Y := pt.Y + dy;
  1475. end;
  1476. //------------------------------------------------------------------------------
  1477. procedure InflateRect(var rec: TRect64; dx, dy: Int64);
  1478. begin
  1479. dec(rec.Left, dx);
  1480. inc(rec.Right, dx);
  1481. dec(rec.Top, dy);
  1482. inc(rec.Bottom, dy);
  1483. end;
  1484. //------------------------------------------------------------------------------
  1485. procedure InflateRect(var rec: TRectD; dx, dy: double);
  1486. begin
  1487. rec.Left := rec.Left - dx;
  1488. rec.Right := rec.Right + dx;
  1489. rec.Top := rec.Top - dy;
  1490. rec.Bottom := rec.Bottom + dy;
  1491. end;
  1492. //------------------------------------------------------------------------------
  1493. procedure RotatePt(var pt: TPointD; const center: TPointD; sinA, cosA: double);
  1494. var
  1495. tmpX, tmpY: double;
  1496. begin
  1497. tmpX := pt.X-center.X;
  1498. tmpY := pt.Y-center.Y;
  1499. pt.X := tmpX * cosA - tmpY * sinA + center.X;
  1500. pt.Y := tmpX * sinA + tmpY * cosA + center.Y;
  1501. end;
  1502. //------------------------------------------------------------------------------
  1503. procedure RotatePath(var path: TPathD; const center: TPointD; sinA, cosA: double);
  1504. var
  1505. i: integer;
  1506. begin
  1507. for i := 0 to High(path) do
  1508. RotatePt(path[i], center, sinA, cosA);
  1509. end;
  1510. //------------------------------------------------------------------------------
  1511. function RotateRect(const rec: TRectD; angleRad: double): TRectD;
  1512. var
  1513. i: integer;
  1514. sinA, cosA: double;
  1515. cp: TPointD;
  1516. pts: TPathD;
  1517. begin
  1518. setLength(pts, 4);
  1519. sinA := Sin(-angleRad);
  1520. cosA := cos(-angleRad);
  1521. cp.X := (rec.Right + rec.Left) / 2;
  1522. cp.Y := (rec.Bottom + rec.Top) / 2;
  1523. pts[0] := PointD(rec.Left, rec.Top);
  1524. pts[1] := PointD(rec.Right, rec.Top);
  1525. pts[2] := PointD(rec.Left, rec.Bottom);
  1526. pts[3] := PointD(rec.Right, rec.Bottom);
  1527. for i := 0 to 3 do RotatePt(pts[i], cp, sinA, cosA);
  1528. result.Left := pts[0].X;
  1529. result.Right := result.Left;
  1530. result.Top := pts[0].Y;
  1531. result.Bottom := result.Top;
  1532. for i := 1 to 3 do
  1533. begin
  1534. if pts[i].X < result.Left then result.Left := pts[i].X;
  1535. if pts[i].Y < result.Top then result.Top := pts[i].Y;
  1536. if pts[i].X > result.Right then result.Right := pts[i].X;
  1537. if pts[i].Y > result.Bottom then result.Bottom := pts[i].Y;
  1538. end;
  1539. end;
  1540. //------------------------------------------------------------------------------
  1541. function RotateRect(const rec: TRect64; angleRad: double): TRect64;
  1542. var
  1543. recD: TRectD;
  1544. begin
  1545. recD := RectD(rec.Left, rec.Top, rec.Right, rec.Bottom);
  1546. recD := RotateRect(recD, angleRad);
  1547. result.Left := Floor(recD.Left);
  1548. result.Top := Floor(recD.Top);
  1549. result.Right := Ceil(recD.Right);
  1550. result.Bottom := Ceil(recD.Bottom);
  1551. end;
  1552. //------------------------------------------------------------------------------
  1553. procedure OffsetRect(var rec: TRect64; dx, dy: Int64);
  1554. begin
  1555. inc(rec.Left, dx); inc(rec.Top, dy);
  1556. inc(rec.Right, dx); inc(rec.Bottom, dy);
  1557. end;
  1558. //------------------------------------------------------------------------------
  1559. procedure OffsetRect(var rec: TRectD; dx, dy: double);
  1560. begin
  1561. rec.Left := rec.Left + dx;
  1562. rec.Right := rec.Right + dx;
  1563. rec.Top := rec.Top + dy;
  1564. rec.Bottom := rec.Bottom + dy;
  1565. end;
  1566. //------------------------------------------------------------------------------
  1567. function UnionRect(const rec, rec2: TRect64): TRect64;
  1568. begin
  1569. // nb: don't use rec.IsEmpty as this will
  1570. // reject open axis-aligned flat paths
  1571. if (rec.Width <= 0) and (rec.Height <= 0) then result := rec2
  1572. else if (rec2.Width <= 0) and (rec2.Height <= 0) then result := rec
  1573. else
  1574. begin
  1575. result.Left := min(rec.Left, rec2.Left);
  1576. result.Right := max(rec.Right, rec2.Right);
  1577. result.Top := min(rec.Top, rec2.Top);
  1578. result.Bottom := max(rec.Bottom, rec2.Bottom);
  1579. end;
  1580. end;
  1581. //------------------------------------------------------------------------------
  1582. function UnionRect(const rec, rec2: TRectD): TRectD;
  1583. begin
  1584. // nb: don't use rec.IsEmpty as this will
  1585. // reject open axis-aligned flat paths
  1586. if (rec.Width <= 0) and (rec.Height <= 0) then result := rec2
  1587. else if (rec2.Width <= 0) and (rec2.Height <= 0) then result := rec
  1588. else
  1589. begin
  1590. result.Left := min(rec.Left, rec2.Left);
  1591. result.Right := max(rec.Right, rec2.Right);
  1592. result.Top := min(rec.Top, rec2.Top);
  1593. result.Bottom := max(rec.Bottom, rec2.Bottom);
  1594. end;
  1595. end;
  1596. //------------------------------------------------------------------------------
  1597. function Area(const path: TPath64): Double;
  1598. var
  1599. i, highI: Integer;
  1600. d: double;
  1601. p1,p2: PPoint64;
  1602. begin
  1603. // shoelace formula
  1604. Result := 0.0;
  1605. highI := High(path);
  1606. if highI < 2 then Exit;
  1607. p1 := @path[highI];
  1608. p2 := @path[0];
  1609. for i := 0 to highI do
  1610. begin
  1611. d := (p1.Y + p2.Y); // needed for Delphi7
  1612. Result := Result + d * (p1.X - p2.X);
  1613. p1 := p2; inc(p2);
  1614. end;
  1615. Result := Result * 0.5;
  1616. end;
  1617. //------------------------------------------------------------------------------
  1618. function Area(const paths: TPaths64): Double;
  1619. var
  1620. i: integer;
  1621. begin
  1622. Result := 0;
  1623. for i := 0 to High(paths) do
  1624. Result := Result + Area(paths[i]);
  1625. end;
  1626. //------------------------------------------------------------------------------
  1627. function Area(const path: TPathD): Double;
  1628. var
  1629. i, highI: Integer;
  1630. p1,p2: PPointD;
  1631. begin
  1632. // https://en.wikipedia.org/wiki/Shoelace_formula
  1633. Result := 0.0;
  1634. highI := High(path);
  1635. if highI < 2 then Exit;
  1636. p1 := @path[highI];
  1637. p2 := @path[0];
  1638. for i := 0 to highI do
  1639. begin
  1640. Result := Result + (p1.Y + p2.Y) * (p1.X - p2.X);
  1641. p1 := p2; inc(p2);
  1642. end;
  1643. Result := Result * 0.5;
  1644. end;
  1645. //------------------------------------------------------------------------------
  1646. function Area(const paths: TPathsD): Double;
  1647. var
  1648. i: integer;
  1649. begin
  1650. Result := 0;
  1651. for i := 0 to High(paths) do
  1652. Result := Result + Area(paths[i]);
  1653. end;
  1654. //------------------------------------------------------------------------------
  1655. function IsPositive(const path: TPath64): Boolean;
  1656. begin
  1657. Result := (Area(path) >= 0);
  1658. end;
  1659. //------------------------------------------------------------------------------
  1660. function IsPositive(const path: TPathD): Boolean;
  1661. begin
  1662. Result := (Area(path) >= 0);
  1663. end;
  1664. //------------------------------------------------------------------------------
  1665. function TriSign(val: Int64): integer; // returns 0, 1 or -1
  1666. {$IFDEF INLINING} inline; {$ENDIF}
  1667. begin
  1668. if (val < 0) then Result := -1
  1669. else if (val > 1) then Result := 1
  1670. else Result := 0;
  1671. end;
  1672. //------------------------------------------------------------------------------
  1673. type
  1674. TMultiplyUInt64Result = record
  1675. lo64: UInt64;
  1676. hi64 : UInt64;
  1677. end;
  1678. function MultiplyUInt64(a, b: UInt64): TMultiplyUInt64Result; // #834, #835
  1679. {$IFDEF INLINING} inline; {$ENDIF}
  1680. var
  1681. x1, x2, x3: UInt64;
  1682. begin
  1683. x1 := (a and $FFFFFFFF) * (b and $FFFFFFFF);
  1684. x2 := (a shr 32) * (b and $FFFFFFFF) + (x1 shr 32);
  1685. x3 := (a and $FFFFFFFF) * (b shr 32) + (x2 and $FFFFFFFF);
  1686. Result.lo64 := ((x3 and $FFFFFFFF) shl 32) or (x1 and $FFFFFFFF);
  1687. Result.hi64 := hi(a shr 32) * (b shr 32) + (x2 shr 32) + (x3 shr 32);
  1688. end;
  1689. //------------------------------------------------------------------------------
  1690. function ProductsAreEqual(a, b, c, d: Int64): Boolean;
  1691. var
  1692. absA,absB,absC,absD: UInt64;
  1693. absAB, absCD : TMultiplyUInt64Result;
  1694. signAB, signCD : integer;
  1695. begin
  1696. // nb: unsigned values will be needed for CalcOverflowCarry()
  1697. absA := UInt64(Abs(a));
  1698. absB := UInt64(Abs(b));
  1699. absC := UInt64(Abs(c));
  1700. absD := UInt64(Abs(d));
  1701. absAB := MultiplyUInt64(absA, absB);
  1702. absCD := MultiplyUInt64(absC, absD);
  1703. // nb: it's important to differentiate 0 values here from other values
  1704. signAB := TriSign(a) * TriSign(b);
  1705. signCD := TriSign(c) * TriSign(d);
  1706. Result := (absAB.lo64 = absCD.lo64) and
  1707. (absAB.hi64 = absCD.hi64) and (signAB = signCD);
  1708. end;
  1709. //------------------------------------------------------------------------------
  1710. function IsCollinear(const pt1, sharedPt, pt2: TPoint64): Boolean;
  1711. var
  1712. a,b,c,d: Int64;
  1713. begin
  1714. a := sharedPt.X - pt1.X;
  1715. b := pt2.Y - sharedPt.Y;
  1716. c := sharedPt.Y - pt1.Y;
  1717. d := pt2.X - sharedPt.X;
  1718. // When checking for collinearity with very large coordinate values
  1719. // then ProductsAreEqual is more accurate than using CrossProduct.
  1720. Result := ProductsAreEqual(a, b, c, d);
  1721. end;
  1722. //------------------------------------------------------------------------------
  1723. function CrossProduct(const pt1, pt2, pt3: TPoint64): double;
  1724. begin
  1725. result := CrossProduct(
  1726. pt2.X - pt1.X, pt2.Y - pt1.Y,
  1727. pt3.X - pt2.X, pt3.Y - pt2.Y);
  1728. end;
  1729. //------------------------------------------------------------------------------
  1730. function CrossProduct(const pt1, pt2, pt3: TPointD): double;
  1731. begin
  1732. result := CrossProduct(
  1733. pt2.X - pt1.X, pt2.Y - pt1.Y,
  1734. pt3.X - pt2.X, pt3.Y - pt2.Y);
  1735. end;
  1736. //------------------------------------------------------------------------------
  1737. function CrossProduct(const vec1, vec2: TPointD): double;
  1738. begin
  1739. result := (vec1.X * vec2.Y - vec1.Y * vec2.X);
  1740. end;
  1741. //------------------------------------------------------------------------------
  1742. function CrossProduct(vec1x, vec1y, vec2x, vec2y: double): double;
  1743. begin
  1744. result := (vec1x * vec2y - vec1y * vec2x);
  1745. end;
  1746. //------------------------------------------------------------------------------
  1747. function DotProduct(const pt1, pt2, pt3: TPoint64): double;
  1748. var
  1749. x1,x2,y1,y2: double; // avoids potential int overflow
  1750. begin
  1751. x1 := pt2.X - pt1.X;
  1752. y1 := pt2.Y - pt1.Y;
  1753. x2 := pt3.X - pt2.X;
  1754. y2 := pt3.Y - pt2.Y;
  1755. result := (x1 * x2 + y1 * y2);
  1756. end;
  1757. //------------------------------------------------------------------------------
  1758. function SqrInt64(val: Int64): double; {$IFDEF INLINING} inline; {$ENDIF}
  1759. begin
  1760. Result := val; // force conversion
  1761. Result := Result * Result;
  1762. end;
  1763. //------------------------------------------------------------------------------
  1764. function DistanceSqr(const pt1, pt2: TPoint64): double;
  1765. begin
  1766. Result := SqrInt64(pt1.X - pt2.X) + SqrInt64(pt1.Y - pt2.Y);
  1767. end;
  1768. //------------------------------------------------------------------------------
  1769. function DistanceSqr(const pt1, pt2: TPointD): double;
  1770. begin
  1771. Result := Sqr(pt1.X - pt2.X) + Sqr(pt1.Y - pt2.Y);
  1772. end;
  1773. //------------------------------------------------------------------------------
  1774. function PerpendicDistFromLineSqrd(const pt, linePt1, linePt2: TPoint64): double;
  1775. var
  1776. a,b,c: double;
  1777. begin
  1778. // perpendicular distance of point (x0,y0) = (a*x0 + b*y0 + C)/Sqrt(a*a + b*b)
  1779. // where ax + by +c = 0 is the equation of the line
  1780. // see https://en.wikipedia.org/wiki/Distance_from_a_point_to_a_line
  1781. a := (linePt1.Y - linePt2.Y);
  1782. b := (linePt2.X - linePt1.X);
  1783. c := a * linePt1.X + b * linePt1.Y;
  1784. c := a * pt.x + b * pt.y - c;
  1785. if (a = 0) and (b = 0) then
  1786. Result := 0 else
  1787. Result := (c * c) / (a * a + b * b);
  1788. end;
  1789. //---------------------------------------------------------------------------
  1790. function PerpendicDistFromLineSqrd(const pt, linePt1, linePt2: TPointD): double;
  1791. var
  1792. a,b,c: double;
  1793. begin
  1794. a := (linePt1.Y - linePt2.Y);
  1795. b := (linePt2.X - linePt1.X);
  1796. c := a * linePt1.X + b * linePt1.Y;
  1797. c := a * pt.x + b * pt.y - c;
  1798. if (a = 0) and (b = 0) then
  1799. Result := 0 else
  1800. Result := (c * c) / (a * a + b * b);
  1801. end;
  1802. //---------------------------------------------------------------------------
  1803. function CleanPath(const path: TPath64): TPath64;
  1804. var
  1805. i,j, len: integer;
  1806. prev: TPoint64;
  1807. begin
  1808. Result := nil;
  1809. len := Length(path);
  1810. while (len > 2) and
  1811. (IsCollinear(path[len-2], path[len-1], path[0])) do dec(len);
  1812. SetLength(Result, len);
  1813. if (len < 2) then Exit;
  1814. prev := path[len -1];
  1815. j := 0;
  1816. for i := 0 to len -2 do
  1817. begin
  1818. if IsCollinear(prev, path[i], path[i+1]) then Continue;
  1819. Result[j] := path[i];
  1820. inc(j);
  1821. prev := path[i];
  1822. end;
  1823. Result[j] := path[len -1];
  1824. SetLength(Result, j+1);
  1825. end;
  1826. //------------------------------------------------------------------------------
  1827. function GetSign(const val: double): integer; {$IFDEF INLINING} inline; {$ENDIF}
  1828. begin
  1829. if val = 0 then Result := 0
  1830. else if val < 0 then Result := -1
  1831. else Result := 1;
  1832. end;
  1833. //------------------------------------------------------------------------------
  1834. function SegmentsIntersect(const s1a, s1b, s2a, s2b: TPoint64;
  1835. inclusive: Boolean): boolean;
  1836. var
  1837. res1, res2, res3, res4: double;
  1838. begin
  1839. if inclusive then
  1840. begin
  1841. //result can include segments that only touch
  1842. Result := false;
  1843. res1 := CrossProduct(s1a, s2a, s2b);
  1844. res2 := CrossProduct(s1b, s2a, s2b);
  1845. if (res1 * res2 > 0) then Exit;
  1846. res3 := CrossProduct(s2a, s1a, s1b);
  1847. res4 := CrossProduct(s2b, s1a, s1b);
  1848. if (res3 * res4 > 0) then Exit;
  1849. Result := (res1 <> 0) or (res2 <> 0) or
  1850. (res3 <> 0) or (res4 <> 0); // ensures not collinear
  1851. end else
  1852. begin
  1853. result := (GetSign(CrossProduct(s1a, s2a, s2b)) *
  1854. GetSign(CrossProduct(s1b, s2a, s2b)) < 0) and
  1855. (GetSign(CrossProduct(s2a, s1a, s1b)) *
  1856. GetSign(CrossProduct(s2b, s1a, s1b)) < 0);
  1857. end;
  1858. end;
  1859. //------------------------------------------------------------------------------
  1860. function GetSegmentIntersectPt(const ln1a, ln1b, ln2a, ln2b: TPoint64;
  1861. out ip: TPoint64): Boolean;
  1862. var
  1863. dx1,dy1, dx2,dy2, t, cp: double;
  1864. begin
  1865. // https://en.wikipedia.org/wiki/Line%E2%80%93line_intersection
  1866. dy1 := (ln1b.y - ln1a.y);
  1867. dx1 := (ln1b.x - ln1a.x);
  1868. dy2 := (ln2b.y - ln2a.y);
  1869. dx2 := (ln2b.x - ln2a.x);
  1870. cp := dy1 * dx2 - dy2 * dx1;
  1871. Result := (cp <> 0.0);
  1872. if not Result then Exit;
  1873. t := ((ln1a.x-ln2a.x) * dy2 - (ln1a.y-ln2a.y) * dx2) / cp;
  1874. if t <= 0.0 then ip := ln1a
  1875. else if t >= 1.0 then ip := ln1b;
  1876. ip.X := Trunc(ln1a.X + t * dx1);
  1877. ip.Y := Trunc(ln1a.Y + t * dy1);
  1878. {$IFDEF USINGZ}
  1879. ip.Z := 0;
  1880. {$ENDIF}
  1881. end;
  1882. //------------------------------------------------------------------------------
  1883. {$R-}
  1884. function PointInPolygon(const pt: TPoint64;
  1885. const polygon: TPath64): TPointInPolygonResult;
  1886. var
  1887. len, val: Integer;
  1888. isAbove, startingAbove: Boolean;
  1889. d: Double; // avoids integer overflow
  1890. curr, prev, cbegin, cend, first: PPoint64;
  1891. begin
  1892. result := pipOutside;
  1893. len := Length(polygon);
  1894. if len < 3 then Exit;
  1895. cbegin := @polygon[0];
  1896. cend := @polygon[len]; // stop is just past the last point (nb {$R-})
  1897. first := cbegin;
  1898. while (first <> cend) and (first.Y = pt.Y) do inc(first);
  1899. if (first = cend) then Exit; // not a proper polygon
  1900. isAbove := first.Y < pt.Y;
  1901. startingAbove := isAbove;
  1902. Result := pipOn;
  1903. curr := first;
  1904. inc(curr);
  1905. val := 0;
  1906. while true do
  1907. begin
  1908. if (curr = cend) then
  1909. begin
  1910. if (cend = first) or (first = cbegin) then break;
  1911. cend := first;
  1912. curr := cbegin;
  1913. end;
  1914. if isAbove then
  1915. begin
  1916. while (curr <> cend) and (curr.Y < pt.Y) do inc(curr);
  1917. if (curr = cend) then Continue;
  1918. end else
  1919. begin
  1920. while (curr <> cend) and (curr.Y > pt.Y) do inc(curr);
  1921. if (curr = cend) then Continue;
  1922. end;
  1923. if curr = cbegin then
  1924. prev := @polygon[len] else // NOT cend!
  1925. prev := curr;
  1926. dec(prev);
  1927. if (curr.Y = pt.Y) then
  1928. begin
  1929. if (curr.X = pt.X) or ((curr.Y = prev.Y) and
  1930. ((pt.X < prev.X) <> (pt.X < curr.X))) then Exit;
  1931. inc(curr);
  1932. if (curr = first) then Break;
  1933. Continue;
  1934. end;
  1935. if (pt.X < curr.X) and (pt.X < prev.X) then
  1936. // we're only interested in edges crossing on the left
  1937. else if((pt.X > prev.X) and (pt.X > curr.X)) then
  1938. val := 1 - val // toggle val
  1939. else
  1940. begin
  1941. d := CrossProduct(prev^, curr^, pt);
  1942. if d = 0 then Exit; // ie point on path
  1943. if (d < 0) = isAbove then val := 1 - val;
  1944. end;
  1945. isAbove := not isAbove;
  1946. inc(curr);
  1947. end;
  1948. if (isAbove <> startingAbove) then
  1949. begin
  1950. cend := @polygon[len];
  1951. if (curr = cend) then curr := cbegin;
  1952. if curr = cbegin then
  1953. prev := cend else
  1954. prev := curr;
  1955. dec(prev);
  1956. d := CrossProduct(prev^, curr^, pt);
  1957. if d = 0 then Exit; // ie point on path
  1958. if (d < 0) = isAbove then val := 1 - val;
  1959. end;
  1960. if val = 0 then
  1961. result := pipOutside else
  1962. result := pipInside;
  1963. end;
  1964. //------------------------------------------------------------------------------
  1965. {$R+}
  1966. procedure GetSinCos(angle: double; out sinA, cosA: double);
  1967. {$IFDEF INLINE} inline; {$ENDIF}
  1968. {$IFNDEF FPC}
  1969. var s, c: extended;
  1970. {$ENDIF}
  1971. begin
  1972. {$IFDEF FPC}
  1973. Math.SinCos(angle, sinA, cosA);
  1974. {$ELSE}
  1975. Math.SinCos(angle, s, c);
  1976. sinA := s; cosA := c;
  1977. {$ENDIF}
  1978. end;
  1979. //------------------------------------------------------------------------------
  1980. function Ellipse(const rec: TRect64; steps: integer): TPath64;
  1981. begin
  1982. Result := Path64(Ellipse(RectD(rec), steps));
  1983. end;
  1984. //------------------------------------------------------------------------------
  1985. function Ellipse(const rec: TRectD; steps: integer): TPathD;
  1986. var
  1987. i: Integer;
  1988. sinA, cosA: double;
  1989. centre, radius, delta: TPointD;
  1990. begin
  1991. result := nil;
  1992. if rec.IsEmpty then Exit;
  1993. with rec do
  1994. begin
  1995. centre := rec.MidPoint;
  1996. radius := PointD(Width * 0.5, Height * 0.5);
  1997. end;
  1998. if (steps < 3) then
  1999. steps := Ceil(PI * sqrt(rec.width + rec.height));
  2000. GetSinCos(2 * Pi / Steps, sinA, cosA);
  2001. delta.x := cosA; delta.y := sinA;
  2002. SetLength(Result, Steps);
  2003. Result[0] := PointD(centre.X + radius.X, centre.Y);
  2004. for i := 1 to steps -1 do
  2005. begin
  2006. Result[i] := PointD(centre.X + radius.X * delta.x,
  2007. centre.Y + radius.y * delta.y);
  2008. delta := PointD(delta.X * cosA - delta.Y * sinA,
  2009. delta.Y * cosA + delta.X * sinA);
  2010. end; // rotates clockwise
  2011. end;
  2012. //------------------------------------------------------------------------------
  2013. function GetClosestPointOnSegment(const pt, seg1, seg2: TPoint64): TPoint64;
  2014. var
  2015. dx, dy, q: double;
  2016. begin
  2017. if (seg1.X = seg2.X) and (seg1.Y = seg2.Y) then
  2018. begin
  2019. Result := seg1;
  2020. Exit;
  2021. end;
  2022. dx := (seg2.X - seg1.X);
  2023. dy := (seg2.Y - seg1.Y);
  2024. q := ((pt.X - seg1.X) * dx + (pt.Y - seg1.Y) * dy) / (Sqr(dx) + Sqr(dy));
  2025. if (q < 0) then q := 0
  2026. else if (q > 1) then q := 1;
  2027. Result := Point64(
  2028. seg1.X + Round(q * dx),
  2029. seg1.Y + Round(q * dy));
  2030. end;
  2031. //------------------------------------------------------------------------------
  2032. procedure RDP(const path: TPath64; startIdx, endIdx: integer;
  2033. epsilonSqrd: double; var boolArray: TArrayOfBoolean); overload;
  2034. var
  2035. i, idx: integer;
  2036. d, maxD: double;
  2037. begin
  2038. idx := 0;
  2039. maxD := 0;
  2040. while (endIdx > startIdx) and
  2041. PointsEqual(path[startIdx], path[endIdx]) do
  2042. begin
  2043. boolArray[endIdx] := false;
  2044. dec(endIdx);
  2045. end;
  2046. for i := startIdx +1 to endIdx -1 do
  2047. begin
  2048. // PerpendicDistFromLineSqrd - avoids expensive Sqrt()
  2049. d := PerpendicDistFromLineSqrd(path[i], path[startIdx], path[endIdx]);
  2050. if d <= maxD then Continue;
  2051. maxD := d;
  2052. idx := i;
  2053. end;
  2054. if maxD < epsilonSqrd then Exit;
  2055. boolArray[idx] := true;
  2056. if idx > startIdx + 1 then RDP(path, startIdx, idx, epsilonSqrd, boolArray);
  2057. if endIdx > idx + 1 then RDP(path, idx, endIdx, epsilonSqrd, boolArray);
  2058. end;
  2059. //------------------------------------------------------------------------------
  2060. procedure RDP(const path: TPathD; startIdx, endIdx: integer;
  2061. epsilonSqrd: double; var boolArray: TArrayOfBoolean); overload;
  2062. var
  2063. i, idx: integer;
  2064. d, maxD: double;
  2065. begin
  2066. idx := 0;
  2067. maxD := 0;
  2068. while (endIdx > startIdx) and
  2069. PointsNearEqual(path[startIdx], path[endIdx]) do
  2070. begin
  2071. boolArray[endIdx] := false;
  2072. dec(endIdx);
  2073. end;
  2074. for i := startIdx +1 to endIdx -1 do
  2075. begin
  2076. // PerpendicDistFromLineSqrd - avoids expensive Sqrt()
  2077. d := PerpendicDistFromLineSqrd(path[i], path[startIdx], path[endIdx]);
  2078. if d <= maxD then Continue;
  2079. maxD := d;
  2080. idx := i;
  2081. end;
  2082. if maxD < epsilonSqrd then Exit;
  2083. boolArray[idx] := true;
  2084. if idx > startIdx + 1 then RDP(path, startIdx, idx, epsilonSqrd, boolArray);
  2085. if endIdx > idx + 1 then RDP(path, idx, endIdx, epsilonSqrd, boolArray);
  2086. end;
  2087. //------------------------------------------------------------------------------
  2088. function RamerDouglasPeucker(const path: TPath64; epsilon: double): TPath64;
  2089. var
  2090. i,j, len: integer;
  2091. boolArray: TArrayOfBoolean;
  2092. begin
  2093. len := length(path);
  2094. if len < 5 then
  2095. begin
  2096. result := Copy(path, 0, len);
  2097. Exit;
  2098. end;
  2099. SetLength(boolArray, len); // already zero initialized
  2100. boolArray[0] := true;
  2101. boolArray[len -1] := true;
  2102. RDP(path, 0, len -1, Sqr(epsilon), boolArray);
  2103. j := 0;
  2104. SetLength(Result, len);
  2105. for i := 0 to len -1 do
  2106. if boolArray[i] then
  2107. begin
  2108. Result[j] := path[i];
  2109. inc(j);
  2110. end;
  2111. SetLength(Result, j);
  2112. end;
  2113. //------------------------------------------------------------------------------
  2114. function RamerDouglasPeucker(const paths: TPaths64; epsilon: double): TPaths64;
  2115. var
  2116. i, len: integer;
  2117. begin
  2118. len := Length(paths);
  2119. SetLength(Result, len);
  2120. for i := 0 to len -1 do
  2121. Result[i] := RamerDouglasPeucker(paths[i], epsilon);
  2122. end;
  2123. //------------------------------------------------------------------------------
  2124. function RamerDouglasPeucker(const path: TPathD; epsilon: double): TPathD; overload;
  2125. var
  2126. i,j, len: integer;
  2127. boolArray: TArrayOfBoolean;
  2128. begin
  2129. len := length(path);
  2130. if len < 5 then
  2131. begin
  2132. result := Copy(path, 0, len);
  2133. Exit;
  2134. end;
  2135. SetLength(boolArray, len); // already zero initialized
  2136. boolArray[0] := true;
  2137. boolArray[len -1] := true;
  2138. RDP(path, 0, len -1, Sqr(epsilon), boolArray);
  2139. j := 0;
  2140. SetLength(Result, len);
  2141. for i := 0 to len -1 do
  2142. if boolArray[i] then
  2143. begin
  2144. Result[j] := path[i];
  2145. inc(j);
  2146. end;
  2147. SetLength(Result, j);
  2148. end;
  2149. //------------------------------------------------------------------------------
  2150. function RamerDouglasPeucker(const paths: TPathsD; epsilon: double): TPathsD; overload;
  2151. var
  2152. i, len: integer;
  2153. begin
  2154. len := Length(paths);
  2155. SetLength(Result, len);
  2156. for i := 0 to len -1 do
  2157. Result[i] := RamerDouglasPeucker(paths[i], epsilon);
  2158. end;
  2159. //------------------------------------------------------------------------------
  2160. end.