SRL Archive - Test corner

You need at least 2 (or 3) rocks visible.

program New;

Var
   RColor: Integer;

Function ClearTPointArray(a: TPointArray): TPointArray;

Var
   I, C: Integer;

Begin
  For I := 0 To GetArrayLength(a) - 1 Do
    If rs_OnMiniMap(a[i].x, a[i].y) Then
    Begin
      C := C + 1;
      SetArrayLength(Result, C + 1);
      Result[C] := a[i];
    End;
End;

Function NumberDoesntExist(Ar2: Array Of Integer; Number: Integer): Boolean;

Var
   I: Integer;
Begin
  Result := False;
  For I := 0 To GetArrayLength(Ar2) - 1 Do
    If Ar2[I] = Number Then
      Exit;
  Result := True;
End;

Function ShrinkArray(YourArray: Array Of Integer): Array Of Integer;

Var
   I: Integer;

Begin
  SetArrayLength(Result, 0);
  For I := 0 To GetArrayLength(YourArray) - 1 Do
  Begin
    If NumberDoesntExist(Result, YourArray[I]) Then
    Begin
      SetArrayLength(Result, GetArrayLength(Result) + 1);
      Result[GetArrayLength(Result) - 1] := YourArray[I];
    End;
  End;
End;

Function GetRockColor(Color1: Boolean): Integer;

Var
   Points: TPointArray;
   Colors, Colors2, Colors3, Amount, Amount2: Array Of Integer;
   I, iZ: Integer;
   myZ: Extended;
   X, Y, Z: Array Of Extended;

Begin
  ColorToleranceSpeed(2);
  SetColorSpeed2Modifiers(0.9, 0.2);
  FindColorsTolerance(Points, RColor, MMX1, MMY1, MMX2, MMY2, 70);
  Points := ClearTPointArray(Points);
  Colors := ShrinkArray(GetColors(Points));
  SetArrayLength(Amount, GetArrayLength(Colors));

  For I := 0 To GetArrayLength(Colors) - 1 Do
  Begin
    Amount[i] := CountColor(Colors[I], MMX1, MMY1, MMX2, MMY2);
   // If Amount[I] > 50 Then WriteLn('Color ' + IntToStr(Colors[I]) + ': '+IntToStr(Amount[I]));
  End;

  For I := 0 To GetArrayLength(Colors) - 1 Do
  Begin
    If (Amount[I] > 50) And (Amount[I] < 750) Then
  //  If (Amount[I] > 50) And (Amount[I] < 500) Then
    Begin
      SetArrayLength(Amount2, GetArrayLength(Amount2) + 1);
      SetArrayLength(Colors2, GetArrayLength(Colors2) + 1);
      Amount2[GetArrayLength(Amount2) - 1] := Amount[I];
      Colors2[GetArrayLength(Colors2) - 1] := Colors[I];
    End;
  End;
  SetArrayLength(X, GetArrayLength(Colors2));
  SetArrayLength(Y, GetArrayLength(Colors2));
  SetArrayLength(Z, GetArrayLength(Colors2));

  For I := 0 To GetArrayLength(Colors2) - 1 Do
  Begin
    ColorToXYZ(Colors2[I], X[I], Y[I], Z[I]);
    If (X[I] > 2) And (X[I] < 14) And (Y[I] > 2) And (Y[I] < 15)
    And (Z[I] > 2) And (Z[I] < 16) Then
    Begin
      SetArrayLength(Colors3, GetArrayLength(Colors3) + 1);
      Colors3[GetArrayLength(Colors3) - 1] := Colors2[I];
      AddToReport('Color['+IntToStr(I)+']: ' + IntToStr(Colors3[GetArrayLength(Colors3) - 1]));
    End;
  End;
  If Color1 Then
  Begin
    MyZ := 0;
    For I := 0 To GetArrayLength(Colors3) - 1 Do
    Begin
      If MaxE(Z[I], MyZ) <> MyZ Then
      Begin
        iZ := I;
        MyZ := MaxE(Z[I], MyZ);
      End;
    End;
  End
  Else
  Begin
    myZ := 100000;
    For I := 0 To GetArrayLength(Colors3) - 1 Do
    Begin
      If MinE(Z[I], MyZ) <> MyZ Then
      Begin
        iZ := I;
        MyZ := MinE(Z[I], MyZ);
      End;
    End
  End;
  If iZ < GetArrayLength(Colors3) Then Result := Colors3[iZ];
  WriteLn('The Color is: '+IntToStr(Result));
End;

Var
   I1, I2: LongInt;

begin
  ClearDebug;
  RColor := 4412238;
  Repeat
    I1 := GetSystemTime;
    GetRockColor(True);
    I2 := GetSystemTime;
    WriteLn(InttoStr(I2-I1));
    Wait(1000);
    ClearReport;
  Until False;
end.

Works, tested at Varrock East Bank.

Where to run?

Tested at MiningGuild. Worked after I changed

(Amount[i] < 500)

{to}

(Amount[i] < 750)

Nice work :)

From: nielsie95
Tested at MiningGuild. Worked after I changed

(Amount[i] < 500)

{to}

(Amount[i] < 750)

Nice work :)

Ah…alot of rocks there… :p

thank god!!!! gonna use this at rim :D

Is this supposed to be an auto-coloring function? If it is, lets hope we can use it in conjunction with Varrock. I swear they only update the cities in an attempt to foil us in our work.