Lab3_1

Program Lab3_1;

Uses
    System.SysUtils;

Type
    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_CLOSE, STRING_OUT_OF_RANGE);

Const
    MIN_LEN = 1;
    MAX_LEN = 50;
    MAX_OPTION = 2;
    MIN_OPTION = 1;
    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 does 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 went wrong. Please try again.',
        'Error. File not closable. Please try again.',
        'Error. String out of Range. Please try again.');

Procedure ProgramTask();
Begin
    Writeln('This program searches for the shortest word in a sentence and indicates the position at which it begins.');
End;

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

Function IsFileTxt(PathToFile: String): TErrorCode;
Var
    ErrorCode: TErrorCode;
Begin
    ErrorCode := CORRECT;
    If (Length(PathToFile) < 5) Or (ExtractSubstring(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 IsFileReadable(Var FileName: TextFile): TErrorCode;
Var
    ErrorCode: TErrorCode;
Begin
    ErrorCode := CORRECT;
    Try
        Reset(FileName);
    Except
        ErrorCode := FILE_NOT_READABLE
    End;
    IsFileReadable := 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;

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

Procedure GetInputFilePath(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 := IsFileReadable(FileName);
        If (Error = CORRECT) And (EOF(FileName)) Then
            Error := FILE_IS_EMPTY;
        If Error <> CORRECT Then
            Writeln(ERR[Error]);
    Until Error = CORRECT;
End;

Procedure GetOutputFilePath(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 ReadStringFromConsole(): String;
Var
    Str: String;
    ErrorCode: TErrorCode;
Begin
    Repeat
        ErrorCode := CORRECT;
        Writeln('Enter a sentence: ');
        Readln(Str);
        If (Length(Str) < MIN_LEN) Or (Length(Str) > MAX_LEN) Then
            ErrorCode := STRING_OUT_OF_RANGE;
        If ErrorCode <> CORRECT Then
            Write(ERR[ErrorCode]);
    Until ErrorCode = CORRECT;
    ReadStringFromConsole := Str;
End;

Function ReadStringFromFile(Var FileName: TextFile): String;
Var
    Str: String;
    ErrorCode: TErrorCode;
Begin
    Writeln('Enter the path to the file with the extension ".txt" to record the result: ');
    GetInputFilePath(FileName);
    ErrorCode := CORRECT;
    Try
        ReadLn(FileName, Str);
    Except
        ErrorCode := READING_GO_WRONG;
    End;
    If ErrorCode = CORRECT Then
    Begin
        If (Length(Str) < MIN_LEN) Or (Length(Str) > MAX_LEN) Then
            ErrorCode := STRING_OUT_OF_RANGE;
    End;
    If ErrorCode <> CORRECT Then
    Begin
        Writeln(ERR[ErrorCode]);
        Str := ReadStringFromConsole();
    End;
    ErrorCode := IsFileCloseable(FileName);
    ReadStringFromFile := Str;
End;

Function IsDelimiter(Ch: Char): Boolean;
Begin
    IsDelimiter := CharInSet(Ch, [' ', ',', '.', '!', '?', ';', ':', '-', '"']);
End;

Procedure FindShortestWords(Sentence: String; Var ShortestWords: String; Var Positions: Array Of Integer; Var PositionCount: Integer);
Var
    CurrentPos, WordLength, WordStart: Integer;
    Word: String;
Begin
    CurrentPos := 1;
    Word := '';
    ShortestWords := '';
    WordLength := MAX_LEN;
    WordStart := 1;
    PositionCount := 0;

    While CurrentPos <= Length(Sentence) Do
    Begin
        If Not IsDelimiter(Sentence[CurrentPos]) Then
        Begin
            If Word = '' Then
                WordStart := CurrentPos;
            Word := Word + Sentence[CurrentPos];
        End
        Else
        Begin
            If (WordLength > Length(Word)) And (Word <> '') Then
            Begin
                ShortestWords := Word;
                WordLength := Length(ShortestWords);
                Positions[0] := WordStart;
                PositionCount := 1;
            End
            Else
            Begin
                If (WordLength = Length(Word)) Then
                Begin
                    ShortestWords := ShortestWords + ' ' + Word;
                    Positions[PositionCount] := WordStart;
                    Inc(PositionCount);
                End;
            End;
            Word := '';
        End;
        Inc(CurrentPos);
    End;
    If (Word <> '') Then
    Begin
        If (WordLength > Length(Word)) Then
        Begin
            ShortestWords := Word;
            WordLength := Length(ShortestWords);
            Positions[0] := WordStart;
            PositionCount := 1;
        End
        Else
            If (WordLength = Length(Word)) Then
            Begin
                ShortestWords := ShortestWords + ' ' + Word;
                Positions[PositionCount] := WordStart;
                Inc(PositionCount);
            End;
    End;
End;

Function GetUserOption(): 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 < MIN_OPTION) Or (Option > MAX_OPTION)) Then
            ErrorCode := INCORRECT_CHOICE;
        If ErrorCode <> CORRECT Then
            Write(ERR[ErrorCode]);
    Until ErrorCode = CORRECT;
    GetUserOption := Option;
End;

Procedure ChooseInputMethod(Var Sentence: String; Var FileName: TextFile);
Var
    Option: Integer;
Begin
    Writeln('If you want to enter a sentence from the console, enter: 1');
    Writeln('If you want to read from a file, enter: 2');
    Option := GetUserOption();
    If Option = 1 Then
        Sentence := ReadStringFromConsole()
    Else
        Sentence := ReadStringFromFile(FileName);
End;

Procedure PrintConsole(Sentence: String);
Var
    ShortestWords: String;
    Positions: Array Of Integer;
    PositionCount, I: Integer;
Begin
    ShortestWords := '';
    SetLength(Positions, MAX_LEN);
    FindShortestWords(Sentence, ShortestWords, Positions, PositionCount);
    Writeln('Shortest word(s): ', ShortestWords);
    Writeln('Positions: ');
    For I := 0 To PositionCount - 1 Do
        Writeln(Positions[I]);
End;

Procedure PrintFile(Sentence: String);
Var
    FileName: TextFile;
    ShortestWords: String;
    Positions: Array Of Integer;
    PositionCount, I: Integer;
    ErrorCode: TErrorCode;
Begin
    WriteLn('Enter the path to the file with the extension ".txt" to record the result:');
    GetOutputFilePath(FileName);
    ErrorCode := IsFileWritable(FileName);

    If ErrorCode = CORRECT Then
    Begin
        Rewrite(FileName);
        SetLength(Positions, MAX_LEN);
        FindShortestWords(Sentence, ShortestWords, Positions, PositionCount);
        Writeln(FileName, 'Shortest word(s): ', ShortestWords);
        Writeln(FileName, 'Positions: ');
        For I := 0 To PositionCount - 1 Do
            Writeln(FileName, Positions[I]);
        ErrorCode := IsFileCloseable(FileName);
    End
    Else
        WriteLn(ERR[ErrorCode]);
End;

Procedure PrintAnswer(Sentence: String);
Var
    Option: Integer;
Begin
    Writeln('If you want to print the answer to the console, enter: 1');
    Writeln('If you want to output the answer to a file, enter: 2');
    Option := GetUserOption();
    If Option = 1 Then
        PrintConsole(Sentence)
    Else
        PrintFile(Sentence);
End;

Var
    Option: Integer;
    Sentence: String;
    FileName: TextFile;

Begin
    ProgramTask();
    ChooseInputMethod(Sentence, FileName);
    PrintAnswer(Sentence);
    Readln;
End.