Program b3_3;

Uses
    System.SysUtils, Classes;

Const
    OutputFileName = '\output.txt';

type
    InputType = (FromConsole, FromFile);

    ListD = record
        Name: AnsiString;
        Score: Integer;
    end;

    AoL = Array of ListD;

Var
    Path: String;
    Size: Integer;
    List: AoL;

function GetInputType(): InputType;
var
    Ret: InputType;
    Input: String;
    IsCorrect: Boolean;
begin
    IsCorrect := False;
    repeat
        Writeln('Выберите способ ввода предложения файл/консоль (ф/к)');
        Readln(Input);
        if (Input = 'ф') or (Input = 'Ф') or (Input = 'Файл') or (Input = 'файл')
        then
        begin
            Ret := InputType.FromFile;
            IsCorrect := True;
        end
        else if (Input = 'к') or (Input = 'К') or (Input = 'Консоль') or
          (Input = 'консоль') then
        begin
            Ret := InputType.FromConsole;
            IsCorrect := True;
        end;
    until IsCorrect;
    Result := Ret;
end;

Function GetSize(Size: Integer): Integer;
Var
    IsCorrect: Boolean;
Begin
    Writeln('Введите количество участников: ');
    Repeat
        IsCorrect := True;
        Try
            Readln(Size);
        Except
            Writeln('Введите целое число!');
            IsCorrect := False;
        End;
        If Size < 3 then
        Begin
            Writeln('Минимальное количество участников: 3');
            IsCorrect := False
        End;
    Until (IsCorrect);
    GetSize := Size;
End;

Function GetListFromConsole(List: AoL; Size: Integer): AoL;
Var
    I, J, Ind, K, B, bif: Integer;
    IsCorrect: Boolean;
    Buf: AnsiString;
    bfs: String;
    Letters: Set of AnsiChar;
Begin
    SetLength(List, Size);
    Letters := ['А' .. 'Я', 'а' .. 'я'];
    For I := 0 to Size - 1 do
    Begin
        Repeat
            IsCorrect := True;
            Writeln('Введите фамилию участника');
            Readln(List[I].Name);
            List[I].Name := Trim(List[I].Name);
            Buf := List[I].Name;
            For J := 1 to Length(Buf) do
            Begin
                If (NOT(Buf[J] in Letters)) then
                Begin
                    IsCorrect := False;
                End;
            End;
            If IsCorrect = False then
            Begin
                Writeln('Фамилия должна состоять из русских букв')
            End;
        Until (IsCorrect);

        Repeat
            Writeln('Введите счёт игрока');
            IsCorrect := True;
            Try
                Readln(List[I].Score);
            Except
                Writeln('Введите целое число!');
                IsCorrect := False;
            End;
            If List[I].Score < 0 then
            Begin
                Writeln('Введите неотрицательное число!');
                IsCorrect := False
            End;
        Until (IsCorrect) End;
        GetListFromConsole := List;
    End;

    Procedure Sorting(var List: AoL);
    Var
        J, I, BufI: Integer;
        BufS: String;
    Begin
        For I := 0 to Size - 1 do
        Begin
            For J := I + 1 to Size do
            Begin
                If List[I].Score < List[J].Score then
                Begin
                    BufI := List[J].Score;
                    List[J].Score := List[I].Score;
                    List[I].Score := BufI;
                    BufS := List[I].Name;
                    List[I].Name := List[J].Name;
                    List[J].Name := BufS;
                End;
            End;
        End;
    End;

    Procedure Top3Output(List: AoL; Size: Integer);
    Var
        Ind, I, J, BufOne, BufTwo: Integer;
    Begin
        Ind := 0;
        Writeln('Участники, показавшие 3 лучших результата: ');
        Writeln(List[0].Name, ' ', List[0].Score);
        For I := 0 to Size - 1 do
        Begin
            if ((List[I].Score = List[0].Score) and
              (List[I].Name <> List[0].Name)) then
            begin
                Writeln(List[I].Name, ' ', List[I].Score);
                Ind := I;
            End;
        End;
        BufOne := Ind;
        Writeln(List[Ind + 1].Name, ' ', List[Ind + 1].Score);
        For I := Ind + 1 to Size - 1 do
        begin
            If ((List[I].Score = List[Ind + 1].Score) and
              (List[I].Name <> List[Ind + 1].Name)) then
            Begin
                Writeln(List[I].Name, ' ', List[I].Score);
                Ind := I;
            End;
        End;
        BufTwo := Ind;
        If BufOne <> BufTwo then
        Begin
            Writeln(List[Ind + 1].Name, ' ', List[Ind + 1].Score);
            For I := Ind + 1 to Size - 1 do
            Begin
                If ((List[I].Score = List[Ind + 1].Score) and
                  (List[I].Name <> List[Ind + 1].Name)) then
                    Writeln(List[I].Name, ' ', List[I].Score)
            End;
        End
        Else
        Begin
            Writeln(List[Ind + 2].Name, ' ', List[Ind + 2].Score);
            For I := Ind + 2 to Size - 1 do
            Begin
                If ((List[I].Score = List[Ind + 2].Score) and
                  (List[I].Name <> List[Ind + 2].Name)) then
                Begin
                    Writeln(List[I].Name, ' ', List[I].Score)
                End;
            End
        End;
    End;

    Function IsFileCorrect(Path: String; Size: Integer): Boolean;
    Var
        ListFile: TextFile;
        I, J, Num: Integer;
        IsCorrect: Boolean;
        Buf, NumS: AnsiString;
        Letters: Set of AnsiChar;
    Begin
        AssignFile(ListFile, Path);
        Reset(ListFile);
        IsCorrect := True;
        I := 1;
        Letters := ['А' .. 'Я', 'а' .. 'я'];
        While not(SeekEof(ListFile)) and IsCorrect do
        Begin
            If I mod 2 = 1 then
            Begin
                While not(SeekEoln(ListFile)) and IsCorrect do
                Begin
                    Read(ListFile, NumS);
                    For J := 1 to Length(NumS) do
                    Begin
                        If NOT(NumS[J] in Letters) then
                        Begin
                            IsCorrect := False;
                        End;
                    End;
                End;
            End
            Else
            Begin
                While not(SeekEoln(ListFile)) and IsCorrect do
                Begin
                    Try
                        Read(ListFile, Num);
                    Except
                        IsCorrect := False;
                    End;
                End;
                Readln(ListFile);
            End;
            Inc(I);
        End;
        If I <> Size * 2 + 1 then
        Begin
            IsCorrect := False;
        End;
        CloseFile(ListFile);
        IsFileCorrect := IsCorrect;
    End;

    Function GetFilePath(): String;
    Var
        Path: String;
        IsCorrect: Boolean;
    Begin
        Repeat
            Writeln('Введите абсолютный путь к файлу ');
            Readln(Path);
            IsCorrect := False;
            If FileExists(Path) then
            Begin
                If IsFileCorrect(Path, Size) then
                    IsCorrect := True
                Else
                    Writeln('Данные в файле некорректны');
            End
            Else
                Writeln('Файл не найден');

        Until IsCorrect;
        GetFilePath := Path;
    End;

    Function GetListFromFile(List: AoL; Size: Integer): AoL;
    Var
        ListFile: TextFile;
        I: Integer;
    Begin
        Path := GetFilePath();
        AssignFile(ListFile, Path);
        Reset(ListFile);
        SetLength(List, Size);
        For I := 0 to Size - 1 do
        Begin
            Readln(ListFile, List[I].Name);
            Readln(ListFile, List[I].Score)
        End;
        CloseFile(ListFile);
        GetListFromFile := List;
    End;

    function GetList(): AoL;
    var
        SelectedInputType: InputType;
    begin
        SelectedInputType := GetInputType();
        if (SelectedInputType = InputType.FromConsole) then
        begin
            List := GetListFromConsole(List, Size)
        end
        else if (SelectedInputType = InputType.FromFile) then
        begin
            List := GetListFromFile(List, Size)
        end;
        GetList := List;
    end;

    Function Output(): String;
    Var
        Patho: String;
        IsCorrect: Boolean;
    Begin
        IsCorrect := False;
        Repeat
            Writeln('Введите директорию, в которую хотите сохранить результат');
            Readln(Patho);
            If DirectoryExists(Patho) then
                IsCorrect := True
            Else
                Writeln('Такой директории не существует. Попробуйте ещё раз');
        Until IsCorrect;
        Output := Patho;
    End;

    Procedure SaveListToFile(List: AoL);
    Var
        Ind, I, J, BufOne, BufTwo: Integer;
        OutputFile: TextFile;
        Directory: String;
    Begin
        Directory := Output();
        AssignFile(OutputFile, Directory + OutputFileName);
        Rewrite(OutputFile);
        Ind := 0;
        Writeln(OutputFile, List[0].Name, ' ', List[0].Score);
        For I := 0 to Size - 1 do
        Begin
            if ((List[I].Score = List[0].Score) and
              (List[I].Name <> List[0].Name)) then
            begin
                Writeln(OutputFile, List[I].Name, ' ', List[I].Score);
                Ind := I;
            End;
        End;
        BufOne := Ind;
        Writeln(OutputFile, List[Ind + 1].Name, ' ', List[Ind + 1].Score);
        For I := Ind + 1 to Size - 1 do
        begin
            If ((List[I].Score = List[Ind + 1].Score) and
              (List[I].Name <> List[Ind + 1].Name)) then
            Begin
                Writeln(OutputFile, List[I].Name, ' ', List[I].Score);
                Ind := I;
            End;
        End;
        BufTwo := Ind;
        If BufOne <> BufTwo then
        Begin
            Writeln(OutputFile, List[Ind + 1].Name, ' ', List[Ind + 1].Score);
            for I := Ind + 1 to Size - 1 do
                If ((List[I].Score = List[Ind + 1].Score) and
                  (List[I].Name <> List[Ind + 1].Name)) then
                    Writeln(OutputFile, List[I].Name, ' ', List[I].Score)
        End
        Else
        Begin
            Writeln(OutputFile, List[Ind + 2].Name, ' ', List[Ind + 2].Score);
            For I := Ind + 2 to Size - 1 do
            Begin
                If ((List[I].Score = List[Ind + 2].Score) and
                  (List[I].Name <> List[Ind + 2].Name)) then
                Begin
                    Writeln(OutputFile, List[I].Name, ' ', List[I].Score)
                End;
            End
        End;
        Writeln('Результат сохранён по указанному пути');
        CloseFile(OutputFile);
        Write;
    End;

    Procedure PrintListBeforeSorting(List: AoL; Size: Integer);
    Var
        I: Integer;
    Begin
        Writeln;
        Writeln('Список игроков до сортировки: ');
        for I := 0 to Size - 1 do
        Begin
            Writeln(List[I].Name, ' ', List[I].Score)
        End;
        Writeln;
    End;

    Procedure PrintListAfterSorting(List: AoL; Size: Integer);
    Var
        I: Integer;
    Begin
        Writeln('Список игроков после сортировки: ');
        for I := 0 to Size - 1 do
        Begin
            Writeln(List[I].Name, ' ', List[I].Score)
        End;
        Writeln;
    End;

Begin
    Size := GetSize(Size);
        List := GetList();
        PrintListBeforeSorting(List, Size);
        Sorting(List);
        PrintListAfterSorting(List, Size);
        Top3Output(List, Size);
        SaveListToFile(List);
        Readln;

End.