3_1 *1

program Laba_3_1;
{$APPTYPE CONSOLE}
uses
  SysUtils;

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

resourcestring
   InstructionMessage
      = 'This program translates arabian numerals to roman numerals';
   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 IsFileCorrect(var InputFile: TextFile): Integer;
var
   AssumedLength, Item: Integer;
begin
   AssumedLength := 0;
   IsFileCorrect := -1;
   try
      while not EoF(InputFile) do
      begin
         Read(InputFile, Item);
         Inc(AssumedLength);
      end;
      IsFileCorrect := 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]);
            IsCorrect := True;
         except
            Writeln(IncorrectConsoleInputMessage);
         end;
      until IsCorrect;
   end;
   ReadConsole := List;
end;

procedure WriteList(var OutputFile: TextFile; List: TList);
var
   i, LastIndex: Integer;
begin
   LastIndex := High(List);
   for i := 0 to LastIndex do
      Write(OutputFile, List[i], ' ');
   Writeln(OutputFile, '');
end;

procedure SortList(var OutputFile: TextFile; List: TList);
var
   i, j, LastIndex, Current: Integer;
begin
   LastIndex := High(List) + 1;
   Writeln(OutputFile, 'Sorted seqeunce');
   for i := 1 to LastIndex do
   begin
      WriteList(OutputFile, List);
      Current := List[i];
      j := i - 1;
      while (List[j] > Current) and (j >= 0) do
      begin
         List[j+1] := List[j];
         Dec(j);
      end;
      List[j+1] := Current;
   end;
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);
end;

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

   Number: Integer;
begin

   Writeln(InstructionMessage);

   Readln(Number);
   Translate(Number);
   Writeln('Fin!');
   Readln;
end;

begin
  Main();
end.