From 56e01c67fa031b36647a4f4e36b736c3f664d779 Mon Sep 17 00:00:00 2001 From: Merlijn Wajer Date: Mon, 1 Aug 2011 16:16:19 +0200 Subject: [PATCH] MML/Finder: CTS: Bitmap+Color functions done. Only DTM to go. --- Units/MMLCore/finder.pas | 157 +++++++++++++++++++++------------------ 1 file changed, 83 insertions(+), 74 deletions(-) diff --git a/Units/MMLCore/finder.pas b/Units/MMLCore/finder.pas index 87b16a8..cdc88de 100644 --- a/Units/MMLCore/finder.pas +++ b/Units/MMLCore/finder.pas @@ -38,8 +38,8 @@ 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! + TODO: Check that each procedure calling Create_CTSInfo also calls + Free_CTSInfo(). } type @@ -624,6 +624,8 @@ begin end; Inc(Ptr, PtrInc) end; + + Free_CTSInfo(ctsinfo); TClient(Client).IOManager.FreeReturnData; end; @@ -764,48 +766,10 @@ var RowData : TPRGB32Array; dX, dY, clR, clG, clB,i,Hispiral: Integer; - function cts0: integer; - var j: integer; - begin - for j := 0 to HiSpiral do - if ((abs(clB-RowData[ClientTPA[j].y][ClientTPA[j].x].B) <= Tol) and - (abs(clG-RowData[ClientTPA[j].y][ClientTPA[j].x].G) <= Tol) and - (Abs(clR-RowData[ClientTPA[j].y][ClientTPA[j].x].R) <= Tol)) then - exit(j); - exit(-1); - end; - - function cts1: integer; - var j: integer; - begin - Tol := Sqr(Tol); - for j := 0 to HiSpiral do - if (sqr(clB - RowData[ClientTPA[j].y][ClientTPA[j].x].B) + - sqr(clG - RowData[ClientTPA[j].y][ClientTPA[j].x].G) + - sqr(clR-RowData[ClientTPA[j].y][ClientTPA[j].x].R)) <= Tol then - exit(j); - exit(-1); - end; - - function cts2: integer; - var j: integer; - HueXTol, SatXTol: Extended; - H1, S1, L1, H2, S2, L2: Extended; - begin - RGBToHSL(clR,clG,clB,H1,S1,L1); - HueXTol := hueMod * Tol; - SatXTol := satMod * Tol; - for j := 0 to HiSpiral do - begin - RGBToHSL(RowData[ClientTPA[j].y][ClientTPA[j].x].R, - RowData[ClientTPA[j].y][ClientTPA[j].x].G, - RowData[ClientTPA[j].y][ClientTPA[j].x].B,H2,S2,L2); - if ((abs(H1 - H2) <= HueXTol) and (abs(S1 - S2) <= SatXTol) and (abs(L1 - L2) <= Tol)) then - exit(j); - end; - - exit(-1); - end; +var + j: integer; + compare: TCTSCompareFunction; + ctsinfo: TCTSInfo; begin Result := false; @@ -824,11 +788,22 @@ begin //Load the spiral path LoadSpiralPath(x-xs,y-ys,0,0,dx,dy); HiSpiral := (dy+1) * (dx + 1) -1; - case CTS of - 0: i := cts0(); - 1: i := cts1(); - 2: i := cts2(); + + 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 + i := j; + break; + end; end; + + Free_CTSInfo(ctsinfo); + if i = -1 then begin Result := False; @@ -1092,6 +1067,7 @@ begin end; Result := False; + Free_CTSInfo(ctsinfo); TClient(Client).IOManager.FreeReturnData; Exit; @@ -1099,6 +1075,7 @@ begin Result := True; x := xx; y := yy; + Free_CTSInfo(ctsinfo); TClient(Client).IOManager.FreeReturnData; end; @@ -1111,8 +1088,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) @@ -1132,13 +1114,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 @@ -1146,7 +1132,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; @@ -1170,6 +1156,7 @@ begin end; Result := False; + Free_CTSInfo(ctsinfo); TClient(Client).IOManager.FreeReturnData; Exit; @@ -1177,6 +1164,7 @@ begin Result := True; x := xx; y := yy; + Free_CTSInfo(ctsinfo); TClient(Client).IOManager.FreeReturnData; end; @@ -1668,10 +1656,6 @@ begin if not SkipCoords[yBmp][xBmp] then if not compare(ctsinfoarray[yBmp][xBmp], @MainRowData[tmpY][xBmp + xx]) 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; @@ -1683,7 +1667,7 @@ begin x := xx + xs; y := yy + ys; result := true; - exit; + Exit; NotFoundBmp: end; @@ -1766,6 +1750,10 @@ var 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. } @@ -1791,9 +1779,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); @@ -1804,21 +1794,23 @@ 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; y := ClientTPA[i].y + ys; result := true; exit; NotFoundBmp: end; + Free_CTSInfo2DArray(ctsinfoarray); TClient(Client).IOManager.FreeReturnData; end; @@ -1836,6 +1828,10 @@ var 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. } @@ -1861,10 +1857,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 @@ -1874,11 +1872,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; @@ -1894,6 +1889,8 @@ begin SetLength(Points,FoundC); Move(ClientTPA[0], Points[0], FoundC * SizeOf(TPoint)); end; + + Free_CTSInfo2DArray(ctsinfoarray); TClient(Client).IOManager.FreeReturnData; end; @@ -1916,6 +1913,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. } @@ -1943,6 +1944,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); @@ -1969,8 +1975,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; @@ -1988,7 +1994,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; @@ -1997,6 +2004,8 @@ begin end; end; end; + + Free_CTSInfo2DArray(ctsinfoarray); TClient(Client).IOManager.FreeReturnData; if BestCount = 0 then Exit;