SRL Archive - Senior Scripts and Snippets

function w_GasCheck(gx, gy: integer): boolean;


Wizzup?

2007-10-20 09:56:03

You might say, oh no, another gas finder!
Today I got really mad because I not manage to 100% follow the rock, I call a GasCheck, and both SKy's and piv's didn't find it, and it keeps finding false gasses too. In my 'madness' I wrote my own gas finder.

-This one differs from all the other ones though.
-It's fast, 0-16ms for a box of 70 x 70. 110ms for the entire MS.
-It gives afaik no false positives.
-It doesn't need to wait to check for changes in pixels, it is purely based on colors.

There are 2 functions. w_GasCheck is for new rocks, w2_GasCheck for old rocks. :)

The code I post here is meant for testing on pictures, or rs if you like.
Please TEST!

It searches for gas around your mouse, don't forget to drag the cross hair.

A note: This one is for New Rocks only.
I guess when you just use colors you will have two different ones, one for new rock and one for old ones. The Old Rock gas is alot darker.

program New;

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);
For I := 0 To High(Points) Do
FastSetPixel(ClientBMP, Points[I].X - xs, Points[I].Y - ys, 255);

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

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

function w_GasCheck(gx, gy: integer): boolean;

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

begin
Try
x1 := gx - 35;
If x1 < 0 Then
x1 := 0;
y1 := gy - 35;
If y1 < 0 Then
y1 := 0;
x2 := gx + 35;
If x2 > 515 Then
x2 := 515;
y2 := gy + 35;
If y2 > 336 Then
y2 := 336;
Time := GetSystemTime;
Result := False;
c := GetColorToleranceSpeed;
ColorToleranceSpeed(2);
SetColorSpeed2ModIfiers(0.2, 0.2);
FindColorsTolerance(Gas, 8886170, x1, y1, x2, y2, 20);
ColorToleranceSpeed(c);
If length(Gas) < 10 Then
Exit;
Colors := GetColors(Gas);
C2 := Colors;
ClearSameIntegers(C2);
writeln('w_Colors Length: ' + inttostr(length(colors)));
writeln('w_C2 Length: ' + inttostr(length(C2)));
If Length(C2) < 40 Then
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;
WriteLn('w_time: ' + IntToStr(GetSystemTime - Time));
WriteLn('w_gas2 length: ' + IntToStr(Length(Gas2)));
Result := (Length(Gas2) > 30); // The only number you might want to tweak.
debugtpa(Gas2, '');
If Result Then
WriteLn('w_GasCheck gave true');
Except WriteLn('w_gasCheck ERROR: No window selected'); End;
End;

function w_GasCheckMS: boolean;

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

begin
Try
x1 := 3;
y1 := 3;
x2 := 515;
y2 := 336;
writeln('Searching in: ('+inttostr(x1) + ', '+inttostr(y1) + ')');
writeln('Searching in: ('+inttostr(x2) + ', '+inttostr(y2) + ')');
Time := GetSystemTime;
Result := False;
c := GetColorToleranceSpeed;
ColorToleranceSpeed(2);
SetColorSpeed2Modifiers(0.2, 0.2);
FindColorsTolerance(Gas, 8886170, x1, y1, x2, y2, 20);
ColorToleranceSpeed(c);
WriteLn('gas1 length: ' + IntToStr(Length(Gas)));
If length(Gas) < 10 Then
Exit;
Colors := GetColors(Gas);
For I := 0 To High(Gas) Do
Begin
ColorToRGB(Colors[I], R, G, B);
If Abs(R - G) <= 15.0 Then
Begin
ColorToHSL(Colors[I], H, S, L);
If (H > 8.0) 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) Then
Begin
SetLength(Gas2, Length(Gas2) + 1);
Gas2[High(Gas2)] := Gas[I];
End;
End;
End;
End;
WriteLn('time: ' + IntToStr(GetSystemTime - Time));
WriteLn('gas2 length: ' + IntToStr(Length(Gas2)));
result := (Length(Gas2) > 30); // The only number you might want to tweak.
debugtpa(gas2, '');
Except WriteLn('w_gasCheck ERROR: No window selected'); end;
end;

function w2_GasCheck(gx, gy: integer): boolean;

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

begin
Try
x1 := gx - 35;
If x1 < 0 Then
x1 := 0;
y1 := gy - 35;
If y1 < 0 Then
y1 := 0;
x2 := gx + 35;
If x2 > 515 Then
x2 := 515;
y2 := gy + 35;
If y2 > 336 Then
y2 := 336;
Time := GetSystemTime;
Result := False;
c := GetColorToleranceSpeed;
ColorToleranceSpeed(2);
SetColorSpeed2ModIfiers(0.2, 0.2);
FindColorsTolerance(Gas, 6126985, x1, y1, x2, y2, 20);
ColorToleranceSpeed(c);
If length(Gas) < 10 Then
Exit;
Colors := GetColors(Gas);
C2 := Colors;
ClearSameIntegers(C2);
writeln('w2_Colors Length: ' + inttostr(length(colors)));
writeln('w2_C2 Length: ' + inttostr(length(C2)));
If Length(C2) < 40 Then
Exit;
For I := 0 To High(Gas) Do
Begin
ColorToRGB(Colors[I], R, G, B);
If Abs((R - 10) - G) <= 5.0 Then
Begin
ColorToHSL(Colors[I], H, S, L);
If (H > 10.0) And (H < 18.0) And (S > 12.0) And (S < 22.0) Then
Begin
ColorToXYZ(Colors[I], X, Y, Z);
If (Abs(X - Z) < 3.0) Then
Begin
SetLength(Gas2, Length(Gas2) + 1);
Gas2[High(Gas2)] := Gas[I];
End;
End
End;
End;
WriteLn('w2_time: ' + IntToStr(GetSystemTime - Time));
WriteLn('w2_gas2 length: ' + IntToStr(Length(Gas2)));
Result := (Length(Gas2) > 30); // The only number you might want to tweak.
debugtpa(Gas2, '');
If Result Then
WriteLn('w2_GasCheck gave true');
Except WriteLn('w2_gasCheck ERROR: No window selected'); End;
End;

function w2_GasCheckMS: boolean;

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

begin
Try
x1 := 3;
y1 := 3;
x2 := 515;
y2 := 336;
writeln('Searching in: ('+inttostr(x1) + ', '+inttostr(y1) + ')');
writeln('Searching in: ('+inttostr(x2) + ', '+inttostr(y2) + ')');
Time := GetSystemTime;
Result := False;
c := GetColorToleranceSpeed;
ColorToleranceSpeed(2);
SetColorSpeed2Modifiers(0.2, 0.2);
FindColorsTolerance(Gas, 6126985, x1, y1, x2, y2, 20);
ColorToleranceSpeed(c);
WriteLn('gas1 length: ' + IntToStr(Length(Gas)));
If length(Gas) < 10 Then
Exit;
Colors := GetColors(Gas);
For I := 0 To High(Gas) Do
Begin
ColorToRGB(Colors[I], R, G, B);
If Abs((R - 10) - G) <= 5.0 Then
Begin
ColorToHSL(Colors[I], H, S, L);
If (H > 10.0) And (H < 18.0) And (S > 12.0) And (S < 22.0) Then
Begin
ColorToXYZ(Colors[I], X, Y, Z);
If (Abs(X - Z) < 3.0) Then
Begin
SetLength(Gas2, Length(Gas2) + 1);
Gas2[High(Gas2)] := Gas[I];
End;
End;
End;
End;
WriteLn('time: ' + IntToStr(GetSystemTime - Time));
WriteLn('gas2 length: ' + IntToStr(Length(Gas2)));
result := (Length(Gas2) > 30); // The only number you might want to tweak.
debugtpa(gas, '');
Except WriteLn('w2_gasCheck ERROR: No window selected'); end;
end;

Function w_FindGas(gx, gy: Integer): Boolean;

Begin
Result := w_GasCheck(gx, gy);
If Not Result Then
Result := w2_GasCheck(gx, gy);
End;

Var
x, y: integer;

begin
{ if w2_gasCheckMS then
writeln('GAS'); }
repeat
wait(1000);
getmousepos(x, y);

if w_FindGas(x, y) then
writeln('found gas')
else
writeln('no gas');
until false;
end.

There.

Note and thanks to The Claw: His pictures, I commented names out, hope thats alright. :)


Feedback, please.
You could run it on the pictures above, or on your own? :)

EDIT: You might still want to do w_GasCheck(x, y-20) in your script, since gas is always a bit above your rock. :)

nielsie95

2007-10-20 11:09:39

Tried it on 65 bitmaps..
It works on all the new rocks and filters the false-positives out nicely.
But with old rocks however.. it didn't find one..

And there was one (new) rock where you had to have the mouse at the left edge of the rock to find it. Anywhere close to the center it didn't find it.

Avarage time: 25ms

Nice work! :)

tarajunky

2007-10-20 11:15:23

I am of the opinion that on gas checking, more is better. And the more different strategies, the better.

I'd rather call 3 different gaschecks once per second than one kind 3 times per second.

I'll test this out on my archive of gas pics and report back.

Wizzup?

2007-10-20 11:51:25

From: nielsie95
But with old rocks however.. it didn't find one..


Really? Wow.
Do you got some pictures of Old Rocks for me?

From: tarajunky
I am of the opinion that on gas checking, more is better. And the more different strategies, the better.

I'd rather call 3 different gaschecks once per second than one kind 3 times per second.

I'll test this out on my archive of gas pics and report back.


Okay, great.

Special Ed

2007-10-20 14:10:30

[SIDENOTE] You know we should really start a screen shot archive of randoms things like Gas, Fires, FishingSpots, Trees, Ents, ect. That way people will have lots of different things to test their procedures on and the would all be different, like in RS [/SIDENOTE]

Well I haven't gotten gas yet (Hehehe… I'm funny) but I'll test it when I get the chance and I'll probably post the screen shot here for data gathering purposes.

The Claw

2007-10-20 23:40:21

Great, worked 100% on about 40-50 tests :) I'll put it into my script now and test it out.

-It gives afaik no false positives, except for the crafting guild light wall, on the inside, but it shouldn't bother you.


Thats exactly what I want it for lolz

Wizzup?

2007-10-21 05:01:26

From: The Claw
Thats exactly what I want it for lolz


I mean the light wall, the inside wall, the one with 1 global color, if you face south you should not have any problems. :)

Wizzup?

2007-10-22 08:29:40

Bump, added one for old rocks, combining them in 1 color is not possible, you could however do something like:


Function w_FindGas(gx, gy: Integer): Boolean;

Begin
Result := w_GasCheck(gx, gy);
If Not Result Then
Result := w2_GasCheck(gx, gy);
End;

I added the w_FindGas to the SCAR code.
I am not too sure about false positives in the w2_GasCheck, didn't test it very thorougly(sp), should work fine though. :)

The Claw

2007-10-22 08:31:02

Or a boolean for if its a new rock or not :) w_GasCheck(var x, y: Integer; NewRock: Boolean)

(MMM, nielsie? ;))

Dark_Sniper

2007-11-11 20:53:46

bump…



I personally like this gas finder works great for me wizzy.

When can I use this for public code… I want to put it in one of my scripts :p with credit to you of course.

The Claw

2007-11-11 20:57:56

Just a note - this has never failed me. :)

Dark_Sniper

2007-11-11 21:06:36

Exactly my point.


I want to use this in my script… it would make it so much better :p

Wizzup?

2007-11-12 02:27:44

From: Dark_Sniper
bump…



I personally like this gas finder works great for me wizzy.

When can I use this for public code… I want to put it in one of my scripts :p with credit to you of course.


You may use it in public. :)

mastaraymond

2007-11-12 11:14:24

From: The Claw
Just a note - this has never failed me. :)

Did fail for me, 1 out of 999, but it failed ^.^

Dark_Sniper

2007-11-12 18:33:45

WOOT ty wizzy :p