uses crt,graph;
Const
 nmax=100;
Type
 coord = array[1..nmax] of real;
 numbers = array[1..nmax] of integer;
 matrix = array[1..nmax div 2, 1..nmax div 2] of byte;

function IOS(x1,y1,x2,y2:real; xL1,yL1,xL2,yL2:real):Boolean;
begin
 if xL1<>xL2
 then
 begin
  IOS:=((y1-yL1+(yL1-yL2)*(x1-xL1)/(xL2-xL1))*(y2-yL1+(yL1-yL2)*(x2-xL1)/(xL2-xL1))>0)
 end
 else
 begin
  IOS:=(x1-xL1)*(x2-xL2)>0
 end;
end;


procedure ConvOfSet(var n:integer; x,y:coord; var Conv:numbers; var k:integer);
{"Строит" выпуклую оболочку множества точек на плоскости с координатами (X[i],Y[i]),
в результате получаем набор номеров точек - вершин выпуклой оболочки. }

Var
 i,j,k1,{k,} beg,t:integer;
 A:matrix;
 c:boolean;
 tk:real;
begin
  i:=1;
  while i<=n do
  begin
    j:=1;
    while j<=i-1 do
    begin
      if (X[i]=X[j])and (Y[i]=Y[j])
      then
      begin
        k:=i+1;
        while k<=n do
        begin
          X[k-1]:=X[k];
          Y[k-1]:=Y[k];
          k:=k+1
        end;
        j:=i;
        n:=n-1
      end;
      j:=j+1
    end;
    i:=i+1
  end;
  i:=1;
  repeat
    Conv[i]:=0;
    j:=1;
    repeat
      A[i,j]:=0;
      j:=j+1
    until not(j<=n);
    i:=i+1
  until not(i<=n);
  i:=1;
  while (i<n) do
  begin
    j:=i+1;
    repeat
      k1:=1;
      C:=True;
      k:=0;
      while (k1<=n)and C and (k=0) do
      begin
        if (k1<>i)and (k1<>j)
        then
        begin
          if X[i]=X[j]
          then
          begin
            if X[k1]=X[i]
            then
            begin
              tk:=(Y[k1]-Y[i])/(Y[j]-Y[i]);
              c:=(tk>0)and(tk<1)
            end
            else
            begin
              k:=k1
            end;
          end
          else
          begin
            if Y[k1]=Y[i]+(Y[j]-Y[i])* (X[k1]-X[i])/(X[j]-X[i])
            then
            begin
              tk:=(X[k1]-X[i])/(X[j]-X[i]);
              c:= (tk>0)and(tk<1)
            end
            else
            begin
              k:=k1
            end;
          end;
        end;
        k1:=k1+1;
      end;
      k1:=1;
      while (k1<=n)and C do
      begin
        if (k1<>i)and(k1<>j)and(k1<>k)
        then
        begin
          if X[i]=X[j]
          then
          begin
            if (X[k1]=X[i])
            then
            begin
              tk:=(Y[k1]-Y[i])/(Y[j]-Y[i]);
              c:=c and (tk>0)and(tk<1)
            end
            else
            begin
              c:=c and IOS(X[k],Y[k],X[k1],Y[k1],X[i],Y[i],X[j],Y[j])
            end;
          end
          else
          begin
            if Y[k1]=Y[i]+(Y[j]-Y[i])*(X[k1]-X[i])/(X[j]-X[i])
            then
            begin
              tk:=(X[k1]-X[i])/(X[j]-X[i]);
              c:=c and (tk>0)and(tk<1)
            end
            else
            begin
              c:=c and IOS(X[k],Y[k],X[k1],Y[k1],X[i],Y[i],X[j],Y[j])
            end;
          end;
        end;
        k1:=k1+1
      end;
      if C
      then
      begin
        A[i,j]:=1;
        A[j,i]:=1
      end;
      j:=j+1
    until not(j<=n);
    i:=i+1
  end;
  beg:=0;
  i:=1;
  while (i<n)and(beg=0) do
  begin
    j:=i+1;
    while (j<=n)and(beg=0) do
    begin
      if A[i,j]=1
      then
      begin
        beg:=i;
        t:=j;
        A[i,j]:=0;
        A[j,i]:=0
      end;
      j:=j+1
    end;
    i:=i+1
  end;
  Conv[1]:=beg;
  Conv[2]:=t;
  k:=3;
  i:=t;
  while t<>beg do
  begin
    j:=1;
    while (j<=n)and(i=t) do
    begin
      if A[t,j]=1
      then
      begin
        i:=j;
        A[t,i]:=0;
        A[i,t]:=0
      end;
      j:=j+1
    end;
    t:=i;
    Conv[k]:=t;
    k:=k+1
  end;
end;


Var
 x,y:coord;
 res:numbers;
 i,n,k:integer;
 gd,gm:smallint;
 r:boolean;
begin
 randomize;

 write('enter n='); readln(n);
 if n=0 then begin
  n:=30; r:=true;
  for i:=1 to n do begin
   x[i]:=200+random(400);
   y[i]:=200+random(200);
  end;
 end else begin
  r:=false;
  for i:=1 to n do begin
   write('x[',i,']='); readln(x[i]);
   write('y[',i,']='); readln(y[i]);
   writeln;
  end;
 end;
 ConvOfSet(n,x,y,res,k);
// clrscr;
 writeln('№':4,'x':8,'y':8);
 for i:=1 to k-1 do begin
  writeln(res[i]:4,x[i]:8:2,y[i]:8:2);
 end;
 writeln('press ENTER...'); readln;
 gd:=d8bit;
 gm:=m800x600;
 initgraph(gd,gm,'');
 SetColor(white);
 SetFillStyle(1, white);
 for i:=1 to n  do begin
  if r then begin
   circle(round(x[i]),round(y[i]), 2);
   FloodFill(round(x[i]),round(y[i]), white);
  end else    putpixel(round(x[i]),round(y[i]), 15);
 end;
 for i:=2 to k-1 do begin
  line (round(x[res[i]]),round(y[res[i]]),round(x[res[i-1]]),round(y[res[i-1]]));
 end;
 readkey;
end.