Add TPointArray.ConvexityDefects

Villavu · Oct 12, 2023 · 953879b · 953879b
1 parent 3f6303e
commit 953879b
Show file tree

Hide file tree

Showing 2 changed files with 92 additions and 0 deletions.
diff --git a/Source/script/imports/simba/simba.import_tpa.pas b/Source/script/imports/simba/simba.import_tpa.pas
@@ -784,6 +784,22 @@ procedure _LapeTPAConcaveHullEx(const Params: PParamArray; const Result: Pointer
   P2DPointArray(Result)^ := PPointArray(Params^[0])^.ConcaveHullEx(PDouble(Params^[1])^, PDouble(Params^[2])^);
 end;
 
+(*
+TPointArray.ConvexityDefects
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+> function TPointArray.ConvexityDefects(Epsilon: Single; Mode: EConvexityDefects = EConvexityDefects.NONE): TPointArray;
+
+Finds the defects in relation to a convex hull of the given concave hull.
+
+ - EConvexityDefects.All     -> Keeps all convex points as well.
+ - EConvexityDefects.Minimal -> Keeps the convex points that was linked to a defect
+ - EConvexityDefects.None    -> Only defects
+*)
+procedure _LapeTPAConvexityDefects(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+  PPointArray(Result)^ := PPointArray(Params^[0])^.ConvexityDefects(PDouble(Params^[1])^, EConvexityDefects(Params^[2]^));
+end;
+
 procedure ImportTPA(Compiler: TSimbaScript_Compiler);
 begin
   with Compiler do
@@ -883,6 +899,9 @@ procedure ImportTPA(Compiler: TSimbaScript_Compiler);
     addGlobalFunc('function TPointArray.ConcaveHull(Epsilon: Double = 2.5; kCount: Integer = 5): TPointArray;', @_LapeTPAConcaveHull);
     addGlobalFunc('function TPointArray.ConcaveHullEx(MaxLeap: Double = -1; Epsilon: Double = 2): T2DPointArray;', @_LapeTPAConcaveHullEx);
 
+    addGlobalType('enum(NONE, ALL, MINIMAL)', 'EConvexityDefects');
+    addGlobalFunc('function TPointArray.ConvexityDefects(Epsilon: Single = 0; Mode: EConvexityDefects = EConvexityDefects.NONE): TPointArray;', @_LapeTPAConvexityDefects);
+
     ImportingSection := '';
   end;
 end;

diff --git a/Source/simba.tpa.pas b/Source/simba.tpa.pas
@@ -12,6 +12,7 @@
   - CreateFromCircle
   - ConvexHull
   - ConcaveHull
+  - ConvexityDefects
   - Border
   - Skeleton
   - MinAreaRect
@@ -41,6 +42,11 @@ interface
   simba.mufasatypes, simba.quad, simba.circle;
 
 type
+  {$PUSH}
+  {$SCOPEDENUMS ON}
+  EConvexityDefects = (NONE, ALL, MINIMAL);
+  {$POP}
+
   TPointArrayHelper = type helper for TPointArray
   public
     class function CreateFromLine(Start, Stop: TPoint): TPointArray; static;
@@ -50,6 +56,8 @@ interface
     class function CreateFromPolygon(Poly: TPointArray; Filled: Boolean): TPointArray; static;
     class function CreateFromSimplePolygon(Center: TPoint; Sides: Integer; Size: Integer; Filled: Boolean): TPointArray; static;
 
+    function IndexOf(P: TPoint): Integer;
+
     function Offset(P: TPoint): TPointArray; overload;
     function Offset(X, Y: Integer): TPointArray; overload;
 
@@ -141,6 +149,7 @@ interface
     function DouglasPeucker(epsilon: Double): TPointArray;
     function ConcaveHull(Epsilon:Double=2.5; kCount:Int32=5): TPointArray;
     function ConcaveHullEx(MaxLeap: Double=-1; Epsilon:Double=2): T2DPointArray;
+    function ConvexityDefects(Epsilon: Single; Mode: EConvexityDefects = EConvexityDefects.NONE): TPointArray;
   end;
 
 implementation
@@ -449,6 +458,16 @@ class function TPointArrayHelper.CreateFromSimplePolygon(Center: TPoint; Sides:
     Result := Result.ShapeFill();
 end;
 
+function TPointArrayHelper.IndexOf(P: TPoint): Integer;
+var
+  What: QWord absolute P;
+begin
+  if (Length(Self) > 0) then
+    Result := IndexQWord(Self[0], Length(Self), What)
+  else
+    Result := -1;
+end;
+
 function TPointArrayHelper.Offset(P: TPoint): TPointArray;
 var
   Ptr: PPoint;
@@ -2542,5 +2561,59 @@ function TPointArrayHelper.ConcaveHullEx(MaxLeap: Double=-1; Epsilon:Double=2):
   Result := BufferResult.ToArray();
 end;
 
+(*
+  Finds the defects in relation to a convex hull of the given concave hull.
+  EConvexityDefects.All     -> Keeps all convex points as well.
+  EConvexityDefects.Minimal -> Keeps the convex points that was linked to a defect
+  EConvexityDefects.None    -> Only defects
+*)
+function TPointArrayHelper.ConvexityDefects(Epsilon: Single; Mode: EConvexityDefects): TPointArray;
+var
+  x,y,i,j,k: Int32;
+  dist, best: Single;
+  pt: TPoint;
+  concavePoly: TPointArray;
+  convex: TPointArray;
+  Buffer: TSimbaPointBuffer;
+begin
+  concavePoly := Self;
+  convex := ConcavePoly.ConvexHull();
+
+  for x:=0 to High(ConcavePoly) do
+  begin
+    i := convex.IndexOf(ConcavePoly[x]);
+
+    if i <> -1 then
+    begin
+      j := (i+1) mod Length(convex);
+      y := concavePoly.IndexOf(convex[j]);
+
+      best := 0;
+      for k:=y to x do
+      begin
+        dist := TSimbaGeometry.DistToLine(concavePoly[k], convex[i], convex[j]);
+        if (dist > best) then
+        begin
+          best := dist;
+          pt := concavePoly[k];
+        end;
+      end;
+
+      if (best >= Epsilon) then
+      begin
+        if (Mode = EConvexityDefects.MINIMAL) and ((Buffer.Count = 0) or (Buffer.Last <> convex[j])) then Buffer.Add(convex[j]);
+        if (best > 0) then
+          Buffer.Add(pt{%H-});
+        if (Mode = EConvexityDefects.MINIMAL) then Buffer.Add(convex[i]);
+      end;
+
+      if (Mode = EConvexityDefects.ALL) then
+        Buffer.Add(convex[i]);
+    end;
+  end;
+
+  Result := Buffer.ToArray(False);
+end;
+
 end.