OPI laba

program bonuses;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Windows;

Type
TLetterArray = Array ['а'..'я'] of Integer;
TPlayerStringArray = Array Of String;
TScoreArray = Array of Integer;
TBonusArray = Array Of Array [0..1] Of Boolean;
Const
    StartLetterBank: TLetterArray = (8, 4, 4, 4, 4, 16, 4, 4, 8, 4, 4, 4, 4, 4, 8, 4, 4, 4, 4, 8, 4, 4, 4, 4, 4 ,4, 4, 8, 4, 8, 8, 8);
Function ExecuteBonus50(Var PlayerString: String; LetterBank: TLetterArray; PlayersScore: TScoreArray; NumberOfPlayer: Integer): Boolean;
Var
    CountLetters, CountChar, ChangeIndex: Integer;
    IsCorrect, IsOkay: Boolean;
    LettertoChange: Char;
    PlayersCopy: String;
Begin
    Randomize;
    PlayersCopy := PlayerString;
    For CountLetters:= 0 To 4 Do
        Repeat
            Writeln ('Введите букву из вашего набора, которую хотели бы заменить');
            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[Chr(ChangeIndex)] < 1) Then
                            IsOkay := False;
                    Until (IsOkay);
                    Dec(LetterBank[Chr(ChangeIndex)]);
                    PlayerString [CountChar] := Chr(ChangeIndex);
                    Break;
                End;
            If Not(IsCorrect) Then
                Writeln ('В вашем наборе отсутствует такая буква или встречается меньшее количество раз. Повторите ввод');
        Until (IsCorrect);
    Dec(PlayersScore[NumberOfPlayer], 2);
    ExecuteBonus50 := True;
End;

Function CheckIfContains (PlayerString: String; Var LetterIndex: Integer): Char;
Var
    LetterCounter: Integer;
    Letter: Char;
    IsCorrect: Boolean;
Begin
    Repeat
        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: Char;
    LetterIndexToChange, DesiredLetterIndex, OtherPlayerNumber: Integer;
Begin
    Writeln ('Введите букву из вашего набора, которую хотели бы заменить');
    LetterToChange := CheckIfContains(PlayersLetters[NumberOfPlayer], LetterIndexToChange);
    Writeln ('Введите номер игрока, с которым хотели бы обменяться');
    Repeat
        Readln(OtherPlayerNumber);
        IsCorrect := True;
        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);
    PlayersLetters[NumberOfPlayer, LetterIndexToChange] := DesiredLetter;
    PlayersLetters[OtherPlayerNumber, DesiredLetterIndex] := LetterToChange;
    ExecuteBonusHelp := True;
End;
Var
    LetterBank:  TLetterArray;
    PlayersScore: TScoreArray;
    BonusUsageArray: TBonusArray;
    PlayersLetters: TPlayerStringArray;
    NumberOfPlayer, NumberOfPlayers: Integer;
begin
    SetConsoleCP(1251);
    SetConsoleOutputCP(1251);
    SetLength(PlayersLetters, NumberOfPlayers);
    SetLength(PlayersScore, NumberOfPlayers);
    SetLength(BonusUsageArray, NumberOfPlayers);
    LetterBank := StartLetterBank;
                                   //BonusUsageArray[NumberOfPlayer, 0] 0 is for 50/50 1 is for Help
    BonusUsageArray[NumberOfPlayer, 0] := ExecuteBonus50(PlayersLetters[NumberOfPlayer], LetterBank, PlayersScore, NumberOfPlayer);
    BonusUsageArray[NumberOfPlayer, 1] := ExecuteBonusHelp(PlayersLetters, NumberOfPlayer);
    Readln
end.