Алгоритм решения задачи: восстановить прямоугольное стекло из всех имеющихся осколков (Паскаль)

[JaySee]

Помогите разобраться. Есть код решения этой задачи http://www.informatics.ru/viewproble...50&round_id=12 , но ни коментариев, ни обьяснения нету.

Помогите разобратсься как работает программа.

const
  MaxN = 2000;
var
  n: integer;
  x, y: array [1..MaxN, 0..2] of integer;
  pts: array [1..MaxN, 0..2] of integer;
  pw: array [1..8] of integer;
  x1, y1, x2, y2: array [1..MaxN] of integer;

procedure ReadAll;
var
  i, j: integer;
begin
  Assign(Input, 'glass.in'); Reset(Input);

  Read(n);
  for i := 1 to n do begin
    for j := 0 to 2 do begin
      Read(x[i][j], y[i][j]);
    end;
  end;

  Close(Input);
end;

var
  np: integer;

function less(x1, y1, x2, y2: longint): boolean;
begin
  less := ( (x1*y2 - x2*y1) < 0 );
end;

var
  pp: array [1..MaxN] of integer;

procedure sortpts(l, r: integer); {by x1}
var
  mx, my: longint;
  i, j, h: integer;
begin
  i := l; j := r;
  mx := x1[pp[(l+r) shr 1]];
  my := y1[pp[(l+r) shr 1]];

  repeat
    while (less( x1[pp[i]], y1[pp[i]], mx, my )) do inc(i);
    while (less( mx, my, x1[pp[j]], y1[pp[j]] )) do dec(j);

    if (i<=j) then begin
      h := pp[i]; pp[i] := pp[j]; pp[j] := h;
      inc(i); dec(j);
    end;
  until (i>j);

  if (i < r) then sortpts(i, r);
  if (l < j) then sortpts(l, j);
end;

procedure trytosolve;
var
  i, j, h, ii, dx, dy: integer;
  s, minx, maxx, miny, maxy: longint;
  x1l, x2l, y1l, y2l: longint;
begin
  s := 0;
  for i := 1 to n do begin
    x1[i] := x[i][pts[i][1]] - x[i][pts[i][0]];
    y1[i] := y[i][pts[i][1]] - y[i][pts[i][0]];

    x2[i] := x[i][pts[i][2]] - x[i][pts[i][0]];
    y2[i] := y[i][pts[i][2]] - y[i][pts[i][0]];

    if ( less(x2[i], y2[i], x1[i], y1[i]) ) then begin
       h := x1[i]; x1[i] := x2[i]; x2[i] := h;
       h := y1[i]; y1[i] := y2[i]; y2[i] := h;
    end;
    pp[i] := i;
    x1l := x1[i];
    x2l := x2[i];
    y1l := y1[i];
    y2l := y2[i];

    s := s + abs( x1l*y2l - x2l*y1l);
  end;
  if odd(s) then exit;
  s := s div 2;

  sortpts(1, n);
  for i := 1 to n do begin
    ii := (i mod n) + 1;
    if (x2[pp[i]] <> x1[pp[ii]]) or (y2[pp[i]] <> y1[pp[ii]]) then exit;
  end;                  

  minx := 0; miny := 0; maxx := 0; maxy := 0;
  for i := 1 to n do begin
    if x1[i] < minx then minx := x1[i];
    if x2[i] < minx then minx := x2[i];
    if x1[i] > maxx then maxx := x1[i];
    if x2[i] > maxx then maxx := x2[i];
    if y1[i] < miny then miny := y1[i];
    if y2[i] < miny then miny := y2[i];
    if y1[i] > maxy then maxy := y1[i];
    if y2[i] > maxy then maxy := y2[i];
  end;

  if ((maxx-minx)*(maxy-miny) <> s) then exit;

  for i := 1 to n do begin
    dx := -(x[i][pts[i][0]] + minx);
    dy := -(y[i][pts[i][0]] + miny);
    for j := 0 to 2 do begin
      if (j > 0) then Write(' ');
      Write(x[i][j]+dx, ' ', y[i][j]+dy);
    end;
    WriteLn;
  end;
  Close(Output);

  halt;
end;

function online(i, a, b: integer): boolean;
begin
  online := (x[i][a] = x[i][b]) or (y[i][a] = y[i][b]);
end;

procedure preppts(i: integer);
var
  cc: integer;
  c0, c1, c2: boolean;
begin
  cc := 0;
  c0 := online(i, 1, 2); if (c0) then inc(cc);
  c1 := online(i, 0, 2); if (c1) then inc(cc);
  c2 := online(i, 0, 1); if (c2) then inc(cc);

  if ((cc > 1)) then begin
    inc(np);
    if (np > 8) then exit;
    pw[np] := i;
  end else
  if (c0) then begin
    pts[i][0] := 0;
    pts[i][1] := 1;
    pts[i][2] := 2;
  end;
  if (c1) then begin
    pts[i][0] := 1;
    pts[i][1] := 0;
    pts[i][2] := 2;
  end;
  if (c2) then begin
    pts[i][0] := 2;
    pts[i][1] := 0;
    pts[i][2] := 1;
  end;
end;

procedure perpts(t: integer);
var
  cc: integer;
  i: integer;
  c0, c1, c2: boolean;
begin
  if t > np then begin
    trytosolve;
    exit;
  end;
  i := pw[t];
  cc := 0;
  c0 := online(i, 1, 2); if (c0) then inc(cc);
  c1 := online(i, 0, 2); if (c1) then inc(cc);
  c2 := online(i, 0, 1); if (c2) then inc(cc);

  if (c0) then begin
    pts[i][0] := 0;
    pts[i][1] := 1;
    pts[i][2] := 2;
    perpts(t+1);
  end;
  if (c1) then begin
    pts[i][0] := 1;
    pts[i][1] := 0;
    pts[i][2] := 2;
    perpts(t+1);
  end;
  if (c2) then begin
    pts[i][0] := 2;
    pts[i][1] := 0;
    pts[i][2] := 1;
    perpts(t+1);
  end;
end;

var i: integer;
begin
  ReadAll;
  np := 0;
  Assign(Output, 'glass.out'); ReWrite(Output);
  for i := 1 to n do preppts(i);
  if np<=8 then perpts(1);
  WriteLn('NO');
  Close(Output);
end.

___________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE] (это кнопочка с решёточкой #)
Не забывайте об этом!
Модератор.