diff --git a/Install/windows/Setup.iss b/Install/windows/Setup.iss index 32173a0..b93cd8c 100644 --- a/Install/windows/Setup.iss +++ b/Install/windows/Setup.iss @@ -44,6 +44,9 @@ Source: "C:\Simba\Extensions\paster.sex"; DestDir: "{app}\Extensions"; Flags: ig Source: "C:\Simba\Extensions\CRov.sex"; DestDir: "{app}\Extensions"; Flags: ignoreversion Source: "C:\Simba\Extensions\Updater.sei"; DestDir: "{app}\Extensions"; Flags: ignoreversion Source: "C:\Simba\Includes\mml.simba"; DestDir: "{app}\Includes"; Flags: ignoreversion +Source: "C:\Simba\settings.xml"; DestDir: "{app}\"; Flags: ignoreversion +; XXX Make sure to use a MINIMAL settings.xml XXX + ; Source: "C:\Simba\Fonts\*"; DestDir: "{app}\Fonts"; Flags: ignoreversion recursesubdirs createallsubdirs ; Source: "C:\Simba\Tests\PS\*"; DestDir:"{app}\Scripts\Tests"; Flags: ignoreversion ; NOTE: Don't use "Flags: ignoreversion" on any shared system files diff --git a/Projects/Simba/simbaunit.pas b/Projects/Simba/simbaunit.pas index eac81c7..0a828a2 100644 --- a/Projects/Simba/simbaunit.pas +++ b/Projects/Simba/simbaunit.pas @@ -62,7 +62,7 @@ uses settings, updater; const - SimbaVersion = 970; + SimbaVersion = 971; interp_PS = 0; //PascalScript interp_RT = 1; //RUTIS diff --git a/TODO b/TODO index ba1abf6..9451910 100644 --- a/TODO +++ b/TODO @@ -7,13 +7,16 @@ Simple stuff, not required, may not be possible/useful: - CTS/finder speedups and changes [ ] - General ideas: + - Table displaying all the different performance gains and + penalties. [ ] + - General ideas: - everything subprocedure (lots of code) - jit + comparison function (per cts) generated, call in loop - comparison function (per cts), not generated, call in loop + - Investigate SIMD probable speedups [ ] - JIT (Generate comparison functions) [ ] - Comparison functions for HSL/XYZ/L*a*b should check for match on each component before calculating the next. diff --git a/Tests/PS/BmpBenchmark.simba b/Tests/PS/BmpBenchmark.simba new file mode 100644 index 0000000..5bf5551 --- /dev/null +++ b/Tests/PS/BmpBenchmark.simba @@ -0,0 +1,25 @@ +program new; +//http://farm4.static.flickr.com/3067/2612399892_7df428d482.jpg +{Make the above bitmap your target} +var + Bmp : integer; + x,y : integer; + w,h : integer; + t, i: integer; +begin + Bmp := createBitmap(15, 10); + FastDrawClear(bmp, clwhite); + GetClientDimensions(w,h); + + setcolortolerancespeed(2); + t:=getsystemtime; + for i := 0 to 10 do + FindBitmapToleranceIn(bmp,x,y,0,0,w-1,h-1,500); + writeln((getsystemtime-t) / 10.0); + + if FindBitmapToleranceIn(bmp,x,y,0,0,w-1,h-1,500) then + begin + writeln('found'); + MoveMouse(x,y); + end; +end. diff --git a/Tests/PS/bmpbench.simba b/Tests/PS/bmpbench.simba index dc9acea..134b738 100644 --- a/Tests/PS/bmpbench.simba +++ b/Tests/PS/bmpbench.simba @@ -1,6 +1,5 @@ program new; -//http://farm4.static.flickr.com/3067/2612399892_7df428d482.jpg -{Make the above bitmap your target} + var Bmp : integer; x,y : integer; @@ -19,11 +18,14 @@ begin setcolortolerancespeed(c); t:=getsystemtime; - for i := 0 to 100 do + for i := 0 to 10 do findBitmapToleranceIn(bmp,x,y,0,0,w-1,h-1,10); - writeln((getsystemtime-t) / 100.0); - if findBitmapToleranceIn(bmp,x,y,0,0,w-1,h-1,200) then + writeln((getsystemtime-t) / 10.0); + if findBitmapToleranceIn(bmp,x,y,0,0,w-1,h-1,10) then + begin writeln('found'); + movemouse(x,y); + end; end; {if FindBitmapToleranceIn(bmp,x,y,0,0,w-1,h-1,300) then diff --git a/Units/MMLCore/bitmaps.pas b/Units/MMLCore/bitmaps.pas index 335550f..80ad422 100644 --- a/Units/MMLCore/bitmaps.pas +++ b/Units/MMLCore/bitmaps.pas @@ -64,6 +64,7 @@ type function FastGetPixel(x,y : integer) : TColor; function FastGetPixels(Points : TPointArray) : TIntegerArray; function GetAreaColors(xs,ys,xe,ye : integer) : T2DIntArray; + function GetHSLValues(xs, ys, xe, ye: integer): T2DHSLArray; procedure FastDrawClear(Color : TColor); procedure FastDrawTransparent(x, y: Integer; TargetBitmap: TMufasaBitmap); procedure FastReplaceColor(OldColor, NewColor: TColor); @@ -876,6 +877,23 @@ begin result[x-xs][y-ys] := BGRToRGB(FData[y*w+x]); end; +function TMufasaBitmap.GetHSLValues(xs, ys, xe, ye: integer): T2DHSLArray; +var + x, y: integer; + R, G, B, C: integer; +begin + ValidatePoint(xs,ys); + ValidatePoint(xe,ye); + setlength(result,ye-ys+1,xe-xs+1); + for y := ys to ye do + for x := xs to xe do + begin { REWRITE THIS } + RGBToHSL(FData[y*w+x].R, FData[y*w+x].G, FData[y*w+x].B, + Result[y-ys][x-xs].H, Result[y-ys][x-xs].S, + Result[y-ys][x-xs].L); + end; +end; + procedure TMufasaBitmap.SetTransparentColor(Col: TColor); begin self.FTransparentSet:= True; @@ -1406,7 +1424,7 @@ var i,minw,minh : integer; begin if (AWidth <> w) or (AHeight <> h) then - begin; + begin if AWidth*AHeight <> 0 then begin; NewData := GetMem(AWidth * AHeight * SizeOf(TRGB32)); diff --git a/Units/MMLCore/colour_conv.pas b/Units/MMLCore/colour_conv.pas index 2cbb3e3..de280b7 100644 --- a/Units/MMLCore/colour_conv.pas +++ b/Units/MMLCore/colour_conv.pas @@ -48,7 +48,8 @@ procedure ColorToXYZ(color: Integer; out X, Y, Z: Extended); inline; function XYZToColor(X, Y, Z: Extended): TColor; inline; function HSLToColor(H, S, L: Extended): TColor; inline; function BGRToRGB(BGR : TRGB32) : TColor;inline; - +procedure XYZtoCIELab(X, Y, Z: Extended; out L, a, b: Extended); +procedure CIELabtoXYZ(L, a, b: Extended; out X, Y, Z: Extended); implementation @@ -336,4 +337,53 @@ begin Result := RGBToColor(r, g, b); end; +procedure XYZtoCIELab(X, Y, Z: Extended; out L, a, b: Extended); +begin + X := X / 95.047; + Y := Y / 100.000; + Z := Z / 108.883; + + if ( X > 0.008856 ) then + X := Power(X, 1.0/3.0) + else + X := ( 7.787 * X ) + ( 16.0 / 116.0 ); + if ( Y > 0.008856 ) then + Y := Power(Y, 1.0/3.0) + else + Y := ( 7.787 * Y ) + ( 16.0 / 116.0 ); + if ( Z > 0.008856 ) then + Z := Power(Z, 1.0/3.0) + else + Z := ( 7.787 * Z ) + ( 16.0 / 116.0 ); + + L := (116.0 * Y ) - 16.0; + a := 500.0 * ( X - Y ); + b := 200.0 * ( Y - Z ); +end; + +procedure CIELabtoXYZ(L, a, b: Extended; out X, Y, Z: Extended); +begin + Y := ( L + 16 ) / 116.0; + X := ( a / 500.0 )+ Y; + Z := Y - ( b / 200.0 ); + + if ( Power(Y, 3) > 0.008856 ) then + Y := Power(Y, 3) + else + Y := ( Y - (16.0 / 116.0 )) / 7.787; + if ( Power(X, 3) > 0.008856 ) then + X := Power(X, 3) + else + X := ( X - (16.0 / 116.0) ) / 7.787; + if ( Power(Z, 3) > 0.008856 ) then + Z := Power(Z, 3) + else + Z := ( Z - (16.0 / 116.0) ) / 7.787; + + + X := 95.047 * X; + Y := 100.000 * Y; + Z := 108.883 * Z; +end; + end. diff --git a/Units/MMLCore/finder.pas b/Units/MMLCore/finder.pas index 40c8f23..432dd89 100644 --- a/Units/MMLCore/finder.pas +++ b/Units/MMLCore/finder.pas @@ -30,15 +30,16 @@ interface {$define CheckAllBackground}//Undefine this to only check the first white point against the background (in masks). uses - colour_conv, Classes, SysUtils,bitmaps,DTM, MufasaTypes; // Types + colour_conv, Classes, SysUtils, bitmaps, DTM, MufasaTypes; // Types { TMFinder Class } { - Should be 100% OS independant, - as all OS dependant code is in the IO Manager - + Should be 100% OS independant, as all OS dependant code is in the IO Manager. Let's try not to use any OS-specific defines here? ;) + + TODO: Check that each procedure calling Create_CTSInfo also calls + Free_CTSInfo(). } type @@ -68,7 +69,7 @@ type function FindColorSpiralTolerance(var x, y: Integer; color, xs, ys, xe, ye,Tol: Integer): Boolean; function FindColorTolerance(out x, y: Integer; Color, xs, ys, xe, ye, tol: Integer): Boolean; function FindColorsTolerance(out Points: TPointArray; Color, xs, ys, xe, ye, Tol: Integer): Boolean; - function FindColorsSpiralTolerance(x, y: Integer; out Points: TPointArray; color, xs, ys, xe, ye: Integer; Tolerance: Integer) : boolean; + function FindColorsSpiralTolerance(x, y: Integer; out Points: TPointArray; color, xs, ys, xe, ye: Integer; Tol: Integer) : boolean; function FindColors(var TPA: TPointArray; Color, xs, ys, xe, ye: Integer): Boolean; function FindColoredArea(var x, y: Integer; color, xs, ys, xe, ye: Integer; MinArea: Integer): Boolean; function FindColoredAreaTolerance(var x, y: Integer; color, xs, ys, xe, ye: Integer; MinArea, tol: Integer): Boolean; @@ -101,18 +102,42 @@ type implementation uses -// colour_conv,// For RGBToColor, etc. - Client, // For the Client Casts. - math, //min/max - tpa, //TPABounds - dtmutil - ; + Client, // For the Client casting. + math, // min/max + tpa, //TPABounds + dtmutil; + +type + TCTS0Info = record + B, G, R, A: byte; + Tol: Integer; + end; + PCTS0Info = ^TCTS0Info; + + TCTS1Info = record + B, G, R, A: byte; + Tol: Integer; { Squared } + end; + PCTS1Info = ^TCTS1Info; + + TCTS2Info = record + H, S, L: extended; + hueMod, satMod: extended; + Tol: Integer; + end; + PCTS2Info = ^TCTS2Info; + + TCTSInfo = Pointer; + TCTSInfoArray = Array of TCTSInfo; + TCTSInfo2DArray = Array of TCTSInfoArray; + TCTSCompareFunction = function (ctsInfo: Pointer; C2: PRGB32): boolean; + procedure TMFinder.LoadSpiralPath(startX, startY, x1, y1, x2, y2: Integer); var i,c,Ring : integer; CurrBox : TBox; -begin; +begin i := 0; Ring := 1; c := 0; @@ -123,58 +148,60 @@ begin; if (startx >= x1) and (startx <= x2) and (starty >= y1) and (starty <= y2) then begin; ClientTPA[c] := Point(Startx, StartY); - inc(c); + Inc(c); end; - Repeat + repeat if (CurrBox.x2 >= x1) and (CurrBox.x1 <= x2) and (Currbox.y1 >= y1) and (Currbox.y1 <= y2) then for i := CurrBox.x1 + 1 to CurrBox.x2 do if (I >= x1) and ( I <= x2) then begin; ClientTPA[c] := Point(i,CurrBox.y1); - inc(c); + Inc(c); end; if (CurrBox.x2 >= x1) and (CurrBox.x2 <= x2) and (Currbox.y2 >= y1) and (Currbox.y1 <= y2) then for i := CurrBox.y1 + 1 to CurrBox.y2 do if (I >= y1) and ( I <= y2) then begin; ClientTPA[c] := Point(Currbox.x2, I); - inc(c); + Inc(c); end; if (CurrBox.x2 >= x1) and (CurrBox.x1 <= x2) and (Currbox.y2 >= y1) and (Currbox.y2 <= y2) then for i := CurrBox.x2 - 1 downto CurrBox.x1 do if (I >= x1) and ( I <= x2) then begin; ClientTPA[c] := Point(i,CurrBox.y2); - inc(c); + Inc(c); end; if (CurrBox.x1 >= x1) and (CurrBox.x1 <= x2) and (Currbox.y2 >= y1) and (Currbox.y1 <= y2) then for i := CurrBox.y2 - 1 downto CurrBox.y1 do if (I >= y1) and ( I <= y2) then begin; ClientTPA[c] := Point(Currbox.x1, I); - inc(c); + Inc(c); end; - inc(ring); + Inc(ring); CurrBox.x1 := Startx-ring; CurrBox.y1 := Starty-Ring; CurrBox.x2 := Startx+Ring; CurrBox.y2 := Starty+Ring; - until (Currbox.x1 < x1) and (Currbox.x2 > x2) and (currbox.y1 < y1) and (currbox.y2 > y2); + until (Currbox.x1 < x1) and (Currbox.x2 > x2) and (currbox.y1 < y1) + and (currbox.y2 > y2); end; -function CalculateRowPtrs(ReturnData : TRetData; RowCount : integer) : TPRGB32Array;overload; +function CalculateRowPtrs(ReturnData: TRetData; RowCount: integer) : TPRGB32Array; overload; var I : integer; begin; - setlength(result,RowCount); + SetLength(result,RowCount); for i := 0 to RowCount - 1 do result[i] := ReturnData.Ptr + ReturnData.RowLen * i; end; -function CalculateRowPtrs(Bitmap : TMufasaBitmap) : TPRGB32Array;overload; +function CalculateRowPtrs(Bitmap : TMufasaBitmap) : TPRGB32Array; overload; begin Result := Bitmap.RowPtrs; end; + //SkipCoords[y][x] = False/True; True means its "transparent" and therefore not needed to be checked. procedure CalculateBitmapSkipCoords(Bitmap : TMufasaBitmap; out SkipCoords : T2DBoolArray); var @@ -199,7 +226,9 @@ begin; inc(ptr); end; end; -//Points left holds the amount of points that are "left" to be checked (Including the point itself.. So for example Pointsleft[0][0] would hold the total amount of pixels that are to be checked. +{ Points left holds the amount of points that are "left" to be checked + (Including the point itself.. So for example Pointsleft[0][0] would + hold the total amount of pixels that are to be checked. } procedure CalculateBitmapSkipCoordsEx(Bitmap : TMufasaBitmap; out SkipCoords : T2DBoolArray;out TotalPoints : integer; out PointsLeft : T2DIntArray); var x,y : integer; @@ -238,6 +267,7 @@ begin; end; end; +{ Initialise the variables for TMFinder } constructor TMFinder.Create(aClient: TObject); var I : integer; @@ -267,7 +297,7 @@ end; procedure TMFinder.SetToleranceSpeed(nCTS: Integer); begin - if (nCTS < 0) or (nCTS > 2) then + if (nCTS < 0) or (nCTS > 3) then raise Exception.CreateFmt('The given CTS ([%d]) is invalid.',[nCTS]); Self.CTS := nCTS; end; @@ -293,6 +323,7 @@ function TMFinder.SimilarColors(Color1, Color2,Tolerance: Integer) : boolean; var R1,G1,B1,R2,G2,B2 : Byte; H1,S1,L1,H2,S2,L2 : extended; + L_1, a_1, b_1, L_2, a_2 ,b_2, X, Y, Z: extended; begin Result := False; ColorToRGB(Color1,R1,G1,B1); @@ -308,13 +339,27 @@ begin RGBToHSL(R2,g2,b2,H2,S2,L2); Result := ((abs(H1 - H2) <= (hueMod * Tolerance)) and (abs(S2-S1) <= (satMod * Tolerance)) and (abs(L1-L2) <= Tolerance)); end; + 3: + begin + RGBToXYZ(R1, G1, B1, X, Y, Z); + XYZtoCIELab(X, Y, Z, L_1, a_1, b_1); + RGBToXYZ(R2, G2, B2, X, Y, Z); + XYZtoCIELab(X, Y, Z, L_2, a_2, b_2); + Result := (abs(L_1 - L_2) < Tolerance) + and (abs(a_1 - a_2) < Tolerance) + and (abs(b_1 - b_2) < Tolerance); + end; end; end; +{ + TODO: Remove this +} function ColorSame(var CTS,Tolerance : Integer; var R1,G1,B1,R2,G2,B2 : byte; var H1,S1,L1,huemod,satmod : extended) : boolean; inline; var H2,S2,L2 : extended; + L_1, a_1, b_1, L_2, a_2 ,b_2, X, Y, Z: extended; begin Result := False; case CTS of @@ -324,6 +369,170 @@ begin RGBToHSL(R2,g2,b2,H2,S2,L2); Result := ((abs(H1 - H2) <= (hueMod * Tolerance)) and (abs(S2-S1) <= (satMod * Tolerance)) and (abs(L1-L2) <= Tolerance)); end; + 3: begin + RGBToXYZ(R1, G1, B1, X, Y, Z); + XYZtoCIELab(X, Y, Z, L_1, a_1, b_1); + RGBToXYZ(R2, G2, B2, X, Y, Z); + XYZtoCIELab(X, Y, Z, L_2, a_2, b_2); + Result := Sqrt(sqr(L_1 - L_2) + sqr(a_1 - a_2) + + sqr(b_1 - b_2)) <= Tolerance; + end; + end; +end; + + +{ Colour Same functions } +function ColorSame_cts0(ctsInfo: Pointer; C2: PRGB32): boolean; + +var + C1: TCTS0Info; +begin + C1 := PCTS0Info(ctsInfo)^; + Result := (Abs(C1.B - C2^.B) <= C1.Tol) + and (Abs(C1.G - C2^.G) <= C1.Tol) + and (Abs(C1.R - C2^.R) <= C1.Tol); +end; + +function ColorSame_cts1(ctsInfo: Pointer; C2: PRGB32): boolean; + +var + C1: TCTS1Info; + r,g,b: integer; +begin + C1 := PCTS1Info(ctsInfo)^; + b := C1.B - C2^.B; + g := C1.G - C2^.G; + r := C1.R - C2^.R; + Result := (b*b + g*g + r*r) <= C1.Tol; +end; + +function ColorSame_cts2(ctsInfo: Pointer; C2: PRGB32): boolean; + +var + h, s, l: extended; + i: TCTS2Info; +begin + i := PCTS2Info(ctsInfo)^; + RGBToHSL(C2^.R, C2^.G, C2^.B, h, s, l); // Inline this later. + + Result := (abs(h - i.H) <= (i.hueMod)) + and (abs(s - i.S) <= (i.satMod)) + and (abs(l - i.L) <= i.Tol); +end; + +{ } + +function Create_CTSInfo(cts: integer; Color, Tol: Integer; + hueMod, satMod: extended): Pointer; overload; +var + R, G, B: Integer; +begin + case cts of + 0: + begin + Result := AllocMem(SizeOf(TCTS0Info)); + ColorToRGB(Color, PCTS0Info(Result)^.R, PCTS0Info(Result)^.G, + PCTS0Info(Result)^.B); + PCTS0Info(Result)^.Tol := Tol; + end; + 1: + begin + Result := AllocMem(SizeOf(TCTS1Info)); + ColorToRGB(Color, PCTS1Info(Result)^.R, PCTS1Info(Result)^.G, + PCTS1Info(Result)^.B); + + PCTS1Info(Result)^.Tol := Tol * Tol; + end; + 2: + begin + Result := AllocMem(SizeOf(TCTS2Info)); + ColorToRGB(Color, R, G, B); + RGBToHSL(R, G, B, PCTS2Info(Result)^.H, PCTS2Info(Result)^.S, + PCTS2Info(Result)^.L); + PCTS2Info(Result)^.hueMod := Tol * hueMod; + PCTS2Info(Result)^.satMod := Tol * satMod; + PCTS2Info(Result)^.Tol := Tol; + end; + end; +end; + + +function Create_CTSInfo(cts: integer; R, G, B, Tol: Integer; + hueMod, satMod: extended): Pointer; overload; + +var Color: Integer; + +begin + Color := RGBToColor(R, G, B); + Result := Create_CTSInfo(cts, Color, Tol, hueMod, satMod); +end; + +procedure Free_CTSInfo(i: Pointer); +begin + if assigned(i) then + FreeMem(i) + else + raise Exception.Create('Free_CTSInfo: Invalid TCTSInfo passed'); +end; + +{ TODO: Not universal, mainly for DTM } +function Create_CTSInfoArray(cts: integer; color, tolerance: array of integer; + hueMod, satMod: extended): TCTSInfoArray; + +var + i: integer; +begin + if length(color) <> length(tolerance) then + raise Exception.Create('Create_CTSInfoArray: Length(Color) <>' + +' Length(Tolerance'); + SetLength(Result, Length(color)); + + for i := High(result) downto 0 do + result := Create_CTSInfo(cts, color[i], tolerance[i], hueMod, satMod); +end; + + +{ TODO: Not universal, mainly for Bitmap } +function Create_CTSInfo2DArray(cts, w, h: integer; data: TPRGB32Array; + Tolerance: Integer; hueMod, satMod: Extended): TCTSInfo2DArray; +var + x, y: integer; +begin + SetLength(Result,h+1,w+1); + + for y := 0 to h do + for x := 0 to w do + Result[y][x] := Create_CTSInfo(cts, + data[y][x].R, data[y][x].G, data[y][x].B, + Tolerance, hueMod, satMod); +end; + +procedure Free_CTSInfoArray(i: TCTSInfoArray); +var + c: integer; +begin + for c := high(i) downto 0 do + Free_CTSInfo(i[c]); + SetLength(i, 0); +end; + +procedure Free_CTSInfo2DArray(i: TCTSInfo2DArray); +var + x, y: integer; +begin + for y := high(i) downto 0 do + for x := high(i[y]) downto 0 do + Free_CTSInfo(i[y][x]); + SetLength(i, 0); +end; + +function Get_CTSCompare(cts: Integer): TCTSCompareFunction; + +begin + case cts of + 0: Result := @ColorSame_cts0; + 1: Result := @ColorSame_cts1; + 2: Result := @ColorSame_cts2; end; end; @@ -399,37 +608,37 @@ var PtrData: TRetData; Ptr: PRGB32; PtrInc: Integer; - clR, clG, clB : byte; dX, dY, xx, yy: Integer; - h,s,l,hmod,smod : extended; - Ccts : integer; + + compare: TCTSCompareFunction; + ctsinfo: TCTSInfo; begin Result := 0; DefaultOperations(xs, ys, xe, ye); + dX := xe - xs; dY := ye - ys; - ColorToRGB(Color, clR, clG, clB); + PtrData := TClient(Client).IOManager.ReturnData(xs, ys, dX + 1, dY + 1); Ptr := PtrData.Ptr; PtrInc := PtrData.IncPtrWith; - CCts := Self.CTS; result := 0; - if cts = 2 then - begin; - RGBToHSL(clR,clG,clB,h,s,l); - hmod := Self.hueMod; - smod := Self.satMod; - end; + + ctsinfo := Create_CTSInfo(Self.CTS, Color, Tolerance, hueMod, satMod); + compare := Get_CTSCompare(Self.CTS); + for yy := ys to ye do begin; for xx := xs to xe do - begin; - if ColorSame(CCts,Tolerance,clR,clG,clB,Ptr^.r,Ptr^.g,Ptr^.b,H,S,L,hmod,smod) then + begin + if compare(ctsinfo, Ptr) then inc(result); Inc(Ptr); end; Inc(Ptr, PtrInc) end; + + Free_CTSInfo(ctsinfo); TClient(Client).IOManager.FreeReturnData; end; @@ -569,9 +778,11 @@ var PtrData: TRetData; RowData : TPRGB32Array; dX, dY, clR, clG, clB,i,Hispiral: Integer; - H1, S1, L1, H2, S2, L2: Extended; - HueXTol, SatXTol: Extended; - label Hit; + +var + j: integer; + compare: TCTSCompareFunction; + ctsinfo: TCTSInfo; begin Result := false; @@ -583,8 +794,6 @@ begin dY := ye - ys; //next, convert the color to r,g,b ColorToRGB(Color, clR, clG, clB); - if Cts = 2 then - RGBToHSL(clR,clG,clB,H1,S1,L1); PtrData := TClient(Client).IOManager.ReturnData(xs, ys, dX + 1, dY + 1); //Load rowdata @@ -592,47 +801,34 @@ begin //Load the spiral path LoadSpiralPath(x-xs,y-ys,0,0,dx,dy); HiSpiral := (dy+1) * (dx + 1) -1; - case CTS of - 0: - for i := 0 to HiSpiral do - if ((abs(clB-RowData[ClientTPA[i].y][ClientTPA[i].x].B) <= Tol) and - (abs(clG-RowData[ClientTPA[i].y][ClientTPA[i].x].G) <= Tol) and - (Abs(clR-RowData[ClientTPA[i].y][ClientTPA[i].x].R) <= Tol)) then - goto Hit; - 1: + ctsinfo := Create_CTSInfo(Self.CTS, Color, Tol, hueMod, satMod); + compare := Get_CTSCompare(Self.CTS); + + i := -1; + for j := 0 to HiSpiral do + begin + if compare(ctsinfo, @RowData[ClientTPA[j].y][ClientTPA[j].x]) then begin - Tol := Sqr(Tol); - for i := 0 to HiSpiral do - if (sqr(clB - RowData[ClientTPA[i].y][ClientTPA[i].x].B) + - sqr(clG - RowData[ClientTPA[i].y][ClientTPA[i].x].G) + - sqr(clR-RowData[ClientTPA[i].y][ClientTPA[i].x].R)) <= Tol then - goto Hit; - end; - 2: - { Can be optimized a lot... RGBToHSL isn't really inline, } - begin - HueXTol := hueMod * Tol; - SatXTol := satMod * Tol; - for i := 0 to HiSpiral do - begin - RGBToHSL(RowData[ClientTPA[i].y][ClientTPA[i].x].R, - RowData[ClientTPA[i].y][ClientTPA[i].x].G, - RowData[ClientTPA[i].y][ClientTPA[i].x].B,H2,S2,L2); - if ((abs(H1 - H2) <= HueXTol) and (abs(S1 - S2) <= SatXTol) and (abs(L1 - L2) <= Tol)) then - goto Hit; - end; + i := j; + break; end; end; - Result := False; - TClient(Client).IOManager.FreeReturnData; - Exit; - Hit: + Free_CTSInfo(ctsinfo); + + if i = -1 then + begin + Result := False; + TClient(Client).IOManager.FreeReturnData; + Exit; + end else + begin Result := True; x := ClientTPA[i].x + xs; y := ClientTPA[i].y + ys; TClient(Client).IOManager.FreeReturnData; + end; end; function TMFinder.FindColoredArea(var x, y: Integer; Color, xs, ys, xe, ye, MinArea: Integer): Boolean; @@ -698,7 +894,6 @@ begin Ptr := Before; Break; end; - Inc(Ptr, PtrInc); end; end; Inc(Ptr); @@ -847,11 +1042,13 @@ var PtrData: TRetData; Ptr: PRGB32; PtrInc: Integer; - dX, dY, clR, clG, clB, xx, yy: Integer; - H1, S1, L1, H2, S2, L2: Extended; - HueXTol, SatXTol: Extended; + dX, dY: Integer; + xx, yy: integer; + compare: TCTSCompareFunction; + ctsinfo: TCTSInfo; label Hit; + begin Result := false; // checks for valid xs,ys,xe,ye? (may involve GetDimensions) @@ -860,10 +1057,6 @@ begin // calculate delta x and y dX := xe - xs; dY := ye - ys; - //next, convert the color to r,g,b - ColorToRGB(Color, clR, clG, clB); - if Cts = 2 then - RGBToHSL(clR,clG,clB,H1,S1,L1); PtrData := TClient(Client).IOManager.ReturnData(xs, ys, dX + 1, dY + 1); @@ -872,54 +1065,22 @@ begin Ptr := PtrData.Ptr; PtrInc := PtrData.IncPtrWith; - case CTS of - 0: - for yy := ys to ye do - begin - for xx := xs to xe do - begin - if ((abs(clB-Ptr^.B) <= Tol) and (abs(clG-Ptr^.G) <= Tol) and (Abs(clR-Ptr^.R) <= Tol)) then - goto Hit; - inc(Ptr); - end; - Inc(Ptr, PtrInc); - end; + ctsinfo := Create_CTSInfo(Self.CTS, Color, Tol, hueMod, satMod); + compare := Get_CTSCompare(Self.CTS); - 1: + for yy := ys to ye do + begin + for xx := xs to xe do begin - Tol := Sqr(Tol); - - for yy := ys to ye do - begin - for xx := xs to xe do - begin - if (sqr(clB - Ptr^.B) + sqr(clG - Ptr^.G) + sqr(clR-Ptr^.R)) <= Tol then - goto Hit; - inc(ptr); - end; - Inc(Ptr, PtrInc); - end; - - end; - 2: - { Can be optimized a lot... RGBToHSL isn't really inline, } - begin - HueXTol := hueMod * Tol; - SatXTol := satMod * Tol; - for yy := ys to ye do - begin - for xx := xs to xe do - begin - RGBToHSL(Ptr^.R,Ptr^.G,Ptr^.B,H2,S2,L2); - if ((abs(H1 - H2) <= HueXTol) and (abs(S1 - S2) <= SatXTol) and (abs(L1 - L2) <= Tol)) then - goto Hit; - inc(Ptr); - end; - Inc(Ptr, PtrInc); - end; + if compare(ctsinfo, Ptr) then + goto Hit; + inc(Ptr); end; + Inc(Ptr, PtrInc); end; + Result := False; + Free_CTSInfo(ctsinfo); TClient(Client).IOManager.FreeReturnData; Exit; @@ -927,6 +1088,7 @@ begin Result := True; x := xx; y := yy; + Free_CTSInfo(ctsinfo); TClient(Client).IOManager.FreeReturnData; end; @@ -939,8 +1101,13 @@ var clR, clG, clB : Byte; H1, S1, L1: Extended; NotFound : Boolean; + + compare: TCTSCompareFunction; + ctsinfo: TCTSInfo; + label Hit; + begin Result := false; // checks for valid xs,ys,xe,ye? (may involve GetDimensions) @@ -960,13 +1127,17 @@ begin Ptr := PtrData.Ptr; PtrInc := PtrData.IncPtrWith; Count := 0; + + ctsinfo := Create_CTSInfo(Self.CTS, Color, Tol, hueMod, satMod); + compare := Get_CTSCompare(Self.CTS); + for yy := ys to ye do begin; for xx := xs to xe do begin; NotFound := False; // Colour comparison here. - if ColorSame(CTS, Tol, Ptr^.R, Ptr^.G, Ptr^.B, clR, clG, clB, H1, S1, L1, huemod, satmod) then + if compare(ctsinfo, Ptr) then begin Before := Ptr; for fy := yy to ye do @@ -974,7 +1145,7 @@ begin for fx := xx to xe do begin Inc(Ptr); - if not ColorSame(CTS, Tol, Ptr^.R, Ptr^.G, Ptr^.B, clR, clG, clB, H1, S1, L1, huemod, satmod) then + if compare(ctsinfo, Ptr) then begin NotFound := True; Break; @@ -998,6 +1169,7 @@ begin end; Result := False; + Free_CTSInfo(ctsinfo); TClient(Client).IOManager.FreeReturnData; Exit; @@ -1005,27 +1177,28 @@ begin Result := True; x := xx; y := yy; + Free_CTSInfo(ctsinfo); TClient(Client).IOManager.FreeReturnData; end; function TMFinder.FindColorsTolerance(out Points: TPointArray; Color, xs, ys, xe, ye, Tol: Integer): Boolean; var - PtrData: TRetData; - Ptr: PRGB32; - PtrInc,C: Integer; - dX, dY, clR, clG, clB, xx, yy: Integer; - H1, S1, L1, H2, S2, L2, hueXTol, satXTol: Extended; + PtrData: TRetData; + Ptr: PRGB32; + PtrInc,C: Integer; + dX, dY: Integer; + + xx, yy: integer; + compare: TCTSCompareFunction; + ctsinfo: TCTSInfo; + begin Result := false; DefaultOperations(xs,ys,xe,ye); dX := xe - xs; dY := ye - ys; - //next, convert the color to r,g,b - ColorToRGB(Color, clR, clG, clB); - if CTS = 2 then - ColorToHSL(color,H1,S1,L1); PtrData := TClient(Client).IOManager.ReturnData(xs, ys, dX + 1, dY + 1); @@ -1034,65 +1207,33 @@ begin Ptr := PtrData.Ptr; PtrInc := PtrData.IncPtrWith; c := 0; - case CTS of - 0: - for yy := ys to ye do - begin - for xx := xs to xe do - begin - if ((abs(clB-Ptr^.B) <= Tol) and (abs(clG-Ptr^.G) <= Tol) and (Abs(clR-Ptr^.R) <= Tol)) then - begin; - ClientTPA[c].x := xx; - ClientTPA[c].y := yy; - inc(c); - end; - inc(Ptr); - end; - Inc(Ptr, PtrInc); - end; - 1: - for yy := ys to ye do - begin - for xx := xs to xe do - begin - if (Sqrt(sqr(clR-Ptr^.R) + sqr(clG - Ptr^.G) + sqr(clB - Ptr^.B)) <= Tol) then - begin; - ClientTPA[c].x := xx; - ClientTPA[c].y := yy; - inc(c); - end; - inc(ptr); - end; - Inc(Ptr, PtrInc); - end; + ctsinfo := Create_CTSInfo(Self.CTS, Color, Tol, hueMod, satMod); + compare := Get_CTSCompare(Self.CTS); - 2: + for yy := ys to ye do + begin + for xx := xs to xe do begin - HueXTol := hueMod * Tol; - SatXTol := satMod * Tol; - for yy := ys to ye do + if compare(ctsinfo, Ptr) then begin - for xx := xs to xe do - begin - RGBToHSL(Ptr^.R,Ptr^.G,Ptr^.B,H2,S2,L2); - if ((abs(H1 - H2) <= HueXTol) and (abs(S1 - S2) <= SatXTol) and (abs(L1 - L2) <= Tol)) then - begin; - ClientTPA[c].x := xx; - ClientTPA[c].y := yy; - Inc(c); - end; - Inc(Ptr) - end; - Inc(Ptr, PtrInc); + ClientTPA[c].x := xx; + ClientTPA[c].y := yy; + inc(c); end; + inc(Ptr); end; + Inc(Ptr, PtrInc); end; + SetLength(Points, C); Move(ClientTPA[0], Points[0], C * SizeOf(TPoint)); Result := C > 0; + + Free_CTSInfo(ctsinfo); TClient(Client).IOManager.FreeReturnData; end; + function TMFinder.FindColorsToleranceOptimised(out Points: TPointArray; Color, xs, ys, xe, ye, Tol: Integer): Boolean; var @@ -1224,14 +1365,17 @@ begin end; function TMFinder.FindColorsSpiralTolerance(x, y: Integer; - out Points: TPointArray; color, xs, ys, xe, ye: Integer; Tolerance: Integer + out Points: TPointArray; color, xs, ys, xe, ye: Integer; Tol: Integer ): boolean; var - PtrData: TRetData; - c : integer; - RowData : TPRGB32Array; - dX, dY, clR, clG, clB, i,SpiralHi: Integer; - H1, S1, L1, H2, S2, L2, HueXTol, SatXTol: Extended; + PtrData: TRetData; + c : integer; + RowData : TPRGB32Array; + dX, dY, SpiralHi, i: Integer; + + compare: TCTSCompareFunction; + ctsinfo: TCTSInfo; + begin Result := false; DefaultOperations(xs,ys,xe,ye); @@ -1239,64 +1383,34 @@ begin dX := xe - xs; dY := ye - ys; //next, convert the color to r,g,b - ColorToRGB(Color, clR, clG, clB); - ColorToHSL(Color, H1, S1, L1); PtrData := TClient(Client).IOManager.ReturnData(xs, ys, dX + 1, dY + 1); c := 0; + ctsinfo := Create_CTSInfo(Self.CTS, Color, Tol, hueMod, satMod); + compare := Get_CTSCompare(Self.CTS); + //Load rowdata RowData:= CalculateRowPtrs(ptrdata,dy+1); //Load the spiral path - LoadSpiralPath(x-xs,y-ys,0,0,dx,dy); + LoadSpiralPath(x-xs,y-ys,0,0,dx,dy); { Fills ClientTPA with Spiral path } + SpiralHi := (dx + 1) * (dy + 1) - 1; - case CTS of - 0: - for i := 0 to SpiralHi do - if ((abs(clB-RowData[ClientTPA[i].y][ClientTPA[i].x].B) <= Tolerance) and - (abs(clG-RowData[ClientTPA[i].y][ClientTPA[i].x].G) <= Tolerance) and - (Abs(clR-RowData[ClientTPA[i].y][ClientTPA[i].x].R) <= Tolerance)) then - begin; - ClientTPA[c].x := ClientTPA[i].x + xs; - ClientTPA[c].y := ClientTPA[i].y + ys; - inc(c); - end; - - - 1: - for i := 0 to SpiralHi do - if (Sqrt(sqr(clR - RowData[ClientTPA[i].y][ClientTPA[i].x].R) + - sqr(clG - RowData[ClientTPA[i].y][ClientTPA[i].x].G) + - sqr(clB - RowData[ClientTPA[i].y][ClientTPA[i].x].B)) <= Tolerance) then - begin; - ClientTPA[c].x := ClientTPA[i].x + xs; - ClientTPA[c].y := ClientTPA[i].y + ys; - inc(c); - end; - - 2: + for i := 0 to SpiralHi do + if compare(ctsinfo, @RowData[ClientTPA[i].y][ClientTPA[i].x]) then begin; - HueXTol := hueMod * Tolerance; - SatXTol := satMod * Tolerance; - for i := 0 to SpiralHi do - begin; - RGBToHSL(RowData[ClientTPA[i].y][ClientTPA[i].x].R, - RowData[ClientTPA[i].y][ClientTPA[i].x].G, - RowData[ClientTPA[i].y][ClientTPA[i].x].B, - H2,S2,L2); - if ((abs(H1 - H2) <= (HueXTol)) and (abs(S1 - S2) <= (satXTol)) and (abs(L1 - L2) <= Tolerance)) then - begin; - ClientTPA[c].x := ClientTPA[i].x + xs; - ClientTPA[c].y := ClientTPA[i].y + ys; - inc(c); - end; - end; + { We can re-use the ClientTPA to store results. } + ClientTPA[c].x := ClientTPA[i].x + xs; + ClientTPA[c].y := ClientTPA[i].y + ys; + inc(c); end; - end; + SetLength(Points, C); Move(ClientTPA[0], Points[0], C * SizeOf(TPoint)); Result := C > 0; + + Free_CTSInfo(ctsinfo); TClient(Client).IOManager.FreeReturnData; end; @@ -1511,11 +1625,13 @@ var xBmp,yBmp : integer; tmpY : integer; dX, dY, xx, yy: Integer; - CCTS : integer; - H,S,L,HMod,SMod : extended; SkipCoords : T2DBoolArray; + + ctsinfoarray: TCTSInfo2DArray; + compare: TCTSCompareFunction; + label NotFoundBmp; - { Don't know if the compiler has any speed-troubles with goto jumping in nested for loops. } + { Don't know if the compiler has any speed-troubles with goto jumping in nested for loops. } begin Result := false; @@ -1536,10 +1652,10 @@ begin //Heck our bitmap cannot be outside the search area dX := dX - bmpW; dY := dY - bmpH; - //Compiler hints - HMod := 0;SMod := 0;H := 0.0;S := 0.0; L := 0.0; - CCTS := Self.CTS; + ctsinfoarray := Create_CTSInfo2DArray(Self.CTS, bmpW, bmpH, BmpRowData, + Tolerance, self.hueMod, self.satMod); + compare := Get_CTSCompare(Self.CTS); //Get the "skip coords". CalculateBitmapSkipCoords(Bitmap,SkipCoords); @@ -1551,21 +1667,24 @@ begin tmpY := yBmp + yy; for xBmp := 0 to BmpW do if not SkipCoords[yBmp][xBmp] then - if not ColorSame(CCTS,tolerance, - BmpRowData[yBmp][xBmp].R,BmpRowData[yBmp][xBmp].G,BmpRowData[yBmp][xBmp].B, - MainRowdata[tmpY][xBmp + xx].R,MainRowdata[tmpY][xBmp + xx].G,MainRowdata[tmpY][xBmp + xx].B, - H,S,L,HMod,SMod) then + if not compare(ctsinfoarray[yBmp][xBmp], + @MainRowData[tmpY][xBmp + xx]) then goto NotFoundBmp; - end; + //We did find the Bmp, otherwise we would be at the part below + + Free_CTSInfo2DArray(ctsinfoarray); TClient(Client).IOManager.FreeReturnData; + x := xx + xs; y := yy + ys; result := true; - exit; + Exit; NotFoundBmp: end; + + Free_CTSInfo2DArray(ctsinfoarray); TClient(Client).IOManager.FreeReturnData; end; @@ -1641,9 +1760,11 @@ var xBmp,yBmp : integer; tmpY : integer; dX, dY, i,HiSpiral: Integer; - CCTS : integer; - H,S,L,HMod,SMod : extended; SkipCoords : T2DBoolArray; + + ctsinfoarray: TCTSInfo2DArray; + compare: TCTSCompareFunction; + label NotFoundBmp; { Don't know if the compiler has any speed-troubles with goto jumping in nested for loops. } @@ -1669,9 +1790,11 @@ begin //Load the spiral into memory LoadSpiralPath(x-xs,y-ys,0,0,dX,dY); HiSpiral := (dx+1) * (dy+1) - 1; - //Compiler hints - HMod := 0;SMod := 0;H := 0.0;S := 0.0; L := 0.0; - CCTS := Self.CTS; + + + ctsinfoarray := Create_CTSInfo2DArray(Self.CTS, bmpW, bmpH, BmpRowData, + Tolerance, self.hueMod, self.satMod); + compare := Get_CTSCompare(Self.CTS); //Get the "skip coords". CalculateBitmapSkipCoords(Bitmap,SkipCoords); @@ -1682,15 +1805,14 @@ begin tmpY := yBmp + ClientTPA[i].y; for xBmp := 0 to BmpW do if not SkipCoords[yBmp][xBmp] then - if not ColorSame(CCTS,tolerance, - BmpRowData[yBmp][xBmp].R,BmpRowData[yBmp][xBmp].G,BmpRowData[yBmp][xBmp].B, - MainRowdata[tmpY][xBmp + ClientTPA[i].x].R,MainRowdata[tmpY][xBmp + ClientTPA[i].x].G, - MainRowdata[tmpY][xBmp + ClientTPA[i].x].B, - H,S,L,HMod,SMod) then + if not compare(ctsinfoarray[yBmp][xBmp], + @MainRowData[tmpY][xBmp + ClientTPA[i].x]) then goto NotFoundBmp; end; //We did find the Bmp, otherwise we would be at the part below + + Free_CTSInfo2DArray(ctsinfoarray); TClient(Client).IOManager.FreeReturnData; x := ClientTPA[i].x + xs; @@ -1699,6 +1821,7 @@ begin exit; NotFoundBmp: end; + Free_CTSInfo2DArray(ctsinfoarray); TClient(Client).IOManager.FreeReturnData; end; @@ -1713,9 +1836,11 @@ var tmpY : integer; dX, dY, i,HiSpiral: Integer; FoundC : integer; - CCTS : integer; - H,S,L,HMod,SMod : extended; SkipCoords : T2DBoolArray; + + ctsinfoarray: TCTSInfo2DArray; + compare: TCTSCompareFunction; + label NotFoundBmp; { Don't know if the compiler has any speed-troubles with goto jumping in nested for loops. } @@ -1741,10 +1866,12 @@ begin //Load the spiral into memory LoadSpiralPath(x-xs,y-ys,0,0,dX,dY); HiSpiral := (dx+1) * (dy+1) - 1; - //Compiler hints - HMod := 0;SMod := 0;H := 0.0;S := 0.0; L := 0.0; - CCTS := Self.CTS; FoundC := 0; + + ctsinfoarray := Create_CTSInfo2DArray(Self.CTS, bmpW, bmpH, BmpRowData, + Tolerance, self.hueMod, self.satMod); + compare := Get_CTSCompare(Self.CTS); + //Get the "skip coords". CalculateBitmapSkipCoords(Bitmap,SkipCoords); for i := 0 to HiSpiral do @@ -1754,11 +1881,8 @@ begin tmpY := yBmp + ClientTPA[i].y; for xBmp := 0 to BmpW do if not SkipCoords[yBmp][xBmp] then - if not ColorSame(CCTS,tolerance, - BmpRowData[yBmp][xBmp].R,BmpRowData[yBmp][xBmp].G,BmpRowData[yBmp][xBmp].B, - MainRowdata[tmpY][xBmp + ClientTPA[i].x].R,MainRowdata[tmpY][xBmp + ClientTPA[i].x].G, - MainRowdata[tmpY][xBmp + ClientTPA[i].x].B, - H,S,L,HMod,SMod) then + if not compare(ctsinfoarray[yBmp][xBmp], + @MainRowData[tmpY][xBmp + ClientTPA[i].x]) then goto NotFoundBmp; end; @@ -1774,6 +1898,8 @@ begin SetLength(Points,FoundC); Move(ClientTPA[0], Points[0], FoundC * SizeOf(TPoint)); end; + + Free_CTSInfo2DArray(ctsinfoarray); TClient(Client).IOManager.FreeReturnData; end; @@ -1796,6 +1922,10 @@ var TotalC : integer; SkipCoords : T2DBoolArray; PointsLeft : T2DIntArray; + + ctsinfoarray: TCTSInfo2DArray; + compare: TCTSCompareFunction; + label FoundBMPPoint, Madness; { Don't know if the compiler has any speed-troubles with goto jumping in nested for loops. } @@ -1823,6 +1953,11 @@ begin Accuracy := 0; BestCount := -1; BestPT := Point(-1,-1); + + ctsinfoarray := Create_CTSInfo2DArray(Self.CTS, bmpW, bmpH, BmpRowData, + Tolerance, self.hueMod, self.satMod); + compare := Get_CTSCompare(Self.CTS); + //Get the "skip coords". and PointsLeft (so we can calc whether we should stop searching or not ;-). CalculateBitmapSkipCoordsEx(Bitmap,SkipCoords,TotalC,PointsLeft); @@ -1849,8 +1984,8 @@ begin xEnd := Min(xx+range + xBmp,SearchdX); for RangeX := xStart to xEnd do begin; - if Sqrt(sqr(BmpRowData[yBmp][xBmp].R - MainRowdata[RangeY][RangeX].R) + sqr(BmpRowData[yBmp][xBmp].G - MainRowdata[RangeY][RangeX].G) - +sqr(BmpRowData[yBmp][xBmp].B - MainRowdata[RangeY][RangeX].B)) <= tolerance then + if not compare(ctsinfoarray[yBmp][xBmp], + @MainRowData[rangeY][rangeX]) then goto FoundBMPPoint; end; end; @@ -1868,7 +2003,8 @@ begin BestCount := GoodCount; BestPT := Point(xx+xs,yy+ys); if GoodCount = TotalC then - begin; + begin + Free_CTSInfo2DArray(ctsinfoarray); TClient(Client).IOManager.FreeReturnData; x := BestPT.x; y := BestPT.y; @@ -1877,6 +2013,8 @@ begin end; end; end; + + Free_CTSInfo2DArray(ctsinfoarray); TClient(Client).IOManager.FreeReturnData; if BestCount = 0 then Exit; @@ -1911,16 +2049,9 @@ end; //MaxToFind, if it's < 1 it won't stop looking function TMFinder.FindDTMs(DTM: TMDTM; out Points: TPointArray; x1, y1, x2, y2, maxToFind: Integer): Boolean; var - //Cache DTM stuff - Len : integer; //Len of the points - DPoints : PMDTMPoint; //DTM Points - // Colours of DTMs - clR,clG,clB : array of byte; - - //Similar colors stuff - hh,ss,ll: array of extended; - hmod,smod: extended; - Ccts : integer; + //Cache DTM stuff + Len : integer; //Len of the points + DPoints : PMDTMPoint; //DTM Points // Bitwise b: Array of Array of Integer; @@ -1948,11 +2079,13 @@ var goodPoints: Array of Boolean; + col_arr, tol_arr: Array of Integer; + ctsinfoarray: TCTSInfoArray; + compare: TCTSCompareFunction; + label theEnd; label AnotherLoopEnd; - - begin // Is the area valid? DefaultOperations(x1, y1, x2, y2); @@ -1983,26 +2116,22 @@ begin FillChar(b[i][0], SizeOf(Integer) * (H+1), 0); end; - // C = DTM.C - SetLength(clR,Len); - SetLength(clG,Len); - SetLength(clB,Len); - for i := 0 to Len - 1 do - ColorToRGB(DPoints[i].c,clR[i],clG[i],clB[i]); - - SetLength(hh,Len); - SetLength(ss,Len); - SetLength(ll,Len); - for i := 0 to Len - 1 do - ColorToHSL(DPoints[i].c,hh[i],ss[i],ll[i]); - - GetToleranceSpeed2Modifiers(hMod, sMod); - - ccts := CTS; - // Retreive Client Data. PtrData := TClient(Client).IOManager.ReturnData(x1, y1, W + 1, H + 1); + SetLength(col_arr, Len); + SetLength(tol_arr, Len); + // C = DTM.C + for i := 0 to Len - 1 do + begin + col_arr[i] := DPoints[i].c; + tol_arr[i] := DPoints[i].t; + end; + + ctsinfoarray := Create_CTSInfoArray(Self.CTS, + col_arr, tol_arr, self.hueMod, self.satMod); + compare := Get_CTSCompare(Self.CTS); + cd := CalculateRowPtrs(PtrData, h + 1); //CD starts at 0,0.. We must adjust the MA, since this is still based on the xs,ys,xe,ye box. MA.x1 := MA.x1 - x1; @@ -2036,7 +2165,7 @@ begin // Checking point i now. (Store that we matched it) ch[xxx][yyy]:= ch[xxx][yyy] or (1 shl i); // if SimilarColors(dtm.c[i], rgbtocolor(cd[yyy][xxx].R, cd[yyy][xxx].G, cd[yyy][xxx].B), DPoints[i].t) then - if ColorSame(ccts,DPoints[i].t,clR[i],clG[i],clB[i],cd[yyy][xxx].R, cd[yyy][xxx].G, cd[yyy][xxx].B,hh[i],ss[i],ll[i],hmod,smod) then + if compare(ctsinfoarray[i], @cd[yyy][xxx]) then b[xxx][yyy] := b[xxx][yyy] or (1 shl i); end; @@ -2065,6 +2194,8 @@ begin AnotherLoopEnd: end; TheEnd: + + Free_CTSInfoArray(ctsinfoarray); TClient(Client).IOManager.FreeReturnData; SetLength(Points, pc); @@ -2081,14 +2212,15 @@ var begin FindDTMsRotated(dtm, P, x1, y1, x2, y2, sAngle, eAngle, aStep, F,Alternating,1); if Length(P) = 0 then - exit(false); + exit(False); aFound := F[0][0]; x := P[0].x; y := P[0].y; Exit(True); end; -procedure RotPoints_DTM(const P: TPointArray;var RotTPA : TPointArray; const A: Extended); +procedure RotPoints_DTM(const P: TPointArray;var RotTPA : TPointArray; const A: + Extended); inline; var I, L: Integer; begin @@ -2102,18 +2234,11 @@ end; function TMFinder.FindDTMsRotated(DTM: TMDTM; out Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: T2DExtendedArray;Alternating : boolean; maxToFind: Integer): Boolean; var - //Cached variables - Len : integer; - DPoints : PMDTMPoint; - DTPA : TPointArray; - RotTPA: TPointArray; - // Colours of DTMs - clR,clG,clB : array of byte; - - //Similar colors stuff - hh,ss,ll: array of extended; - hmod,smod: extended; - Ccts : integer; + //Cached variables + Len : integer; + DPoints : PMDTMPoint; + DTPA : TPointArray; + RotTPA: TPointArray; // Bitwise b: Array of Array of Integer; @@ -2143,11 +2268,14 @@ var // point count pc: Integer = 0; - ac: Integer = 0; goodPoints: Array of Boolean; s: extended; + col_arr, tol_arr: Array of Integer; + ctsinfoarray: TCTSInfoArray; + compare: TCTSCompareFunction; + label theEnd; label AnotherLoopEnd; @@ -2183,20 +2311,6 @@ begin FillChar(ch[i][0], SizeOf(Integer) * (H+1), 0); end; - // Convert colors to there components - SetLength(clR,Len); - SetLength(clG,Len); - SetLength(clB,Len); - for i := 0 to Len - 1 do - ColorToRGB(DPoints[i].c,clR[i],clG[i],clB[i]); - //Compiler hints - - SetLength(hh,Len); - SetLength(ss,Len); - SetLength(ll,Len); - for i := 0 to Len - 1 do - ColorToHSL(DPoints[i].c,hh[i],ss[i],ll[i]); - { When we search for a rotated DTM, everything is the same, except the coordinates.. Therefore we create a TPA of the 'original' DTM, containing all the Points. @@ -2206,12 +2320,22 @@ begin for i := 0 to len-1 do DTPA[i] := Point(DPoints[i].x,DPoints[i].y); - GetToleranceSpeed2Modifiers(hMod, sMod); - ccts := CTS; - // Retreive Client Data. PtrData := TClient(Client).IOManager.ReturnData(x1, y1, W + 1, H + 1); + SetLength(col_arr, Len); + SetLength(tol_arr, Len); + // C = DTM.C + for i := 0 to Len - 1 do + begin + col_arr[i] := DPoints[i].c; + tol_arr[i] := DPoints[i].t; + end; + + ctsinfoarray := Create_CTSInfoArray(Self.CTS, + col_arr, tol_arr, self.hueMod, self.satMod); + compare := Get_CTSCompare(Self.CTS); + cd := CalculateRowPtrs(PtrData, h + 1); SetLength(aFound, 0); SetLength(Points, 0); @@ -2257,7 +2381,7 @@ begin // Checking point i now. (Store that we matched it) ch[xxx][yyy]:= ch[xxx][yyy] or (1 shl i); - if ColorSame(ccts,DPoints[i].t,clR[i],clG[i],clB[i],cd[yyy][xxx].R, cd[yyy][xxx].G, cd[yyy][xxx].B,hh[i],ss[i],ll[i],hmod,smod) then + if compare(ctsinfoarray[i], @cd[yyy][xxx]) then b[xxx][yyy] := b[xxx][yyy] or (1 shl i); end; @@ -2289,7 +2413,6 @@ begin goto theEnd; AnotherLoopEnd: end; - ac := 0; if Alternating then begin if AngleSteps mod 2 = 0 then //This means it's an even number, thus we must add a positive step @@ -2301,7 +2424,10 @@ begin s := s + aStep; end; TheEnd: - TClient(Client).IOManager.FreeReturnData; + + Free_CTSInfoArray(ctsinfoarray); + TClient(Client).IOManager.FreeReturnData; + Result := (pc > 0); { Don't forget to pre calculate the rotated points at the start. Saves a lot of rotatepoint() calls. } diff --git a/Units/MMLCore/mufasatypes.pas b/Units/MMLCore/mufasatypes.pas index ef1adea..a5e4cf2 100644 --- a/Units/MMLCore/mufasatypes.pas +++ b/Units/MMLCore/mufasatypes.pas @@ -60,6 +60,14 @@ type TRGB32Array = array of TRGB32; TPRGB32Array = array of PRGB32; //Array of Pointers + THSL = record + H, S, L: extended; + end; + PHSL = ^THSL; + + THSLArray = array of THSL; + T2DHSLArray = array of array of THSL; + TRetData = record Ptr : PRGB32; IncPtrWith : integer;