Форум программистов [Powered by Invision Power Board]

Код
Uses
     crt;

Const qqq=10;

Type
     nas = array[1..3, 1..qqq] of integer;
     vas = array[1..qqq-1, 1..qqq-1] of integer;

Var
    f: text;
    b: integer;
    mas: nas;
    mm: vas;

Procedure rd(var mas: nas);
Var
    f: text;
    i: integer;

Begin
  Assign(f, 'input.pas');
  Reset(f);
  read(f, b);
  For i:=1 to b do
  begin
    read(f, mas[1, i]);
    read(f, mas[2, i]);
    read(f, mas[3, i]);
  end;
  close(f); 
  end;

Function opred(p1, p2, p3, l: integer): shortint;
Var opr: longint;
Begin
  opr:=    (mas[1, l]-mas[1, p3])*(mas[2, p1]-mas[2, p3])*(mas[3, p2]-mas[3, p3]);
  opr:=opr+(mas[2, l]-mas[2, p3])*(mas[3, p1]-mas[3, p3])*(mas[1, p2]-mas[1, p3]);
  opr:=opr+(mas[3, l]-mas[3, p3])*(mas[1, p1]-mas[1, p3])*(mas[2, p2]-mas[2, p3]);
  opr:=opr-(mas[1, l]-mas[1, p3])*(mas[3, p1]-mas[3, p3])*(mas[2, p2]-mas[2, p3]);
  opr:=opr-(mas[2, l]-mas[2, p3])*(mas[1, p1]-mas[1, p3])*(mas[3, p2]-mas[2, p3]);
  opr:=opr-(mas[3, l]-mas[3, p3])*(mas[2, p1]-mas[2, p3])*(mas[1, p2]-mas[1, p3]);
  If opr>0 then opred:=1 else if opr<0 then opred:=-1 else opred:=0;
end;

Procedure chist(var das: array of integer; c: integer);
Var i: integer;
Begin
  For i:=0 to c do
    das[i]:=0;
End;

Procedure force;
Var i, j, k: integer;
    m, n, d: integer;
    off1, off2: shortint;
    w, p, cop: integer;
    das: array[1..qqq-1] of integer;
    min, pl: boolean;
    label back;
Begin
  w:=1;
  p:=1;
  chist(das, qqq-1);
  For i:=1 to b-4 do
  begin
      For j:=i+1 to b-3 do
      begin
      {back:
      min:=false;
      pl:=false;}
         For k:=j+1 to b-2 do
         begin
         back:
         min:=false;
         pl:=false;
              For m:=k+1 to b-1 do
              begin
              off1:=opred(i, j, k, m);
              if off1=0 then begin das[p]:=m; inc(p); end
                 else
                 if ((min) and (off1>0)) or ((pl) and (off1<0)) then
                 begin
                 chist(das, p);
                 p:=1;
                 inc(k);
                 goto back;
                 end
                 else
                 case off1 of
                      -1: min:=true;
                       1: pl:=true;
                       end;
              end;
{         if p>1 then}
            begin
            For cop:=1 to qqq-1 do mm[w, cop]:=das[cop];
            chist(das, p);
            mm[w, p]:=i;
            mm[w,p+1]:=j;
            mm[w,p+2]:=k;
            p:=1;
            inc(w);
            end;
         end;
      end;
  end;
end;

Begin
  clrscr;
  rd(mas);
  force;
  readln;  
  readln;
end.