Merge branch 'cts-rework' into cts-3

Conflicts:
	Units/MMLCore/finder.pas

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.

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;
+  ctsinfo := Create_CTSInfo(Self.CTS, Color, Tolerance, hueMod, satMod);
-    RGBToHSL(clR,clG,clB,h,s,l);
+  compare := Get_CTSCompare(Self.CTS);
-    hmod := Self.hueMod;
+
-    smod := Self.satMod;
-  end;
   for yy := ys to ye do
   begin;
     for xx := xs to xe do
-    begin;
+    begin
-      if ColorSame(CCts,Tolerance,clR,clG,clB,Ptr^.r,Ptr^.g,Ptr^.b,H,S,L,hmod,smod) then
+      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;
 

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); 
+  constructor TWindow.Create(display: PDisplay; screennum: integer; window: x.TWindow);
-  begin 
+  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);
+  { TODO: Check if this supports multiple keyboard layouts, probably not }
-var
+  procedure TWindow.SendString(str: string);
-  I, L: Integer;
+  var
-  K: Byte;
+    I, L: Integer;
-  HoldShift: Boolean;
+    K: Byte;
-begin
+    HoldShift: Boolean;
-  HoldShift := False;
-  L := Length(str);
-  for I := 1 to L do
   begin
-    if (((str[I] >= 'A') and (str[I] <= 'Z')) or 
+    HoldShift := False;
-        ((str[I] >= '!') and (str[I] <= '&')) or
+    L := Length(str);
-        ((str[I] >= '(') and (str[I] <= '+')) or
+    for I := 1 to L do
-        (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);
+      if (((str[I] >= 'A') and (str[I] <= 'Z')) or
-      HoldShift := True;
+          ((str[I] >= '!') and (str[I] <= '&')) or
-    end;
+          ((str[I] >= '(') and (str[I] <= '+')) or
-    
+          (str[I] = ':') or
-    K := GetKeyCode(str[I]);
+          ((str[I] >= '<') and (str[I] <= '@')) or
-    HoldKey(K);
+          ((str[I] >= '^') and (str[I] <= '_')) or
-    Sleep(20);
+          ((str[I] >= '{') and (str[I] <= '~'))) then
-    ReleaseKey(K);
+      begin
-    
+        HoldKey(VK_SHIFT);
-    if (HoldShift) then
+        HoldShift := True;
-    begin
+      end;
-      HoldShift := False;
+
-      ReleaseKey(VK_SHIFT);
+      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))

Units/lape

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