Enhancement/Question - Finding Road Colors

[CamHart]

I couldn't figure out how to work the road color thing in SRL (unless i did figure it out and it doesn't work like i liked), so I made this thing. You might need to edit the numbers 4000000 and 8000000 which is what i've found all road colors being with the exception of barbarian village. Even if it finds a bad color it doesn't jack up. Still in a beta form, never been tested limitless.

Edit: If you're looking for enhancement use tarajunky's posted below. Dominates mine...


program New;
{.Include SRL\SRL.Scar}
{.Include SRL\SRL\Extended\xColor.Scar}

var
RememberRoadColors: Boolean;
ABadColor: Array of Integer;

Function InArray(One:Integer; Arrays:Array of Integer):Boolean;
var c:integer;
Begin
For c:=0 to (GetArrayLength(Arrays) - 1) Do
If(One = Arrays[c])Then
Result:= true;
End;

//Start of Read/Write Arrays to Files
Function ArrayToString(Arrays: Array of Integer):String;
var
c, arraylength:integer;
thestring:string;
Begin
Arraylength:= GetArrayLength(Arrays) - 1;
for c:=0 to Arraylength do
thestring:= (thestring + IntToStr(Arrays[c])+',');
Result:= thestring;
End;

Function StringToArray(Source, Split:String):Array of Integer;
Var
Arrays: Array of Integer;
ArrayLength, c, v:integer;
Char: String;
Begin
Source:= Trim(Source);
Split:= Trim(Split);
ArrayLength := 1;
SetArrayLength(Arrays, ArrayLength);
//Writeln('Source: '+Source);
//Writeln('Length: '+ IntToStr(Length(Source)));
For c := 0 to (Length(Source) - 1) do
Begin
//Writeln('C: '+ IntToStr(c));
Char:= Trim(StrGet(Source, c + 1));
//Writeln('Char: '+Char);
//if((Char = Split) or (Char = (' ' + Split))) or (Char = (Split + ' ')))Then
if(Char = Split)Then
Begin
Arrays[ArrayLength - 1]:= V;
V:= 0;
ArrayLength:= ArrayLength + 1;
SetArrayLength(Arrays, ArrayLength + 1);
End else
Begin
V:= StrToInt(Trim(IntToStr(V) + Char));
End;
End;
SetArrayLength(Arrays, ArrayLength - 1);// There's an Extra Slot added so this removes it
Result:= Arrays;
End;

Function ReadArrayFromFile(Path, Split:String):Array of Integer;
Var
Filenum: Integer;
Thestuff: String;
Arrays: Array of Integer;
Begin
Filenum := Openfile(Path, True);//not sure about true/false thing
If(Filenum >= 0)Then
Begin
If(ReadFileString(Filenum, Thestuff, FileSize(Filenum)))Then
Begin
Arrays:= StringToArray(Thestuff, Split);
Writeln('Array Read: '+ArrayToString(Arrays));
Result:= Arrays;
End else
Begin
Writeln('Cannot read array');
Result:= Arrays;
End;
CloseFile(Filenum);
End;
End;

Function WriteArrayToFile(Path: String; Arrays: Array of Integer):Boolean;
Var
Filenum: Integer;
Begin
Filenum:=RewriteFile(Path, True);//not sure about true/false thing
if(Filenum >= 0)Then
Begin
Result:= WriteFileString(Filenum, ArrayToString(ABadColor));
Writeln('Array Wrote: ' + ArrayToString(ABadColor));
CloseFile(filenum);
End;
End;

//End of Read/Write Arrays to File

//Read/Write Array Color Sets

Function ReadBadColors:Array of Integer;
Begin
Result:= ReadArrayFromFile(AppPath+'BadOldRoadColors.txt', ',');
End;

Function WriteBadColors(Addition: Integer):Boolean;//Addition is a number you want to add to the array
Var
OldStuff: Array of Integer;
ALength: integer;
Begin
OldStuff:= ReadBadColors;
ALength:= GetArrayLength(OldStuff);
SetArrayLength(OldStuff, ALength + 1);
OldStuff[ALength]:= Addition;//edit? //GetArrayLenght counts doesn't count 0
Result:= WriteArrayToFile(AppPath+'BadOldRoadColors.txt', OldStuff);
End;

Function ReadGoodColors:Array of Integer;
Begin
Result:= ReadArrayFromFile(AppPath+'GoodOldRoadColors.txt', ',');
End;

Function WriteGoodColors(Addition: Integer):Boolean;//Addition is a number you want to add to the array
Var
OldStuff: Array of Integer;
ALength: Integer;
Begin
OldStuff:= ReadGoodColors;
ALength:= GetArrayLength(OldStuff);
SetArrayLength(OldStuff, ALength + 1);
OldStuff[ALength]:= Addition; //edit
Result:= WriteArrayToFile(AppPath+'GoodOldRoadColors.txt', OldStuff);
End;

Function CheckGoodOldRoadColors:integer;
var
Filenum, c:Integer;
OldColors:Array of Integer;
Begin
Filenum:= OpenFile(AppPath+'GoodOldRoadColors.txt', true);
If(Filenum >= 0)Then
Begin
OldColors:= ReadArrayFromFile(AppPath+'GoodOldRoadColors.txt', ',');
For c:=0 to (GetArrayLength(OldColors) - 1) Do
Begin
If(CountColor(OldColors[c], MMX1, MMY1, MMX2, MMY2) > 0)Then
Begin
Writeln('Old Color Found: '+IntToStr(OldColors[c]));
Result:=OldColors[c];
End;
End;
CloseFile(Filenum);
End;
End;
//End of read/write array color sets

//Start of FindRoadColor Functions
Function CreateCircleBitmap(X1, Y1, X2, Y2: Integer; DebugWindow:Boolean):Integer;//Leeched from masquerader
var
Debug,Temp: TCanvas;
H, W, ScreenBmp, TempBmp: Integer;
begin
W := Max(X1, X2) - Min(X1, X2);
H := Max(Y1, Y2) - Min(Y1, Y2);
TempBmp := BitmapFromString(W, H, '');
Temp := GetBitmapCanvas(TempBmp);
ScreenBmp := BitmapFromString(W, H, '');

FastDrawClear(TempBmp, -1);
CopyClientToBitmap(ScreenBmp, X1, Y1, X2, Y2);

CopyCanvas(GetBitmapCanvas(TempBmp), Temp, 0, 0, W, H, 0, 0, W, H);
Temp.Ellipse(0, 0, W, H);
CopyCanvas(Temp, GetBitmapCanvas(TempBmp), 0, 0, W, H, 0, 0, W, H);
SetTransparentColor(TempBmp, 16777215);
FastDrawTransparent(0, 0, TempBmp, ScreenBmp);
If(DebugWindow)Then
displaydebugimgwindow(w,h);
debug:=getdebugcanvas;
copycanvas(getbitmapcanvas(screenbmp),debug,0,0,w, h,0,0,w,h);
SaveBitmap(ScreenBmp, AppPath+'CircleBitmap.bmp');
Result:= LoadBitmap(AppPath+'CircleBitmap.bmp');
FreeBitmap(TempBmp);
FreeBitmap(ScreenBmp);
end;

Function RoadMaskBitMap:integer;
var
a, q, z, ClientHandle, stuff:integer;
Begin
ClientHandle:= GetClientWindowHandle;
FindWindow('Debug Image');
a := BitmapFromString(4, 3, 'z78DA7373A30E0000CEFE13B1');
If(FindBitMapMaskTolerance(a, q, z, 20, 29, 124, 106, 1, 1))Then
//If(FindBitmapInCircleTol(a, q, z, 73, 67, 67, 0))Then //Doesnt work?
Begin
stuff:= GetColor(q, z);
If(stuff >= 0)Then
Writeln('Coord: ('+IntToStr(q)+', '+IntToStr(z)+') - '+IntToStr(stuff));
Result:=stuff;
End;
FreeBitMap(a);
SetClientWindowHandle(ClientHandle);
End;

Function FindTheRoadColor(CheckOldColors: Boolean):Integer;
Var TheColor, c, OldColor,
a, CameraMoves,
MiniMap, MaxRoadColor, MinRoadColor:integer;
DebugCanvas: TCanvas;
TheKey: Boolean;
begin
If(CheckOldColors)Then
Begin
OldColor:= CheckGoodOldRoadColors;
If((OldColor > 0) and (Not(InArray(OldColor, ABadColor))))Then
Result:= OldColor
End;
MaxRoadColor:= 8000000;//Change the road color limitations here
MinRoadColor:= 4000000;// Default are 4000000 and 8000000
DebugCanvas:= GetDebugCanvas;
CameraMoves:= 0;
a := BitmapFromString(4, 3, 'z78DA7373A30E0000CEFE13B1');
MiniMap:= BitmapFromString(165, 161, '');
TheColor:=0;
If(Random(10) > Random(5))Then
Begin
TheKey:= true;
End
Else
Begin
TheKey:= false;
End;
MiniMap:= CreateCircleBitmap(575, 9, 720, 143, true);
Repeat
Writeln('Searching for road...');
c:= 0;
If((TheColor < MinRoadColor) or (TheColor > MaxRoadColor))Then
Begin
CameraMoves:= CameraMoves + 1;
ActivateClient;
If(TheKey)Then
Begin
KeyDown(VK_Right);
End
Else
Begin
KeyDown(VK_Left);
End;
Wait(400 + Random(1000));
If(TheKey)Then
Begin
KeyUp(VK_Right);
End
Else
Begin
KeyUp(VK_Left);
End;
End;
Repeat
TheColor:= RoadMaskBitMap;
MiniMap:= RotateBitmap(MiniMap, (5*(Pi/180)));
SafeCopyCanvas(GetBitmapCanvas(MiniMap), DebugCanvas, 0, 0, 165, 161, 0, 0, 165, 161);//165,161
c:= c + 1;
Until((c > 72) or ((TheColor > MinRoadColor) and (TheColor < MaxRoadColor) and (Not (InArray(TheColor, ABadColor))) ) );
Until(((TheColor > MinRoadColor) and (TheColor < MaxRoadColor) and (Not (InArray(TheColor, ABadColor)))) or (CameraMoves > 500));
FreeBitMap(a);
FreeBitMap(MiniMap);
If(RememberRoadColors)Then
WriteGoodColors(TheColor);
Result:= TheColor;
end;
//End of RoadColors

begin
SetupSRL;
RememberRoadColors:= true;//True to have it save road colors to files
FindTheRoadColor(true);
end.

[I]Copied this from a script, and made sure

One bug I've found....

[Runtime Error] : Exception: Access violation at address 7C918FEA in module 'ntdll.dll'. Write of address 00000098 in line 263 in script
Not sure how to fix this. Happens rarely, might only happen when i haven't set the client. Any help is appreciated.

Also has bugs with the writing/reading of arrays in it, but that can be edited out (I'll fix it once i find time).

Also, it doesn't have a time limit to when its searching really... Well it does but if you want to edit that feel free.

[tarajunky]

I have a flawless roadcolor function ready.

Good job, but that thing is a BEAST. :) I think mine is about 45 lines total and you don't need any files or arrays or anything.

[CamHart]

You don't necessarly NEED files or arrays, but I choose to do what i can to make things work the best. You could easily do it without files and arrays.

[Boreas]

Don't worry, I use arrays and repeats too much.

[tarajunky]

You don't necessarly NEED files or arrays, but I choose to do what i can to make things work the best. You could easily do it without files and arrays.

You did a good job. Fakawi did a similar thing himself, where you could save all the roadcolors to an array, and then when the roadcolor changed you could do a simple check against the array of known good colors.

This makes sense given the fact that when the roadcolors change, they don't change by much, so you have a pretty good chance of getting a match.

Anyway, I'll go ahead and post my function here and you can test it out.


function FindRoadColor:integer; // By Tarajunky
var red,green,blue:integer;
var TestColor,a,b,GenericRoadColor:integer;
begin
GenericRoadColor:=6842479;
Flag;
a:=MMX1;
b:=MMY1;
repeat
b:=b+1;
repeat;
a:=a+1;
if FindColorTolerance(x,y,GenericRoadColor,a,b,MMX2,M MY2,80) then
begin
a:=x;
b:=y;
TestColor:=GetColor(x,y);
red:=(TestColor mod 256);
green:=((TestColor/256) mod 256);
blue:=((TestColor/256) / 256);
if Red-Green>=5 then if Red-Green<=10 then
if Red-Blue>=5 then if Red-Blue<=10 then
begin
if GetColor(a+5,b+5)=TestColor then
if GetColor(a+3,b+3)=TestColor then
if GetColor(a,b+5)=TestColor then
if GetColor(a+5,b)=TestColor then
if GetColor(a,b+3)=TestColor then
if GetColor(a+3,b)=TestColor then
if GetColor(a+5,b+3)=TestColor then
if GetColor(a+3,b+5)=TestColor then
begin
result:=TestColor;
RoadColor:=TestColor;
Writeln('RoadColor = '+IntToStr(TestColor));
exit;
end;
end;
end else a:=MMX2;
until a>=MMX2;
a:=MMX1;
until b>=MMY2;
Writeln('Could not find Road Color!');
result:=0;
end;

[CamHart]

You just dominated all over me lol... Any idea on how long till the next SRL update?

[CamHart]

It worked great, but then it had problems with some colors. One of them was 5131604. Would it work if you made the generic color an array then get some more "generic" road colors for it to look from?

[tarajunky]

The original search has a tolerance of 80, so it will pick up pretty much ANYTHING that is anywhere close to a road color. If it misses one, it is far more likely that it missed the exclusion criteria. Thanks for posting that color, it will help me refine the exclusion criteria.

This does not work for Falador road colors, by the way. I wrote a different function to find those. They look grey, but they are really completely different. Can you tell me where you were testing when you found that color? Thanks!

[CamHart]

Fally :D lol. I suggest you check out barbarian village too (if you havn't already), those road colors are messy.

Edit: I never went to barb village when testing yours, i just know it doesn't work with my method.

[tarajunky]

Yeah, I have a FindRoadColor (most everywhere), FindFallyRoadColor (Falador obviously) and FindDirtRoadColor (barb village and between Lumby and Draynor). That takes care of most of the roads in f2p.

Also FindLadderColor, FindRockColor, FindWaterColor, and FindBridgeColor. They are all based on the RGB search strategy. These colors all remain the same once you pick them, even after logging out and back in, so they are very useful for navigation.

I think they will all be added to the next SRL release.

[IronTeapot]

I think they will all be added to the next SRL release.

YAY! <- That pretty much sums it up. Wouldn't mind learning how the RGB searching actually works though, but I can accept just a function that does it for me :)

[Boreas]

Excerpt from understanding scar color code in SRL FAQ, become a member to read the rest (I'm sure you can, you've already got the bear).

So I've been working on this color stuff today and here's what I came up with.

I found as canada said, you can convert a color into hex and get a 6 character hex string. The first 2 characters are the hex value of the blue component, last 2 red, middle green. So I made a script to demonstrate this. The script converted SCAR color to hex, split into 3, and converted back to decimal, and did the reverse. I went into paint, made a custom color, took note of the red, green, and blue values, and used the scar color picker to get the color. Armed with this infomation I was able to convert from RGB to SCAR and check if it was correct. Then I noticed a problem, when any of the RGB values were low, the hex string was less than 6 characters. This is how hex values work:

0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
0 1 2 3 4 5 6 7 8 9 A B C D E F

As you can see the first few are only 1 character, theres really a 0 before each one (0F etc) which would up hold the 6 character length, but these 0's get lost in the process. So the hex values were less than 6 chars, which meant that finding the red section gave an error, because strget was looking for the 6th, and even if there was no error, there others were inaccurate because you dont know if 5FFFB is 5 FF FB(yellow) or 5F FF B(green).

So I found a new way to convert that doesn't use hex, in fact it does almost the same thing that hex does but skips over the hex part. Here are the functions I wrote:



type rgbcolor =record
red,green,blue:integer;
end;

function color2rgb(color:integer):rgbcolor;
begin
result.red:=(color mod 256);
result.green:=((color/256) mod 256);
result.blue:=((color/256) / 256);
end;

function rgb2color(rgb:rgbcolor):integer;
begin
result:=(((rgb.blue*256)+rgb.green)*256)+rgb.red
end;



As you can see it works by using 256 because the rbg values are 0-255.





program New;
type rgbcolor =record
red,green,blue:integer;
end; var
color:integer;
color2:rgbcolor;
//---------Setup-------- const
color=5200980;



function color2rgb(color:integer):rgbcolor;
begin
result.red:=(color mod 256);
result.green:=((color/256) mod 256);
result.blue:=((color/256) / 256);
end;

function rgb2color(rgb:rgbcolor):integer;
begin
result:=(((rgb.blue*256)+rgb.green)*256)+rgb.red
end;


begin
writeln('----------------');
writeln(inttostr(color));
writeln(' ');

color2:=color2rgb(color)
writeln(inttostr(color2.red));
writeln(inttostr(color2.green));
writeln(inttostr(color2.blue));
end.


I wrote this to try and find the pattern (or at least range) in the color changes of a certain rock after switching worlds. You put in a color, say 5200980 and it outputs
----------------
5200980

84
92
79

I did this a few times to get a range for the grey rocks RGB values. I then put these ranges into the following script that uses Yakman's color displaying code. Notice how the colors are similiar when you change the RGB values in this script, but range when you change the SCAR value, like in Yakman's.



program New;
type rgbcolor =record
red,green,blue:integer;
end; var
color,x,y,z,{x1,y1,z1,x2,y2,z2,}square,buffer:inte ger;
{waitforme:boolean; }
color1:rgbcolor;
//---------SETUP------------ const //should I wait for you to press ctrl //after showing the number of colors //before displaying them?
waitformetotal=true;
//Should I wait for you to press ctrl //before displaying each color?
waitforme=false;
x1=63;{red min} x2=97;{red max}
y1=75;{green min} y2=92;{green max}
z1=61;{blue min} z2=83;{blue max}







function rgb2color(rgb:rgbcolor):integer;
begin
result:=(((rgb.blue*256)+rgb.green)*256)+rgb.red
end;

begin

{waitforme:=false;

x1:=63; //red start
y1:=75; //green start
z1:=61; //blue start
x2:=97; //red end
y2:=81; //green end
z2:=83; //blue end
}
x:=x1-1;
y:=y1-1;
z:=z1-1;
writeln('there will be '+inttostr((x2-x1)*(y2-y1)*(z2-z1))+' colors');
if waitformetotal then begin repeat
wait(10);
until isfunctionkeydown(1);
end;
cleardebug;
square:=bitmapfromstring(50,50,'');

displaydebugimgwindow(100,100);
buffer:=bitmapfromstring(100,100,'') ;
repeat
x:=x+1;
y:=y1;
repeat
y:=y+1;
z:=z1;
repeat
z:=z+1;
//writeln(inttostr(x)+' '+inttostr(y)+' '+inttostr(z));
color1.red:=x;
color1.green:=y;
color1.blue:=z;
color:=rgb2color(color1);
writeln(inttostr(color)+' '+inttostr(x)+' '+inttostr(y)+' '+inttostr(z));
fastdrawclear(square,color)
fastdrawclear(buffer,0)
fastdrawtransparent(25,25,square,buffer)
safedrawbitmap(buffer,getdebugcanvas,0,0)
status('Color = '+inttostr(color)) if waitforme then begin repeat
wait(10);
until isfunctionkeydown(1);
end; until z=z2;
until y=y2;
until x=x2;
end.



So, if you want to find similar colors, you need to change the RGB values.

So far, my experiments with finding a pattern in the color of a certain rock (to see which rock go to srl member scripts>fighters> WT Fakawi's Guard fighter> look at his zoomed in screen shot) show that there is no pattern in the SCAR color nor the RGB colors (that I can see with my small sample size) but there is a range. It took the lowest and highest RGB values, found the RGB ranges, multiplied those 3, and found that the range of greys so far is over 12 thousand, and that's from only 4 colors. The range of SCAR colors for these 4 is about 1.2mil, and includes all sorts of colors.

I started this because I wanted to make a procedure to auto color the color of the rock, and shape recognition didn't work because it changed and there were similiar shapes, neither did find a color that appeared a certain number (or within a range) of times. So I thought what I knew the range of colors it could be, and have the script go through them til it found 1. However, that's looking less likely with 12 thousand creeping up. It's interesting to investigate anyway though.

Congrats for reading this far.

[CamHart]

Boreas - I'll have to read through that tomorrow... its kinda late and i needa hit the hay. Looks interesting though. Looks like it explains RGB coloring n crap very well...

tarajunky - How long is inbetween each SRL release normally? Until all the known bugs are fixed or what? After a given period of time? Once Devs feel like typing the new release up?