Программа


{ Список }
PROGRAM Basketball_Team(input,output);
CONST LengthName=40;  { Длина имени игрока }
TYPE PlayerList=^Player;  { Список игроков }
     Player=record        { Запись об игроке }
              Name:packed array [1..LengthName] of char; { Имя }
              Point:integer;   { Очки }
              Next,Pred:PlayerList { Ссылки на следующего и предыдущего }
            end;
VAR Exit:boolean;              { Флаг "Выход" }
    F:PlayerList;              { Список игроков }
FUNCTION Menu:integer;         { Функция вывода меню и получения ответа }
  Const QuantityMenuPoint=3;   { Количество пунктов меню }
        ExitPoint=QuantityMenuPoint; { Пункт меню "Выход" }
  Var Point:integer;            { Текущий пункт меню }
      AnswerBuf:char;           { Переменная для получения ответа на меню }
  Begin
    repeat  { Цикл чтения ответа на меню }
      WriteLn; { Пропуск строки }
      { Вывод меню: }
      WriteLn('МЕНЮ:');
      WriteLn('[1] Ввод данных об игроке');
      WriteLn('[2] Вывод списка игроков отсортированного по очкам');
      WriteLn('[3] Выход');
      ReadLn(AnswerBuf); { Чтение ответа на меню }
      Point:=Ord(AnswerBuf)-Ord('0'); { Перевод полученного символа в пункт меню }
    until (0<Point) and (Point<=QuantityMenuPoint);
                          { Выход из цикла при пролучении корректного ответа }
    { Определение значения функции: }
    if Point=ExitPoint then Menu:=255
                       else Menu:=Point
  End;
PROCEDURE AddPlayer(var L:PlayerList); { Процедура добавления игрока }
  Var Buf:PlayerList;      { Буферная переменная для записи данных об игроке }
      LBuf:PlayerList; { Указатель для движения по списку }
      i:0..LengthName; { Счетчик символов в имени игрока }
      Exit:boolean;  { Флаг выхода из цикла просмотра списка }
  Begin
    New(Buf);  { Организация новой переменной }
    with Buf^ do
    begin
      Write('Введите имя игрока '); { Вывод приглашения }
      i:=0;                         { Сброс счетчика символов }
      while not EOLn do             { Цикл чтения строки }
      begin
        i:=i+1;                     { Пересчет счетчика }
        Read(Name[i])           { Чтение символа строки }
      end;
      ReadLn;
      while i<40 do                 { Цикл дополнения строки пробелами }
      begin
        i:=i+1;                     { Пересчет счетчика }
        Name[i]:=' '            { Дополнение строки пробелами }
      end;
      Write('Введите количество очков '); { Вывод приглашения }
      ReadLn(Point);                  { Ввод очков }
    end;
    if L=nil    { Проверка наличия списка }
    then begin  { списка нет }
           L:=Buf; { Определение списка }
           { Сброс ссылок: }
           L^.Next:=nil;
           L^.Pred:=nil
         end
    else begin  { список существует }
           LBuf:=L;  { Определение ссылки для прохода по списку }
           while (LBuf^.Next<>nil)and(LBuf^.Name<>Buf^.Name) do Lbuf:=LBuf^.Next;
         { Движение до последнего элемента или до элемента со сходным именем }
           if LBuf^.Name=Buf^.Name { Проверка условия выхода из цикла движения по списку }
           then begin { имя найдено }
                  LBuf^.Point:=LBuf^.Point+Buf^.Point;  { Набор очков }
                  Dispose(Buf)   { Уничтожение буфера }
                end
           else begin { введенный игрок - новый }
                  { Вставка нового игрока: }
                  LBuf^.Next:=Buf;
                  Buf^.Next:=nil;
                  Buf^.Pred:=LBuf
                end
         end
  End;
PROCEDURE ViewPlayers (L:PlayerList); { Процедура просмотра списка }
  Var i:0..LengthName; { Счетчик символов в имени игрока }
  Begin
    WriteLn; { Пропуск строки }
    { Вывод заголовка: }
    WriteLn(' ИГРОК                                   ОЧКИ');
    WriteLn('----------------------------------------------');
    while L<>nil do { Цикл просмотра списка }
    begin
      for i:=1 to LengthName do Write(L^.Name[i]); { Цикл вывода имени }
      WriteLn(' ',L^.Point:3); { Вывод количества очков }
      L:=L^.Next                { Продвижение по списку }
    end;
    WriteLn { Пропуск строки }
  End;
PROCEDURE SortPlayers(var P:PlayerList);   { Процедура сортировки списка }
  Function SecondElementIsMax(First,Second:Player):boolean;
                                 { Функция определения максимального элемента }
    begin
      SecondElementIsMax:=Second.Point>First.Point
    end;
  Var Ref,         { Ссылка }
      RefPred,     { Ссылка на предыдущий элемент }
      RefMax,      { Ссылка на максимальный элемент }
      RefPredMax   { Ссылка на элемент предыдущий максимальному }
      :PlayerList;
  Begin
    if P<>nil then { Если очередь не пустая, то - сортировка очереди }
      begin
        { Начальное определение ссылок: }
        RefMax:=P;
        RefPredMax:=nil;
        Ref:=RefMax;
        while Ref^.Next<>nil do { Цикл просмотра очереди }
          begin
            RefPred:=Ref;   { Переопределение ссылки на предыдущий элемент }
            Ref:=Ref^.Next; { Переопределение ссылки на текщий элемент }
            { Сравнивание максимального элемента с текущим: }
            if SecondElementIsMax(RefMax^,Ref^)
              then begin { Переопределение ссылок максимального элемента: }
                     RefMax:=Ref;
                     RefPredMax:=RefPred
                   end
          end;
        if RefPredMax<>nil then
          begin { Если максимальный элемент не первый, то - перестановка }
            RefPredMax^.Next:=RefMax^.Next;     { максимального элемента }
            RefMax^.Next:=P;                    { в начало очереди }
            P:=RefMax
          end;
        SortPlayers(P^.Next) { Сортировка хвоста очереди }
      end
  End;
PROCEDURE DisposerList(var L:PlayerList); { Процедура удаления списка }
  Begin
    if L<>nil then begin   { Если переменная существует, то }
                     DisposerList(L^.NEXT);  { удаление хвоста списка }
                     Dispose(L);             { удаление переменной }
                     L:=nil { Переопределение ссылки }
                   end
  End;
BEGIN
  Exit:=FALSE;    { Сброс флага "Выход" }
  F:=nil;   { Сброс ссылки на список }
  repeat   { Цикл работы программы }
    case Menu of       { Выбор действия по ответу на меню }
        1:AddPlayer(F);      { Ввод игрока }
        2:begin
            SortPlayers(F);   { Сортировка файла }
            ViewPlayers(F)    { Просмотр файла }
          end;
      255:Exit:=TRUE  { Подъем флага "Выход" }
    end
  until Exit;
  DisposerList(F)  { Уничтожение списка }
END.

Бесплатные примеры программ
Примеры написанных программ
Помощь студентам по программированию