GR32_Geometry.pas 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651
  1. unit GR32_Geometry;
  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 Additional Math Routines for Graphics32
  23. *
  24. * The Initial Developers of the Original Code are
  25. * Mattias Andersson <[email protected]>
  26. * Michael Hansen <[email protected]>
  27. *
  28. * Portions created by the Initial Developers are Copyright (C) 2005-2012
  29. * the Initial Developers. All Rights Reserved.
  30. *
  31. *
  32. * ***** END LICENSE BLOCK ***** *)
  33. interface
  34. {$I GR32.inc}
  35. uses
  36. Math, Types, GR32;
  37. type
  38. TLinePos = (lpStart, lpEnd, lpBoth, lpNeither);
  39. // TFloat Overloads
  40. function Average(const V1, V2: TFloatPoint): TFloatPoint; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
  41. function CrossProduct(V1, V2: TFloatPoint): TFloat; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  42. function Dot(const V1, V2: TFloatPoint): TFloat; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
  43. function Distance(const V1, V2: TFloatPoint): TFloat; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
  44. function SqrDistance(const V1, V2: TFloatPoint): TFloat; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
  45. function GetPointAtAngleFromPoint(const Pt: TFloatPoint; const Dist, Radians: Single): TFloatPoint; overload;
  46. function GetAngleOfPt2FromPt1(const Pt1, Pt2: TFloatPoint): Single; overload;
  47. function GetUnitNormal(const Pt1, Pt2: TFloatPoint): TFloatPoint; overload;
  48. function GetUnitVector(const Pt1, Pt2: TFloatPoint): TFloatPoint; overload;
  49. function OffsetPoint(const Pt: TFloatPoint; DeltaX, DeltaY: TFloat): TFloatPoint; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
  50. function OffsetPoint(const Pt, Delta: TFloatPoint): TFloatPoint; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
  51. function OffsetRect(const Rct: TFloatRect; const DeltaX, DeltaY: TFloat): TFloatRect; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
  52. function OffsetRect(const Rct: TFloatRect; const Delta: TFloatPoint): TFloatRect; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
  53. function Shorten(const Pts: TArrayOfFloatPoint;
  54. Delta: TFloat; LinePos: TLinePos): TArrayOfFloatPoint; overload;
  55. function PointInPolygon(const Pt: TFloatPoint; const Pts: TArrayOfFloatPoint): Boolean; overload;
  56. function SegmentIntersect(const P1, P2, P3, P4: TFloatPoint;
  57. out IntersectPoint: TFloatPoint): Boolean; overload;
  58. function PerpendicularDistance(const P, P1, P2: TFloatPoint): TFloat; overload;
  59. // TFixed Overloads
  60. function Average(const V1, V2: TFixedPoint): TFixedPoint; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
  61. function CrossProduct(V1, V2: TFixedPoint): TFixed; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
  62. function Dot(const V1, V2: TFixedPoint): TFixed; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
  63. function Distance(const V1, V2: TFixedPoint): TFixed; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
  64. function SqrDistance(const V1, V2: TFixedPoint): TFixed; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
  65. function GetPointAtAngleFromPoint(const Pt: TFixedPoint; const Dist, Radians: Single): TFixedPoint; overload;
  66. function GetAngleOfPt2FromPt1(Pt1, Pt2: TFixedPoint): Single; overload;
  67. function GetUnitVector(const Pt1, Pt2: TFixedPoint): TFloatPoint; overload;
  68. function GetUnitNormal(const Pt1, Pt2: TFixedPoint): TFloatPoint; overload;
  69. function OffsetPoint(const Pt: TFixedPoint; DeltaX, DeltaY: TFixed): TFixedPoint; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
  70. function OffsetPoint(const Pt: TFixedPoint; DeltaX, DeltaY: TFloat): TFixedPoint; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
  71. function OffsetPoint(const Pt: TFixedPoint; const Delta: TFixedPoint): TFixedPoint; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
  72. function OffsetPoint(const Pt: TFixedPoint; const Delta: TFloatPoint): TFixedPoint; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
  73. function OffsetRect(const Rct: TFixedRect; const DeltaX, DeltaY: TFixed): TFixedRect; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
  74. function OffsetRect(const Rct: TFixedRect; const DeltaX, DeltaY: TFloat): TFixedRect; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
  75. function OffsetRect(const Rct: TFixedRect; const Delta: TFixedPoint): TFixedRect; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
  76. function OffsetRect(const Rct: TFixedRect; const Delta: TFloatPoint): TFixedRect; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
  77. function Shorten(const Pts: TArrayOfFixedPoint;
  78. Delta: TFloat; LinePos: TLinePos): TArrayOfFixedPoint; overload;
  79. function PointInPolygon(const Pt: TFixedPoint; const Pts: array of TFixedPoint): Boolean; overload;
  80. function SegmentIntersect(const P1, P2, P3, P4: TFixedPoint;
  81. out IntersectPoint: TFixedPoint): Boolean; overload;
  82. function PerpendicularDistance(const P, P1, P2: TFixedPoint): TFixed; overload;
  83. // Integer Overloads
  84. function Average(const V1, V2: TPoint): TPoint; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
  85. function CrossProduct(V1, V2: TPoint): Integer; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
  86. function Dot(const V1, V2: TPoint): Integer; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
  87. function Distance(const V1, V2: TPoint): TFloat; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
  88. function SqrDistance(const V1, V2: TPoint): Integer; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
  89. function OffsetPoint(const Pt: TPoint; DeltaX, DeltaY: Integer): TPoint; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
  90. function OffsetPoint(const Pt, Delta: TPoint): TPoint; overload;{$IFDEF USEINLINING} inline; {$ENDIF}
  91. function PerpendicularDistance(const P, P1, P2: TPoint): TFloat; overload;
  92. const
  93. CRad01 = Pi / 180;
  94. CRad30 = Pi / 6;
  95. CRad45 = Pi / 4;
  96. CRad60 = Pi / 3;
  97. CRad90 = Pi / 2;
  98. CRad180 = Pi;
  99. CRad270 = CRad90 * 3;
  100. CRad360 = CRad180 * 2;
  101. CDegToRad = Pi / 180;
  102. CRadToDeg = 180 / Pi;
  103. implementation
  104. uses
  105. GR32_Math;
  106. function Average(const V1, V2: TFloatPoint): TFloatPoint;
  107. begin
  108. Result.X := (V1.X + V2.X) * 0.5;
  109. Result.Y := (V1.Y + V2.Y) * 0.5;
  110. end;
  111. function CrossProduct(V1, V2: TFloatPoint): TFloat;
  112. begin
  113. Result := V1.X * V2.Y - V1.Y * V2.X;
  114. end;
  115. function Dot(const V1, V2: TFloatPoint): TFloat;
  116. begin
  117. Result := V1.X * V2.X + V1.Y * V2.Y;
  118. end;
  119. function Distance(const V1, V2: TFloatPoint): TFloat;
  120. begin
  121. Result := GR32_Math.Hypot(V2.X - V1.X, V2.Y - V1.Y);
  122. end;
  123. function SqrDistance(const V1, V2: TFloatPoint): TFloat;
  124. begin
  125. Result := Sqr(V2.X - V1.X) + Sqr(V2.Y - V1.Y);
  126. end;
  127. function GetPointAtAngleFromPoint(const Pt: TFloatPoint;
  128. const Dist, Radians: TFloat): TFloatPoint; overload;
  129. var
  130. SinAng, CosAng: TFloat;
  131. begin
  132. GR32_Math.SinCos(Radians, SinAng, CosAng);
  133. Result.X := Dist * CosAng + Pt.X;
  134. Result.Y := -Dist * SinAng + Pt.Y; // Y axis is positive down
  135. end;
  136. function GetAngleOfPt2FromPt1(const Pt1, Pt2: TFloatPoint): Single;
  137. var
  138. X, Y: TFloat;
  139. begin
  140. X := Pt2.X - Pt1.X;
  141. Y := Pt2.Y - Pt1.Y;
  142. if X = 0 then
  143. begin
  144. if Y > 0 then Result := CRad270 else Result := CRad90;
  145. end else
  146. begin
  147. Result := ArcTan2(-Y, X);
  148. if Result < 0 then Result := Result + CRad360;
  149. end;
  150. end;
  151. function GetUnitVector(const Pt1, Pt2: TFloatPoint): TFloatPoint;
  152. var
  153. Delta: TFloatPoint;
  154. Temp: TFloat;
  155. begin
  156. Delta.X := (Pt2.X - Pt1.X);
  157. Delta.Y := (Pt2.Y - Pt1.Y);
  158. if (Delta.X = 0) and (Delta.Y = 0) then
  159. Result := FloatPoint(0, 0)
  160. else
  161. begin
  162. Temp := 1 / GR32_Math.Hypot(Delta.X, Delta.Y);
  163. Result.X := Delta.X * Temp;
  164. Result.Y := Delta.Y * Temp;
  165. end;
  166. end;
  167. function GetUnitNormal(const Pt1, Pt2: TFloatPoint): TFloatPoint;
  168. var
  169. Delta: TFloatPoint;
  170. Temp: TFloat;
  171. begin
  172. Delta.X := (Pt2.X - Pt1.X);
  173. Delta.Y := (Pt2.Y - Pt1.Y);
  174. if (Delta.X = 0) and (Delta.Y = 0) then
  175. Result := FloatPoint(0, 0)
  176. else
  177. begin
  178. Temp := 1 / GR32_Math.Hypot(Delta.X, Delta.Y);
  179. Delta.X := Delta.X * Temp;
  180. Delta.Y := Delta.Y * Temp;
  181. end;
  182. Result.X := Delta.Y; // ie perpendicular to
  183. Result.Y := -Delta.X; // the unit vector
  184. end;
  185. function OffsetPoint(const Pt: TFloatPoint; DeltaX, DeltaY: TFloat): TFloatPoint;
  186. begin
  187. Result.X := Pt.X + DeltaX;
  188. Result.Y := Pt.Y + DeltaY;
  189. end;
  190. function OffsetPoint(const Pt, Delta: TFloatPoint): TFloatPoint;
  191. begin
  192. Result.X := Pt.X + Delta.X;
  193. Result.Y := Pt.Y + Delta.Y;
  194. end;
  195. function OffsetRect(const Rct: TFloatRect; const DeltaX, DeltaY: TFloat): TFloatRect;
  196. begin
  197. Result.TopLeft := OffsetPoint(Rct.TopLeft, DeltaX, DeltaY);
  198. Result.BottomRight := OffsetPoint(Rct.BottomRight, DeltaX, DeltaY);
  199. end;
  200. function OffsetRect(const Rct: TFloatRect; const Delta: TFloatPoint): TFloatRect;
  201. begin
  202. Result.TopLeft := OffsetPoint(Rct.TopLeft, Delta);
  203. Result.BottomRight := OffsetPoint(Rct.BottomRight, Delta);
  204. end;
  205. function Shorten(const Pts: TArrayOfFloatPoint;
  206. Delta: TFloat; LinePos: TLinePos): TArrayOfFloatPoint;
  207. var
  208. Index, HighI: integer;
  209. Dist, DeltaSqr: TFloat;
  210. UnitVec: TFloatPoint;
  211. procedure FixStart;
  212. begin
  213. Index := 1;
  214. while (Index < HighI) and (SqrDistance(Pts[Index], Pts[0]) < DeltaSqr) do
  215. Inc(Index);
  216. UnitVec := GetUnitVector(Pts[Index], Pts[0]);
  217. Dist := Distance(Pts[Index], Pts[0]) - Delta;
  218. if Index > 1 then
  219. begin
  220. HighI := HighI - Index + 1;
  221. Move(Result[Index], Result[1], SizeOf(TFloatPoint) * HighI);
  222. SetLength(Result, HighI + 1);
  223. end;
  224. Result[0] := OffsetPoint(Result[1], UnitVec.X * Dist, UnitVec.Y * Dist);
  225. end;
  226. procedure FixEnd;
  227. begin
  228. Index := HighI - 1;
  229. while (Index > 0) and (SqrDistance(Pts[Index],Pts[HighI]) < DeltaSqr) do
  230. Dec(Index);
  231. UnitVec := GetUnitVector(Pts[Index],Pts[HighI]);
  232. Dist := Distance(Pts[Index], Pts[HighI]) - Delta;
  233. if Index + 1 < HighI then SetLength(Result, Index + 2);
  234. Result[Index + 1] := OffsetPoint(Result[Index], UnitVec.X * Dist, UnitVec.Y * Dist);
  235. end;
  236. begin
  237. Result := Pts;
  238. HighI := High(Pts);
  239. DeltaSqr := Delta * Delta;
  240. if HighI < 1 then Exit;
  241. case LinePos of
  242. lpStart: FixStart;
  243. lpEnd : FixEnd;
  244. lpBoth : begin FixStart; FixEnd; end;
  245. end;
  246. end;
  247. function PointInPolygon(const Pt: TFloatPoint; const Pts: TArrayOfFloatPoint): Boolean;
  248. var
  249. Index: Integer;
  250. iPt, jPt: PFloatPoint;
  251. begin
  252. Result := False;
  253. iPt := @Pts[0];
  254. jPt := @Pts[High(Pts)];
  255. for Index := 0 to High(Pts) do
  256. begin
  257. Result := Result xor (((Pt.Y >= iPt.Y) xor (Pt.Y >= jPt.Y)) and
  258. ((Pt.X - iPt.X) < ((jPt.X - iPt.X) * (Pt.Y -iPt.Y) / (jPt.Y - iPt.Y))));
  259. jPt := iPt;
  260. Inc(iPt);
  261. end;
  262. end;
  263. function SegmentIntersect(const P1, P2, P3, P4: TFloatPoint;
  264. out IntersectPoint: TFloatPoint): Boolean;
  265. var
  266. m1, b1, m2, b2: TFloat;
  267. begin
  268. // see http://astronomy.swin.edu.au/~pbourke/geometry/lineline2d/
  269. Result := False;
  270. if (P2.X = P1.X) then
  271. begin
  272. if (P4.X = P3.X) then Exit; // parallel lines
  273. m2 := (P4.Y - P3.Y) / (P4.X - P3.X);
  274. b2 := P3.Y - m2 * P3.X;
  275. IntersectPoint.X := P1.X;
  276. IntersectPoint.Y := m2 * P1.X + b2;
  277. Result := (((IntersectPoint.Y < P2.Y) = (IntersectPoint.Y > P1.Y)) or
  278. (IntersectPoint.Y = P2.Y) or (IntersectPoint.Y = P1.Y)) and
  279. (((IntersectPoint.Y < P3.Y) = (IntersectPoint.Y > P4.Y)) or
  280. (IntersectPoint.Y = P3.Y) or (IntersectPoint.Y = P4.Y));
  281. end
  282. else if (P4.X = P3.X) then
  283. begin
  284. m1 := (P2.Y - P1.Y) / (P2.X - P1.X);
  285. b1 := P1.Y - m1 * P1.X;
  286. IntersectPoint.X := P3.X;
  287. IntersectPoint.Y := m1 * P3.X + b1;
  288. Result := (((IntersectPoint.Y < P2.Y) = (IntersectPoint.Y > P1.Y)) or
  289. (IntersectPoint.Y = P2.Y) or (IntersectPoint.Y = P1.Y)) and
  290. (((IntersectPoint.Y < P3.Y) = (IntersectPoint.Y > P4.Y)) or
  291. (IntersectPoint.Y = P3.Y) or (IntersectPoint.Y = P4.Y));
  292. end else
  293. begin
  294. m1 := (P2.Y - P1.Y) / (P2.X - P1.X);
  295. b1 := P1.Y - m1 * P1.X;
  296. m2 := (P4.Y - P3.Y) / (P4.X - P3.X);
  297. b2 := P3.Y - m2 * P3.X;
  298. if m1 = m2 then Exit; // parallel lines
  299. IntersectPoint.X := (b2 - b1) / (m1 - m2);
  300. IntersectPoint.Y := m1 * IntersectPoint.X + b1;
  301. Result := (((IntersectPoint.X < P2.X) = (IntersectPoint.X > P1.X)) or
  302. (IntersectPoint.X = P2.X) or (IntersectPoint.X = P1.X)) and
  303. (((IntersectPoint.X < P3.X) = (IntersectPoint.X > P4.X)) or
  304. (IntersectPoint.X = P3.X) or (IntersectPoint.X = P4.X));
  305. end;
  306. end;
  307. function PerpendicularDistance(const P, P1, P2: TFloatPoint): TFloat;
  308. begin
  309. Result := Abs((P.x - P2.x) * (P1.y - P2.y) - (P.y - P2.y) * (P1.x - P2.x)) /
  310. GR32_Math.Hypot(P1.x - P2.x, P1.y - P2.y);
  311. end;
  312. // Fixed overloads
  313. function Average(const V1, V2: TFixedPoint): TFixedPoint;
  314. begin
  315. Result.X := (V1.X + V2.X) div 2;
  316. Result.Y := (V1.Y + V2.Y) div 2;
  317. end;
  318. function CrossProduct(V1, V2: TFixedPoint): TFixed;
  319. begin
  320. Result := FixedMul(V1.X, V2.Y) - FixedMul(V1.Y, V2.X);
  321. end;
  322. function Dot(const V1, V2: TFixedPoint): TFixed;
  323. begin
  324. Result := FixedMul(V1.X, V2.X) + FixedMul(V1.Y, V2.Y);
  325. end;
  326. function Distance(const V1, V2: TFixedPoint): TFixed;
  327. begin
  328. Result :=
  329. Fixed(Hypot((V2.X - V1.X) * FixedToFloat, (V2.Y - V1.Y) * FixedToFloat));
  330. end;
  331. function SqrDistance(const V1, V2: TFixedPoint): TFixed;
  332. begin
  333. Result := FixedSqr(V2.X - V1.X) + FixedSqr(V2.Y - V1.Y);
  334. end;
  335. function GetPointAtAngleFromPoint(const Pt: TFixedPoint;
  336. const Dist, Radians: TFloat): TFixedPoint;
  337. var
  338. SinAng, CosAng: TFloat;
  339. begin
  340. GR32_Math.SinCos(Radians, SinAng, CosAng);
  341. Result.X := Round(Dist * CosAng * FixedOne) + Pt.X;
  342. Result.Y := -Round(Dist * SinAng * FixedOne) + Pt.Y; // Y axis is positive down
  343. end;
  344. function GetAngleOfPt2FromPt1(Pt1, Pt2: TFixedPoint): Single;
  345. begin
  346. with Pt2 do
  347. begin
  348. X := X - Pt1.X;
  349. Y := Y - Pt1.Y;
  350. if X = 0 then
  351. begin
  352. if Y > 0 then Result := CRad270 else Result := CRad90;
  353. end else
  354. begin
  355. Result := ArcTan2(-Y,X);
  356. if Result < 0 then Result := Result + CRad360;
  357. end;
  358. end;
  359. end;
  360. function GetUnitVector(const Pt1, Pt2: TFixedPoint): TFloatPoint;
  361. var
  362. Delta: TFloatPoint;
  363. Temp: Single;
  364. begin
  365. Delta.X := (Pt2.X - Pt1.X) * FixedToFloat;
  366. Delta.Y := (Pt2.Y - Pt1.Y) * FixedToFloat;
  367. if (Delta.X = 0) and (Delta.Y = 0) then
  368. begin
  369. Result := FloatPoint(0,0);
  370. end else
  371. begin
  372. Temp := 1 / GR32_Math.Hypot(Delta.X, Delta.Y);
  373. Result.X := Delta.X * Temp;
  374. Result.Y := Delta.Y * Temp;
  375. end;
  376. end;
  377. function GetUnitNormal(const Pt1, Pt2: TFixedPoint): TFloatPoint;
  378. var
  379. Delta: TFloatPoint;
  380. Temp: Single;
  381. begin
  382. Delta.X := (Pt2.X - Pt1.X) * FixedToFloat;
  383. Delta.Y := (Pt2.Y - Pt1.Y) * FixedToFloat;
  384. if (Delta.X = 0) and (Delta.Y = 0) then
  385. begin
  386. Result := FloatPoint(0,0);
  387. end else
  388. begin
  389. Temp := 1 / GR32_Math.Hypot(Delta.X, Delta.Y);
  390. Delta.X := Delta.X * Temp;
  391. Delta.Y := Delta.Y * Temp;
  392. end;
  393. Result.X := Delta.Y; // ie perpendicular to
  394. Result.Y := -Delta.X; // the unit vector
  395. end;
  396. function OffsetPoint(const Pt: TFixedPoint; DeltaX, DeltaY: TFixed): TFixedPoint;
  397. begin
  398. Result.X := Pt.X + DeltaX;
  399. Result.Y := Pt.Y + DeltaY;
  400. end;
  401. function OffsetPoint(const Pt: TFixedPoint; DeltaX, DeltaY: TFloat): TFixedPoint;
  402. begin
  403. Result.X := Pt.X + Fixed(DeltaX);
  404. Result.Y := Pt.Y + Fixed(DeltaY);
  405. end;
  406. function OffsetPoint(const Pt: TFixedPoint; const Delta: TFixedPoint): TFixedPoint;
  407. begin
  408. Result.X := Pt.X + Delta.X;
  409. Result.Y := Pt.Y + Delta.Y;
  410. end;
  411. function OffsetPoint(const Pt: TFixedPoint; const Delta: TFloatPoint): TFixedPoint;
  412. begin
  413. Result.X := Pt.X + Fixed(Delta.X);
  414. Result.Y := Pt.Y + Fixed(Delta.Y);
  415. end;
  416. function OffsetRect(const Rct: TFixedRect; const DeltaX, DeltaY: TFixed): TFixedRect;
  417. begin
  418. Result.TopLeft := OffsetPoint(Rct.TopLeft, DeltaX, DeltaY);
  419. Result.BottomRight := OffsetPoint(Rct.BottomRight, DeltaX, DeltaY);
  420. end;
  421. function OffsetRect(const Rct: TFixedRect; const Delta: TFixedPoint): TFixedRect;
  422. begin
  423. Result.TopLeft := OffsetPoint(Rct.TopLeft, Delta);
  424. Result.BottomRight := OffsetPoint(Rct.BottomRight, Delta);
  425. end;
  426. function OffsetRect(const Rct: TFixedRect; const DeltaX, DeltaY: TFloat): TFixedRect;
  427. var
  428. DX, DY: TFixed;
  429. begin
  430. DX := Fixed(DeltaX);
  431. DY := Fixed(DeltaY);
  432. Result.TopLeft := OffsetPoint(Rct.TopLeft, DX, DY);
  433. Result.BottomRight := OffsetPoint(Rct.BottomRight, DX, DY);
  434. end;
  435. function OffsetRect(const Rct: TFixedRect; const Delta: TFloatPoint): TFixedRect;
  436. var
  437. DX, DY: TFixed;
  438. begin
  439. DX := Fixed(Delta.X);
  440. DY := Fixed(Delta.Y);
  441. Result.TopLeft := OffsetPoint(Rct.TopLeft, DX, DY);
  442. Result.BottomRight := OffsetPoint(Rct.BottomRight, DX, DY);
  443. end;
  444. function Shorten(const Pts: TArrayOfFixedPoint;
  445. Delta: TFloat; LinePos: TLinePos): TArrayOfFixedPoint;
  446. var
  447. Index, HighI: integer;
  448. Dist, DeltaSqr: TFloat;
  449. UnitVec: TFloatPoint;
  450. procedure FixStart;
  451. begin
  452. Index := 1;
  453. while (Index < HighI) and (SqrDistance(Pts[Index],Pts[0]) < DeltaSqr) do Inc(Index);
  454. UnitVec := GetUnitVector(Pts[Index], Pts[0]);
  455. Dist := Distance(Pts[Index],Pts[0]) - Delta;
  456. if Index > 1 then
  457. begin
  458. Move(Result[Index], Result[1], SizeOf(TFloatPoint) * (HighI - Index + 1));
  459. SetLength(Result, HighI - Index + 2);
  460. HighI := HighI - Index + 1;
  461. end;
  462. Result[0] := OffsetPoint(Result[1], UnitVec.X * Dist, UnitVec.Y * Dist);
  463. end;
  464. procedure FixEnd;
  465. begin
  466. Index := HighI -1;
  467. while (Index > 0) and (SqrDistance(Pts[Index],Pts[HighI]) < DeltaSqr) do Dec(Index);
  468. UnitVec := GetUnitVector(Pts[Index],Pts[HighI]);
  469. Dist := Distance(Pts[Index],Pts[HighI]) - Delta;
  470. if Index + 1 < HighI then SetLength(Result, Index + 2);
  471. Result[Index + 1] := OffsetPoint(Result[Index], UnitVec.X * Dist, UnitVec.Y * Dist);
  472. end;
  473. begin
  474. Result := Pts;
  475. HighI := High(Pts);
  476. DeltaSqr := Delta * Delta;
  477. if HighI < 1 then Exit;
  478. case LinePos of
  479. lpStart: FixStart;
  480. lpEnd : FixEnd;
  481. lpBoth : begin FixStart; FixEnd; end;
  482. end;
  483. end;
  484. function PointInPolygon(const Pt: TFixedPoint; const Pts: array of TFixedPoint): Boolean;
  485. var
  486. I: Integer;
  487. iPt, jPt: PFixedPoint;
  488. begin
  489. Result := False;
  490. iPt := @Pts[0];
  491. jPt := @Pts[High(Pts)];
  492. for I := 0 to High(Pts) do
  493. begin
  494. Result := Result xor (((Pt.Y >= iPt.Y) xor (Pt.Y >= jPt.Y)) and
  495. (Pt.X - iPt.X < MulDiv(jPt.X - iPt.X, Pt.Y - iPt.Y, jPt.Y - iPt.Y)));
  496. jPt := iPt;
  497. Inc(iPt);
  498. end;
  499. end;
  500. function SegmentIntersect(const P1, P2, P3, P4: TFixedPoint;
  501. out IntersectPoint: TFixedPoint): Boolean;
  502. var
  503. m1,b1,m2,b2: TFloat;
  504. begin
  505. Result := False;
  506. if (P2.X = P1.X) then
  507. begin
  508. if (P4.X = P3.X) then Exit; // parallel lines
  509. m2 := (P4.Y - P3.Y) / (P4.X - P3.X);
  510. b2 := P3.Y - m2 * P3.X;
  511. IntersectPoint.X := P1.X;
  512. IntersectPoint.Y := Round(m2 * P1.X + b2);
  513. Result := (IntersectPoint.Y < P2.Y) = (IntersectPoint.Y > P1.Y);
  514. end
  515. else if (P4.X = P3.X) then
  516. begin
  517. m1 := (P2.Y - P1.Y) / (P2.X - P1.X);
  518. b1 := P1.Y - m1 * P1.X;
  519. IntersectPoint.X := P3.X;
  520. IntersectPoint.Y := Round(m1 * P3.X + b1);
  521. Result := (IntersectPoint.Y < P3.Y) = (IntersectPoint.Y > P4.Y);
  522. end else
  523. begin
  524. m1 := (P2.Y - P1.Y) / (P2.X - P1.X);
  525. b1 := P1.Y - m1 * P1.X;
  526. m2 := (P4.Y - P3.Y) / (P4.X - P3.X);
  527. b2 := P3.Y - m2 * P3.X;
  528. if m1 = m2 then Exit; // parallel lines
  529. IntersectPoint.X := Round((b2 - b1) / (m1 - m2));
  530. IntersectPoint.Y := Round(m1 * IntersectPoint.X + b1);
  531. Result := ((IntersectPoint.X < P2.X) = (IntersectPoint.X > P1.X));
  532. end;
  533. end;
  534. function PerpendicularDistance(const P, P1, P2: TFixedPoint): TFixed;
  535. begin
  536. Result := Fixed(Abs((P.x - P2.x) * (P1.y - P2.y) - (P.y - P2.y) *
  537. (P1.x - P2.x)) * FixedToFloat / Hypot((P1.x - P2.x) * FixedToFloat,
  538. (P1.y - P2.y) * FixedToFloat));
  539. end;
  540. // Integer overloads
  541. function Average(const V1, V2: TPoint): TPoint;
  542. begin
  543. Result.X := (V1.X + V2.X) div 2;
  544. Result.Y := (V1.Y + V2.Y) div 2;
  545. end;
  546. function CrossProduct(V1, V2: TPoint): Integer;
  547. begin
  548. Result := V1.X * V2.Y - V1.Y * V2.X;
  549. end;
  550. function Dot(const V1, V2: TPoint): Integer;
  551. begin
  552. Result := V1.X * V2.X + V1.Y * V2.Y;
  553. end;
  554. function Distance(const V1, V2: TPoint): TFloat;
  555. begin
  556. Result := Hypot(Integer(V2.X - V1.X), Integer(V2.Y - V1.Y));
  557. end;
  558. function SqrDistance(const V1, V2: TPoint): Integer;
  559. begin
  560. Result := Sqr(V2.X - V1.X) + Sqr(V2.Y - V1.Y);
  561. end;
  562. function OffsetPoint(const Pt: TPoint; DeltaX, DeltaY: Integer): TPoint;
  563. begin
  564. Result.X := Pt.X + DeltaX;
  565. Result.Y := Pt.Y + DeltaY;
  566. end;
  567. function OffsetPoint(const Pt, Delta: TPoint): TPoint;
  568. begin
  569. Result.X := Pt.X + Delta.X;
  570. Result.Y := Pt.Y + Delta.Y;
  571. end;
  572. function PerpendicularDistance(const P, P1, P2: TPoint): TFloat;
  573. begin
  574. Result := Abs((P.x - P2.x) * (P1.y - P2.y) - (P.y - P2.y) * (P1.x - P2.x)) /
  575. Math.Hypot(P1.x - P2.x, P1.y - P2.y);
  576. end;
  577. end.