moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-24 02:02:17 -05:00
Code Issues Releases Wiki Activity

MML: Added FilterTPACustom, FilterTPADistEx, and FilterTPADist

Browse Source
This commit is contained in:
Cohen Adair 2011-07-29 14:45:30 -04:00
parent 73b2b9635d
commit c4215bc2e5
3 changed files with 93 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
Units/MMLAddon/PSInc/Wrappers/tpa.inc
View File

@ -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);

3
Units/MMLAddon/PSInc/psexportedmethods.inc
View File

@ -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;');

75
Units/MMLCore/tpa.pas
View File

@ -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.
/\}