22
33(* ******************************************************************************
44* Author : Angus Johnson *
5- * Date : 19 February 2023 *
5+ * Date : 17 July 2023 *
66* Website : http://www.angusj.com *
77* Copyright : Angus Johnson 2010-2023 *
88* Purpose : Core Clipper Library module *
@@ -120,6 +120,7 @@ TListEx = class
120120 protected
121121 function UnsafeGet (idx: integer): Pointer; // no range checking
122122 procedure UnsafeSet (idx: integer; val: Pointer);
123+ procedure UnsafeDelete (index: integer); virtual ;
123124 public
124125 constructor Create(capacity: integer = 0 ); virtual ;
125126 destructor Destroy; override;
@@ -347,6 +348,9 @@ procedure CheckPrecisionRange(var precision: integer);
347348 NullRectD : TRectD = (left: 0 ; top: 0 ; right: 0 ; Bottom: 0 );
348349 Tolerance : Double = 1.0E-12 ;
349350
351+ // https://github.com/AngusJohnson/Clipper2/discussions/564
352+ MaxDecimalPrecision = 8 ;
353+
350354implementation
351355
352356resourcestring
@@ -608,6 +612,14 @@ procedure TListEx.UnsafeSet(idx: integer; val: Pointer);
608612end ;
609613// ------------------------------------------------------------------------------
610614
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+
611623procedure TListEx.Swap (idx1, idx2: integer);
612624var
613625 p: Pointer;
@@ -623,7 +635,7 @@ procedure TListEx.Swap(idx1, idx2: integer);
623635
624636procedure CheckPrecisionRange (var precision: integer);
625637begin
626- if (precision < -8 ) or (precision > 8 ) then
638+ if (precision < -MaxDecimalPrecision ) or (precision > MaxDecimalPrecision ) then
627639 Raise EClipper2LibException(rsClipper_PrecisonErr);
628640end ;
629641// ------------------------------------------------------------------------------
@@ -1922,36 +1934,24 @@ function __Trunc(val: double): Int64; {$IFDEF INLINE} inline; {$ENDIF}
19221934end ;
19231935// ------------------------------------------------------------------------------
19241936
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-
19341937function GetIntersectPoint (const ln1a, ln1b, ln2a, ln2b: TPoint64;
19351938 out ip: TPoint64): Boolean;
19361939var
1937- dx1,dy1, dx2,dy2, qx,qy , cp: double;
1940+ dx1,dy1, dx2,dy2, t , cp: double;
19381941begin
19391942 // https://en.wikipedia.org/wiki/Line%E2%80%93line_intersection
19401943 dy1 := (ln1b.y - ln1a.y);
19411944 dx1 := (ln1b.x - ln1a.x);
19421945 dy2 := (ln2b.y - ln2a.y);
19431946 dx2 := (ln2b.x - ln2a.x);
19441947 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);
19551955end ;
19561956// ------------------------------------------------------------------------------
19571957
0 commit comments