From 2a864cac75aa0c576e9283bce5d10c0715c5535f Mon Sep 17 00:00:00 2001 From: Raymond Date: Fri, 18 Dec 2009 16:16:47 +0000 Subject: [PATCH] Added some functions to Bitmaps, made a start with exporting TMufasaBitmap.. Oh and added some TPA functions, not yet exported to PS. git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@288 3f818213-9676-44b0-a9b4-5e4c4e03d09d --- Units/MMLAddon/PSInc/Wrappers/bitmap.inc | 14 + Units/MMLAddon/PSInc/psexportedmethods.inc | 7 +- Units/MMLAddon/mmlpsthread.pas | 20 + Units/MMLAddon/tpa.pas | 1569 ++++++++++++++++++++ Units/MMLCore/bitmaps.pas | 46 +- Units/MMLCore/mufasatypes.pas | 2 + Units/MMLCore/mufasatypesutil.pas | 51 + 7 files changed, 1706 insertions(+), 3 deletions(-) create mode 100644 Units/MMLCore/mufasatypesutil.pas diff --git a/Units/MMLAddon/PSInc/Wrappers/bitmap.inc b/Units/MMLAddon/PSInc/Wrappers/bitmap.inc index 7ceb0e8..4662f6c 100644 --- a/Units/MMLAddon/PSInc/Wrappers/bitmap.inc +++ b/Units/MMLAddon/PSInc/Wrappers/bitmap.inc @@ -106,6 +106,20 @@ begin; CurrThread.Client.MBitmaps.Bmp[Bmp].FastSetPixels(TPA,Colors); end; +procedure DrawTPABitmap(bitmap : integer; TPA : TPointArray; Color : integer); +begin + CurrThread.Client.MBitmaps.Bmp[Bitmap].DrawTPA(TPA,Color); +end; +procedure DrawATPABitmap(bitmap : integer; ATPA : T2DPointArray); +begin + CurrThread.Client.MBitmaps.Bmp[bitmap].DrawATPA(ATPA); +end; + +procedure DrawATPABitmapEx(bitmap : integer; ATPA : T2DPointArray; Colors : TIntegerArray); +begin + CurrThread.Client.MBitmaps.Bmp[bitmap].DrawATPA(ATPA,Colors); +end; + procedure FastDrawClear(bmp : integer; Color : TColor); begin; CurrThread.Client.MBitmaps.Bmp[bmp].FastDrawClear(Color); diff --git a/Units/MMLAddon/PSInc/psexportedmethods.inc b/Units/MMLAddon/PSInc/psexportedmethods.inc index 116eecf..ac1dcf1 100644 --- a/Units/MMLAddon/PSInc/psexportedmethods.inc +++ b/Units/MMLAddon/PSInc/psexportedmethods.inc @@ -110,8 +110,8 @@ AddFunction(@FindColorsToleranceOptimised,'function FindColorsToleranceOptimised AddFunction(@FindColorsTolerance,'function FindColorsTolerance(out Points: TPointArray; Color, xs, ys, xe, ye, Tolerance: Integer): Boolean;'); AddFunction(@FindColorSpiral,'function FindColorSpiral(var x, y: Integer; color, xs, ys, xe, ye: Integer): Boolean;'); AddFunction(@FindColorsSpiralTolerance,'function FindColorsSpiralTolerance(x, y: Integer; out Points: TPointArray; color, xs, ys, xe, ye: Integer; Tolerance: Integer) : boolean;'); -AddFunction(@SetColorToleranceSpeed, 'procedure SetColorToleranceSpeed(cts: integer);'); -AddFunction(@FindColoredArea, 'function FindColoredArea(var x, y : Integer; color, xs, ys, xe, ye, MinArea : Integer): Boolean'); +AddFunction(@SetColorToleranceSpeed, 'procedure SetColorToleranceSpeed(cts: integer);'); +AddFunction(@FindColoredArea, 'function FindColoredArea(var x, y : Integer; color, xs, ys, xe, ye, MinArea : Integer): Boolean'); AddFunction(@FindColoredAreaTolerance, 'function FindColoredAreaTolerance(var x, y : Integer; color, xs, ys, xe, ye, MinArea, Tolerance : Integer): Boolean'); AddFunction(@ColorToHSL, 'procedure ColorToHSL(c: integer; out r,g,b: extended);'); @@ -177,6 +177,9 @@ AddFunction(@CreateBitmapMask,'function CreateBitmapMask(Bitmap : integer) : TMa AddFunction(@FindMaskTolerance,'function FindMaskTolerance(mask: TMask; out x, y: Integer; xs,ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;'); AddFunction(@FindBitmapMaskTolerance,'function FindBitmapMaskTolerance(mask: Integer; out x, y: Integer; xs, ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;'); AddFunction(@FindDeformedBitmapToleranceIn,'function FindDeformedBitmapToleranceIn(bitmap: integer; out x,y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer; Range: Integer; AllowPartialAccuracy: Boolean; out accuracy: Extended): Boolean;'); +AddFunction(@DrawTPABitmap,'procedure DrawTPABitmap(bitmap : integer; TPA : TPointArray; Color : integer);'); +AddFunction(@DrawATPABitmap,'procedure DrawATPABitmap(bitmap : integer; ATPA : T2DPointArray);'); +AddFunction(@DrawATPABitmapEx,'procedure DrawATPABitmapEx(bitmap : integer; ATPA : T2DPointArray; Colors : TIntegerArray);'); {tpa} AddFunction(@SplitTPAEx,'function SplitTPAEx(arr: TPointArray; w, h: Integer): T2DPointArray;'); diff --git a/Units/MMLAddon/mmlpsthread.pas b/Units/MMLAddon/mmlpsthread.pas index 597e03c..ddb5e00 100644 --- a/Units/MMLAddon/mmlpsthread.pas +++ b/Units/MMLAddon/mmlpsthread.pas @@ -303,6 +303,24 @@ begin Result := True; end; +procedure SIRegister_Mufasa(cl: TPSPascalCompiler); +begin; + with cl.AddClassN(cl.FindClass('TObject'),'TMufasaBitmap') do + begin; + RegisterMethod('function SaveToFile(const FileName : string) :boolean;'); + RegisterMethod('procedure LoadFromFile(const FileName : string);'); + end; +end; + +procedure RIRegister_Mufasa(cl: TPSRuntimeClassImporter); +begin; + with cl.Add(TMufasaBitmap) do + begin + RegisterMethod(@TMufasaBitmap.SaveToFile, 'SAVETOFILE'); + RegisterConstructor(@TMufasaBitmap.LoadFromFile, 'LOADFROMFILE'); + end; +end; + procedure TMMLPSThread.OnCompImport(Sender: TObject; x: TPSPascalCompiler); begin SIRegister_Std(x); @@ -312,6 +330,7 @@ begin SIRegister_stdctrls(x); SIRegister_Forms(x); SIRegister_ExtCtrls(x); + SIRegister_Mufasa(x); end; procedure TMMLPSThread.OnExecImport(Sender: TObject; se: TPSExec; @@ -324,6 +343,7 @@ begin RIRegister_stdctrls(x); RIRegister_Forms(x); RIRegister_ExtCtrls(x); + RIRegister_Mufasa(x); end; procedure TMMLPSThread.OutputMessages; diff --git a/Units/MMLAddon/tpa.pas b/Units/MMLAddon/tpa.pas index f0a6726..8ccc30e 100644 --- a/Units/MMLAddon/tpa.pas +++ b/Units/MMLAddon/tpa.pas @@ -28,10 +28,772 @@ interface uses Classes, SysUtils, mufasatypes; + +function FastTPASort(TPA: TPointArray; Dists: TIntegerArray; maxDist: Integer; CloseFirst: Boolean): TPointArray; + +//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(a: TPointArray; w, h: Integer): TPointArray; +function ReArrangeandShortenArray(a: TPointArray; Dist: Integer): TPointArray; +function TPAtoATPAEx(TPA: TPointArray; w, h: Integer): T2DPointArray; +function TPAtoATPA(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(TPA: TPointArray; var x, y: Integer): Boolean; +function MiddleTPA(tpa: TPointArray): TPoint; +procedure SortATPASize(var a: T2DPointArray; const BigFirst: Boolean); +procedure SortATPAFromSize(var a: T2DPointArray; const Size: Integer; CloseFirst: Boolean); +function CombineTPA(Ar1, Ar2: TPointArray): TPointArray; +function CombineIntArray(Ar1, Ar2: TIntegerArray): TIntegerArray; +function InIntArrayEx(a: TIntegerArray; var Where: Integer; const Number: Integer): Boolean; +function InIntArray(a: TIntegerArray; Number: Integer): Boolean; +procedure ClearSameIntegers(var a: TIntegerArray); +procedure ClearSameIntegersAndTPA(var a: TIntegerArray; var p: TPointArray); function SplitTPAEx(arr: TPointArray; w, h: Integer): T2DPointArray; +function SplitTPA(arr: TPointArray; Dist: Integer): T2DPointArray; +procedure FilterPointsPie(var Points: TPointArray; const SD, ED, MinR, MaxR: Extended; Mx, My: Integer); +function RemoveDistTPointArray(x, y, dist: Integer; ThePoints: TPointArray; RemoveHigher: Boolean): TPointArray; +function GetATPABounds(ATPA: T2DPointArray): TBox; +function GetTPABounds(TPA: TPointArray): TBox; +function FindTPAinTPA(SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean; +function FindTextTPAinTPA(Height : integer; SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean; +function FindGapsTPA(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(ATPA : T2DPointArray) : TPointArray; +function TPAFromBox(const Box : TBox) : TPointArray; +Function RotatePoints(Const P: TPointArray; A, cx, cy: Extended): TPointArray ; +Function RotatePoint(Const p: TPoint; angle, mx, my: Extended): TPoint; inline; +function FindTPAEdges(p: TPointArray): TPointArray; +function PointInTPA(p: TPoint; arP: TPointArray): Boolean; +function ClearTPAFromTPA(arP, ClearPoints: TPointArray): TPointArray; +procedure ClearDoubleTPA(var TPA: TPointArray); +Function ReturnPointsNotInTPA(Const TotalTPA: TPointArray; 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); implementation +uses + math; + + + + +{/\ + Very Fast TPA Sort, uses an adepted CountSort algorithm. +/\} + +Function FastTPASort(TPA: TPointArray; 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; + +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; + b: boolean; + +begin + b:=false; + NoTP := 0; + l := High(a); + for i := 0 to l do + begin + 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 + b := true; + Break; + end; + if not b 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; + b: boolean; + +begin + b := false; + NoTP := 0; + l := High(a); + for i := 0 to l do + begin + for c := 0 to NoTP - 1 do + if (Round(fSqrt(Sqr(a[i].x - a[c].x) + Sqr(a[i].y - a[c].y))) <= Dist) then + begin + b:=true; + Break; + end; + 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(fSqrt(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(a: TPointArray; w, h: Integer): TPointArray; +var + i, t, c, l: Integer; +begin + l := High(a); + c := 0; + SetLength(Result, l + 1); + for i := 0 to l do + begin + 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 + Break; + 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(a: TPointArray; Dist: Integer): TPointArray; +var + i, t, c, l: Integer; +begin + l := High(a); + c := 0; + SetLength(Result, l + 1); + for i := 0 to l do + begin + for t := 0 to c -1 do + if (Round(fSqrt(Sqr(Result[t].x - a[i].x) + Sqr(Result[t].y - a[i].y))) <= Dist) then + Break; + 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(TPA: TPointArray; w, h: Integer): T2DPointArray; +var + a, b, c, l: LongInt; +begin + SetLength(Result, 0); + l := High(TPA); + c := 0; + for a := 0 to l do + begin + 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 + Break; + 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(TPA: TPointArray; Dist: Integer): T2DPointArray; +var + a, b, c, l: LongInt; +begin + SetLength(Result, 0); + l := High(tpa); + c := 0; + for a := 0 to l do + begin + for b := 0 to c -1 do + if (Round(fSqrt(Sqr(TPA[a].X - Result[b][0].X) + Sqr(TPA[a].Y - Result[b][0].Y))) <= Dist) then + Break; + 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 + writeln('hoi0'); + l := High(a); + if (l < 0) then Exit; + writeln('hoi1'); + 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)); + writeln('hoi2'); + QuickATPASort(DistArr, a, 0, l, True); + writeln('hoi3'); +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(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(tpa: TPointArray): TPoint; +var + i, l: Integer; +begin + 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(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(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(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(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; +begin + b := Copy(a); + l := High(b); + c := 0; + for i := 0 to l do + begin + for t := 0 to c -1 do + if (b[i] = a[t]) then + Break; + 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; +begin + b := Copy(a); + l := High(b); + c := 0; + for i := 0 to l do + begin + for t := 0 to c -1 do + if (b[i] = a[t]) then + Break; + 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(arr: TPointArray; w, h: Integer): T2DPointArray; var @@ -75,5 +837,812 @@ begin 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(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(fSqrt(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; + +{/\ + 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 := fSqrt(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 are inside or outside the distance Dist from the point (x, y) from the TPointArray ThePoints. +/\} + +function RemoveDistTPointArray(x, y, dist: Integer; 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(fSqrt(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(fSqrt(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(ATPA: T2DPointArray): TBox; +var + I,II,L2,L : Integer; +begin; + 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(TPA: TPointArray): TBox; +var + I,L : Integer; +begin; + 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, TotalTPA: TPointArray; var Matches: TPointArray): Boolean; +var + Len, I,II,LenSearch,xOff,yOff : integer; + tx,ty,MatchCount : integer; + Screen : Array of Array of Boolean; + ScreenBox,SearchBox : TBox; +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); + 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; + For II := 0 to LenSearch do + if Screen[tx + SearchTPA[II].x ][ty + SearchTPA[II].y] = False then + Break; + 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; SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean; +var + Len, I,II,LenSearch,LenTPA,xOff,yOff,x,y: integer; + tx,ty,MatchCount : integer; + Screen : Array of Array of Boolean; + 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); + 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); + 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; + For II := 0 to LenSearch do + if Screen[tx + SearchTPA[II].x ][ty + SearchTPA[II].y] = False then + Break; + if (II > LenSearch) then + begin; + For II := 0 to LenTPA do + if Screen[tx + InversedTPA[II].x ][ty + InversedTPA[II].y] = True then + Break; + if (II > LenTPA) 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 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(TPA: TPointArray; MinPixels: Integer): T2DPointArray; +var + Len,TotalLen,LenRes,I,II,III : integer; + Screen : Array of Array of Boolean; + 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); + 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(ATPA : T2DPointArray) : TPointArray; +var + I,II, Len, TempL,CurrentL : integer; +begin; + Len := High(ATPA); + 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; + + +{/\ + 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; + +Begin + L := High(P); + SetLength(Result, L + 1); + For I := 0 To L Do + Begin + Result[I].X := Trunc(cx + cos(A) * (p[i].x - cx) - sin(A) * (p[i].y - cy)); + Result[I].Y := Trunc(cy + sin(A) * (p[i].x - cx) + cos(A) * (p[i].y - cy)); + End; + // I recon its faster than Point(). +End; + +{/\ + Rotate the given Point with A radians. +/\} + +Function RotatePoint(Const p: TPoint; angle, mx, my: Extended): TPoint; inline; + +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(p: TPointArray): TPointArray; +var + b: array of array of Boolean; + 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 + SetLength(b[i], y); + 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(p: TPoint; arP: TPointArray): Boolean; +var + i, l: Integer; +begin + l := High(arP); + for i := 0 to l do + if (arP[i].x = p.x) and (arP[i].y = p.y) then + Break; + Result := i <> Length(arP); +end; + +{/\ + Removes the given ClearPoints from arP. +/\} + +function ClearTPAFromTPA(arP, ClearPoints: TPointArray): TPointArray; +var + i, j, l, l2: Integer; +begin + l := High(arP); + l2 := High(ClearPoints); + for i := 0 to l do + begin + for j := 0 to l2 do + if (arP[i].x = ClearPoints[j].x) and (arP[i].y = ClearPoints[j].y) then + Break; + + 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; Box: TBox): TPointArray; + +Var + X, Y, I: Integer; + B: Array Of Array Of Boolean; + +Begin + SetLength(Result, ((Box.X2 - Box.X1 + 1) * (Box.Y2 - Box.Y1 + 1)) - Length(TotalTPA)); + + SetLength(B, Box.X2 - Box.X1 + 1, Box.Y2 - Box.Y1 + 1); + + For I := 0 To High(TotalTPA) Do + B[TotalTPA[I].X - Box.X1][TotalTPA[I].Y - Box.Y1] := True; + + I := 0; + For X := 0 To Box.X2 - Box.X1 Do + For Y := 0 To Box.Y2 - Box.Y1 Do + If Not B[X][Y] Then + Begin + Result[I].X := X + Box.X1; + Result[I].Y := Y + Box.Y1; + I := I + 1; + End; + SetLength(B, 0); +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: Array Of Array Of Integer; + 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 := 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: Array Of Array Of Integer; + 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); + 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; + end. diff --git a/Units/MMLCore/bitmaps.pas b/Units/MMLCore/bitmaps.pas index 169267f..25ae258 100644 --- a/Units/MMLCore/bitmaps.pas +++ b/Units/MMLCore/bitmaps.pas @@ -51,6 +51,9 @@ type procedure LoadFromFile(const FileName : string); procedure FastSetPixel(x,y : integer; Color : TColor); procedure FastSetPixels(TPA : TPointArray; Colors : TIntegerArray); + procedure DrawATPA(ATPA : T2DPointArray; Colors : TIntegerArray);overload; + procedure DrawATPA(ATPA : T2DPointArray);overload; + procedure DrawTPA(TPA : TPointArray; Color : TColor); function FastGetPixel(x,y : integer) : TColor; function FastGetPixels(TPA : TPointArray) : TIntegerArray; Procedure SetTransparentColor(Col : TColor); @@ -104,7 +107,7 @@ implementation uses Windowutil,paszlib,DCPbase64,math, - colour_conv,window; + colour_conv,window,mufasatypesutil; function Min(a,b:integer) : integer; begin @@ -391,6 +394,47 @@ begin end; end; +procedure TMufasaBitmap.DrawATPA(ATPA: T2DPointArray; Colors: TIntegerArray); +var + lenTPA,lenATPA : integer; + i,ii : integer; + Color : TRGB32; +begin + lenATPA := High(ATPA); + if LenATPA <> High(colors) then + Raise Exception.CreateFMT('TPA/Colors Length differ -> %d : %d',[LenATPA + 1,High(Colors) + 1]); + for i := 0 to lenATPA do + begin; + lenTPA := High(ATPA[i]); + Color := RGBToBGR(Colors[i]); + for ii := 0 to lenTPA do + begin; + ValidatePoint(ATPA[i][ii].x,ATPA[i][ii].y); + FData[ATPA[i][ii].y * w + ATPA[i][ii].x] := Color; + end; + end; +end; + + +procedure TMufasaBitmap.DrawATPA(ATPA: T2DPointArray); +var + Colors : TIntegerArray; + i,len : integer; +begin + len := high(ATPA); + SetLength(colors,len+1); + for i := 0 to len do + Colors[i] := Random(clwhite); + DrawATPA(ATPA,Colors); +end; + +procedure TMufasaBitmap.DrawTPA(TPA: TPointArray; Color: TColor); +begin + DrawATPA(ConvArr([TPA]),ConvArr([Color])); +end; + + + function TMufasaBitmap.FastGetPixel(x, y: integer): TColor; begin ValidatePoint(x,y); diff --git a/Units/MMLCore/mufasatypes.pas b/Units/MMLCore/mufasatypes.pas index 80d468d..40713c3 100644 --- a/Units/MMLCore/mufasatypes.pas +++ b/Units/MMLCore/mufasatypes.pas @@ -301,6 +301,7 @@ var (str :'UNDEFINED'; key : $FF) ); + implementation operator+(PT1, PT2: TPoint): TPoint; begin @@ -312,5 +313,6 @@ begin Result.x := PT1.x - PT2.x; Result.y := Pt1.y - PT2.y; end; + end. diff --git a/Units/MMLCore/mufasatypesutil.pas b/Units/MMLCore/mufasatypesutil.pas new file mode 100644 index 0000000..1c7966d --- /dev/null +++ b/Units/MMLCore/mufasatypesutil.pas @@ -0,0 +1,51 @@ +unit mufasatypesutil; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils,mufasatypes; + +function ConvArr(Arr: array of TPoint): TPointArray; overload; +function ConvArr(Arr: array of TPointArray): T2DPointArray; overload; +function ConvArr(Arr: array of Integer): TIntegerArray; overload; + + +implementation + +function ConvArr(Arr: array of TPoint): TPointArray; overload; +var + Len : Integer; +begin; + Len := Length(Arr); + SetLength(Result, Len); + Move(Arr[Low(Arr)], Result[0], Len*SizeOf(TPoint)); +end; + +function ConvArr(Arr: array of TPointArray): T2DPointArray; overload; +var + Len,Len2 : Integer; + i : integer; +begin; + Len := Length(Arr); + SetLength(Result, Len); + for i := Len - 1 downto 0 do + begin + Len2 := Length(Arr[i]); + SetLength(result[i],len2); + Move(Arr[i][0],Result[i][0],Len2*SizeOf(TPoint)); + end; +end; + +function ConvArr(Arr: array of Integer): TIntegerArray; overload; +var + Len : Integer; +begin; + Len := Length(Arr); + SetLength(Result, Len); + Move(Arr[Low(Arr)], Result[0], Len*SizeOf(Integer)); +end; + +end. +