GR32_VectorUtils.pas 89 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834
  1. unit GR32_VectorUtils;
  2. (* ***** BEGIN LICENSE BLOCK *****
  3. * Version: MPL 1.1 or LGPL 2.1 with linking exception
  4. *
  5. * The contents of this file are subject to the Mozilla Public License Version
  6. * 1.1 (the "License"); you may not use this file except in compliance with
  7. * the License. You may obtain a copy of the License at
  8. * http://www.mozilla.org/MPL/
  9. *
  10. * Software distributed under the License is distributed on an "AS IS" basis,
  11. * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  12. * for the specific language governing rights and limitations under the
  13. * License.
  14. *
  15. * Alternatively, the contents of this file may be used under the terms of the
  16. * Free Pascal modified version of the GNU Lesser General Public License
  17. * Version 2.1 (the "FPC modified LGPL License"), in which case the provisions
  18. * of this license are applicable instead of those above.
  19. * Please see the file LICENSE.txt for additional information concerning this
  20. * license.
  21. *
  22. * The Original Code is Vectorial Polygon Rasterizer for Graphics32
  23. *
  24. * The Initial Developer of the Original Code is
  25. * Mattias Andersson <[email protected]>
  26. *
  27. * Portions created by the Initial Developer are Copyright (C) 2008-2012
  28. * the Initial Developer. All Rights Reserved.
  29. *
  30. * ***** END LICENSE BLOCK ***** *)
  31. interface
  32. {$include GR32.inc}
  33. {$BOOLEVAL OFF}
  34. {-$define GR32_OFFSET_CLIPPER}
  35. {-$define GR32_OFFSET_ANGUS}
  36. {-$define GR32_OFFSET_REF}
  37. {$if (not defined(GR32_OFFSET_REF)) and (not defined(GR32_OFFSET_CLIPPER)) and (not defined(GR32_OFFSET_ANGUS))}
  38. // We need at least one implementation. Fallback to the reference implementation.
  39. {$define GR32_OFFSET_REF}
  40. {$ifend}
  41. uses
  42. {$if defined(UseInlining)}
  43. Types,
  44. {$ifend}
  45. Math,
  46. GR32,
  47. GR32_Transforms,
  48. GR32_Polygons;
  49. const
  50. DEFAULT_MITER_LIMIT = 4.0;
  51. DEFAULT_MITER_LIMIT_FIXED = $40000;
  52. TWOPI = 2 * Pi;
  53. function InSignedRange(const X, X1, X2: TFloat): Boolean; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  54. function InSignedRange(const X, X1, X2: TFixed): Boolean; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  55. function Intersect(const A1, A2, B1, B2: TFloatPoint; out P: TFloatPoint): Boolean; overload;
  56. function Intersect(const A1, A2, B1, B2: TFixedPoint; out P: TFixedPoint): Boolean; overload;
  57. function VertexReduction(const Points: TArrayOfFloatPoint; Epsilon: TFloat = 1): TArrayOfFloatPoint; overload;
  58. function VertexReduction(const Points: TArrayOfFixedPoint; Epsilon: TFixed = FixedOne): TArrayOfFixedPoint; overload;
  59. function ClosePolygon(const Points: TArrayOfFloatPoint): TArrayOfFloatPoint; overload;
  60. function ClosePolygon(const Points: TArrayOfFixedPoint): TArrayOfFixedPoint; overload;
  61. function ClipLine(var X1, Y1, X2, Y2: Integer; MinX, MinY, MaxX, MaxY: Integer): Boolean; overload;
  62. function ClipLine(var X1, Y1, X2, Y2: TFloat; MinX, MinY, MaxX, MaxY: TFloat): Boolean; overload;
  63. function ClipLine(var X1, Y1, X2, Y2: TFixed; MinX, MinY, MaxX, MaxY: TFixed): Boolean; overload;
  64. function ClipLine(var P1, P2: TPoint; const ClipRect: TRect): Boolean; overload;
  65. function ClipLine(var P1, P2: TFloatPoint; const ClipRect: TFloatRect): Boolean; overload;
  66. function ClipLine(var P1, P2: TFixedPoint; const ClipRect: TFixedRect): Boolean; overload;
  67. type
  68. TTriangleVertexIndices = array [0 .. 2] of Integer;
  69. TArrayOfTriangleVertexIndices = array of TTriangleVertexIndices;
  70. function DelaunayTriangulation(Points: TArrayOfFloatPoint): TArrayOfTriangleVertexIndices;
  71. function BuildNormals(const Points: TArrayOfFloatPoint): TArrayOfFloatPoint; overload;
  72. function BuildNormals(const Points: TArrayOfFixedPoint): TArrayOfFixedPoint; overload;
  73. function Grow(const Points: TArrayOfFloatPoint; const Normals: TArrayOfFloatPoint; const Delta: TFloat; JoinStyle: TJoinStyle = jsMiter; Closed: Boolean = True; MiterLimit: TFloat = DEFAULT_MITER_LIMIT): TArrayOfFloatPoint; overload; {$ifndef GR32_OFFSET_REF} deprecated; {$ENDIF} {$IFDEF USEINLINING} inline; {$ENDIF}
  74. function Grow(const Points: TArrayOfFloatPoint; const Delta: TFloat; JoinStyle: TJoinStyle = jsMiter; Closed: Boolean = True; MiterLimit: TFloat = DEFAULT_MITER_LIMIT): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  75. function Grow(const Points: TArrayOfFixedPoint; const Normals: TArrayOfFixedPoint; const Delta: TFixed; JoinStyle: TJoinStyle = jsMiter; Closed: Boolean = True; MiterLimit: TFixed = DEFAULT_MITER_LIMIT_FIXED): TArrayOfFixedPoint; overload; {$ifndef GR32_OFFSET_REF} deprecated; {$ENDIF} {$IFDEF USEINLINING} inline; {$ENDIF}
  76. function Grow(const Points: TArrayOfFixedPoint; const Delta: TFixed; JoinStyle: TJoinStyle = jsMiter; Closed: Boolean = True; MiterLimit: TFixed = DEFAULT_MITER_LIMIT_FIXED): TArrayOfFixedPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  77. function ReversePolygon(const Points: TArrayOfFloatPoint): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  78. function ReversePolygon(const Points: TArrayOfFixedPoint): TArrayOfFixedPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  79. function BuildPolyLine(const Points: TArrayOfFloatPoint; StrokeWidth: TFloat; JoinStyle: TJoinStyle = jsMiter; EndStyle: TEndStyle = esButt; MiterLimit: TFloat = DEFAULT_MITER_LIMIT): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  80. function BuildPolyPolyLine(const Points: TArrayOfArrayOfFloatPoint; Closed: Boolean; StrokeWidth: TFloat; JoinStyle: TJoinStyle = jsMiter; EndStyle: TEndStyle = esButt; MiterLimit: TFloat = DEFAULT_MITER_LIMIT): TArrayOfArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  81. function BuildPolyLine(const Points: TArrayOfFixedPoint; StrokeWidth: TFixed; JoinStyle: TJoinStyle = jsMiter; EndStyle: TEndStyle = esButt; MiterLimit: TFixed = DEFAULT_MITER_LIMIT_FIXED): TArrayOfFixedPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  82. function BuildPolyPolyLine(const Points: TArrayOfArrayOfFixedPoint; Closed: Boolean; StrokeWidth: TFixed; JoinStyle: TJoinStyle = jsMiter; EndStyle: TEndStyle = esButt; MiterLimit: TFixed = DEFAULT_MITER_LIMIT_FIXED): TArrayOfArrayOfFixedPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  83. function BuildDashedLine(const Points: TArrayOfFloatPoint;
  84. const DashArray: TArrayOfFloat; DashOffset: TFloat = 0;
  85. Closed: Boolean = False): TArrayOfArrayOfFloatPoint; overload;
  86. function BuildDashedLine(const Points: TArrayOfFixedPoint;
  87. const DashArray: TArrayOfFixed; DashOffset: TFixed = 0;
  88. Closed: Boolean = False): TArrayOfArrayOfFixedPoint; overload;
  89. function ClipPolygon(const Points: TArrayOfFloatPoint; const ClipRect: TFloatRect): TArrayOfFloatPoint; overload;
  90. function ClipPolygon(const Points: TArrayOfFixedPoint; const ClipRect: TFixedRect): TArrayOfFixedPoint; overload;
  91. function CalculateCircleSteps(Radius: TFloat): Cardinal; {$IFDEF USEINLINING} inline; {$ENDIF}
  92. function BuildArc(const P: TFloatPoint; StartAngle, EndAngle, Radius: TFloat; Steps: Integer): TArrayOfFloatPoint; overload;
  93. function BuildArc(const P: TFloatPoint; StartAngle, EndAngle, Radius: TFloat): TArrayOfFloatPoint; overload;
  94. function BuildArc(const P: TFixedPoint; StartAngle, EndAngle, Radius: TFloat; Steps: Integer): TArrayOfFixedPoint; overload;
  95. function BuildArc(const P: TFixedPoint; StartAngle, EndAngle, Radius: TFloat): TArrayOfFixedPoint; overload;
  96. function Line(const P1, P2: TFloatPoint): TArrayOfFloatPoint; overload;
  97. function Line(const X1, Y1, X2, Y2: TFloat): TArrayOfFloatPoint; overload;
  98. function VertLine(const X, Y1, Y2: TFloat): TArrayOfFloatPoint;
  99. function HorzLine(const X1, Y, X2: TFloat): TArrayOfFloatPoint;
  100. function Circle(const P: TFloatPoint; const Radius: TFloat; Steps: Integer): TArrayOfFloatPoint; overload; {$IFDEF INLINING_ENHANCED_RECORDS} inline; {$ENDIF}
  101. function Circle(const P: TFloatPoint; const Radius: TFloat): TArrayOfFloatPoint; overload; {$IFDEF INLINING_ENHANCED_RECORDS} inline; {$ENDIF}
  102. function Circle(const X, Y, Radius: TFloat; Steps: Integer): TArrayOfFloatPoint; overload; {$IFDEF INLINING_ENHANCED_RECORDS} inline; {$ENDIF}
  103. function Circle(const X, Y, Radius: TFloat): TArrayOfFloatPoint; overload; {$IFDEF INLINING_ENHANCED_RECORDS} inline; {$ENDIF}
  104. function Circle(const R: TRect): TArrayOfFloatPoint; overload; {$IFDEF INLINING_ENHANCED_RECORDS} inline; {$ENDIF}
  105. function Circle(const R: TRect; Steps: Integer): TArrayOfFloatPoint; overload; {$IFDEF INLINING_ENHANCED_RECORDS} inline; {$ENDIF}
  106. function Circle(const R: TFloatRect): TArrayOfFloatPoint; overload; {$IFDEF INLINING_ENHANCED_RECORDS} inline; {$ENDIF}
  107. function Circle(const R: TFloatRect; Steps: Integer): TArrayOfFloatPoint; overload; {$IFDEF INLINING_ENHANCED_RECORDS} inline; {$ENDIF}
  108. function Pie(const P: TFloatPoint; const Radius: TFloat; const Angle, Offset: TFloat; Steps: Integer): TArrayOfFloatPoint; overload;
  109. function Pie(const P: TFloatPoint; const Radius: TFloat; const Angle: TFloat; const Offset: TFloat = 0): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  110. function Pie(const P: TFloatPoint; const Radius: TFloat; const Angle: TFloat; Steps: Integer): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  111. function Pie(const X, Y, Radius: TFloat; const Angle, Offset: TFloat; Steps: Integer): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  112. function Pie(const X, Y, Radius: TFloat; const Angle: TFloat; const Offset: TFloat = 0): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  113. function Pie(const X, Y, Radius: TFloat; const Angle: TFloat; Steps: Integer): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  114. function Ellipse(const P, R: TFloatPoint; Steps: Integer): TArrayOfFloatPoint; overload;
  115. function Ellipse(const P, R: TFloatPoint): TArrayOfFloatPoint; overload; {$IFDEF INLINING_ENHANCED_RECORDS} inline; {$ENDIF}
  116. function Ellipse(const X, Y, Rx, Ry: TFloat; Steps: Integer): TArrayOfFloatPoint; overload; {$IFDEF INLINING_ENHANCED_RECORDS} inline; {$ENDIF}
  117. function Ellipse(const X, Y, Rx, Ry: TFloat): TArrayOfFloatPoint; overload; {$IFDEF INLINING_ENHANCED_RECORDS} inline; {$ENDIF}
  118. function Ellipse(const R: TRect): TArrayOfFloatPoint; overload; {$IFDEF INLINING_ENHANCED_RECORDS} inline; {$ENDIF}
  119. function Ellipse(const R: TFloatRect): TArrayOfFloatPoint; overload; {$IFDEF INLINING_ENHANCED_RECORDS} inline; {$ENDIF}
  120. function Ellipse(const R: TRect; Steps: Integer): TArrayOfFloatPoint; overload; {$IFDEF INLINING_ENHANCED_RECORDS} inline; {$ENDIF}
  121. function Ellipse(const R: TFloatRect; Steps: Integer): TArrayOfFloatPoint; overload; {$IFDEF INLINING_ENHANCED_RECORDS} inline; {$ENDIF}
  122. function Star(const P: TFloatPoint; const InnerRadius, OuterRadius: TFloat; Vertices: Integer = 5; Rotation: TFloat = 0): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  123. function Star(const X, Y, InnerRadius, OuterRadius: TFloat; Vertices: Integer = 5; Rotation: TFloat = 0): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  124. function Star(const P: TFloatPoint; const Radius: TFloat; Vertices: Integer = 5; Rotation: TFloat = 0): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  125. function Star(const X, Y, Radius: TFloat; Vertices: Integer = 5; Rotation: TFloat = 0): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  126. function Rectangle(const R: TRect): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  127. function Rectangle(const R: TFloatRect): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  128. function RoundRect(const R: TFloatRect; const Radius: TFloat): TArrayOfFloatPoint; {$IFDEF USEINLINING} inline; {$ENDIF}
  129. function PolygonBounds(const Points: TArrayOfFloatPoint): TFloatRect; overload;
  130. function PolygonBounds(const Points: TArrayOfFixedPoint): TFixedRect; overload;
  131. function PolyPolygonBounds(const Points: TArrayOfArrayOfFloatPoint): TFloatRect; overload;
  132. function PolyPolygonBounds(const Points: TArrayOfArrayOfFixedPoint): TFixedRect; overload;
  133. function ScalePolygon(const Points: TArrayOfFloatPoint; ScaleX, ScaleY: TFloat): TArrayOfFloatPoint; overload;
  134. function ScalePolygon(const Points: TArrayOfFixedPoint; ScaleX, ScaleY: TFixed): TArrayOfFixedPoint; overload;
  135. function ScalePolyPolygon(const Points: TArrayOfArrayOfFloatPoint; ScaleX, ScaleY: TFloat): TArrayOfArrayOfFloatPoint; overload;
  136. function ScalePolyPolygon(const Points: TArrayOfArrayOfFixedPoint; ScaleX, ScaleY: TFixed): TArrayOfArrayOfFixedPoint; overload;
  137. procedure ScalePolygonInplace(const Points: TArrayOfFloatPoint; ScaleX, ScaleY: TFloat); overload;
  138. procedure ScalePolygonInplace(const Points: TArrayOfFixedPoint; ScaleX, ScaleY: TFixed); overload;
  139. procedure ScalePolyPolygonInplace(const Points: TArrayOfArrayOfFloatPoint; ScaleX, ScaleY: TFloat); overload;
  140. procedure ScalePolyPolygonInplace(const Points: TArrayOfArrayOfFixedPoint; ScaleX, ScaleY: TFixed); overload;
  141. function TranslatePolygon(const Points: TArrayOfFloatPoint; OffsetX, OffsetY: TFloat): TArrayOfFloatPoint; overload;
  142. function TranslatePolygon(const Points: TArrayOfFixedPoint; Offsetx, OffsetY: TFixed): TArrayOfFixedPoint; overload;
  143. function TranslatePolyPolygon(const Points: TArrayOfArrayOfFloatPoint; OffsetX, OffsetY: TFloat): TArrayOfArrayOfFloatPoint; overload;
  144. function TranslatePolyPolygon(const Points: TArrayOfArrayOfFixedPoint; OffsetX, OffsetY: TFixed): TArrayOfArrayOfFixedPoint; overload;
  145. procedure TranslatePolygonInplace(const Points: TArrayOfFloatPoint; OffsetX, OffsetY: TFloat); overload;
  146. procedure TranslatePolygonInplace(const Points: TArrayOfFixedPoint; Offsetx, OffsetY: TFixed); overload;
  147. procedure TranslatePolyPolygonInplace(const Points: TArrayOfArrayOfFloatPoint; OffsetX, OffsetY: TFloat); overload;
  148. procedure TranslatePolyPolygonInplace(const Points: TArrayOfArrayOfFixedPoint; OffsetX, OffsetY: TFixed); overload;
  149. function TransformPolygon(const Points: TArrayOfFloatPoint; Transformation: TTransformation): TArrayOfFloatPoint; overload;
  150. function TransformPolygon(const Points: TArrayOfFixedPoint; Transformation: TTransformation): TArrayOfFixedPoint; overload;
  151. function TransformPolyPolygon(const Points: TArrayOfArrayOfFloatPoint; Transformation: TTransformation): TArrayOfArrayOfFloatPoint; overload;
  152. function TransformPolyPolygon(const Points: TArrayOfArrayOfFixedPoint; Transformation: TTransformation): TArrayOfArrayOfFixedPoint; overload;
  153. function BuildPolygonF(const Data: array of TFloat): TArrayOfFloatPoint; overload;
  154. function BuildPolygonX(const Data: array of TFixed): TArrayOfFixedPoint; overload;
  155. function PolyPolygon(const Points: TArrayOfFloatPoint): TArrayOfArrayOfFloatPoint; overload; {$IFDEF USEINLINING}inline;{$ENDIF}
  156. function PolyPolygon(const Points: TArrayOfFixedPoint): TArrayOfArrayOfFixedPoint; overload; {$IFDEF USEINLINING}inline;{$ENDIF}
  157. function PointToFloatPoint(const Points: TArrayOfPoint): TArrayOfFloatPoint; overload;
  158. function PointToFloatPoint(const Points: TArrayOfArrayOfPoint): TArrayOfArrayOfFloatPoint; overload;
  159. function PointToFixedPoint(const Points: TArrayOfPoint): TArrayOfFixedPoint; overload;
  160. function PointToFixedPoint(const Points: TArrayOfArrayOfPoint): TArrayOfArrayOfFixedPoint; overload;
  161. function FixedPointToFloatPoint(const Points: TArrayOfFixedPoint): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING}inline;{$ENDIF}
  162. function FixedPointToFloatPoint(const Points: TArrayOfArrayOfFixedPoint): TArrayOfArrayOfFloatPoint; overload; {$IFDEF USEINLINING}inline;{$ENDIF}
  163. function FloatPointToFixedPoint(const Points: TArrayOfFloatPoint): TArrayOfFixedPoint; overload; {$IFDEF USEINLINING}inline;{$ENDIF}
  164. function FloatPointToFixedPoint(const Points: TArrayOfArrayOfFloatPoint): TArrayOfArrayOfFixedPoint; overload; {$IFDEF USEINLINING}inline;{$ENDIF}
  165. //------------------------------------------------------------------------------
  166. //
  167. // TPolyLineBuilder
  168. //
  169. //------------------------------------------------------------------------------
  170. // Abstract base class for polygon offsetter backends.
  171. // Primarily for internal use.
  172. //------------------------------------------------------------------------------
  173. type
  174. TPolyLineBuilder = class abstract
  175. protected
  176. // Float
  177. class function Grow(const Points: TArrayOfFloatPoint; const Normals: TArrayOfFloatPoint; const Delta: TFloat; JoinStyle: TJoinStyle = jsMiter; Closed: Boolean = True; MiterLimit: TFloat = DEFAULT_MITER_LIMIT): TArrayOfFloatPoint; overload; virtual; abstract;
  178. // Fixed
  179. class function Grow(const Points: TArrayOfFixedPoint; const Normals: TArrayOfFixedPoint; const Delta: TFixed; JoinStyle: TJoinStyle = jsMiter; Closed: Boolean = True; MiterLimit: TFixed = DEFAULT_MITER_LIMIT_FIXED): TArrayOfFixedPoint; overload; virtual;
  180. public
  181. class function SupportedJoinStyles: TJoinStyles; virtual;
  182. class function SupportedEndStyles: TEndStyles; virtual;
  183. // Float
  184. class function Grow(const Points: TArrayOfFloatPoint; const Delta: TFloat; JoinStyle: TJoinStyle = jsMiter; Closed: Boolean = True; MiterLimit: TFloat = DEFAULT_MITER_LIMIT): TArrayOfFloatPoint; overload; virtual;
  185. // Fixed
  186. class function Grow(const Points: TArrayOfFixedPoint; const Delta: TFixed; JoinStyle: TJoinStyle = jsMiter; Closed: Boolean = True; MiterLimit: TFixed = DEFAULT_MITER_LIMIT_FIXED): TArrayOfFixedPoint; overload; virtual;
  187. // Float
  188. class function BuildPolyLine(const Points: TArrayOfFloatPoint; StrokeWidth: TFloat; JoinStyle: TJoinStyle = jsMiter; EndStyle: TEndStyle = esButt; MiterLimit: TFloat = DEFAULT_MITER_LIMIT): TArrayOfFloatPoint; overload; virtual; abstract;
  189. class function BuildPolyPolyLine(const Points: TArrayOfArrayOfFloatPoint; Closed: Boolean; StrokeWidth: TFloat; JoinStyle: TJoinStyle = jsMiter; EndStyle: TEndStyle = esButt; MiterLimit: TFloat = DEFAULT_MITER_LIMIT): TArrayOfArrayOfFloatPoint; overload; virtual; abstract;
  190. // Fixed
  191. class function BuildPolyLine(const Points: TArrayOfFixedPoint; StrokeWidth: TFixed; JoinStyle: TJoinStyle = jsMiter; EndStyle: TEndStyle = esButt; MiterLimit: TFixed = DEFAULT_MITER_LIMIT_FIXED): TArrayOfFixedPoint; overload; virtual;
  192. class function BuildPolyPolyLine(const Points: TArrayOfArrayOfFixedPoint; Closed: Boolean; StrokeWidth: TFixed; JoinStyle: TJoinStyle = jsMiter; EndStyle: TEndStyle = esButt; MiterLimit: TFixed = DEFAULT_MITER_LIMIT_FIXED): TArrayOfArrayOfFixedPoint; overload; virtual;
  193. end;
  194. TPolylineBuilderClass = class of TPolyLineBuilder;
  195. var
  196. PolylineBuilder: TPolylineBuilderClass;
  197. //------------------------------------------------------------------------------
  198. implementation
  199. uses
  200. {$if defined(GR32_OFFSET_CLIPPER)}
  201. GR32_VectorUtils.Clipper2,
  202. {$elseif defined(GR32_OFFSET_ANGUS)}
  203. GR32_VectorUtils.Angus,
  204. {$else}
  205. GR32_VectorUtils.Reference,
  206. {$ifend}
  207. GR32_Math,
  208. GR32_Geometry,
  209. GR32_LowLevel;
  210. type
  211. TTransformationAccess = class(TTransformation);
  212. // Returns True if Min(X1, X2) <= X < Max(X1, X2)
  213. function InSignedRange(const X, X1, X2: TFloat): Boolean;
  214. begin
  215. Result := (X < X1) xor (X < X2);
  216. end;
  217. // Returns True if Min(X1, X2) <= X < Max(X1, X2)
  218. function InSignedRange(const X, X1, X2: TFixed): Boolean;
  219. begin
  220. Result := (X < X1) xor (X < X2);
  221. end;
  222. // Returns True if the line segments (A1, A2) and (B1, B2) intersects
  223. // P is the point of intersection
  224. function Intersect(const A1, A2, B1, B2: TFloatPoint; out P: TFloatPoint): Boolean;
  225. var
  226. Adx, Ady, Bdx, Bdy, ABy, ABx: TFloat;
  227. t, ta, tb: TFloat;
  228. begin
  229. Result := False;
  230. Adx := A2.X - A1.X;
  231. Ady := A2.Y - A1.Y;
  232. Bdx := B2.X - B1.X;
  233. Bdy := B2.Y - B1.Y;
  234. t := (Bdy * Adx) - (Bdx * Ady);
  235. if t = 0 then Exit; // lines are parallell
  236. ABx := A1.X - B1.X;
  237. ABy := A1.Y - B1.Y;
  238. ta := Bdx * ABy - Bdy * ABx;
  239. tb := Adx * ABy - Ady * ABx;
  240. if InSignedRange(ta, 0, t) and InSignedRange(tb, 0, t) then
  241. begin
  242. Result := True;
  243. ta := ta / t;
  244. P.X := A1.X + ta * Adx;
  245. P.Y := A1.Y + ta * Ady;
  246. end;
  247. end;
  248. function Intersect(const A1, A2, B1, B2: TFixedPoint; out P: TFixedPoint): Boolean; overload;
  249. var
  250. Adx, Ady, Bdx, Bdy, ABy, ABx: TFixed;
  251. t, ta, tb: TFixed;
  252. begin
  253. Result := False;
  254. Adx := A2.X - A1.X;
  255. Ady := A2.Y - A1.Y;
  256. Bdx := B2.X - B1.X;
  257. Bdy := B2.Y - B1.Y;
  258. t := (Bdy * Adx) - (Bdx * Ady);
  259. if t = 0 then Exit; // lines are parallell
  260. ABx := A1.X - B1.X;
  261. ABy := A1.Y - B1.Y;
  262. ta := Bdx * ABy - Bdy * ABx;
  263. tb := Adx * ABy - Ady * ABx;
  264. if InSignedRange(ta, 0, t) and InSignedRange(tb, 0, t) then
  265. begin
  266. Result := True;
  267. ta := FixedDiv(ta, t);
  268. P.X := A1.X + ta * Adx;
  269. P.Y := A1.Y + ta * Ady;
  270. end;
  271. end;
  272. //------------------------------------------------------------------------------
  273. //
  274. // RamerDouglasPeucker
  275. //
  276. //------------------------------------------------------------------------------
  277. // Ramer-Douglas-Peucker line simplification.
  278. //
  279. // References:
  280. //
  281. // - Urs Ramer
  282. // "An iterative procedure for the polygonal approximation of plane curves".
  283. // Computer Graphics and Image Processing.
  284. // Volume 1, Issue 3, November 1972, Pages 244-256
  285. //
  286. // - David H. Douglas & Thomas K. Peucker
  287. // "Algorithms for the reduction of the number of points required to represent
  288. // a digitized line or its caricature".
  289. // Cartographica: The International Journal for Geographic Information and
  290. // Geovisualization. Volume 10 Issue 2, December 1973, Pages 112–122.
  291. //
  292. //------------------------------------------------------------------------------
  293. // This implementation performs the following optimizations, compared to common
  294. // reference implementations:
  295. // - The distance calculations avoids use of Sqrt and Abs by comparing squared
  296. // values.
  297. // - Static expressions are evaluated outside the loop.
  298. //------------------------------------------------------------------------------
  299. function RamerDouglasPeuckerSquared(const Points: TArrayOfFloatPoint; FirstIndex,
  300. LastIndex: Integer; EpsilonSquared: TFloat): TArrayOfFloatPoint; overload;
  301. var
  302. DistX, DistY, DistXY: TFloat;
  303. Numerator, Denominator: TFloat;
  304. Index, DeltaMaxIndex: Integer;
  305. DeltaSquared, DeltaSquaredMax: TFloat;
  306. Parts: array[0..1] of TArrayOfFloatPoint;
  307. FirstPoint, LastPoint, p: PFloatPoint;
  308. begin
  309. FirstPoint := @Points[FirstIndex];
  310. LastPoint := @Points[LastIndex];
  311. if LastIndex - FirstIndex <= 1 then
  312. begin
  313. SetLength(Result, 2);
  314. Result[0] := FirstPoint^;
  315. Result[1] := LastPoint^;
  316. exit;
  317. end;
  318. DistX := LastPoint.X - FirstPoint.X;
  319. DistY := LastPoint.Y - FirstPoint.Y;
  320. DistXY := FirstPoint.X * LastPoint.Y - LastPoint.X * FirstPoint.Y;
  321. Denominator := Sqr(DistX) + Sqr(DistY); // Squared distance
  322. if (Denominator <> 0.0) then
  323. Denominator := 1 / Denominator;
  324. // Find the point with the maximum distance
  325. DeltaSquaredMax := 0;
  326. DeltaMaxIndex := 0;
  327. for Index := FirstIndex + 1 to LastIndex - 1 do
  328. begin
  329. p := @Points[Index];
  330. // Perpendicular distance, squared
  331. Numerator := DistXY + DistX * p.Y - DistY * p.X;
  332. DeltaSquared := Denominator * Sqr(Numerator);
  333. if DeltaSquared >= DeltaSquaredMax then
  334. begin
  335. DeltaMaxIndex := Index;
  336. DeltaSquaredMax := DeltaSquared;
  337. end;
  338. end;
  339. // If max distance is greater than Epsilon, recursively simplify
  340. if (DeltaSquaredMax >= EpsilonSquared) or (Denominator = 0.0) then
  341. begin
  342. // Recurse
  343. Parts[0] := RamerDouglasPeuckerSquared(Points, FirstIndex, DeltaMaxIndex, EpsilonSquared);
  344. Parts[1] := RamerDouglasPeuckerSquared(Points, DeltaMaxIndex, LastIndex, EpsilonSquared);
  345. // Build the result list
  346. SetLength(Result, Length(Parts[0]) + Length(Parts[1]) - 1);
  347. Move(Parts[0, 0], Result[0], (Length(Parts[0]) - 1) * SizeOf(TFloatPoint));
  348. Move(Parts[1, 0], Result[Length(Parts[0]) - 1], Length(Parts[1]) * SizeOf(TFloatPoint));
  349. end else
  350. begin
  351. SetLength(Result, 2);
  352. Result[0] := FirstPoint^;
  353. Result[1] := LastPoint^;
  354. end;
  355. end;
  356. //------------------------------------------------------------------------------
  357. function RamerDouglasPeucker(const Points: TArrayOfFloatPoint; FirstIndex,
  358. LastIndex: Integer; Epsilon: TFloat): TArrayOfFloatPoint; overload;
  359. begin
  360. Result := RamerDouglasPeuckerSquared(Points, FirstIndex, LastIndex, Sqr(Epsilon));
  361. end;
  362. //------------------------------------------------------------------------------
  363. //
  364. // VertexReduction
  365. //
  366. //------------------------------------------------------------------------------
  367. // First do a simple and cheap line simplification and then do a regular
  368. // Ramer-Douglas-Peucker simplification. The first step vastly improves the
  369. // performance of the Ramer-Douglas-Peucker simplification for most cases.
  370. //------------------------------------------------------------------------------
  371. function VertexReduction(const Points: TArrayOfFloatPoint; Epsilon: TFloat): TArrayOfFloatPoint;
  372. var
  373. Index: Integer;
  374. Count: integer;
  375. SqrEpsilon: TFloat;
  376. begin
  377. if (Length(Points) = 0) then
  378. Exit(nil);
  379. // Initial line simplification; Ignore points closer than Epsilon to each other
  380. SqrEpsilon := Sqr(Epsilon);
  381. SetLength(Result, Length(Points)); // Make room for all points to avoid reallocation
  382. Result[0] := Points[0];
  383. Count := 1;
  384. Index := 1;
  385. while Index < Length(Points) do
  386. begin
  387. if SqrDistance(Result[Count-1], Points[Index]) > SqrEpsilon then
  388. begin
  389. Result[Count] := Points[Index];
  390. Inc(Count);
  391. end;
  392. Inc(Index);
  393. end;
  394. // Ramer-Douglas-Peucker line simplification
  395. if Count > 2 then
  396. Result := RamerDouglasPeuckerSquared(Result, 0, Count-1, SqrEpsilon)
  397. else
  398. SetLength(Result, Count); // Trim to actually used size
  399. end;
  400. //------------------------------------------------------------------------------
  401. function VertexReduction(const Points: TArrayOfFixedPoint; Epsilon: TFixed): TArrayOfFixedPoint;
  402. begin
  403. if (Length(Points) = 0) then
  404. Exit(nil);
  405. // Use float points; A fixed points version of RamerDouglasPeucker is unfortunately
  406. // not possible due to integer overflows.
  407. Result := FloatPointToFixedPoint(VertexReduction(FixedPointToFloatPoint(Points), Epsilon*FixedToFloat));
  408. end;
  409. //------------------------------------------------------------------------------
  410. function ClosePolygon(const Points: TArrayOfFloatPoint): TArrayOfFloatPoint;
  411. var
  412. L: Integer;
  413. P1, P2: TFloatPoint;
  414. begin
  415. L := Length(Points);
  416. Result := Points;
  417. if L <= 1 then
  418. Exit;
  419. P1 := Result[0];
  420. P2 := Result[L - 1];
  421. if (P1.X = P2.X) and (P1.Y = P2.Y) then
  422. Exit;
  423. SetLength(Result, L + 1);
  424. Move(Result[0], Points[0], L * SizeOf(TFloatPoint));
  425. Result[L] := P1;
  426. end;
  427. function ClosePolygon(const Points: TArrayOfFixedPoint): TArrayOfFixedPoint;
  428. var
  429. L: Integer;
  430. P1, P2: TFixedPoint;
  431. begin
  432. L := Length(Points);
  433. Result := Points;
  434. if L <= 1 then
  435. Exit;
  436. P1 := Result[0];
  437. P2 := Result[L - 1];
  438. if (P1.X = P2.X) and (P1.Y = P2.Y) then
  439. Exit;
  440. SetLength(Result, L + 1);
  441. Move(Result[0], Points[0], L * SizeOf(TFixedPoint));
  442. Result[L] := P1;
  443. end;
  444. // Note:
  445. // ClipLine has been copied to GR32 to avoid referencing this unit there since that would
  446. // prevent inlining here of GR32 functions due to
  447. // H2456 Inline function '%s' has not been expanded because contained unit '%s' uses compiling unit '%s'
  448. // Make sure to keep the two functions in sync!
  449. function ClipLine(var X1, Y1, X2, Y2: Integer; MinX, MinY, MaxX, MaxY: Integer): Boolean;
  450. var
  451. C1, C2: Integer;
  452. V: Integer;
  453. begin
  454. { Get edge codes }
  455. C1 := Ord(X1 < MinX) + Ord(X1 > MaxX) shl 1 + Ord(Y1 < MinY) shl 2 + Ord(Y1 > MaxY) shl 3;
  456. C2 := Ord(X2 < MinX) + Ord(X2 > MaxX) shl 1 + Ord(Y2 < MinY) shl 2 + Ord(Y2 > MaxY) shl 3;
  457. if ((C1 and C2) = 0) and ((C1 or C2) <> 0) then
  458. begin
  459. if (C1 and 12) <> 0 then
  460. begin
  461. if C1 < 8 then V := MinY else V := MaxY;
  462. Inc(X1, MulDiv(V - Y1, X2 - X1, Y2 - Y1));
  463. Y1 := V;
  464. C1 := Ord(X1 < MinX) + Ord(X1 > MaxX) shl 1;
  465. end;
  466. if (C2 and 12) <> 0 then
  467. begin
  468. if C2 < 8 then V := MinY else V := MaxY;
  469. Inc(X2, MulDiv(V - Y2, X2 - X1, Y2 - Y1));
  470. Y2 := V;
  471. C2 := Ord(X2 < MinX) + Ord(X2 > MaxX) shl 1;
  472. end;
  473. if ((C1 and C2) = 0) and ((C1 or C2) <> 0) then
  474. begin
  475. if C1 <> 0 then
  476. begin
  477. if C1 = 1 then V := MinX else V := MaxX;
  478. Inc(Y1, MulDiv(V - X1, Y2 - Y1, X2 - X1));
  479. X1 := V;
  480. C1 := 0;
  481. end;
  482. if C2 <> 0 then
  483. begin
  484. if C2 = 1 then V := MinX else V := MaxX;
  485. Inc(Y2, MulDiv(V - X2, Y2 - Y1, X2 - X1));
  486. X2 := V;
  487. C2 := 0;
  488. end;
  489. end;
  490. end;
  491. Result := (C1 or C2) = 0;
  492. end;
  493. function ClipLine(var X1, Y1, X2, Y2: TFloat; MinX, MinY, MaxX, MaxY: TFloat): Boolean;
  494. var
  495. C1, C2: Integer;
  496. V: TFloat;
  497. begin
  498. { Get edge codes }
  499. C1 := Ord(X1 < MinX) + Ord(X1 > MaxX) shl 1 + Ord(Y1 < MinY) shl 2 + Ord(Y1 > MaxY) shl 3;
  500. C2 := Ord(X2 < MinX) + Ord(X2 > MaxX) shl 1 + Ord(Y2 < MinY) shl 2 + Ord(Y2 > MaxY) shl 3;
  501. if ((C1 and C2) = 0) and ((C1 or C2) <> 0) then
  502. begin
  503. if (C1 and 12) <> 0 then
  504. begin
  505. if C1 < 8 then V := MinY else V := MaxY;
  506. X1 := X1 + (V - Y1) * (X2 - X1) / (Y2 - Y1);
  507. Y1 := V;
  508. C1 := Ord(X1 < MinX) + Ord(X1 > MaxX) shl 1;
  509. end;
  510. if (C2 and 12) <> 0 then
  511. begin
  512. if C2 < 8 then V := MinY else V := MaxY;
  513. X2 := X2 + (V - Y2) * (X2 - X1) / (Y2 - Y1);
  514. Y2 := V;
  515. C2 := Ord(X2 < MinX) + Ord(X2 > MaxX) shl 1;
  516. end;
  517. if ((C1 and C2) = 0) and ((C1 or C2) <> 0) then
  518. begin
  519. if C1 <> 0 then
  520. begin
  521. if C1 = 1 then V := MinX else V := MaxX;
  522. Y1 := Y1 + (V - X1) * (Y2 - Y1) / (X2 - X1);
  523. X1 := V;
  524. C1 := 0;
  525. end;
  526. if C2 <> 0 then
  527. begin
  528. if C2 = 1 then V := MinX else V := MaxX;
  529. Y2 := Y2 + (V - X2) * (Y2 - Y1) / (X2 - X1);
  530. X2 := V;
  531. C2 := 0;
  532. end;
  533. end;
  534. end;
  535. Result := (C1 or C2) = 0;
  536. end;
  537. function ClipLine(var X1, Y1, X2, Y2: TFixed; MinX, MinY, MaxX, MaxY: TFixed): Boolean;
  538. var
  539. C1, C2: Integer;
  540. V: TFixed;
  541. begin
  542. { Get edge codes }
  543. C1 := Ord(X1 < MinX) + Ord(X1 > MaxX) shl 1 + Ord(Y1 < MinY) shl 2 + Ord(Y1 > MaxY) shl 3;
  544. C2 := Ord(X2 < MinX) + Ord(X2 > MaxX) shl 1 + Ord(Y2 < MinY) shl 2 + Ord(Y2 > MaxY) shl 3;
  545. if ((C1 and C2) = 0) and ((C1 or C2) <> 0) then
  546. begin
  547. if (C1 and 12) <> 0 then
  548. begin
  549. if C1 < 8 then V := MinY else V := MaxY;
  550. X1 := X1 + FixedDiv(FixedMul(V - Y1, X2 - X1), Y2 - Y1);
  551. Y1 := V;
  552. C1 := Ord(X1 < MinX) + Ord(X1 > MaxX) shl 1;
  553. end;
  554. if (C2 and 12) <> 0 then
  555. begin
  556. if C2 < 8 then V := MinY else V := MaxY;
  557. X2 := X2 + FixedDiv(FixedMul(V - Y2, X2 - X1), Y2 - Y1);
  558. Y2 := V;
  559. C2 := Ord(X2 < MinX) + Ord(X2 > MaxX) shl 1;
  560. end;
  561. if ((C1 and C2) = 0) and ((C1 or C2) <> 0) then
  562. begin
  563. if C1 <> 0 then
  564. begin
  565. if C1 = 1 then V := MinX else V := MaxX;
  566. Y1 := Y1 + FixedDiv(FixedMul(V - X1, Y2 - Y1), X2 - X1);
  567. X1 := V;
  568. C1 := 0;
  569. end;
  570. if C2 <> 0 then
  571. begin
  572. if C2 = 1 then V := MinX else V := MaxX;
  573. Y2 := Y2 + FixedDiv(FixedMul(V - X2, Y2 - Y1), X2 - X1);
  574. X2 := V;
  575. C2 := 0;
  576. end;
  577. end;
  578. end;
  579. Result := (C1 or C2) = 0;
  580. end;
  581. function ClipLine(var P1, P2: TPoint; const ClipRect: TRect): Boolean;
  582. begin
  583. Result := ClipLine(P1.X, P1.Y, P2.X, P2.Y, ClipRect.Left, ClipRect.Top,
  584. ClipRect.Right, ClipRect.Bottom);
  585. end;
  586. function ClipLine(var P1, P2: TFloatPoint; const ClipRect: TFloatRect): Boolean;
  587. begin
  588. Result := ClipLine(P1.X, P1.Y, P2.X, P2.Y, ClipRect.Left, ClipRect.Top,
  589. ClipRect.Right, ClipRect.Bottom);
  590. end;
  591. function ClipLine(var P1, P2: TFixedPoint; const ClipRect: TFixedRect): Boolean;
  592. begin
  593. Result := ClipLine(P1.X, P1.Y, P2.X, P2.Y, ClipRect.Left, ClipRect.Top,
  594. ClipRect.Right, ClipRect.Bottom);
  595. end;
  596. procedure FastMergeSortX(const Values: TArrayOfFloatPoint;
  597. out Indexes: TArrayOfInteger; out Bounds: TFloatRect);
  598. var
  599. Temp: TArrayOfInteger;
  600. procedure Merge(I1, I2, J1, J2: Integer);
  601. var
  602. I, J, K: Integer;
  603. begin
  604. if Values[Indexes[I2]].X < Values[Indexes[J1]].X then Exit;
  605. I := I1;
  606. J := J1;
  607. K := 0;
  608. repeat
  609. if Values[Indexes[I]].X < Values[Indexes[J]].X then
  610. begin
  611. Temp[K] := Indexes[I];
  612. Inc(I);
  613. end
  614. else
  615. begin
  616. Temp[K] := Indexes[J];
  617. Inc(J);
  618. end;
  619. Inc(K);
  620. until (I > I2) or (J > J2);
  621. while I <= I2 do
  622. begin
  623. Temp[K] := Indexes[I];
  624. Inc(I); Inc(K);
  625. end;
  626. while J <= J2 do
  627. begin
  628. Temp[K] := Indexes[J];
  629. Inc(J); Inc(K);
  630. end;
  631. for I := 0 to K - 1 do
  632. begin
  633. Indexes[I + I1] := Temp[I];
  634. end;
  635. end;
  636. procedure Recurse(I1, I2: Integer);
  637. var
  638. I, IX: Integer;
  639. begin
  640. if I1 = I2 then
  641. Indexes[I1] := I1
  642. else if Indexes[I1] = Indexes[I2] then
  643. begin
  644. if Values[I1].X <= Values[I2].X then
  645. begin
  646. for I := I1 to I2 do Indexes[I] := I;
  647. end
  648. else
  649. begin
  650. IX := I1 + I2;
  651. for I := I1 to I2 do Indexes[I] := IX - I;
  652. end;
  653. end
  654. else
  655. begin
  656. IX := (I1 + I2) div 2;
  657. Recurse(I1, IX);
  658. Recurse(IX + 1, I2);
  659. Merge(I1, IX, IX + 1, I2);
  660. end;
  661. end;
  662. var
  663. I, Index, S: Integer;
  664. begin
  665. SetLength(Temp, Length(Values));
  666. SetLength(Indexes, Length(Values));
  667. Index := 0;
  668. S := Math.Sign(Values[1].X - Values[0].X);
  669. if S = 0 then S := 1;
  670. Indexes[0] := 0;
  671. Bounds.Left := Values[0].X;
  672. Bounds.Top := Values[0].Y;
  673. Bounds.Right := Bounds.Left;
  674. Bounds.Bottom := Bounds.Top;
  675. for I := 1 to High(Values) do
  676. begin
  677. if Math.Sign(Values[I].X - Values[I - 1].X) = -S then
  678. begin
  679. S := -S;
  680. Inc(Index);
  681. end;
  682. if Values[I].X < Bounds.Left then
  683. Bounds.Left := Values[I].X;
  684. if Values[I].Y < Bounds.Top then
  685. Bounds.Top := Values[I].Y;
  686. if Values[I].X > Bounds.Right then
  687. Bounds.Right := Values[I].X;
  688. if Values[I].Y > Bounds.Bottom then
  689. Bounds.Bottom := Values[I].Y;
  690. Indexes[I] := Index;
  691. end;
  692. Recurse(0, High(Values));
  693. end;
  694. // Delaunay Triangulation
  695. // Based on Paul Bourke's implementation of the Bowyer-Watson algorithm.
  696. // References:
  697. // http://paulbourke.net/papers/triangulate/
  698. // https://en.wikipedia.org/wiki/Bowyer%E2%80%93Watson_algorithm
  699. // Note: GR32_ColorGradients contains a custom version of this function. Keep both in sync.
  700. function DelaunayTriangulation(Points: TArrayOfFloatPoint): TArrayOfTriangleVertexIndices;
  701. var
  702. Complete: array of Byte;
  703. Edges: array of array [0 .. 1] of Integer;
  704. ByteIndex, Bit: Byte;
  705. MaxVerticesCount, EdgeCount, MaxEdgeCount, MaxTriangleCount: Integer;
  706. // For super triangle
  707. ScaledDeltaMax: TFloat;
  708. Mid: TFloatPoint;
  709. Bounds: TFloatRect;
  710. // General Variables
  711. SortedVertexIndices: TArrayOfInteger;
  712. TriangleCount, VertexCount, I, J, K: Integer;
  713. CenterX, CenterY, RadSqr: TFloat;
  714. Inside: Boolean;
  715. const
  716. CSuperTriangleCount = 3; // -> super triangle
  717. CTolerance = 0.000001;
  718. function InCircle(Pt, Pt1, Pt2, Pt3: TFloatPoint): Boolean;
  719. // Return TRUE if the point Pt(x, y) lies inside the circumcircle made up by
  720. // points Pt1(x, y) Pt2(x, y) Pt3(x, y)
  721. // The circumcircle centre is returned in (CenterX, CenterY) and the radius r
  722. // NOTE: A point on the edge is inside the circumcircle
  723. var
  724. M1, M2, MX1, MY1, MX2, MY2: Double;
  725. DeltaX, DeltaY, DeltaRadSqr, AbsY1Y2, AbsY2Y3: Double;
  726. begin
  727. AbsY1Y2 := Abs(Pt1.Y - Pt2.Y);
  728. AbsY2Y3 := Abs(Pt2.Y - Pt3.Y);
  729. // Check for coincident points
  730. if (AbsY1Y2 < CTolerance) and (AbsY2Y3 < CTolerance) then
  731. begin
  732. Result := False;
  733. Exit;
  734. end;
  735. if AbsY1Y2 < CTolerance then
  736. begin
  737. M2 := -(Pt3.X - Pt2.X) / (Pt3.Y - Pt2.Y);
  738. MX2 := (Pt2.X + Pt3.X) * 0.5;
  739. MY2 := (Pt2.Y + Pt3.Y) * 0.5;
  740. CenterX := (Pt2.X + Pt1.X) * 0.5;
  741. CenterY := M2 * (CenterX - MX2) + MY2;
  742. end
  743. else if AbsY2Y3 < CTolerance then
  744. begin
  745. M1 := -(Pt2.X - Pt1.X) / (Pt2.Y - Pt1.Y);
  746. MX1 := (Pt1.X + Pt2.X) * 0.5;
  747. MY1 := (Pt1.Y + Pt2.Y) * 0.5;
  748. CenterX := (Pt3.X + Pt2.X) * 0.5;
  749. CenterY := M1 * (CenterX - MX1) + MY1;
  750. end
  751. else
  752. begin
  753. M1 := -(Pt2.X - Pt1.X) / (Pt2.Y - Pt1.Y);
  754. M2 := -(Pt3.X - Pt2.X) / (Pt3.Y - Pt2.Y);
  755. if Abs(M1 - M2) < CTolerance then
  756. begin
  757. Result := False;
  758. Exit;
  759. end;
  760. MX1 := (Pt1.X + Pt2.X) * 0.5;
  761. MX2 := (Pt2.X + Pt3.X) * 0.5;
  762. MY1 := (Pt1.Y + Pt2.Y) * 0.5;
  763. MY2 := (Pt2.Y + Pt3.Y) * 0.5;
  764. CenterX := (M1 * MX1 - M2 * Mx2 + My2 - MY1) / (M1 - M2);
  765. if (AbsY1Y2 > AbsY2Y3) then
  766. CenterY := M1 * (CenterX - MX1) + MY1
  767. else
  768. CenterY := M2 * (CenterX - MX2) + MY2;
  769. end;
  770. DeltaX := Pt2.X - CenterX;
  771. DeltaY := Pt2.Y - CenterY;
  772. RadSqr := DeltaX * DeltaX + DeltaY * DeltaY;
  773. DeltaX := Pt.X - CenterX;
  774. DeltaY := Pt.Y - CenterY;
  775. DeltaRadSqr := Sqr(DeltaX) + Sqr(DeltaY);
  776. Result := (DeltaRadSqr - RadSqr) <= CTolerance;
  777. end;
  778. begin
  779. VertexCount := Length(Points);
  780. MaxVerticesCount := VertexCount + CSuperTriangleCount;
  781. // Sort points by x value and find maximum and minimum vertex bounds.
  782. FastMergeSortX(Points, SortedVertexIndices, Bounds);
  783. // set dynamic array sizes
  784. SetLength(Points, MaxVerticesCount);
  785. MaxTriangleCount := 2 * (MaxVerticesCount - 1);
  786. SetLength(Result, MaxTriangleCount);
  787. MaxEdgeCount := 3 * (MaxVerticesCount - 1);
  788. SetLength(Edges, MaxEdgeCount);
  789. SetLength(Complete, (MaxTriangleCount + 7) shr 3);
  790. // This is to allow calculation of the bounding triangle
  791. with Bounds do
  792. begin
  793. ScaledDeltaMax := 30 * Max(Right - Left, Bottom - Top);
  794. Mid := FloatPoint((Left + Right) * 0.5, (Top + Bottom) * 0.5);
  795. end;
  796. // Set up the super triangle
  797. // This is a triangle which encompasses all the sample points. The super
  798. // triangle coordinates are added to the end of the vertex list. The super
  799. // triangle is the first triangle in the triangle list.
  800. Points[VertexCount] := FloatPoint(Mid.X - ScaledDeltaMax, Mid.Y - ScaledDeltaMax);
  801. Points[VertexCount + 1] := FloatPoint(Mid.X + ScaledDeltaMax, Mid.Y);
  802. Points[VertexCount + 2] := FloatPoint(Mid.X, Mid.Y + ScaledDeltaMax);
  803. Result[0, 0] := VertexCount;
  804. Result[0, 1] := VertexCount + 1;
  805. Result[0, 2] := VertexCount + 2;
  806. Complete[0] := 0;
  807. TriangleCount := 1;
  808. // Include each point one at a time into the existing mesh
  809. for I := 0 to VertexCount - 1 do
  810. begin
  811. EdgeCount := 0;
  812. // Set up the edge buffer.
  813. // If the point [x, y] lies inside the circumcircle then the hree edges of
  814. // that triangle are added to the edge buffer.
  815. J := 0;
  816. repeat
  817. if Complete[J shr 3] and (1 shl (J and $7)) = 0 then
  818. begin
  819. Inside := InCircle(Points[SortedVertexIndices[I]],
  820. Points[Result[J, 0]], Points[Result[J, 1]], Points[Result[J, 2]]);
  821. ByteIndex := J shr 3;
  822. Bit := 1 shl (J and $7);
  823. if (CenterX < Points[SortedVertexIndices[I]].X) and
  824. ((Sqr(Points[SortedVertexIndices[I]].X - CenterX)) > RadSqr) then
  825. Complete[ByteIndex] := Complete[ByteIndex] or Bit
  826. else
  827. if Inside then
  828. begin
  829. Edges[EdgeCount + 0, 0] := Result[J, 0];
  830. Edges[EdgeCount + 0, 1] := Result[J, 1];
  831. Edges[EdgeCount + 1, 0] := Result[J, 1];
  832. Edges[EdgeCount + 1, 1] := Result[J, 2];
  833. Edges[EdgeCount + 2, 0] := Result[J, 2];
  834. Edges[EdgeCount + 2, 1] := Result[J, 0];
  835. EdgeCount := EdgeCount + 3;
  836. Assert(EdgeCount <= MaxEdgeCount);
  837. TriangleCount := TriangleCount - 1;
  838. Result[J] := Result[TriangleCount];
  839. Complete[ByteIndex] := (Complete[ByteIndex] and (not Bit))
  840. or (Complete[TriangleCount shr 3] and Bit);
  841. Continue;
  842. end;
  843. end;
  844. J := J + 1;
  845. until J >= TriangleCount;
  846. // Tag multiple edges
  847. // Note: if all triangles are specified anticlockwise then all
  848. // interior edges are opposite pointing in direction.
  849. for J := 0 to EdgeCount - 2 do
  850. begin
  851. if (Edges[J, 0] <> -1) or (Edges[J, 1] <> -1) then
  852. begin
  853. for K := J + 1 to EdgeCount - 1 do
  854. begin
  855. if (Edges[K, 0] <> -1) or (Edges[K, 1] <> -1) then
  856. begin
  857. if (Edges[J, 0] = Edges[K, 1]) and
  858. (Edges[J, 1] = Edges[K, 0]) then
  859. begin
  860. Edges[J, 0] := -1;
  861. Edges[J, 1] := -1;
  862. Edges[K, 1] := -1;
  863. Edges[K, 0] := -1;
  864. end;
  865. end;
  866. end;
  867. end;
  868. end;
  869. // Form new triangles for the current point.
  870. // Skipping over any tagged edges. All edges are arranged in clockwise
  871. // order.
  872. for J := 0 to EdgeCount - 1 do
  873. begin
  874. if (Edges[J, 0] <> -1) or (Edges[J, 1] <> -1) then
  875. begin
  876. Result[TriangleCount, 0] := Edges[J, 0];
  877. Result[TriangleCount, 1] := Edges[J, 1];
  878. Result[TriangleCount, 2] := SortedVertexIndices[I];
  879. ByteIndex := TriangleCount shr 3;
  880. Bit := 1 shl (TriangleCount and $7);
  881. Complete[ByteIndex] := Complete[ByteIndex] and not Bit;
  882. Inc(TriangleCount);
  883. Assert(TriangleCount <= MaxTriangleCount);
  884. end;
  885. end;
  886. end;
  887. // Remove triangles with supertriangle vertices
  888. // These are triangles which have a vertex number greater than VertexCount
  889. I := 0;
  890. repeat
  891. if (Result[I, 0] >= VertexCount) or
  892. (Result[I, 1] >= VertexCount) or
  893. (Result[I, 2] >= VertexCount) then
  894. begin
  895. TriangleCount := TriangleCount - 1;
  896. Result[I, 0] := Result[TriangleCount, 0];
  897. Result[I, 1] := Result[TriangleCount, 1];
  898. Result[I, 2] := Result[TriangleCount, 2];
  899. I := I - 1;
  900. end;
  901. I := I + 1;
  902. until I >= TriangleCount;
  903. SetLength(Points, Length(Points) - 3);
  904. SetLength(Result, TriangleCount);
  905. end;
  906. function BuildArc(const P: TFloatPoint; StartAngle, EndAngle, Radius: TFloat;
  907. Steps: Integer): TArrayOfFloatPoint;
  908. var
  909. I: Integer;
  910. C, D: TFloatPoint;
  911. begin
  912. SetLength(Result, Steps);
  913. SinCos(StartAngle, Radius, C.Y, C.X);
  914. Result[0] := OffsetPoint(P, C);
  915. GR32_Math.SinCos((EndAngle - StartAngle) / (Steps - 1), D.Y, D.X);
  916. for I := 1 to Steps - 1 do
  917. begin
  918. C := FloatPoint(C.X * D.X - C.Y * D.Y, C.Y * D.X + C.X * D.Y);
  919. Result[I] := OffsetPoint(P, C);
  920. end;
  921. end;
  922. function BuildArc(const P: TFloatPoint; StartAngle, EndAngle, Radius: TFloat): TArrayOfFloatPoint;
  923. const
  924. MINSTEPS = 6;
  925. SQUAREDMINSTEPS = Sqr(MINSTEPS);
  926. var
  927. Temp: TFloat;
  928. Steps: Integer;
  929. begin
  930. // The code below was previously:
  931. //
  932. // Steps := Max(MINSTEPS, System.Round(Sqrt(Abs(Radius)) *
  933. // Abs(EndAngle - StartAngle)));
  934. //
  935. // However, for small radii, the square root calculation is performed with
  936. // the result that the output is set to 6 anyway. In this case (only a few
  937. // drawing operations), the performance spend for this calculation is dominant
  938. // for large radii (when a lot of CPU intensive drawing takes place), the
  939. // more expensive float point comparison (Temp < SQUAREDMINSTEPS) is not very
  940. // significant
  941. Temp := Abs(Radius) * Sqr(EndAngle - StartAngle);
  942. if Temp < SQUAREDMINSTEPS then
  943. Steps := 6
  944. else
  945. Steps := Round(Sqrt(Temp));
  946. Result := BuildArc(P, StartAngle, EndAngle, Radius, Steps);
  947. end;
  948. function BuildArc(const P: TFixedPoint; StartAngle, EndAngle, Radius: TFloat;
  949. Steps: Integer): TArrayOfFixedPoint;
  950. var
  951. I: Integer;
  952. C, D: TFloatPoint;
  953. begin
  954. SetLength(Result, Steps);
  955. SinCos(StartAngle, Radius, C.Y, C.X);
  956. Result[0] := OffsetPoint(P, C);
  957. GR32_Math.SinCos((EndAngle - StartAngle) / (Steps - 1), D.Y, D.X);
  958. for I := 1 to Steps - 1 do
  959. begin
  960. C := FloatPoint(C.X * D.X - C.Y * D.Y, C.Y * D.X + C.X * D.Y);
  961. Result[I] := OffsetPoint(P, FixedPoint(C));
  962. end;
  963. end;
  964. function BuildArc(const P: TFixedPoint; StartAngle, EndAngle, Radius: TFloat): TArrayOfFixedPoint;
  965. const
  966. MINSTEPS = 6;
  967. SQUAREDMINSTEPS = Sqr(MINSTEPS);
  968. var
  969. Temp: TFloat;
  970. Steps: Integer;
  971. begin
  972. // The code below was previously:
  973. //
  974. // Steps := Clamp(System.Round(Sqrt(Abs(Radius)) *
  975. // Abs(EndAngle - StartAngle)), MINSTEPS, $100000);
  976. //
  977. // However, for small radii, the square root calculation is performed with
  978. // the result that the output is set to 6 anyway. In this case (only a few
  979. // drawing operations), the performance spend for this calculation is dominant
  980. // for large radii (when a lot of CPU intensive drawing takes place), the
  981. // more expensive float point comparison (Temp < SQUAREDMINSTEPS) is not very
  982. // significant
  983. Temp := Abs(Radius) * Sqr(EndAngle - StartAngle);
  984. if Temp < SQUAREDMINSTEPS then
  985. Steps := MINSTEPS
  986. else
  987. Steps := Clamp(Round(Sqrt(Temp)), $100000);
  988. Result := BuildArc(P, StartAngle, EndAngle, Radius, Steps);
  989. end;
  990. function Line(const P1, P2: TFloatPoint): TArrayOfFloatPoint;
  991. begin
  992. SetLength(Result, 2);
  993. Result[0] := P1;
  994. Result[1] := P2;
  995. end;
  996. function Line(const X1, Y1, X2, Y2: TFloat): TArrayOfFloatPoint; overload;
  997. begin
  998. SetLength(Result, 2);
  999. Result[0] := FloatPoint(X1, Y1);
  1000. Result[1] := FloatPoint(X2, Y2);
  1001. end;
  1002. function VertLine(const X, Y1, Y2: TFloat): TArrayOfFloatPoint;
  1003. begin
  1004. SetLength(Result, 2);
  1005. Result[0] := FloatPoint(X, Y1);
  1006. Result[1] := FloatPoint(X, Y2);
  1007. end;
  1008. function HorzLine(const X1, Y, X2: TFloat): TArrayOfFloatPoint;
  1009. begin
  1010. SetLength(Result, 2);
  1011. Result[0] := FloatPoint(X1, Y);
  1012. Result[1] := FloatPoint(X2, Y);
  1013. end;
  1014. function CalculateCircleSteps(Radius: TFloat): Cardinal;
  1015. var
  1016. AbsRadius: TFloat;
  1017. begin
  1018. AbsRadius := Abs(Radius);
  1019. Result := Trunc(Pi / (ArcCos(AbsRadius / (AbsRadius + 0.125))));
  1020. end;
  1021. function Circle(const P: TFloatPoint; const Radius: TFloat;
  1022. Steps: Integer): TArrayOfFloatPoint;
  1023. var
  1024. I: Integer;
  1025. M: TFloat;
  1026. C, D: TFloatPoint;
  1027. begin
  1028. if Steps <= 0 then
  1029. Steps := CalculateCircleSteps(Radius);
  1030. SetLength(Result, Steps);
  1031. M := 2 * System.Pi / Steps;
  1032. // first item
  1033. Result[0].X := Radius + P.X;
  1034. Result[0].Y := P.Y;
  1035. // calculate complex offset
  1036. GR32_Math.SinCos(M, C.Y, C.X);
  1037. D.X := Radius * C.X;
  1038. D.Y := Radius * C.Y;
  1039. // second item
  1040. Result[1].X := D.X + P.X;
  1041. Result[1].Y := D.Y + P.Y;
  1042. // other items
  1043. for I := 2 to Steps - 1 do
  1044. begin
  1045. D := FloatPoint(D.X * C.X - D.Y * C.Y, D.Y * C.X + D.X * C.Y);
  1046. Result[I].X := D.X + P.X;
  1047. Result[I].Y := D.Y + P.Y;
  1048. end;
  1049. end;
  1050. function Circle(const P: TFloatPoint; const Radius: TFloat): TArrayOfFloatPoint;
  1051. begin
  1052. Result := Circle(P, Radius, CalculateCircleSteps(Radius));
  1053. end;
  1054. function Circle(const X, Y, Radius: TFloat; Steps: Integer): TArrayOfFloatPoint;
  1055. begin
  1056. Result := Circle(FloatPoint(X, Y), Radius, Steps);
  1057. end;
  1058. function Circle(const X, Y, Radius: TFloat): TArrayOfFloatPoint;
  1059. begin
  1060. Result := Circle(FloatPoint(X, Y), Radius, CalculateCircleSteps(Radius));
  1061. end;
  1062. function Circle(const R: TRect): TArrayOfFloatPoint;
  1063. begin
  1064. Result := Circle(
  1065. FloatPoint(0.5 * (R.Right + R.Left), 0.5 * (R.Bottom + R.Top)),
  1066. Min(0.5 * (R.Right - R.Left), 0.5 * (R.Bottom - R.Top)));
  1067. end;
  1068. function Circle(const R: TRect; Steps: Integer): TArrayOfFloatPoint;
  1069. begin
  1070. Result := Circle(
  1071. FloatPoint(0.5 * (R.Right + R.Left), 0.5 * (R.Bottom + R.Top)),
  1072. Min(0.5 * (R.Right - R.Left), 0.5 * (R.Bottom - R.Top)), Steps);
  1073. end;
  1074. function Circle(const R: TFloatRect): TArrayOfFloatPoint;
  1075. begin
  1076. Result := Circle(
  1077. FloatPoint(0.5 * (R.Right + R.Left), 0.5 * (R.Bottom + R.Top)),
  1078. Min(0.5 * (R.Right - R.Left), 0.5 * (R.Bottom - R.Top)));
  1079. end;
  1080. function Circle(const R: TFloatRect; Steps: Integer): TArrayOfFloatPoint;
  1081. begin
  1082. Result := Circle(
  1083. FloatPoint(0.5 * (R.Right + R.Left), 0.5 * (R.Bottom + R.Top)),
  1084. Min(0.5 * (R.Right - R.Left), 0.5 * (R.Bottom - R.Top)), Steps);
  1085. end;
  1086. function Pie(const P: TFloatPoint; const Radius: TFloat;
  1087. const Angle, Offset: TFloat; Steps: Integer): TArrayOfFloatPoint;
  1088. var
  1089. I: Integer;
  1090. C, D: TFloatPoint;
  1091. begin
  1092. SetLength(Result, Steps + 2);
  1093. Result[0] := P;
  1094. // calculate initial position
  1095. GR32_Math.SinCos(Offset, Radius, D.Y, D.X);
  1096. Result[1].X := D.X + P.X;
  1097. Result[1].Y := D.Y + P.Y;
  1098. // calculate complex offset
  1099. GR32_Math.SinCos(Angle / Steps, C.Y, C.X);
  1100. // other items
  1101. for I := 2 to Steps + 1 do
  1102. begin
  1103. D := FloatPoint(D.X * C.X - D.Y * C.Y, D.Y * C.X + D.X * C.Y);
  1104. Result[I].X := D.X + P.X;
  1105. Result[I].Y := D.Y + P.Y;
  1106. end;
  1107. end;
  1108. function Pie(const P: TFloatPoint; const Radius: TFloat;
  1109. const Angle: TFloat; const Offset: TFloat = 0): TArrayOfFloatPoint;
  1110. begin
  1111. Result := Pie(P, Radius, Angle, Offset, CalculateCircleSteps(Radius));
  1112. end;
  1113. function Pie(const P: TFloatPoint; const Radius: TFloat;
  1114. const Angle: TFloat; Steps: Integer): TArrayOfFloatPoint;
  1115. begin
  1116. Result := Pie(P, Radius, Angle, 0, Steps);
  1117. end;
  1118. function Pie(const X, Y, Radius: TFloat; const Angle: TFloat;
  1119. const Offset: TFloat = 0): TArrayOfFloatPoint;
  1120. begin
  1121. Result := Pie(FloatPoint(X, Y), Radius, Angle, Offset, CalculateCircleSteps(Radius));
  1122. end;
  1123. function Pie(const X, Y, Radius: TFloat; const Angle, Offset: TFloat;
  1124. Steps: Integer): TArrayOfFloatPoint;
  1125. begin
  1126. Result := Pie(FloatPoint(X, Y), Radius, Angle, Offset, Steps);
  1127. end;
  1128. function Pie(const X, Y, Radius: TFloat; const Angle: TFloat;
  1129. Steps: Integer): TArrayOfFloatPoint;
  1130. begin
  1131. Result := Pie(FloatPoint(X, Y), Radius, Angle, 0, Steps);
  1132. end;
  1133. function Ellipse(const P, R: TFloatPoint; Steps: Integer): TArrayOfFloatPoint;
  1134. var
  1135. I: Integer;
  1136. M: TFloat;
  1137. C, D: TFloatPoint;
  1138. begin
  1139. SetLength(Result, Steps);
  1140. M := 2 * System.Pi / Steps;
  1141. // first item
  1142. Result[0].X := R.X + P.X;
  1143. Result[0].Y := P.Y;
  1144. // calculate complex offset
  1145. GR32_Math.SinCos(M, C.Y, C.X);
  1146. D := C;
  1147. // second item
  1148. Result[1].X := R.X * D.X + P.X;
  1149. Result[1].Y := R.Y * D.Y + P.Y;
  1150. // other items
  1151. for I := 2 to Steps - 1 do
  1152. begin
  1153. D := FloatPoint(D.X * C.X - D.Y * C.Y, D.Y * C.X + D.X * C.Y);
  1154. Result[I].X := R.X * D.X + P.X;
  1155. Result[I].Y := R.Y * D.Y + P.Y;
  1156. end;
  1157. end;
  1158. function Ellipse(const P, R: TFloatPoint): TArrayOfFloatPoint;
  1159. begin
  1160. Result := Ellipse(P, R, CalculateCircleSteps(Min(R.X, R.Y)));
  1161. end;
  1162. function Ellipse(const X, Y, Rx, Ry: TFloat; Steps: Integer): TArrayOfFloatPoint;
  1163. begin
  1164. Result := Ellipse(FloatPoint(X, Y), FloatPoint(Rx, Ry), Steps);
  1165. end;
  1166. function Ellipse(const X, Y, Rx, Ry: TFloat): TArrayOfFloatPoint;
  1167. begin
  1168. Result := Ellipse(FloatPoint(X, Y), FloatPoint(Rx, Ry),
  1169. CalculateCircleSteps(Min(Rx, Ry)));
  1170. end;
  1171. function Ellipse(const R: TRect): TArrayOfFloatPoint;
  1172. begin
  1173. Result := Ellipse(
  1174. FloatPoint(0.5 * (R.Right + R.Left), 0.5 * (R.Bottom + R.Top)),
  1175. FloatPoint(0.5 * (R.Right - R.Left), 0.5 * (R.Bottom - R.Top)));
  1176. end;
  1177. function Ellipse(const R: TFloatRect): TArrayOfFloatPoint;
  1178. begin
  1179. Result := Ellipse(
  1180. FloatPoint(0.5 * (R.Right + R.Left), 0.5 * (R.Bottom + R.Top)),
  1181. FloatPoint(0.5 * (R.Right - R.Left), 0.5 * (R.Bottom - R.Top)));
  1182. end;
  1183. function Ellipse(const R: TRect; Steps: Integer): TArrayOfFloatPoint;
  1184. begin
  1185. Result := Ellipse(
  1186. FloatPoint(0.5 * (R.Right + R.Left), 0.5 * (R.Bottom + R.Top)),
  1187. FloatPoint(0.5 * (R.Right - R.Left), 0.5 * (R.Bottom - R.Top)), Steps);
  1188. end;
  1189. function Ellipse(const R: TFloatRect; Steps: Integer): TArrayOfFloatPoint;
  1190. begin
  1191. Result := Ellipse(
  1192. FloatPoint(0.5 * (R.Right + R.Left), 0.5 * (R.Bottom + R.Top)),
  1193. FloatPoint(0.5 * (R.Right - R.Left), 0.5 * (R.Bottom - R.Top)), Steps);
  1194. end;
  1195. function Star(const X, Y, Radius: TFloat; Vertices: Integer = 5;
  1196. Rotation: TFloat = 0): TArrayOfFloatPoint;
  1197. var
  1198. Alpha, Ratio: TFloat;
  1199. begin
  1200. Alpha := Pi * (Vertices - 2 * ((Vertices - 1) shr 1)) / Vertices;
  1201. Ratio := Sin(Alpha * 0.5) / Sin( Alpha * 0.5 + Pi / Vertices);
  1202. Result := Star(X, Y, Ratio * Radius, Radius, Vertices, Rotation);
  1203. end;
  1204. function Star(const P: TFloatPoint; const Radius: TFloat; Vertices: Integer = 5;
  1205. Rotation: TFloat = 0): TArrayOfFloatPoint;
  1206. var
  1207. Alpha, Ratio: TFloat;
  1208. begin
  1209. Alpha := Pi * (Vertices - 2 * ((Vertices - 1) shr 1)) / Vertices;
  1210. Ratio := Sin(Alpha * 0.5) / Sin(Alpha * 0.5 + Pi / Vertices);
  1211. Result := Star(P, Ratio * Radius, Radius, Vertices, Rotation);
  1212. end;
  1213. function Star(const X, Y, InnerRadius, OuterRadius: TFloat;
  1214. Vertices: Integer = 5; Rotation: TFloat = 0): TArrayOfFloatPoint;
  1215. begin
  1216. Result := Star(FloatPoint(X, Y), InnerRadius, OuterRadius, Vertices, Rotation);
  1217. end;
  1218. function Star(const P: TFloatPoint; const InnerRadius, OuterRadius: TFloat;
  1219. Vertices: Integer = 5; Rotation: TFloat = 0): TArrayOfFloatPoint;
  1220. var
  1221. I: Integer;
  1222. M: TFloat;
  1223. C, D: TFloatPoint;
  1224. begin
  1225. SetLength(Result, 2 * Vertices);
  1226. M := System.Pi / Vertices;
  1227. // calculate complex offset
  1228. GR32_Math.SinCos(M, C.Y, C.X);
  1229. // first item
  1230. if Rotation = 0 then
  1231. begin
  1232. Result[0].X := OuterRadius + P.X;
  1233. Result[0].Y := P.Y;
  1234. D := C;
  1235. end
  1236. else
  1237. begin
  1238. GR32_Math.SinCos(Rotation, D.Y, D.X);
  1239. Result[0].X := OuterRadius * D.X + P.X;
  1240. Result[0].Y := OuterRadius * D.Y + P.Y;
  1241. D := FloatPoint(D.X * C.X - D.Y * C.Y, D.Y * C.X + D.X * C.Y);
  1242. end;
  1243. // second item
  1244. Result[1].X := InnerRadius * D.X + P.X;
  1245. Result[1].Y := InnerRadius * D.Y + P.Y;
  1246. // other items
  1247. for I := 2 to (2 * Vertices) - 1 do
  1248. begin
  1249. D := FloatPoint(D.X * C.X - D.Y * C.Y, D.Y * C.X + D.X * C.Y);
  1250. if I mod 2 = 0 then
  1251. begin
  1252. Result[I].X := OuterRadius * D.X + P.X;
  1253. Result[I].Y := OuterRadius * D.Y + P.Y;
  1254. end
  1255. else
  1256. begin
  1257. Result[I].X := InnerRadius * D.X + P.X;
  1258. Result[I].Y := InnerRadius * D.Y + P.Y;
  1259. end;
  1260. end;
  1261. end;
  1262. function Rectangle(const R: TRect): TArrayOfFloatPoint;
  1263. begin
  1264. SetLength(Result, 4);
  1265. Result[0] := FloatPoint(R.TopLeft);
  1266. Result[1] := FloatPoint(R.Right, R.Top);
  1267. Result[2] := FloatPoint(R.BottomRight);
  1268. Result[3] := FloatPoint(R.Left, R.Bottom);
  1269. end;
  1270. function Rectangle(const R: TFloatRect): TArrayOfFloatPoint;
  1271. begin
  1272. SetLength(Result, 4);
  1273. Result[0] := R.TopLeft;
  1274. Result[1] := FloatPoint(R.Right, R.Top);
  1275. Result[2] := R.BottomRight;
  1276. Result[3] := FloatPoint(R.Left, R.Bottom);
  1277. end;
  1278. function RoundRect(const R: TFloatRect; const Radius: TFloat): TArrayOfFloatPoint;
  1279. var
  1280. R2: TFloatRect;
  1281. CornerRadius: TFloat;
  1282. begin
  1283. // Constrain radius to half width & height
  1284. CornerRadius := Min(Radius, Min(R.Width / 2, R.Height / 2));
  1285. R2 := R;
  1286. // Shrink box and then...
  1287. GR32.InflateRect(R2, -CornerRadius, -CornerRadius);
  1288. // ...Grow it with rounded corners
  1289. Result := Grow(Rectangle(R2), CornerRadius, jsRound, True);
  1290. end;
  1291. function BuildNormals(const Points: TArrayOfFloatPoint): TArrayOfFloatPoint;
  1292. const
  1293. EPSILON = 1E-4;
  1294. var
  1295. I, Count, NextI: Integer;
  1296. dx, dy, f: Double;
  1297. begin
  1298. Count := Length(Points);
  1299. SetLength(Result, Count);
  1300. I := 0;
  1301. NextI := 1;
  1302. while I < Count do
  1303. begin
  1304. if NextI >= Count then NextI := 0;
  1305. dx := Points[NextI].X - Points[I].X;
  1306. dy := Points[NextI].Y - Points[I].Y;
  1307. f := GR32_Math.Hypot(dx, dy);
  1308. if (f > EPSILON) then
  1309. begin
  1310. f := 1 / f;
  1311. dx := dx * f;
  1312. dy := dy * f;
  1313. end;
  1314. Result[I].X := dy;
  1315. Result[I].Y := -dx;
  1316. Inc(I);
  1317. Inc(NextI);
  1318. end;
  1319. end;
  1320. function BuildNormals(const Points: TArrayOfFixedPoint): TArrayOfFixedPoint;
  1321. var
  1322. I, Count, NextI: Integer;
  1323. dx, dy, f: TFixed;
  1324. begin
  1325. Count := Length(Points);
  1326. SetLength(Result, Count);
  1327. I := 0;
  1328. NextI := 1;
  1329. while I < Count do
  1330. begin
  1331. if NextI >= Count then NextI := 0;
  1332. dx := Points[NextI].X - Points[I].X;
  1333. dy := Points[NextI].Y - Points[I].Y;
  1334. f := GR32_Math.Hypot(dx, dy);
  1335. if (f <> 0) then
  1336. begin
  1337. dx := FixedDiv(dx, f);
  1338. dy := FixedDiv(dy, f);
  1339. end;
  1340. Result[I].X := dy;
  1341. Result[I].Y := -dx;
  1342. Inc(I);
  1343. Inc(NextI);
  1344. end;
  1345. end;
  1346. // Converts an array of points in TFixed format to an array of points in TFloat format
  1347. function FixedPointToFloatPoint(const Points: TArrayOfFixedPoint): TArrayOfFloatPoint;
  1348. var
  1349. Index: Integer;
  1350. begin
  1351. SetLength(Result, Length(Points));
  1352. for Index := 0 to Length(Points) - 1 do
  1353. begin
  1354. Result[Index].X := Points[Index].X * FixedToFloat;
  1355. Result[Index].Y := Points[Index].Y * FixedToFloat;
  1356. end;
  1357. end;
  1358. // Converts an array of array of points in TFixed format to an array of array of points in TFloat format
  1359. function FixedPointToFloatPoint(const Points: TArrayOfArrayOfFixedPoint): TArrayOfArrayOfFloatPoint;
  1360. var
  1361. Index, PointIndex: Integer;
  1362. begin
  1363. SetLength(Result, Length(Points));
  1364. for Index := 0 to Length(Points) - 1 do
  1365. begin
  1366. SetLength(Result[Index], Length(Points[Index]));
  1367. for PointIndex := 0 to Length(Points[Index]) - 1 do
  1368. begin
  1369. Result[Index, PointIndex].X := Points[Index, PointIndex].X * FixedToFloat;
  1370. Result[Index, PointIndex].Y := Points[Index, PointIndex].Y * FixedToFloat;
  1371. end;
  1372. end;
  1373. end;
  1374. // Converts an array of points in TFixed format to an array of points in TFloat format
  1375. function FloatPointToFixedPoint(const Points: TArrayOfFloatPoint): TArrayOfFixedPoint;
  1376. var
  1377. Index: Integer;
  1378. begin
  1379. SetLength(Result, Length(Points));
  1380. for Index := 0 to Length(Points) - 1 do
  1381. begin
  1382. Result[Index].X := Fixed(Points[Index].X);
  1383. Result[Index].Y := Fixed(Points[Index].Y);
  1384. end;
  1385. end;
  1386. // Converts an array of array of points in TFixed format to an array of array of points in TFloat format
  1387. function FloatPointToFixedPoint(const Points: TArrayOfArrayOfFloatPoint): TArrayOfArrayOfFixedPoint;
  1388. var
  1389. Index, PointIndex: Integer;
  1390. begin
  1391. SetLength(Result, Length(Points));
  1392. for Index := 0 to Length(Points) - 1 do
  1393. begin
  1394. SetLength(Result[Index], Length(Points[Index]));
  1395. for PointIndex := 0 to Length(Points[Index]) - 1 do
  1396. begin
  1397. Result[Index, PointIndex].X := Fixed(Points[Index, PointIndex].X);
  1398. Result[Index, PointIndex].Y := Fixed(Points[Index, PointIndex].Y);
  1399. end;
  1400. end;
  1401. end;
  1402. function ReversePolygon(const Points: TArrayOfFloatPoint): TArrayOfFloatPoint;
  1403. var
  1404. I, L: Integer;
  1405. begin
  1406. L := Length(Points);
  1407. SetLength(Result, L);
  1408. Dec(L);
  1409. for I := 0 to L do
  1410. Result[I] := Points[L - I];
  1411. end;
  1412. function ReversePolygon(const Points: TArrayOfFixedPoint): TArrayOfFixedPoint;
  1413. var
  1414. I, L: Integer;
  1415. begin
  1416. L := Length(Points);
  1417. SetLength(Result, L);
  1418. Dec(L);
  1419. for I := 0 to L do
  1420. Result[I] := Points[L - I];
  1421. end;
  1422. function BuildDashedLine(const Points: TArrayOfFloatPoint;
  1423. const DashArray: TArrayOfFloat; DashOffset: TFloat = 0;
  1424. Closed: Boolean = False): TArrayOfArrayOfFloatPoint;
  1425. const
  1426. EPSILON = 1E-4;
  1427. var
  1428. I, J, DashIndex, len1, len2: Integer;
  1429. Offset, Dist, v: TFloat;
  1430. Delta: TFloatPoint;
  1431. procedure AddPoint(X, Y: TFloat);
  1432. var
  1433. K: Integer;
  1434. begin
  1435. K := Length(Result[J]);
  1436. SetLength(Result[J], K + 1);
  1437. Result[J][K].X := X;
  1438. Result[J][K].Y := Y;
  1439. end;
  1440. procedure AddDash(I: Integer);
  1441. begin
  1442. if i = 0 then
  1443. begin
  1444. Delta.X := Points[0].X - Points[High(Points)].X;
  1445. Delta.Y := Points[0].Y - Points[High(Points)].Y;
  1446. end else
  1447. begin
  1448. Delta.X := Points[I].X - Points[I - 1].X;
  1449. Delta.Y := Points[I].Y - Points[I - 1].Y;
  1450. end;
  1451. Dist := GR32_Math.Hypot(Delta.X, Delta.Y);
  1452. Offset := Offset + Dist;
  1453. if (Dist > EPSILON) then
  1454. begin
  1455. Dist := 1 / Dist;
  1456. Delta.X := Delta.X * Dist;
  1457. Delta.Y := Delta.Y * Dist;
  1458. end;
  1459. while Offset > DashOffset do
  1460. begin
  1461. v := Offset - DashOffset;
  1462. AddPoint(Points[I].X - v * Delta.X, Points[I].Y - v * Delta.Y);
  1463. DashIndex := (DashIndex + 1) mod Length(DashArray);
  1464. DashOffset := DashOffset + DashArray[DashIndex];
  1465. if Odd(DashIndex) then
  1466. begin
  1467. Inc(J);
  1468. SetLength(Result, J + 1);
  1469. end;
  1470. end;
  1471. if not Odd(DashIndex) then
  1472. AddPoint(Points[I].X, Points[I].Y);
  1473. end;
  1474. begin
  1475. Result := nil;
  1476. if (Length(Points) = 0) then
  1477. Exit;
  1478. if (Length(DashArray) = 0) then
  1479. begin
  1480. Setlength(Result, 1);
  1481. Result[0] := Points;
  1482. Exit;
  1483. end;
  1484. DashIndex := -1;
  1485. Offset := 0;
  1486. V := 0;
  1487. for I := 0 to High(DashArray) do
  1488. V := V + DashArray[I];
  1489. DashOffset := Wrap(DashOffset, V);
  1490. DashOffset := DashOffset - V;
  1491. while (DashOffset < 0) and (DashIndex < High(DashArray)) do
  1492. begin
  1493. Inc(DashIndex);
  1494. DashOffset := DashOffset + DashArray[DashIndex];
  1495. end;
  1496. J := 0;
  1497. // note to self: second dimension might not be zero by default!
  1498. SetLength(Result, 1, 0);
  1499. if not Odd(DashIndex) then
  1500. AddPoint(Points[0].X, Points[0].Y);
  1501. for I := 1 to High(Points) do
  1502. AddDash(I);
  1503. if Closed then
  1504. begin
  1505. AddDash(0);
  1506. len1 := Length(Result[0]);
  1507. len2 := Length(Result[J]);
  1508. // Only merge if the first and last points are contributing on a dash
  1509. {$IFNDEF FPC}
  1510. if (len1 > 0) and (len2 > 0) and (Result[0][0] = Result[J][len2 - 1]) then
  1511. {$ELSE}
  1512. if (len1 > 0) and (len2 > 0) and (Result[0][0].X = Result[J][len2 - 1].X) and (Result[0][0].Y = Result[J][len2 - 1].Y) then
  1513. {$ENDIF}
  1514. begin
  1515. SetLength(Result[0], len1 + len2 -1);
  1516. Move(Result[0][0], Result[0][len2 - 1], SizeOf(TFloatPoint) * len1);
  1517. Move(Result[J][0], Result[0][0], SizeOf(TFloatPoint) * len2);
  1518. SetLength(Result, J);
  1519. Dec(J);
  1520. end;
  1521. end;
  1522. if (J >= 0) and (Length(Result[J]) = 0) then
  1523. SetLength(Result, J);
  1524. end;
  1525. function BuildDashedLine(const Points: TArrayOfFixedPoint;
  1526. const DashArray: TArrayOfFixed; DashOffset: TFixed = 0;
  1527. Closed: Boolean = False): TArrayOfArrayOfFixedPoint;
  1528. var
  1529. I, J, DashIndex, Len1, Len2: Integer;
  1530. Offset, Dist, v: TFixed;
  1531. Delta: TFixedPoint;
  1532. procedure AddPoint(X, Y: TFixed);
  1533. var
  1534. K: Integer;
  1535. begin
  1536. K := Length(Result[J]);
  1537. SetLength(Result[J], K + 1);
  1538. Result[J][K].X := X;
  1539. Result[J][K].Y := Y;
  1540. end;
  1541. procedure AddDash(I: Integer);
  1542. begin
  1543. if i = 0 then
  1544. begin
  1545. Delta.X := Points[0].X - Points[High(Points)].X;
  1546. Delta.Y := Points[0].Y - Points[High(Points)].Y;
  1547. end else
  1548. begin
  1549. Delta.X := Points[I].X - Points[I - 1].X;
  1550. Delta.Y := Points[I].Y - Points[I - 1].Y;
  1551. end;
  1552. Dist := GR32_Math.Hypot(Delta.X, Delta.Y);
  1553. Offset := Offset + Dist;
  1554. if (Dist > 0) then
  1555. begin
  1556. Delta.X := FixedDiv(Delta.X, Dist);
  1557. Delta.Y := FixedDiv(Delta.Y, Dist);
  1558. end;
  1559. while Offset > DashOffset do
  1560. begin
  1561. v := Offset - DashOffset;
  1562. AddPoint(Points[I].X - FixedMul(v, Delta.X), Points[I].Y - FixedMul(v,
  1563. Delta.Y));
  1564. DashIndex := (DashIndex + 1) mod Length(DashArray);
  1565. DashOffset := DashOffset + DashArray[DashIndex];
  1566. if Odd(DashIndex) then
  1567. begin
  1568. Inc(J);
  1569. SetLength(Result, J + 1);
  1570. end;
  1571. end;
  1572. if not Odd(DashIndex) then
  1573. AddPoint(Points[I].X, Points[I].Y);
  1574. end;
  1575. begin
  1576. Result := nil;
  1577. if (Length(Points) = 0) then
  1578. Exit;
  1579. if (Length(DashArray) = 0) then
  1580. begin
  1581. Setlength(Result, 1);
  1582. Result[0] := Points;
  1583. Exit;
  1584. end;
  1585. DashIndex := -1;
  1586. Offset := 0;
  1587. V := 0;
  1588. for I := 0 to High(DashArray) do
  1589. V := V + DashArray[I];
  1590. DashOffset := Wrap(DashOffset, V);
  1591. DashOffset := DashOffset - V;
  1592. while DashOffset < 0 do
  1593. begin
  1594. Inc(DashIndex);
  1595. DashOffset := DashOffset + DashArray[DashIndex];
  1596. end;
  1597. J := 0;
  1598. // note to self: second dimension might not be zero by default!
  1599. SetLength(Result, 1, 0);
  1600. if not Odd(DashIndex) then
  1601. AddPoint(Points[0].X, Points[0].Y);
  1602. for I := 1 to High(Points) do
  1603. AddDash(I);
  1604. if Closed then
  1605. begin
  1606. AddDash(0);
  1607. Len1 := Length(Result[0]);
  1608. Len2 := Length(Result[J]);
  1609. if (Len1 > 0) and (Len2 > 0) then
  1610. begin
  1611. SetLength(Result[0], len1 + len2 -1);
  1612. Move(Result[0][0], Result[0][len2 - 1], SizeOf(TFixedPoint) * Len1);
  1613. Move(Result[J][0], Result[0][0], SizeOf(TFixedPoint) * Len2);
  1614. SetLength(Result, J);
  1615. Dec(J);
  1616. end;
  1617. end;
  1618. if (J >= 0) and (Length(Result[J]) = 0) then SetLength(Result, J);
  1619. end;
  1620. function InterpolateX(X: TFloat; const P1, P2: TFloatPoint): TFloatPoint; overload;
  1621. var
  1622. W: Double;
  1623. begin
  1624. W := (X - P1.X) / (P2.X - P1.X);
  1625. Result.X := X;
  1626. Result.Y := P1.Y + W * (P2.Y - P1.Y);
  1627. end;
  1628. function InterpolateY(Y: TFloat; const P1, P2: TFloatPoint): TFloatPoint; overload;
  1629. var
  1630. W: Double;
  1631. begin
  1632. W := (Y - P1.Y) / (P2.Y - P1.Y);
  1633. Result.Y := Y;
  1634. Result.X := P1.X + W * (P2.X - P1.X);
  1635. end;
  1636. function GetCode(const P: TFloatPoint; const R: TFloatRect): Integer; overload; {$IFDEF USEINLINING}inline;{$ENDIF}
  1637. begin
  1638. Result := Ord(P.X >= R.Left) or
  1639. (Ord(P.X <= R.Right) shl 1) or
  1640. (Ord(P.Y >= R.Top) shl 2) or
  1641. (Ord(P.Y <= R.Bottom) shl 3);
  1642. end;
  1643. function ClipPolygon(const Points: TArrayOfFloatPoint; const ClipRect: TFloatRect): TArrayOfFloatPoint;
  1644. type
  1645. TInterpolateProc = function(X: TFloat; const P1, P2: TFloatPoint): TFloatPoint;
  1646. const
  1647. SAFEOVERSIZE = 5;
  1648. POPCOUNT: array [0..15] of Integer =
  1649. (0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4);
  1650. var
  1651. I, J, K, L, N: Integer;
  1652. X, Y, Z, Code, Count: Integer;
  1653. Codes: PByteArray;
  1654. NextIndex: PIntegerArray;
  1655. Temp: PFloatPointArray;
  1656. label
  1657. ExitProc;
  1658. procedure AddPoint(Index: Integer; const P: TFloatPoint);
  1659. begin
  1660. Temp[K] := P;
  1661. Codes[K] := GetCode(P, ClipRect);
  1662. Inc(K);
  1663. Inc(Count);
  1664. end;
  1665. function ClipEdges(Mask: Integer; V: TFloat; Interpolate: TInterpolateProc): Boolean;
  1666. var
  1667. I, NextI, StopIndex: Integer;
  1668. begin
  1669. I := 0;
  1670. while (I < K) and (Codes[I] and Mask = 0) do Inc(I);
  1671. Result := I = K;
  1672. if Result then { all points outside }
  1673. begin
  1674. ClipPolygon := nil;
  1675. Result := True;
  1676. Exit;
  1677. end;
  1678. StopIndex := I;
  1679. repeat
  1680. NextI := NextIndex[I];
  1681. if Codes[NextI] and Mask = 0 then { inside -> outside }
  1682. begin
  1683. NextIndex[I] := K;
  1684. NextIndex[K] := K + 1;
  1685. AddPoint(I, Interpolate(V, Temp[I], Temp[NextI]));
  1686. while Codes[NextI] and Mask = 0 do
  1687. begin
  1688. Dec(Count);
  1689. Codes[NextI] := 0;
  1690. I := NextI;
  1691. NextI := NextIndex[I];
  1692. end;
  1693. { outside -> inside }
  1694. NextIndex[I] := K;
  1695. NextIndex[K] := NextI;
  1696. AddPoint(I, Interpolate(V, Temp[I], Temp[NextI]));
  1697. end;
  1698. I := NextI;
  1699. until I = StopIndex;
  1700. end;
  1701. begin
  1702. N := Length(Points);
  1703. {$IFDEF USESTACKALLOC}
  1704. Codes := StackAlloc(N * SAFEOVERSIZE * SizeOf(Byte));
  1705. {$ELSE}
  1706. GetMem(Codes, N * SAFEOVERSIZE * SizeOf(Byte));
  1707. {$ENDIF}
  1708. X := 15;
  1709. Y := 0;
  1710. for I := 0 to N - 1 do
  1711. begin
  1712. Code := GetCode(Points[I], ClipRect);
  1713. Codes[I] := Code;
  1714. X := X and Code;
  1715. Y := Y or Code;
  1716. end;
  1717. if X = 15 then { all points inside }
  1718. begin
  1719. Result := Points;
  1720. end
  1721. else if Y <> 15 then { all points outside }
  1722. begin
  1723. Result := nil;
  1724. end
  1725. else
  1726. begin
  1727. Count := N;
  1728. Z := Codes[N - 1];
  1729. for I := 0 to N - 1 do
  1730. begin
  1731. Code := Codes[I];
  1732. Inc(Count, POPCOUNT[Z xor Code]);
  1733. Z := Code;
  1734. end;
  1735. {$IFDEF USESTACKALLOC}
  1736. Temp := StackAlloc(Count * SizeOf(TFloatPoint));
  1737. NextIndex := StackAlloc(Count * SizeOf(TFloatPoint));
  1738. {$ELSE}
  1739. GetMem(Temp, Count * SizeOf(TFloatPoint));
  1740. GetMem(NextIndex, Count * SizeOf(TFloatPoint));
  1741. {$ENDIF}
  1742. Move(Points[0], Temp[0], N * SizeOf(TFloatPoint));
  1743. for I := 0 to N - 2 do NextIndex[I] := I + 1;
  1744. NextIndex[N - 1] := 0;
  1745. Count := N;
  1746. K := N;
  1747. if X and 1 = 0 then if ClipEdges(1, ClipRect.Left, InterpolateX) then goto ExitProc;
  1748. if X and 2 = 0 then if ClipEdges(2, ClipRect.Right, InterpolateX) then goto ExitProc;
  1749. if X and 4 = 0 then if ClipEdges(4, ClipRect.Top, InterpolateY) then goto ExitProc;
  1750. if X and 8 = 0 then if ClipEdges(8, ClipRect.Bottom, InterpolateY) then goto ExitProc;
  1751. SetLength(Result, Count);
  1752. { start with first point inside the clipping rectangle }
  1753. I := 0;
  1754. while Codes[I] = 0 do
  1755. I := NextIndex[I];
  1756. J := I;
  1757. L := 0;
  1758. repeat
  1759. Result[L] := Temp[I];
  1760. Inc(L);
  1761. I := NextIndex[I];
  1762. until I = J;
  1763. ExitProc:
  1764. {$IFDEF USESTACKALLOC}
  1765. StackFree(NextIndex);
  1766. StackFree(Temp);
  1767. {$ELSE}
  1768. FreeMem(NextIndex);
  1769. FreeMem(Temp);
  1770. {$ENDIF}
  1771. end;
  1772. {$IFDEF USESTACKALLOC}
  1773. StackFree(Codes);
  1774. {$ELSE}
  1775. FreeMem(Codes);
  1776. {$ENDIF}
  1777. end;
  1778. function InterpolateX(X: TFixed; const P1, P2: TFixedPoint): TFixedPoint; overload;
  1779. var
  1780. W: TFixed;
  1781. begin
  1782. W := FixedDiv(X - P1.X, P2.X - P1.X);
  1783. Result.X := X;
  1784. Result.Y := P1.Y + FixedMul(W, P2.Y - P1.Y);
  1785. end;
  1786. function InterpolateY(Y: TFixed; const P1, P2: TFixedPoint): TFixedPoint; overload;
  1787. var
  1788. W: TFixed;
  1789. begin
  1790. W := FixedDiv(Y - P1.Y, P2.Y - P1.Y);
  1791. Result.Y := Y;
  1792. Result.X := P1.X + FixedMul(W, P2.X - P1.X);
  1793. end;
  1794. function GetCode(const P: TFixedPoint; const R: TFixedRect): Integer; overload; {$IFDEF USEINLINING}inline;{$ENDIF}
  1795. begin
  1796. Result := Ord(P.X >= R.Left) or
  1797. (Ord(P.X <= R.Right) shl 1) or
  1798. (Ord(P.Y >= R.Top) shl 2) or
  1799. (Ord(P.Y <= R.Bottom) shl 3);
  1800. end;
  1801. function ClipPolygon(const Points: TArrayOfFixedPoint; const ClipRect: TFixedRect): TArrayOfFixedPoint;
  1802. type
  1803. TInterpolateProc = function(X: TFixed; const P1, P2: TFixedPoint): TFixedPoint;
  1804. const
  1805. SAFEOVERSIZE = 5;
  1806. POPCOUNT: array [0..15] of Integer =
  1807. (0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4);
  1808. var
  1809. I, J, K, L, N: Integer;
  1810. X, Y, Z, Code, Count: Integer;
  1811. Codes: PByteArray;
  1812. NextIndex: PIntegerArray;
  1813. Temp: PFixedPointArray;
  1814. label
  1815. ExitProc;
  1816. procedure AddPoint(Index: Integer; const P: TFixedPoint);
  1817. begin
  1818. Temp[K] := P;
  1819. Codes[K] := GetCode(P, ClipRect);
  1820. Inc(K);
  1821. Inc(Count);
  1822. end;
  1823. function ClipEdges(Mask: Integer; V: TFixed; Interpolate: TInterpolateProc): Boolean;
  1824. var
  1825. I, NextI, StopIndex: Integer;
  1826. begin
  1827. I := 0;
  1828. while (I < K) and (Codes[I] and Mask = 0) do Inc(I);
  1829. Result := I = K;
  1830. if Result then { all points outside }
  1831. begin
  1832. ClipPolygon := nil;
  1833. Result := True;
  1834. Exit;
  1835. end;
  1836. StopIndex := I;
  1837. repeat
  1838. NextI := NextIndex[I];
  1839. if Codes[NextI] and Mask = 0 then { inside -> outside }
  1840. begin
  1841. NextIndex[I] := K;
  1842. NextIndex[K] := K + 1;
  1843. AddPoint(I, Interpolate(V, Temp[I], Temp[NextI]));
  1844. while Codes[NextI] and Mask = 0 do
  1845. begin
  1846. Dec(Count);
  1847. Codes[NextI] := 0;
  1848. I := NextI;
  1849. NextI := NextIndex[I];
  1850. end;
  1851. { outside -> inside }
  1852. NextIndex[I] := K;
  1853. NextIndex[K] := NextI;
  1854. AddPoint(I, Interpolate(V, Temp[I], Temp[NextI]));
  1855. end;
  1856. I := NextI;
  1857. until I = StopIndex;
  1858. end;
  1859. begin
  1860. N := Length(Points);
  1861. {$IFDEF USESTACKALLOC}
  1862. Codes := StackAlloc(N * SAFEOVERSIZE * SizeOf(Byte));
  1863. {$ELSE}
  1864. GetMem(Codes, N * SAFEOVERSIZE * SizeOf(Byte));
  1865. {$ENDIF}
  1866. X := 15;
  1867. Y := 0;
  1868. for I := 0 to N - 1 do
  1869. begin
  1870. Code := GetCode(Points[I], ClipRect);
  1871. Codes[I] := Code;
  1872. X := X and Code;
  1873. Y := Y or Code;
  1874. end;
  1875. if X = 15 then { all points inside }
  1876. begin
  1877. Result := Points;
  1878. end
  1879. else if Y <> 15 then { all points outside }
  1880. begin
  1881. Result := nil;
  1882. end
  1883. else
  1884. begin
  1885. Count := N;
  1886. Z := Codes[N - 1];
  1887. for I := 0 to N - 1 do
  1888. begin
  1889. Code := Codes[I];
  1890. Inc(Count, POPCOUNT[Z xor Code]);
  1891. Z := Code;
  1892. end;
  1893. {$IFDEF USESTACKALLOC}
  1894. Temp := StackAlloc(Count * SizeOf(TFixedPoint));
  1895. NextIndex := StackAlloc(Count * SizeOf(TFixedPoint));
  1896. {$ELSE}
  1897. GetMem(Temp, Count * SizeOf(TFixedPoint));
  1898. GetMem(NextIndex, Count * SizeOf(TFixedPoint));
  1899. {$ENDIF}
  1900. Move(Points[0], Temp[0], N * SizeOf(TFixedPoint));
  1901. for I := 0 to N - 2 do NextIndex[I] := I + 1;
  1902. NextIndex[N - 1] := 0;
  1903. Count := N;
  1904. K := N;
  1905. if X and 1 = 0 then if ClipEdges(1, ClipRect.Left, InterpolateX) then goto ExitProc;
  1906. if X and 2 = 0 then if ClipEdges(2, ClipRect.Right, InterpolateX) then goto ExitProc;
  1907. if X and 4 = 0 then if ClipEdges(4, ClipRect.Top, InterpolateY) then goto ExitProc;
  1908. if X and 8 = 0 then if ClipEdges(8, ClipRect.Bottom, InterpolateY) then goto ExitProc;
  1909. SetLength(Result, Count);
  1910. { start with first point inside the clipping rectangle }
  1911. I := 0;
  1912. while Codes[I] = 0 do
  1913. I := NextIndex[I];
  1914. J := I;
  1915. L := 0;
  1916. repeat
  1917. Result[L] := Temp[I];
  1918. Inc(L);
  1919. I := NextIndex[I];
  1920. until I = J;
  1921. ExitProc:
  1922. {$IFDEF USESTACKALLOC}
  1923. StackFree(NextIndex);
  1924. StackFree(Temp);
  1925. {$ELSE}
  1926. FreeMem(NextIndex);
  1927. FreeMem(Temp);
  1928. {$ENDIF}
  1929. end;
  1930. {$IFDEF USESTACKALLOC}
  1931. StackFree(Codes);
  1932. {$ELSE}
  1933. FreeMem(Codes);
  1934. {$ENDIF}
  1935. end;
  1936. function PolygonBounds(const Points: TArrayOfFloatPoint): TFloatRect;
  1937. var
  1938. I: Integer;
  1939. begin
  1940. if (Length(Points) = 0) then
  1941. Exit(Default(TFloatRect));
  1942. Result.Left := Points[0].X;
  1943. Result.Top := Points[0].Y;
  1944. Result.Right := Points[0].X;
  1945. Result.Bottom := Points[0].Y;
  1946. for I := 1 to High(Points) do
  1947. begin
  1948. Result.Left := Min(Result.Left, Points[I].X);
  1949. Result.Right := Max(Result.Right, Points[I].X);
  1950. Result.Top := Min(Result.Top, Points[I].Y);
  1951. Result.Bottom := Max(Result.Bottom, Points[I].Y);
  1952. end;
  1953. end;
  1954. function PolygonBounds(const Points: TArrayOfFixedPoint): TFixedRect;
  1955. var
  1956. I: Integer;
  1957. begin
  1958. if (Length(Points) = 0) then
  1959. Exit(Default(TFixedRect));
  1960. Result.Left := Points[0].X;
  1961. Result.Top := Points[0].Y;
  1962. Result.Right := Points[0].X;
  1963. Result.Bottom := Points[0].Y;
  1964. for I := 1 to High(Points) do
  1965. begin
  1966. Result.Left := Min(Result.Left, Points[I].X);
  1967. Result.Right := Max(Result.Right, Points[I].X);
  1968. Result.Top := Min(Result.Top, Points[I].Y);
  1969. Result.Bottom := Max(Result.Bottom, Points[I].Y);
  1970. end;
  1971. end;
  1972. function PolyPolygonBounds(const Points: TArrayOfArrayOfFloatPoint): TFloatRect;
  1973. var
  1974. i: Integer;
  1975. R: TFloatRect;
  1976. AnyValid: boolean;
  1977. begin
  1978. if (Length(Points) = 0) then
  1979. Exit(Default(TFloatRect));
  1980. AnyValid := False;
  1981. for i := 0 to High(Points) do
  1982. begin
  1983. if (Length(Points[i]) = 0) then
  1984. continue;
  1985. if (not AnyValid) then
  1986. begin
  1987. Result := PolygonBounds(Points[i]);
  1988. AnyValid := True;
  1989. end else
  1990. begin
  1991. R := PolygonBounds(Points[i]);
  1992. if (Result.Left > R.Left) then
  1993. Result.Left := R.Left;
  1994. if (Result.Right < R.Right) then
  1995. Result.Right := R.Right;
  1996. if (Result.Top > R.Top) then
  1997. Result.Top := R.Top;
  1998. if (Result.Bottom < R.Bottom) then
  1999. Result.Bottom := R.Bottom;
  2000. end;
  2001. end;
  2002. if (not AnyValid) then
  2003. Exit(Default(TFloatRect));
  2004. end;
  2005. function PolyPolygonBounds(const Points: TArrayOfArrayOfFixedPoint): TFixedRect;
  2006. var
  2007. i: Integer;
  2008. R: TFixedRect;
  2009. AnyValid: boolean;
  2010. begin
  2011. if (Length(Points) = 0) then
  2012. Exit(Default(TFixedRect));
  2013. AnyValid := False;
  2014. for i := 0 to High(Points) do
  2015. begin
  2016. if (Length(Points[i]) = 0) then
  2017. continue;
  2018. if (not AnyValid) then
  2019. begin
  2020. Result := PolygonBounds(Points[i]);
  2021. AnyValid := True;
  2022. end else
  2023. begin
  2024. R := PolygonBounds(Points[i]);
  2025. if (Result.Left > R.Left) then
  2026. Result.Left := R.Left;
  2027. if (Result.Right < R.Right) then
  2028. Result.Right := R.Right;
  2029. if (Result.Top > R.Top) then
  2030. Result.Top := R.Top;
  2031. if (Result.Bottom < R.Bottom) then
  2032. Result.Bottom := R.Bottom;
  2033. end;
  2034. end;
  2035. if (not AnyValid) then
  2036. Exit(Default(TFixedRect));
  2037. end;
  2038. // Scales to a polygon (TArrayOfFloatPoint)
  2039. function ScalePolygon(const Points: TArrayOfFloatPoint; ScaleX, ScaleY: TFloat): TArrayOfFloatPoint;
  2040. var
  2041. I, L: Integer;
  2042. begin
  2043. L := Length(Points);
  2044. SetLength(Result, L);
  2045. for I := 0 to L - 1 do
  2046. begin
  2047. Result[I].X := Points[I].X * ScaleX;
  2048. Result[I].Y := Points[I].Y * ScaleY;
  2049. end;
  2050. end;
  2051. // Scales to a polygon (TArrayOfFixedPoint)
  2052. function ScalePolygon(const Points: TArrayOfFixedPoint; ScaleX, ScaleY: TFixed): TArrayOfFixedPoint;
  2053. var
  2054. I, L: Integer;
  2055. begin
  2056. L := Length(Points);
  2057. SetLength(Result, L);
  2058. for I := 0 to L - 1 do
  2059. begin
  2060. Result[I].X := FixedMul(Points[I].X, ScaleX);
  2061. Result[I].Y := FixedMul(Points[I].Y, ScaleY);
  2062. end;
  2063. end;
  2064. // Scales all sub polygons in a complex polygon (TArrayOfArrayOfFloatPoint)
  2065. function ScalePolyPolygon(const Points: TArrayOfArrayOfFloatPoint;
  2066. ScaleX, ScaleY: TFloat): TArrayOfArrayOfFloatPoint;
  2067. var
  2068. I, L: Integer;
  2069. begin
  2070. L := Length(Points);
  2071. SetLength(Result, L);
  2072. for I := 0 to L - 1 do
  2073. Result[I] := ScalePolygon(Points[I], ScaleX, ScaleY);
  2074. end;
  2075. // Scales all sub polygons in a complex polygon (TArrayOfArrayOfFixedPoint)
  2076. function ScalePolyPolygon(const Points: TArrayOfArrayOfFixedPoint;
  2077. ScaleX, ScaleY: TFixed): TArrayOfArrayOfFixedPoint;
  2078. var
  2079. I, L: Integer;
  2080. begin
  2081. L := Length(Points);
  2082. SetLength(Result, L);
  2083. for I := 0 to L - 1 do
  2084. Result[I] := ScalePolygon(Points[I], ScaleX, ScaleY);
  2085. end;
  2086. // Scales a polygon (TArrayOfFloatPoint)
  2087. procedure ScalePolygonInplace(const Points: TArrayOfFloatPoint; ScaleX, ScaleY: TFloat);
  2088. var
  2089. I: Integer;
  2090. begin
  2091. for I := 0 to Length(Points) - 1 do
  2092. begin
  2093. Points[I].X := Points[I].X * ScaleX;
  2094. Points[I].Y := Points[I].Y * ScaleY;
  2095. end;
  2096. end;
  2097. // Scales a polygon (TArrayOfFixedPoint)
  2098. procedure ScalePolygonInplace(const Points: TArrayOfFixedPoint; ScaleX, ScaleY: TFixed);
  2099. var
  2100. I: Integer;
  2101. begin
  2102. for I := 0 to Length(Points) - 1 do
  2103. begin
  2104. Points[I].X := FixedMul(Points[I].X, ScaleX);
  2105. Points[I].Y := FixedMul(Points[I].Y, ScaleY);
  2106. end;
  2107. end;
  2108. // Scales all sub polygons in a complex polygon (TArrayOfArrayOfFloatPoint)
  2109. procedure ScalePolyPolygonInplace(const Points: TArrayOfArrayOfFloatPoint;
  2110. ScaleX, ScaleY: TFloat);
  2111. var
  2112. I: Integer;
  2113. begin
  2114. for I := 0 to Length(Points) - 1 do
  2115. ScalePolygonInplace(Points[I], ScaleX, ScaleY);
  2116. end;
  2117. // Scales all sub polygons in a complex polygon (TArrayOfArrayOfFixedPoint)
  2118. procedure ScalePolyPolygonInplace(const Points: TArrayOfArrayOfFixedPoint;
  2119. ScaleX, ScaleY: TFixed);
  2120. var
  2121. I: Integer;
  2122. begin
  2123. for I := 0 to Length(Points) - 1 do
  2124. ScalePolygonInplace(Points[I], ScaleX, ScaleY);
  2125. end;
  2126. // Translates a polygon (TArrayOfFloatPoint)
  2127. function TranslatePolygon(const Points: TArrayOfFloatPoint;
  2128. OffsetX, OffsetY: TFloat): TArrayOfFloatPoint;
  2129. var
  2130. I, Len: Integer;
  2131. begin
  2132. Len := Length(Points);
  2133. SetLength(Result, Len);
  2134. for I := 0 to Len - 1 do
  2135. begin
  2136. Result[I].X := Points[I].X + OffsetX;
  2137. Result[I].Y := Points[I].Y + OffsetY;
  2138. end;
  2139. end;
  2140. // Translates a polygon (TArrayOfFixedPoint)
  2141. function TranslatePolygon(const Points: TArrayOfFixedPoint;
  2142. OffsetX, OffsetY: TFixed): TArrayOfFixedPoint;
  2143. var
  2144. I, Len: Integer;
  2145. begin
  2146. Len := Length(Points);
  2147. SetLength(Result, Len);
  2148. for I := 0 to Len - 1 do
  2149. begin
  2150. Result[I].X := Points[I].X + OffsetX;
  2151. Result[I].Y := Points[I].Y + OffsetY;
  2152. end;
  2153. end;
  2154. // Translates all sub polygons in a complex polygon (TArrayOfArrayOfFloatPoint)
  2155. function TranslatePolyPolygon(const Points: TArrayOfArrayOfFloatPoint; OffsetX,
  2156. OffsetY: TFloat): TArrayOfArrayOfFloatPoint;
  2157. var
  2158. I, L: Integer;
  2159. begin
  2160. L := Length(Points);
  2161. SetLength(Result, L);
  2162. for I := 0 to L - 1 do
  2163. Result[I] := TranslatePolygon(Points[I], OffsetX, OffsetY);
  2164. end;
  2165. // Translates all sub polygons in a complex polygon (TArrayOfArrayOfFixedPoint)
  2166. function TranslatePolyPolygon(const Points: TArrayOfArrayOfFixedPoint;
  2167. OffsetX, OffsetY: TFixed): TArrayOfArrayOfFixedPoint;
  2168. var
  2169. I, L: Integer;
  2170. begin
  2171. L := Length(Points);
  2172. SetLength(Result, L);
  2173. for I := 0 to L - 1 do
  2174. Result[I] := TranslatePolygon(Points[I], OffsetX, OffsetY);
  2175. end;
  2176. procedure TranslatePolygonInplace(const Points: TArrayOfFloatPoint;
  2177. OffsetX, OffsetY: TFloat);
  2178. var
  2179. I: Integer;
  2180. begin
  2181. for I := 0 to Length(Points) - 1 do
  2182. begin
  2183. Points[I].X := Points[I].X + OffsetX;
  2184. Points[I].Y := Points[I].Y + OffsetY;
  2185. end;
  2186. end;
  2187. procedure TranslatePolygonInplace(const Points: TArrayOfFixedPoint;
  2188. OffsetX, OffsetY: TFixed);
  2189. var
  2190. I: Integer;
  2191. begin
  2192. for I := 0 to Length(Points) - 1 do
  2193. begin
  2194. Points[I].X := Points[I].X + OffsetX;
  2195. Points[I].Y := Points[I].Y + OffsetY;
  2196. end;
  2197. end;
  2198. // Translates all sub polygons in a complex polygon (TArrayOfArrayOfFloatPoint)
  2199. procedure TranslatePolyPolygonInplace(const Points: TArrayOfArrayOfFloatPoint; OffsetX,
  2200. OffsetY: TFloat);
  2201. var
  2202. I: Integer;
  2203. begin
  2204. for I := 0 to Length(Points) - 1 do
  2205. TranslatePolygonInplace(Points[I], OffsetX, OffsetY);
  2206. end;
  2207. // Translates all sub polygons in a complex polygon (TArrayOfArrayOfFixedPoint)
  2208. procedure TranslatePolyPolygonInplace(const Points: TArrayOfArrayOfFixedPoint;
  2209. OffsetX, OffsetY: TFixed);
  2210. var
  2211. I: Integer;
  2212. begin
  2213. for I := 0 to Length(Points) - 1 do
  2214. TranslatePolygonInplace(Points[I], OffsetX, OffsetY);
  2215. end;
  2216. // Applies transformation to a polygon (TArrayOfFloatPoint)
  2217. function TransformPolygon(const Points: TArrayOfFloatPoint;
  2218. Transformation: TTransformation): TArrayOfFloatPoint;
  2219. var
  2220. I: Integer;
  2221. begin
  2222. SetLength(Result, Length(Points));
  2223. for I := 0 to High(Result) do
  2224. TTransformationAccess(Transformation).TransformFloat(Points[I].X,
  2225. Points[I].Y, Result[I].X, Result[I].Y);
  2226. end;
  2227. // Applies transformation to a polygon (TArrayOfFixedPoint)
  2228. function TransformPolygon(const Points: TArrayOfFixedPoint;
  2229. Transformation: TTransformation): TArrayOfFixedPoint;
  2230. var
  2231. I: Integer;
  2232. begin
  2233. SetLength(Result, Length(Points));
  2234. for I := 0 to High(Result) do
  2235. TTransformationAccess(Transformation).TransformFixed(Points[I].X,
  2236. Points[I].Y, Result[I].X, Result[I].Y);
  2237. end;
  2238. // Applies transformation to all sub polygons in a complex polygon
  2239. function TransformPolyPolygon(const Points: TArrayOfArrayOfFloatPoint;
  2240. Transformation: TTransformation): TArrayOfArrayOfFloatPoint;
  2241. var
  2242. I: Integer;
  2243. begin
  2244. SetLength(Result, Length(Points));
  2245. TTransformationAccess(Transformation).PrepareTransform;
  2246. for I := 0 to High(Result) do
  2247. Result[I] := TransformPolygon(Points[I], Transformation);
  2248. end;
  2249. // Applies transformation to all sub polygons in a complex polygon
  2250. function TransformPolyPolygon(const Points: TArrayOfArrayOfFixedPoint;
  2251. Transformation: TTransformation): TArrayOfArrayOfFixedPoint;
  2252. var
  2253. I: Integer;
  2254. begin
  2255. SetLength(Result, Length(Points));
  2256. TTransformationAccess(Transformation).PrepareTransform;
  2257. for I := 0 to High(Result) do
  2258. Result[I] := TransformPolygon(Points[I], Transformation);
  2259. end;
  2260. function BuildPolygonF(const Data: array of TFloat): TArrayOfFloatPoint;
  2261. var
  2262. Index, Count: Integer;
  2263. begin
  2264. Count := Length(Data) div 2;
  2265. SetLength(Result, Count);
  2266. if Count = 0 then Exit;
  2267. for Index := 0 to Count - 1 do
  2268. begin
  2269. Result[Index].X := Data[Index * 2];
  2270. Result[Index].Y := Data[Index * 2 + 1];
  2271. end;
  2272. end;
  2273. function BuildPolygonX(const Data: array of TFixed): TArrayOfFixedPoint;
  2274. var
  2275. Index, Count: Integer;
  2276. begin
  2277. Count := Length(Data) div 2;
  2278. SetLength(Result, Count);
  2279. if Count = 0 then Exit;
  2280. for Index := 0 to Count - 1 do
  2281. begin
  2282. Result[Index].X := Data[Index * 2];
  2283. Result[Index].Y := Data[Index * 2 + 1];
  2284. end;
  2285. end;
  2286. // Copy data from Polygon to simple PolyPolygon (using 1 sub polygon only)
  2287. function PolyPolygon(const Points: TArrayOfFloatPoint): TArrayOfArrayOfFloatPoint;
  2288. begin
  2289. SetLength(Result, 1);
  2290. Result[0] := Points;
  2291. end;
  2292. function PolyPolygon(const Points: TArrayOfFixedPoint): TArrayOfArrayOfFixedPoint;
  2293. begin
  2294. SetLength(Result, 1);
  2295. Result[0] := Points;
  2296. end;
  2297. function PointToFloatPoint(const Points: TArrayOfPoint): TArrayOfFloatPoint;
  2298. var
  2299. Index: Integer;
  2300. begin
  2301. if Length(Points) > 0 then
  2302. begin
  2303. SetLength(Result, Length(Points));
  2304. for Index := 0 to Length(Points) - 1 do
  2305. begin
  2306. Result[Index].X := Points[Index].X;
  2307. Result[Index].Y := Points[Index].Y;
  2308. end;
  2309. end;
  2310. end;
  2311. function PointToFloatPoint(const Points: TArrayOfArrayOfPoint): TArrayOfArrayOfFloatPoint;
  2312. var
  2313. Index, PointIndex: Integer;
  2314. begin
  2315. if Length(Points) > 0 then
  2316. begin
  2317. SetLength(Result, Length(Points));
  2318. for Index := 0 to Length(Points) - 1 do
  2319. begin
  2320. SetLength(Result[Index], Length(Points[Index]));
  2321. for PointIndex := 0 to Length(Points[Index]) - 1 do
  2322. begin
  2323. Result[Index, PointIndex].X := Points[Index, PointIndex].X;
  2324. Result[Index, PointIndex].Y := Points[Index, PointIndex].Y;
  2325. end;
  2326. end;
  2327. end;
  2328. end;
  2329. function PointToFixedPoint(const Points: TArrayOfPoint): TArrayOfFixedPoint;
  2330. var
  2331. Index: Integer;
  2332. begin
  2333. if Length(Points) > 0 then
  2334. begin
  2335. SetLength(Result, Length(Points));
  2336. for Index := 0 to Length(Points) - 1 do
  2337. begin
  2338. Result[Index].X := Fixed(Points[Index].X);
  2339. Result[Index].Y := Fixed(Points[Index].Y);
  2340. end;
  2341. end;
  2342. end;
  2343. function PointToFixedPoint(const Points: TArrayOfArrayOfPoint): TArrayOfArrayOfFixedPoint;
  2344. var
  2345. Index, PointIndex: Integer;
  2346. begin
  2347. if Length(Points) > 0 then
  2348. begin
  2349. SetLength(Result, Length(Points));
  2350. for Index := 0 to Length(Points) - 1 do
  2351. begin
  2352. SetLength(Result[Index], Length(Points[Index]));
  2353. for PointIndex := 0 to Length(Points[Index]) - 1 do
  2354. begin
  2355. Result[Index, PointIndex].X := Fixed(Points[Index, PointIndex].X);
  2356. Result[Index, PointIndex].Y := Fixed(Points[Index, PointIndex].Y);
  2357. end;
  2358. end;
  2359. end;
  2360. end;
  2361. //------------------------------------------------------------------------------
  2362. //
  2363. // TPolyLineBuilder
  2364. //
  2365. //------------------------------------------------------------------------------
  2366. // Abstract base class for Grow and BuildPoly*line implementations.
  2367. //------------------------------------------------------------------------------
  2368. class function TPolyLineBuilder.SupportedEndStyles: TEndStyles;
  2369. begin
  2370. Result := [];
  2371. end;
  2372. class function TPolyLineBuilder.SupportedJoinStyles: TJoinStyles;
  2373. begin
  2374. Result := [];
  2375. end;
  2376. //------------------------------------------------------------------------------
  2377. class function TPolyLineBuilder.BuildPolyLine(const Points: TArrayOfFixedPoint; StrokeWidth: TFixed; JoinStyle: TJoinStyle;
  2378. EndStyle: TEndStyle; MiterLimit: TFixed): TArrayOfFixedPoint;
  2379. var
  2380. FloatPoints, FloatResult: TArrayOfFloatPoint;
  2381. begin
  2382. FloatPoints := FixedPointToFloatPoint(Points);
  2383. // Defer to float implementation
  2384. FloatResult := BuildPolyLine(FloatPoints, StrokeWidth*FixedOne, JoinStyle, EndStyle, MiterLimit*FixedOne);
  2385. if (Length(FloatResult) > 0) then
  2386. Result := FloatPointToFixedPoint(FloatResult)
  2387. else
  2388. SetLength(Result, 0);
  2389. end;
  2390. //------------------------------------------------------------------------------
  2391. class function TPolyLineBuilder.BuildPolyPolyLine(const Points: TArrayOfArrayOfFixedPoint; Closed: Boolean; StrokeWidth: TFixed;
  2392. JoinStyle: TJoinStyle; EndStyle: TEndStyle; MiterLimit: TFixed): TArrayOfArrayOfFixedPoint;
  2393. var
  2394. FloatPoints, FloatResult: GR32.TArrayOfArrayOfFloatPoint;
  2395. begin
  2396. FloatPoints := FixedPointToFloatPoint(Points);
  2397. // Defer to float implementation
  2398. FloatResult := BuildPolyPolyLine(FloatPoints, Closed, StrokeWidth*FixedOne, JoinStyle, EndStyle, MiterLimit*FixedOne);
  2399. if (Length(FloatResult) > 0) then
  2400. Result := FloatPointToFixedPoint(FloatResult)
  2401. else
  2402. SetLength(Result, 0);
  2403. end;
  2404. //------------------------------------------------------------------------------
  2405. class function TPolyLineBuilder.Grow(const Points: TArrayOfFloatPoint; const Delta: TFloat; JoinStyle: TJoinStyle; Closed: Boolean;
  2406. MiterLimit: TFloat): TArrayOfFloatPoint;
  2407. var
  2408. Normals: TArrayOfFloatPoint;
  2409. begin
  2410. Normals := BuildNormals(Points);
  2411. Result := Grow(Points, Normals, Delta, JoinStyle, Closed, MiterLimit);
  2412. end;
  2413. //------------------------------------------------------------------------------
  2414. class function TPolyLineBuilder.Grow(const Points: TArrayOfFixedPoint; const Delta: TFixed; JoinStyle: TJoinStyle; Closed: Boolean;
  2415. MiterLimit: TFixed): TArrayOfFixedPoint;
  2416. var
  2417. Normals: TArrayOfFixedPoint;
  2418. begin
  2419. Normals := BuildNormals(Points);
  2420. Result := Grow(Points, Normals, Delta, JoinStyle, Closed, MiterLimit);
  2421. end;
  2422. //------------------------------------------------------------------------------
  2423. class function TPolyLineBuilder.Grow(const Points, Normals: TArrayOfFixedPoint; const Delta: TFixed; JoinStyle: TJoinStyle;
  2424. Closed: Boolean; MiterLimit: TFixed): TArrayOfFixedPoint;
  2425. var
  2426. FloatPoints, FloatNormals, FloatResult: TArrayOfFloatPoint;
  2427. begin
  2428. FloatPoints := FixedPointToFloatPoint(Points);
  2429. FloatNormals := FixedPointToFloatPoint(Normals);
  2430. // Defer to float implementation
  2431. FloatResult := Grow(FloatPoints, FloatNormals, Delta * FixedToFloat, JoinStyle, Closed, MiterLimit * FixedToFloat);
  2432. if (Length(FloatResult) > 0) then
  2433. Result := FloatPointToFixedPoint(FloatResult)
  2434. else
  2435. SetLength(Result, 0);
  2436. end;
  2437. //------------------------------------------------------------------------------
  2438. function Grow(const Points: TArrayOfFloatPoint; const Normals: TArrayOfFloatPoint; const Delta: TFloat; JoinStyle: TJoinStyle; Closed: Boolean; MiterLimit: TFloat): TArrayOfFloatPoint;
  2439. begin
  2440. Result := Grow(Points, Delta, JoinStyle, Closed, MiterLimit);
  2441. end;
  2442. function Grow(const Points: TArrayOfFloatPoint; const Delta: TFloat; JoinStyle: TJoinStyle; Closed: Boolean; MiterLimit: TFloat): TArrayOfFloatPoint;
  2443. begin
  2444. Result := PolylineBuilder.Grow(Points, Delta, JoinStyle, Closed, MiterLimit);
  2445. end;
  2446. function Grow(const Points: TArrayOfFixedPoint; const Normals: TArrayOfFixedPoint; const Delta: TFixed; JoinStyle: TJoinStyle; Closed: Boolean; MiterLimit: TFixed): TArrayOfFixedPoint;
  2447. begin
  2448. Result := Grow(Points, Delta, JoinStyle, Closed, MiterLimit);
  2449. end;
  2450. function Grow(const Points: TArrayOfFixedPoint; const Delta: TFixed; JoinStyle: TJoinStyle; Closed: Boolean; MiterLimit: TFixed): TArrayOfFixedPoint;
  2451. begin
  2452. Result := PolylineBuilder.Grow(Points, Delta, JoinStyle, Closed, MiterLimit);
  2453. end;
  2454. //------------------------------------------------------------------------------
  2455. function BuildPolyLine(const Points: TArrayOfFloatPoint; StrokeWidth: TFloat; JoinStyle: TJoinStyle; EndStyle: TEndStyle; MiterLimit: TFloat): TArrayOfFloatPoint;
  2456. begin
  2457. Result := PolylineBuilder.BuildPolyLine(Points, StrokeWidth, JoinStyle, EndStyle, MiterLimit);
  2458. end;
  2459. function BuildPolyPolyLine(const Points: TArrayOfArrayOfFloatPoint; Closed: Boolean; StrokeWidth: TFloat; JoinStyle: TJoinStyle; EndStyle: TEndStyle; MiterLimit: TFloat): TArrayOfArrayOfFloatPoint;
  2460. begin
  2461. Result := PolylineBuilder.BuildPolyPolyLine(Points, Closed, StrokeWidth, JoinStyle, EndStyle, MiterLimit);
  2462. end;
  2463. function BuildPolyLine(const Points: TArrayOfFixedPoint; StrokeWidth: TFixed; JoinStyle: TJoinStyle; EndStyle: TEndStyle; MiterLimit: TFixed): TArrayOfFixedPoint;
  2464. begin
  2465. Result := PolylineBuilder.BuildPolyLine(Points, StrokeWidth, JoinStyle, EndStyle, MiterLimit);
  2466. end;
  2467. function BuildPolyPolyLine(const Points: TArrayOfArrayOfFixedPoint; Closed: Boolean; StrokeWidth: TFixed; JoinStyle: TJoinStyle; EndStyle: TEndStyle; MiterLimit: TFixed): TArrayOfArrayOfFixedPoint;
  2468. begin
  2469. Result := PolylineBuilder.BuildPolyPolyLine(Points, Closed, StrokeWidth, JoinStyle, EndStyle, MiterLimit);
  2470. end;
  2471. //------------------------------------------------------------------------------
  2472. initialization
  2473. {$if defined(GR32_OFFSET_CLIPPER)}
  2474. PolylineBuilder := PolyLineBuilderClipper;
  2475. {$elseif defined(GR32_OFFSET_ANGUS)}
  2476. PolylineBuilder := PolyLineBuilderAngus;
  2477. {$elseif defined(GR32_OFFSET_REF)}
  2478. PolylineBuilder := PolyLineBuilderReference;
  2479. {$ifend}
  2480. end.