SRL Archive - Test corner

finding the essence mine locations!
Since alot of people have been PM'ing me about my essence miner…
I thought I should show that I am working on the Essence Miner again…

I think it works 100%. And it is very fast (just remove the wait(1000) and the DebugMM ;) )
I think in total it takes less than 16ms.
Does anyone feel like testing it?

program New;

{.include srl/srl.scar}

Type
   EssLoc = Record
     Name: String;
     Info: Array Of Array Of Integer;
     L: Integer;
   End;
   EssLocArray = Array Of EssLoc;
   
Var
   EssInfo: EssLocArray;

Procedure DebugMM(TPA: TPointArray);

Var
   I, l: Integer;
   C: TCanvas;
   
Begin
  displaydebugimgwindow(0, 0);
  displaydebugimgwindow(mmx2-mmx1, mmy2-mmy1);
  C := GetDebugCanvas;
  CopyCanvas(GetClientCanvas, C, MMX1, MMY1, MMX2, MMY2, 0, 0, MMX2 - MMX1, MMY2 - MMy1);
  l := high(tpa);
  for i := 0 to l do
    C.pixels[tpa[i].x - mmx1, tpa[i].y - mmy1] := 255;
    
  displaydebugimgwindow(mmx2-mmx1, mmy2-mmy1);
End;

Function GetCurrentTPA: TPointArray;

Var
   cts: Integer;

Begin
  cts := GetColorToleranceSpeed;
  ColorToleranceSpeed(1);
  FindColorsTolerance(Result, clWhite, MMX1, MMy1, MMX2, MMY2, 421);
  ColorToleranceSpeed(cts);
End;

Function ScanMM(Const TPA: TPointArray; SD, ED, MinR, MaxR: Integer): Integer;

Begin
  FilterPointsPie(TPA, SD, ED, MinR, MaxR, MMCX, MMCY);
  Result := Length(TPA);
  DebugMM(TPA);
End;

Function RetInt(a: Array Of Integer): Array Of Integer;

Begin
  Result := a;
End;

Procedure LoadLocations;

Begin
  SetLength(EssInfo, 6);
  With EssInfo[0] Do
  Begin
    Name := 'North West';
    Info := [RetInt([80, 160, 60, 70, 400]), RetInt([270, 30, 30, 50, 900])];
    L := 1;
  End;
  With EssInfo[1] Do
  Begin
    Name := 'Middle North';
    Info := [RetInt([0, 80, 60, 70, 320]), RetInt([80, 180, 55, 70, 320]),
    RetInt([170, 260, 60, 70, 210]), RetInt([270, 340, 30, 75, 1000])];
    L := 3;
  End;
  With EssInfo[2] Do
  Begin
    Name := 'Middle South';
    Info := [RetInt([170, 270, 30, 70, 1700]), RetInt([330, 120, 25, 50, 1700])];
    L := 1;
  End;
  With EssInfo[3] Do
  Begin
    Name := 'North East';
    Info := [RetInt([350, 130, 30, 60, 2000]), RetInt([180, 270, 60, 74, 700])];
    L := 1;
  End;
  With EssInfo[4] Do
  Begin
    Name := 'South West';
    Info := [RetInt([290, 70, 0, 74, 3000])];
    L := 0;
  End;
  With EssInfo[5] Do
  Begin
    Name := 'South East';
    Info := [RetInt([285, 0, 0, 74, 1600]), RetInt([0, 270, 0, 50, 2800])];
    L := 1;
  End;

End;

Function AdeptDegree(CompassAngle: Extended; Degree: Integer): Integer;

Begin
  Result := Round(Abs(CompassAngle + Degree));
  While Result > 360 Do
    Result := Result - 360;
End;

Function GetPos: String;

Var
   TPA: TPointArray;
   I, C, E, r: Integer;
   CA: Extended;
   
Begin
  r:=getsystemtime;
  TPA := GetCurrentTPA;
  CA := rs_GetCompassAngleDegrees;
  WriteLn(FloatToStr(CA));
  writeln(inttostr(getsystemtime - r));
  For I := Low(EssInfo) To High(EssInfo) Do
  Begin
    With EssInfo[I] Do
    Begin
      WriteLn(EssInfo[I].Name + ': Info Length ' + IntToStr(Length(Info)));
      For C := 0 To L Do
      Begin
        Wait(1000);
        E := ScanMM(TPA, AdeptDegree(CA, Info[C][0]), AdeptDegree(CA, Info[C][1]),
        Info[C][2], Info[C][3]);
        
        writeln(inttostr(c) + '...' +  inttostr(E) + ' vs ' + inttostr(info[C][4]));

        If E < Info[C][4] Then
        Begin
          WriteLn('Breaking... ' + IntToStr(C) + ' E('+inttostr(E) + ') was smaller than info[C][4](' + inttostr(info[C][4]) + ')');
          Break;
        End;
      End;
      If C = L + 1 Then
      Begin
        Result := Name;
        WriteLn('Location: ' + Result);
        Exit;
      End;
    End;
  End;
End;

Var
   I, t: Integer;
   TPA: TPointArray;
begin
  setupsrl;
  cleardebug;
  LoadLocations;
  GetPos;
end.

BTW: Since (3.14?) With … Do also works with your own records!

Looks very Fast(i mean wizzup? xD)

I went and ran it, looks very good, and sexy like you said ;)

I fixed the names, there were two South West's and there was no South East. ;)

Holy…amazing!!

What's the point of this though:

Function RetInt(a: Array Of Integer): Array Of Integer;
 
Begin
  Result := a;
End;

From: Santa_Clause
Holy…amazing!!

What's the point of this though:

Function RetInt(a: Array Of Integer): Array Of Integer;
 
Begin
  Result := a;
End;

That way I can declare a two-dimensional array in one line.
eg:

a := [6,7,5,7];

Works, but

a := [ [6,5], [8,7] ]

Does not.

However,

 a := [ retint([6,5]), retint([8,7]) ] 

Does work. It's the same principe as declaring TPointArrays in one Line, using Point(x,y:integer):TPoint;

tpa := [point(7,5), point(3,4), point(9,9)];

:)

Ahh, that clears up alot. Thankyou.

From: Wizzup?
That way I can declare a two-dimensional array in one line.
eg:

a := [6,7,5,7];

Works, but

a := [ [6,5], [8,7] ]

Does not.

However,

 a := [ retint([6,5]), retint([8,7]) ] 

Does work. It's the same principe as declaring TPointArrays in one Line, using Point(x,y:integer):TPoint;

tpa := [point(7,5), point(3,4), point(9,9)];

:)

Or

program Hoi;
var
  A : Array Of  TIntegerArray;
begin
 a := [ TIntegerArray([6,5]), TIntegerArray([8,7]) ]
end.

FindColorsTolerance(Result, clWhite, MMX1, MMy1, MMX2, MMY2, 421);

the heck?!

From: JuKKa
FindColorsTolerance(Result, clWhite, MMX1, MMy1, MMX2, MMY2, 421);

the heck?!

All colors except black

From: mastaraymond
All colors except black

whoa, i never knew this.. how did u guys find this out? freddy has something he has not told us (non devs)

From: JuKKa
whoa, i never knew this.. how did u guys find this out? freddy has something he has not told us (non devs)

Uh? The max tol for CTS1 is found out easily, you just do a for loop until black and white match eachother, then you do that minus one, so black and white don't match.

From: JuKKa
whoa, i never knew this.. how did u guys find this out? freddy has something he has not told us (non devs)

For R1, G1, and B1 = 0 and R2, G2 and B2 = 255) then the maximum tolerance is 422.

RGBTol := Sqrt(Sqr(R1-R2) + Sqr(G1-G2) + Sqr(B1-B2));

You could have also brute-forced the max RGB tolerance:

program New;
var tol:integer;
begin
for tol := 0 to 1000 do if similarcolors(clwhite, clblack, tol) then break;
writeln(inttostr(tol));
end.

;)

Yet another thing that might help is reading the post benland made about RGB a long time ago:

http://www.villavu.com/forum/showthread.php?t=2754?p=37590#post37590

@Link Wizzup posted above.
Canadarules explained all well, Benland just came and tryed to get peoples confused. So they can't understand nothing, and peoples wouldn't get smarter.

:p

Anyways I thought about it before, could *went on testing, and saw i failed*

Anyways, if my membership stops, I'll try to understand it, and make it to tutorial.(2 more days p2p)
Edit, I think i'll use my printer first time for something usefull, i'll print whole thread, so if i have to go sleep, i can say to mom im reading school stuff:D

I'm confused about the Tolerance thing, why do you square all the differences in R/G/B add them then take the squareroot? I know this is how the program works but why? wouldn't it just be smarter to add them together, or does this allow for small differences in all three but not one large difference?


But I'm exited for the update to essance miner (I've used over 100k of essences to get my rc level to 67, and i need some more, and buying them is so lame)

program New;
begin
  writeln(floattostr(sqrt(sqr(0 - 2) + sqr(0 - 5) + sqr(0 - 1))));
  writeln(floattostr(sqrt(sqr(iabs(0 - 2) + iabs(0 - 5) + iabs(0 - 1)))));
end.

There's quite a large difference between squaring each difference and squaring the total differences ;)

BTW Wizzup?, I'm too lazy to figure out exactly how that works; would you mind explaining?

From: king vash
I'm confused about the Tolerance thing, why do you square all the differences in R/G/B add them then take the squareroot? I know this is how the program works but why? wouldn't it just be smarter to add them together, or does this allow for small differences in all three but not one large difference?


But I'm exited for the update to essance miner (I've used over 100k of essences to get my rc level to 67, and i need some more, and buying them is so lame)

Well, the whole Square (Root) formula is just the SCAR formula for CTS 1.
I guess you could compare it to the distance of two points in a 3d space.

If you have these two points:

Point1(65,90,4);
Point2(89, 3, 80);

Then the distance between these two points is

Sqrt( Sqr(X1 - X2) + Sqr(Y1 - Y2) + Sqr(Z1 - Z2) );
Sqrt( Sqr(65 - 89) + Sqr(90 - 3) + Sqr(4 - 80) ); 

The same applies to RGB.

Now, the max 'tolerance' for RGB is when one color is at RGB(0, 0, 0) and the other color is at RGB(255, 255, 255).

The max tolerance would be:

RGBTol := Sqrt(Sqr(R1-R2) + Sqr(G1-G2) + Sqr(B1-B2));
Sqrt( Sqr(0 - 255) + Sqr(0 - 255) + Sqr(0 - 255) ); 

Which results in 422.
Luckily enough, the two colors mentioned above RGB(0, 0, 0) and RGB(255, 255, 255) are Black (clBlack) and White (clWhite). ;)

So cts 1 finds ALL colors with tolerance 422.

Now, I wanted to leave the color 'black' out. Simply decreasing the tol to 421 already works, because

Sqrt( Sqr(0 - 255) + Sqr(0 - 255) + Sqr(0 - 255) ) > 421.

And every other color except black which' sum of RGB is higher than 1 will be included, eg:

RGB(2,0,0); // still found with tol 421
RGB(0,1,1); // still found with tol 421
RGB(0, 0, 1);  // NOT found with tol 421

Accidentally, RGB(0, 0, 1) = 65536, the other 'black' color of the essence mine. So this one was also excluded from the Colors find with a tolerance of 421. I could have lowered the tol even more it this color was not included in a tolerance of 421, since the entire essence mine is quite 'white'. ;) White = High RGB values.