Spiski

Program spisok;
Type
  ptr=^student;
  student=record
   fam:string;
   year:integer;
   groop:string[9];
   time:real;
   next:ptr;
  end;

var
  headptr:ptr;

procedure vvod(var stud:student); {чтение значений полей записи}
begin
  with stud do
   begin
    write('введите- фамилию '); readln(fam);
    write('год рождения ') ; readln(year);
    write ('номер группы '); readln(groop);
    write('время забега '); readln(time);
   end;
end;{vvod}

procedure formspisok; {построение списка}
var
  p:ptr;
  let:char;
begin
  headptr:=nil;
  repeat
    write(' Продолжить? (у-да, n-нет) ');readln(let) ;
    if let='n' then exit;
    if headptr=nil then
      {формирование первого элемента списка}
      begin new(headptr);
          p:=headptr;
      end
    else
    {формирование очередного элемента списка}
      begin
        new(p^.next);
        p:=p^.next;
      end;
    vvod(p^);
    p^.next:=nil;
  until let='n';
end; {formspisok}

procedure pech (stud: student); {печать значений полей записи}
begin
  with stud do
    writeln(fam:14,year:6,groop:11,time:9:2);
end;{pech}

procedure pechspisok; {печать списка}
var p:ptr;
begin
  p:=headptr;
  while p<>nil do
    begin
      pech(p^);
      p:=p^.next;
    end;
end;{pechspisok}

procedure sort; {сортировка списка}
var p1,p2,q1,q2,temp{Bcпомогат. указатель}:ptr;
begin
  if headptr=nil then exit {если списка нет}
                 else if headptr^.next=nil then exit
                 {если список из одного элемента}
                 else
                   begin
                     p1:=headptr;{поиск с начала}
                     p2:=nil;
                       while p1^.next<>nil do
                         begin
                           q1:=p1^.next;{адрес очередного эл.}
                           q2:=p1;
                           while q1<>nil do {пока не конец}
                            begin
                             if p1^.fam>q1^.fam then
                                                  begin
                                                  if p1=q2 then
                                                  {выбираем следующий элемент списка}
                                                  begin
                                                    p1^.next:=q1^.next;
                                                    q1^.next:=p1; p1:=q1;
                                                    q1:=q2; q2:=q1;
                                                  end
                                                  else{изменяем связи в списке}
                                                    begin
                                                      temp:=p1^.next;
                                                      p1^.next:=q1^.next ;
                                                      q1^.next:=temp;
                                                      temp:=p1; p1:=q1;
                                                      q1:=temp; q2^.next:=q1;
                                                    end;
                             if p2=nil then headptr:=p1
                               else p2^.next:=p1;
                            end;
                            q2:=q1; q1:=q1^.next;
                            end;
                            p2:=p1; p1:=p1^.next;
                         end;
                   end;
end;{sort}

begin
  formspisok;
  writeln('Исходный список: ');
  pechspisok;
  sort;
  writeln;
  writeln('Список после сортировки: ');
  pechspisok;
end.