program m1;
Uses CRT;
Type
  PData = ^TData;
  TData = record
    names:array[1..3] of string[15];  {Фамилия, имя, отчество}
    marks:array[1..4] of integer; {3 оценки}
    bal:byte;   {Дополнительный балл}
    SB:real;    {Средний балл}
    next:PData;
  end;

{--------------------------------------------------------------------------}
procedure hello;
begin
 WriteLn('     ************************************************************ ');
 WriteLn('     *    Программа определения проходного балла на заданную    * ');
 WriteLn('     *   специальность по результатам вступительных экзаменов   * ');
 WriteLn('     *          и формирования списка студентов,                * ');
 WriteLn('     *  чей средний балл выше или равен заданному,упорядочивает * ');
 WriteLn('     *     их по фамилиям и размещает в типизированный файл.    * ');
 WriteLn('     ************************************************************ ');
 WriteLn;
end;

{--------------------------------------------------------------------------}
procedure vvod(var f:text;var Rec:TData);
var
  s:real; {Сумма 3 оценок}
  i, k,
  p:integer; {Позиция в строке ввода}
  error:integer; {код ошибки при преобраз. строки в число}
  st:string;
  bals:string;{Строки,содерж bal}
  Smarks:array[1..4] of string;
Begin
  { Write('Введите фамилию, имя и отчество: '); }
  s:=0;
  readln(f,st);
  for k:=1 to 3 do begin
    p:=pos(' ',st);
    rec.names[k]:=copy(st,1,p-1);
    delete(st,1,p);
  end;

  for i:=1 to 4 do begin { От 1ой до 4ой оценки}
    p:=pos(' ',st);
    Smarks[i]:=copy(st,1,p-1);          {Вырезаем оценку}
    val(Smarks[i],rec.marks[i],error);  {Преобразовываем строку в число}
    s:=s+rec.marks[i];                  {Накапливаем сумму оценок}
    delete(st,1,p);                     {Удаляем i оценку из строки}
  end;

  bals:=copy(st,1,p-1);
  val(bals,rec.bal,error);
  if rec.bal = 0 then rec.sb:=s/3 { Если дополнительного балла нет }
  else rec.sb:=(s+rec.bal)/4;
end;{vvod}

{--------------------------------------------------------------------------}
procedure add(var head,tail:PData;var Rec:TData);
var p:PData;
begin
  new(p);
  if Head=nil then head:=p
  else tail^.next:=p;

  Tail:=p;
  p^ := rec; { <-- !!! }
  p^.next:=nil;
end;{add}
{--------------------------------------------------------------------------}
procedure prosmotr(var head:Pdata);
var
  p:pdata;
  i,v,k:byte;
begin
  WriteLn('Результат: ');
  P:=Head;
  While P<>nil do begin
    for k:=1 to 3 do
      Write(P^.names[k]:15);
    for i:=1 to 3 do
      write(p^.marks[i]:3);

    writeln(p^.bal:3,' ',p^.SB:4:1);
    P:=P^.next;
  end; {while}
end;{prosm}

Var
  Head,Tail:PData;
  f:text;
  r:TData;

{--------------------------------------------------------------------------}
Begin{main}
  clrscr;
  Hello;
  head := nil;
  assign(f,'sot.txt'); reset(f);
  while not eof(f) do begin
    vvod(f,r);
    add(head,tail,r);
  end;
  prosmotr(head);
  readkey;
END.