source: tags/1.4.0/Geometry.pas

Last change on this file was 345, checked in by chronos, 4 weeks ago
  • Modified: Improved test cases.
File size: 14.8 KB
Line 
1unit Geometry;
2
3interface
4
5uses
6 Classes, SysUtils, Math;
7
8type
9 { TGPoint }
10
11 TGPoint<T> = record
12 public
13 X: T;
14 Y: T;
15 constructor Create(const X, Y: T);
16 class operator Add(const A, B: TGPoint<T>): TGPoint<T>;
17 class operator Subtract(const A, B: TGPoint<T>): TGPoint<T>;
18 class operator GreaterThan(const A, B: TGPoint<T>): Boolean;
19 class operator GreaterThanOrEqual(const A, B: TGPoint<T>): Boolean;
20 class operator LessThan(const A, B: TGPoint<T>): Boolean;
21 class operator LessThanOrEqual(const A, B: TGPoint<T>): Boolean;
22 class operator Equal(const A, B: TGPoint<T>): Boolean;
23 class operator Multiply(const A, B: TGPoint<T>): TGPoint<T>;
24 //class operator Divide(const A, B: TGPoint<T>): TGPoint<T>;
25 //class operator Modulus(A: TGPoint<T>; B: TGPoint<T>): TGPoint<T>;
26 class function Min(const A, B: TGPoint<T>): TGPoint<T>; static;
27 class function Max(const A, B: TGPoint<T>): TGPoint<T>; static;
28 procedure Rotate(Base: TGPoint<T>; Angle: Double);
29 end;
30
31 { TGPoint3D }
32
33 TGPoint3D<T> = record
34 public
35 X: T;
36 Y: T;
37 Z: T;
38 constructor Create(const X, Y, Z: T);
39 end;
40
41 { TGRect }
42
43 TGRect<T> = record
44 private
45 function GetEmpty: Boolean;
46 function GetSize: T;
47 procedure SetSize(AValue: T);
48 public
49 P1: T;
50 P2: T;
51 function IsPointInside(const P: T): Boolean;
52 function Center: T;
53 procedure SetEmpty;
54 procedure Normalize;
55 procedure Move(P: T);
56 class operator Equal(const A, B: TGRect<T>): Boolean;
57 constructor Create(const P1, P2: T);
58 constructor CreateBounds(const Origin, Size: T);
59 property Size: T read GetSize write SetSize;
60 property Empty: Boolean read GetEmpty;
61 end;
62
63 { TGLine }
64
65 TGLine<T> = record
66 private
67 function GetDistance: Double;
68 procedure SetDistance(AValue: Double);
69 public
70 P1: T;
71 P2: T;
72 constructor Create(const P1, P2: T);
73 function GetMiddle: T;
74 function GetAngle: Double;
75 function GetSize: T;
76 function ToRect: TGRect<T>;
77 function DotProduct: Double;
78 class function LineIntersect(const LineA, LineB: TGLine<T>; out Intersection: T): Boolean; static;
79 procedure Rotate(const Angle: Double);
80 class operator Equal(const A, B: TGLine<T>): Boolean;
81 property Distance: Double read GetDistance write SetDistance;
82 end;
83
84 { TGPolygon }
85
86 TGPolygon<T> = record
87 private
88 function GetPoint(const Index: Integer): T; inline;
89 procedure SetPoint(const Index: Integer; const AValue: T); inline;
90 public
91 type
92 TPointArray = array of T;
93 var
94 Points: TPointArray;
95 function IsPointInside(const P: T): Boolean;
96 constructor Create(const Points: TPointArray); overload;
97 constructor Create(const Rect: TGRect<T>); overload;
98 function Compare(Polygon: TGPolygon<T>): Boolean;
99 procedure Move(P: T);
100 function GetRect: TGRect<T>;
101 function EdgeDistance(Polygon: TGPolygon<T>): Double;
102 function GetCenter: T;
103 procedure AddPoint(const P: T);
104 procedure Clear;
105 procedure CutLine(Vector: TGLine<T>; const PointInside: T);
106 property Items[Index: Integer]: T read GetPoint write SetPoint; default;
107 end;
108
109 // Integer
110 TPoint = TGPoint<Integer>;
111 TPoint3D = TGPoint3D<Integer>;
112 TLine = TGLine<TPoint>;
113 TRect = TGRect<TPoint>;
114 TPolygon = TGPolygon<TPoint>;
115
116 // FLoating
117 TPointF = TGPoint<Single>;
118 TPoint3DF = TGPoint3D<Single>;
119 TRectF = TGRect<TPointF>;
120 TLineF = TGLine<TPointF>;
121 TPolygonF = TGPolygon<TPointF>;
122
123function TypedMod(Numerator, Denominator: Integer): Integer; overload;
124//function TypedMod(Numerator, Denominator: Single): Single; overload;
125function TypedDivide(Divident, Divisor: Integer): Integer; overload;
126function TypedDivide(Divident, Divisor: Single): Single; overload;
127function TypedRound(Value: Double): Integer; overload;
128function TypedRound(Value: Double): Double; overload;
129function StdPointToPoint(Value: Classes.TPoint): TPoint;
130function PointToStdPoint(Value: TPoint): Classes.TPoint;
131function ModNeg(A, B: Integer): Integer;
132
133
134implementation
135
136function ModNeg(A, B: Integer): Integer;
137begin
138 if A < 0 then A := A + Ceil(-A / B) * B;
139 Result := A mod B;
140end;
141
142function TypedMod(Numerator, Denominator: Integer): Integer; overload;
143begin
144 Result := Numerator mod Denominator;
145end;
146
147{function TypedMod(Numerator, Denominator: Single): Single; overload;
148begin
149 //Result := FMod(Numerator, Denominator);
150end;}
151
152function TypedDivide(Divident, Divisor: Integer): Integer;
153begin
154 Result := Divident div Divisor;
155end;
156
157function TypedDivide(Divident, Divisor: Single): Single;
158begin
159 Result := Divident / Divisor;
160end;
161
162function TypedRound(Value: Double): Integer;
163begin
164 Result := Round(Value);
165end;
166
167function TypedRound(Value: Double): Double;
168begin
169 Result := Value;
170end;
171
172function StdPointToPoint(Value: Classes.TPoint): TPoint;
173begin
174 Result.X := Value.X;
175 Result.Y := Value.Y;
176end;
177
178function PointToStdPoint(Value: TPoint): Classes.TPoint;
179begin
180 Result.X := Value.X;
181 Result.Y := Value.Y;
182end;
183
184{ TGPolygon }
185
186function TGPolygon<T>.GetPoint(const Index: Integer): T;
187begin
188 Result := Points[Index];
189end;
190
191function TGPolygon<T>.GetCenter: T;
192var
193 I: Integer;
194begin
195 Result := T.Create(0, 0);
196 for I := 0 to Length(Points) - 1 do
197 Result := Result + Points[I];
198 Result.X := TypedRound(Result.X / Length(Points));
199 Result.Y := TypedRound(Result.Y / Length(Points));
200end;
201
202procedure TGPolygon<T>.SetPoint(const Index: Integer; const AValue: T);
203begin
204 Points[Index] := AValue;
205end;
206
207function TGPolygon<T>.IsPointInside(const P: T): Boolean;
208var
209 I, J: Integer;
210begin
211 Result := False;
212 J := High(Points);
213 for I := Low(Points) to High(Points) do begin
214 if ((Points[I].Y <= P.Y) and (P.Y < Points[J].Y)) or
215 ((Points[J].Y <= P.Y) and (P.Y < Points[I].Y)) then
216 begin
217 if (P.X < (Points[J].X - Points[I].X) *
218 (P.Y - Points[I].Y) /
219 (Points[J].Y - Points[I].Y) + Points[I].X) then
220 Result := not Result;
221 end;
222 J := I;
223 end;
224end;
225
226constructor TGPolygon<T>.Create(const Points: TPointArray);
227var
228 I: Integer;
229begin
230 SetLength(Self.Points, Length(Points));
231 for I := 0 to Length(Points) - 1 do
232 Self.Points[I] := Points[I];
233end;
234
235constructor TGPolygon<T>.Create(const Rect: TGRect<T>);
236begin
237 SetLength(Self.Points, 4);
238 Self.Points[0] := Rect.P1;
239 Self.Points[1] := T.Create(Rect.P2.X, Rect.P1.Y);
240 Self.Points[2] := Rect.P2;
241 Self.Points[3] := T.Create(Rect.P1.X, Rect.P2.Y);
242end;
243
244function TGPolygon<T>.Compare(Polygon: TGPolygon<T>): Boolean;
245var
246 I: Integer;
247begin
248 Result := Length(Points) = Length(Polygon.Points);
249 if not Result then Exit;
250 for I := 0 to Length(Points) - 1 do
251 if Points[I] <> Polygon.Points[I] then begin
252 Result := False;
253 Break;
254 end;
255end;
256
257function TGPolygon<T>.GetRect: TGRect<T>;
258var
259 I: Integer;
260begin
261 if Length(Points) = 0 then
262 Result.Empty
263 else begin
264 Result := TGRect<T>.Create(Points[0], Points[0]);
265 for I := 1 to Length(Points) - 1 do
266 with Points[I] do begin
267 Result.P1 := Points[I].Min(Result.P1, Points[I]);
268 Result.P2 := Points[I].Max(Result.P2, Points[I]);
269 end;
270 end;
271end;
272
273procedure TGPolygon<T>.AddPoint(const P: T);
274begin
275 SetLength(Points, Length(Points) + 1);
276 Points[Length(Points) - 1] := P;
277end;
278
279procedure TGPolygon<T>.Clear;
280begin
281 SetLength(Points, 0);
282end;
283
284procedure TGPolygon<T>.CutLine(Vector: TGLine<T>; const PointInside: T);
285var
286 I: Integer;
287 PointsChecked: Integer;
288 L1, L2: TGLine<T>;
289 Intersection: T;
290 NewPoly: TGPolygon<T>;
291 NewPolygonStarted: Boolean;
292 Success: Boolean;
293begin
294 NewPoly.Clear;
295 Success := False;
296 NewPolygonStarted := False;
297 I := 0;
298 PointsChecked := 0;
299 L1 := Vector;
300 L1.Rotate(Pi / 2);
301 if Length(Points) > 0 then
302 while True do begin
303 L2 := TGLine<T>.Create(Points[I], Points[(I + 1) mod Length(Points)]);
304 if TGLine<T>.LineIntersect(L1, L2, Intersection) then
305 if L2.ToRect.IsPointInside(Intersection) then begin
306 if not NewPolygonStarted then begin
307 // Crossing line, start new polygon
308 NewPoly.Clear;
309 NewPoly.AddPoint(Intersection);
310 NewPolygonStarted := True;
311 end else begin
312 // Crossing line, end polygon. If point NewPolygonStarted, the use polygon as result
313 NewPoly.AddPoint(Points[I]);
314 NewPoly.AddPoint(Intersection);
315 if NewPoly.IsPointInside(PointInside) then begin
316 Success := True;
317 Break;
318 end else begin
319 NewPoly.Clear;
320 NewPoly.AddPoint(Intersection);
321 NewPolygonStarted := True;
322 end;
323 end;
324 end else
325 NewPoly.AddPoint(Points[I]);
326 I := (I + 1) mod Length(Points);
327 Inc(PointsChecked);
328 if PointsChecked > 2 * Length(Points) then Break;
329 end;
330 if Success then Points := NewPoly.Points;
331end;
332
333function TGPolygon<T>.EdgeDistance(Polygon: TGPolygon<T>): Double;
334var
335 I, J: Integer;
336 Dist: Double;
337begin
338 Result := Infinity;
339 for I := 0 to Length(Points) - 1 do
340 for J := 0 to Length(Polygon.Points) - 1 do begin
341 Dist := TGLine<T>.Create(Points[I], Polygon.Points[J]).Distance;
342 if Dist < Result then Result := Dist;
343 end;
344end;
345
346procedure TGPolygon<T>.Move(P: T);
347var
348 I: Integer;
349begin
350 for I := 0 to Length(Points) - 1 do
351 Points[I] := Points[I] + P;
352end;
353
354{ TGLine }
355
356function TGLine<T>.GetDistance: Double;
357begin
358 Result := Sqrt(Sqr(P2.X - P1.X) + Sqr(P2.Y - P1.Y));
359end;
360
361procedure TGLine<T>.SetDistance(AValue: Double);
362var
363 Angle: Double;
364begin
365 Angle := GetAngle;
366 P2 := T.Create(Round(P1.X + Cos(Angle) * AValue),
367 Round(P1.Y + Sin(Angle) * AValue));
368end;
369
370constructor TGLine<T>.Create(const P1, P2: T);
371begin
372 Self.P1 := P1;
373 Self.P2 := P2;
374end;
375
376function TGLine<T>.GetMiddle: T;
377begin
378 Result := T.Create(P1.X + TypedDivide((P2.X - P1.X), 2), P1.Y + TypedDivide((P2.Y - P1.Y), 2));
379end;
380
381function TGLine<T>.GetAngle: Double;
382begin
383 Result := ArcTan2(P2.Y - P1.Y, P2.X - P1.X);
384end;
385
386function TGLine<T>.GetSize: T;
387begin
388 Result := P2 - P1;
389end;
390
391function TGLine<T>.ToRect: TGRect<T>;
392begin
393 Result := TGRect<T>.Create(P1, P2);
394end;
395
396function TGLine<T>.DotProduct: Double;
397begin
398 Result := P1.X * P2.X + P1.Y * P2.Y;
399end;
400
401procedure TGLine<T>.Rotate(const Angle: Double);
402begin
403 P2.Rotate(P1, Angle);
404end;
405
406class operator TGLine<T>.Equal(const A, B: TGLine<T>): Boolean;
407begin
408 Result := (A.P1 = B.P1) and (A.P2 = B.P2);
409end;
410
411class function TGLine<T>.LineIntersect(const LineA, LineB: TGLine<T>; out
412 Intersection: T): Boolean;
413Var
414 LDetLineA, LDetLineB, LDetDivInv: Double;
415 LDiffLA, LDiffLB: T;
416 D: Double;
417begin
418 if (LineA.P1 = LineA.P2) or (LineB.P1 = LineB.P2) then begin
419 Result := False;
420 Exit;
421 end;
422 LDetLineA := LineA.P1.X * LineA.P2.Y - LineA.P1.Y * LineA.P2.X;
423 LDetLineB := LineB.P1.X * LineB.P2.Y - LineB.P1.Y * LineB.P2.X;
424
425 LDiffLA := LineA.P1 - LineA.P2;
426 LDiffLB := LineB.P1 - LineB.P2;
427
428 D := (LDiffLA.X * LDiffLB.Y) - (LDiffLA.Y * LDiffLB.X);
429 if D = 0 then begin
430 // Parallel lines without intersection
431 Result := False;
432 Exit;
433 end;
434 LDetDivInv := 1 / D;
435
436 Intersection.X := TypedRound(((LDetLineA * LDiffLB.X) - (LDiffLA.X * LDetLineB)) * LDetDivInv);
437 Intersection.Y := TypedRound(((LDetLineA * LDiffLB.Y) - (LDiffLA.Y * LDetLineB)) * LDetDivInv);
438 Result := True;
439end;
440
441{ TGPoint3D }
442
443constructor TGPoint3D<T>.Create(const X, Y, Z: T);
444begin
445 Self.X := X;
446 Self.Y := Y;
447 Self.Z := Z;
448end;
449
450{ TGPoint }
451
452constructor TGPoint<T>.Create(const X, Y: T);
453begin
454 Self.X := X;
455 Self.Y := Y;
456end;
457
458class operator TGPoint<T>.Equal(const A, B: TGPoint<T>): Boolean;
459begin
460 Result := (A.X = B.X) and (A.Y = B.Y);
461end;
462
463class operator TGPoint<T>.Add(const A, B: TGPoint<T>): TGPoint<T>;
464begin
465 Result.X := A.X + B.X;
466 Result.Y := A.Y + B.Y;
467end;
468
469class operator TGPoint<T>.Subtract(const A, B: TGPoint<T>): TGPoint<T>;
470begin
471 Result.X := A.X - B.X;
472 Result.Y := A.Y - B.Y;
473end;
474
475class operator TGPoint<T>.Multiply(const A, B: TGPoint<T>): TGPoint<T>;
476begin
477 Result.X := A.X * B.X;
478 Result.Y := A.Y * B.Y;
479end;
480
481{class operator TGPoint<T>.Divide(const A, B: TGPoint<T>): TGPoint<T>;
482begin
483 Result.X := TypedDivide(A.X, B.X);
484 Result.Y := TypedDivide(A.Y, B.Y);
485end;
486
487class operator TGPoint<T>.Modulus(A: TGPoint<T>; B: TGPoint<T>): TGPoint<T>;
488begin
489 Result.X := TypedMod(A.X, B.X);
490 Result.Y := TypedMod(A.Y, B.Y);
491end;
492}
493
494class operator TGPoint<T>.GreaterThan(const A, B: TGPoint<T>): Boolean;
495begin
496 Result := (A.X > B.X) and (A.Y > B.Y);
497end;
498
499class operator TGPoint<T>.GreaterThanOrEqual(const A, B: TGPoint<T>): Boolean;
500begin
501 Result := (A.X >= B.X) and (A.Y >= B.Y);
502end;
503
504class operator TGPoint<T>.LessThan(const A, B: TGPoint<T>): Boolean;
505begin
506 Result := (A.X < B.X) and (A.Y < B.Y);
507end;
508
509class operator TGPoint<T>.LessThanOrEqual(const A, B: TGPoint<T>): Boolean;
510begin
511 Result := (A.X <= B.X) and (A.Y <= B.Y);
512end;
513
514class function TGPoint<T>.Min(const A, B: TGPoint<T>): TGPoint<T>;
515begin
516 if A.X < B.X then Result.X := A.X else Result.X := B.X;
517 if A.Y < B.Y then Result.Y := A.Y else Result.Y := B.Y;
518end;
519
520class function TGPoint<T>.Max(const A, B: TGPoint<T>): TGPoint<T>;
521begin
522 if A.X > B.X then Result.X := A.X else Result.X := B.X;
523 if A.Y > B.Y then Result.Y := A.Y else Result.Y := B.Y;
524end;
525
526procedure TGPoint<T>.Rotate(Base: TGPoint<T>; Angle: Double);
527var
528 D: TGPoint<T>;
529begin
530 D := Self - Base;
531 X := Base.X + TypedRound(D.X * Cos(Angle) - D.Y * Sin(Angle));
532 Y := Base.Y + TypedRound(D.X * Sin(Angle) + D.Y * Cos(Angle));
533end;
534
535{ TGRect }
536
537function TGRect<T>.IsPointInside(const P: T): Boolean;
538begin
539 Result := (P >= P1) and (P <= P2);
540end;
541
542function TGRect<T>.GetEmpty: Boolean;
543begin
544 Result := P1 = P2;
545end;
546
547procedure TGRect<T>.SetEmpty;
548begin
549 P2 := P1;
550end;
551
552procedure TGRect<T>.Normalize;
553var
554 NewP1: T;
555 NewP2: T;
556begin
557 NewP1 := P1.Min(P1, P2);
558 NewP2 := P1.Max(P1, P2);
559 P1 := NewP1;
560 P2 := NewP2;
561end;
562
563function TGRect<T>.Center: T;
564begin
565 Result.X := TypedDivide(P2.X - P1.X, 2);
566 Result.Y := TypedDivide(P2.Y - P1.Y, 2);
567end;
568
569function TGRect<T>.GetSize: T;
570begin
571 Result := P2 - P1;
572end;
573
574procedure TGRect<T>.SetSize(AValue: T);
575begin
576 P2 := P1 + AValue;
577end;
578
579procedure TGRect<T>.Move(P: T);
580begin
581 P1 := P1 + P;
582 P2 := P2 + P;
583end;
584
585constructor TGRect<T>.Create(const P1, P2: T);
586begin
587 Self.P1 := P1;
588 Self.P2 := P2;
589 Normalize;
590end;
591
592constructor TGRect<T>.CreateBounds(const Origin, Size: T);
593begin
594 Self.P1 := Origin;
595 Self.P2 := Origin + Size;
596end;
597
598class operator TGRect<T>.Equal(const A, B: TGRect<T>): Boolean;
599begin
600 Result := (A.P1 = B.P1) and (A.P2 = B.P2);
601end;
602
603end.
604
Note: See TracBrowser for help on using the repository browser.