visualize

const
  DIST = 10;

var
  bmp: TSCARBitmap;
  colors: TIntArray;

procedure DrawBoxOutline(var bmp: TSCARBitmap; bx: TBox; color: Integer);
var
  x, y: Integer;
begin
  for x := bx.X1 to bx.X2 do
    if ((x > -1) and (bx.Y1 > -1) and (x < bmp.Width) and (bx.Y1 < bmp.Height)) then
      bmp.Pixels[x, bx.Y1] := color;
  for y := bx.Y1 to bx.Y2 do
    if ((bx.X2 > -1) and (y > -1) and (bx.X2 < bmp.Width) and (y < bmp.Height)) then
      bmp.Pixels[bx.X2, y] := color;
  for x := bx.X2 downto bx.X1 do
    if ((x > -1) and (bx.Y2 > -1) and (x < bmp.Width) and (bx.Y2 < bmp.Height)) then
      bmp.Pixels[x, bx.Y2] := color;
  for y := bx.Y2 downto bx.Y1 do
    if ((bx.X1 > -1) and (y > -1) and (bx.X1 < bmp.Width) and (y < bmp.Height)) then
      bmp.Pixels[bx.X1, y] := color;
end;

{==============================================================================]
  Explanation: Returns the line of points fromPt => toPt.
[==============================================================================}
function GetTPALine(fromPt, toPt: TPoint): TPointArray;
var
  i, h: integer;
begin
  if ((fromPt.X <> toPt.X) or (fromPt.Y <> toPt.Y)) then
  begin
    h := Max(Round(Abs(fromPt.X - toPt.X)), Round(Abs(fromPt.Y - toPt.Y)));
    SetLength(Result, (h + 1));
    for i := 0 to h do
      Result[i] := Point((fromPt.X + Round((toPt.X - fromPt.X) * (Extended(i) / h))), (fromPt.Y + Round((toPt.Y - fromPt.Y) * (Extended(i) / h))));
  end else
    Result := [fromPt];
end;

{==============================================================================]
 Splits TPA with minDist, maxDist.
[==============================================================================}
function TPADistributeEx(TPA: TPointArray; minDist, maxDist: Extended): T2DPointArray;
var
  h, i, l, c, s, x, y, o, r, d, m: Integer;
  p: T2DIntArray;
  q: TPointArray;
  a, b: TBox;
  e: Extended;
  z: TPoint;
  tmp: TSCARBitmap;
begin
  SetLength(Result, 0);
  h := High(TPA);
  if ((minDist <= maxDist) and (h > -1)) then
    if (h > 0) then // We make sure array is bigger than 1 item...
    begin
      b := TPABounds(TPA);
      SetLength(p, ((b.X2 - b.X1) + 1)); // We create 2D Integer table, for storing point counts (if array contains duplicates). This part is the 1D.
      for i := 0 to (b.X2 - b.X1) do // Creating 2D side with loop.
      begin
        SetLength(p[i], ((b.Y2 - b.Y1) + 1));
        for c := 0 to (b.Y2 - b.Y1) do
          p[i][c] := 0; // Setting 0 as default value for all array items.
      end;
      if (maxDist < 0.0) then // Making sure maxDist isn't lower than 0
        maxDist := 0.0; // ..when it isn't, we set it to 0.
      d := Ceil(maxDist); // Storing distance by maxDist to d variable, which will be used for scanning the point groups to result.
      m := Max(((b.X2 - b.X1) + 1), ((b.Y2 - b.Y1) + 1)); // We get the maximum radius that we should be using.
      if (d > m) then // We make sure d isn't greater than maximum radius could be in the first place.. To reduce checking a bit, when user hits with long distances that aren't even needed.
        d := m;
      for i := 0 to h do // We loop through whole array increasing the Integer table values with points, this we will get the point counts.
        Inc(p[(TPA[i].X - b.X1)][(TPA[i].Y - b.Y1)]);
      for i := 0 to h do
        if (p[(TPA[i].X - b.X1)][(TPA[i].Y - b.Y1)] > 0) then // Time to start capturing the groups
        begin
          c := Length(Result);
          SetLength(Result, (c + 1)); // Creating first/next group of points for result.
          SetLength(Result[c], p[(TPA[i].X - b.X1)][(TPA[i].Y - b.Y1)]); // We set the length for all points at this coordinate, by point count.
          for o := 0 to (p[(TPA[i].X - b.X1)][(TPA[i].Y - b.Y1)] - 1) do // Loop for planting all the points from current TPA index to this new group.
            Result[c][o] := TPA[i];
          bmp.Pixels[TPA[i].X, TPA[i].Y] := colors[c];
          DebugBitmap(bmp);
          SetLength(q, 1); // Creating new queue
          q[0] := TPA[i]; // ..we set the current TPA item as the object for it...
          r := (r + p[(TPA[i].X - b.X1)][(TPA[i].Y - b.Y1)]); // R variable is for keeping track of points that we have "met" so far, this part increases it by the total points
          if (r > h) then // We can simply exit, there's no more to go through, because there was so many duplicates in the array, probably.
            Exit;
          p[(TPA[i].X - b.X1)][(TPA[i].Y - b.Y1)] := 0; // Setting the point count to 0, that way we don't hit the same place twice, which would fuck up things pretty bad!
          s := 1; // Simply needed for the while..do loop to work.
          while (s > 0) do // While there's still queue items to check through...
          begin
            s := High(q); // Highest queue
            z := q[s]; // Storing the point to Z variable for checking.
            a.X1 := (z.X - d); // Creating the area from point Z (by QUEUE) with radius, for scanning the points.
            a.Y1 := (z.Y - d);
            a.X2 := (z.X + d);
            a.Y2 := (z.Y + d);
            SetLength(q, s); // We decrease queue by 1, pretty much.
            if (a.X1 < b.X1) then // START: Lets constrain TBox a (scan area) to the boundaries of b, which is the variable for our TPA bounds.
              a.X1 := b.X1
            else
              if (a.X1 > b.X2) then
                a.X1 := b.X2;
            if (a.Y1 < b.Y1) then
              a.Y1 := b.Y1
            else
              if (a.Y1 > b.Y2) then
                a.Y1 := b.Y2;
            if (a.X2 < b.X1) then
              a.X2 := b.X1
            else
              if (a.X2 > b.X2) then
                a.X2 := b.X2;
            if (a.Y2 < b.Y1) then
              a.Y2 := b.Y1
            else
              if (a.Y2 > b.Y2) then
                a.Y2 := b.Y2; // END: DONE! This way, there's no looping outside the bounds, speeds up things.
            tmp := bmp.Clone;
            DrawBoxOutline(tmp, a, clRed);
            DebugBitmap(tmp);
            tmp.Free;
            for x := a.X1 to a.X2 do // Lets loop through area for new points to group.
              for y := a.Y1 to a.Y2 do
                if (p[(x - b.X1)][(y - b.Y1)] > 0) then // When we hit Integer table slot which contains more than 0 points, we possibly hitted a match... Time to capture the point(s)!
                begin
                  e := Sqrt(Sqr(z.X - x) + Sqr(z.Y - y)); // Calculating the distance between Z (center point) and this new point from table.
                  if ((e >= minDist) and (e <= maxDist)) then // ..and if it's within minDist and maxDist, we take it in, else we will leave it, because its not valid.
                  begin
                    l := Length(Result[c]);
                    SetLength(Result[c], (l + p[(x - b.X1)][(y - b.Y1)])); // Once again, capturing the point(s) to group, pretty much the same actions as with the first group item.
                    for o := 0 to (p[(x - b.X1)][(y - b.Y1)] - 1) do
                    begin
                      Result[c][(l + o)].X := x;
                      Result[c][(l + o)].Y := y;
                    end;
                    bmp.Pixels[x, y] := colors[c];
                    DebugBitmap(bmp);
                    r := (r + p[(x - b.X1)][(y - b.Y1)]);
                    if (r > h) then
                      Exit;
                    p[(x - b.X1)][(y - b.Y1)] := 0;
                    SetLength(q, (s + 1));
                    q[s] := Result[c][l]; // Added the point to checking/scanning queu.
                    Inc(s);
                  end;
                end;
          end;
        end;
    end else
    begin // When we have only 1 point, there's no need to do any looping, so lets just create the array simply this easy way...
      SetLength(Result, 1);
      SetLength(Result[0], 1);
      Result[0][0] := TPA[0];
    end;
end;

function TPADistribute(TPA: TPointArray; dist: Extended): T2DPointArray;
begin
  Result := TPADistributeEx(TPA, 0, dist);
end;

{==============================================================================]
  Explanation: Returns all the color points from bitmap as TPointArray.
               Result is based on Row-by-Row.
[==============================================================================}
function GetBitmapColorTPA(bmp: TSCARBitmap; color: Integer): TPointArray;
var
  x, y, r: Integer;
begin
  SetLength(Result, (bmp.Width * bmp.Height));
  for y := 0 to (bmp.Height - 1) do
    for x := 0 to (bmp.Width - 1) do
      if (bmp.Pixels[x, y] = color) then
      begin
        Result[r] := Point(x, y);
        Inc(r);
      end;
  SetLength(Result, r);
end;

procedure Setup;
begin
  bmp := TSCARBitmap.Create('deNrt2lt2wyAMBUAvssvvXtod5LSJj' +
    'a6kuf9xQAx+AN/X1/UjIiIiIiIiSbnuy4xepHUtCknTcWRy9l3LCDLJZNNBZPJ' +
    'kYTuCZJLJQJOHx7FvX8LZM7nNZPjd+FhBmGSSSSYLH4vPlZTJYSbzv6eYZJJJJ' +
    'gv7kr/0dLgsTNb2pcWKKJNMNjV5VzuZLOxL/p+WVJLJqr6U/O+VFyY3m7xSw2R' +
    'CX0r+mkkmH2qhZzeTac9Q3zhMBt6pZnzs1LYtdj1trclalgltY/L2hjVdrgxpW' +
    'PK+w8kezVi6P9ngMSCZDCxaSMNa7M8e61qXKT/jphSYJc+gfJYoMsnkYWBNTbZ' +
    'b1mDyv8XpZbLdloT3ybcrwySTma+Cy19ru2zuLPwwYfKuUkxao04oBZBMentJA' +
    '3lyL77kLevpER+2w77H5C2/Cvy+aLdkx+SLi6edEGByxvvk51eO2mjYYHL87u0' +
    'BS+HfvK3XkPeYLLmaLeD32rnBZMkFZ++4HXgbnMqy6pq1EsJNOos17JOwu0nHs' +
    'ZjMMelE1uB1s44mHcpiMsqkQ1lM5ph0DGYDyL+MS4jJwTubTHY0OX7DncleJsN' +
    'PRDC5zWSLgzpMMskkk0xKlMnyvSQgmTzWnqg68NZozfyJJgXOTdj6mvywYZl1I' +
    'G2AyTeal1wH0nKG40wL8+cmZsNMvmhnizowljMcjza10dwELGREVIDJqEFRASC' +
    'jBsWsZDJqXExJJqOGxpRkMmd0zEcgQ4bJM4JJYVKwBFKYFHmCpRqKiIiIiIiIb' +
    'MsvNuu8Mw==');
  colors := [2588671, 969215, 1959605, 15245824, 10766755, 12829635, 5733049, 15391129];
  DebugBitmap(bmp);
end;

var
  TPA: TPointArray;
  ATPA: T2DPointArray;

begin
  Setup;
  TPA := GetBitmapColorTPA(bmp, 0);
  ATPA := TPADistribute(TPA, DIST);
  WriteLn(Length(ATPA));
  SetLength(TPA, 0);
  SetLength(ATPA, 0);
  bmp.Free;
end.