Программа
{ Список }
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.
Бесплатные примеры программ
Примеры написанных программ
Помощь студентам по программированию