mirror of
https://github.com/moparisthebest/Simba
synced 2024-11-14 05:15:16 -05:00
2135 lines
53 KiB
ObjectPascal
2135 lines
53 KiB
ObjectPascal
{
|
|
This file is part of the Mufasa Macro Library (MML)
|
|
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
|
|
|
|
MML is free software: you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by
|
|
the Free Software Foundation, either version 3 of the License, or
|
|
(at your option) any later version.
|
|
|
|
MML is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with MML. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
See the file COPYING, included in this distribution,
|
|
for details about the copyright.
|
|
|
|
TPA functions for the Mufasa Macro Library
|
|
}
|
|
unit tpa;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, mufasatypes;
|
|
|
|
function FastTPASort(const TPA: TPointArray;const Dists: TIntegerArray; maxDist: Integer; CloseFirst: Boolean): TPointArray;
|
|
procedure QuickSort(var A: TIntegerArray; iLo, iHi: Integer);
|
|
|
|
//Start Wizzyplugin
|
|
procedure tSwap(var a, b: TPoint);
|
|
procedure tpaSwap(var a, b: TPointArray);
|
|
procedure SwapE(var a, b: Extended);
|
|
procedure RAaSTPAEx(var a: TPointArray; const w, h: Integer);
|
|
procedure RAaSTPA(var a: TPointArray; const Dist: Integer);
|
|
function NearbyPointInArrayEx(const P: TPoint; w, h:Integer; a: TPointArray): Boolean;
|
|
function NearbyPointInArray(const P: TPoint; Dist:Integer; a: TPointArray): Boolean;
|
|
function ReArrangeandShortenArrayEx(const a: TPointArray; w, h: Integer): TPointArray;
|
|
function ReArrangeandShortenArray(const a: TPointArray; Dist: Integer): TPointArray;
|
|
function TPAtoATPAEx(const TPA: TPointArray; w, h: Integer): T2DPointArray;
|
|
function TPAtoATPA(const TPA: TPointArray; Dist: Integer): T2DPointArray;
|
|
procedure QuickTPASort(var A: TIntegerArray; var B: TPointArray; iLo, iHi: Integer; SortUp: Boolean);
|
|
procedure QuickATPASort(var A: TIntegerArray; var B: T2DPointArray; iLo, iHi: Integer; SortUp: Boolean);
|
|
procedure SortTPAFrom(var a: TPointArray; const From: TPoint);
|
|
procedure SortATPAFrom(var a: T2DPointArray; const From: TPoint);
|
|
procedure SortATPAFromFirstPoint(var a: T2DPointArray; const From: TPoint);
|
|
procedure InvertTPA(var a: TPointArray);
|
|
procedure InvertATPA(var a: T2DPointArray);
|
|
function MiddleTPAEx(const TPA: TPointArray; var x, y: Integer): Boolean;
|
|
function MiddleTPA(const tpa: TPointArray): TPoint;
|
|
procedure SortATPASize(var a: T2DPointArray; const BigFirst: Boolean);
|
|
procedure SortATPAFromSize(var a: T2DPointArray; const Size: Integer; CloseFirst: Boolean);
|
|
function CombineTPA(const Ar1, Ar2: TPointArray): TPointArray;
|
|
function CombineIntArray(const Ar1, Ar2: TIntegerArray): TIntegerArray;
|
|
function InIntArrayEx(const a: TIntegerArray; var Where: Integer; const Number: Integer): Boolean;
|
|
function InIntArray(const a: TIntegerArray; Number: Integer): Boolean;
|
|
procedure ClearSameIntegers(var a: TIntegerArray);
|
|
procedure ClearSameIntegersAndTPA(var a: TIntegerArray; var p: TPointArray);
|
|
function SplitTPAEx(const arr: TPointArray; w, h: Integer): T2DPointArray;
|
|
function SplitTPA(const arr: TPointArray; Dist: Integer): T2DPointArray;
|
|
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);
|
|
function RemoveDistTPointArray(x, y, dist: Integer;const ThePoints: TPointArray; RemoveHigher: Boolean): TPointArray;
|
|
function GetATPABounds(const ATPA: T2DPointArray): TBox;
|
|
function GetTPABounds(const TPA: TPointArray): TBox;
|
|
function FindTPAinTPA(SearchTPA: TPointArray; const TotalTPA: TPointArray; var Matches: TPointArray): Boolean;
|
|
function FindTextTPAinTPA(Height : integer;const SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;
|
|
function GetSamePointsATPA(const ATPA : T2DPointArray; var Matches : TPointArray) : boolean;
|
|
function FindGapsTPA(const TPA: TPointArray; MinPixels: Integer): T2DPointArray;
|
|
procedure SortCircleWise(var tpa: TPointArray; const cx, cy, StartDegree: Integer; SortUp, ClockWise: Boolean);
|
|
procedure LinearSort(var tpa: TPointArray; cx, cy, sd: Integer; SortUp: Boolean);
|
|
function MergeATPA(const ATPA : T2DPointArray) : TPointArray;
|
|
procedure AppendTPA(var TPA : TPointArray; const ToAppend : TPointArray);
|
|
function TPAFromBox(const Box : TBox) : TPointArray;
|
|
function FindTPAEdges(const p: TPointArray): TPointArray;
|
|
function PointInTPA(const p: TPoint;const arP: TPointArray): Boolean;
|
|
function ClearTPAFromTPA(const arP, ClearPoints: TPointArray): TPointArray;
|
|
procedure ClearDoubleTPA(var TPA: TPointArray);
|
|
Function ReturnPointsNotInTPA(Const TotalTPA: TPointArray; const Box: TBox): TPointArray;
|
|
Procedure TPACountSort(Var TPA: TPointArray;const max: TPoint;Const SortOnX : Boolean);
|
|
Procedure TPACountSortBase(Var TPA: TPointArray;const maxx, base: TPoint; const SortOnX : Boolean);
|
|
procedure InvertTIA(var tI: TIntegerArray);
|
|
function SumIntegerArray(const Ints : TIntegerArray): Integer;
|
|
function AverageTIA(const tI: TIntegerArray): Integer;
|
|
function AverageExtended(const tE: TExtendedArray): Extended;
|
|
function SameTPA(const aTPA, bTPA: TPointArray): Boolean;
|
|
function TPAInATPA(const TPA: TPointArray;const InATPA: T2DPointArray; var Index: LongInt): Boolean;
|
|
procedure OffsetTPA(var TPA : TPointArray; const Offset : TPoint);
|
|
procedure OffsetATPA(var ATPA : T2DPointArray; const Offset : TPoint);
|
|
|
|
implementation
|
|
|
|
uses
|
|
math,mmath;
|
|
|
|
|
|
|
|
|
|
{/\
|
|
Very Fast TPA Sort, uses an adepted CountSort algorithm.
|
|
/\}
|
|
|
|
Function FastTPASort(const TPA: TPointArray;const Dists: TIntegerArray; maxDist: Integer; CloseFirst: Boolean): TPointArray;
|
|
|
|
{
|
|
If you want to understand this algorithm, it might be helpful to read about
|
|
CountSort. This algorithm is quite similar to CountSort.
|
|
}
|
|
|
|
Var
|
|
Oc, D: TIntegerArray;
|
|
I, H, J: Integer;
|
|
ind: array of array of integer;
|
|
|
|
Begin
|
|
SetLength(Oc, maxDist + 1); // Oc stores the occurances of each distance.
|
|
H := High(Dists); // The amount of values in the given Array of Points...
|
|
// We store it instead of calling High(Dists) each time.
|
|
|
|
// Get the occurance of each distance, and store it in Oc.
|
|
// We need the occurances of each distance, so we can later on set the 2d Array
|
|
// to it's proper length.
|
|
For I := 0 To H Do
|
|
Oc[Dists[I]] := Oc[Dists[I]] + 1;
|
|
|
|
// What we are basically going to do now is the following:
|
|
// Sort the points by their distances using countsort.
|
|
// But because (-2, -2) and (2, 2) have the same distance from (0, 0), we also
|
|
// store the index in the array 'TPA', which contains the actual points.
|
|
// This way we can retreive the actuals points.
|
|
|
|
// D nothing but a counter. It contains the amount of points (indices) stored
|
|
// for EACH distance, so it's length is equal to the amount of Distances.
|
|
// ind is the array that has as first index the Distance. The second depth of
|
|
// the array is the index which is used to retreive the original point.
|
|
|
|
SetLength(D, maxDist + 1);
|
|
SetLength(ind, maxDist + 1);
|
|
For I := 0 To maxDist Do // set the ind length of each ind[distance] to Oc[distance]
|
|
SetLength(ind[i], Oc[i] + 1);
|
|
For I := 0 To H Do // Performs the actual index sorting
|
|
Begin
|
|
// put an index (of Dists AND TPA) into a distance array.
|
|
ind[Dists[I]][D[Dists[I]]] := I;
|
|
// inc by one, so we won't override previous indexes.
|
|
D[Dists[i]] := D[Dists[i]] + 1;
|
|
End;
|
|
|
|
// Here we are back to the CountSort style of writing back.
|
|
// Now we are going to write back to the Result.
|
|
// The Result's length is obviously of the same length as 'TPA'.
|
|
SetLength(Result, H + 1);
|
|
H := 0;
|
|
|
|
// CloseFirst just means: Start writing from dist 0 to maxDist, or
|
|
// start writing from maxDist to dist 0. The first one places the closest points
|
|
// at the start of the result. The higher the index, the more far away the point.
|
|
// Not Closefirst means put the most far away point in Result first.
|
|
If CloseFirst Then
|
|
Begin
|
|
For I := 0 To maxDist Do // Put back to result
|
|
For J := 0 To oC[I] - 1 Do
|
|
Begin
|
|
Result[H] := TPA[ind[I][J]];
|
|
H := H + 1;
|
|
End;
|
|
End
|
|
Else
|
|
For I := maxDist Downto 0 Do // Put back to result
|
|
For J := 0 To oC[I] - 1 Do
|
|
Begin
|
|
Result[H] := TPA[ind[I][J]];
|
|
H := H + 1;
|
|
End;
|
|
// Voila!
|
|
End;
|
|
|
|
procedure QuickSort(var A: TIntegerArray; iLo, iHi: Integer) ;
|
|
var
|
|
Lo, Hi, Pivot, T: Integer;
|
|
begin
|
|
Lo := iLo;
|
|
Hi := iHi;
|
|
Pivot := A[(Lo + Hi) div 2];
|
|
repeat
|
|
while A[Lo] < Pivot do Inc(Lo) ;
|
|
while A[Hi] > Pivot do Dec(Hi) ;
|
|
if Lo <= Hi then
|
|
begin
|
|
T := A[Lo];
|
|
A[Lo] := A[Hi];
|
|
A[Hi] := T;
|
|
Inc(Lo) ;
|
|
Dec(Hi) ;
|
|
end;
|
|
until Lo > Hi;
|
|
if Hi > iLo then QuickSort(A, iLo, Hi) ;
|
|
if Lo < iHi then QuickSort(A, Lo, iHi) ;
|
|
end;
|
|
|
|
const
|
|
flnC=545947;
|
|
fsqrtA:single=0.5;
|
|
|
|
{{$ASMMODE INTEL}
|
|
function fsqrt(x: Single): Single;
|
|
begin
|
|
asm
|
|
sub dword ptr x, ($3F800000-flnC)
|
|
fild dword ptr x
|
|
fmul fsqrtA
|
|
fistp dword ptr x
|
|
add dword ptr x,($3F800000-flnC)
|
|
fld x
|
|
end;
|
|
end; }
|
|
|
|
|
|
procedure tSwap(var a, b: TPoint);
|
|
var
|
|
c: TPoint;
|
|
begin
|
|
c := a;
|
|
a := b;
|
|
b := c;
|
|
end;
|
|
|
|
procedure tpaSwap(var a, b: TPointArray);
|
|
var
|
|
c: TPointArray;
|
|
begin
|
|
c := a;
|
|
a := b;
|
|
b := c;
|
|
end;
|
|
|
|
procedure SwapE(var a, b: Extended);
|
|
var
|
|
c: extended;
|
|
begin
|
|
c := a;
|
|
a := b;
|
|
b := c;
|
|
end;
|
|
|
|
{/\
|
|
Leaves one point per box with side lengths W and H to the TPA.
|
|
/\}
|
|
|
|
procedure RAaSTPAEx(var a: TPointArray; const w, h: Integer);
|
|
var
|
|
i, c, NoTP, l: Integer;
|
|
t: TPoint;
|
|
Found : boolean;
|
|
begin
|
|
NoTP := 0;
|
|
l := High(a);
|
|
for i := 0 to l do
|
|
begin
|
|
Found := false;
|
|
for c := 0 to NoTP - 1 do
|
|
if (Abs(a[i].x - a[c].x) <= w) and (Abs(a[i].y - a[c].y) <= h) then
|
|
begin
|
|
Found := true;
|
|
Break;
|
|
end;
|
|
if not Found then
|
|
// if (c >= NoTP) then
|
|
begin
|
|
t := a[i];
|
|
a[i] := a[NoTP];
|
|
a[NoTP] := t;
|
|
Inc(NoTP);
|
|
end;
|
|
end;
|
|
SetLength(a, NoTP);
|
|
end;
|
|
|
|
{/\
|
|
Leaves one point per box with the side length Dist.
|
|
/\}
|
|
|
|
procedure RAaSTPA(var a: TPointArray; const Dist: Integer);
|
|
var
|
|
i, c, NoTP, l: Integer;
|
|
t: TPoint;
|
|
Found : boolean;
|
|
begin
|
|
NoTP := 0;
|
|
l := High(a);
|
|
for i := 0 to l do
|
|
begin
|
|
Found := false;
|
|
for c := 0 to NoTP - 1 do
|
|
if (Round(sqrt(Sqr(a[i].x - a[c].x) + Sqr(a[i].y - a[c].y))) <= Dist) then
|
|
begin
|
|
Found := True;
|
|
Break;
|
|
end;
|
|
if not Found then
|
|
// if (c >= NoTP) then
|
|
begin
|
|
t := a[i];
|
|
a[i] := a[NoTP];
|
|
a[NoTP] := t;
|
|
Inc(NoTP);
|
|
end;
|
|
end;
|
|
SetLength(a, NoTP);
|
|
end;
|
|
|
|
{/\
|
|
Returns true if the point P is near a point in the TPA a with the max X and Y distances W and H.
|
|
/\}
|
|
|
|
function NearbyPointInArrayEx(const P: TPoint; w, h:Integer; a: TPointArray): Boolean;
|
|
var
|
|
i, l: Integer;
|
|
begin
|
|
Result := False;
|
|
l := High(a);
|
|
for i := 0 to l do
|
|
if (Abs(P.x - a[i].x) <= w) and (Abs(P.y - a[i].y) <= h) then
|
|
begin
|
|
Result := True;
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
{/\
|
|
Returns true if the point P is near a point in the TPA a with the max distance Dist.
|
|
/\}
|
|
|
|
function NearbyPointInArray(const P: TPoint; Dist:Integer; a: TPointArray): Boolean;
|
|
var
|
|
i, l: Integer;
|
|
begin
|
|
Result := False;
|
|
l := High(a);
|
|
for i := 0 to l do
|
|
if (Round(sqrt(Sqr(P.x - a[i].x) + Sqr(P.y - a[i].y))) <= Dist) then
|
|
begin
|
|
Result := True;
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
{/\
|
|
Results the TPointArray a with one point per box with side lengths W and H left.
|
|
/\}
|
|
|
|
function ReArrangeandShortenArrayEx(const a: TPointArray; w, h: Integer): TPointArray;
|
|
var
|
|
i, t, c, l: Integer;
|
|
Found: Boolean;
|
|
begin
|
|
l := High(a);
|
|
c := 0;
|
|
SetLength(Result, l + 1);
|
|
for i := 0 to l do
|
|
begin
|
|
Found := False;
|
|
for t := 0 to c -1 do
|
|
if (Abs(Result[t].x - a[i].x) <= w) and (Abs(Result[t].y - a[i].y) <= h) then
|
|
begin;
|
|
Found := True;
|
|
Break;
|
|
end;
|
|
if not Found then
|
|
// if (t >= c) then
|
|
begin
|
|
Result[c] := a[i];
|
|
Inc(c);
|
|
end;
|
|
end;
|
|
SetLength(Result, c);
|
|
end;
|
|
|
|
{/\
|
|
Results the TPointArray a with one point per box with side length Dist left.
|
|
/\}
|
|
|
|
function ReArrangeandShortenArray(const a: TPointArray; Dist: Integer): TPointArray;
|
|
var
|
|
i, t, c, l: Integer;
|
|
Found: Boolean;
|
|
begin
|
|
l := High(a);
|
|
c := 0;
|
|
SetLength(Result, l + 1);
|
|
for i := 0 to l do
|
|
begin
|
|
Found := False;
|
|
for t := 0 to c -1 do
|
|
if (Round(sqrt(Sqr(Result[t].x - a[i].x) + Sqr(Result[t].y - a[i].y))) <= Dist) then
|
|
begin
|
|
Found := True;
|
|
Break;
|
|
end;
|
|
if not found then
|
|
// if (t >= c) then
|
|
begin
|
|
Result[c] := a[i];
|
|
Inc(c);
|
|
end;
|
|
end;
|
|
SetLength(Result, c);
|
|
end;
|
|
|
|
{/\
|
|
Splits the TPA to boxes with sidelengths W and H and results them as a T2DPointArray.
|
|
/\}
|
|
|
|
function TPAtoATPAEx(const TPA: TPointArray; w, h: Integer): T2DPointArray;
|
|
var
|
|
a, b, c, l: LongInt;
|
|
Found: Boolean;
|
|
begin
|
|
SetLength(Result, 0);
|
|
l := High(TPA);
|
|
c := 0;
|
|
for a := 0 to l do
|
|
begin
|
|
Found := false;
|
|
for b := 0 to c -1 do
|
|
if (Abs(TPA[a].X - Result[b][0].X) <= w) and (Abs(TPA[a].Y - Result[b][0].Y) <= h) then
|
|
begin
|
|
Found := True;
|
|
Break;
|
|
end;
|
|
if Found then
|
|
// if (b < c) then
|
|
begin
|
|
SetLength(Result[b], Length(Result[b]) + 1);
|
|
Result[b][High(Result[b])] := TPA[a];
|
|
end else
|
|
begin
|
|
SetLength(Result, c + 1);
|
|
SetLength(Result[c], 1);
|
|
Result[c][0] := TPA[a];
|
|
Inc(c);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{/\
|
|
Splits the TPA to boxes with sidelength Dist and results them as a T2DPointArray.
|
|
/\}
|
|
|
|
function TPAtoATPA(const TPA: TPointArray; Dist: Integer): T2DPointArray;
|
|
var
|
|
a, b, c, l: LongInt;
|
|
Found: Boolean;
|
|
begin
|
|
SetLength(Result, 0);
|
|
l := High(tpa);
|
|
c := 0;
|
|
for a := 0 to l do
|
|
begin
|
|
Found := false;
|
|
for b := 0 to c -1 do
|
|
if (Round(sqrt(Sqr(TPA[a].X - Result[b][0].X) + Sqr(TPA[a].Y - Result[b][0].Y))) <= Dist) then
|
|
begin
|
|
Found := True;
|
|
Break;
|
|
end;
|
|
if Found then
|
|
// if (b < c) then
|
|
begin
|
|
SetLength(Result[b], Length(Result[b]) + 1);
|
|
Result[b][High(Result[b])] := TPA[a];
|
|
end else
|
|
begin
|
|
SetLength(Result, c + 1);
|
|
SetLength(Result[c], 1);
|
|
Result[c][0] := TPA[a];
|
|
Inc(c);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{/\
|
|
Sorts the given TPointArray.
|
|
/\}
|
|
|
|
procedure QuickTPASort(var A: TIntegerArray; var B: TPointArray; iLo, iHi: Integer; SortUp: Boolean);
|
|
var
|
|
Lo, Hi, Mid, T: Integer;
|
|
TP: TPoint;
|
|
begin
|
|
if (Length(A) <> Length(B)) then Exit;
|
|
Lo := iLo;
|
|
Hi := iHi;
|
|
Mid := A[(Lo + Hi) shr 1];
|
|
repeat
|
|
if SortUp then
|
|
begin
|
|
while (A[Lo] < Mid) do Inc(Lo);
|
|
while (A[Hi] > Mid) do Dec(Hi);
|
|
end else
|
|
begin
|
|
while (A[Lo] > Mid) do Inc(Lo);
|
|
while (A[Hi] < Mid) do Dec(Hi);
|
|
end;
|
|
if (Lo <= Hi) then
|
|
begin
|
|
T := A[Lo];
|
|
A[Lo] := A[Hi];
|
|
A[Hi] := T;
|
|
TP := B[Lo];
|
|
B[Lo] := B[Hi];
|
|
B[Hi] := TP;
|
|
Inc(Lo);
|
|
Dec(Hi);
|
|
end;
|
|
until Lo > Hi;
|
|
if (Hi > iLo) then QuickTPASort(A, B, iLo, Hi, SortUp);
|
|
if (Lo < iHi) then QuickTPASort(A, B, Lo, iHi, SortUp);
|
|
end;
|
|
|
|
{/\
|
|
Sorts the given T2DPointArray.
|
|
/\}
|
|
|
|
procedure QuickATPASort(var A: TIntegerArray; var B: T2DPointArray; iLo, iHi: Integer; SortUp: Boolean);
|
|
var
|
|
Lo, Hi, Mid, T: Integer;
|
|
TP: TPointArray;
|
|
begin
|
|
if (Length(A) <> Length(B)) then Exit;
|
|
Lo := iLo;
|
|
Hi := iHi;
|
|
Mid := A[(Lo + Hi) shr 1];
|
|
repeat
|
|
if SortUp then
|
|
begin
|
|
while (A[Lo] < Mid) do Inc(Lo);
|
|
while (A[Hi] > Mid) do Dec(Hi);
|
|
end else
|
|
begin
|
|
while (A[Lo] > Mid) do Inc(Lo);
|
|
while (A[Hi] < Mid) do Dec(Hi);
|
|
end;
|
|
if (Lo <= Hi) then
|
|
begin
|
|
T := A[Lo];
|
|
A[Lo] := A[Hi];
|
|
A[Hi] := T;
|
|
TP := B[Lo];
|
|
B[Lo] := B[Hi];
|
|
B[Hi] := TP;
|
|
Inc(Lo);
|
|
Dec(Hi);
|
|
end;
|
|
until Lo > Hi;
|
|
if (Hi > iLo) then QuickATPASort(A, B, iLo, Hi, SortUp);
|
|
if (Lo < iHi) then QuickATPASort(A, B, Lo, iHi, SortUp);
|
|
end;
|
|
|
|
{/\
|
|
Sorts the TPointArray a from the point From.
|
|
Closest one to the point is [0], second closest is [1] etc.
|
|
/\}
|
|
|
|
procedure SortTPAFrom(var a: TPointArray; const From: TPoint);
|
|
var
|
|
i, l: Integer;
|
|
DistArr: TIntegerArray;
|
|
begin
|
|
l := High(a);
|
|
if (l < 0) then Exit;
|
|
SetLength(DistArr, l + 1);
|
|
for i := 0 to l do
|
|
DistArr[i] := Round(Sqr(From.x - a[i].x) + Sqr(From.y - a[i].y));
|
|
QuickTPASort(DistArr, a, 0, l, True);
|
|
end;
|
|
|
|
{/\
|
|
Sorts the T2DPointArray a from the point From.
|
|
/\}
|
|
|
|
procedure SortATPAFrom(var a: T2DPointArray; const From: TPoint);
|
|
var
|
|
i, l: Integer;
|
|
begin
|
|
l := High(a);
|
|
if (l < 0) then Exit;
|
|
for i := 0 to l do
|
|
SortTPAFrom(a[i], From);
|
|
end;
|
|
|
|
{/\
|
|
Sorts the T2DPointArray a from the point From.
|
|
/\}
|
|
|
|
procedure SortATPAFromFirstPoint(var a: T2DPointArray; const From: TPoint);
|
|
var
|
|
i, l: Integer;
|
|
DistArr: TIntegerArray;
|
|
begin
|
|
l := High(a);
|
|
if (l < 0) then Exit;
|
|
SetLength(DistArr, l + 1);
|
|
for i := 0 to l do
|
|
DistArr[i] := Round(Sqr(From.x - a[i][0].x) + Sqr(From.y - a[i][0].y));
|
|
QuickATPASort(DistArr, a, 0, l, True);
|
|
end;
|
|
|
|
{/\
|
|
Inverts / Reverses the TPointArray a.
|
|
/\}
|
|
|
|
procedure InvertTPA(var a: TPointArray);
|
|
var
|
|
i, l: Integer;
|
|
b: tpointarray;
|
|
begin
|
|
l := High(a);
|
|
if (l < 0) then Exit;
|
|
b := Copy(a);
|
|
for i := l downto 0 Do
|
|
a[l - i] := b[i];
|
|
end;
|
|
|
|
{/\
|
|
Inverts / Reverts the T2DPointArray a.
|
|
/\}
|
|
|
|
procedure InvertATPA(var a: T2DPointArray);
|
|
var
|
|
i, l: Integer;
|
|
b: T2DPointArray;
|
|
begin
|
|
l := High(a);
|
|
if (l < 0) then Exit;
|
|
b := Copy(a);
|
|
for i := l downto 0 do
|
|
a[l - i] := b[i];
|
|
end;
|
|
|
|
{/\
|
|
Stores the coordinates of the middle of the TPointArray a to X and Y.
|
|
/\}
|
|
|
|
function MiddleTPAEx(const TPA: TPointArray; var x, y: Integer): Boolean;
|
|
var
|
|
i, l: Integer;
|
|
begin
|
|
Result := False;
|
|
l := High(tpa);
|
|
if (l < 0) then Exit;
|
|
x := 0;
|
|
y := 0;
|
|
for i := 0 to l do
|
|
begin
|
|
x := x + tpa[i].x;
|
|
y := y + tpa[i].y;
|
|
end;
|
|
x := x div (l + 1);
|
|
y := y div (l + 1);
|
|
Result := True;
|
|
end;
|
|
|
|
{/\
|
|
Returns the middle of the TPointArray tpa.
|
|
/\}
|
|
|
|
function MiddleTPA(const tpa: TPointArray): TPoint;
|
|
var
|
|
i, l: Integer;
|
|
begin
|
|
FillChar(result,sizeof(TPoint),0);
|
|
l := High(tpa);
|
|
if (l < 0) then Exit;
|
|
Result.x := 0;
|
|
Result.y := 0;
|
|
for i := 0 to l do
|
|
begin
|
|
Result.x := Result.x + tpa[i].x;
|
|
Result.y := Result.y + tpa[i].y;
|
|
end;
|
|
Result.x := Result.x div (l + 1);
|
|
Result.y := Result.y div (l + 1);
|
|
end;
|
|
|
|
{/\
|
|
Sorts the T2DPointArray a from either largest or smallest, by the amount of points in the TPAs.
|
|
/\}
|
|
|
|
procedure SortATPASize(var a: T2DPointArray; const BigFirst: Boolean);
|
|
var
|
|
i, l: Integer;
|
|
SizeArr: TIntegerArray;
|
|
begin
|
|
l := High(a);
|
|
if (l < 0) then Exit;
|
|
SetLength(SizeArr, l + 1);
|
|
for i := 0 to l do
|
|
SizeArr[i] := Length(a[i]);
|
|
QuickATPASort(SizeArr, a, 0, l, not BigFirst);
|
|
end;
|
|
|
|
{/\
|
|
Combines the TPointArrays Ar1 and Ar2, and results the combination.
|
|
/\}
|
|
|
|
procedure SortATPAFromSize(var a: T2DPointArray; const Size: Integer; CloseFirst: Boolean);
|
|
var
|
|
i, l: Integer;
|
|
SizeArr: TIntegerArray;
|
|
begin
|
|
l := High(a);
|
|
if (l < 0) then Exit;
|
|
SetLength(SizeArr, l + 1);
|
|
for i := 0 to l do
|
|
SizeArr[i] := Abs(Length(a[i]) - Size);
|
|
QuickATPASort(SizeArr, a, 0, l, CloseFirst);
|
|
end;
|
|
|
|
{/\
|
|
Combines the TPointArrays Ar1 and Ar2, and results the combination.
|
|
/\}
|
|
|
|
function CombineTPA(const Ar1, Ar2: TPointArray): TPointArray;
|
|
var
|
|
i, l1, l2: Integer;
|
|
begin
|
|
Result := Copy(Ar1);
|
|
l1 := Length(Result);
|
|
l2 := Length(Ar2);
|
|
SetLength(Result, l1 + l2);
|
|
for i := 0 to l2 -1 do
|
|
Result[i + l1] := Ar2[i];
|
|
end;
|
|
|
|
{/\
|
|
Combines the TIntegerArrays Ar1 and Ar2, and results the combination.
|
|
/\}
|
|
|
|
function CombineIntArray(const Ar1, Ar2: TIntegerArray): TIntegerArray;
|
|
var
|
|
i, l1, l2: Integer;
|
|
begin
|
|
Result := Copy(Ar1);
|
|
l1 := Length(Result);
|
|
l2 := Length(Ar2);
|
|
SetLength(Result, l1 + l2);
|
|
for i := 0 to l2 -1 do
|
|
Result[i + l1] := Ar2[i];
|
|
end;
|
|
|
|
{/\
|
|
Returns true if the integer Number was found in the integer array a, and stores the index to Where.
|
|
/\}
|
|
|
|
function InIntArrayEx(const a: TIntegerArray; var Where: Integer; const Number: Integer): Boolean;
|
|
var
|
|
i, l: Integer;
|
|
begin
|
|
Result := False;
|
|
l := High(a);
|
|
for i := 0 to l do
|
|
if (a[i] = Number) then
|
|
begin
|
|
Where := i;
|
|
Result := True;
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
{/\
|
|
Returns true if the integer Number was found in the integer array a.
|
|
/\}
|
|
|
|
function InIntArray(const a: TIntegerArray; Number: Integer): Boolean;
|
|
var
|
|
i, l: Integer;
|
|
begin
|
|
Result := False;
|
|
l := High(a);
|
|
for i := 0 to l do
|
|
if (a[i] = Number) then
|
|
begin
|
|
Result := True;
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
{/\
|
|
Clears the duplicates in the integer array a.
|
|
/\}
|
|
|
|
procedure ClearSameIntegers(var a: TIntegerArray);
|
|
var
|
|
i, t, c, l: Integer;
|
|
b: TIntegerArray;
|
|
Found: Boolean;
|
|
begin
|
|
b := Copy(a);
|
|
l := High(b);
|
|
c := 0;
|
|
for i := 0 to l do
|
|
begin
|
|
Found := False;
|
|
for t := 0 to c -1 do
|
|
if (b[i] = a[t]) then
|
|
begin
|
|
Found := True;
|
|
Break;
|
|
end;
|
|
if not Found then
|
|
// if (t >= c) then
|
|
begin
|
|
a[c] := b[i];
|
|
Inc(c);
|
|
end;
|
|
end;
|
|
SetLength(a, c);
|
|
end;
|
|
|
|
{/\
|
|
Clears the duplicates in the integer array a and the TPointArray p.
|
|
/\}
|
|
|
|
procedure ClearSameIntegersAndTPA(var a: TIntegerArray; var p: TPointArray);
|
|
var
|
|
i, t, c, l: Integer;
|
|
b: TIntegerArray;
|
|
Found: Boolean;
|
|
begin
|
|
b := Copy(a);
|
|
l := High(b);
|
|
c := 0;
|
|
for i := 0 to l do
|
|
begin
|
|
Found := false;
|
|
for t := 0 to c -1 do
|
|
if (b[i] = a[t]) then
|
|
begin
|
|
Found := true;
|
|
Break;
|
|
end;
|
|
if not Found then
|
|
// if (t >= c) then
|
|
begin
|
|
SetLength(a, c +1);
|
|
a[c] := b[i];
|
|
p[c] := p[i];
|
|
Inc(c);
|
|
end;
|
|
end;
|
|
SetLength(p, c);
|
|
SetLength(a, c);
|
|
end;
|
|
|
|
{/\
|
|
Splits the points with max X and Y distances W and H to their own TPointArrays.
|
|
/\}
|
|
|
|
function SplitTPAEx(const arr: TPointArray; w, h: Integer): T2DPointArray;
|
|
var
|
|
t1, t2, c, ec, tc, l: Integer;
|
|
tpa: TPointArray;
|
|
begin
|
|
tpa := Copy(arr);
|
|
l := High(tpa);
|
|
if (l < 0) then Exit;
|
|
SetLength(Result, l + 1);
|
|
c := 0;
|
|
ec := 0;
|
|
while ((l - ec) >= 0) do
|
|
begin
|
|
SetLength(Result[c], 1);
|
|
Result[c][0] := tpa[0];
|
|
tpa[0] := tpa[l - ec];
|
|
Inc(ec);
|
|
tc := 1;
|
|
t1 := 0;
|
|
while (t1 < tc) do
|
|
begin
|
|
t2 := 0;
|
|
while (t2 <= (l - ec)) do
|
|
begin
|
|
if (Abs(Result[c][t1].x - tpa[t2].x) <= w) and (Abs(Result[c][t1].y - tpa[t2].y) <= h) then
|
|
begin
|
|
SetLength(Result[c], tc +1);
|
|
Result[c][tc] := tpa[t2];
|
|
tpa[t2] := tpa[l - ec];
|
|
Inc(ec);
|
|
Inc(tc);
|
|
Dec(t2);
|
|
end;
|
|
Inc(t2);
|
|
end;
|
|
Inc(t1);
|
|
end;
|
|
Inc(c);
|
|
end;
|
|
SetLength(Result, c);
|
|
end;
|
|
|
|
{/\
|
|
Splits the points with max distance Dist to their own TPointArrays.
|
|
Dist 1 puts the points that are next to eachother to their own arrays.
|
|
/\}
|
|
|
|
function SplitTPA(const arr: TPointArray; Dist: Integer): T2DPointArray;
|
|
var
|
|
t1, t2, c, ec, tc, l: Integer;
|
|
tpa: TPointArray;
|
|
begin
|
|
tpa := Copy(arr);
|
|
l := High(tpa);
|
|
if (l < 0) then Exit;
|
|
SetLength(Result, l + 1);
|
|
c := 0;
|
|
ec := 0;
|
|
while ((l - ec) >= 0) do
|
|
begin
|
|
SetLength(Result[c], 1);
|
|
Result[c][0] := tpa[0];
|
|
tpa[0] := tpa[l - ec];
|
|
Inc(ec);
|
|
tc := 1;
|
|
t1 := 0;
|
|
while (t1 < tc) do
|
|
begin
|
|
t2 := 0;
|
|
while (t2 <= (l - ec)) do
|
|
begin
|
|
if (Round(sqrt(Sqr(Result[c][t1].x - tpa[t2].x) + Sqr(Result[c][t1].y - tpa[t2].y))) <= Dist) then
|
|
begin
|
|
SetLength(Result[c], tc +1);
|
|
Result[c][tc] := tpa[t2];
|
|
tpa[t2] := tpa[l - ec];
|
|
Inc(ec);
|
|
Inc(tc);
|
|
Dec(t2);
|
|
end;
|
|
Inc(t2);
|
|
end;
|
|
Inc(t1);
|
|
end;
|
|
Inc(c);
|
|
end;
|
|
SetLength(Result, c);
|
|
end;
|
|
|
|
function FloodFillTPA(const TPA : TPointArray) : T2DPointArray;
|
|
var
|
|
x,y,i,CurrentArray, LengthTPA,CurrentStack : integer;
|
|
TempBox : TBox;
|
|
PointsToFill : T2DBoolArray;
|
|
Lengths : TIntegerArray;
|
|
TempTPA : TPointArray;
|
|
Stack : TPointArray;
|
|
fx,fy : integer;
|
|
begin;
|
|
LengthTPA := High(TPA);
|
|
if LengthTPA < 1 then
|
|
begin;
|
|
if LengthTPA = 0 then
|
|
begin;
|
|
SetLength(Result,1,1);
|
|
Result[0][0] := TPA[0];
|
|
end else
|
|
SetLength(Result,0);
|
|
exit;
|
|
end;
|
|
TempBox := GetTPABounds(TPA);
|
|
SetLength(PointsToFill,TempBox.x2 - TempBox.x1+3,TempBox.y2 - TempBox.y1+3); //W + 2, H + 2 so that we can check the borders
|
|
fy := TempBox.y2 - TempBox.y1+3;
|
|
fx := TempBox.x2 - TempBox.x1+2;
|
|
for i := 0 to fx do
|
|
FillChar(PointsToFill[i][0],fy,0);
|
|
x := TempBox.x1 - 1;
|
|
y := TempBox.y1 - 1;
|
|
CurrentArray := -1;
|
|
SetLength(Stack , LengthTPA + 1);
|
|
SetLength(Lengths , LengthTPA + 1);
|
|
SetLength(TempTPA , LengthTPA + 1);
|
|
for I := 0 to LengthTPA do
|
|
begin;
|
|
TempTPA[I].x := TPA[I].x - x;
|
|
TempTPA[I].y := TPA[I].y - y;
|
|
end;
|
|
for I := 0 to LengthTPA do
|
|
PointsToFill[TempTPA[I].x][TempTPA[I].y] := True;
|
|
for I := 0 to LengthTPA do
|
|
if PointsToFill[TempTPA[I].x][TempTPA[I].y] then
|
|
begin;
|
|
PointsToFill[TempTPA[i].x][TempTPA[i].y] := false;
|
|
inc(CurrentArray);
|
|
SetLength(Result,CurrentArray + 1);
|
|
SetLength(Result[CurrentArray],LengthTPA - I + 1);
|
|
Lengths[CurrentArray] := 0;
|
|
CurrentStack := 0;
|
|
Stack[0].x := TempTPA[I].x;
|
|
Stack[0].y := TempTPA[I].y;
|
|
While CurrentStack > -1 do
|
|
begin;
|
|
fx := stack[CurrentStack].x;
|
|
fy := stack[CurrentStack].y;
|
|
dec(CurrentStack);
|
|
Result[CurrentArray][Lengths[CurrentArray]].x := fx + x;
|
|
Result[CurrentArray][Lengths[CurrentArray]].y := fy + y;
|
|
inc(Lengths[CurrentArray]);
|
|
if PointsToFill[fx+1][fy] then
|
|
begin
|
|
inc(CurrentStack);Stack[CurrentStack].x := fx+1;Stack[Currentstack].y := fy;PointsToFill[fx+1][fy] := false;
|
|
end;
|
|
if PointsToFill[fx][fy+1] then
|
|
begin
|
|
inc(CurrentStack);Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy+1;PointsToFill[fx][fy+1] := false;
|
|
end;
|
|
if PointsToFill[fx-1][fy] then
|
|
begin
|
|
inc(CurrentStack);Stack[CurrentStack].x := fx-1;Stack[Currentstack].y := fy;PointsToFill[fx-1][fy] := false;
|
|
end;
|
|
if PointsToFill[fx][fy-1] then
|
|
begin
|
|
inc(CurrentStack);Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy-1;PointsToFill[fx][fy-1] := false;
|
|
end;
|
|
if PointsToFill[fx+1][fy+1] then
|
|
begin
|
|
inc(CurrentStack);Stack[CurrentStack].x := fx+1;Stack[Currentstack].y := fy+1;PointsToFill[fx+1][fy+1] := false;
|
|
end;
|
|
if PointsToFill[fx-1][fy-1] then
|
|
begin
|
|
inc(CurrentStack);Stack[CurrentStack].x := fx-1;Stack[Currentstack].y := fy-1;PointsToFill[fx-1][fy-1] := false;
|
|
end;
|
|
if PointsToFill[fx-1][fy+1] then
|
|
begin
|
|
inc(CurrentStack);Stack[CurrentStack].x := fx-1;Stack[Currentstack].y := fy+1;PointsToFill[fx-1][fy+1] := false;
|
|
end;
|
|
if PointsToFill[fx+1][fy-1] then
|
|
begin
|
|
inc(CurrentStack);Stack[CurrentStack].x := fx+1;Stack[Currentstack].y := fy-1;PointsToFill[fx+1][fy-1] := false;
|
|
end;
|
|
end;
|
|
SetLength(Result[CurrentArray],Lengths[CurrentArray]);
|
|
end;
|
|
SetLength(Stack,0);
|
|
SetLength(TempTPA,0);
|
|
SetLength(Lengths,0);
|
|
end;
|
|
|
|
{/\
|
|
Removes the points in the TPointArray Points that are not within the degrees
|
|
\\ SD (StartDegree) and ED (EndDegree) and the distances MinR (MinRadius) and
|
|
\\ MaxR (MaxRadius) from the origin (Mx, My).
|
|
/\}
|
|
|
|
procedure FilterPointsPie(var Points: TPointArray; const SD, ED, MinR, MaxR: Extended; Mx, My: Integer);
|
|
const
|
|
i180Pi = 57.29577951;
|
|
var
|
|
G: TPointArray;
|
|
I, L, T: Integer;
|
|
D, StartD, EndD: Extended;
|
|
cWise: Boolean;
|
|
begin
|
|
T := High(Points);
|
|
if (T < 0) then Exit;
|
|
SetLength(G, T + 1);
|
|
L := 0;
|
|
StartD := SD;
|
|
EndD := ED;
|
|
cWise := StartD > EndD;
|
|
while StartD > 360.0 do
|
|
StartD := StartD - 360.0;
|
|
while EndD > 360.0 do
|
|
EndD := EndD - 360.0;
|
|
while StartD < 0.0 do
|
|
StartD := StartD + 360.0;
|
|
while EndD < 0.0 do
|
|
EndD := EndD + 360.0;
|
|
if StartD > EndD then
|
|
SwapE(StartD, EndD);
|
|
for I := 0 to T do
|
|
begin
|
|
D := sqrt(Sqr(Points[I].X - Mx) + Sqr(Points[I].Y - My));
|
|
if( D <= MinR) or (D >= MaxR) then
|
|
Continue;
|
|
D := (ArcTan2(Points[I].Y - My, Points[I].X - Mx) * i180Pi) + 90;
|
|
if D < 0.0 then
|
|
D := D + 360.0;
|
|
if (not ((StartD <= D) and (EndD >= D))) xor CWise then
|
|
Continue;
|
|
G[L] := Points[I];
|
|
Inc(L);
|
|
end;
|
|
SetLength(G, L);
|
|
Points := G;
|
|
end;
|
|
|
|
{/\
|
|
Removes the points that don't have a dist between mindist/maxdist with (mx,my)
|
|
/\}
|
|
|
|
procedure FilterPointsDist(var Points: TPointArray; const MinDist,
|
|
MaxDist: Extended; Mx, My: Integer);
|
|
var
|
|
c,i,l : integer;
|
|
d : extended;
|
|
mind,maxd : extended;
|
|
begin
|
|
l := high(points);
|
|
c := 0;
|
|
mind := sqr(mindist);
|
|
maxd := sqr(maxdist);
|
|
for i := 0 to l do
|
|
begin
|
|
d := sqr(Points[i].x - mx) + sqr(points[i].y - my);
|
|
if (d >= mind) and (d <= maxd) then
|
|
begin
|
|
points[c] := points[i];
|
|
inc(c);
|
|
end;
|
|
end;
|
|
setlength(points,c);
|
|
end;
|
|
|
|
{/\
|
|
Removes the points in the TPointArray Points that are not on the line defined by angle, radius and center.
|
|
/\}
|
|
|
|
procedure FilterPointsLine(var Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer);
|
|
var
|
|
I, Hi, Ind, y: Integer;
|
|
P: TPointArray;
|
|
Box: TBox;
|
|
B: T2DBoolArray;
|
|
SinAngle,CosAngle : Extended;
|
|
begin
|
|
Ind := 0;
|
|
Box:= GetTPABounds(Points);
|
|
SinAngle := sin(Radial);
|
|
CosAngle := cos(Radial);
|
|
SetLength(B, max(Box.x2, Round(SinAngle * Radius + MX)) + 1);
|
|
y:= max(Box.x2, -Round(CosAngle * Radius) + MY);
|
|
for I:= 0 to High(B) do
|
|
begin;
|
|
SetLength(B[I], y + 1);
|
|
FillChar(B[i][0],y+1,0);
|
|
end;
|
|
Hi:= High(Points);
|
|
for I:= 0 to Hi do
|
|
B[Points[I].x][Points[I].y]:= True;
|
|
SetLength(P, Hi + 1);
|
|
for I:= 0 to Radius do
|
|
begin
|
|
if(B[Round(SinAngle * I) + MX][-Round(CosAngle * I) + MY])then
|
|
begin
|
|
P[Ind].X := Round(SinAngle * I) + MX;
|
|
P[Ind].Y := -Round(CosAngle * I) + MY;
|
|
inc(Ind);
|
|
end;
|
|
end;
|
|
SetLength(P, Ind);
|
|
Points:= P;
|
|
end;
|
|
|
|
{/\
|
|
Removes the points that are inside or outside the distance Dist from the point (x, y) from the TPointArray ThePoints.
|
|
/\}
|
|
|
|
function RemoveDistTPointArray(x, y, dist: Integer;const ThePoints: TPointArray; RemoveHigher: Boolean): TPointArray;
|
|
var
|
|
I, L, LL: integer;
|
|
begin;
|
|
L := 0;
|
|
LL := Length(ThePoints) -1;
|
|
SetLength(Result, LL + 1);
|
|
if RemoveHigher then
|
|
begin;
|
|
for I := 0 to LL do
|
|
if not (Round(sqrt(sqr(ThePoints[i].x - x)+sqr(ThePoints[i].y - y))) > Dist) then
|
|
begin;
|
|
Result[L] := ThePoints[i];
|
|
L := L + 1;
|
|
end;
|
|
end else
|
|
begin;
|
|
for I := 0 to LL do
|
|
if not (Round(sqrt(sqr(ThePoints[i].x - x)+sqr(ThePoints[i].y - y))) < Dist) then
|
|
begin;
|
|
Result[L] := ThePoints[i];
|
|
L := L + 1;
|
|
end;
|
|
end;
|
|
SetLength(Result,L);
|
|
end;
|
|
|
|
{/\
|
|
Returns the boundaries of the ATPA as a TBox.
|
|
/\}
|
|
|
|
function GetATPABounds(const ATPA: T2DPointArray): TBox;
|
|
var
|
|
I,II,L2,L : Integer;
|
|
begin;
|
|
FillChar(result,sizeof(TBox),0);
|
|
L := High(ATPA);
|
|
if (l < 0) then Exit;
|
|
For I := 0 to L do
|
|
if Length(ATPA[I]) > 0 then
|
|
begin;
|
|
Result.x1 := ATPA[I][0].x;
|
|
Result.y1 := ATPA[I][0].y;
|
|
Result.x2 := ATPA[I][0].x;
|
|
Result.y2 := ATPA[I][0].y;
|
|
end;
|
|
for I := 0 to L do
|
|
begin;
|
|
L2 := High(ATPA[I]);
|
|
for II := 0 to L2 do
|
|
begin;
|
|
if ATPA[i][II].x > Result.x2 then
|
|
Result.x2 := ATPA[i][II].x
|
|
else if ATPA[i][II].x < Result.x1 then
|
|
Result.x1 := ATPA[i][II].x;
|
|
if ATPA[i][II].y > Result.y2 then
|
|
Result.y2 := ATPA[i][II].y
|
|
else if ATPA[i][II].y < Result.y1 then
|
|
Result.y1 := ATPA[i][II].y;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{/\
|
|
Returns the boundaries of the TPA as a TBox.
|
|
/\}
|
|
|
|
function GetTPABounds(const TPA: TPointArray): TBox;
|
|
var
|
|
I,L : Integer;
|
|
begin;
|
|
FillChar(result,sizeof(TBox),0);
|
|
L := High(TPA);
|
|
if (l < 0) then Exit;
|
|
Result.x1 := TPA[0].x;
|
|
Result.y1 := TPA[0].y;
|
|
Result.x2 := TPA[0].x;
|
|
Result.y2 := TPA[0].y;
|
|
for I:= 1 to L do
|
|
begin;
|
|
if TPA[i].x > Result.x2 then
|
|
Result.x2 := TPA[i].x
|
|
else if TPA[i].x < Result.x1 then
|
|
Result.x1 := TPA[i].x;
|
|
if TPA[i].y > Result.y2 then
|
|
Result.y2 := TPA[i].y
|
|
else if TPA[i].y < Result.y1 then
|
|
Result.y1 := TPA[i].y;
|
|
end;
|
|
end;
|
|
|
|
{/\
|
|
Looks for the TPA SearchTPA in the TPA TotalTPA and returns the matched points
|
|
\\ to the TPA Matches. Returns true if there were atleast one match(es).
|
|
/\}
|
|
|
|
function FindTPAinTPA(SearchTPA : TPointArray; const TotalTPA: TPointArray; var Matches: TPointArray): Boolean;
|
|
var
|
|
Len, I,II,LenSearch,xOff,yOff : integer;
|
|
tx,ty,MatchCount : integer;
|
|
Screen : T2DBoolArray;
|
|
ScreenBox,SearchBox : TBox;
|
|
Found: Boolean;
|
|
begin;
|
|
Result := False;
|
|
Len := High(TotalTPA);
|
|
LenSearch := High(SearchTPA);
|
|
if LenSearch < 0 then Exit;
|
|
if Len < LenSearch then Exit;
|
|
MatchCount := 0;
|
|
ScreenBox := GetTPABounds(TotalTPA);
|
|
SearchBox := GetTPABounds(SearchTPA);
|
|
try
|
|
SetLength(Screen,ScreenBox.x2 + 1,ScreenBox.y2 + 1);
|
|
for i := ScreenBox.x2 downto 0 do
|
|
FillChar(Screen[i][0],screenbox.y2+1,0);
|
|
except
|
|
Exit;
|
|
end;
|
|
if (SearchBox.x1 > 0) or (SearchBox.y1 > 0) then
|
|
begin;
|
|
for I := 0 to LenSearch do
|
|
begin;
|
|
SearchTPA[I].x := SearchTPA[I].x - SearchBox.x1;
|
|
SearchTPA[I].y := SearchTPA[I].y - SearchBox.y1;
|
|
end;
|
|
SearchBox.x2 := SearchBox.x2 - SearchBox.x1;
|
|
SearchBox.y2 := SearchBox.y2 - SearchBox.y1;
|
|
SearchBox.x1 := 0;
|
|
SearchBox.y1 := 0;
|
|
end;
|
|
xOff := SearchBox.x2;
|
|
yOff := SearchBox.y2;
|
|
for I := 0 to LenSearch do
|
|
begin;
|
|
if (SearchTPA[I].x = 0) and (SearchTPA[I].y < yOff) then
|
|
yOff := SearchTPA[I].y;
|
|
if (SearchTPA[I].y = 0) and (SearchTPA[I].x < xOff) then
|
|
xOff := SearchTPA[I].x;
|
|
end;
|
|
for I := 0 to Len do
|
|
Screen[TotalTPA[I].x][TotalTPA[I].y] := True;
|
|
for I := 0 to Len do
|
|
begin;
|
|
tx := TotalTPA[I].x - xOff;
|
|
ty := TotalTPA[I].y;// - yOff;
|
|
if tx > 0 then
|
|
if ty > 0 then
|
|
if ((SearchBox.x2 + tx) <= ScreenBox.x2) and ((SearchBox.y2 + ty) <= ScreenBox.y2) then
|
|
begin;
|
|
Found := false;
|
|
For II := 0 to LenSearch do
|
|
if Screen[tx + SearchTPA[II].x ][ty + SearchTPA[II].y] = False then
|
|
begin
|
|
Found := True;
|
|
Break;
|
|
end;
|
|
if not found then
|
|
// if II > LenSearch then
|
|
begin;
|
|
MatchCount := MatchCount + 1;
|
|
SetLength(Matches,MatchCount);
|
|
Matches[MatchCount - 1].x := TotalTPA[I].x;
|
|
Matches[MatchCount - 1].y := TotalTPA[I].y;
|
|
end;
|
|
end;
|
|
end;
|
|
if (MatchCount > 0) then
|
|
Result := True;
|
|
end;
|
|
|
|
{/\
|
|
Read the description of FindTPAinTPA. Additional Height parameter.
|
|
/\}
|
|
|
|
function FindTextTPAinTPA(Height : integer;const SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;
|
|
var
|
|
Len, I,II,LenSearch,LenTPA,xOff,yOff,x,y: integer;
|
|
tx,ty,MatchCount : integer;
|
|
Found : boolean;
|
|
Screen : T2DBoolArray;
|
|
ScreenBox,SearchBox : TBox;
|
|
InversedTPA : TPointArray;
|
|
begin;
|
|
Result := False;
|
|
Len := High(TotalTPA);
|
|
LenSearch := High(SearchTPA);
|
|
if LenSearch < 0 then Exit;
|
|
if Len < LenSearch then Exit;
|
|
MatchCount := 0;
|
|
xOff := -5;
|
|
yOff := 0;
|
|
ScreenBox := GetTPABounds(TotalTPA);
|
|
SearchBox := GetTPABounds(SearchTPA);
|
|
if height > SearchBox.y2 then
|
|
Screenbox.y2 := Screenbox.y2 + (height - SearchBox.y2);
|
|
SearchBox.y2 := Height;
|
|
SetLength(Screen, SearchBox.x2 + 1,SearchBox.y2 + 1);
|
|
for i := SearchBox.x2 downto 0 do
|
|
FillChar(screen[i][0],SearchBox.y2+1,0);
|
|
SetLength(InversedTPA,(SearchBox.x2 + 1) * (Searchbox.y2 + 1));
|
|
for I := 0 to LenSearch do
|
|
Screen[ SearchTPA[I].x,SearchTPA[I].y] := True;
|
|
LenTPA := -1;
|
|
for y := 0 to SearchBox.y2 do
|
|
for x := 0 to SearchBox.x2 do
|
|
if Screen[X][Y] = False then
|
|
begin;
|
|
LenTPA := LenTPA + 1;
|
|
InversedTPA[LenTPA].x := x;
|
|
InversedTPA[LenTPA].y := y;
|
|
end;
|
|
for x := 0 to SearchBox.x2 do
|
|
begin;
|
|
for y := 0 to SearchBox.y2 do
|
|
if Screen[x][y] = True then
|
|
begin;
|
|
xOff := x;
|
|
yOff := y;
|
|
Break;
|
|
end;
|
|
if xOff >= 0 then
|
|
Break;
|
|
end;
|
|
try
|
|
SetLength(Screen,0);
|
|
SetLength(Screen,ScreenBox.x2 + 1,ScreenBox.y2 + 1);
|
|
for i := ScreenBox.x2 downto 0 do
|
|
FillChar(screen[i][0],screenbox.y2+1,0);
|
|
except
|
|
Exit;
|
|
end;
|
|
for I := 0 to Len do
|
|
Screen[TotalTPA[I].x][TotalTPA[I].y] := True;
|
|
for I := 0 to Len do
|
|
begin;
|
|
tx := TotalTPA[I].x - xOff;
|
|
ty := TotalTPA[I].y - yOff;
|
|
if tx > 0 then
|
|
if ty > 0 then
|
|
if ((SearchBox.x2 + tx) <= ScreenBox.x2) and ((SearchBox.y2 + ty) <= ScreenBox.y2) then
|
|
begin;
|
|
Found := false;
|
|
For II := 0 to LenSearch do
|
|
if Screen[tx + SearchTPA[II].x ][ty + SearchTPA[II].y] = False then
|
|
begin
|
|
Found := true;
|
|
Break;
|
|
end;
|
|
if (not Found) then
|
|
begin;
|
|
Found := false;
|
|
For II := 0 to LenTPA do
|
|
if Screen[tx + InversedTPA[II].x ][ty + InversedTPA[II].y] = True then
|
|
begin
|
|
Found := true;
|
|
Break;
|
|
end;
|
|
if (not Found) then
|
|
begin;
|
|
MatchCount := MatchCount + 1;
|
|
SetLength(Matches,MatchCount);
|
|
Matches[MatchCount - 1].x := TotalTPA[I].x;
|
|
Matches[MatchCount - 1].y := TotalTPA[I].y;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
if (MatchCount > 0) then
|
|
Result := True;
|
|
end;
|
|
|
|
{/\
|
|
Finds the points that exist in all TPA's in the ATPA.
|
|
/\}
|
|
|
|
function GetSamePointsATPA(const ATPA : T2DPointArray; var Matches : TPointArray) : boolean;
|
|
var
|
|
I,ii,Len,MatchesC : integer;
|
|
MinBox,TempBox : TBox;
|
|
Grid : Array of Array of LongWord;
|
|
CompareValue : Longword;
|
|
W,H,x,y: integer;
|
|
begin;
|
|
len := high(ATPA);
|
|
result := false;
|
|
if len >= 31 then
|
|
begin;
|
|
Writeln('You cannot have more than 32 TPA''s in your ATPA for this function');
|
|
exit;
|
|
end;
|
|
if len <= 0 then
|
|
begin;
|
|
Writeln('You''d need more than 1 TPA for this function');
|
|
exit;
|
|
end;
|
|
MinBox.x1 := 0;
|
|
MinBox.y1 := 0;
|
|
MinBox.x2 := MaxInt;
|
|
MinBox.y2 := MaxInt;
|
|
for i := 0 to len do
|
|
if Length(ATPA[i]) = 0 then
|
|
Exit
|
|
else
|
|
begin
|
|
TempBox := GetTPABounds(ATPA[i]);
|
|
MinBox.x1 := Max(MinBox.x1,TempBox.x1);
|
|
MinBox.y1 := Max(MinBox.y1,TempBox.y1);
|
|
MinBox.x2 := Min(MinBox.x2,TempBox.x2);
|
|
MinBox.y2 := Min(MinBox.y2,TempBox.y2);
|
|
end;
|
|
w := MinBox.x2-minbox.x1;
|
|
h := minbox.y2 - minbox.y1;
|
|
Writeln(format('(%d,%d,%d,%d)',[minbox.x1,minbox.y1,minbox.x2,minbox.y2]));
|
|
SetLength(Grid,w + 1);
|
|
for i := (W) downto 0 do
|
|
begin;
|
|
setlength(grid[i],H + 1);
|
|
FillChar(grid[i][0],SizeOf(LongWord) * (H + 1),0);
|
|
end;
|
|
for i := 0 to len do
|
|
for ii := high(ATPA[i]) downto 0 do
|
|
if (ATPA[i][ii].x >= MinBox.x1) and (ATPA[i][ii].x <= MinBox.x2) and
|
|
(ATPA[i][ii].y >= MinBox.y1) and (ATPA[i][ii].y <= MinBox.y2) then
|
|
Grid[ATPA[i][ii].x-MinBox.x1][ATPA[i][ii].y-MinBox.y1] :=
|
|
Grid[ATPA[i][ii].x-MinBox.x1][ATPA[i][ii].y-MinBox.y1] or (1 shl i);//Set that this TPA has this point..
|
|
CompareValue := 0;
|
|
for i := 0 to len do
|
|
CompareValue := CompareValue or (1 shl i);
|
|
SetLength(matches, (W+1) * (H+ 1));
|
|
MatchesC := 0;
|
|
for y := 0 to H do
|
|
for x := 0 to W do
|
|
if Grid[x][y] = CompareValue then
|
|
begin;
|
|
Matches[MatchesC].x := x + minbox.x1;
|
|
Matches[MatchesC].y := y + minbox.y1;
|
|
inc(MatchesC);
|
|
end;
|
|
result := (MatchesC <> 0);
|
|
setlength(matches,MatchesC);
|
|
end;
|
|
{/\
|
|
Finds the possible gaps in the TPointArray TPA and results the gaps as a T2DPointArray.
|
|
\\ Considers as a gap if the gap length is >= MinPixels.
|
|
\\ Only horizontal, sorry folks.
|
|
/\}
|
|
|
|
function FindGapsTPA(const TPA: TPointArray; MinPixels: Integer): T2DPointArray;
|
|
var
|
|
Len,TotalLen,LenRes,I,II,III : integer;
|
|
Screen : T2DBoolArray;
|
|
Height,Width : Integer;
|
|
Box : TBox;
|
|
begin;
|
|
Len := High(TPA);
|
|
if Len < 0 then exit;
|
|
Box := GetTPABounds(TPA);
|
|
Height := Box.y2 - Box.y1;
|
|
Width := Box.x2 - Box.x1;
|
|
LenRes := 0;
|
|
III := 0;
|
|
try
|
|
SetLength(Screen,Width + 1,Height + 1);
|
|
for i := 0 to Width do
|
|
FillChar(Screen[i][0],(Height+1),0);
|
|
except
|
|
Exit;
|
|
end;
|
|
For I := 0 to Len do
|
|
Screen[TPA[I].x - Box.x1][TPA[I].y - Box.y1] := True;
|
|
SetLength(result,1);
|
|
SetLength(Result[0],Len+1);
|
|
TotalLen := 0;
|
|
for I := 0 to Width do
|
|
begin;
|
|
for II := 0 to Height do
|
|
if Screen[I][II]=True then
|
|
begin;
|
|
Result[TotalLen][LenRes].x := I + Box.x1;
|
|
Result[TotalLen][LenRes].y := II + Box.y1;
|
|
LenRes := LenRes + 1;
|
|
III := I;
|
|
end;
|
|
if LenRes = 0 then
|
|
III := I
|
|
else
|
|
if (I - III) > MinPixels then
|
|
begin;
|
|
III := I;
|
|
SetLength(Result[TotalLen],LenRes);
|
|
LenRes := 0;
|
|
TotalLen := TotalLen + 1;
|
|
SetLength(Result,TotalLen + 1);
|
|
SetLength(Result[TotalLen],Len + 1);
|
|
end;
|
|
end;
|
|
SetLength(Result[TotalLen],LenRes);
|
|
end;
|
|
|
|
|
|
|
|
{/\
|
|
Sorts all points in tpa by distance from degree (Deg) and distance from mx and my.
|
|
\\ Sortup will return closest distance to mx and my first.
|
|
\\ Distance will be sorted first (RadialWalk style).
|
|
/\}
|
|
|
|
procedure SortCircleWise(var tpa: TPointArray; const cx, cy, StartDegree: Integer; SortUp, ClockWise: Boolean);
|
|
const
|
|
i180Pi = 57.29577951;
|
|
var
|
|
i, l, td, sd: Integer;
|
|
Dist, Deg: TIntegerArray;
|
|
begin
|
|
l := Length(tpa);
|
|
if (l = 0) then Exit;
|
|
sd := StartDegree;
|
|
while (sd > 360) do
|
|
sd := (sd - 360);
|
|
sd := (360 - sd);
|
|
SetLength(Dist, l);
|
|
SetLength(Deg, l);
|
|
for i := 0 to l -1 do
|
|
Dist[i] := Round(Hypot(tpa[i].x - cx, tpa[i].y - cy));
|
|
QuickTPASort(Dist, tpa, 0, l -1, SortUp);
|
|
if (l = 1) then Exit;
|
|
for i := 0 to l -1 do
|
|
begin
|
|
td := Round(ArcTan2(tpa[i].y - cy, tpa[i].x - cx) * i180Pi) + 90;
|
|
if (td < 0) then
|
|
td := td + 360;
|
|
if ClockWise then
|
|
Deg[i] := Round(sd + td) mod 360
|
|
else
|
|
Deg[i] := 360 - Round(sd + td) mod 360;
|
|
end;
|
|
i := 1;
|
|
td := 0;
|
|
Dec(l);
|
|
while (i < l) do
|
|
begin
|
|
while (i < l) and (Abs(Dist[td] - Dist[i]) <= 1) do Inc(i);
|
|
QuickTPASort(Deg, tpa, td, i, False);
|
|
Inc(i);
|
|
td := i;
|
|
end;
|
|
if (td < l) then
|
|
QuickTPASort(Deg, tpa, td, l, False);
|
|
end;
|
|
|
|
{/\
|
|
Sorts all points in tpa by distance from degree (Deg) and distance from mx and my.
|
|
\\ Sortup will return closest distance to mx and my first.
|
|
\\ Degree will be sorted first (LinearWalk style).
|
|
/\}
|
|
|
|
procedure LinearSort(var tpa: TPointArray; cx, cy, sd: Integer; SortUp: Boolean);
|
|
const
|
|
i180Pi = 57.29577951;
|
|
var
|
|
i, l, td: Integer;
|
|
Dist, Deg: TIntegerArray;
|
|
begin
|
|
l := Length(tpa);
|
|
if (l = 0) then Exit;
|
|
while (sd > 360) do
|
|
sd := (sd - 360);
|
|
SetLength(Dist, l);
|
|
SetLength(Deg, l);
|
|
for i := 0 to l -1 do
|
|
begin
|
|
td := Round(ArcTan2(tpa[i].y - cy, tpa[i].x - cx) * i180Pi) + 90;
|
|
if (td < 0) then
|
|
td := td + 360;
|
|
Deg[i] := Min(Abs(sd - td), Min(Abs(sd - (td + 360)), Abs((sd + 360) - td)))
|
|
end;
|
|
QuickTPASort(Deg, tpa, 0, l -1, True);
|
|
if (l = 1) then Exit;
|
|
for i := 0 to l -1 do
|
|
Dist[i] := Round(Hypot(tpa[i].x - cx, tpa[i].y - cy));
|
|
i := 1;
|
|
td := 0;
|
|
Dec(l);
|
|
while (i < l) do
|
|
begin
|
|
while (i < l) and (Abs(Deg[td] - Deg[i]) <= 3) do Inc(i);
|
|
QuickTPASort(Dist, tpa, td, i, SortUp);
|
|
Inc(i);
|
|
td := i;
|
|
end;
|
|
if (td < l) then
|
|
QuickTPASort(Dist, tpa, td, l, SortUp);
|
|
end;
|
|
|
|
{/\
|
|
Merges the TPointArrays of the T2DPointArray ATPA in to one TPA.
|
|
/\}
|
|
|
|
Function MergeATPA(const ATPA: T2DPointArray): TPointArray;
|
|
var
|
|
I, II, Len, TempL, CurrentL: integer;
|
|
begin;
|
|
Len := High(ATPA);
|
|
if Len < 0 then
|
|
begin
|
|
SetLength(Result, 0);
|
|
Exit;
|
|
end;
|
|
CurrentL := 0;
|
|
For I:= 0 to Len do
|
|
begin;
|
|
TempL := High(ATPA[I]);
|
|
if TempL < 0 then
|
|
Continue;
|
|
TempL := Templ + CurrentL + 1;
|
|
Setlength(Result, TempL+1);
|
|
For II := CurrentL to TempL do
|
|
Result[II] := ATPA[I][II - CurrentL];
|
|
CurrentL := TempL;
|
|
end;
|
|
SetLength(Result,CurrentL);
|
|
end;
|
|
|
|
|
|
procedure AppendTPA(var TPA: TPointArray; const ToAppend: TPointArray);
|
|
var
|
|
l,lo,i : integer;
|
|
begin
|
|
l := high(ToAppend);
|
|
lo := length(TPA);
|
|
setlength(TPA,lo + l + 1);
|
|
for i := 0 to l do
|
|
TPA[i + lo] := ToAppend[i];
|
|
end;
|
|
|
|
{/\
|
|
Returns a TPointArray of a the full given Box.
|
|
/\}
|
|
function TPAFromBox(const Box : TBox) : TPointArray;
|
|
var
|
|
x, y: integer;
|
|
l : integer;
|
|
begin;
|
|
SetLength(Result, (Box.x2 - Box.x1 + 1) * (Box.y2 - Box.y1 + 1));
|
|
l := 0;
|
|
For x := box.x1 to Box.x2 do
|
|
for y := box.y1 to box.y2 do
|
|
begin;
|
|
Result[l].x := x;
|
|
Result[l].y := y;
|
|
inc(l);
|
|
end;
|
|
end;
|
|
|
|
{/\
|
|
Rotate the given TPA with A radians.
|
|
/\}
|
|
|
|
Function RotatePoints(Const P: TPointArray; A, cx, cy: Extended): TPointArray ;
|
|
|
|
Var
|
|
I, L: Integer;
|
|
CosA,SinA : extended;
|
|
|
|
Begin
|
|
L := High(P);
|
|
SetLength(Result, L + 1);
|
|
CosA := Cos(a);
|
|
SinA := Sin(a);
|
|
For I := 0 To L Do
|
|
Begin
|
|
Result[I].X := Trunc(cx + CosA * (p[i].x - cx) - SinA * (p[i].y - cy));
|
|
Result[I].Y := Trunc(cy + SinA * (p[i].x - cx) + CosA * (p[i].y - cy));
|
|
End;
|
|
// I recon it's faster than Point().
|
|
End;
|
|
|
|
{/\
|
|
Rotate the given Point with A radians.
|
|
/\}
|
|
|
|
Function RotatePoint(Const p: TPoint; angle, mx, my: Extended): TPoint;
|
|
|
|
Begin
|
|
Result.X := Trunc(mx + cos(angle) * (p.x - mx) - sin(angle) * (p.y - my));
|
|
Result.Y := Trunc(my + sin(angle) * (p.x - mx) + cos(angle) * (p.y- my));
|
|
End;
|
|
|
|
{/\
|
|
Returns the edges of the given TPA.
|
|
/\}
|
|
|
|
function FindTPAEdges(const p: TPointArray): TPointArray;
|
|
var
|
|
b: T2DBoolArray;
|
|
i, x, y, l, c: Integer;
|
|
Box: TBox;
|
|
begin
|
|
SetLength(Result, 0);
|
|
l := Length(p);
|
|
if (l = 0) then Exit;
|
|
Box := GetTPABounds(p);
|
|
x := (Box.x2 - Box.x1) + 3;
|
|
y := (Box.y2 - Box.y1) + 3;
|
|
SetLength(b, x);
|
|
for i := 0 to x -1 do
|
|
begin
|
|
SetLength(b[i], y);
|
|
FillChar(b[i][0],y,0);
|
|
end;
|
|
for i := 0 to l -1 do
|
|
b[p[i].x +1 - Box.x1][p[i].y +1 - Box.y1] := True;
|
|
SetLength(Result, l);
|
|
c := 0;
|
|
for i := 0 to l -1 do
|
|
begin
|
|
x := -1;
|
|
while (x <= 1) do
|
|
begin
|
|
for y := -1 to 1 do
|
|
try
|
|
if not b[p[i].x + 1 + x - Box.x1][p[i].y + 1 + y - Box.y1] then
|
|
begin
|
|
Result[c] := p[i];
|
|
Inc(c);
|
|
x := 2;
|
|
Break;
|
|
end;
|
|
except end;
|
|
Inc(x);
|
|
end;
|
|
end;
|
|
SetLength(Result, c);
|
|
end;
|
|
|
|
{/\
|
|
Results true if a point is in a TPointArray.
|
|
Notes: In actuallys means IN the array, not in the box shaped by the array.
|
|
/\}
|
|
|
|
function PointInTPA(const p: TPoint;const arP: TPointArray): Boolean;
|
|
var
|
|
i, l: Integer;
|
|
begin
|
|
l := High(arP);
|
|
if l < 0 then
|
|
Exit(false);
|
|
Result := True;
|
|
for i := 0 to l do
|
|
if (arP[i].x = p.x) and (arP[i].y = p.y) then
|
|
Exit;
|
|
Result := False;
|
|
end;
|
|
|
|
{/\
|
|
Removes the given ClearPoints from arP.
|
|
/\}
|
|
|
|
function ClearTPAFromTPA(const arP, ClearPoints: TPointArray): TPointArray;
|
|
var
|
|
i, j, l, l2: Integer;
|
|
Found: Boolean;
|
|
begin
|
|
Setlength(result,0);
|
|
l := High(arP);
|
|
l2 := High(ClearPoints);
|
|
for i := 0 to l do
|
|
begin
|
|
Found := false;
|
|
for j := 0 to l2 do
|
|
if (arP[i].x = ClearPoints[j].x) and (arP[i].y = ClearPoints[j].y) then
|
|
begin
|
|
Found := True;
|
|
Break;
|
|
end;
|
|
if not found then
|
|
// if (j = l2 + 1) then
|
|
begin
|
|
SetLength(Result, Length(Result) + 1);
|
|
Result[High(Result)] := arP[i];
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{/\
|
|
Removes all the doubles point from a TPA.
|
|
/\}
|
|
|
|
procedure ClearDoubleTPA(var TPA: TPointArray);
|
|
var
|
|
I, II, L: Integer;
|
|
Swappie: TPoint;
|
|
begin
|
|
L := High(TPA);
|
|
for I := 0 To L Do
|
|
for II := I + 1 To L Do
|
|
if ((TPA[I].X = TPA[II].X) And (TPA[I].Y = TPA[II].Y)) then
|
|
begin
|
|
Swappie := TPA[L];
|
|
TPA[L] := TPA[II];
|
|
TPA[II] := Swappie;
|
|
L := L - 1;
|
|
end;
|
|
SetLength(TPA, L + 1);
|
|
end;
|
|
|
|
{/\
|
|
Uses Box to define an area around TotalTPA.
|
|
Every point that is not in TotalTPA, but is in Box, is added to the Result.
|
|
\\ This can be very handy if you want for example, can get all the colors of the background, but not of the actual object.
|
|
\\ If you pass this all the colors of the background, it will returns the points of the object.
|
|
/\}
|
|
|
|
Function ReturnPointsNotInTPA(Const TotalTPA: TPointArray; const Box: TBox): TPointArray;
|
|
var
|
|
x, y, w, h, i, l: integer;
|
|
B: T2DBoolArray;
|
|
begin;
|
|
w := Box.x2 - Box.x1;
|
|
h := Box.y2 - Box.y1;
|
|
if (w = 0) and (h = 0) then
|
|
Exit;
|
|
SetLength(b, w + 1, h + 1);
|
|
for i := w downto 0 do
|
|
FillChar(b[i][0],h+1,0);
|
|
l := High(TotalTPA);
|
|
x := 0;
|
|
for i := 0 to l do
|
|
if ((TotalTPA[i].x >= Box.x1) and (TotalTPA[i].x <= Box.x2) and
|
|
(TotalTPA[i].y >= Box.y1) and (TotalTPA[i].y <= Box.y2)) then
|
|
begin;
|
|
Inc(x);
|
|
B[TotalTPA[i].x-Box.x1][TotalTPA[i].y-Box.y1] := True;
|
|
end;
|
|
if x = 0 then
|
|
Exit;
|
|
SetLength(result,(w + 1) * (h + 1) - x);
|
|
i := 0;
|
|
for x := 0 to w do
|
|
for y := 0 to h do
|
|
if not B[x][y] then
|
|
try
|
|
Result[i].x := x + Box.x1;
|
|
Result[i].y := y + Box.y1;
|
|
Inc(i);
|
|
except end;
|
|
SetLength(b, 0);
|
|
SetLength(Result, i);
|
|
end;
|
|
|
|
{/\
|
|
Sorts a TPointArray by either X or Y. You have to define the max Point as well.
|
|
/\}
|
|
|
|
Procedure TPACountSort(Var TPA: TPointArray;const max: TPoint;Const SortOnX : Boolean);
|
|
Var
|
|
c: T2DIntegerArray;
|
|
I, II, III, hTPA, cc: Integer;
|
|
Begin
|
|
hTPA := High(TPA);
|
|
if hTPA < 1 then
|
|
Exit;
|
|
SetLength(c, max.X + 1,max.Y + 1);
|
|
for i := max.x downto 0 do
|
|
FillChar(c[i][0],(max.y+1)*sizeof(Integer),0);
|
|
For I := 0 To hTPA Do
|
|
c[TPA[I].x][TPA[I].y] := c[TPA[i].x][TPA[i].y] + 1;
|
|
|
|
cc := 0;
|
|
if SortOnX then
|
|
begin
|
|
For I := 0 To max.X Do
|
|
For II := 0 To max.Y Do
|
|
Begin
|
|
For III := 0 To c[I][II] - 1 Do
|
|
Begin
|
|
TPA[cc].x := I;
|
|
TPA[cc].y := II;
|
|
cc := cc + 1;
|
|
End;
|
|
End;
|
|
end else
|
|
begin;
|
|
For II := 0 To max.Y Do
|
|
For I := 0 To max.X Do
|
|
Begin
|
|
For III := 0 To c[I][II] - 1 Do
|
|
Begin
|
|
TPA[cc].x := I;
|
|
TPA[cc].y := II;
|
|
cc := cc + 1;
|
|
End;
|
|
End;
|
|
end;
|
|
End;
|
|
|
|
|
|
{/\
|
|
Sorts a TPointArray by either X or Y. Allows one to pass a Base.
|
|
/\}
|
|
|
|
Procedure TPACountSortBase(Var TPA: TPointArray;const maxx, base: TPoint; const SortOnX : Boolean);
|
|
Var
|
|
c: T2DIntegerArray;
|
|
I, II, III, hTPA, cc: Integer;
|
|
Max : TPoint;
|
|
Begin
|
|
hTPA := High(TPA);
|
|
if hTPA < 1 then
|
|
Exit;
|
|
max.X := maxx.X - base.X;
|
|
max.Y := maxx.Y - base.Y;
|
|
SetLength(c, max.X + 1,max.Y + 1);
|
|
for i := max.x downto 0 do
|
|
FillChar(c[i][0],(max.y+1)*sizeof(integer),0);
|
|
hTPA := High(TPA);
|
|
For I := 0 To hTPA Do
|
|
c[TPA[I].x - base.X][TPA[I].y - base.Y] := c[TPA[i].x- base.X][TPA[i].y- base.Y] + 1;
|
|
|
|
cc := 0;
|
|
if SortOnX then
|
|
begin
|
|
For I := 0 To max.X Do
|
|
For II := 0 To max.Y Do
|
|
Begin
|
|
For III := 0 To c[I][II] - 1 Do
|
|
Begin
|
|
TPA[cc].x := I + base.X;
|
|
TPA[cc].y := II + base.Y;
|
|
cc := cc + 1;
|
|
End;
|
|
End;
|
|
end else
|
|
begin;
|
|
For II := 0 To max.Y Do
|
|
For I := 0 To max.X Do
|
|
Begin
|
|
For III := 0 To c[I][II] - 1 Do
|
|
Begin
|
|
TPA[cc].x := I + base.X;
|
|
TPA[cc].y := II + base.Y;
|
|
cc := cc + 1;
|
|
End;
|
|
End;
|
|
end;
|
|
End;
|
|
|
|
{/\
|
|
Returns the sum of all integers in the array
|
|
/\}
|
|
function SumIntegerArray(const Ints : TIntegerArray): Integer;
|
|
var
|
|
I, H: Integer;
|
|
begin
|
|
Result := 0;
|
|
H := High(Ints);
|
|
for I := 0 to H do
|
|
Result := Result + Ints[I];
|
|
end;
|
|
|
|
{/\
|
|
Inverts the IntegerArray, last becomes first etc..
|
|
/\}
|
|
procedure InvertTIA(var tI: TIntegerArray);
|
|
var
|
|
Temp: TIntegerArray;
|
|
i, h: Integer;
|
|
begin
|
|
h := High(tI);
|
|
Temp := tI;
|
|
for i := 0 to h do
|
|
tI[i] := Temp[h - i];
|
|
end;
|
|
|
|
{/\
|
|
Results the Average of an IntegerArray
|
|
/\}
|
|
|
|
function AverageTIA(const tI: TIntegerArray): Integer;
|
|
begin
|
|
try Result := (SumIntegerArray(tI) div Length(tI)); except Result := 0; end;
|
|
end;
|
|
|
|
{/\
|
|
Results the Average of an ExtendedArray
|
|
/\}
|
|
function AverageExtended(const tE: TExtendedArray): Extended;
|
|
var
|
|
i, h: Integer;
|
|
begin
|
|
Result := 1;
|
|
try
|
|
h := High(tE);
|
|
for i := 0 to h do
|
|
Result := (Result * tE[i]);
|
|
Result := Power(Result, 1/(h + 1));
|
|
except
|
|
Result := 0.0;
|
|
end;
|
|
end;
|
|
|
|
{/\
|
|
Returns true if the two inputed TPA's are exactly the same (so the order matters)
|
|
/\}
|
|
function SameTPA(const aTPA, bTPA: TPointArray): Boolean;
|
|
var
|
|
I: LongInt;
|
|
h : integer;
|
|
begin
|
|
Result := False;
|
|
if (Length(aTPA) <> Length(bTPA)) then
|
|
Exit;
|
|
h := high(ATPA);
|
|
for I := Low(aTPA) to h do
|
|
if ((aTPA[I].X <> bTPA[I].X) or (aTPA[I].Y <> bTPA[I].Y)) then
|
|
Exit;
|
|
Result := True;
|
|
end;
|
|
{/\
|
|
Returns true if the TPA is found as one of ATPA's sub-TPA's.. And again, order matters
|
|
/\}
|
|
function TPAInATPA(const TPA: TPointArray;const InATPA: T2DPointArray; var Index: LongInt): Boolean;
|
|
var
|
|
I: LongInt;
|
|
h : integer;
|
|
begin
|
|
Result := True;
|
|
h := high(inATPA);
|
|
for I := Low(InATPA) to h do
|
|
if (SameTPA(TPA, InATPA[I])) then
|
|
begin
|
|
Index := I;
|
|
Exit;
|
|
end;
|
|
Result := False;
|
|
end;
|
|
|
|
procedure OffsetTPA(var TPA: TPointArray; const Offset: TPoint);
|
|
var
|
|
i : integer;
|
|
begin
|
|
for i := high(TPA) downto 0 do
|
|
begin;
|
|
inc(TPA[i].x,offset.x);
|
|
inc(TPA[i].y,offset.y);
|
|
end;
|
|
end;
|
|
|
|
procedure OffsetATPA(var ATPA: T2DPointArray; const Offset: TPoint);
|
|
var
|
|
i : integer;
|
|
begin
|
|
for i := high(ATPA) downto 0 do
|
|
OffsetTPA(ATPA[i],Offset);
|
|
end;
|
|
|
|
|
|
end.
|
|
|