эрудит епте

Program Scrabble;

Uses
    SysUtils,
    Windows;

Type
    TLetterArray = Array ['а' .. 'я'] Of Integer;
    TWordArray = Array Of AnsiString;
    TScoreArray = Array Of Integer;
    TPlayerStringArray = Array Of AnsiString;
    TBonusArray = Array Of Array [0 .. 1] Of Boolean;

Const
    //wb - префикс от Word Bank
    WbFilePath = 'WordBank.txt';
    StartLetterBank: TLetterArray = (10, 3, 4, 3, 4, 16, 4, 4, 12, 4, 4, 4, 4, 12, 16, 5, 4, 8, 8, 4, 10, 8, 2, 4, 4, 4, 4, 2, 2, 4, 5, 5);

Function CreateWordBank(): TWordArray;
Var
    WbSize, WbCount: Integer;
    WbInputWord: AnsiString;
    WbBaseFile: TextFile;
    WordBank: TWordArray;
Begin
    WbCount := 0;
    AssignFile(WbBaseFile, WbFilePath);
    Reset(WbBaseFile);
    Readln(WbBaseFile, WbSize);
    SetLength(WordBank, WbSize);
    While Not EoF(WbBaseFile) Do
    Begin
        Readln(WbBaseFile, WbInputWord);
        WordBank[WbCount] := UTF8ToAnsi(WbInputWord);
        Inc(WbCount);
    End;
    CloseFile(WbBaseFile);
    CreateWordBank := WordBank;
End;

Function InputNumberOfPlayers(): Integer;
Const
    MIN_NUM = 2;
    MAX_NUM = 6;
Var
    NumOfPlayers: Integer;
    IsInputCorrect: Boolean;
Begin
    Write('Введите количество игроков (целое число в диапазоне от 2 до 6): ');
    Repeat
        IsInputCorrect := True;
        Try
            Read(NumOfPlayers);
        Except
            IsInputCorrect := False;
            Write('Введено недопустимое значение. Повторите ввод: ');
        End;
        If IsInputCorrect And ((NumOfPlayers < MIN_NUM) Or (NumOfPlayers > MAX_NUM)) Then
        Begin
            IsInputCorrect := False;
            Write('Введено число, не входящее в диапазон допустимых значений. Повторите ввод: ');
        End;
    Until IsInputCorrect;
    InputNumberOfPlayers := NumOfPlayers;
End;

Function CheckLetterCount(PlayerString: String; LetterBank: TLetterArray): Boolean;
Var
    MissingLetters, LetterCounter: Integer;
    I: AnsiChar;
    IsEnough: Boolean;
Begin
    IsEnough := True;
    MissingLetters := 10 - Length(PlayerString);
    LetterCounter := 0;
    For I := 'а' To 'я' Do
        LetterCounter := LetterCounter + LetterBank[I];
    If MissingLetters > LetterCounter Then
        IsEnough := False;
    CheckLetterCount := IsEnough;
End;

Procedure FillPlayerString(Var TempPlayerString: AnsiString; Var LetterBank: TLetterArray);
Var
    RandomLetter: AnsiChar;
    RandomIndex, CountOfLetter: Integer;
Begin
    Randomize;
    While (Length(TempPlayerString) < 10) Do //Нужно набрать 10 букв
    Begin
        RandomIndex := Random(32) + 224;
        RandomLetter := AnsiChar(RandomIndex);
        CountOfLetter := LetterBank[RandomLetter];
        If CountOfLetter > 0 Then
        Begin
            TempPlayerString := TempPlayerString + RandomLetter;
            Dec(LetterBank[RandomLetter]);
        End;
    End;
End;

Function ReadPlayersWord(Var LetterPack: AnsiString): AnsiString;
Const
    RUS_LETTERS = ['а' .. 'я'];
    MAX_LENGTH = 10;
    MOVE_SKIP = '';
    FIFTY_FIFTY = '50';
    FRIEND_HELP = '+';
Var
    CharCount, LetterCount, FoundLetters: Integer;
    InputWord, StartPack: AnsiString;
    IsInputCorrect: Boolean;
Begin
    StartPack := LetterPack;
    Repeat
        Readln(InputWord);
        If (InputWord = '') Then
            Read(InputWord);
        IsInputCorrect := True;
        Trim(InputWord);
        If (InputWord <> FIFTY_FIFTY) And (InputWord <> FRIEND_HELP) And (InputWord <> MOVE_SKIP) Then
        Begin
            For CharCount := 1 To Length(InputWord) Do
                If Not(InputWord[CharCount] In RUS_LETTERS) Then
                    IsInputCorrect := False;
            If Not IsInputCorrect Or (Length(InputWord) > MAX_LENGTH) Then
                Write('Слово введено некорректно. Повторите ввод: ')
            Else
            Begin
                FoundLetters := 0;
                For CharCount := 1 To Length(InputWord) Do
                Begin
                    For LetterCount := 1 To High(LetterPack) Do
                        If (InputWord[CharCount] = LetterPack[LetterCount]) And (LetterPack[LetterCount] <> '0') Then
                        Begin
                            Inc(FoundLetters);
                            LetterPack[LetterCount] := '0';
                            Break;
                        End;
                End;
                If (FoundLetters <> Length(InputWord)) Then
                Begin
                    IsInputCorrect := False;
                    Write('Введено слово, не соответствующее условию игры. Повторите ввод: ');
                    LetterPack := StartPack;
                End;
            End;
        End;
    Until IsInputCorrect;
    ReadPlayersWord := InputWord;
End;

Function IsWordInBank(ExpectedWord: String; WordBank: TWordArray): Boolean;
Var
    LeftIndex, RightIndex, MiddleIndex: Integer;
    IsFound: Boolean;
Begin
    LeftIndex := 0;
    IsFound := False;
    RightIndex := High(WordBank);
    While (LeftIndex <= RightIndex) And (IsFound = False) Do
    Begin
        MiddleIndex := (LeftIndex + RightIndex) Div 2;
        If WordBank[MiddleIndex] = ExpectedWord Then
            IsFound := True
        Else
        Begin
            If WordBank[MiddleIndex] < ExpectedWord Then
                LeftIndex := MiddleIndex + 1
            Else
                RightIndex := MiddleIndex - 1;
        End;
    End;
    IsWordInBank := IsFound;
End;

//процедура очистки консоли, честно спизжена с просторов интернета
Procedure ClearConsole();
Var
    HStdOut: HWND;
    ScreenBufInfo: TConsoleScreenBufferInfo;
    Coord1: TCoord;
    Z: Integer;
Begin
    HStdOut := GetStdHandle(STD_OUTPUT_HANDLE);
    GetConsoleScreenBufferInfo(HStdOut, ScreenBufInfo);
    For Z := 1 To ScreenBufInfo.DwSize.Y Do
        WriteLn;
    Coord1.X := 0;
    Coord1.Y := 0;
    SetConsoleCursorPosition(HStdOut, Coord1);
End;

Procedure OutputMoveConditions(PlayerCount: Integer; LetterPack: AnsiString);
Var
    LetterCount: Integer;
Begin
    ClearConsole();
    Writeln('Ход игрока ', PlayerCount + 1, '.', #13#10);
    Writeln('Нажмите Enter, если вы хотите пропустить ход.');
    Writeln('Введите 50, если вы хотите использовать бонус "50/50".');
    Writeln('Введите +, если вы хотите использовать бонус "Помощь друга".', #13#10);
    Write('Ваш набор букв: [');
    //чуть более читаемый вывод набора букв
    For LetterCount := 1 To 9 Do
        Write(LetterPack[LetterCount], ', ');
    Writeln(LetterPack[10], ']', #13#10);
    Write('Введите ваше слово: ');
End;

Function ResultOfVote(PlayerCount, NumberOfPlayers: Integer): Boolean;
Const
    VOTE_FOR = 'ДА';
    VOTE_AGAINST = 'НЕТ';
Var
    VoteCount, VotesFor, MinAmountOfVotes: Integer;
    Vote: AnsiString;
    IsInputCorrect, IsVotedFor: Boolean;
Begin
    Writeln('Введите ДА, чтобы проголосовать за, и НЕТ, чтобы проголосовать против.', #13#10);
    MinAmountOfVotes := NumberOfPlayers Div 2 + NumberOfPlayers Mod 2;
    VotesFor := 1;
    Dec(NumberOfPlayers);
    For VoteCount := 0 To NumberOfPlayers Do
    Begin
        If (VoteCount <> PlayerCount) Then
        Begin
            Write('Игрок ', VoteCount + 1, ', ваш голос: ');
            Repeat
                IsInputCorrect := True;
                Readln(Vote);
                If (Vote = '') Then
                    Read(Vote);
                If (Vote <> VOTE_FOR) And (Vote <> VOTE_AGAINST) Then
                Begin
                    IsInputCorrect := False;
                    Write('Введено некорректное значение. Повторите ввод: ');
                End;
            Until IsInputCorrect;
            If (Vote = VOTE_FOR) Then
                Inc(VotesFor);
        End;
    End;
    If (VotesFor >= MinAmountOfVotes) Then
        IsVotedFor := True
    Else
        IsVotedFor := False;
    ResultOfVote := IsVotedFor;
End;

Function ExecuteBonus50(Var PlayerString: AnsiString; LetterBank: TLetterArray; PlayersScore: TScoreArray; NumberOfPlayer: Integer)
  : Boolean;
Var
    CountLetters, CountChar, ChangeIndex: Integer;
    IsCorrect, IsOkay: Boolean;
    C: Char;
    LettertoChange: AnsiString;
    PlayersCopy: AnsiString;
Begin
    Randomize;
    PlayersCopy := PlayerString;
    For CountLetters := 0 To 4 Do
        Repeat
            Writeln('Введите букву из вашего набора, которую хотели бы заменить: ');
            Readln(LetterToChange);
            If (LetterToChange = #13) Then
                Readln(LetterToChange
                );
            IsCorrect := False;
            For CountChar := 1 To 10 Do
                If (LetterToChange = PlayersCopy[CountChar]) Then
                Begin
                    IsCorrect := True;
                    PlayersCopy[CountChar] := '0';
                    Repeat
                        IsOkay := True;
                        ChangeIndex := 255 - Random(32);
                        If (LetterBank[AnsiChar(ChangeIndex)] < 1) Then
                            IsOkay := False;
                    Until (IsOkay);
                    Dec(LetterBank[AnsiChar(ChangeIndex)]);
                    PlayerString[CountChar] := AnsiChar(ChangeIndex);
                    Break;
                End;
            If Not(IsCorrect) Then
                Writeln('В вашем наборе отсутствует такая буква или встречается меньшее количество раз. Повторите ввод');
        Until (IsCorrect);
    Dec(PlayersScore[NumberOfPlayer], 2);
    ExecuteBonus50 := True;
End;

Function CheckIfContains(PlayerString: AnsiString; Var LetterIndex: Integer; NumberOfPlayer: Integer): AnsiChar;
Var
    LetterCounter: Integer;
    Letter: AnsiChar;
    IsCorrect: Boolean;
Begin
    Repeat
        Readln(Letter);
        If (Letter = #13) Then
            Readln(Letter);
        IsCorrect := False;
        For LetterCounter := 1 To 10 Do
            If (Letter = PlayerString[LetterCounter]) Then
            Begin
                IsCorrect := True;
                LetterIndex := LetterCounter;
            End;
        If Not(IsCorrect) Then
            Writeln('В наборе отсутствует такая буква. Повторите ввод: ');
    Until (IsCorrect);
    CheckIfContains := Letter;
End;

Function ExecuteBonusHelp(PlayersLetters: TPlayerStringArray; NumberOfPlayer: Integer): Boolean;
Var
    IsCorrect: Boolean;
    LetterToChange, DesiredLetter: AnsiChar;
    LetterIndexToChange, DesiredLetterIndex, OtherPlayerNumber: Integer;
Begin
    Writeln('Введите букву из вашего набора, которую хотели бы заменить: ');
    LetterToChange := CheckIfContains(PlayersLetters[NumberOfPlayer], LetterIndexToChange, NumberOfPlayer);
    Writeln('Введите номер игрока, с которым хотели бы обменяться: ');
    Repeat
        Readln(OtherPlayerNumber);
        IsCorrect := True;
        Dec(OtherPlayerNumber);
        If (OtherPlayerNumber = NumberOfPlayer) Then
        Begin
            Writeln('Вы не можете меняться с самим собой. Повторите ввод:');
            IsCorrect := False;
        End;
        If (OtherPlayerNumber > High(PlayersLetters)) Then
        Begin
            Writeln('Такого игрока не существует. Повторите ввод');
            IsCorrect := False;
        End;
    Until (IsCorrect);
    Writeln('Введите букву из чужого набора, на которую хотели бы заменить');
    DesiredLetter := CheckIfContains(PlayersLetters[OtherPlayerNumber], DesiredLetterIndex, OtherPlayerNumber);
    PlayersLetters[NumberOfPlayer, LetterIndexToChange] := DesiredLetter;
    PlayersLetters[OtherPlayerNumber, DesiredLetterIndex] := LetterToChange;
    ExecuteBonusHelp := True;
End;

Procedure PlayGame(Var WordBank: TWordArray; Var NumberOfPlayers: Integer; Var PlayersScore: TScoreArray; BonusUsageArray: TBonusArray);
Const
    MOVE_SKIP = '';
    FIFTY_FIFTY = '50';
    FRIEND_HELP = '+';
Var
    LastLetter: AnsiChar;
    PlayerCount, SkippedMoves, HelpCount, HelpHelpCount, RandomIndex: Integer;
    IsWordCorrect, IsVotedFor, IsGameOver: Boolean;
    InputWord: AnsiString;
    LetterBank: TLetterArray;
    PlayersLetters: TPlayerStringArray;
Begin
    Randomize;
    LastLetter := #0;
    InputWord := '';
    SetLength(PlayersLetters, NumberOfPlayers);
    SetLength(PlayersScore, NumberOfPlayers);
    SetLength(BonusUsageArray, NumberOfPlayers);
    LetterBank := StartLetterBank;
    IsGameOver := False;
    Repeat
        SkippedMoves := 0;
        //заполняются наборы букв
        For PlayerCount := 0 To High(PlayersLetters) Do
            FillPlayerString(PlayersLetters[PlayerCount], LetterBank);
        //цикл ходов игроков в рамках одного хода игры
        For PlayerCount := 0 To High(PlayersScore) Do
        Begin
            For HelpCount := 0 To High(PlayersLetters) Do
                For HelpHelpCount := 1 To Length(PlayersLetters[HelpCount]) Do
                    If (PlayersLetters[HelpCount][HelpHelpCount] = '0') Then
                    Begin
                        RandomIndex := Random(32) + 224;
                        PlayersLetters[HelpCount][HelpHelpCount] := AnsiChar(RandomIndex);
                    End;
            OutputMoveConditions(PlayerCount, PlayersLetters[PlayerCount]);
            InputWord := ReadPlayersWord(PlayersLetters[PlayerCount]);
            If (InputWord = MOVE_SKIP) Then
                Inc(SkippedMoves)
            Else
            Begin
                If (InputWord = FIFTY_FIFTY) Then
                Begin
                    If (BonusUsageArray[PlayerCount, 0]) Then
                        Writeln('Вы уже использовали этот бонус.')
                    Else
                        BonusUsageArray[PlayerCount, 0] := ExecuteBonus50(PlayersLetters[PlayerCount], LetterBank, PlayersScore,
                          PlayerCount);
                End
                Else
                Begin
                    If (InputWord = FRIEND_HELP) Then
                    Begin
                        If (BonusUsageArray[PlayerCount, 0]) Then
                            Writeln('Вы уже использовали этот бонус.')
                        Else
                        Begin
                            For HelpCount := 0 To High(PlayersLetters) Do
                                If (HelpCount <> PlayerCount) Then
                                    Writeln('Набор игрока ', HelpCount + 1, ': [', PlayersLetters[HelpCount], '].');
                            BonusUsageArray[PlayerCount, 1] := ExecuteBonusHelp(PlayersLetters, PlayerCount);
                        End;
                    End
                    Else
                    Begin
                        IsWordCorrect := IsWordInBank(InputWord, WordBank);
                        If IsWordCorrect Then
                        Begin
                            If (InputWord[1] = LastLetter) Then
                                PlayersScore[PlayerCount] := 2 * (PlayersScore[PlayerCount] + Length(InputWord))
                            Else
                                PlayersScore[PlayerCount] := PlayersScore[PlayerCount] + Length(InputWord);
                            Writeln(#13#10, 'Слово верное! Ваш счёт: ', PlayersScore[PlayerCount]);
                        End
                        Else
                        Begin
                            Writeln(#13#10, 'Голосование: добавлять ли слово "', InputWord, '" в Банк Слов?');
                            IsVotedFor := ResultOfVote(PlayerCount, Length(PlayersScore));
                            If IsVotedFor Then
                            Begin
                                If (InputWord[1] = LastLetter) Then
                                    PlayersScore[PlayerCount] := 2 * (PlayersScore[PlayerCount] + Length(InputWord))
                                Else
                                    PlayersScore[PlayerCount] := PlayersScore[PlayerCount] + Length(InputWord);
                                //сюда вставить функцию добавления слова в Банк Букв
                                Writeln(#13#10, 'Слово внесено в Банк Слов! Ваш счёт: ', PlayersScore[PlayerCount]);
                            End
                            Else
                            Begin
                                PlayersScore[PlayerCount] := PlayersScore[PlayerCount] + (-1) * Length(InputWord);
                                Writeln(#13#10, 'Слово не внесено в Банк Слов. Ваш счёт: ', PlayersScore[PlayerCount]);
                            End;
                        End;
                    End;
                End;
                Writeln(#13#10, 'Нажмите Enter, чтобы перейти к следующему ходу.');
                Readln;
                //такие убогие условия иногда встречаются, какая-то проблема с самым первым считыванием
                If (LastLetter = #0) Then
                    Readln;
                LastLetter := InputWord[Length(InputWord)];
            End;
        End;
        If (SkippedMoves = Length(PlayersScore)) Then
            IsGameOver := True;
        If (SkippedMoves = Length(PlayersScore)) And (LastLetter = #0) Then
            NumberOfPlayers := -1;
    Until IsGameOver;
End;

Procedure FindWinner(AmountOfPlayers: Integer; Var PlayerScore: TScoreArray);
Var
    NumberOfPlayer, Max, WinnerNumber: Integer;
Begin
    ClearConsole;
    If (AmountOfPlayers <> -1) Then
    Begin
        Max := PlayerScore[0];
        WinnerNumber := 0;
        For NumberOfPlayer := 1 To High(PlayerScore) Do
        Begin
            If PlayerScore[NumberOfPlayer] > Max Then
            Begin
                Max := PlayerScore[NumberOfPlayer];
                WinnerNumber := NumberOfPlayer;
            End;
        End;
        Writeln('Игра завершена! Победитель - игрок под номером ', WinnerNumber + 1, ' со счётом ', Max, '.');
        Writeln(#13#10, 'Поздравляем!', #13#10, #13#10, 'Нажмите Enter, чтобы выйти из игры.');
    End
    Else
    Begin
        Writeln('Не было сделано ни одного хода. Игра завершена.');
        Writeln(#13#10, 'Нажмите Enter, чтобы выйти из игры.');
    End;
    Readln;
End;

Var
    WordBank: TWordArray;
    NumberOfPlayers: Integer;
    PlayersScore: TScoreArray;
    BonusUsageArray: TBonusArray;

Begin
    WordBank := CreateWordBank();
    NumberOfPlayers := InputNumberOfPlayers();
    PlayGame(WordBank, NumberOfPlayers, PlayersScore, BonusUsageArray);
    FindWinner(NumberOfPlayers, PlayersScore);
    Readln;

End.