Merge branch 'cts-rework' into cts-3

Conflicts:
	Units/MMLCore/finder.pas
This commit is contained in:
Merlijn Wajer 2011-07-30 20:38:59 +02:00
commit a58a08f487
4 changed files with 178 additions and 84 deletions

36
Tests/PS/bmpbench.simba Normal file
View File

@ -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.

View File

@ -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;

View File

@ -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))

@ -1 +1 @@
Subproject commit 940053e16d79c3d76b6b70d6a1bf56507ad0e627
Subproject commit b24c52b9748c6f9f3e91a7a86f727022bf2fd6ce