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,6 +465,7 @@ begin
         Result := AllocMem(SizeOf(TCTS1Info));
         ColorToRGB(Color, PCTS1Info(Result)^.R, PCTS1Info(Result)^.G,
                     PCTS1Info(Result)^.B);
+
         PCTS1Info(Result)^.Tol := Tol * Tol;
       end;
       2:
@@ -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,9 +1658,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. }
 
@@ -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

@@ -23,6 +23,12 @@
 {$mode objfpc}{$H+}
 unit os_linux;
 
+{
+  TODO's:
+  - Allow selecting a different X display
+  - Fix keyboard layout / SendString
+}
+
 interface
 
   uses
@@ -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.
@@ -413,6 +419,7 @@ implementation
     result := xmask and ButtonP > 0;
   end;
 
+  { TODO: Check if this supports multiple keyboard layouts, probably not }
   procedure TWindow.SendString(str: string);
   var
     I, L: Integer;

Units/lape

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