SRL Archive - First Scripts

Hey everyone! I've been here for a week or two and I've been working on a potato picker script for ORS. It still doesn't run smoothly, and I've made it for private use. A lot of thanks go to Sjoe who has helped me with walking.

My script is not entirely finished yet, it still needs some antiban and it has to find randoms. I feel like my mainloop is lacking a bit as well. Also opening the gate or finding it is what usually fucks the script up. Constructive criticism and feedback is greatly appreciated.

Ta-Da!

program PotatoPicker;
{$DEFINE SMART8}
{$I SRL-OSR/SRL.simba}

var
  Gate: integer;

Procedure declarePlayers;
begin
  HowManyPlayers := 1;
  NumberOfPlayers(HowManyPlayers);
  CurrentPlayer := 0;

  with Players[0] do
  begin
    Players[0].Name        := 'xx';
    Players[0].Pass        := 'xx';
    Players[0].Nick        := 'xx';
    Players[0].Pin         := 'xx';
    Players[0].Lampskill   := Skill_Agility;
    Players[0].WorldInfo   := [];
    Players[0].Member      := True;
    Players[0].Active      := True;
  end;
end;

function PotatoColor: Integer;
var
  arP: TPointArray;
  arC: TIntegerArray;
  tmpCTS, i, arL: Integer;
begin
  tmpCTS := GetColorToleranceSpeed;
  ColorToleranceSpeed(2);
  SetColorSpeed2Modifiers(0.10, 0.13);

  FindColorsSpiralTolerance(MSCX, MSCY, arP, 3563085, MSX1, MSY1, MSX2, MSY2, 8);
  if (Length(arP) = 0) then
  begin
    //Writeln('Failed to find the color, no result.');
    ColorToleranceSpeed(tmpCTS);
    SetColorSpeed2Modifiers(0.2, 0.2);
    Exit;
  end;

  arC := GetColors(arP);
  ClearSameIntegers(arC);
  arL := High(arC);

  for i := 0 to arL do
  begin
    Result := arC[i];
    //Writeln('AutoColor = ' + IntToStr(arC[i]));
    Break;
  end;

  ColorToleranceSpeed(tmpCTS);
  SetColorSpeed2Modifiers(0.2, 0.2);

  if (i = arL + 1) then
    //Writeln('AutoColor failed in finding the color.');
end;

function BankColors: Integer;
var
  arP: TPointArray;
  arC: TIntegerArray;
  tmpCTS, i, arL: Integer;

begin
  tmpCTS := GetColorToleranceSpeed;
  ColorToleranceSpeed(2);
  SetColorSpeed2Modifiers(0.02, 2.44);

  if not (FindColorsTolerance(arP, 3563636, MSX1, MSY1, MSX2, MSY2, 5)) then
  begin
    //Writeln('Failed to find the color, no result.');
    ColorToleranceSpeed(tmpCTS);
    SetColorSpeed2Modifiers(0.2, 0.2);
    Exit;
  end;

  arC := GetColors(arP);
  ClearSameIntegers(arC);
  arL := High(arC);

  for i := 0 to arL do
  begin
    Result := arC[i];
    //Writeln('AutoColor = ' + IntToStr(arC[i]));
    Break;
  end;

  ColorToleranceSpeed(tmpCTS);
  SetColorSpeed2Modifiers(0.2, 0.2);

  if (i = arL + 1) then
//Writeln('AutoColor failed in finding the color.');
end;

function R_GetCameraYaw: Integer;
Begin
  Result := SmartGetFieldInt(0, 'dq.fw') * -1896216087;
End;

function R_GetCompassAngle: extended;   //your getdegrees func, just converted to rads
Begin
  Result := R_GetCameraYaw / 5.67777;
End;

function R_GetTileGlobal: TPoint;
var
  Me: Integer;
Begin
  Me := SmartGetFieldObject(0, 'p.ho');
  Result.X := (SmartGetFieldInt(0, 'd.cy') * 670470189) + (SmartGetFieldInt(Me, 'z') * -344898115) div 128;
  Result.Y := (SmartGetFieldInt(0, 'r.cl') * -1567957809) + (SmartGetFieldInt(Me, 'v') * -331795885) div 128;
  SmartFreeObject(Me);
End;

function R_TileToMM(tile: TPoint): TPoint;
var
  angle, x, y: extended;
  temp: TPoint;
begin
   angle:= -Radians(R_GetCompassAngle);
   temp := R_GetTileGlobal;
   x:= (tile.x - temp.x) * 4 - 2;
   y:= (temp.y - tile.y) * 4 - 2;
   result.x:= round(x*cos(angle) + y*sin(angle)) + 645;
   result.y:= round(y*cos(angle) - x*sin(angle)) + 85;
end;
//creds to Awkwardsaw
function R_WalkDaPath(path : TPointArray) : Boolean;
var
  i, c, a: Integer;
  tp, ntp : TPoint;
begin
  RunEnergy(10 + Random(20));
  Wait(100 + Random(300));
  GameTab(Tab_inv);
  for i := 0 to high(path) do
  begin
    tp := R_TileToMM(path[i]);
    if i < high(path) then
    begin
      ntp := R_TileToMM(path[i + 1]);
      if rs_OnMinimap(ntp) then
        continue;
    end;
    if not rs_OnMinimap(tp) then
    begin
      writeln('tile not on map: ' + inttostr(i));
      inc(a);
      continue;
    end;
    if i = High(Path) then MMouse(tp.x, tp.y, 1, 1)
      else MMouse(tp.x, tp.y, 2, 2);

    Wait(60 + Random(30));
    ClickMouse2(Mouse_left);
    Wait(50 + Random(20));

    if i < high(path) then
    begin
      ntp := R_TileToMM(path[i + 1]);
      while not rs_OnMinimap(ntp) do
      begin
        ntp := R_TileToMM(path[i + 1]);
        wait(100 + random(50));
        inc(c);
        if c > 300 then
        begin
          result := false;
          exit;
        end;
        if not IsMoving then continue;
      end;
    end else
      flag;
    end;
  result := true;
end;

Procedure PickPotato;
var
  x, y: integer;
begin
  repeat
  if FindNormalRandoms Then
    if Not LoggedIn Then
      Exit;
  if FindObjCustom(x, y, ['otato'], [PotatoColor], 5) then
  begin
    MakeCompass('n');
    ClickMouse2(mouse_Left);
    wait(2000+random(250));
  end;
  until(InvFull);
end;

procedure WalkToGate;
var
  path: TPointArray;
begin
  if (not Loggedin) then Exit;

  Path := [Point(3148, 3280), Point(3145, 3290)];

  R_WalkDaPath(Path);

  FFlag(1);
end;

Procedure WalkToBank;
var
  path: TPointArray;
begin
  if (not Loggedin) then Exit;

  Path := [Point(3137, 3292), Point(3128, 3294), Point(3118, 3294), Point(3110, 3288), Point(3106, 3278), Point(3105, 3267), Point(3103, 3255), Point(3096, 3248), Point(3092, 3245)];

  R_WalkDaPath(Path);
  FFlag(1);
end;

function OpenDatBank(): boolean;
var
  path: TPoint;
begin
  begin
  Path := R_TileToMM(Point(3093, 3244));
  MMouse(Path.x, Path.y, 1, 1);
  ClickMouse2(mouse_Left);
  result:= false;
  end;
  if(openBank( 'db', false, false ))then
  begin
    if( bankScreen )then
    begin
      depositAll();
      result:= true;
    end;
  end;
end;

procedure WalkToField;
var
  Path: TPointArray;
begin
  if (not Loggedin) then Exit;

  Path := [Point(3097, 3250), Point(3103, 3256), Point(3104, 3264), Point(3105, 3274), Point(3109, 3283), Point(3116, 3294), Point(3127, 3294), Point(3135, 3292), Point(3146, 3292)];

  R_WalkDaPath(Path);
  FFlag(1);
end;

procedure SetDTM;
begin
  Gate := DTMFromString('mbQAAAHicY2VgYOBjZGAwAGI9IH7DAMHTgHgCEM8D4olAvACIGyP5GAp9+cB0bRgEswLF0TEjFgwGALOmCb4=');
end;

procedure FrDTM;
begin
  FreeDTM(Gate);
end;

procedure FindGate;
var
  x, y, i: integer;
  aFound: Extended;
  Path: TPoint;
begin
  repeat
  if FindDTMRotated(Gate, x, y, MSX1, MSY1, MSX2, MSY2, -Pi/4, Pi/4, Pi/60, aFound) then
  begin
    MakeCompass('n');
    writeln('We found the gate');
    MMouse(x, y, 3, 3);
    Mouse(x, y, 0, 0, true);
    Exit;
  end else
    begin
    Path := R_TileToMM(Point(3146, 3292));
    MMouse(Path.x, Path.y, 1, 1);
    ClickMouse2(mouse_Left);
    FFlag(1);
    writeln('Trying again');
  end;
  until FindObj(x, y, 'lose', 872307, 5);
end;

begin
  ClearDebug;
  DeclarePlayers;
  SetupSRL;
  ActivateClient;
  LoginPlayer;
  MakeCompass('n');
  //writeln(R_GetTileGlobal);
  repeat
  WalkToField;
  SetDTM;
  Wait(250+random(250));
  FindGate;
  Wait(1000+random(250));
  PickPotato;
  WalkToGate;
  Wait(1000+random(250));
  FindGate;
  FrDTM;
  WalkToBank;
  OpenDatBank;
  until false;
end.

Looking good for your first script.

Thanks. But it collects 200 potatoes at most and then crashes. Even if it would collect 1000 it would be good enough.

From: Athylus
Thanks. But it collects 200 potatoes at most and then crashes. Even if it would collect 1000 it would be good enough.

What does it say or do

It usually gets stuck at opening the gate, I'm trying to make a new procedure for it now. It's really hard to open a gate when the fence around it is all the same color.

From: Athylus
It usually gets stuck at opening the gate, I'm trying to make a new procedure for it now. It's really hard to open a gate when the fence around it is all the same color.

You should try using TPAs or ATPAs with Uptext or Option checkers, have it loop through the TPAs or ATPAs and check for 'open' or 'closed' in the Uptext or Options.

Thanks GG, I'll read up some info.