old/PAS/LineBounds/clear.pas

uses Graph;
CONST
     Num  = 10;
     MinX = 100;
     MinY = 100;
     MaxX = 540;
     MaxY = 380;
{---------------------------------------------------------------}
type
    PList = ^TList;
    TList = record
          val : real;
          x,y : longint;
          prev: PList;
    end;
{---------------------------------------------------------------}
var
 i,cx,cy        : LongInt;
 List,NNN,Tmp   : Plist;
{------------------------------------------------------------}
Function Angle(x,y:word):real;
var
 x1,y1:longint;
 ret:real;
begin
 x1 := x-cx;
 y1 := y-cy;
 if x1=0 then
  begin
   Angle:=(PI/2) - PI * (y1/abs(y1)-1)/2;
   Exit;
  end;
 ret:=arctan(y1/x1);
 if (x1>0) and (y1<0) then ret:=ret+2*Pi;
 if ((x1<0) and (y1>0)) or ((x1<0) and (y1<0)) then ret:=ret+Pi;
 Angle:=ret;
end;
{==============================================================}
Procedure Sort(var List:plist);
var
 ret,t1,t2,t3:plist;
 min:plist;
begin
  ret:=nil;
  t1:=List;
  while t1<>nil do begin t1^.val:=Angle(t1^.x,t1^.y); t1:=t1^.prev end;
  t1:=List;
  repeat
    t2:=t1;
    min:=t1;
    while t2^.prev<>nil do
     begin
      if t2^.prev^.val<min^.prev^.val then min := t2;
      t2:=t2^.prev;
     end;
    if min^.prev^.val > t1^.val then
     begin
       New(t3);
       t3^.val := t1^.val;
       t3^.x := t1^.x;
       t3^.y := t1^.y;
       t3^.prev:=ret;
       ret:=t3;
       t2:=t1;
       t1:=t1^.prev;
       DisPose(t2);
     end
    else
     begin
       New(t3);
       t3^.val := min^.prev^.val;
       t3^.x := min^.prev^.x;
       t3^.y := min^.prev^.y;
       t3^.prev:=ret;
       ret:=t3;
       t2:=min^.prev;
       min^.prev := t2^.prev;
       DisPose(t2);
     end;
  until t1^.prev=nil;
  t1^.prev:=ret;
  List:=t1;
end;
{-------------------------------------------------}
var
  deleted,ay,ay1,ay2,ax,ax1,ax2,aa,ab,ac : longint;
  GGG                                    : string;
  pr1                                    : plist;
begin
  randomize;
  List:=nil;
  cx:=0;
  cy:=0;
  for i := 1 to Num do
   begin
    New(NNN);
    NNN^.x:=random(MaxX-minX)+minX;
    NNN^.y:=random(MaxY-minY)+minY;
    inc(cx,NNN^.x);inc(cy,NNN^.y);
    NNN^.prev := List;
    List:=NNN
   end;
  cx := cx div Num;
  cy := cy div Num;
  Sort(List);
  NNN:=List;
  ax1:=1;

  nnn^.prev:=List;
  repeat
    NNN:=List;
    pr1:=List;
    deleted:=0;
    repeat
      ax:=NNN^.prev^.prev^.x;ax1:=NNN^.x;ax2:=NNN^.prev^.x;
      ay:=NNN^.prev^.prev^.y;ay1:=NNN^.y;ay2:=NNN^.prev^.y;
      aa:=ay2-ay1;
      ab:=ax1-ax2;
      ac:=ay1*(ax2-ax1)-ax1*(ay2-ay1);
      if ( (aa*ax+ab*ay+ac) *
           (aa*cx+ab*cy+ac) ) < 0 then
      begin
        inc(deleted);
        tmp:=NNN^.prev;
        if (List=tmp) then List := NNN;
        NNN^.prev := tmp^.prev;
        dispose(tmp);
        NNN:=pr1;
      end;
      Pr1:=NNN;
      NNN:=NNN^.Prev;
    until NNN=List;
  until deleted=0;
{-------------------------------------------------------}
  NNN:=list^.prev;
  while (NNN<>List) do
   begin
    Tmp:=NNN;
    NNN:=NNN^.prev;
    Dispose(Tmp);
   end;
  Dispose(NNN);
end.