Lab2_4

Program Lab2_4;

Uses
    System.SysUtils;

Type
    TMass = Array Of Array Of Double;
    TErrorCode = (CORRECT, INCORRECT_CHOISE, 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);

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 choise. 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 . Please try again. ');

Procedure ProgramTask();
Begin
    Writeln('This program removes rows containing 0 elements');
End;

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

Function IsFileTxt(PathToFile: String): TErrorCode;
Var
    ErrorCode: TErrorCode;
Begin
    ErrorCode := CORRECT;
    If (Length(PathToFile) < 5) Or (GetLastPartStr(PathToFile, Length(PathToFile) - 3, Length(PathToFile)) <> '.txt') Then
        ErrorCode := FILE_NOT_TXT;
    IsFileTxt := ErrorCode;
End;

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

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

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

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

Procedure GetFileNormalWriting(Var FileName: TextFile);
Var
    ErrorCode: TErrorCode;
    PathToFile: String;
Begin
    Repeat
        Readln(PathToFile);
        ErrorCode := IsFileTxt(PathToFile);
        If ErrorCode = CORRECT Then
        Begin
            ErrorCode := IsFileExist(PathToFile);
            AssignFile(FileName, PathToFile);
            ErrorCode := IsFileWritable(FileName);
        End;
        If ErrorCode <> CORRECT Then
            Writeln(ERR[ErrorCode]);
    Until ErrorCode = CORRECT;
End;

Function MatrixSetingFile(Var FileName: TextFile; Var Matrix: TMass; Var Size: Integer): TErrorCode;
Var
    ErrorCode: TErrorCode;
    I: Integer;
Begin
    ErrorCode := CORRECT;
    Writeln('Чтение настроек матрицы...');
    Try
        Read(FileName, Size);
    Except
        ErrorCode := READING_GO_WRONG;
    End;
    If EOF(FileName) Then
        ErrorCode := FILE_NOT_FULL;
    If (ErrorCode = CORRECT) And (Size < MIN_ARR) Or (Size > MAX_ARR) Then
        ErrorCode := OUT_OF_RANGE;
    If ErrorCode = CORRECT Then
    Begin
        SetLength(Matrix, Size);
        For I := 0 To Size - 1 Do
            SetLength(Matrix[I], Size);
    End;

    MatrixSetingFile := ErrorCode;
End;

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

Procedure ReadMatrix(Var FileName: TextFile; Var Matrix: TMass);
Var
    I, J: Integer;
    ErrorCode: TErrorCode;
Begin
    ErrorCode := CORRECT;
    For I := 0 To High(Matrix) Do
    Begin
        For J := 0 To High(Matrix[I]) Do
        Begin
            If Not EOF(FileName) Then
            Begin
                Try
                    Read(FileName, Matrix[I][J]);
                Except
                    ErrorCode := READING_GO_WRONG;
                End;
            End
            Else
                ErrorCode := FILE_NOT_FULL;
        End;
    End;
    If ErrorCode <> CORRECT Then
        WriteLn(ERR[ErrorCode]);
End;

Procedure ReadMatrixFromFile(Var Matrix: TMass; Var Size: Integer);
Var
    FileName: TextFile;
    ErrorCode: TErrorCode;
Begin
    WriteLn('Enter the path to the file with extension ".txt" with matrix dimensions and free terms from ', MIN_ARR, ' .. ', MAX_ARR);
    GetFileNormalReading(FileName);
    ErrorCode := MatrixSetingFile(FileName, Matrix, Size);

    If ErrorCode = CORRECT Then
        ReadMatrix(FileName, Matrix)
    Else
        WriteLn(ERR[ErrorCode]);
    CloseFile(FileName);
End;

Procedure ReadMatrixFromConsole(Var Matrix: TMass; Var Size: Integer);
Var
    I, J: Integer;
    ErrorCode: TErrorCode;
Begin
    MatrixSetingConsole(Matrix, Size);
    Writeln('Matrix size [', Size, ',', Size, ']');
    For I := 0 To High(Matrix) Do
    Begin
        SetLength(Matrix[I], Size);
        WriteLn('Please enter the elements for row ', I, ' (diagonal and above) through the space in the range ', MIN_COUNT:7:2, ' .. ',
            MAX_COUNT:7:2);
        For J := 0 To High(Matrix[I]) Do
        Begin
            Repeat
                ErrorCode := CORRECT;
                Try
                    Readln(Matrix[I][J]);
                Except
                    ErrorCode := NON_NUMERIC;
                End;
                If (ErrorCode = CORRECT) And ((Matrix[I][J] < MIN_COUNT) Or (Matrix[I][J] > MAX_COUNT)) Then
                    ErrorCode := OUT_OF_RANGE;
                If ErrorCode <> CORRECT Then
                    WriteLn(ERR[ErrorCode]);
            Until ErrorCode = CORRECT;
        End;

    End;
End;

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

Procedure OptionHowToRead(Var Matrix: TMass; Size: Integer);
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, Size)
    Else
        ReadMatrixFromConsole(Matrix, Size);

End;

Procedure PrintConsole(Matrix: Tmass; Var NewRowCount, Size: Integer);
Var
    I, J: Integer;
Begin
    WriteLn('Solutions:');
    For I := 0 To NewRowCount - 1 Do
    Begin
        For J := 0 To High(Matrix) Do
            Write(Matrix[I][J]:0:2, ' ');
        WriteLn;
    End;
End;

Procedure PrintFile(Matrix: Tmass; Var NewRowCount, Size: Integer);
Var
    FileName: TextFile;
    I, J: Integer;
    ErrorCode: TErrorCode;
Begin
    WriteLn('Enter the path to the file with the extension ".txt" to get the answer: ');
    GetFileNormalWriting(FileName);
    ErrorCode := IsFileWritable(FileName);

    If ErrorCode = CORRECT Then
    Begin
        Rewrite(FileName);
        WriteLn(FileName, 'Solutions:');
        For I := 0 To NewRowCount - 1 Do
        Begin
            For J := 0 To High(Matrix) Do
                Write(FileName, Matrix[I][J]:0:4, ' ');
            WriteLn(Filename);
        End;
        CloseFile(FileName);
    End
    Else
        WriteLn(ERR[ErrorCode]);
End;

Function RemoveZeroRows(Var Matrix: TMass; Var Size: Integer): Integer;
Var
    NewRowCount, I, J: Integer;
    HasZero: Boolean;
Begin
    NewRowCount := 0;
    For I := 0 To High(Matrix) Do
    Begin
        HasZero := False;
        For J := 0 To High(Matrix[I]) Do
        Begin
            If Matrix[I][J] = 0 Then
                HasZero := True;
        End;

        If Not HasZero Then
        Begin
            For J := 0 To High(Matrix[I]) Do
                Matrix[NewRowCount][J] := Matrix[I][J];
            Inc(NewRowCount);
        End;
    End;
    RemoveZeroRows := NewRowCount;
End;

Procedure PrintAnswer(Matrix: Tmass; NewRowCount, Size: Integer);
Var
    Option, I: 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, NewRowCount, Size)
    Else
        PrintConsole(Matrix, NewRowCount, Size);
End;

Var
    Matrix: TMass;
    Size, NewRowCount: Integer;

Begin
    Size := 0;
    ProgramTask();
    OptionHowToRead(Matrix, Size);
    NewRowCount := RemoveZeroRows(Matrix, Size);
    PrintAnswer(Matrix, NewRowCount, Size);
    Writeln('Press Enter to exit');
    Readln;

End.