From c4215bc2e51c1f8f03fec5f50fe9d0bf1e562fb0 Mon Sep 17 00:00:00 2001
From: Cohen Adair <cohenadair@gmail.com>
Date: Fri, 29 Jul 2011 14:45:30 -0400
Subject: [PATCH] MML: Added FilterTPACustom, FilterTPADistEx, and
 FilterTPADist

---
 Units/MMLAddon/PSInc/Wrappers/tpa.inc      | 15 +++++
 Units/MMLAddon/PSInc/psexportedmethods.inc |  3 +
 Units/MMLCore/tpa.pas                      | 75 ++++++++++++++++++++++
 3 files changed, 93 insertions(+)

diff --git a/Units/MMLAddon/PSInc/Wrappers/tpa.inc b/Units/MMLAddon/PSInc/Wrappers/tpa.inc
index 0c7c547..f8ef974 100644
--- a/Units/MMLAddon/PSInc/Wrappers/tpa.inc
+++ b/Units/MMLAddon/PSInc/Wrappers/tpa.inc
@@ -143,6 +143,21 @@ begin
   FilterPointsLine(points,radial,radius,mx,my);
 end;
 
+procedure ps_FilterTPACustom(TPA: TPointArray; compare: function(a, b: integer): boolean);
+begin
+  FilterTPACustom(TPA, @compare);
+end;
+
+procedure ps_FilterTPADistEx(var TPA: TPointArray; maxL, maxW: integer);
+begin
+  FilterTPADistEx(TPA, maxL, maxW);
+end;
+
+procedure ps_FilterTPADist(var TPA: TPointArray; maxDist: integer);
+begin
+  FilterTPADist(TPA, maxDist);
+end;
+
 function ps_GetATPABounds(const ATPA: T2DPointArray): TBox;extdecl;
 begin
   result := GetATPABounds(ATPA);
diff --git a/Units/MMLAddon/PSInc/psexportedmethods.inc b/Units/MMLAddon/PSInc/psexportedmethods.inc
index 4dad21c..3c82ba0 100644
--- a/Units/MMLAddon/PSInc/psexportedmethods.inc
+++ b/Units/MMLAddon/PSInc/psexportedmethods.inc
@@ -458,6 +458,9 @@ AddFunction(@ps_FloodFillTPA,'function FloodFillTPA(const TPA : TPointArray) : T
 AddFunction(@ps_FilterPointsPie,'procedure FilterPointsPie(var Points: TPointArray; const SD, ED, MinR, MaxR: Extended; Mx, My: Integer);');
 AddFunction(@ps_FilterPointsLine,'procedure FilterPointsLine(var Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer);');
 AddFunction(@ps_filterpointsdist,'procedure FilterPointsDist(var Points: TPointArray; const MinDist, MaxDist: Extended; Mx, My: Integer);');
+AddFunction(@ps_filterTPACustom, 'procedure FilterTPACustom(var TPA: TPointArray; compare: function(a, b: integer): boolean);');
+AddFunction(@ps_filterTPADistEx, 'procedure FilterTPADistEx(var TPA: TPointArray; maxL, maxW: integer);');
+AddFunction(@ps_filterTPADist, 'procedure FilterTPADist(var TPA: TPointArray; maxDist: integer);');
 AddFunction(@ps_GetATPABounds,'function GetATPABounds(const ATPA: T2DPointArray): TBox;');
 AddFunction(@ps_GetTPABounds,'function GetTPABounds(const TPA: TPointArray): TBox;');
 AddFunction(@ps_FindTPAinTPA,'function FindTPAinTPA(const SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;');
diff --git a/Units/MMLCore/tpa.pas b/Units/MMLCore/tpa.pas
index 9c0abae..bded283 100644
--- a/Units/MMLCore/tpa.pas
+++ b/Units/MMLCore/tpa.pas
@@ -67,6 +67,9 @@ function FloodFillTPA(const TPA : TPointArray) : T2DPointArray;
 procedure FilterPointsPie(var Points: TPointArray; const SD, ED, MinR, MaxR: Extended; Mx, My: Integer);
 procedure FilterPointsDist(var Points: TPointArray; const MinDist,MaxDist: Extended; Mx, My: Integer);
 procedure FilterPointsLine(var Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer);
+procedure FilterTPACustom(var TPA: TPointArray; compare: function(a, b: integer): boolean);
+procedure FilterTPADistEx(var TPA: TPointArray; maxL, maxW: integer);
+procedure FilterTPADist(var TPA: TPointArray; maxDist: integer);
 function RemoveDistTPointArray(x, y, dist: Integer;const ThePoints: TPointArray; RemoveHigher: Boolean): TPointArray;
 function GetATPABounds(const ATPA: T2DPointArray): TBox;
 function GetTPABounds(const TPA: TPointArray): TBox;
@@ -1168,6 +1171,78 @@ begin
   Points:= P;
 end;
 
+{/\
+  Removes points in the TPA using the funciton 'compare'.  If 'compare' returns
+  true, point b is removed from the TPA.
+/\}
+procedure FilterTPACustom(TPA: TPointArray; compare: function(a, b: integer): boolean);
+var
+  c, i, j, l, h: integer;
+  newTPA: TPointArray;
+  inBadElements: TBooleanArray;
+begin
+  h := high(TPA);
+  l := (h + 1); // i.e. length(TPA);
+
+  setLength(inBadElements, l);
+  setLength(newTPA, l);
+
+  for i := 0 to h do
+    inBadElements[i] := false; // just in case..
+
+  for i := 0 to (h - 1) do
+  begin
+    if (inBadElements[i]) then // increases speed significantly
+      continue;
+
+    for j := (i + 1) to h do
+    begin
+      if (inBadElements[j]) then // increases speed significantly
+        continue;
+
+      if (compare(TPA[i], TPA[j])) then
+        inBadElements[j] := true;
+    end;
+  end;
+
+  c := 0;
+
+  // set the new TPA
+  for i := 0 to h do
+    if (not inBadElements[i]) then
+    begin
+      newTPA[c] := TPA[i];
+      inc(c);
+    end;
+
+  setLength(newTPA, c);
+  TPA := newTPA;
+end;
+
+{/\
+  Removes points in the TPA that are within maxL or maxW of each other.
+/\}
+procedure FilterTPADistEx(var TPA: TPointArray; maxL, maxW: integer);
+function lwComp(a,b: TPoint): Boolean;
+begin
+  result := (abs(a.x-b.x) <= maxW) or (abs(a.y-b.y) <= maxL); // lambda would be nice..
+end;
+begin
+  FilterTPACustom(TPA, @lwComp);
+end;
+
+{/\
+  Removes points in the TPA that are within 'maxDist' of each other.
+/\}
+procedure FilterTPADist(var TPA: TPointArray; maxDist: integer);
+function distComp(a, b: TPoint): boolean;
+begin
+  result := (((a.x-b.x)*(a.x-b.x)) + ((a.y-b.y)*(a.y-b.y)) <= (maxDist*maxDist));
+end;
+begin
+  FilterTPACustom(TPA, @distComp);
+end;
+
 {/\
   Removes the points that are inside or outside the distance Dist from the point (x, y) from the TPointArray ThePoints.
 /\}