zakaz 10_12_2020

program zakaz_10_12_2020;

uses
    System.SysUtils;

type
    TAnswer = Array [0..1] of String;

function GetInput() : String;
    var
        StrInput: String;
        IsCorrect, HasOnlySpacesOrEmpty: Boolean;
        i: Integer;

    begin
        writeln('Введите строку:');
        repeat
            IsCorrect := true;
            readln(StrInput);
            i := 1;

            HasOnlySpacesOrEmpty := True;
            while ((i <= Length(StrInput)) and HasOnlySpacesOrEmpty) do
            begin
                if (StrInput[i] <> ' ') then
                    HasOnlySpacesOrEmpty := false;
                Inc(i);
            end;


            if (HasOnlySpacesOrEmpty) then
            begin
                writeln('Строка пустая. Повторите попытку:');
                IsCorrect := false;
            end;
        until IsCorrect;

        GetInput := StrInput;
    end;

function SearchForFirstWord(StrInput: String) : String;
    var
        StrWord: String;
        ChChar: Char;
        i: Integer;
        WasNotSpace, FirstWordNotFound: Boolean;

    begin
        StrWord := '';
        WasNotSpace := false;
        FirstWordNotFound := true;

        i := 1;
        while ((i <= Length(StrInput)) and FirstWordNotFound) do
        begin
            ChChar := StrInput[i];
            if ((ChChar = ' ') or (i = Length(StrInput))) then
                begin
                    if WasNotSpace then
                    FirstWordNotFound := false;
                end
            else
            begin
                StrWord := StrWord + ChChar;
                WasNotSpace := true;
            end;
            Inc(i);
        end;

        Result := StrWord;
    end;

function SearchForLastWord(StrInput: String) : String;
    var
        StrWord: String;
        ChChar: Char;
        i: Integer;
        WasNotSpace, LastWordNotFound: Boolean;

    begin
        StrWord := '';
        WasNotSpace := false;
        LastWordNotFound := true;

        i := Length(StrInput);
        while ((i > 0) and LastWordNotFound) do
        begin
            ChChar := StrInput[i];
            if ((ChChar = ' ') or (i = 1)) then
            begin
                if WasNotSpace then
                    LastWordNotFound := false;
            end
            else
            begin
                StrWord := ChChar + StrWord;
                WasNotSpace := true;
            end;
            Dec(i);
        end;

        Result := StrWord;
    end;

function FindConsonatsInWord(StrFirstWord: String) : String;
    const
        StrConsonats = 'QWRZTPSDFGHKLXCVBNMЙЦКНГШЩЗХФВПРЛДЖЧМТБ';

    var
        i, j, z: Integer;
        StrConsonatsInFirstWord: String;
        LetterIsAlreadyInString: Boolean;

    begin
        StrConsonatsInFirstWord := '';

        for i := 1 to Length(StrFirstWord) do
            for j := 1 to Length(StrConsonats) do
                if (UpperCase(StrFirstWord[i]) = StrConsonats[j]) then
                begin
                    LetterIsAlreadyInString := false;
                    z := 1;
                    while ((z <= Length(StrConsonatsInFirstWord)) and not LetterIsAlreadyInString) do
                    begin
                        if (StrConsonats[j] = StrConsonatsInFirstWord[z]) then
                            LetterIsAlreadyInString := True;
                        Inc(z);
                    end;
                    if (not LetterIsAlreadyInString) then
                        StrConsonatsInFirstWord := StrConsonatsInFirstWord + StrConsonats[j];
                end;

        Result := StrConsonatsInFirstWord;
    end;

procedure Part1OfTask(var ArrStrAnswer: TAnswer; SWord, StrConsonatsInFirstWord, StrLastWord: String);
    var
        ConsonatsInWord: String;
        ConsonatsEquel, OneLetterEquels: Boolean;
        i, j: Integer;

    begin
        if (UpperCase(SWord) <> UpperCase(StrLastWord)) then
        begin
            ConsonatsInWord := FindConsonatsInWord(SWord);

            ConsonatsEquel := true;

            i := 1;
            while ((i <= Length(StrConsonatsInFirstWord)) and ConsonatsEquel) do
            begin
                j := 1;
                OneLetterEquels := false;
                while ((j <= Length(ConsonatsInWord)) and ConsonatsEquel and not OneLetterEquels) do
                begin
                    if (StrConsonatsInFirstWord[i] = ConsonatsInWord[j]) then
                        OneLetterEquels := true;
                    Inc(j);
                end;
                if not OneLetterEquels then
                    ConsonatsEquel := false;

                Inc(i);
            end;

            i := 1;
            while ((i <= Length(ConsonatsInWord)) and ConsonatsEquel) do
            begin
                j := 1;
                OneLetterEquels := false;
                while ((j <= Length(StrConsonatsInFirstWord)) and ConsonatsEquel and not OneLetterEquels) do
                begin
                    if (ConsonatsInWord[i] = StrConsonatsInFirstWord[j]) then
                        OneLetterEquels := true;
                    Inc(j);
                end;
                if not OneLetterEquels then
                    ConsonatsEquel := false;

                Inc(i);
            end;

            if (ConsonatsEquel) then
                ArrStrAnswer[0] := ArrStrAnswer[0] + SWord + ' ';

        end;
    end;

procedure Part2OfTask(var ArrStrAnswer: TAnswer; SWord, StrLastWord: String; var StrVocalsWhichAlreadyWereInString: String);
    const
        Vocals = 'EUIOAJYУЕЫАОЭЯИЮЁ';
    var
        i, j, k:Integer;
        VocalIsAlreadyInString, VocalFound: Boolean;
        StrWordOutput: String;

    begin
        StrWordOutput := '';
        if (UpperCase(SWord) <> UpperCase(StrLastWord)) then
        begin
            for i := 1 to Length(SWord) do
            begin
                VocalFound := false;
                j := 1;
                while ((j <= Length(Vocals)) and not VocalFound) do
                begin
                    if (UpperCase(SWord[i]) = Vocals[j]) then
                    begin
                        VocalFound := true;
                        VocalIsAlreadyInString := false;
                        k := 1;
                        while ((k <= Length(StrVocalsWhichAlreadyWereInString)) and not VocalIsAlreadyInString) do
                        begin
                            if (UpperCase(SWord[i]) = StrVocalsWhichAlreadyWereInString[k]) then
                                VocalIsAlreadyInString := true;
                            Inc(k);
                        end;

                        if not VocalIsAlreadyInString then
                        begin
                            StrVocalsWhichAlreadyWereInString := StrVocalsWhichAlreadyWereInString + Vocals[j];
                            StrWordOutput := StrWordOutput + SWord[i];
                        end;
                    end;

                    Inc(j);
                end;

                if not VocalFound then
                    StrWordOutput := StrWordOutput + SWord[i];
            end;
            ArrStrAnswer[1] := ArrStrAnswer[1] + StrWordOutput + ' ';
        end;
    end;

procedure DecideWhatToDoWithFoundWord(var ArrStrAnswer: TAnswer; SWord, StrConsonatsInFirstWord, StrLastWord: String; var StrVocalsWhichAlreadyWereInString: String);


    begin
        Part1OfTask(ArrStrAnswer, SWord, StrConsonatsInFirstWord, StrLastWord);
        Part2OfTask(ArrStrAnswer, SWord, StrLastWord, StrVocalsWhichAlreadyWereInString);
    end;

function ComputeAnswer(SInput, StrFirstWord, StrConsonatsInFirstWord, StrLastWord: String) : TAnswer;
    var
        SWord, StrVocalsWhichAlreadyWereInString: String;
        ChChar: Char;
        i: Integer;
        ArrStrAnswer: TAnswer;

    begin
        ArrStrAnswer[0] := '';
        ArrStrAnswer[1] := '';
        SWord := '';
        StrVocalsWhichAlreadyWereInString := '';

        i := 1;
        while (i <= Length(SInput)) do
        begin
            ChChar := SInput[i];
            if ((ChChar = ' ') or (i = Length(SInput))) then
            begin
                if (i = Length(SInput)) then
                    SWord := SWord + ChChar;
                DecideWhatToDoWithFoundWord(ArrStrAnswer, SWord, StrConsonatsInFirstWord, StrLastWord, StrVocalsWhichAlreadyWereInString);
                SWord := '';
            end
            else
                SWord := SWord + ChChar;
            Inc(i);
        end;
        writeln;

        Result := ArrStrAnswer;
    end;

procedure OutputAnswer(ArrStrAnswer: TAnswer);
    var
        SShouldOutputInfoToFile, SPathToFile: String;
        BOutputIsReady: Boolean;

    begin
        writeln('Ответ:' + #10 + #13 + ArrStrAnswer[0] + #10 + #13 + ArrStrAnswer[1]);
    end;

var
    StrInput, StrFirstWord, StrLastWord, StrConsonatsInFirstWord: String;
    ArrStrAnswer: TAnswer;

begin
    StrInput := GetInput();
    StrFirstWord := SearchForFirstWord(StrInput);
    StrConsonatsInFirstWord := FindConsonatsInWord(StrFirstWord);
    StrLastWord := SearchForLastWord(StrInput);

    ArrStrAnswer := ComputeAnswer(StrInput, StrFirstWord, StrConsonatsInFirstWord, StrLastWord);
    OutputAnswer(ArrStrAnswer);
    readln;
end.