SRL Archive - Test corner

Yep. This one is even more accurate. New rocks only.
I made it because my older one (w_GasCheck) didn't seem to work in Rimmington too well. It worked fine in Lumb and VEM though.
I have NOT used this in my scripts yet. Please run it on your Gas Bitmaps…

A simple testscript:

program New;

Function new_GasCheck2(GP: TPoint): Boolean;

Var
   CTS, I, Le, T, Time: Integer;
   P, P2: TPointArray;
   C, C2: TIntegerArray;
   R, G, B: Integer;
   H, S, L: Extended;
   X, Y, Z: Extended;

Begin
  Result := False;

  Time := GetSystemTime;

  CTS := GetColorToleranceSpeed;
  ColorToleranceSpeed(2);
  SetColorSpeed2Modifiers(0.16, 0.46);
  GP.Y := GP.Y - 20;
  FindColorsTolerance(P, 9083807, GP.x - 25, GP.y - 25, GP.X + 25, GP.Y + 25, 15);
  ColorToleranceSpeed(CTS);
  SetColorSpeed2Modifiers(0.2, 0.2);

  If Length(P) < 60 Then
    Exit;

  C := GetColors(P);
  C2 := C;
  ClearSameIntegers(C);


  If Length(C) < 40 Then // Maybe lower the value.
  //If Length(C) < 60 Then
  Begin
    Exit;
  End;

  WriteLn('Passed Color Diversity: ' + IntToStr(Length(C)));
  Writeln('Total colors found: ' + IntToStr(Length(P)));

  SetLength(C, 0);
  SetLength(C, Length(C2));
  SetLength(P2, Length(P));

  Le := High(C2);

  For I := 0 To Le Do
  Begin
    ColorToRGB(C2[I], R, G, B);
    //If ((R - G) <= 6) And (G - B > 7) Then
    If ((R - G) <= 10) And (G - B > 7) Then
    Begin
      ColorToHSL(C2[I], H, S, L);
      If (H > 11.5) And (H < 16.0) And (S < 16.0) And (S > 2.0) And (L > 42.0) And (L < 71.0) Then
      Begin
        ColorToXYZ(C2[I], X, Y, Z);
        If (X >= 18.0) And (X <= 45.0) And (Y >= 20.0)
                       And (Y <= 48.0) And (Z >= 15.0)
                       And (Z <= 47.0) And (Abs(X - Y) < 3.0)
                       And (Abs(X - Z) < 5.0) And (Abs(Y - Z) < 6.5)
                        Then
        Begin
          C[T] := C2[I];
          P2[T] := P[I];
          T := T + 1;
        End;
      End;
    End;
  End;
  SetLength(C, T);

  ClearSameIntegers(C);

  If Length(C) < 25 Then
  Begin
    Exit;
  End;
  WriteLn('Passed Color Diversity after filtering the colors: ' + IntToStr(Length(C)));
  Writeln('Total colors found, after filtering: ' + IntToStr(Length(P2)));


  Result := True;
  WriteLn('Gas Gave TRUE');
  writeln('Time taken: ' + IntToStr(GetSystemTime - Time));
End;

Var
   P: TPoint;
begin
  Repeat
    Wait(500);
    GetMousePos(p.x, P.y);
    new_GasCheck2(p);
  Until False;
end.

And this is what I used for the 'real' testing , on the entire MS, using lots of bitmaps:

GasCheck1 is a short one using only ACA
GasCheck2 is my older w_GasCheck.
GasCheck3 is newest GasCheck I made, using ACA and lots of other filtering…

program New;

Var
   TestBMP, Count: Integer;

Const
   FoundBMPPath = 'GasFounds/'; // Only set when you are saving bmps.
   SaveBMPs = False;    // I recommend not saving them.
   Debug = False; // debug messages.

Function DebugTPA(Points: TPointArray; BmpName: String): Boolean;

Var
   Width, Height, ClientBMP, I: Integer;
   xs, ys, xe, ye: Integer;

Begin
  Try
  Begin
    xe := xs xor xs;
    ye := ys xor ys;
    xs := 1 shl 20;
    ys := 1 shl 20;

    For I := 0 To High(Points) Do
    Begin
      xs := Min(xs, Points[I].X);
      ys := Min(ys, Points[I].Y);

      xe := Max(xe, Points[I].X);
      ye := Max(ye, Points[I].Y);
    End;

    Width := xe - xs;
    Height := ye - ys;

    DisplayDebugImgWindow(0, 0);
    DisplayDebugImgWindow(Width, Height);
    ClientBMP := BitmapFromString(Width, Height, '');

    CopyClientToBitmap(ClientBMP, xs, ys, xe, ye);
    SafeCopyCanvas(GetBitmapCanvas(TestBMP), GetBitmapCanvas(ClientBMP),
    xs, ys, xe, ye, 0, 0, width, height);
    For I := 0 To High(Points) Do
      FastSetPixel(ClientBMP, Points[I].X - xs, Points[I].Y - ys, 255);

    If SaveBMPs Then
      If BmpName <> '' Then
        SaveBitmap(ClientBMP, AppPath + FoundBMPPath + BmpName + '.bmp');
    SafeDrawBitmap(ClientBMP, GetDebugCanvas, 0, 0);
    DisplayDebugImgWindow(Width, Height);

    FreeBitmap(ClientBMP);
  End
  Except
    FreeBitmap(ClientBMP);
  End;
  Result := True;
End;

procedure dwriteln(s: string);

begin
  if debug then
    writeln(s);
end;
Function FindGas1: Boolean;

Var
   CTS, I, L, T, w, h: Integer;
   P, P2: TPointArray;
   C, C2: TIntegerArray;
   X, Y, Z: Extended;

Begin
  Result := False;

  ColorToleranceSpeed(2);
  SetColorSpeed2Modifiers(0.18, 0.38);
  GetClientDimensions(W, H);
  FindColorsTolerance(P, 9215649, 0, 0, W, H, 12);

  writeln('Total points found before filtering: ' + IntToStr(Length(P)));

  C := GetColors(P);
  C2 := C;
  ClearSameIntegers(C);

  dwriteln('Total different colors found: ' + IntToStr(Length(C)));

  SetLength(C, 0);
  SetLength(C, Length(C2));
  SetLength(P2, Length(P));
  L := High(C2);

  For I := 0 To L Do
  Begin
    ColorToXYZ(C2[I], X, Y, Z);
    If (X >= 20.21) And (X <= 45.20) And (Y >= 21.73) And (Y <= 47.88)
                    And (Z >= 18.15) And (Z <= 46.40) Then
    Begin
      C[T] := C2[I];
      P2[T] := P[I];
      T := T + 1;
    End;
  End;
  SetLength(C, T);

  writeln('Total colors found, after filtering: ' + IntToStr(Length(C)));

  ClearSameIntegers(C);

  dwriteln('Total different colors found, after filtering: ' + IntToStr(Length(C)));
  
  //DebugTPA(P2, 'GasFound1 ' + IntToStr(Count));
  drawtpacanvas(p2, 255, getdebugcanvas);
  ColorToleranceSpeed(CTS);
  SetColorSpeed2Modifiers(0.2, 0.2);
End;

function FindGas2: boolean;

Var
   x1, y1, x2, y2, I, time, c, w, he: Integer;
   R, G, B: Integer;
   H, S, L: ExtEnded;
   X, Y, Z: ExtEnded;
   Gas, Gas2: TPointArray;
   Colors, C2: TIntegerArray;

begin
  Time := GetSystemTime;
  Result := False;
  ColorToleranceSpeed(2);
  SetColorSpeed2ModIfiers(0.2, 0.2);
  getclientdimensions(w, he);
  FindColorsTolerance(Gas, 8886170, 0, 0, w, he, 20);
  
  writeln('Total colors found before filtering: ' + IntToStr(Length(Gas)));

  Colors := GetColors(Gas);
  C2 := Colors;
  ClearSameIntegers(C2);

  If Length(C2) < 40 Then  // amount of diff colors.
    Exit;
  For I := 0 To High(Gas) Do
  Begin
    ColorToRGB(Colors[I], R, G, B);
    If Abs(R - G) <= 10.0 Then
    Begin
      ColorToHSL(Colors[I], H, S, L);
      If (H > 11.5) And (H < 16.0) And (S < 12.0) Then
      Begin
        ColorToXYZ(Colors[I], X, Y, Z);
        If (Abs(X - Y) < 5.0) And (Abs(X - Z) < 5.0) And (Abs(Y - Z) < 5.0) Then
        Begin
          SetLength(Gas2, Length(Gas2) + 1);
          Gas2[High(Gas2)] := Gas[I];
        End;
      End;
    End;
  End;
  dwriteln('w_time: ' + IntToStr(GetSystemTime - Time));
  writeln('Total colors found after filtering: ' + IntToStr(Length(Gas2)));
  
  DebugTPA(Gas2, 'GasFound2 ' + IntToStr(Count));
  Result := (Length(Gas2) > 20); // The only number you might want to tweak.
End;

Function FindGas3: Boolean;

Var
   CTS, I, Le, T, w, he, Time: Integer;
   P, P2: TPointArray;
   C, C2: TIntegerArray;
   R, G, B: Integer;
   H, S, L: Extended;
   X, Y, Z: Extended;

Begin
  Result := False;
  
  Time := GetSystemTime;
  CTS := GetColorToleranceSpeed;
  ColorToleranceSpeed(2);
  GetClientDimensions(W, He);

  SetColorSpeed2Modifiers(0.16, 0.46);

  //FindColorsTolerance(P, 9083807, 0, 0, W, He, 15);

  FindColorsTolerance(P, 9083807, 3, 3, 515, 336, 15);
  //writeln('Time1: ' + IntToStr(GetSystemTime - Time));

  ColorToleranceSpeed(CTS);
  SetColorSpeed2Modifiers(0.2, 0.2);
  
  C := GetColors(P);
  C2 := C;
  ClearSameIntegers(C);

  writeln('Total points found before filtering: ' + IntToStr(Length(P)));
  writeln('Total different colors found: ' + IntToStr(Length(C)));
  
  //If Length(C) < 70 Then
  If Length(C) < 60 Then
  Begin
    WriteLn('Not enough color diversity: ' + IntToStr(Length(C)));
    Exit;
  End;

  //writeln('Time2: ' + IntToStr(GetSystemTime - Time));

  SetLength(C, 0);
  SetLength(C, Length(C2));
  SetLength(P2, Length(P));
  Le := High(C2);

  For I := 0 To Le Do
  Begin
    ColorToRGB(C2[I], R, G, B);
    //If ((R - G) <= 6) And (G - B > 7) Then
    If ((R - G) <= 10) And (G - B > 7) Then
    Begin
      ColorToHSL(C2[I], H, S, L);
      If (H > 11.5) And (H < 16.0) And (S < 16.0) And (S > 2.0) And (L > 42.0) And (L < 71.0) Then
      Begin
        ColorToXYZ(C2[I], X, Y, Z);
        If (X >= 18.0) And (X <= 45.0) And (Y >= 20.0)
                       And (Y <= 48.0) And (Z >= 15.0)
                       And (Z <= 47.0) And (Abs(X - Y) < 3.0)
                       And (Abs(X - Z) < 5.0) And (Abs(Y - Z) < 6.5)
                        Then
        Begin
          C[T] := C2[I];
          P2[T] := P[I];
          T := T + 1;
        End;
      End;
    End;
  End;
  SetLength(C, T);

  writeln('Total colors found, after filtering: ' + IntToStr(Length(P2)));

  ClearSameIntegers(C);

  writeln('Total different colors found, after filtering: ' + IntToStr(Length(C)));

  //If Length(C) < 30 Then
  If Length(C) < 25 Then
  Begin
    WriteLn('Not enough color diversity after filtering the colors: ' + IntToStr(Length(C)));
    //Exit;
  End;
  Result := True;
  WriteLn('Gas Gave TRUE');
  writeln('Time3: ' + IntToStr(GetSystemTime - Time));
  DebugTPA(P2, 'GasFound3 ' + IntToStr(Count));
  //DrawTPACanvas(P2, 255, GetDebugCanvas);
End;

Var
   I, w, h: Integer;
   S: String;
   SA: TStringArray;

begin
  ClearDebug;
  S := AppPath + 'GasPics\';
  dwriteln(S);
  SA := GetFiles(S, 'bmp');
  WriteLn(IntToStr(Length(SA)));
  For I := 0 To High(SA) Do
  Begin
    writeln(IntToStr(I) + '-File: ' + SA[I]);
    
    TestBMP := LoadBitmap(AppPath + 'GasPics\' + SA[I]);
    SetTargetBitmap(TestBMP);
    getbitmapsize(TestBMP, w, h);
    DisplayDebugImgWindow(w, h);
    SafeDrawBitmap(TestBMP, GetDebugCanvas, 0, 0);

    Wait(500);
    FindGas3;
    FreeBitmap(TestBMP);
    Inc(Count);
    Wait(500);
    ClearDebug;
  End;
end.

Works for pretty much all new rocks, haven't seen it fail on 180 bitmaps. :D

I need a picture of gas in rimmington…

I'll get you that gas pic in Rimmy in an hour or so… Grr :garfield:

Edit: Sorry, probably tomorrow, can't get the dang random for once :p

i tested the gas finder on like 5 bitmaps of my character mining (with gas onscreen), and it worked :)

really fast, like 47-90 milliseconds for each check.

I made it because my older one (w_GasCheck) didn't seem to work in Rimmington too well.

Remember when I said my powerminer fails in gaschecking?
Ofcourse I was mining in Rimmington…

Check works in rimmington, my 'stop-mining' click in my script doesn't:

Passed Color Diversity: 68
Total different colors found: 68
Passed Color Diversity after filtering the colors: 42
Total colors found, after filtering: 42
Gas Gave TRUE
Time taken: 0
Passed Color Diversity: 53
Total different colors found: 53
Passed Color Diversity after filtering the colors: 37
Total colors found, after filtering: 37
Gas Gave TRUE
Time taken: 15
******** FOUND FIGHTING RANDOM ********
Successfully executed

;)

GasCheck, or some new GasCheck of yours?

From first post:

  WriteLn('Passed Color Diversity after filtering the colors: ' + IntToStr(Length(C)));
  Writeln('Total colors found, after filtering: ' + IntToStr(Length(P2)));
 
 
  Result := True;
  WriteLn('Gas Gave TRUE');
  writeln('Time taken: ' + IntToStr(GetSystemTime - Time));

From my post above:

Passed Color Diversity after filtering the colors: 42
Total colors found, after filtering: 42
Gas Gave TRUE
Time taken: 0

You tell me. ;)

i think it isn't ;)

Good Job Wizzup? you should make a good ent finder!(leech0s)

[Wizzup] im not sure but could you unblock me or add me i want ask you a few things, because you don't react on my pm(not always though)[/wizzup]

Do you sit there and mine till you get gas or use a bitmap?

The problem with using bitmaps to test is that we already found the gas using the old checker, which is how it took the screenshot, so testing on them is only proving that the new gas checker can do what the old one can :p the real test is if it works on the gas the old checker missed