3_1 *2

program Laba_3_1;
{$APPTYPE CONSOLE}
uses
  SysUtils;

type
   TList = array of Integer;
   TRomans = array of string;
   TInputMode = (WithFile, Console);

resourcestring
   InstructionMessage
      = 'This program converts numbers to the Roman numeral system.';
   ModeOfInputMessage = 'Where do you want to input data from? [F]ile or [C]onsole';
   IncorrectInputFilePathMessage
      = 'Incorrect input file path, check if file exists and try again';
   IncorrectInputModeMessage = 'Incorrect way of input, choose [F]ile or [C]onsole';
   OutputFileExistsErrorMessage
      = 'Incorrect output file, such file already exists, try again';
   ShouldCreateMessage = 'Do you want to save output data into file? [Y]es or [N]o';
   ShouldCreateErrorMessage = 'Incorrect answer, choose [Y]es or [N]o';
   SuccessfullySavedMessage = 'Output data was successfully saved into ';
   InputFilePathMessage = 'Enter input file path';
   OutputFilePathMessage = 'Enter output file path';
   EnterAmountMessage = 'Enter amount of elements of your sequence';
   EnterElemsMessage = 'Enter elements';
   IncorrectFileDataError
      = 'Error! Your input file contains invalid data, correct this and try again';
   IncorrectConsoleInputMessage
      = 'Error! It should be natural number from 1 to 2147483676';

function GetInputFilePath: string;
var
   Path: string;
begin
   Writeln(InputFilePathMessage);
   Readln(Path);
   while not FileExists(Path) do
   begin
      Writeln(IncorrectInputFilePathMessage);
      Readln(Path);
   end;
   GetInputFilePath := Path;
end;

function ShouldCreateOutputFile: Boolean;
var
   Answer: string;
begin
   Writeln(ShouldCreateMessage);
   Readln(Answer);
   Answer := LowerCase(Answer);
   while (Answer <> 'y') and (Answer <> 'n') do
   begin
      Writeln(ShouldCreateErrorMessage);
      Readln(Answer);
   end;
   ShouldCreateOutputFile := Answer = 'y';
end;

function GetOutputFilePath: string;
var
   Path: string;
begin
   Writeln(OutputFilePathMessage);
   Readln(Path);
   while FileExists(Path) do
   begin
      Writeln(OutputFileExistsErrorMessage);
      Readln(Path);
   end;
   GetOutputFilePath := Path;
end;

function ChooseInputMode: TInputMode;
var
   Mode: string;
begin
   Writeln(ModeOfInputMessage);
   Readln(Mode);
   Mode := LowerCase(Mode);
   while (Mode <> 'c') and (Mode <> 'f') do
   begin
      Writeln(IncorrectInputModeMessage);
      Readln(Mode);
   end;
   if Mode = 'f' then
      ChooseInputMode := WithFile
   else
      ChooseInputMode := Console;
end;

function ReadFile(var InputFile: TextFile; Len: Integer): TList;
var
   Sequence: TList;
   i: Integer;
begin
   SetLength(Sequence, Len);
   Reset(InputFile);
   i := 0;
   while not EoF(InputFile) do
   begin
      Read(InputFile, Sequence[i]);
      Inc(i);
   end;
   CloseFile(InputFile);
   ReadFile := Sequence;
end;

function GetFileLength(var InputFile: TextFile): Integer;
var
   AssumedLength, Item: Integer;
   HasError: Boolean;
begin
   AssumedLength := 0;
   GetFileLength := -1;
   HasError := False;
   try

      while not EoF(InputFile) do
      begin
         Read(InputFile, Item);
         if (Item < 1) or (Item > 2000) then
            HasError := True;
         Inc(AssumedLength);
      end;

      if HasError then
         Writeln('Every number in file should be from 1 to 2000. Try again')
      else
         GetFileLength := AssumedLength;
   except
      Writeln(IncorrectFileDataError);
   end;
end;

function ReadConsole: TList;
var
   N, i: Integer;
   IsCorrect: Boolean;
   List: TList;
begin
   IsCorrect := False;
   Writeln(EnterAmountMessage);
   repeat
      try
         Readln(N);
         IsCorrect := True;
      except
         Writeln(IncorrectConsoleInputMessage);
      end;
   until IsCorrect;
   SetLength(List, N);
   Writeln(EnterElemsMessage);
   for i := 0 to N - 1 do
   begin
      IsCorrect := False;
      repeat
         try
            Readln(List[i]);
            if (List[i] < 1) or (List[i] > 2000) then
               Writeln('Number should be from 1 to 2000')
            else
               IsCorrect := True;
         except
            Writeln(IncorrectConsoleInputMessage);
         end;
      until IsCorrect;
   end;
   ReadConsole := List;
end;

function Translate(Num: Integer): string;
var
   Pattern, Triple, Roman, Temp: string;
   i, j, Divider, Digit, Whole, Remainder: Integer;
begin
   Pattern := 'IVXLCDMMM';
   Roman := '';
   Divider := 1000;
   for i := 1 to 4 do
   begin
      Temp := '';
      Digit := Num div Divider mod 10;
      Divider := Divider div 10;
      //Writeln(Digit);

      Whole := Digit div 5;
      Remainder := Digit mod 5;

      Triple := Copy(Pattern, 8 - (2*i - 1), 3);
      //Writeln('Triple: ', Triple);

      if Whole = 1 then
         Temp := Temp + Triple[2];


      if (Remainder > 0) and (Remainder < 4) then
         for j := 1 to Remainder do
            Temp := Temp + Triple[1];

      if Remainder = 4 then
         if Whole = 0 then
            Temp := Triple[1] + Triple[2]
         else
            Temp := Triple[1] + Triple[3];
      //Temp := Temp + ' ';
      //Writeln(Temp);
      Roman := Roman + Temp;

      //Writeln('--------------');
   end;

   //Writeln('Roman: ', Roman);
   Translate := Roman;
end;

function ConvertListToRoman(List: TList): TRomans;
var
   i: Integer;
   Romans: TRomans;
begin
   SetLength(Romans, Length(List));
   for i := 0 to Length(List) - 1 do
      Romans[i] := Translate(List[i]);

   ConvertListToRoman := Romans;
end;

procedure WriteRomans(var OutputFile: TextFile; Romans: TRomans; List: TList);
var
   i: Integer;
begin
    for i := 0 to Length(Romans) - 1 do
      Writeln(OutputFile, List[i], ' = ', Romans[i]);
end;

procedure Main;
var
   Len: Integer;
   List, ListToFile: TList;
   InputFile, OutputFile: TextFile;
   OutputFilePath: string;
   Romans, RomansToFile: TRomans;

   Number: Integer;
begin
   Writeln(InstructionMessage);
   case ChooseInputMode() of
      WithFile:
      begin
         Assign(InputFile, GetInputFilePath());
         Reset(InputFile);
         Len := GetFileLength(InputFile);
         if Len <> - 1 then
            List := ReadFile(InputFile, Len);
      end;
      Console:
         List := ReadConsole();
   end;

   if Len <> -1 then
   begin
      Romans := ConvertListToRoman(List);
      //RomansToFile := Copy(Romans);
      WriteRomans(Output, Romans, List);
      if ShouldCreateOutputFile() then
      begin
         OutputFilePath := GetOutputFilePath();
         AssignFile(OutputFile, OutputFilePath);
         Rewrite(OutputFile);
         WriteRomans(OutputFile, Romans, List);
         Writeln(SuccessfullySavedMessage, OutputFilePath);
         CloseFile(OutputFile);
      end;
   end;
   Writeln('Fin!');
   Readln;
end;

begin
  Main();
end.