program Lab3_1;
{$APPTYPE CONSOLE}
uses
  System.SysUtils;
type
   TIntArray = Array of Integer;

procedure ChooseInOutType(var InOutType: Boolean; MessageType: String);
var
   TypedLetter: Char;
   IsCorrectAnswer: Boolean;
begin
   if (MessageType = 'in') then
      Writeln('В случае, если вы хотите ввести строку из файла, введите F. Если же вы хотите ввести строку из консоли, введите C.')
   else
      if (MessageType = 'out') then
         Writeln('В случае, если вы хотите произвести вывод в файл, введите F. Если же вы хотите произвести вывод только на экран, введите C.');
   IsCorrectAnswer := false;
   repeat
      Readln(TypedLetter);
      TypedLetter := UpCase(TypedLetter);
      if (TypedLetter = 'F') then
      begin
         InOutType := true;
         IsCorrectAnswer := true;
      end
      else
         if (TypedLetter = 'C') then
         begin
            InOutType := false;
            IsCorrectAnswer := true;
         end
      else
      begin
         Writeln('Ошибка. Был введён некорректный ответ. Повторите попытку.');
         IsCorrectAnswer := false;
      end;
   until (IsCorrectAnswer);
end;

function ReadStringFromFile(SourceFileName: String): String;
var
   InputSource: TextFile;
   InputString: String;
   i: Integer;
begin
   AssignFile(InputSource, SourceFileName);
   Reset(InputSource);
   Read(InputSource, InputString);
   CloseFile(InputSource);
   ReadStringFromFile := InputString;
end;

procedure DeleteExcessSpaces(var BrokenString: String);
var
   i: Integer;
begin
   for i := 1 to (High(BrokenString) - 1) do
      if (BrokenString[i] = ' ') then
         while (BrokenString[i+1] = ' ') do
         begin
            delete(BrokenString, i+1, 1);
         end;
   if (BrokenString[High(BrokenString)] = ' ') then
      delete(BrokenString, High(BrokenString), 1);
end;

function CountStrNums(InputString: String): Integer;
var
   i, NumsCount: Integer;
begin
   NumsCount := 1;
   for i := 1 to High(InputString) do
      if (InputString[i] = ' ') then
         inc(NumsCount);
   CountStrNums := NumsCount;
end;

function BreakStringIntoArray(InputString: String; NumbersCount: Integer): TIntArray;
var
   FillingArray: TIntArray;
   i, PrevSpace: Integer;
begin
   SetLength(FillingArray, NumbersCount);
   for i := 0 to High(FillingArray) - 1 do
   begin
      FillingArray[i] := StrToInt(Copy(InputString, 1, pos(' ', InputString) - 1));
      Delete(InputString, 1, pos(' ', InputString));
   end;
   FillingArray[High(FillingArray)] := StrToInt(Copy(InputString, 1, high(InputString)));
   BreakStringIntoArray := FillingArray;
end;

function DecToRoman(DecNumber: Integer): String;
const
   DecDigits: Array[1..13] of Integer = (1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000);
   RomanDigits: Array[1..13] of String = ('I', 'IV', 'V', 'IX', 'X', 'XL', 'L', 'XC', 'C', 'CD', 'D', 'CM', 'M');
var
   i: Integer;
   StrResult: String;
begin
   i := 13;
   StrResult := ' ';
   while (DecNumber > 0) do
      if (DecDigits[i] > DecNumber) then
         dec(i)
      else
      begin
         DecNumber := DecNumber - DecDigits[i];
         StrResult := StrResult + RomanDigits[i];
      end;
   DecToRoman :=  StrResult;
end;

function ReadNumberString(): String;
const
   Digits: Set of Char = ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9'];
var
   i, k, StrLength: Integer;
   InputString: String;
   IsCorrectString: Boolean;
begin
   Writeln('Введите четыре натуральных числа до 2000');
   repeat
      IsCorrectString := true;
      i := 1;
      Readln(InputString);
      StrLength := Length(InputString) + 1;
      while (i < StrLength) and (IsCorrectString) do
      begin
         if (InputString[i] = ' ') then
            inc(i)
         else
            if (InputString[i] in Digits) then
               inc(i)
            else
            begin
               IsCorrectString := false;
               Writeln('Ошибка. Введите четыре натуральных числа до 2000');
            end;
      end;
   until (IsCorrectString);
   ReadNumberString := InputString;
end;

function ConvertString(DecStr: String): String;
var
   StrNumsCount, i: Integer;
   DecNumbers: TIntArray;
   RomStr: String;
begin
   StrNumsCount := CountStrNums(DecStr);
   DecNumbers := BreakStringIntoArray(DecStr, StrNumsCount);
   for i := 0 to High(DecNumbers) do
      RomStr := RomStr + DecToRoman(DecNumbers[i]);
   ConvertString := RomStr;
end;

function ReadFileName(): String;
var
   FileName: String;
   TestNumber: Real;
begin
   Readln(FileName);
   FileName := FileName + '.txt';
   ReadFileName := FileName;
end;

function isFileCorrect(FileName: String): Boolean;
var
   TestNumber, NumsCount: Integer;
   TestFile: TextFile;
begin
   NumsCount := 0;
   try
      AssignFile(TestFile, FileName);
      Reset(TestFile);
      if (FileExists(FileName)) then
      begin
         while not (EoF(TestFile)) do
            begin
            Read(TestFile, TestNumber);
            inc(NumsCount);
            end;
         if NumsCount < 5 then
            IsFileCorrect := true
         else
         begin
            Writeln('Ошибка. Указанный файл содержит больше 4 чисел.');
            IsFileCorrect := false;
         end;
      end
      else
      begin
         Writeln('Указанный файл не найден');
         IsFileCorrect := false;
      end;
   except
      Writeln('Ощибка. Указанный файл содержит буквенные символы');
      IsFileCorrect := false;
   end;
end;

procedure ClearFile(OutputFileName: String);
var
   OutputFile: TextFile;
begin
   AssignFile(OutputFile, OutputFileName);
   Rewrite(OutputFile);
   CloseFile(OutputFile);
end;

function ChooseOutputFile(): String;
var
   OutputFileName: String;
   Answer: Char;
   IsCorrectFile, IsCorrectAnswer: Boolean;
begin
   IsCorrectFile := false;
   IsCorrectAnswer := false;
   repeat
      Writeln('Укажите название файла, в который хотите произвести запись.');
      OutputFileName := ReadFileName();
      if (FileExists(OutputFileName)) then
      begin
         ClearFile(OutputFileName);
         IsCorrectFile := true;
      end
      else
      begin
         Writeln('Файл с указанным названием не существует. Если вы желаете создать файл с указанным именем, введите Y, в обратном случае введите N');
         repeat
            Readln(Answer);
            Answer := UpCase(Answer);
            if (Answer = 'Y') then
            begin
               ClearFile(OutputFileName);
               IsCorrectFile := true;
               IsCorrectAnswer := true;
            end
            else
               if (Answer = 'N') then
               begin
                  IsCorrectFile := false;
                  IsCorrectAnswer := true;
               end
            else
            begin
               Writeln('Ошибка. Был введён некорректный ответ. Повторите попытку');
            end;
         until (IsCorrectAnswer);
      end;
   until (IsCorrectFile);
   ChooseOutputFile := OutputFileName;
end;

procedure WritelnStrInFile(OutputFileName, Str: String);
var
   OutputFile: TextFile;
begin
   AssignFile(OutputFile, OutputFileName);
   Append(OutputFile);
   Writeln(OutputFile, Str);
   CloseFile(OutputFile);
end;

function ReadString (): String;
var
   FileInput: Boolean;
   InputFileName, FullDecStr: String;
begin
   ChooseInOutType(FileInput, 'in');
   if (FileInput) then
   begin
      repeat
         Writeln('Укажите имя файла, из которого хотите считать строку');
         InputFileName := ReadFileName();
      until (IsFileCorrect(InputFileName));
      FullDecStr := ReadStringFromFile(InputFileName);
   end
   else
   begin
      FullDecStr := ReadNumberString();
   end;
   ReadString := FullDecStr;
end;

procedure PrintToFile(StrAnswer: String);
var
   OutputFileName: String;
begin
   OutputFileName := ChooseOutputFile();
   WritelnStrInFile(OutputFileName, 'Числа, представленные римскими цифрами: ');
   WritelnStrInFile(OutputFileName, StrAnswer);
   Writeln('Запись в файл произведена успешно');
end;

procedure PrintResult(FullDecStr, FullRomanStr: String);
var
   FileOutput: Boolean;
begin
   Writeln('Числа, представленные арабскими цифрами: ', FullDecStr);
   Writeln('Числа, представленные римскими цифрами: ', FullRomanStr);
   ChooseInOutType(FileOutput, 'out');
   if (FileOutput) then
      PrintToFile(FullRomanStr);
end;

procedure Main();
var
   FullDecStr, FullRomanStr: String;
begin
   Writeln('Данная программа переводит до 4 введённых чисел, представленных арабскими цифрами, в римские цифры.');
   FullDecStr := ReadString();
   DeleteExcessSpaces(FullDecStr);
   FullRomanStr := ConvertString(FullDecStr);
   PrintResult(FullDecStr, FullRomanStr);
   Readln;
end;

begin
   Main();
end.