Lab3_1

Program Lab3_1;

Uses
    System.SysUtils;

Type
    TMatrix = Array of Array of Integer;
    TStrings = Array of String;
    TErrorCode = (CORRECT,
                  INCORRECT_CHOICE,
                  NON_NUMERIC,
                  OUT_OF_RANGE,
                  FILE_NOT_TXT,
                  FILE_NOT_EXIST,
                  FILE_NOT_READABLE,
                  FILE_NOT_WRITABLE,
                  FILE_NOT_CLOSE,
                  FILE_IS_EMPTY,
                  READING_GO_WRONG,
                  FILE_NOT_FULL,
                  STRING_OUT_OF_RANGE);

Const
    MIN_EXT = 5;
    MIN_LEN = 1;
    MAX_LEN = 32;
    MIN_TEXT = 1;
    MAX_TEXT = 255;
    MAX_OPTION = 2;
    Err: Array [TErrorCode] Of String = ('',
                                         'Error. Incorrect choice. Please try again.',
                                         'Error. Non-numeric value. Please try again. ',
                                         'Error. Out of Range. Please try again. ',
                                         'Error. File not .txt. Please try again', 'Error. File not Exist. Please try again.',
                                         'Error. File not readable. Please try again.',
                                         'Error. File not writable. Please try again.',
                                         'Error. File not closeble. Please try again.',
                                         'Error. File is empty. Please try again.',
                                         'Error. Reading go wrong. Please try again.',
                                         'Error. The file lacks sufficient information.',
                                         'Error. String out of Range. Please try again. ');

Procedure ProgramTask();
Begin
    Writeln('This program "recodes" russian text according to the transcoding ', #13#10, 'table specified by two lines st1 and st2.');
End;

Function GetExtension(Const Str: String; Const PosStart, PosEnd: Integer): String;
Var
    I: Integer;
    PartStr: String;
Begin
    PartStr := '';
    For I := PosStart To PosEnd Do
        PartStr := PartStr + Str[I];
    GetExtension := PartStr;
End;

Function DoesFileTxt(Const PathToFile: String): TErrorCode;
Var
    Error: TErrorCode;
    Len: Integer;
Begin
    Error := CORRECT;
    Len := Length(PathToFile);
    If (Len < MIN_EXT) Or (GetExtension(PathToFile, Len - 3, Len) <> '.txt') Then
        Error := FILE_NOT_TXT;
    DoesFileTxt := Error;
End;

Function DoesFileExist(Const PathToFile: String): TErrorCode;
Var
    Error: TErrorCode;
Begin
    Error := CORRECT;
    If Not FileExists(PathToFile) Then
        Error := FILE_NOT_EXIST;
    DoesFileExist := Error;
End;

Function DoesFileReadable(Var FileName: TextFile): TErrorCode;
Var
    Error: TErrorCode;
Begin
    Error := CORRECT;
    Try
        Reset(FileName);
    Except
        Error := FILE_NOT_READABLE
    End;
    DoesFileReadable := Error;
End;

Function DoesFileWritable(Var FileName: TextFile): TErrorCode;
Var
    Error: TErrorCode;
Begin
    Error := CORRECT;
    Try
        Append(FileName);
    Except
        Error := FILE_NOT_WRITABLE;
    End;
    DoesFileWritable := Error;
End;

Function DoesFileCloseable(Var FileName: TextFile): TErrorCode;
Var
    Error: TErrorCode;
Begin
    Error := CORRECT;
    Try
        CloseFile(FileName);
    Except
        Error := FILE_NOT_CLOSE
    End;
    DoesFileCloseable := Error;
End;

Procedure GetFileNormalReading(Var FileName: TextFile);
Var
    Error: TErrorCode;
    PathToFile: String;
Begin
    Repeat
        Readln(PathToFile);
        Error := DoesFileTxt(PathToFile);
        If Error = CORRECT Then
        Begin
            Error := DoesFileExist(PathToFile);
            AssignFile(FileName, PathToFile);
        End;
        If Error = CORRECT Then
            Error := DoesFileReadable(FileName);
        If (Error = CORRECT) And (EOF(FileName)) Then
            Error := FILE_IS_EMPTY;
        If Error <> CORRECT Then
            Writeln(ERR[Error]);
    Until Error = CORRECT;
End;

Procedure GetFileNormalWriting(Var FileName: TextFile);
Var
    Error: TErrorCode;
    PathToFile: String;
Begin
    Repeat
        Readln(PathToFile);
        Error := DoesFileTxt(PathToFile);
        If Error = CORRECT Then
        Begin
            Error := DoesFileExist(PathToFile);
            AssignFile(FileName, PathToFile);
        End;
        If Error = CORRECT Then
            Error := DoesFileWritable(FileName);
        If Error <> CORRECT Then
            Writeln(ERR[Error]);
    Until Error = CORRECT;
End;

Function ReadStringFromConsole(Const MIN_COUNT, MAX_COUNT: Integer): String;
Var
    Str: String;
    Error: TErrorCode;
Begin
    Repeat
        Error := CORRECT;
        Readln(Str);
        If (Length(Str) < MIN_LEN) Or (Length(Str) > MAX_LEN) Then
            Error := STRING_OUT_OF_RANGE;
        If Error <> CORRECT Then
            Write(ERR[Error]);
    Until Error = CORRECT;
    ReadStringFromConsole := Str;
End;

Function ReadStringFromFile(Const I: Integer; Var FileName: TextFile; Const MIN_COUNT, MAX_COUNT: Integer): String;
Var
    Str: String;
    Error: TErrorCode;
Begin
    Repeat
        Error := CORRECT;
        ReadLn(FileName, Str);
        If (Length(Str) < MIN_COUNT) Or (Length(Str) > MAX_COUNT) Then
            Error := STRING_OUT_OF_RANGE;
        If Error <> CORRECT Then
        Begin
            Write(ERR[Error]);
            Writeln('Please write string(', I, ')');
            Str := ReadStringFromConsole(MIN_COUNT, MAX_COUNT);
        End;
    Until Error = CORRECT;
    ReadStringFromFile := Str;
End;

Function FindFileStringNumber(Var FileName: TextFile): Integer;
Var
    Counter: Integer;
Begin
    Counter := 0;
    While Not EOF(FileName) Do
    Begin
        Readln(FileName);
        Inc(Counter);
    End;
    FindFileStringNumber := Counter;
End;

Procedure ReadInformationFromFile(Var Str1, Str2: String; Var Text: TStrings);

Var
    Counter, I: Integer;
    FileName: TextFile;
    Error: TErrorCode;
Begin
    Repeat
        WriteLn('Enter the path to the file with extension ".txt", text and strings: st1, st2 - the transcoding table');
        Error := CORRECT;
        GetFileNormalReading(FileName);
        Counter := FindFileStringNumber(FileName);
        If Counter < 3 Then
            Error := FILE_NOT_FULL
        Else
        Begin
            Setlength(Text, Counter - 2);
            Error := DoesFileReadable(FileName);
        End;
        If Error = CORRECT Then
        Begin
            For I := Low(Text) To High(Text) Do
                Text[I] := ReadStringFromFile(I, FileName, MIN_TEXT, MAX_TEXT);
            Str1 := ReadStringFromFile(1, FileName, MIN_LEN, MAX_LEN);
            Str2 := ReadStringFromFile(2, FileName, MIN_LEN, MAX_LEN);
        End;
        If Length(Str1) <> Length(Str2) Then
            Error := OUT_OF_RANGE;
        Error := DoesFileCloseable(FileName);
        If Error <> CORRECT Then
            Writeln(ERR[Error]);
    Until Error = CORRECT;
End;

Procedure ReadInformationFromConsole(Var Str1, Str2: String; Var Text: TStrings);
Var
    Error: TErrorCode;
    I: Integer;
    DoesReading: Boolean;
Begin
    Setlength(Text, 1);
    DoesReading := True;
    Writeln('Please write text, but at the end insert special symbol "\0"');
    Repeat
        I := 0;
        Error := CORRECT;
        While DoesReading Do
        Begin
            Text[I] := ReadStringFromConsole(MIN_LEN, MAX_LEN);
            If Text[I] = '\0' Then
            Begin
                DoesReading := False;
                Text[I] := '';
            End;
            Inc(I);
            Setlength(Text, I + 1);
        End;
        Writeln('Please write string: st1 - the transcoding table');
        Str1 := ReadStringFromConsole(MIN_LEN, MAX_LEN);
        Writeln('Please write string: st2 - the transcoding table');
        Str2 := ReadStringFromConsole(MIN_LEN, MAX_LEN);
        If Length(Str1) <> Length(Str2) Then
            Error := OUT_OF_RANGE;
        If Error <> CORRECT Then
            Writeln(ERR[Error]);
    Until Error = CORRECT;
End;

Function ToUpperCase(Ch: Char): Char;
Var
    Answer: Char;
Begin
    Answer := Ch;
    If (Ch = 'ё') Then
        Answer := 'Ё';
    If (Ch >= 'а') And (Ch <= 'я') Then
        Answer := Chr(Ord(Ch) - (Ord('а') - Ord('А')));
    If (Ch >= 'a') And (Ch <= 'z') Then
        Answer := Chr(Ord(Ch) - (Ord('a') - Ord('A')));
    ToUpperCase := Answer;
End;

Procedure Recoding(Const Str1, Str2: String; Var Text: TStrings; Var Points: TMatrix);
Var
    I, J, K, R: Integer;
    DoesExist: Boolean;
Begin
    R := 0;
    Setlength(Points, 1, 3);
    For I := Low(Text) To High(Text) Do
        For J := 1 To Length(Text[I]) Do
        Begin
            DoesExist := False;
            For K := 1 To Length(Str1) Do
                If (Not DoesExist) And ((Text[I][J] = Str1[K])) Then
                Begin
                    Points[R][0] := J;
                    Points[R][1] := K;
                    Points[R][2] := I;
                    Inc(R);
                    Setlength(Points, R + 1, 3);
                    Text[I][J] := Str2[K];
                    DoesExist := True;
                End
                Else
                    If (Not DoesExist) And (Text[I][J] = ToUpperCase(Str1[K])) Then
                    Begin
                        Points[R][0] := J;
                        Points[R][1] := K;
                        Points[R][2] := I;
                        Inc(R);
                        Setlength(Points, R + 1, 3);
                        Text[I][J] := ToUpperCase(Str2[K]);
                        DoesExist := True;
                    End;
        End;
End;

Procedure Decoding(Const Str1, Str2: String; Var Text: TStrings; Const Points: TMatrix);
Var
     J, Length: Integer;
Begin
    Length := High(Points) - 1;
        For J := Low(Points) To Length Do
        Begin
            If (Text[Points[J][2]][Points[J][0]] = Str2[Points[J][1]]) Then
                Text[Points[J][2]][Points[J][0]] := Str1[Points[J][1]]
            Else
                If (Text[Points[J][2]][Points[J][0]] = ToUpperCase(Str2[Points[J][1]])) Then
                    Text[Points[J][2]][Points[J][0]] := ToUpperCase(Str1[Points[J][1]])
        End;
End;

Function OptionRead(): Integer;
Var
    Error: TErrorCode;
    Option: Integer;
Begin
    Option := 0;
    Repeat
        Error := CORRECT;
        Try
            Readln(Option);
        Except
            Error := NON_NUMERIC;
        End;
        If (Error = CORRECT) And ((Option < 1) Or (Option > MAX_OPTION)) Then
            Error := INCORRECT_CHOICE;
        If Error <> CORRECT Then
            Write(ERR[Error]);
    Until Error = CORRECT;
    OptionRead := Option;
End;

Procedure OptionHowToRead(Var Str1, Str2: String; Var Text: TStrings);
Var
    Option: Integer;
Begin
    Writeln('If you want to read from console enter: 1');
    Writeln('If you want to read from File enter:    2');
    Option := OptionRead();
    If Option = 2 Then
        ReadInformationFromFile(Str1, Str2, Text)
    Else
        ReadInformationFromConsole(Str1, Str2, Text)
End;

Procedure PrintConsole(Var Text: TStrings; Const J: Integer);
Var
    I: Integer;
Begin
    If J = 1 Then
        WriteLn('Recoded text:')
    Else
        Writeln('Decoded text');
    For I := Low(Text) To High(Text) Do
        WriteLn(Text[I]);
End;

Procedure PrintFile(Var Text: TStrings; Const J: Integer);
Var
    FileName: TextFile;
    Error: TErrorCode;
    I: Integer;
Begin
    Repeat
        WriteLn('Enter the path to the file with extension ".txt" to get answer: ');
        GetFileNormalWriting(FileName);
        Writeln(FileName);
        If J = 1 Then

            Writeln(FileName, 'Recoded text:')
        Else
            Writeln(FileName, 'Decoded text:');
        For I := Low(Text) To High(Text) Do
            WriteLn(FileName, Text[I]);
        Error := DoesFileCloseable(FileName);
        If Error <> CORRECT Then
            Writeln(ERR[Error]);
    Until Error = CORRECT;
End;

Procedure PrintAnswer(Var Text: TStrings; Const I: Integer);
Var
    Option: Integer;
Begin
    Writeln('If you want to print answer in console enter: 1');
    Writeln('If you want to print answer in File enter:    2');
    Option := OptionRead();
    If Option = 2 Then
        PrintFile(Text, I)
    Else
        PrintConsole(Text, I);
End;

Var
    Str1, Str2: String;
    Text: TStrings;
    Points: TMatrix;

Begin
    ProgramTask();
    OptionHowToRead(Str1, Str2, Text);
    Recoding(Str1, Str2, Text, Points);
    Writeln('Recoded text');
    PrintAnswer(Text, 1);
    Decoding(Str1, Str2, Text, Points);
    Writeln('Decoded text');
    PrintAnswer(Text, 2);
    Writeln('Press Enter to exit');
    Readln;

End.