SRL Archive - SRL Snippets

This function was inspired by DTM item-finding. I originally created this to search for metal bars in the inventory since their colors change so much.

function FilterTPASegment(TPA, Segment: TPointArray; Accuracy: Extended): TPointArray;

The function takes a set of specified "segment" points and compares their values to points in the TPA. This is done by using the PointInTPA function, and a set of points are only added to the result array if all (the number of points required to be found can be changed with the accuracy setting) of the points in the segment array are in the TPA. This seems to be a good choice for item-finding and I'm sure it has other uses as well.

I've used this function in my Clay, Craft, Bank script for generic item-finding (finds any type of uncut gem with the same segment) if you want to see it in action.

How to make a segment:

^ Segments are based upon a normal coordinate system. The above segment looks like this when put into code:

BarSegment := [Point(0, 0), Point(1, 0), Point(2, 0), Point(3, 0), Point(4, 1), Point(4, 2),
  Point(4, 3), Point(4, 4), Point(4, 5), Point(3, 6), Point(2, 7), Point(1, 8), Point(0, 9)]; 

Item Finding:

Usage:

FindColorsTolerance(TPA, Color, Area[0], Area[1], Area[2], Area[3], Tol);
Points := FilterTPASegment(TPA, BarSegment, 1);
aPoints := SplitTPAEx(Points, 20, 20);
SMART_ClearCanvas;
for a := 0 to High(aPoints) do
  SMART_DrawDotsEx(False, aPoints[a], clred);

It currently takes around 100-400 ms depending on the search area size.

Descripton:

(*
FilterTPASegment
~~~~~~~

.. code-block:: pascal

    function FilterTPASegment(TPA, Segment: TPointArray; Accuracy: Extended): TPointArray;

Results a TPointArray of all found (line) segments within the given TPointArray.
Accuracy can be decreased to allow for tolerance of segment shape.
    * TPA: The TPA to be filtered.
    * Segment: The TPA of specified points to be searched for.
    * Accuracy: Lower for more search tolerance. Valid choices: 0.00 - 1.00

.. note::

    by Runaway

Example:

.. code-block:: pascal

  FindColorsTolerance(TPA, 131072, MIX1, MIY1, MIX2, MIY2, 1);
  BarSegment := [Point(0, 0), Point(1, 0), Point(2, 0), Point(3, 0), Point(4, 1), Point(4, 2),
  Point(4, 3), Point(4, 4), Point(4, 5), Point(3, 6), Point(2, 7), Point(1, 8), Point(0, 9)];
  Points := FilterTPASegment(TPA, BarSegment, 1);
  aPoints := SplitTPAEx(Points, 20, 20);
  for a := 0 to High(aPoints) do
  begin
    x := MiddleTPA(aPoints[a]).x;
    y := MiddleTPA(aPoints[a]).y;
    Mouse(x, y, 3, 3, mouse_right);
    if WaitOption(Option, 1000) then
      Break;
  end;
*)

function FilterTPASegment:

function FilterTPASegment(TPA, Segment: TPointArray; Accuracy: Extended): TPointArray;
var
  Temp: TPointArray;
  Curr: TPoint;
  lResult, lTemp, MinRes, Res, MaxCount, Count, hTPA, hSegment: Integer;
  t, i, ii: Integer;
begin
  hTPA := High(TPA);
  hSegment := High(Segment);
  lResult := 0;
  MinRes := Round(Accuracy * (hSegment + 1));
  MaxCount := (hSegment + 1) - MinRes;
  MarkTime(t);
  for i := 0 to hTPA do
  begin
    Res := 0;
    for ii := 0 to hSegment do
    begin
      Curr := Point(TPA[i].x + Segment[ii].x, TPA[i].y + Segment[ii].y);
      if PointInTPA(Curr, TPA) then
      begin
        SetLength(Temp, Res + 1);
        lTemp := Length(Temp);
        Temp[Res] := Curr;
        Inc(Res);
      end;
      Count := (ii + 1) - Res;
      if (Count > MaxCount) then
        Break;
    end;
    if (Res >= MinRes) then
    begin
      SetLength(Result, lResult + lTemp);
      lResult := Length(Result);
      AppendTPA(Result, Temp);
    end;
  end;
  if Debug then Writeln('Took: '+IntToStr(TimeFromMark(t))+' ms, found '+ IntToStr(Round(lResult / (hSegment + 1))) +' segments');
end;

Edit: This is a nifty little function that will create a TPA segment for the item in the specified slot.
function CreateTPASegment:

function CreateTPASegment(Slot, Len: Integer): TPointArray;
var
  TPA, Temp: TPointArray;
  Taken: TBooleanArray;
  pTemp: TPoint;
  sBox: TBox;
  hTemp, i, ii: Integer;
  pDist, sDist: Extended;
begin
  SetLength(Result, 0);
  if ExistsItem(Slot) then
  begin
    sBox := InvBox(Slot);
    FindColorsTolerance(TPA, 131072, sBox.x1, sBox.y1, sBox.x2, sBox.y2, 1);
    SortTPAFrom(TPA, Point(sBox.x2, sBox.y1));
    if (Length(TPA) >= Len) then
    begin
      for i := 0 to (Len - 1) do
        Temp[i] := TPA[i];
      hTemp := High(Temp);
      SetLength(Result, hTemp + 1);
      SetLength(Taken, hTemp + 1);
      InvertTPA(Temp);
      pDist := Distance(Temp[0].x, Temp[0].y, Temp[1].x, Temp[1].y);
      if (pDist < 2) then
      begin
        if (Temp[0].x <= Temp[1].x) and (Temp[0].y <= Temp[1].y) then
        begin
          pTemp := Temp[0];
          Taken[0] := True;
        end else
        begin
          pTemp := Temp[1];
          Taken[1] := True;
        end;
      end else
      begin
        if (Temp[0].y < Temp[1].y) then
        begin
          pTemp := Temp[0];
          Taken[0] := True;
        end else
        begin
          pTemp := Temp[1];
          Taken[1] := True;
        end;
      end;
      Result[0] := Point(0, 0);
      for i := 1 to hTemp do
      begin
        for ii := 0 to hTemp do
        begin
          if Taken[ii] then
            Continue;
          sDist := Distance(Result[i - 1].x, Result[i - 1].y, Temp[ii].x, Temp[ii].y);
          if (sDist < 2) then
          begin
            Result[i] := Point(Temp[ii].x - pTemp.x, Temp[ii].y - pTemp.y);
            Taken[ii] := True;
            Break;
          end;
        end;
      end;
    end else
    begin
      Writeln('Not enough points to create segment!');
      Exit;
    end;
  end else
  begin
    Writeln('No item found in specified slot!');
    Exit;
  end;
end;

If you want to test it out for yourself, I've attached a testing script with debug/paint all set up and ready to go. All you have to do is select the area, colors, etc. :)

I love your tpa things, this also looks amazing :P your TPA cluster works like a charm still :)

Interesting thing. How Accuracy parameter works? It has to do with color tolerance or gaps in segment?

From: Ollybest
I love your tpa things, this also looks amazing :P your TPA cluster works like a charm still :)

Thanks! Unfortunately this one doesn't seem to be as useful as the others :o

From: beginner5
Interesting thing. How Accuracy parameter works? It has to do with color tolerance or gaps in segment?

Gaps in the segment; If the accuracy is 0.8, only 80% of the points from the segment array need to be found to result as a match.

I don't know if anyone uses this, but I've updated my first post and have added a new function at the bottom:

function CreateTPASegment(Slot, Len: Integer): TPointArray;

It creates a segment of specified Length (Len) in the specified slot. I'm using this to identify any type of food without having to bother with color for my upcoming combat script. I haven't tested it yet but it should work in theory!

This stuff is beautiful man