Skip to content

Commit

Permalink
More native methods for lape's internal methods
Browse files Browse the repository at this point in the history
  • Loading branch information
@ollydev
ollydev committed May 10, 2022
1 parent 5641618 commit 5a172e0
Show file tree
Hide file tree
Showing 9 changed files with 406 additions and 68 deletions.
1 change: 1 addition & 0 deletions Source/codetools/simba.codetools_arrayhelpers.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -99,6 +99,7 @@ implementation
'function <Array>.Stddev: Double; external;',
'function <Array>.Slice(Start, Stop, Step: Integer): <Array>; external;',
'function <Array>.Remove(Value: <ArrayType>): Boolean; external;',
'function <Array>.RemoveAll(Value: <ArrayType>): Integer; external;',
'procedure <Array>.Delete(Index, Count: Integer); external;',
'procedure <Array>.Delete(Index: Integer; Count: Integer = High(Integer)); external;',
'procedure <Array>.Insert(Item: <ArrayType>; Index: Integer); external;',
Expand Down
268 changes: 238 additions & 30 deletions Source/generics/simba.generics_array.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -29,46 +29,70 @@ interface
generic procedure Sort<_T>(var Arr: specialize TArray<_T>);
generic function Sorted<_T>(const Arr: specialize TArray<_T>): specialize TArray<_T>;

procedure Sort(var Arr: TIntegerArray);
procedure Sort(var Arr: TIntegerArray); overload;
procedure Sort(var Arr: TSingleArray); overload;
procedure Sort(var Arr: TDoubleArray); overload;
procedure Sort(var Arr: TExtendedArray); overload;

procedure Sort(var Arr: TPointArray; var Weights: TIntegerArray; SortUp: Boolean); overload;
procedure Sort(var Arr: TPointArray; var Weights: TIntegerArray; Lo, Hi: Integer; SortUp: Boolean); overload;
procedure Sort(var Arr: T2DPointArray; var Weights: TIntegerArray; SortUp: Boolean); overload;
procedure Sort(var Arr: T2DPointArray; var Weights: TIntegerArray; Lo, Hi: Integer; SortUp: Boolean); overload;

function MinA(const Arr: TIntegerArray): Integer; overload;
function MinA(const Arr: TExtendedArray): Extended; overload;
function MaxA(const Arr: TIntegerArray): Integer; overload;
function MaxA(const Arr: TExtendedArray): Extended; overload;
function Min(const Arr: TIntegerArray): Integer; overload;
function Min(const Arr: TSingleArray): Single; overload;
function Min(const Arr: TDoubleArray): Double; overload;
function Min(const Arr: TExtendedArray): Extended; overload;

function Max(const Arr: TIntegerArray): Integer; overload;
function Max(const Arr: TSingleArray): Single; overload;
function Max(const Arr: TDoubleArray): Double; overload;
function Max(const Arr: TExtendedArray): Extended; overload;

function Sum(const Arr: TIntegerArray): Int64; overload;
function Sum(const Arr: TSingleArray): Extended; overload;
function Sum(const Arr: TDoubleArray): Extended; overload;
function Sum(const Arr: TExtendedArray): Extended; overload;
function Average(const Arr: TIntegerArray): Int64; overload;
function Average(const Arr: TExtendedArray): Extended; overload;
function Sum(const Arr: TPointArray): TPoint; overload;

function Mean(const Arr: TIntegerArray): Int64; overload;
function Mean(const Arr: TExtendedArray): Extended; overload;

function Mode(const Arr: TIntegerArray): Integer;
procedure Reverse(var Arr: TIntegerArray);
procedure Reverse(var Arr: TPointArray);
procedure Reverse(var Arr: T2DPointArray);

function IndexOf(const Item: Integer; const Arr: TIntegerArray): Integer;
function IndexOf(const Item: String; const Arr: TStringArray): Integer;
function IndexOf(const Item: TPoint; const Arr: TPointArray): Integer;
procedure Reverse(var Arr: TIntegerArray); overload;
procedure Reverse(var Arr: TPointArray); overload;
procedure Reverse(var Arr: T2DPointArray); overload;

function IndicesOf(const Item: Integer; const Arr: TIntegerArray): TIntegerArray;
function IndicesOf(const Item: String; const Arr: TStringArray): TIntegerArray;
function IndicesOf(const Item: TPoint; const Arr: TPointArray): TIntegerArray;
function IndexOf(const Item: Integer; const Arr: TIntegerArray): Integer; overload;
function IndexOf(const Item: String; const Arr: TStringArray): Integer; overload;
function IndexOf(const Item: TPoint; const Arr: TPointArray): Integer; overload;

function IndicesOf(const Item: Integer; const Arr: TIntegerArray): TIntegerArray; overload;
function IndicesOf(const Item: String; const Arr: TStringArray): TIntegerArray; overload;
function IndicesOf(const Item: TPoint; const Arr: TPointArray): TIntegerArray; overload;

// TPoint: Use Matrix
function Unique(const Arr: TPointArray): TPointArray;
function Unique(const Arr: TPointArray): TPointArray; overload;

// Integer: Use Hashing
function Unique(const Arr: TIntegerArray): TIntegerArray;
function Unique(const Arr: TIntegerArray): TIntegerArray; overload;

// String: Use Hashing
function Unique(const Arr: TStringArray): TStringArray;
function Unique(const Arr: TStringArray): TStringArray; overload;

// Double: Use SameValue
function IndexOf(const Item: Double; const Arr: TDoubleArray): Integer;
function IndicesOf(const Item: Double; const Arr: TDoubleArray): TIntegerArray;
function Unique(const Arr: TDoubleArray): TDoubleArray;
// Floats: Use SameValue
function IndexOf(const Item: Single; const Arr: TSingleArray): Integer; overload;
function IndexOf(const Item: Double; const Arr: TDoubleArray): Integer; overload;
function IndexOf(const Item: Extended; const Arr: TExtendedArray): Integer; overload;

function IndicesOf(const Item: Single; const Arr: TSingleArray): TIntegerArray; overload;
function IndicesOf(const Item: Double; const Arr: TDoubleArray): TIntegerArray; overload;
function IndicesOf(const Item: Extended; const Arr: TExtendedArray): TIntegerArray; overload;

function Unique(const Arr: TSingleArray): TSingleArray; overload;
function Unique(const Arr: TDoubleArray): TDoubleArray; overload;
function Unique(const Arr: TExtendedArray): TExtendedArray; overload;

implementation

Expand Down Expand Up @@ -374,25 +398,45 @@ procedure Sort(var Arr: T2DPointArray; var Weights: TIntegerArray; SortUp: Boole

procedure Sort(var Arr: T2DPointArray; var Weights: TIntegerArray; Lo, Hi: Integer; SortUp: Boolean);
begin
specialize QuickSortWeighted<TPointArray, Integer>(Arr, Weights, Lo, Hi, SortUp);
specialize QuickSortWeighted<TPointArray, Integer>(Arr, Weights, Lo, Hi, SortUp);
end;

function MinA(const Arr: TIntegerArray): Integer;
function Min(const Arr: TIntegerArray): Integer;
begin
Result := specialize MinA<Integer>(Arr);
end;

function MinA(const Arr: TExtendedArray): Extended;
function Min(const Arr: TSingleArray): Single;
begin
Result := specialize MinA<Single>(Arr);
end;

function Min(const Arr: TDoubleArray): Double;
begin
Result := specialize MinA<Double>(Arr);
end;

function Min(const Arr: TExtendedArray): Extended;
begin
Result := specialize MinA<Extended>(Arr);
end;

function MaxA(const Arr: TIntegerArray): Integer;
function Max(const Arr: TIntegerArray): Integer;
begin
Result := specialize MaxA<Integer>(Arr);
end;

function MaxA(const Arr: TExtendedArray): Extended;
function Max(const Arr: TSingleArray): Single;
begin
Result := specialize MaxA<Single>(Arr);
end;

function Max(const Arr: TDoubleArray): Double;
begin
Result := specialize MaxA<Double>(Arr);
end;

function Max(const Arr: TExtendedArray): Extended;
begin
Result := specialize MaxA<Extended>(Arr);
end;
Expand All @@ -402,19 +446,34 @@ function Sum(const Arr: TIntegerArray): Int64;
Result := specialize Sum<Integer, Int64>(Arr);
end;

function Sum(const Arr: TSingleArray): Extended;
begin
Result := specialize Sum<Single, Extended>(Arr);
end;

function Sum(const Arr: TDoubleArray): Extended;
begin
Result := specialize Sum<Double, Extended>(Arr);
end;

function Sum(const Arr: TExtendedArray): Extended;
begin
Result := specialize Sum<Extended, Extended>(Arr);
end;

function Average(const Arr: TIntegerArray): Int64;
function Sum(const Arr: TPointArray): TPoint;
begin
Result := specialize Sum<TPoint, TPoint>(Arr);
end;

function Mean(const Arr: TIntegerArray): Int64;
begin
Result := Sum(Arr);
if (Result <> 0) then
Result := Result div Length(Arr);
end;

function Average(const Arr: TExtendedArray): Extended;
function Mean(const Arr: TExtendedArray): Extended;
begin
Result := Sum(Arr);
if (Result <> 0) then
Expand All @@ -431,6 +490,21 @@ procedure Sort(var Arr: TIntegerArray);
specialize QuickSort<Integer>(Arr, Low(Arr), High(Arr));
end;

procedure Sort(var Arr: TSingleArray);
begin
specialize QuickSort<Single>(Arr, Low(Arr), High(Arr));
end;

procedure Sort(var Arr: TDoubleArray);
begin
specialize QuickSort<Double>(Arr, Low(Arr), High(Arr));
end;

procedure Sort(var Arr: TExtendedArray);
begin
specialize QuickSort<Extended>(Arr, Low(Arr), High(Arr));
end;

procedure Reverse(var Arr: TIntegerArray);
begin
specialize Reverse<Integer>(Arr);
Expand Down Expand Up @@ -587,6 +661,17 @@ function Unique(const Arr: TStringArray): TStringArray;
Result := Buffer.Trim();
end;

function IndexOf(const Item: Single; const Arr: TSingleArray): Integer;
var
I: Integer;
begin
for I := 0 to High(Arr) do
if SameValue(Item, Arr[I]) then
Exit(I);

Result := -1;
end;

function IndexOf(const Item: Double; const Arr: TDoubleArray): Integer;
var
I: Integer;
Expand All @@ -598,6 +683,31 @@ function IndexOf(const Item: Double; const Arr: TDoubleArray): Integer;
Result := -1;
end;

function IndexOf(const Item: Extended; const Arr: TExtendedArray): Integer;
var
I: Integer;
begin
for I := 0 to High(Arr) do
if SameValue(Item, Arr[I]) then
Exit(I);

Result := -1;
end;

function IndicesOf(const Item: Single; const Arr: TSingleArray): TIntegerArray;
var
I: Integer;
Buffer: specialize TSimbaOverAllocateArray<Integer>;
begin
Buffer.Init(4);

for I := 0 to High(Arr) do
if SameValue(Item, Arr[I]) then
Buffer.Add(I);

Result := Buffer.Trim();
end;

function IndicesOf(const Item: Double; const Arr: TDoubleArray): TIntegerArray;
var
I: Integer;
Expand All @@ -612,6 +722,62 @@ function IndicesOf(const Item: Double; const Arr: TDoubleArray): TIntegerArray;
Result := Buffer.Trim();
end;

function IndicesOf(const Item: Extended; const Arr: TExtendedArray): TIntegerArray;
var
I: Integer;
Buffer: specialize TSimbaOverAllocateArray<Integer>;
begin
Buffer.Init(4);

for I := 0 to High(Arr) do
if SameValue(Item, Arr[I]) then
Buffer.Add(I);

Result := Buffer.Trim();
end;

function Unique(const Arr: TSingleArray): TSingleArray;
var
I, J, Size: Integer;
Value: Single;
Table: array of record
Bucket: TSingleArray;
Count: Integer;
end;
Buffer: specialize TSimbaOverAllocateArray<Single>;
label
Next;
begin
Buffer.Init();

SetLength(Table, NextPower2(Length(Arr)));
Size := High(Table);

for i := 0 to High(Arr) do
begin
Value := Arr[i];

with Table[Round(Value) and Size] do
begin
for J := 0 to Count - 1 do
if SameValue(Value, Bucket[J]) then
goto Next;

if (Count >= Length(Bucket)) then
SetLength(Bucket, 4 + (Length(Bucket) * 2));

Bucket[Count] := Value;
Inc(Count);

Buffer.Add(Value);
end;

Next:
end;

Result := Buffer.Trim();
end;

function Unique(const Arr: TDoubleArray): TDoubleArray;
var
I, J, Size: Integer;
Expand Down Expand Up @@ -654,5 +820,47 @@ function Unique(const Arr: TDoubleArray): TDoubleArray;
Result := Buffer.Trim();
end;

function Unique(const Arr: TExtendedArray): TExtendedArray;
var
I, J, Size: Integer;
Value: Extended;
Table: array of record
Bucket: TExtendedArray;
Count: Integer;
end;
Buffer: specialize TSimbaOverAllocateArray<Extended>;
label
Next;
begin
Buffer.Init();

SetLength(Table, NextPower2(Length(Arr)));
Size := High(Table);

for i := 0 to High(Arr) do
begin
Value := Arr[i];

with Table[Round(Value) and Size] do
begin
for J := 0 to Count - 1 do
if SameValue(Value, Bucket[J]) then
goto Next;

if (Count >= Length(Bucket)) then
SetLength(Bucket, 4 + (Length(Bucket) * 2));

Bucket[Count] := Value;
Inc(Count);

Buffer.Add(Value);
end;

Next:
end;

Result := Buffer.Trim();
end;

end.

4 changes: 2 additions & 2 deletions Source/script/wrappers_simba/simba.imports_finder.inc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -33,10 +33,10 @@ addGlobalFunc('function FindColorSpiralTolerance(var x, y: Integer; color, xs, y
addGlobalFunc('function FindColorsSpiralTolerance(x, y: Integer; var Points: TPointArray; color, xs, ys, xe, ye: Integer; Tolerance: Integer): Boolean', @_LapeFindColorsSpiralTolerance);
addGlobalFunc('function FindColoredArea(var x, y: Integer; color, xs, ys, xe, ye: Integer; MinArea: Integer): Boolean', @_LapeFindColoredArea);
addGlobalFunc('function FindColoredAreaTolerance(var x, y: Integer; Color, xs, ys, xe, ye, MinArea, Tol: Integer): Boolean', @_LapeFindColoredAreaTolerance);
addGlobalFunc('function FindDeformedBitmapToleranceIn(bitmap: Integer; var x, y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer; Range: Integer; AllowPartialAccuracy: Boolean; var accuracy: Extended): Boolean', @_LapeFindDeformedBitmapToleranceIn);
addGlobalFunc('function FindDeformedBitmapToleranceIn(bitmap: TMufasaBitmap; var x, y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer; Range: Integer; AllowPartialAccuracy: Boolean; var accuracy: Extended): Boolean', @_LapeFindDeformedBitmapToleranceIn);
addGlobalFunc('function FindTemplate(Templ: TMufasaBitmap; out x, y: Integer; Formula: ETMFormula; xs,ys,xe,ye: Integer; MinMatch: Extended; DynamicAdjust: Boolean = True): Boolean', @_LapeFindTemplate);
addGlobalFunc('function FindTemplateEx(Templ: TMufasaBitmap; out TPA: TPointArray; Formula: ETMFormula; xs,ys,xe,ye: Integer; MinMatch: Extended; DynamicAdjust: Boolean = True): Boolean', @_LapeFindTemplateEx);
addGlobalFunc('function FindTextMatrix(Text, Font: String; constref Matrix: T2DIntegerArray; out Bounds: TBox): Single', @_LapeFindTextMatrix);
addGlobalFunc('function FindTextMatrix(Text, Font: String; const Matrix: T2DIntegerArray; out Bounds: TBox): Single', @_LapeFindTextMatrix);
addGlobalFunc('function FindTextColor(Text, Font: String; Color, Tolerance: Integer; X1, Y1, X2, Y2: Integer; out Bounds: TBox): Single; overload', @_LapeFindTextColor);
addGlobalFunc('function FindTextColor(Text, Font: String; Color, Tolerance: Integer; X1, Y1, X2, Y2: Integer; MinMatch: Single = 1): Boolean; overload', @_LapeFindTextColorEx);
addGlobalFunc('function FindText(Text, Font: String; X1, Y1, X2, Y2: Integer; out Bounds: TBox): Single; overload', @_LapeFindText);
Expand Down
Loading

0 comments on commit 5a172e0

Please sign in to comment.