SRL Archive - Research & Development Lounge

Please done flame, ive never really been good at TPA's ive understand
them but never Really got the grip of them, i know this is probably nt very good for an SRL member but w/e.

Its great for Dubugging Because of Wizzups great Draw TPA Function!!

program New;
{.include SRl/SRl.scar}



{*******************************************************************************
Function DebugATPA(aPoints: T2DPointArray; BmpName: String): Boolean;
By: Wizzup? Smally Edited by Nicbaz
Description: Draws a T2DPointArray on the debug canvas.
*******************************************************************************}
procedure DebugATPA(aPoints: T2DPointArray; BMPName: string);
var
   ClientBMP, Hi, Hi2, I, Col, I2: Integer;
   B: TBox;

Begin
  B := GetATPABounds(aPoints);
  DisplayDebugImgWindow(B.x2 - B.x1, B.y2 - B.y1);
  ClientBMP := BitmapFromString(B.x2 - B.x1, B.y2 - B.y1, '');
  CopyClientToBitmap(ClientBMP, B.x1, B.y1, b.x2, b.y2);
  Hi := High(aPoints);
  for I := 0 to Hi do
  begin
    Col := Random(839894);
    Hi2 := High(aPoints[i]);
    for I2 := 0 to Hi2 do
      FastSetPixel(ClientBMP, aPoints[i][I2].X - b.x1, aPoints[i][I2].Y - b.y1, Col);
  end;
  SafeDrawBitmap(ClientBMP, GetDebugCanvas, 0, 0);
  try
    FreeBitmap(ClientBMP);
  except
  end;
end;


Function FindTPA(Uptex:string; Colors: TIntegerArray; Tol,
         ObjWidth, ObjHeight:Integer): Boolean;
Var
  TPAs: TPointArray;
  TPA:  Tpoint;
  D2TPA: T2DPointArray;
  X,Y,I,N: Integer;

Begin
  n := Length(Colors) - 1;
  for i := 0 to n do
    FindColorsSpiralTolerance(x,y,TPAs,Colors[i],MMX1, MMY1, MMX2,MMY2,30);
  If length(TPAs) = 0 Then
    Exit;
  D2TPA:= TPAtoATPAEx(TPAs,ObjHeight,ObjWidth);
  For i:= 0 to length(D2TPA) - 1 Do
  begin
    TPA:= MiddleTPA(D2TPA[i]);
    DebugATPA(D2TPA,'TPA');
    MMouse(TPA.X, TPA.Y, 0, 0);
    Wait(150 + Random(50));
    If IsUpText(UpTex) Then
    begin
      X:= TPA.X
      Y:= TPA.Y
      Result:= True;
    end;
  end;
end;







begin
  SmartSetUp('world16',true,true,false);
  wait(2000);
  SetTargetDC(SmartGetDC);
  SetupSRL;
  FindTPA('df',[(8108767)],10,30,30);
end.

So this.. hmm. Finds a TPA, and then draws on the canvas to show where it is? Like, all the spots found?

yep it draws the t2dpoint array like i picked about 5 colors of coal ore and it found all it could on the ms like the black lines on the rocks went green

It looks like it'd work pretty well.

If you used ColorToleranceSpeed(2), you'd get faster and more accurate results. Only problem is: More math. =P

Other than that, good job NiCbaZ. Rep+ to you ^.^

whats the difference between this and Wizzup?'s DrawTPA and DrawATPA ?

Ok thanks il work on " more math" could you show me some TPA's that use some advanced math, as i said im not very good at TPA's yet so need more examples , i find it hard to Read Tuts i prefer looking at the code and trying to understand it.


HyperSecret: Nothing just removed a few lines, that's not really what im putting in "Test corner" im putting my FindTPA

Not sure, but I believe when running FindColorsSpiral/Tolerance, it clears the TPA before hand meaning it will only return the TPA of the last colour searched for. Instead, set TPAs to an ATPA then set same length as colours and use TPAs as you do with colours then combine the ATPA into a single TPA before then splitting (may want to remove duplicate points at this stage or not).
Also, I believe TPAToATPAEx's last 2 integers refer to the shape of the 2d array ie length of array ATPA and length of ATPA with which you may have been confused about.
Otherwise, nice little function that will work well with a bit of adjustments.

function TPADrawColor(i: Integer): Integer;
begin
  Result := RGBtoColor(60 * i, 10 * i, 30 * i);
end;

procedure Draw(TPA: T2DPointArray);
var
  Found, I, I2, Hgh, Hgn: Integer;
begin
  Hgn := High(TPA);
  Found := BitmapFromString(MSx2 - MSx1 + 1, MSy2 - MSy1 + 1, '');
  CopyClientToBitmap(Found, MSx1, MSy1, MSx2, MSy2);
  for I2 := 0 to Hgn do
  begin
    Hgh := High(TPA[I2]);
    for I := 0 to Hgh do
      FastSetPixel(Found, TPA[I2][i].X - MSx1, TPA[I2][i].Y - MSy1, TPADrawColor(I2));
  end;
  DisplayDebugImgWindow(MSx2 - MSx1 + 1, MSy2 - MSy1 + 1);
  SafeDrawBitmap(Found, GetDebugCanvas, 0, 0);
  FreeBitmap(Found);
end;

:)

From: Timer

procedure Draw(TPA: T2DPointArray);
var
  Found, I, I2, Hgh, Hgn: Integer;
begin
  Hgn := High(TPA);
  Found := BitmapFromString(MSx2 - MSx1 + 1, MSy2 - MSy1 + 1, '');
  CopyClientToBitmap(Found, MSx1, MSy1, MSx2, MSy2);
  for I2 := 0 to Hgn do
  begin
    Hgh := High(TPA[I2]);
    For I := 0 To Hgh Do
      FastSetPixel(Found, TPA[I2][i].X - MSx1, TPA[I2][i].Y - MSy1, CLRed);
  end;
  DisplayDebugImgWindow(MSx2 - MSx1 + 1, MSy2 - MSy1 + 1);
  SafeDrawBitmap(Found, GetDebugCanvas, 0, 0);
  FreeBitmap(Found);
end;

:)

To bad its hard to tell the difference between each tpa

From: Mylesmadness
To bad its hard to tell the difference between each tpa

Hmm… Give me 5 minutes! ;)

EDIT: Added the different Colors!