PDA

View Full Version : FindDirtRoadColor (Without near water ftw!)



Cazax
04-13-2008, 09:04 PM
Function FFindDirtRoadColor : Integer;
var
H,S,L,X,Y,Z : Extended;
R,G,B,P,A,TestColor,xx,xy : Integer;
TPA : TPointArray;
begin
if Not(LoggedIn) then Exit;
xx:= MMCX;
xy := MMCY;
FindColorsSpiralTolerance(xx, xy, TPA, 1322555, MMX1, MMY1, MMX2, MMY2, 60)
P := High(TPA);
for A := 0 to P do
begin
if RS_OnMinimap(TPA[A].X, TPA[A].Y) then
begin
TestColor := GetColor(TPA[A].X, TPA[A].Y);
if SimilarColors(TestColor, 1322555, 50) then
begin
ColorToRGB(TestColor, R, G, B);
ColorToHSL(TestColor, H, S, L);
ColorToXYZ(TestColor, X, Y, Z);
if InRange(R - G, -6, 29) then
if InRange(R - B, 25, 55) then
if InRange(G - B, 12, 40) then
if InRange(Round(S) - Round(H), 28, 48) then
if InRange(Round(L) - Round(H), -4, 14) then
if InRange(Round(S) - Round(L), 23, 47) then
if InRange(Round(X) - Round(Y), -8, 9) then
if InRange(Round(Y) - Round(Z), -7, 9) then
if GetColor(TPA[A].X + 2, TPA[A].Y + 2) = TestColor then
if GetColor(TPA[A].X + 1, TPA[A].Y + 1) = TestColor then
begin
Writeln('DirtRoadColor = '+Inttostr(TestColor));
Result := TestColor;
Exit;
end;
end;
end;
end;
Writeln('Couldnt find DirtRoadColor!');
Result := 0;
end;

Will find the nearest dirt road color, i made this becouse SRL's one searchs it only if there is water near it.

and the question is... do you want a tut on this(RGB, XYZ, HSL, how to make an autocolor function like this one)?

Harry
04-13-2008, 09:05 PM
Make a tut please :)

Looks very nice :D How long it take you?

Cazax
04-13-2008, 09:06 PM
Make a tut please :)

Looks very nice :D How long it take you?

Hmm 10 - 20 mins, vote if you want a tut ;)

tarajunky
04-14-2008, 05:40 AM
Looks great. If this works well, we should replace the SRL one. It was never very good. :P

ShowerThoughts
04-14-2008, 05:44 AM
I Am A Leecher i us ACA2 :D

munk
04-14-2008, 08:49 AM
confused...idk if thisll work..


ColorToRGB(1322555, R, G, B);

shouldnt you be testing TestColor and not your pre-picked color:p

ColorToRGB(1322555, R, G, B);
if InRange(R - G, 1, 21) then
if InRange(R - B, 33, 46) then
if InRange(G - B, 20, 35) then
ColorToHSL(1322555, H, S, L);
if InRange(Round(S) - Round(H), 33, 43) then
if InRange(Round(L) - Round(H), 1, 9) then
if InRange(Round(S) - Round(L), 30, 39) then
ColorToXYZ(1322555, X, Y, Z);
if InRange(Round(X) - Round(Y), -4, 4) then
if InRange(Round(Y) - Round(Z), -2, 4) then
Writeln('DirtRoadColor = '+Inttostr(TestColor));
Result := TestColor;
Exit;

that's all stacked wrong, it wont run some of the conversions, so just do it all at the beginning or something

ColorToRGB(1322555, R, G, B);
ColorToHSL(1322555, H, S, L);
ColorToXYZ(1322555, X, Y, Z);
if InRange(R - G, 1, 21) then
if InRange(R - B, 33, 46) then
if InRange(G - B, 20, 35) then
if InRange(Round(S) - Round(H), 33, 43) then
if InRange(Round(L) - Round(H), 1, 9) then
if InRange(Round(S) - Round(L), 30, 39) then
if InRange(Round(X) - Round(Y), -4, 4) then
if InRange(Round(Y) - Round(Z), -2, 4) then
Writeln('DirtRoadColor = '+Inttostr(TestColor));
Result := TestColor;
Exit;

:)

oh yeah, and i believe SRL's findDirtRoadColor searches for water because next to the water there is sometimes a color similar to the dirt road color.

but yeah, you can make a tut if you want, but all it really should say is "go download ACA2" :D

ZephyrsFury
04-14-2008, 08:59 AM
And don't you need to set some more restrictions on the colours? Like in FindRoadColor, it checks whether its actually a road by checking surrounding pixels for the same colour.

tarajunky
04-14-2008, 02:52 PM
LOL, Munk is right. There are a few fundamental flaws in your code.

You need to test the TestColor, not your generic color. And you need to stack it like he said. (Except you need to add a begin..end after all the thens. Munks version still won't work.) ;)

Fix it up, and then people can test it out.

munk
04-14-2008, 06:51 PM
LOL, Munk is right. There are a few fundamental flaws in your code.

You need to test the TestColor, not your generic color. And you need to stack it like he said. (Except you need to add a begin..end after all the thens. Munks version still won't work.) ;)

Fix it up, and then people can test it out.


haha well I didnt go over it with a fine tooth comb! and also idk about you guys but



Today, 04:49 AM


Why was I up at 5am?! I dont even remember!

Cazax
04-14-2008, 09:42 PM
munk and Zephyr are right, here is the final autocolorer:

Function FindDirtRoadColor : Integer;
var
H,S,L,X,Y,Z : Extended;
R,G,B,P,A,TestColor,xx,xy : Integer;
TPA : TPointArray;
begin
if Not(LoggedIn) then Exit;
xx:= MMCX;
xy := MMCY;
FindColorsSpiralTolerance(xx, xy, TPA, 1322555, MMX1, MMY1, MMX2, MMY2, 60)
P := High(TPA);
for A := 0 to P do
begin
if RS_OnMinimap(TPA[A].X, TPA[A].Y) then
begin
TestColor := GetColor(TPA[A].X, TPA[A].Y);
if SimilarColors(TestColor, 1322555, 50) then
begin
ColorToRGB(TestColor, R, G, B);
ColorToHSL(TestColor, H, S, L);
ColorToXYZ(TestColor, X, Y, Z);
if InRange(R - G, -6, 29) then
if InRange(R - B, 25, 55) then
if InRange(G - B, 12, 40) then
if InRange(Round(S) - Round(H), 28, 48) then
if InRange(Round(L) - Round(H), -4, 14) then
if InRange(Round(S) - Round(L), 23, 47) then
if InRange(Round(X) - Round(Y), -8, 9) then
if InRange(Round(Y) - Round(Z), -7, 9) then
if GetColor(TPA[A].X + 2, TPA[A].Y + 2) = TestColor then
if GetColor(TPA[A].X + 1, TPA[A].Y + 1) = TestColor then
begin
Writeln('DirtRoadColor = '+Inttostr(TestColor));
Result := TestColor;
Exit;
end;
end;
end;
end;
Writeln('Couldnt find DirtRoadColor!');
Result := 0;
end;
Is amazing! almost working ;)

@munk: i didnt use ACA2, i made this manually :)
@Zephyrs: added that
@tarajunky: hope this replace SRL's one :rolleyes:
@hermpie: yes you are a leecher :p

Floor66
04-16-2008, 05:09 PM
tut pl0cks =p
nice work there!

tarajunky
04-18-2008, 09:53 PM
So did anyone test this out?

Cazax
04-18-2008, 09:55 PM
So did anyone test this out?

I tested it and works. you can test it at the road between lumbridge - Draynor Village

ZephyrsFury
04-20-2008, 10:59 AM
Hmmm I just tested it and it failed to find the colour.

The actually colour was 1785947. I've done a bit of analysis and from my list of colours that I got of the dirt colour it doesn't seem to match your restrictions:


Max R-B: 71 Min R-B: 38 Diff: 33
Max R-G: 34 Min R-G: 11 Diff: 23
Max G-B: 60 Min G-B: 21 Diff: 39



Here's my autocolour proc if you want to have a look:


function FindTheDirtRoad(var x, y: Integer; x1, y1, x2, y2: Integer): Boolean;
var
GC, a, TestColor, CTS: Integer;
P: TPointArray;
XX, YY, ZZ, H, S, L: Extended;
begin
GC := 1982805;
CTS := GetColorToleranceSpeed;
ColorToleranceSpeed(2);
FindColorsSpiralTolerance(MMCX, MMCY, P, GC, x1, y1, x2, y2, 40);

if (Length(P) <> 0) then
begin
for a := 0 to High(P) do
begin
TestColor := GetColor(P[a].x, P[a].y);
ColorToXYZ(TestColor, XX, YY, ZZ);
ColorToHSL(TestColor, H, S, L);
if (XX <= 15) then
if (YY <= 16) then
if (ZZ <= 7) then
if (CountColor(TestColor, P[a].x - 5, P[a].y - 2, P[a].x + 5, P[a].y + 3) = 66) then
begin
x := P[a].x;
y := P[a].y;
Result := True;
Break;
end;
end;
end;

ColorToleranceSpeed(CTS);
end;


This procedure is specific to the Draynor-Lummy Road so it might not work for other road.