From 880072d723823194b1e71c3e78e2ca3a4568c51e Mon Sep 17 00:00:00 2001 From: Merlijn Wajer Date: Sat, 30 Jul 2011 11:32:58 +0200 Subject: [PATCH 01/10] MML/Core: Clean up os_linux. --- Units/MMLCore/os_linux.pas | 105 ++++++++++++++++++++----------------- 1 file changed, 56 insertions(+), 49 deletions(-) diff --git a/Units/MMLCore/os_linux.pas b/Units/MMLCore/os_linux.pas index 94bdeed..54dce59 100644 --- a/Units/MMLCore/os_linux.pas +++ b/Units/MMLCore/os_linux.pas @@ -20,15 +20,21 @@ Linux OS specific implementation for Mufasa Macro Library } -{$mode objfpc}{$H+} +{$mode objfpc}{$H+} unit os_linux; +{ + TODO's: + - Allow selecting a different X display + - Fix keyboard layout / SendString +} + interface uses Classes, SysUtils, mufasatypes, xlib, x, xutil, IOManager, XKeyInput, ctypes, xtest, syncobjs, mufasabase; - + type TNativeWindow = x.TWindow; @@ -43,7 +49,7 @@ interface TWindow = class(TWindow_Abstract) public - constructor Create(display: PDisplay; screennum: integer; window: x.TWindow); + constructor Create(display: PDisplay; screennum: integer; window: x.TWindow); destructor Destroy; override; procedure GetTargetDimensions(out w, h: integer); override; procedure GetTargetPosition(out left, top: integer); override; @@ -89,7 +95,7 @@ interface { X Error Handler } oldXHandler: TXErrorHandler; end; - + TIOManager = class(TIOManager_Abstract) public constructor Create; @@ -109,7 +115,7 @@ interface end; function MufasaXErrorHandler(para1:PDisplay; para2:PXErrorEvent):cint; cdecl; - + implementation uses GraphType, interfacebase, lcltype; @@ -126,7 +132,7 @@ implementation { This is extremely hacky, but also very useful. We have to install a X error handler, because otherwise X - will terminate out entire app on error. + will terminate our entire app on error. Since we want the right thread to recieve the right error, we have to fiddle a bit with threadvars, mutexes / semaphores. @@ -207,8 +213,8 @@ implementation end; { See if the semaphores / CS are initialised } - constructor TWindow.Create(display: PDisplay; screennum: integer; window: x.TWindow); - begin + constructor TWindow.Create(display: PDisplay; screennum: integer; window: x.TWindow); + begin inherited Create; self.display:= display; self.screennum:= screennum; @@ -227,8 +233,8 @@ implementation finally ErrorCS.Leave; end; - end; - + end; + destructor TWindow.Destroy; var erh: TXErrorHandler; @@ -304,8 +310,8 @@ implementation if ReceivedError then raise Exception.Create('Error: ActivateClient: ' + GetError); end; - - function TWindow.ReturnData(xs, ys, width, height: Integer): TRetData; + + function TWindow.ReturnData(xs, ys, width, height: Integer): TRetData; var w,h: integer; begin @@ -334,8 +340,8 @@ implementation dirty:= true; //XSetErrorHandler(Old_Handler); end; - - procedure TWindow.FreeReturnData; + + procedure TWindow.FreeReturnData; begin if dirty then begin @@ -413,40 +419,41 @@ implementation result := xmask and ButtonP > 0; end; -procedure TWindow.SendString(str: string); -var - I, L: Integer; - K: Byte; - HoldShift: Boolean; -begin - HoldShift := False; - L := Length(str); - for I := 1 to L do + { TODO: Check if this supports multiple keyboard layouts, probably not } + procedure TWindow.SendString(str: string); + var + I, L: Integer; + K: Byte; + HoldShift: Boolean; begin - if (((str[I] >= 'A') and (str[I] <= 'Z')) or - ((str[I] >= '!') and (str[I] <= '&')) or - ((str[I] >= '(') and (str[I] <= '+')) or - (str[I] = ':') or - ((str[I] >= '<') and (str[I] <= '@')) or - ((str[I] >= '^') and (str[I] <= '_')) or - ((str[I] >= '{') and (str[I] <= '~'))) then + HoldShift := False; + L := Length(str); + for I := 1 to L do begin - HoldKey(VK_SHIFT); - HoldShift := True; - end; - - K := GetKeyCode(str[I]); - HoldKey(K); - Sleep(20); - ReleaseKey(K); - - if (HoldShift) then - begin - HoldShift := False; - ReleaseKey(VK_SHIFT); + if (((str[I] >= 'A') and (str[I] <= 'Z')) or + ((str[I] >= '!') and (str[I] <= '&')) or + ((str[I] >= '(') and (str[I] <= '+')) or + (str[I] = ':') or + ((str[I] >= '<') and (str[I] <= '@')) or + ((str[I] >= '^') and (str[I] <= '_')) or + ((str[I] >= '{') and (str[I] <= '~'))) then + begin + HoldKey(VK_SHIFT); + HoldShift := True; + end; + + K := GetKeyCode(str[I]); + HoldKey(K); + Sleep(20); + ReleaseKey(K); + + if (HoldShift) then + begin + HoldShift := False; + ReleaseKey(VK_SHIFT); + end; end; end; -end; procedure TWindow.HoldKey(key: integer); begin @@ -474,7 +481,7 @@ end; Raise Exception.CreateFMT('GetSimpleKeyCode - char (%s) is not in A..z',[c]); end end; - + { ***implementation*** IOManager } constructor TIOManager.Create; @@ -499,17 +506,17 @@ end; { Get the Desktop Window } desktop:= RootWindow(display,screennum) end; - - procedure TIOManager.NativeFree; + + procedure TIOManager.NativeFree; begin XCloseDisplay(display); end; - + procedure TIOManager.SetDesktop; begin SetBothTargets(TWindow.Create(display, screennum, desktop)); end; - + function TIOManager.SetTarget(target: x.TWindow): integer; begin result := SetBothTargets(TWindow.Create(display, screennum, target)) From cdb89a1802fb45583e6d49a171c0b50d34a625d5 Mon Sep 17 00:00:00 2001 From: Merlijn Wajer Date: Sat, 30 Jul 2011 13:12:21 +0200 Subject: [PATCH 02/10] MMLCore: FindBitmapToleranceIn cts rewrite. --- Units/MMLCore/finder.pas | 99 +++++++++++++++++++++++++++++----------- 1 file changed, 73 insertions(+), 26 deletions(-) diff --git a/Units/MMLCore/finder.pas b/Units/MMLCore/finder.pas index 99a916d..238b70a 100644 --- a/Units/MMLCore/finder.pas +++ b/Units/MMLCore/finder.pas @@ -128,6 +128,9 @@ type end; PCTS2Info = ^TCTS2Info; + TCTSInfo = Pointer; + TCTSInfoArray = Array of TCTSInfo; + TCTSInfo2DArray = Array of TCTSInfoArray; TCTSCompareFunction = function (ctsInfo: Pointer; C2: PRGB32): boolean; @@ -462,6 +465,45 @@ begin raise Exception.Create('Free_CTSInfo: Invalid TCTSInfo passed'); end; + +function Create_CTSInfo2DArray(cts, xs, ys, xe, ye: integer; bmp: TMufasaBitmap; + Tolerance: Integer; hueMod, satMod: Extended): TCTSInfo2DArray; +var + x, y, w: integer; +begin + setlength(result,ye-ys+1,xe-xs+1); + w := bmp.width; + for y := ys to ye do + for x := xs to xe do + begin + { This is kinda ugly. We call RGBToColor() here only to call ColorToRGB() + later again in Create_CTSInfo) } + result[y-ys][x-xs] := Create_CTSInfo(cts, + rgbtocolor(bmp.fdata[y*w+x].R, bmp.fdata[y*w+x].G, + bmp.fdata[y*w+x].B), + Tolerance, hueMod, satMod); + end; +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 @@ -546,30 +588,29 @@ var 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; @@ -1008,7 +1049,7 @@ var dX, dY, clR, clG, clB: Integer; xx, yy: integer; compare: TCTSCompareFunction; - ctsinfo: Pointer; + ctsinfo: TCTSInfo; label Hit; @@ -1141,7 +1182,7 @@ var xx, yy: integer; compare: TCTSCompareFunction; - ctsinfo: Pointer; + ctsinfo: TCTSInfo; { procedure cts3; begin @@ -1184,9 +1225,6 @@ begin ctsinfo := Create_CTSInfo(Self.CTS, Color, Tol, hueMod, satMod); compare := Get_CTSCompare(Self.CTS); - if cts = 1 then - tol := tol * tol; - for yy := ys to ye do begin for xx := xs to xe do @@ -1350,7 +1388,7 @@ var dX, dY, SpiralHi, i: Integer; compare: TCTSCompareFunction; - ctsinfo: Pointer; + ctsinfo: TCTSInfo; begin Result := false; @@ -1591,7 +1629,6 @@ begin TClient(Client).IOManager.FreeReturnData; end; - { TODO: Implement HSLRows? } @@ -1605,9 +1642,11 @@ 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. } @@ -1630,10 +1669,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, xs, ys, xe, ye, bitmap, + Tolerance, self.hueMod, self.satMod); + compare := Get_CTSCompare(Self.CTS); //Get the "skip coords". CalculateBitmapSkipCoords(Bitmap,SkipCoords); @@ -1645,21 +1684,29 @@ begin tmpY := yBmp + yy; for xBmp := 0 to BmpW do if not SkipCoords[yBmp][xBmp] then - if not ColorSame(CCTS,tolerance, + 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 + H,S,L,HMod,SMod) 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; NotFoundBmp: end; + + Free_CTSInfo2DArray(ctsinfoarray); TClient(Client).IOManager.FreeReturnData; end; From daff307f3d8062e1643a99ca2a8940c6199c20c0 Mon Sep 17 00:00:00 2001 From: Merlijn Wajer Date: Sat, 30 Jul 2011 13:46:10 +0200 Subject: [PATCH 03/10] Tests: Add BmpBench. --- Tests/PS/bmpbench.simba | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) create mode 100644 Tests/PS/bmpbench.simba diff --git a/Tests/PS/bmpbench.simba b/Tests/PS/bmpbench.simba new file mode 100644 index 0000000..dc9acea --- /dev/null +++ b/Tests/PS/bmpbench.simba @@ -0,0 +1,34 @@ +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, c: integer; +begin + Bmp := createBitmap(15, 10); + FastDrawClear(bmp, clRed); + GetClientDimensions(w,h); + writeln(w); + writeln(h); + + for c := 0 to 2 do + begin + writeln('cts: ' + inttostr(c)); + setcolortolerancespeed(c); + + t:=getsystemtime; + for i := 0 to 100 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('found'); + end; + + {if FindBitmapToleranceIn(bmp,x,y,0,0,w-1,h-1,300) then + begin + writeln('found'); + MoveMouse(x,y); + end;} +end. From 841f228a0fd2d8ba8660c9863818e4aa29c80e73 Mon Sep 17 00:00:00 2001 From: Merlijn Wajer Date: Sat, 30 Jul 2011 13:46:10 +0200 Subject: [PATCH 04/10] Tests: Add BmpBench. --- Tests/PS/bmpbench.simba | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) create mode 100644 Tests/PS/bmpbench.simba diff --git a/Tests/PS/bmpbench.simba b/Tests/PS/bmpbench.simba new file mode 100644 index 0000000..dc9acea --- /dev/null +++ b/Tests/PS/bmpbench.simba @@ -0,0 +1,34 @@ +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, c: integer; +begin + Bmp := createBitmap(15, 10); + FastDrawClear(bmp, clRed); + GetClientDimensions(w,h); + writeln(w); + writeln(h); + + for c := 0 to 2 do + begin + writeln('cts: ' + inttostr(c)); + setcolortolerancespeed(c); + + t:=getsystemtime; + for i := 0 to 100 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('found'); + end; + + {if FindBitmapToleranceIn(bmp,x,y,0,0,w-1,h-1,300) then + begin + writeln('found'); + MoveMouse(x,y); + end;} +end. From 353d1f393d617db3eeef34cd77b12984ce4e16e3 Mon Sep 17 00:00:00 2001 From: Merlijn Wajer Date: Sat, 30 Jul 2011 14:31:54 +0200 Subject: [PATCH 05/10] Lape: Update head. --- Units/lape | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Units/lape b/Units/lape index 940053e..b24c52b 160000 --- a/Units/lape +++ b/Units/lape @@ -1 +1 @@ -Subproject commit 940053e16d79c3d76b6b70d6a1bf56507ad0e627 +Subproject commit b24c52b9748c6f9f3e91a7a86f727022bf2fd6ce From 0422f0eb5a89159c4019ec9066d7bae9dbfc267c Mon Sep 17 00:00:00 2001 From: Merlijn Wajer Date: Sat, 30 Jul 2011 15:53:48 +0200 Subject: [PATCH 06/10] MML/Core: Fixes for FindBitmapToleranceIn. --- Units/MMLCore/finder.pas | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/Units/MMLCore/finder.pas b/Units/MMLCore/finder.pas index 238b70a..ef487d7 100644 --- a/Units/MMLCore/finder.pas +++ b/Units/MMLCore/finder.pas @@ -107,7 +107,6 @@ uses tpa, //TPABounds dtmutil; - type TCTS0Info = record B, G, R, A: byte; @@ -466,21 +465,24 @@ begin end; -function Create_CTSInfo2DArray(cts, xs, ys, xe, ye: integer; bmp: TMufasaBitmap; +function Create_CTSInfo2DArray(cts, w, h: integer; bmp: TMufasaBitmap; Tolerance: Integer; hueMod, satMod: Extended): TCTSInfo2DArray; var - x, y, w: integer; + x, y: integer; + data: PRGB32; begin - setlength(result,ye-ys+1,xe-xs+1); - w := bmp.width; - for y := ys to ye do - for x := xs to xe do + setlength(result,h+1,w+1); + + data := bmp.fdata; + + for y := 0 to h do + for x := 0 to w do begin { This is kinda ugly. We call RGBToColor() here only to call ColorToRGB() later again in Create_CTSInfo) } - result[y-ys][x-xs] := Create_CTSInfo(cts, - rgbtocolor(bmp.fdata[y*w+x].R, bmp.fdata[y*w+x].G, - bmp.fdata[y*w+x].B), + result[y][x] := Create_CTSInfo(cts, + rgbtocolor(data[y*w+x].R, data[y*w+x].G, + data[y*w+x].B), Tolerance, hueMod, satMod); end; end; @@ -1670,7 +1672,7 @@ begin dX := dX - bmpW; dY := dY - bmpH; - ctsinfoarray := Create_CTSInfo2DArray(Self.CTS, xs, ys, xe, ye, bitmap, + ctsinfoarray := Create_CTSInfo2DArray(Self.CTS, bmpW, bmpH, bitmap, Tolerance, self.hueMod, self.satMod); compare := Get_CTSCompare(Self.CTS); From 3b939443e81540dfac64c22c10558fd9d0bac7cd Mon Sep 17 00:00:00 2001 From: Merlijn Wajer Date: Sat, 30 Jul 2011 19:10:10 +0200 Subject: [PATCH 07/10] MML/Core: FindBitmapToleranceIn is nearly finished. Speed is nice, results are not accurate yet. I probably missed something when pre-loading the data. --- Units/MMLCore/finder.pas | 37 ++++++++++++++++++++++++++++++++----- 1 file changed, 32 insertions(+), 5 deletions(-) diff --git a/Units/MMLCore/finder.pas b/Units/MMLCore/finder.pas index ef487d7..81d172f 100644 --- a/Units/MMLCore/finder.pas +++ b/Units/MMLCore/finder.pas @@ -423,7 +423,7 @@ end; { } function Create_CTSInfo(cts: integer; Color, Tol: Integer; - hueMod, satMod: extended): Pointer; + hueMod, satMod: extended): Pointer; overload; var R, G, B: Integer; H, S, L: Integer; @@ -456,6 +456,16 @@ begin 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 @@ -473,16 +483,14 @@ var begin setlength(result,h+1,w+1); + w := bmp.width; data := bmp.fdata; for y := 0 to h do for x := 0 to w do begin - { This is kinda ugly. We call RGBToColor() here only to call ColorToRGB() - later again in Create_CTSInfo) } result[y][x] := Create_CTSInfo(cts, - rgbtocolor(data[y*w+x].R, data[y*w+x].G, - data[y*w+x].B), + data[y*w+x].R, data[y*w+x].G, data[y*w+x].B, Tolerance, hueMod, satMod); end; end; @@ -1676,6 +1684,25 @@ begin Tolerance, self.hueMod, self.satMod); compare := Get_CTSCompare(Self.CTS); +// for yBmp := 0 to BmpH do +// begin +// tmpY := yBmp + yy; +// for xBmp := 0 to BmpW do +// begin +// writeln('BmpRowData: ' + IntToStr(BmpRowData[yBmp][xBmp].R) + ', ' + +// IntToStr(BmpRowData[yBmp][xBmp].G) +// + ', ' + IntToStr(BmpRowData[yBmp][xBmp].B)); +// +// case self.cts of +// 0, 1: writeln('ctsinfo: ' + +// IntToStr(TCTS1Info(ctsinfoarray[yBmp][xBmp]).R) + ', ' + +// IntToStr(TCTS1Info(ctsinfoarray[yBmp][xBmp]).G) + ', ' + +// IntToStr(TCTS1Info(ctsinfoarray[yBmp][xBmp]).B)); +// end; +// +// end; +// end; + //Get the "skip coords". CalculateBitmapSkipCoords(Bitmap,SkipCoords); for yy := 0 to dY do From 6f32e21291a863e9187b05e38a940a4921105b37 Mon Sep 17 00:00:00 2001 From: Merlijn Wajer Date: Sat, 30 Jul 2011 20:08:17 +0200 Subject: [PATCH 08/10] MML/Core: FindBitmapToleranceIn seems to work. --- Units/MMLCore/finder.pas | 44 +++++++++------------------------------- 1 file changed, 10 insertions(+), 34 deletions(-) diff --git a/Units/MMLCore/finder.pas b/Units/MMLCore/finder.pas index 81d172f..aea425a 100644 --- a/Units/MMLCore/finder.pas +++ b/Units/MMLCore/finder.pas @@ -441,7 +441,8 @@ begin Result := AllocMem(SizeOf(TCTS1Info)); ColorToRGB(Color, PCTS1Info(Result)^.R, PCTS1Info(Result)^.G, PCTS1Info(Result)^.B); - PCTS1Info(Result)^.Tol := Tol*Tol; + + PCTS1Info(Result)^.Tol := Tol * Tol; end; 2: begin @@ -466,6 +467,7 @@ 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 @@ -475,22 +477,18 @@ begin end; -function Create_CTSInfo2DArray(cts, w, h: integer; bmp: TMufasaBitmap; +function Create_CTSInfo2DArray(cts, w, h: integer; data: TPRGB32Array; Tolerance: Integer; hueMod, satMod: Extended): TCTSInfo2DArray; var x, y: integer; - data: PRGB32; begin - setlength(result,h+1,w+1); - - w := bmp.width; - data := bmp.fdata; + SetLength(Result,h+1,w+1); for y := 0 to h do for x := 0 to w do begin - result[y][x] := Create_CTSInfo(cts, - data[y*w+x].R, data[y*w+x].G, data[y*w+x].B, + Result[y][x] := Create_CTSInfo(cts, + data[y][x].R, data[y][x].G, data[y][x].B, Tolerance, hueMod, satMod); end; end; @@ -1639,9 +1637,6 @@ begin TClient(Client).IOManager.FreeReturnData; end; -{ - TODO: Implement HSLRows? -} function TMFinder.FindBitmapToleranceIn(bitmap: TMufasaBitmap; out x, y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer): Boolean; var @@ -1653,12 +1648,13 @@ var tmpY : integer; dX, dY, xx, yy: Integer; SkipCoords : T2DBoolArray; + a: TRGB32; 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; @@ -1680,29 +1676,10 @@ begin dX := dX - bmpW; dY := dY - bmpH; - ctsinfoarray := Create_CTSInfo2DArray(Self.CTS, bmpW, bmpH, bitmap, + ctsinfoarray := Create_CTSInfo2DArray(Self.CTS, bmpW, bmpH, BmpRowData, Tolerance, self.hueMod, self.satMod); compare := Get_CTSCompare(Self.CTS); -// for yBmp := 0 to BmpH do -// begin -// tmpY := yBmp + yy; -// for xBmp := 0 to BmpW do -// begin -// writeln('BmpRowData: ' + IntToStr(BmpRowData[yBmp][xBmp].R) + ', ' + -// IntToStr(BmpRowData[yBmp][xBmp].G) -// + ', ' + IntToStr(BmpRowData[yBmp][xBmp].B)); -// -// case self.cts of -// 0, 1: writeln('ctsinfo: ' + -// IntToStr(TCTS1Info(ctsinfoarray[yBmp][xBmp]).R) + ', ' + -// IntToStr(TCTS1Info(ctsinfoarray[yBmp][xBmp]).G) + ', ' + -// IntToStr(TCTS1Info(ctsinfoarray[yBmp][xBmp]).B)); -// end; -// -// end; -// end; - //Get the "skip coords". CalculateBitmapSkipCoords(Bitmap,SkipCoords); for yy := 0 to dY do @@ -1720,7 +1697,6 @@ begin 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 From 013daccf0770abc0d7fc1f2b8c07a2e6d2419dd8 Mon Sep 17 00:00:00 2001 From: Merlijn Wajer Date: Sat, 30 Jul 2011 20:09:31 +0200 Subject: [PATCH 09/10] MML/Core: Cleanup. --- Units/MMLCore/finder.pas | 1 - 1 file changed, 1 deletion(-) diff --git a/Units/MMLCore/finder.pas b/Units/MMLCore/finder.pas index aea425a..9a01486 100644 --- a/Units/MMLCore/finder.pas +++ b/Units/MMLCore/finder.pas @@ -1648,7 +1648,6 @@ var tmpY : integer; dX, dY, xx, yy: Integer; SkipCoords : T2DBoolArray; - a: TRGB32; ctsinfoarray: TCTSInfo2DArray; compare: TCTSCompareFunction; From 55b0435a4e77206d018793acebdd988968218a3a Mon Sep 17 00:00:00 2001 From: Merlijn Wajer Date: Sat, 30 Jul 2011 20:27:54 +0200 Subject: [PATCH 10/10] Tests: Update BmpBench. --- Tests/PS/bmpbench.simba | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) 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