program new;

procedure SetPixels(bmp: Integer; TPA: TPointArray; color: Integer);
var
  a, z, w, h: Integer;
begin
  z := High(TPA);
  if (z > -1) then
  begin
    GetBitmapSize(bmp, w, h);
    for a := 0 to z do
      if ((TPA[a].X >= 0) and (TPA[a].Y >= 0) and (TPA[a].X < w) and (TPA[a].Y < h)) then
        FastSetPixel(bmp, TPA[a].X, TPA[a].Y, color);
  end;
end;


//Walk around current, from previous.
procedure RotatingAdjecent8Way(var adj:TPointArray;const Curr:TPoint; const Prev:TPoint);
var
  i: Integer;
  dx,dy,x,y:Single;
begin
  x := Prev.x; y := Prev.y;
  adj[7] := Prev;
  for i:=0 to 6 do
  begin
    dx := x - Curr.x;
    dy := y - Curr.y;
    x := ((dy * 0.7070) + (dx * 0.7070)) + Curr.x;
    y := ((dy * 0.7070) - (dx * 0.7070)) + Curr.y;
    adj[i] := Point(Round(x),Round(y));
  end;
end;

procedure TPALine(var TPA:TPointArray; P1, P2: TPoint);
var
  dx,dy,step,I,H: Integer;
  rx,ry,x,y: Extended;
begin
  H := Length(TPA);
  if (p1.x = p2.x) and (p2.y = p1.y) then
  begin
    SetLength(TPA, H+1);
    TPA[H] := P1;
    Exit;
  end;

  dx := (P2.x - P1.x);
  dy := (P2.y - P1.y);
  if (Abs(dx) > Abs(dy)) then step := Abs(dx)
  else step := Abs(dy);
  SetLength(TPA, (H+step+1));

  rx := dx / step;
  ry := dy / step;
  x := P1.x;
  y := P1.y;

  TPA[H] := Point(P1.x, P1.y);
  for I:=1 to step do
  begin
    x := x + rx;
    y := y + ry;
    TPA[(H+i)] := Point(Round(x),Round(y));
  end;
end;


function lines(TPA:TPointArray; Distance:Integer): TPointArray;
var
  i,j,h,x,y,lx,hx,ly,hy,l,hit:Integer;
  Matrix:T2DIntegerArray;
  Area: TBox;
  pt,start,prev,endpt:TPoint;
  adj:TPointArray;
  bmp:Integer;
begin
  Area := GetTPABounds(TPA);
  Area.X2 := (Area.X2 - Area.X1) + 1;  //Width
  Area.Y2 := (Area.Y2 - Area.Y1) + 1;  //Height
  H := High(TPA);

  SetLength(Matrix, Area.Y2);
  for i:=0 to (Area.Y2-1) do
    SetLength(Matrix[i], Area.X2);
  for i:=0 to H do
    Matrix[(TPA[i].y-Area.Y1)][(TPA[i].x-Area.X1)] := 1;

  for i:=0 to H do
  begin
    pt.x := TPA[i].x-Area.X1;
    pt.y := TPA[i].y-Area.Y1;
    if Matrix[pt.y][pt.x] = 1 then
    begin
      Matrix[pt.y][pt.x] := 0;
      lx := Max(pt.x - Distance, 0);
      hx := Min(pt.x + Distance, Area.X2-1);
      ly := Max(pt.y - Distance, 0);
      hy := Min(pt.y + Distance, Area.Y2-1);
      for x:=lx to hx do
        for y:=ly to hy do
          if Matrix[y][x] = 1 then
            TPALine(Result, Point((pt.x),(pt.y)), point(x,y));
    end;
  end;
  {
  bmp := CreateBitmap(400,400);
  SetPixels(bmp,Result,255);
  DisplayDebugImgWindow(400,400);
  DrawBitmapDebugImg(bmp);
  }
  //Add lines to matrix, and find start.
  start := Point(Area.X2, Area.Y2);
  for i:=0 to High(Result) do begin
    Matrix[Result[i].y][Result[i].x] := 255;
    if Result[i].y < start.y then
        start := Result[i];
  end;

  //Rooooooling: http://www.youtube.com/watch?v=qCRae5mRoRE
  l := High(Result);
  SetLength(Result, 0);
  SetLength(adj, 8);
  endpt := start;
  prev := Point(start.x, start.y-1);
  i := 0; hit := 0;
  while True do begin
    Inc(i);
    RotatingAdjecent8Way(adj, start, prev);
    for j:=0 to 7 do begin
      if (adj[j].x >= 0) and (adj[j].x < Area.X2) and
         (adj[j].y >= 0) and (adj[j].y < Area.Y2) then
        if Matrix[adj[j].y][adj[j].x] >= 255 then
        begin
          prev := start;
          start := adj[j];
          hx := Matrix[start.y][start.x];
          Matrix[start.y][start.x] := hx+1;
          if hx = 255 then begin
            SetLength(Result, Length(result)+1);
            Result[High(result)] := prev;
          end;
          break;
        end;
    end;
    if ((endpt.x = prev.x) and (endpt.y = prev.y) and (i>1)) or (i>l) then
    begin
      Inc(hit);
      if hit = 2 then Break;
    end;
  end;
  {
  SetPixels(bmp,Result,16777215);
  DrawBitmapDebugImg(bmp);
  FreeBitmap(bmp);}
end;



//----------------------------------------------


function RandomTPA(Amount:Integer; MinX,MinY,MaxX,MaxY:Integer): TPointArray;
var i:Integer;
begin
  SetLength(Result, Amount);
  for i:=0 to Amount-1 do
    Result[i] := Point(RandomRange(MinX, MaxX), RandomRange(MinY, MaxY));
end;

procedure DebugBitmap(bmp: Integer);
var
  w, h: Integer;
begin
  GetBitmapSize(bmp, w, h);
  DisplayDebugImgWindow(w, h);
  DrawBitmapDebugImg(bmp);
end;


var
  TPA,TPA2: TPointArray;
  t, bmp:Integer;
begin
  bmp := CreateBitmap(500, 500);
  TPA := RandomTPA(1000, 20,20, 400,400);
  DrawTPABitmap(bmp, TPA, 16777215);
  t:=GetSystemTime;
  TPA2 := lines(TPA, 30);
  WriteLn('used '+ToStr(GetSystemTime - t)+'ms');
  DrawTPABitmap(bmp, TPA2, 255);
  DebugBitmap(bmp);
end.