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 (var 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.