Skip to content

Commit

Permalink
Add TPointArray.ConvexityDefects
Browse files Browse the repository at this point in the history
  • Loading branch information
ollydev committed Oct 12, 2023
1 parent 3f6303e commit 953879b
Show file tree
Hide file tree
Showing 2 changed files with 92 additions and 0 deletions.
19 changes: 19 additions & 0 deletions Source/script/imports/simba/simba.import_tpa.pas
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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;
Expand Down
73 changes: 73 additions & 0 deletions Source/simba.tpa.pas
Original file line number Diff line number Diff line change
Expand Up @@ -12,6 +12,7 @@
- CreateFromCircle
- ConvexHull
- ConcaveHull
- ConvexityDefects
- Border
- Skeleton
- MinAreaRect
Expand Down Expand Up @@ -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;
Expand All @@ -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;

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -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.

0 comments on commit 953879b

Please sign in to comment.