old/PAS/LineBounds/bounds.pas

uses Graph;
CONST
     Num  = 10;
     MinX = 100;
     MinY = 100;
     MaxX = 540;
     MaxY = 380;
{---------------------------------------------------------------}
Procedure Delay(aMS:word);assembler;
asm
  xor dx, dx
  mov ax, aMS
  mov bx, 1000
  mul bx
  mov cx, dx
  mov dx, ax
  mov ah, 86h
  int 15h
end;

type
    PList = ^TList;
    TList = record
          val : real;
          x,y : longint;
          prev: PList;
    end;
{---------------------------------------------------------------}
var
 grDriver       : Integer;
 grMode         : Integer;
 ErrCode        : Integer;
 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
  grDriver := Detect;
  InitGraph(grDriver, grMode,' ');
  ErrCode := GraphResult;
  if ErrCode = grOk then
  begin  { Do graphics }
  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);
    FillEllipse(NNN^.x,NNN^.y,2,2);
    NNN^.prev := List;
    List:=NNN
   end;
  cx := cx div Num;
  cy := cy div Num;
  SetFillStyle(SOLIDFILL,Magenta);
  FillEllipse(cx,cy,3,3);
  Sort(List);
  NNN:=List;
  SetWriteMode(XORPut);
  ax1:=1;
  while (NNN^.prev<>nil) do
   begin
    SetColor(Green);
    Str(ax1,GGG);
    OutTextXY(NNN^.x,NNN^.y+5,GGG);
    SetColor(Blue);
    Line(cx,cy,NNN^.x,NNN^.y);
    Delay(300);
    Line(cx,cy,NNN^.x,NNN^.y);
    Inc(ax1);
    NNN:=nnn^.prev;
   end;
  nnn^.prev:=List;
  SetColor(Green);
  Str(ax1,GGG);
  OutTextXY(NNN^.x,NNN^.y+5,GGG);
  SetColor(Blue);
  Line(cx,cy,NNN^.x,NNN^.y);
  Delay(300);
  Line(cx,cy,NNN^.x,NNN^.y);
  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);
      SetColor(Blue);
      Line(ax1,ay1,ax2,ay2);
      SetColor(Red);
      Line(cx,cy,ax,ay);
      if ( (aa*ax+ab*ay+ac) *
           (aa*cx+ab*cy+ac) ) < 0 then
      begin
        inc(deleted);
        tmp:=NNN^.prev;
        SetColor(Green);
        Line(ax2-3,ay2-3,ax2+3,ay2+3);
        Line(ax2-3,ay2+3,ax2+3,ay2-3);
        if (List=tmp) then List := NNN;
        NNN^.prev := tmp^.prev;
        dispose(tmp);
        NNN:=pr1;
      end;
      Delay(500);
      SetColor(Blue);
      Line(ax1,ay1,ax2,ay2);
      SetColor(Red);
      Line(cx,cy,ax,ay);
      Pr1:=NNN;
      NNN:=NNN^.Prev;
    until NNN=List;
  until deleted=0;
{-------------------------------------------------------}
  SetColor(Yellow);
  MoveTo(List^.x,List^.y);
  NNN:=list^.prev;
  while (NNN<>List) do
   begin
    LineTo(NNN^.x,NNN^.y);
    Tmp:=NNN;
    NNN:=NNN^.prev;
    Dispose(Tmp);
   end;
  LineTo(NNN^.x,NNN^.y);
  Dispose(NNN);
  Readln;
  CloseGraph;
 end
 else
   Writeln('Graphics error:', GraphErrorMsg(ErrCode));
end.