diff --git a/Tests/PS/bmpbench.simba b/Tests/PS/bmpbench.simba new file mode 100644 index 0000000..134b738 --- /dev/null +++ b/Tests/PS/bmpbench.simba @@ -0,0 +1,36 @@ +program new; + +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 10 do + findBitmapToleranceIn(bmp,x,y,0,0,w-1,h-1,10); + 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 + begin + writeln('found'); + MoveMouse(x,y); + end;} +end. diff --git a/Units/MMLCore/finder.pas b/Units/MMLCore/finder.pas index 3743bf0..54b6ce3 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; @@ -134,6 +133,9 @@ type end; PCTS3Info = ^TCTS3Info; + TCTSInfo = Pointer; + TCTSInfoArray = Array of TCTSInfo; + TCTSInfo2DArray = Array of TCTSInfoArray; TCTSCompareFunction = function (ctsInfo: Pointer; C2: PRGB32): boolean; @@ -444,7 +446,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; @@ -463,7 +465,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 @@ -487,6 +490,17 @@ 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 @@ -495,6 +509,42 @@ begin raise Exception.Create('Free_CTSInfo: Invalid TCTSInfo passed'); end; + +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 + begin + Result[y][x] := Create_CTSInfo(cts, + data[y][x].R, data[y][x].G, data[y][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 @@ -580,30 +630,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; @@ -1042,7 +1091,7 @@ var dX, dY, clR, clG, clB: Integer; xx, yy: integer; compare: TCTSCompareFunction; - ctsinfo: Pointer; + ctsinfo: TCTSInfo; label Hit; @@ -1175,7 +1224,7 @@ var xx, yy: integer; compare: TCTSCompareFunction; - ctsinfo: Pointer; + ctsinfo: TCTSInfo; begin Result := false; @@ -1195,9 +1244,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 @@ -1361,7 +1407,7 @@ var dX, dY, SpiralHi, i: Integer; compare: TCTSCompareFunction; - ctsinfo: Pointer; + ctsinfo: TCTSInfo; begin Result := false; @@ -1602,10 +1648,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 @@ -1616,11 +1658,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; @@ -1641,10 +1685,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); @@ -1656,21 +1700,28 @@ 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; 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)) 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