From 58ea6021cd0cee3bd54f8ce93713bedc9ff3feb4 Mon Sep 17 00:00:00 2001 From: Merlijn Wajer Date: Thu, 16 Jun 2011 14:26:20 +0200 Subject: [PATCH] CTS work. CTS 2 is still broken for bitmaps. --- Tests/PS/BmpBenchmark.simba | 25 +++++ Units/MMLCore/bitmaps.pas | 20 +++- Units/MMLCore/finder.pas | 178 +++++++++++++++++++++++++--------- Units/MMLCore/mufasatypes.pas | 8 ++ 4 files changed, 186 insertions(+), 45 deletions(-) create mode 100644 Tests/PS/BmpBenchmark.simba 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/Units/MMLCore/bitmaps.pas b/Units/MMLCore/bitmaps.pas index 335550f..f04effa 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,xe-xs+1,ye-ys+1); + for y := ys to ye do + for x := xs to xe do + begin + RGBToHSL(FData[y*w+x].R, FData[y*w+x].G, FData[y*w+x].B, + Result[x-xs][y-ys].H, Result[x-xs][y-ys].S, + Result[x-xs][y-ys].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/finder.pas b/Units/MMLCore/finder.pas index 6b51ddc..d54af95 100644 --- a/Units/MMLCore/finder.pas +++ b/Units/MMLCore/finder.pas @@ -37,6 +37,9 @@ uses { 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? ;) + + + Benchmarks with FindBitmapToleranceIn on _very_ high tolerance! } type @@ -336,7 +339,21 @@ end; stack. } -function ColorSameCTS2(Tolerance: Integer; H1,S1,L1,H2,S2,L2, hueMod, satMod: extended): +{ Not using var for each arg now, as it should be inlined } +function ColorSame_cts0(Tolerance : Integer; R1,G1,B1,R2,G2,B2 : byte) : boolean; inline; + +begin + Result := ((Abs(R1-R2) <= Tolerance) and (Abs(G1-G2) <= Tolerance) and (Abs(B1-B2) <= Tolerance)); +end; + +{ Not using var for each arg now, as it should be inlined } +function ColorSame_cts1(Tolerance : Integer; R1,G1,B1,R2,G2,B2 : byte) : boolean; inline; + +begin + Result := (Sqrt(sqr(R1-R2) + sqr(G1-G2) + sqr(B1-B2)) <= Tolerance); +end; + +function ColorSame_cts2(Tolerance: Integer; H1,S1,L1,H2,S2,L2, hueMod, satMod: extended): boolean; inline; begin result := ((abs(H1 - H2) <= (hueMod * Tolerance)) and @@ -896,7 +913,7 @@ var Inc(Ptr, PtrInc); end; - result.x := -1; result.y := -1; + Result := Point(-1, -1); end; function cts1: tpoint; @@ -915,7 +932,7 @@ var Inc(Ptr, PtrInc); end; - result.x := -1; result.y := -1; + Result := Point(-1, -1); end; function cts2: tpoint; @@ -938,7 +955,7 @@ var Inc(Ptr, PtrInc); end; - result.x := -1; result.y := -1; + Result := Point(-1, -1); end; begin @@ -1291,7 +1308,7 @@ var PtrData: TRetData; c : integer; RowData : TPRGB32Array; - dX, dY, clR, clG, clB, i,SpiralHi: Integer; + dX, dY, clR, clG, clB, SpiralHi: Integer; procedure cts0; var i: integer; @@ -1575,21 +1592,106 @@ end; function TMFinder.FindBitmapToleranceIn(bitmap: TMufasaBitmap; out x, y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer): Boolean; var - MainRowdata : TPRGB32Array; - BmpRowData : TPRGB32Array; - PtrData : TRetData; - BmpW,BmpH : integer; - xBmp,yBmp : integer; - tmpY : integer; - dX, dY, xx, yy: Integer; - CCTS : integer; - H,S,L,HMod,SMod : extended; - SkipCoords : T2DBoolArray; -label NotFoundBmp; + MainRowdata : TPRGB32Array; + PtrData : TRetData; + BmpW,BmpH : integer; + dX, dY: Integer; + SkipCoords : T2DBoolArray; + foundP: TPoint; + + function cts0: tpoint; + var xx, yy, xBmp, yBmp, tmpY: integer; + BmpRowData : TPRGB32Array; + label NotFoundBmp; + begin + BmpRowData:= CalculateRowPtrs(bitmap); + + for yy := 0 to dY do + for xx := 0 to dX do + begin + for yBmp:= 0 to BmpH do + begin + tmpY := yBmp + yy; + for xBmp := 0 to BmpW do + if not SkipCoords[yBmp][xBmp] then + if not ColorSame_cts0(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) then + goto NotFoundBmp; + end; + exit(Point(xx + xs, yy + ys)); + NotFoundBmp: // double break + end; + + Result := Point(-1, -1); + end; { Don't know if the compiler has any speed-troubles with goto jumping in nested for loops. } + function cts1: tpoint; + var xx, yy, xBmp, yBmp, tmpY: integer; + BmpRowData : TPRGB32Array; + label NotFoundBmp; + begin + BmpRowData:= CalculateRowPtrs(bitmap); + + for yy := 0 to dY do + for xx := 0 to dX do + begin + for yBmp:= 0 to BmpH do + begin + tmpY := yBmp + yy; + for xBmp := 0 to BmpW do + if not SkipCoords[yBmp][xBmp] then + if not ColorSame_cts1(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) then + goto NotFoundBmp; + end; + exit(Point(xx + xs, yy + ys)); + NotFoundBmp: // double break + end; + + Result := Point(-1, -1); + end; + + function cts2: tpoint; + var H1, S1, L1, H2, S2, L2, HMod, SMod: extended; + xx, yy, xBmp, yBmp, tmpY: integer; + + HSLRows: T2DHSLArray; + + label NotFoundBmp; + begin + HSLRows := bitmap.GetHSLValues(0, 0, BmpW - 1, BmpH - 1); + + for yy := 0 to dY do + for xx := 0 to dX do + begin + for yBmp:= 0 to BmpH do + begin + tmpY := yBmp + yy; + for xBmp := 0 to BmpW do + if not SkipCoords[yBmp][xBmp] then + begin + RGBToHSL(MainRowdata[tmpY][xBmp + xx].R, MainRowdata[tmpY][xBmp + xx].G, + MainRowdata[tmpY][xBmp + xx].B, H2, S2, L2); + + if not ColorSame_cts2(Tolerance, HSLRows[yBmp][xBmp].H, HSLRows[yBmp][xBmp].S, HSLRows[yBmp][xBmp].L, + H2, S2, L2, hueMod, satMod) then + goto NotFoundBmp; + end; + end; + exit(Point(xx + xs, yy + ys)); + NotFoundBmp: // double break + end; + + Result := Point(-1, -1); + end; + begin - Result := false; + Result := False; // checks for valid xs,ys,xe,ye? (may involve GetDimensions) DefaultOperations(xs,ys,xe,ye); @@ -1600,43 +1702,31 @@ begin PtrData := TClient(Client).IOManager.ReturnData(xs, ys, dX + 1, dY + 1); //Caculate the row ptrs MainRowdata:= CalculateRowPtrs(PtrData,dy+1); - BmpRowData:= CalculateRowPtrs(bitmap); + + //Get the 'fixed' bmp size BmpW := bitmap.Width - 1; BmpH := bitmap.Height - 1; //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; //Get the "skip coords". CalculateBitmapSkipCoords(Bitmap,SkipCoords); - for yy := 0 to dY do - for xx := 0 to dX do - begin; - for yBmp:= 0 to BmpH do - 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 - goto NotFoundBmp; - end; - //We did find the Bmp, otherwise we would be at the part below - TClient(Client).IOManager.FreeReturnData; - x := xx + xs; - y := yy + ys; - result := true; - exit; - NotFoundBmp: - end; + case Self.CTS of + 0: foundP := cts0(); + 1: foundP := cts1(); + 2: foundP := cts2(); + end; + + if (foundP.x = -1) and (foundP.y = -1) then + result := False + else begin + x := foundP.x; + y := foundP.y; + Result := True; + end; TClient(Client).IOManager.FreeReturnData; end; 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;