ATPASortSpiralEx

{==============================================================================]
 @action: Sorts ATPA to order in a spiral pattern, spiraling out from the origin TPoint.
 @note: Doesn't touch the index items (points), will keep them at same order as they were.
 @contributors: Janilabo, slacky
[==============================================================================}
procedure ATPASortSpiralEx(var ATPA: T2DPointArray; origin: TPoint); callconv
var
  h, r, i, d, g, s, n, x, y, z: Integer;
  p: T3DBoolArray;
  c: T2DPointArray;
  a: TBoolArray;
  bx: TBox;
  v: Boolean;
begin;
  h := High(ATPA);
  if (h > 0) then
  begin
    SetLength(c, (h + 1));
    v := False;
    for i := 0 to h do
    begin
      y := High(ATPA[i]);
      SetLength(c[i], (y + 1));
      if (y > -1) then
      case v of
        False:
        begin
          v := True;
          bx := Box(ATPA[i][0].X, ATPA[i][0].Y, ATPA[i][0].X, ATPA[i][0].Y);
          c[i][0] := ATPA[i][0];
          if (y > 0) then
          for x := 1 to y do
          begin
            c[i][x] := ATPA[i][x];
            if (ATPA[i][x].X < bx.X1) then
              bx.X1 := ATPA[i][x].X
            else
              if (ATPA[i][x].X > bx.X2) then
                bx.X2 := ATPA[i][x].X;
            if (ATPA[i][x].Y < bx.Y1) then
              bx.Y1 := ATPA[i][x].Y
            else
              if (ATPA[i][x].Y > bx.Y2) then
                bx.Y2 := ATPA[i][x].Y;
          end;
        end;
        True:
        for x := 0 to y do
        begin
          c[i][x] := ATPA[i][x];
          if (ATPA[i][x].X < bx.X1) then
            bx.X1 := ATPA[i][x].X
          else
            if (ATPA[i][x].X > bx.X2) then
              bx.X2 := ATPA[i][x].X;
          if (ATPA[i][x].Y < bx.Y1) then
            bx.Y1 := ATPA[i][x].Y
          else
            if (ATPA[i][x].Y > bx.Y2) then
              bx.Y2 := ATPA[i][x].Y;
        end;
      end;
    end;
    if v then
    begin
      z := (h + 1);
      CreateTBoA(False, (h + 1), a);
      r := 0;
      for i := h downto 0 do
        if (Length(c[i]) = 0) then
        begin
          SetLength(ATPA[(h - r)], 0);
          a[i] := True;
          Dec(z);
        end;
      SetLength(p, ((bx.X2 - bx.X1) + 1));
      for x := 0 to (bx.X2 - bx.X1) do
      begin
        SetLength(p[x], ((bx.Y2 - bx.Y1) + 1));
        for y := 0 to (bx.Y2 - bx.Y1) do
        begin
          SetLength(p[x][y], (h + 1));
          for i := 0 to h do
            p[x][y][i] := False;
        end;
      end;
      for i := 0 to h do
      begin
        y := High(ATPA[i]);
        for x := 0 to y do
          p[(ATPA[i][x].X - bx.X1)][(ATPA[i][x].Y - bx.Y1)][i] := True;
      end;
      d := 0;
      s := 1;
      g := 1;
      r := 0;
      n := 0;
      repeat
        if ((origin.X >= bx.X1) and (origin.Y >= bx.Y1) and (origin.X <= bx.X2) and (origin.Y <= bx.Y2)) then
          for i := 0 to h do
            if not a[i] then
              if p[(origin.X - bx.X1)][(origin.Y - bx.Y1)][i] then
              begin
                y := High(c[i]);
                SetLength(ATPA[n], (y + 1));
                for x := 0 to y do
                  ATPA[n][x] := c[i][x];
                a[i] := True;
                Inc(n);
                Dec(z);
              end;
        case (d mod 4) of
          0: origin.Y := (origin.Y - 1);
          1: origin.X := (origin.X + 1);
          2: origin.Y := (origin.Y + 1);
          3: origin.X := (origin.X - 1);
        end;
        if (g = s) then
        begin
          Inc(d);
          if ((d mod 2) = 0) then
            Inc(s);
          g := 0;
        end;
        Inc(g);
      until ((z <= 0) or (n > h));
    end;
  end;
end;