SRL Archive - SRL Archives

These need to be re-named because I just stole them out of my wannabe include but, here they are!
UPDATED HERE:

type
  THSLColor = record
    h: Extended;
    s: Extended;
    l: Extended;
  end;
  TRGBColor = record
    r: Integer;
    g: Integer;
    b: Integer;
  end;
  TXYZColor = record
    x: Extended;
    y: Extended;
    z: Extended;
  end;
  
function GetTolerance(arr: array of Integer; theCTS: Integer): Integer;
var
  cts,i: Integer;
begin
  cts := GetColorToleranceSpeed;
  ColorToleranceSpeed(theCTS);
  for i:=0 to High(arr)-1 do
  begin
    Result := 0;
    while(not SimilarColors(arr[i],arr[i+1],Result)) do
    begin
      Inc(Result);
    end;
  end;
  ColorToleranceSpeed(cts);
  Inc(Result);
end;

procedure HueSatTolCol(var hue,sat: Extended; var tol,col: Integer; arr: array of Integer; cts: Integer);
var
  i,ii,r,g,b: Integer;
  hslarr: array of THSLColor;
  rgbarr: array of TRGBColor;
  xyzarr: array of TXYZColor;
  rgbminmax: array[0..1] of TRGBColor;
  minmax: array[0..1] of THSLColor;
  xyzminmax: array[0..1] of TXYZColor;
  h,s,l,x,y,z: Extended;
  hmod,smod: Extended;
  bestCol: THSLColor;
begin
  SetLength(hslarr,Length(arr));
  for i:=0 to High(arr) do
  begin
    ColorToHSL(arr[i],hslarr[i].h,hslarr[i].s,hslarr[i].l);
  end;
  // hslarr now contains the contents of arr in HSL form.
  minmax[0].h := 255;
  minmax[0].s := 255;
  minmax[0].l := 255;
  // MinMax[0] = MIN MinMax[1] = MAX
  ii := High(hslarr);
  for i:=0 to ii do
  begin
    minmax[0].h := MinE(minmax[0].h,hslarr[i].h);
    minmax[0].s := MinE(minmax[0].s,hslarr[i].s);
    minmax[0].l := MinE(minmax[0].l,hslarr[i].l);
    minmax[1].h := MaxE(minmax[1].h,hslarr[i].h);
    minmax[1].s := MaxE(minmax[1].s,hslarr[i].s);
    minmax[1].l := MaxE(minmax[1].l,hslarr[i].l);
  end;
  h := minmax[1].h - minmax[0].h;
  s := minmax[1].s - minmax[0].s;
  l := minmax[1].l - minmax[0].l;
  hmod := (h/l);
  smod := (s/l);
  if(hmod < 0.1)then
    hmod := 0.1;
  if(smod < 0.1) then
    smod := 0.1;
  hue := hmod;
  sat := smod;
  if(cts < 2)then
  begin
    ii := High(arr);
    SetLength(rgbarr, ii+1);
    for i:=0 to ii do
    begin
      ColorToRGB(arr[i],rgbarr[i].r,rgbarr[i].g,rgbarr[i].b);
    end;
    ii := High(rgbarr);
    rgbminmax[0].r := 255;
    rgbminmax[0].g := 255;
    rgbminmax[0].b := 255;
    for i:=0 to ii do
    begin
      rgbminmax[0].r := Min(rgbminmax[0].r, rgbarr[i].r);
      rgbminmax[0].g := Min(rgbminmax[0].g, rgbarr[i].g);
      rgbminmax[0].b := Min(rgbminmax[0].b, rgbarr[i].b);
      rgbminmax[1].r := Max(rgbminmax[1].r, rgbarr[i].r);
      rgbminmax[1].g := Max(rgbminmax[1].g, rgbarr[i].g);
      rgbminmax[1].b := Max(rgbminmax[1].b, rgbarr[i].b);
    end;
    r := rgbminmax[1].r - rgbminmax[0].r;
    g := rgbminmax[1].g - rgbminmax[0].g;
    b := rgbminmax[1].b - rgbminmax[0].b;
    col := RGBToColor(r,g,b);
    tol := GetTolerance(arr,cts);
  end;
  if(cts = 2) then
  begin
    bestCol.h := (minmax[0].h + minmax[1].h) div 2;
    bestCol.s := (minmax[0].s + minmax[1].s) div 2;
    bestCol.l := (minmax[0].l + minmax[1].l) div 2;
    col := HSLToColor(bestCol.h,bestCol.s,bestCol.l);
    tol := Round(l + 0.1);
  end;
  if(cts = 3) then
  begin
    SetLength(xyzarr,Length(arr));
    for i:=0 to High(xyzarr) do
    begin
      ColorToXYZ(arr[i],xyzarr[i].x,xyzarr[i].y,xyzarr[i].z);
    end;
    xyzminmax[0].x := 255;
    xyzminmax[0].y := 255;
    xyzminmax[0].z := 255;
    for i:=0 to High(xyzarr) do
    begin
      xyzminmax[0].x := MinE(xyzminmax[0].x,xyzarr[i].x);
      xyzminmax[0].y := MinE(xyzminmax[0].y,xyzarr[i].y);
      xyzminmax[0].z := MinE(xyzminmax[0].z,xyzarr[i].z);
      xyzminmax[1].x := MaxE(xyzminmax[1].x,xyzarr[i].x);
      xyzminmax[1].y := MaxE(xyzminmax[1].y,xyzarr[i].y);
      xyzminmax[1].z := MaxE(xyzminmax[1].z,xyzarr[i].z);
    end;
    x := xyzminmax[1].x - xyzminmax[0].x;
    y := xyzminmax[1].y - xyzminmax[0].y;
    z := xyzminmax[1].z - xyzminmax[0].z;
    col := XYZToColor(x,y,z);
    tol := GetTolerance(arr,cts);
  end;
end;
function SaFindObjectTPA(color: Integer; upTexts: TStringArray; huemod, satmod: Extended; colorSpeed, tolerance, splitX, splitY: Integer): TPoint;
var
  cts,i,sax,say,count: Integer;
  TPA: TPointArray;
  ATPA: T2DPointArray;
begin
  cts := GetColorToleranceSpeed;
  ColorToleranceSpeed(colorSpeed);
  if(colorSpeed = 2) then
    SetColorSpeed2Modifiers(huemod,satmod);
  FindColorsSpiralTolerance(MSCX,MSCY,TPA,color,MSX1,MSY1,MSX2,MSY2,tolerance);
  //DebugTPA(TPA,'');
  i := Length(TPA);
  if((i > splitX) and (i > splitY)) then
  begin
    ATPA := SplitTPAEx(TPA,splitX,splitY);
    for i:=0 to High(ATPA) do
    begin
      MiddleTPAEx(ATPA[i],sax,say);
      MMouse(sax,say,2,2);
      wait(500 + random(500));
      wait(200 + random(500));
      for count:=0 to High(upTexts) do
      begin
        if(IsUpText(upTexts[count])) then
        begin
          GetMousePos(sax,say);
          Result := Point(sax,say);
          ColorToleranceSpeed(cts);
          Exit;
        end;
      end;
    end;
  end else
  begin
    for i:=0 to High(TPA) do
    begin
      MMouse(TPA[i].x,TPA[i].y,2,2);
      wait(500 + random(500));
      wait(200 + random(500));
      if(IsUpText(upTexts[count])) then
      begin
        GetMousePos(sax,say);
        Result := Point(sax,say);
        ColorToleranceSpeed(cts);
        Exit;
      end;
    end;
  end;
  Result := Point(0,0);
end;
{*******************************************************************************
function SaFindObjectColorArray(arr: array of Integer; upTexts: TStringArray; colorSpeed,splitX,splitY: Integer): TPoint;
By: Tniffoc
Description: Finds the object defined by the parameters.
Valid Arguments:
arr -  An array of colors from the object.
upTexts - An array of strings possible for the UpTexts of the object ex. 'illow' for willow.
colorSpeed - The speed to be used. If you don't know, look up ColorSpeedTolerance.
splitX - The size of the object across the X axis.
splitY - The size of the object across the Y axis.
*******************************************************************************}
function SaFindObjectColorArray(arr: array of Integer; upTexts: TStringArray; colorSpeed,splitX,splitY: Integer): TPoint;
var
  color,tolerance: Integer;
  hm,sm: Extended;
begin
  HueSatTolCol(hm,sm,tolerance,color,arr,colorSpeed);
  Result := SaFindObjectTPA(color,upTexts,hm,sm,colorSpeed,tolerance,splitX,splitY);
end;

OLD BELOW HERE

type
  THSLColor = record
    h: Extended;
    s: Extended;
    l: Extended;
  end;
{I'll write up the comment for this when I get back today.}
procedure HueSatTolCol(var hue,sat: Extended; var tol,col: Integer; arr: array of Integer);
var
  i: Integer;
  hslarr: array of THSLColor;
  minmax: array[0..1] of THSLColor;
  h,s,l: Extended;
  hmod,smod: Extended;
  bestCol: THSLColor;
begin
  SetLength(hslarr,Length(arr));
  for i:=0 to High(arr) do
  begin
    ColorToHSL(arr[i],hslarr[i].h,hslarr[i].s,hslarr[i].l);
  end;
  // hslarr now contains the contents of arr in HSL form.
  minmax[0].h := 255;
  minmax[0].s := 255;
  minmax[0].l := 255;
  // MinMax[0] = MIN MinMax[1] = MAX
  for i:=0 to High(hslarr) do
  begin
    minmax[0].h := MinE(minmax[0].h,hslarr[i].h);
    minmax[0].s := MinE(minmax[0].s,hslarr[i].s);
    minmax[0].l := MinE(minmax[0].l,hslarr[i].l);
    minmax[1].h := MaxE(minmax[1].h,hslarr[i].h);
    minmax[1].s := MaxE(minmax[1].s,hslarr[i].s);
    minmax[1].l := MaxE(minmax[1].l,hslarr[i].l);
  end;
  h := minmax[1].h - minmax[0].h;
  s := minmax[1].s - minmax[0].s;
  l := minmax[1].l - minmax[0].l;
  tol := Round(l + 0.1);
  hmod := (h/l);
  smod := (s/l);
  if(hmod < 0.1)then
    hmod := 0.1;
  if(smod < 0.1) then
    smod := 0.1;
  hue := hmod;
  sat := smod;
  bestCol.h := (minmax[0].h + minmax[1].h) div 2;
  bestCol.s := (minmax[0].s + minmax[1].s) div 2;
  bestCol.l := (minmax[0].l + minmax[1].l) div 2;
  writeln(FloatToStr(h));
  writeln(FloatToStr(s));
  writeln(FloatToStr(l));
  col := HSLToColor(bestCol.h,bestCol.s,bestCol.l);
  Writeln(IntToStr(col));
end;
{*******************************************************************************
function SaFindObjectTPA(color: Integer; upTexts: TStringArray; huemod, satmod: Extended; colorSpeed, tolerance, splitX, splitY: Integer): TPoint;
By: Tniffoc
Description: Returns the x,y coordinates of the object defined by the arguments
on the main screen.
Valid Arguments:
color - The color the the object
upTexts - All the possible up texts for the object being found
huemod - The hue modifier (only applicable if you are using colorSpeed 2)
satmod - The sat modifier (only applicable if you are using colorSpeed 2)
colorSpeed - The speed to be used. If you don't know what this is, look it up.
tolerance - The tolerance to be used when finding the object.
splitX: The size of the object across the x axis.
splitY: the size of the object across the y axis.
*******************************************************************************}
function SaFindObjectTPA(color: Integer; upTexts: TStringArray; huemod, satmod: Extended; colorSpeed, tolerance, splitX, splitY: Integer): TPoint;
var
  cts,i,sax,say,count: Integer;
  TPA: TPointArray;
  ATPA: T2DPointArray;
begin
  cts := GetColorToleranceSpeed;
  ColorToleranceSpeed(colorSpeed);
  if(colorSpeed > 1) then
    SetColorSpeed2Modifiers(huemod,satmod);
  FindColorsSpiralTolerance(MSCX,MSCY,TPA,color,MSX1,MSY1,MSX2,MSY2,tolerance);
  i := Length(TPA);
  if((i > splitX) and (i > splitY)) then
  begin
    ATPA := SplitTPAEx(TPA,splitX,splitY);
    for i:=0 to High(ATPA) do
    begin
      MiddleTPAEx(ATPA[i],sax,say);
      MMouse(sax,say,2,2);
      wait(500 + random(500));
      wait(200 + random(500));
      for count:=0 to High(upTexts) do
      begin
        if(IsUpText(upTexts[count])) then
        begin
          GetMousePos(sax,say);
          Result := Point(sax,say);
          ColorToleranceSpeed(cts);
          Exit;
        end;
      end;
    end;
  end else
  begin
    for i:=0 to High(TPA) do
    begin
      MMouse(TPA[i].x,TPA[i].y,2,2);
      wait(500 + random(500));
      wait(200 + random(500));
      if(IsUpText(upTexts[count])) then
      begin
        GetMousePos(sax,say);
        Result := Point(sax,say);
        ColorToleranceSpeed(cts);
        Exit;
      end;
    end;
  end;
  Result := Point(0,0);
end;
{*******************************************************************************
function SaFindObjectColorArray(arr: array of Integer; upTexts: TStringArray; colorSpeed,splitX,splitY: Integer): TPoint;
By: Tniffoc
Description: Finds the object defined by the parameters.
Valid Arguments:
arr -  An array of colors from the object.
upTexts - An array of strings possible for the UpTexts of the object ex. 'illow' for willow.
colorSpeed - The speed to be used. If you don't know, look up ColorSpeedTolerance.
splitX - The size of the object across the X axis.
splitY - The size of the object across the Y axis.
*******************************************************************************}
function SaFindObjectColorArray(arr: array of Integer; upTexts: TStringArray; colorSpeed,splitX,splitY: Integer): TPoint;
var
  color,tolerance: Integer;
  hm,sm: Extended;
begin
  HueSatTolCol(hm,sm,tolerance,color,arr);
  Result := SaFindObjectTPA(color,upTexts,hm,sm,colorSpeed,tolerance,splitX,splitY);
end;

SaFindObjectTPA is defficient. It sorts the points in to bigger blocks, good, it goes through all of them, good, but it should just end there if the uptext matches, why is the second loop even being done?

From: n3ss3s
SaFindObjectTPA is defficient. It sorts the points in to bigger blocks, good, it goes through all of them, good, but it should just end there if the uptext matches, why is the second loop even being done?

I don't see what you're saying. As I see it, it sorts the points into bigger blocks and for each one, performs the following actions:

1. MMouse to the area
2. Check all uptexts and exit if the right one is found.

The loop in the else statement is a TPA only backup in case the TPA is too small for ATPA finding. I don't quite understand what you're saying.

From: Tniffoc
I don't see what you're saying. As I see it, it sorts the points into bigger blocks and for each one, performs the following actions:

1. MMouse to the area
2. Check all uptexts and exit if the right one is found.

The loop in the else statement is a TPA only backup in case the TPA is too small for ATPA finding. I don't quite understand what you're saying.

Oh shat I didn't see there is an else in there :p

From: n3ss3s
Oh shat I didn't see there is an else in there :p

Lol. I'm hoping that this will help out the noobs who don't want to learn real TPA finding. This provides REAL TPA CTS 2 Finding for people on 1 line of simple code.

Btw, don'y forget about IsUpTextMultiCustom :)

Just pointing some things…

- To fasten your for to do loops, store High(x) in a variable. The function High is called every time it loops.
- The max HSL value is 100
- SaFindObjectTPA does almost the same as FindObjTPA, except that it supports hue and sat modifiers. But not all people would like to use CTS 2…
-

 if(colorSpeed > 1) then
    SetColorSpeed2Modifiers(huemod,satmod);

Color speed can also be 3(XYZ), so you should do if (colorSpeed = 2) then
- Result := Point(0,0); is not necessary

From: Cazax
Just pointing some things…

- To fasten your for to do loops, store High(x) in a variable. The function High is called every time it loops.
- The max HSL value is 100
- SaFindObjectTPA does almost the same as FindObjTPA, except that it supports hue and sat modifiers. But not all people would like to use CTS 2…
-

 if(colorSpeed > 1) then
    SetColorSpeed2Modifiers(huemod,satmod);

Color speed can also be 3(XYZ), so you should do if (colorSpeed = 2) then
- Result := Point(0,0); is not necessary

• I'll do the High thing right now.
• HSL value really doesn't matter.
• SaFindObjectTPA already supports other cts.
• I'll work on cts 1 and 3 support now becuase the colors will be wrong. :eek:
• if(colorSpeed = 2) fix will be out in next release.

UPDATED

Thanks for the feedback.

Instead of custom types, why not use just a 2D integer array?

From: Nava2
Instead of custom types, why not use just a 2D integer array?

This is the first time I did this and it simplified things for me.

what if TPA is too small for splitting, but it still has many pixels in some wrong place, which do not give the uptext we want? The mouse goes through all those pixels which might in some cases be very detectable. Have you confirmed this is not a problem?

From: marpis
what if TPA is too small for splitting, but it still has many pixels in some wrong place, which do not give the uptext we want? The mouse goes through all those pixels which might in some cases be very detectable. Have you confirmed this is not a problem?

The maximum size of a TPA that cannot be split under normal circumstances is quite small. If the TPA is too small to be split in the first place, you're doing it wrong afaik.

Cases:

case cts of
  0, 1: blah;
  2: moreblah;
  3: alotofblah;
end;

You also forgot to set a variable to High in a lot of places.

In GetTolerance, in that while loop you do not need the begin/end, or the Result := 0;.

If I find anything else I'll notify you. :)