SRL Archive - Test corner

I made couple very very similar functions, and then one a little more unique.

type

  TColorArrayInfo = record
  Amount, Color: Integer;
  
End;
  
  



////////////////////////////////////////////////////////////////////////////////

Function FindColorDegreesTol(Var Cx, Cy: Integer; Col, MidX, MidY, SD, ED, Dist, Tol: Integer): Boolean;

Var

  x1, y1, x2, y2, x, y, I, L: Integer;
  pts: TPointArray;
  z: Extended;
  
Begin

  x1 := MidX - Dist;
  y1 := MidY - Dist;
  x2 := MidX + Dist;
  y2 := MidY + Dist;
  
  FindColorsSpiralTolerance(MidX, MidY, pts, Col, x1, y1, x2, y2, Tol);
  
  L := High(pts);
  
  For I := 0 To L Do
  Begin
  
    If Not InCircle(pts[i].x, pts[i].y, MidX, MidY, Dist) Then Continue;

    x := pts[i].x - MidX;
    y := pts[i].y - MidY;
    z := Round(ArcTan(y / x));
    
    If (z > SD) And (z < ED) Then
    Begin

      cx := x;
      cy := y;
      Result := True;
      Exit;
      
    End;
    
  End;
End;


Function FindColorDegreesTolEx(Var Cx, Cy, Angle, tDist: Integer; Col, MidX, MidY, SD, ED, Dist, Tol: Integer): Boolean;

Var

  x1, y1, x2, y2, x, y, I, L, z: Integer;
  pts: TPointArray;

Begin

  x1 := MidX - Dist;
  y1 := MidY - Dist;
  x2 := MidX + Dist;
  y2 := MidY + Dist;

  FindColorsSpiralTolerance(MidX, MidY, pts, Col, x1, y1, x2, y2, Tol);

  L := High(pts);

  For I := 0 To L Do
  Begin

    If Not InCircle(pts[i].x, pts[i].y, MidX, MidY, Dist) Then Continue;

    x := pts[i].x - MidX;
    y := pts[i].y - MidY;
    z := Round(ArcTan(y / x));

    If (z > SD) And (z < ED) Then
    Begin

      cx := x;
      cy := y;
      Angle := z;
      tDist := Distance(MidX, MidY, cx, cy);
      Result := True;
      Exit;

    End;

  End;
End;

Function FindColorDegreesTol2(Var Cx, Cy: Integer; Col, MidX, MidY, SD, ED, MinDist, MaxDist, Tol: Integer): Boolean;

Var

  x1, y1, x2, y2, x, y, I, L: Integer;
  pts: TPointArray;
  z: Extended;

Begin

  x1 := MidX - MaxDist;
  y1 := MidY - MaxDist;
  x2 := MidX + MaxDist;
  y2 := MidY + MaxDist;

  FindColorsSpiralTolerance(MidX, MidY, pts, Col, x1, y1, x2, y2, Tol);

  L := High(pts);

  For I := 0 To L Do
  Begin

    If Not InCircle(pts[i].x, pts[i].y, MidX, MidY, MaxDist) Then
      Continue;
    
    If Not InRange(Distance(pts[i].x, pts[i].y, MidX, MidY), MinDist, MaxDist) Then
      Continue;

    x := pts[i].x - MidX;
    y := pts[i].y - MidY;
    z := Round(ArcTan(y / x));

    If (z > SD) And (z < ED) Then
    Begin

      cx := x;
      cy := y;
      Result := True;
      Exit;

    End;

  End;
End;

////////////////////////////////////////////////////////////////////////////////


Function ScanCircle(SD, ED, MidX, MidY, Radius: Integer): Array of TColorArrayInfo;

Var
  X, Y, I, C, S: Integer;
  Exists: Boolean;
  
Begin

  For I := SD To ED Do
  Begin
  
    Exists := False;
  
    X := MidX + Round(Radius * Cos(i - 90));
    Y := MidY + Round(Radius * Sin(i - 90));
    
    For C := 0 To High(Result) Do
    Begin

      If Result[i].Color = GetColor(X, Y) Then
      Begin
      
        Exists := True;
        S := C;
        Break;
        
      End;
    End;
    
    If Not Exists Then
    Begin

      SetArrayLength(Result, GetArrayLength(Result) + 1);
      Result[High(Result)].Color := GetColor(X, Y);
      Result[High(Result)].Amount := 1;
        
    End Else
    Begin

      Result[s].Amount := Result[s].Amount + 1;

    End;
  End;
End;

You should all be able to see from the code what it does, though if you have questions just ask…

[spam] Looking I scripts I don't write always makes my head hurt [/spam]

Mind saying what each variable of the function does? I can understand some like MidX, MidY, but I don't really know what SD and ED do… my guess is start distance & end distance… Not to mention, you've got some funky standards but I'm not complaining, you're cranking out procedures all the time.

This is mine:

program New;

const
  MMX1 = 570;
  MMY1 = 5;
  MMX2 = 715;
  MMY2 = 160;
  MMCX = 643;
  MMCY = 84;

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

Var
   Width, Height, ClientBMP, I, L: 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;
    L := High(Points);
    For I := 0 To L 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);
    SafeDrawBitmap(ClientBMP, GetDebugCanvas, 0, 0);

    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;

Procedure SwapE(Var a, b: Extended);

Var
   c: extended;

Begin
  c := a;
  a := b;
  b := c;
End;

Procedure FilterColorsPie(Var Points: TPointArray; StartD, EndD, MinR, MaxR: Extended; Mx, my: Integer);

Var
   G: TPointArray;
   I, L, T: Integer;
   D, i180Pi: Extended;
   cWise: Boolean;

Begin
  SetLength(G, Length(Points));
  L := 0;
  i180Pi := 180.0 / Pi;
  cWise := StartD > EndD;
  While StartD > 360.0 Do
    StartD := StartD - 360.0;
  While EndD > 360.0 Do
    EndD := EndD - 360.0;
  While StartD < 0.0 Do
    StartD := StartD + 360.0
  While EndD  < 0.0 Do
    EndD := EndD + 360.0
  If StartD > EndD Then
    SwapE(StartD, EndD);
  T := High(Points);
  For I := 0 To T Do
  Begin
    D := Sqrt( Sqr(Points[I].X - Mx) + Sqr(Points[I].Y - My) );
    If( D <= MinR) Or (D >= MaxR) Then
      Continue;
    D := ArcTan2(Points[I].Y - My, Points[I].X - Mx) * i180Pi + 90
    If D < 0.0 Then
      D := D + 360.0;
    If (Not ((StartD <= D) And (EndD >= D))) xOr CWise Then
      Continue;
    G[L] := Points[I];
    L := L + 1;
  End;
  SetLength(G, L);
  Points := G;
End;

Procedure FindColorsPie(Var Points: TPointArray; Color, Tol: Integer; StartD, EndD, MinR, MaxR: Extended; x1, y1, x2, y2, Mx, My: Integer);

Begin
  FindColorsTolerance(Points, Color, x1, y1, x2, y2, Tol);
//  FilterPointsPie(Points, StartD, EndD, MinR, MaxR, Mx, My);
  FilterColorsPie(Points, StartD, EndD, MinR, MaxR, Mx, My);
End;

Var
   P: TPointArray;
   Time: Integer;

begin
  Time := GetSystemTime;
  FindColorsPie(P, 16777215, 500, 450, 310, 0, 60, MMX1, MMY1, MMX2, MMY2, MMCX, MMCY);
  WriteLn(IntToStr(GetSystemTime - Time)+' milliseconds.');
  DebugTPA(P, '');
end.

Speedtests maybe?
EDIT: for all colors found on entire MM and sorting, it is <16ms in plugin.

Dude you gotta play fair! xD

Lol, I could give you rep for just for the sake of making so beatiful code :p

D := Sqrt( Sqr(Points[i].X - Mx) + Sqr(Points[i].Y - My) );

maybe to

D := Sqrt( Sqr(Points[i].X - Mx + Points[i].Y - My) );

?

w00t, I fastened your function by propably like 0.001 ms? xD

From: n3ss3s
Dude you gotta play fair! xD

Lol, I could give you rep for just for the sake of making so beatiful code :p


w00t, I fastened your function by propably like 0.001 ms? xD

Remove the Sqr calls.. It wil speed up with 0.1 MS!

You mean replace them with X * X?

From: n3ss3s
You mean replace them with X * X?

Yes

From: n3ss3s
Dude you gotta play fair! xD

Lol, I could give you rep for just for the sake of making so beatiful code :p

D := Sqrt( Sqr(Points[i].X - Mx) + Sqr(Points[i].Y - My) );

maybe to

D := Sqrt( Sqr(Points[i].X - Mx + Points[i].Y - My) );

?

w00t, I fastened your function by propably like 0.001 ms? xD

Nope, that won't work. You don't get the distance that way.
Sqrt(Sqr(6) + Sqr(8)) does not equal Sqrt(Sqr(6+8)) either.

If you remove the Sqr's, you'll need an extra - for each Sqr you remove.

O.o it actually doesn't =/

Umm what 'distance'?

D := Sqrt( Sqr(Points.X - Mx) + Sqr(Points.Y - My) );

Oh, now I understand what you mean, took a closer look :)

D := Sqrt(Sqr(A) + Sqr(B))

Hey, wait a second! Why not use Hypot()? Or is it slower?

EDIT: Distance() isn't leet enough? :p

Distance is around 20% faster then the sqrt method.