diff --git a/Source/script/imports/simba/simba.import_tpa.pas b/Source/script/imports/simba/simba.import_tpa.pas index 1d9a2fdcd..8ce21ec67 100644 --- 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 index 483651f9f..afe096eb3 100644 --- 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.