2
2
3
3
(* ******************************************************************************
4
4
* Author : Angus Johnson *
5
- * Date : 19 February 2023 *
5
+ * Date : 17 July 2023 *
6
6
* Website : http://www.angusj.com *
7
7
* Copyright : Angus Johnson 2010-2023 *
8
8
* Purpose : Core Clipper Library module *
@@ -120,6 +120,7 @@ TListEx = class
120
120
protected
121
121
function UnsafeGet (idx: integer): Pointer; // no range checking
122
122
procedure UnsafeSet (idx: integer; val: Pointer);
123
+ procedure UnsafeDelete (index: integer); virtual ;
123
124
public
124
125
constructor Create(capacity: integer = 0 ); virtual ;
125
126
destructor Destroy; override;
@@ -347,6 +348,9 @@ procedure CheckPrecisionRange(var precision: integer);
347
348
NullRectD : TRectD = (left: 0 ; top: 0 ; right: 0 ; Bottom: 0 );
348
349
Tolerance : Double = 1.0E-12 ;
349
350
351
+ // https://github.com/AngusJohnson/Clipper2/discussions/564
352
+ MaxDecimalPrecision = 8 ;
353
+
350
354
implementation
351
355
352
356
resourcestring
@@ -608,6 +612,14 @@ procedure TListEx.UnsafeSet(idx: integer; val: Pointer);
608
612
end ;
609
613
// ------------------------------------------------------------------------------
610
614
615
+ procedure TListEx.UnsafeDelete (index: integer);
616
+ begin
617
+ dec(fCount);
618
+ if index < fCount then
619
+ Move(fList[index +1 ], fList[index], (fCount - index) * SizeOf(Pointer));
620
+ end ;
621
+ // ------------------------------------------------------------------------------
622
+
611
623
procedure TListEx.Swap (idx1, idx2: integer);
612
624
var
613
625
p: Pointer;
@@ -623,7 +635,7 @@ procedure TListEx.Swap(idx1, idx2: integer);
623
635
624
636
procedure CheckPrecisionRange (var precision: integer);
625
637
begin
626
- if (precision < -8 ) or (precision > 8 ) then
638
+ if (precision < -MaxDecimalPrecision ) or (precision > MaxDecimalPrecision ) then
627
639
Raise EClipper2LibException(rsClipper_PrecisonErr);
628
640
end ;
629
641
// ------------------------------------------------------------------------------
@@ -1922,36 +1934,24 @@ function __Trunc(val: double): Int64; {$IFDEF INLINE} inline; {$ENDIF}
1922
1934
end ;
1923
1935
// ------------------------------------------------------------------------------
1924
1936
1925
- function CheckCastInt64 (val: double): Int64; { $IFDEF INLINE} inline; { $ENDIF}
1926
- begin
1927
- if (val >= MaxCoord) or (val <= MinCoord) then
1928
- Raise EClipper2LibException.Create(' overflow error.' );
1929
- Result := Trunc(val);
1930
- // Result := __Trunc(val);
1931
- end ;
1932
- // ------------------------------------------------------------------------------
1933
-
1934
1937
function GetIntersectPoint (const ln1a, ln1b, ln2a, ln2b: TPoint64;
1935
1938
out ip: TPoint64): Boolean;
1936
1939
var
1937
- dx1,dy1, dx2,dy2, qx,qy , cp: double;
1940
+ dx1,dy1, dx2,dy2, t , cp: double;
1938
1941
begin
1939
1942
// https://en.wikipedia.org/wiki/Line%E2%80%93line_intersection
1940
1943
dy1 := (ln1b.y - ln1a.y);
1941
1944
dx1 := (ln1b.x - ln1a.x);
1942
1945
dy2 := (ln2b.y - ln2a.y);
1943
1946
dx2 := (ln2b.x - ln2a.x);
1944
1947
cp := dy1 * dx2 - dy2 * dx1;
1945
- if (cp = 0.0 ) then
1946
- begin
1947
- Result := false;
1948
- Exit;
1949
- end ;
1950
- qx := dx1 * ln1a.y - dy1 * ln1a.x;
1951
- qy := dx2 * ln2a.y - dy2 * ln2a.x;
1952
- ip.X := CheckCastInt64((dx1 * qy - dx2 * qx) / cp);
1953
- ip.Y := CheckCastInt64((dy1 * qy - dy2 * qx) / cp);
1954
- Result := (ip.x <> invalid64) and (ip.y <> invalid64);
1948
+ Result := (cp <> 0.0 );
1949
+ if not Result then Exit;
1950
+ t := ((ln1a.x-ln2a.x) * dy2 - (ln1a.y-ln2a.y) * dx2) / cp;
1951
+ if t <= 0.0 then ip := ln1a
1952
+ else if t >= 1.0 then ip := ln1b;
1953
+ ip.X := Trunc(ln1a.X + t * dx1);
1954
+ ip.Y := Trunc(ln1a.Y + t * dy1);
1955
1955
end ;
1956
1956
// ------------------------------------------------------------------------------
1957
1957
0 commit comments