Lab2_4

Program Lab2_4;

Uses
    System.SysUtils;

Type
    TMass = Array Of Array Of Double;
    TErrorCode = (CORRECT,
        INCORRECT_CHOICE,
        NON_NUMERIC,
        OUT_OF_RANGE,
        FILE_NOT_TXT,
        FILE_NOT_EXIST,
        FILE_NOT_READABLE,
        FILE_NOT_WRITABLE,
        FILE_IS_EMPTY,
        READING_GO_WRONG,
        FILE_NOT_FULL,
        TOO_MANY);

Const
    MIN_ARR = 2;
    MAX_ARR = 20;
    MAX_OPTION = 2;
    MIN_COUNT = -999.999;
    MAX_COUNT = 999.999;
    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 is empty. Please try again.',
        'Error. Reading go wrong. Please try again.',
        'Error. The file lacks sufficient information.',
        'Error. Too much information in the file. Please try again. ');

Procedure ProgramTask();
Begin
    Writeln('The real square matrix of order 2n is given.');
    Writeln('Sub-matrices of order n are indicated by numbers:');
    Writeln('|1|2|');
    Writeln('|3|4|');
    Writeln('Get new matrix');
    Writeln('|3|4|');
    Writeln('|2|1|');
End;

Function GetExtension(Var Str: String; 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 IsFileTxt(PathToFile: String): TErrorCode;
Var
    Error: TErrorCode;
    Size: Integer;
Begin
    Error := CORRECT;
    Size := Length(PathToFile);
    If (Size < 5) Or (GetExtension(PathToFile, Size - 3, Size) <> '.txt') Then
        Error := FILE_NOT_TXT;
    IsFileTxt := Error;
End;

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

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

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

Procedure GetFileNormalReading(Var FileName: TextFile);
Var
    Error: TErrorCode;
    PathToFile: String;
Begin
    Repeat
        Readln(PathToFile);
        Error := IsFileTxt(PathToFile);
        If Error = CORRECT Then
        Begin
            Error := IsFileExist(PathToFile);
            AssignFile(FileName, PathToFile);
        End;
        If Error = CORRECT Then
            Error := IsFileReadble(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 := IsFileTxt(PathToFile);
        If Error = CORRECT Then
        Begin
            Error := IsFileExist(PathToFile);
            AssignFile(FileName, PathToFile);
        End;
        If Error = CORRECT Then
            Error := IsFileWritable(FileName);
        If Error <> CORRECT Then
            Writeln(ERR[Error]);
    Until Error = CORRECT;
End;

Function MatrixSetingFile(Var FileName: TextFile; Var Matrix: TMass): TErrorCode;
Var
    Error: TErrorCode;
    Setting: Integer;
Begin
    Setting := 0;
    Writeln('Reading setings of matrix...');
    Error := CORRECT;
    Try
        Read(FileName, Setting);
    Except
        Error := READING_GO_WRONG;
    End;
    If EOF(FileName) Then
        Error := FILE_NOT_FULL;
    If (Error = CORRECT) And ((Setting < MIN_ARR) Or (Setting > MAX_ARR) Or ((Setting Mod 2) > 0)) Then
        Error := OUT_OF_RANGE;
    If Error = CORRECT Then
        SetLength(Matrix, Setting, Setting);

    MatrixSetingFile := Error;
End;

Procedure MatrixSetingConsole(Var Matrix: TMass; Var Setting: Integer);
Var
    Error: TErrorCode;
Begin
    Repeat
        Error := CORRECT;
        Writeln('Please write size of matrix in the range ', MIN_ARR, ' .. ', MAX_ARR);
        Try
            Readln(Setting);
        Except
            Error := NON_NUMERIC;
        End;
        If (Error = CORRECT) And ((Setting < MIN_ARR) Or (Setting > MAX_ARR) Or ((Setting Mod 2) > 0)) Then
            Error := OUT_OF_RANGE;
        If Error <> CORRECT Then
            Write(ERR[Error]);
    Until Error = CORRECT;
    SetLength(Matrix, Setting, Setting);
End;

Procedure ReadErrorNumConsole(Var Matrix: TMass; Var Error: TErrorCode; Const I, J: Integer);
Begin
    Writeln(ERR[Error]);
    Repeat
        Writeln('Please write the num[', I, ',', J, ']');
        Error := CORRECT;
        Try
            Readln(Matrix[I][J]);
        Except
            Error := NON_NUMERIC;
        End;
        If (Error = CORRECT) And ((Matrix[I][J] < MIN_COUNT) Or (Matrix[I][J] > MAX_COUNT)) Then
            Error := OUT_OF_RANGE;
        Write(ERR[Error]);
    Until Error = CORRECT;
End;

Procedure ReadMatrixFromFile(Var Matrix: TMass);

Var
    FileName: TextFile;
    Error: TErrorCode;
    I, J: Integer;
Begin
    Repeat
        WriteLn('Enter the path to the file with extension ".txt" with matrix length and High from ', MIN_ARR, ' .. ', MAX_ARR);
        GetFileNormalReading(FileName);
        Error := MatrixSetingFile(FileName, Matrix);
        If Error = CORRECT Then
            For I := 0 To High(Matrix) Do
                For J := 0 To High(Matrix[I]) Do
                    If Not EOF(FileName) Then
                    Begin
                        Try
                            Read(FileName, Matrix[I][J]);
                        Except
                            Error := READING_GO_WRONG;
                            ReadErrorNumConsole(Matrix, Error, I, J);
                        End;
                    End
                    Else
                    Begin
                        Error := FILE_NOT_FULL;
                        ReadErrorNumConsole(Matrix, Error, I, J);
                    End;
        If Error <> CORRECT Then
            WriteLn(ERR[Error]);
        CloseFile(FileName);
    Until Error = CORRECT;

End;

Procedure ReadColsFromConsole(Var Matrix: TMass; Const I: Integer);
Var
    Error: TErrorCode;
    J: Integer;
    Num: Double;
Begin
    WriteLn('Please enter the col ', I, ' through the space in the range ', MIN_COUNT:7:2, ' .. ', MAX_COUNT:7:2);
    Num := 0;
    For J := 0 To High(Matrix[I]) Do
        Repeat
            Error := CORRECT;
            Try
                Read(Num);
            Except
                Error := NON_NUMERIC;
            End;
            If (Error = CORRECT) And ((Num < MIN_COUNT) Or (Num > MAX_COUNT)) Then
                Error := OUT_OF_RANGE;
            If Error = CORRECT Then
                Matrix[I][J] := Num
            Else
                WriteLn(ERR[Error]);
        Until Error = CORRECT;
End;

Procedure ReadMatrixFromConsole(Var Matrix: TMass);
Var
    I, Setting: Integer;
Begin
    Setting := 0;
    MatrixSetingConsole(Matrix, Setting);
    Writeln('Matrix size [', Setting, ',', Setting, ']');
    For I := 0 To High(Matrix) Do
        ReadColsFromConsole(Matrix, I);
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 Matrix: TMass);
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
        ReadMatrixFromFile(Matrix)
    Else
        ReadMatrixFromConsole(Matrix);
End;

Procedure Swap(Var Matrix: TMass; Const I, J, K, R: Integer);
Begin
    Matrix[I][J] := Matrix[I][J] + Matrix[K][R];
    Matrix[K][R] := Matrix[I][J] - Matrix[K][R];
    Matrix[I][J] := Matrix[I][J] - Matrix[K][R];
End;

Procedure Swap1_4(Var Matrix: TMass; Const N, Part: Integer);
Var
    I, J: Integer;
Begin
    For I := N DownTo Low(Matrix) Do
        For J := N DownTo Low(Matrix) Do
            Swap(Matrix, I, J, I + Part, J + Part)
End;

Procedure Swap2_3(Var Matrix: TMass; Const N, Part: Integer);
Var
    I, J: Integer;
Begin
    For I := High(Matrix) DownTo Part Do
        For J := N DownTo Low(Matrix) Do
            Swap(Matrix, I, J, I - Part, J + Part)
End;

Procedure Swap4_3(Var Matrix: TMass; Const N, Part: Integer);
Var
    I, J: Integer;
Begin
    For I := N DownTo Low(Matrix) Do
        For J := N DownTo Low(Matrix) Do
            Swap(Matrix, I, J, I, J + Part)
End;

Procedure ChangeMatrix(Var Matrix: TMass);
Var
    N, Part: Integer;
Begin
    N := High(Matrix) Div 2;
    Part := Length(Matrix) Div 2;
    Swap1_4(Matrix, N, Part);
    Swap2_3(Matrix, N, Part);
    Swap4_3(Matrix, N, Part);
End;

Procedure PrintConsole(Const Matrix: TMass);
Var
    I, J: Integer;
Begin
    For I := Low(Matrix) To High(Matrix) Do
    Begin
        For J := Low(Matrix[0]) To High(Matrix[0]) Do
            Write(Matrix[I][J]:3:2, ' ');
        Writeln(' ');
    End;
End;

Procedure PrintFile(Const Matrix: TMass);
Var
    I, J: Integer;
    FileName: TextFile;
Begin
    WriteLn('Enter the path to the file with extension ".txt" to get answer: ');
    GetFileNormalWriting(FileName);
    Writeln(FileName);
    For I := Low(Matrix) To High(Matrix) Do
    Begin
        For J := Low(Matrix[0]) To High(Matrix[0]) Do
            Write(FileName, Matrix[I][J]:3:2, ' ');
        Writeln(FileName);
    End;
    CloseFile(FileName);
End;

Procedure PrintAnswer(Const Matrix: TMass);
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(Matrix)
    Else
        PrintConsole(Matrix);
End;

Var
    Matrix: TMass;

Begin
    ProgramTask();
    OptionHowToRead(Matrix);
    ChangeMatrix(Matrix);
    PrintAnswer(Matrix);
    Writeln('Press Enter to exit');
    Readln;

End.