program laba3_1;

Uses
   System.SysUtils;

procedure Main(); forward;
function CheckString(s: string): Boolean; forward;
procedure PrintTask; forward;
function UserInputFromConsole(): string; forward;
function UserInputFromFile(Path: String): string; forward;
function CheckPath(Path: String): Boolean; forward;
function UserOutputPath(): String; forward;
procedure PrintInConsole(value: Integer; s: String); forward;
procedure PrintInFile(Path: String; value: Integer; s: string); forward;
function CheckFile(Path: String): Boolean; forward;
function UserInputPath(): String; forward;
function InputMethod: Word; forward;
function OutputMethod(): Word; forward;
function DeleteNotSym(s: string): string; forward;
function ConvertToRim(a: Integer): String; forward;
function Check4Same(s: string): string; forward;
function FixNotValid(s: string): string; forward;

const
   sym: array[1..7] of Char = ('I', 'V', 'X', 'L', 'C', 'D', 'M');
   num: array[1..7] of Integer = (1, 5, 10, 50, 100, 500, 1000);

function CheckString(s: string): Boolean;
begin
   s := DeleteNotSym(s);
   if (Length(s) > 4) or (Length(s) = 0) then
      CheckString := False
   else
      CheckString := True;
end;

function UserInputFromConsole(): string;
var
   s: string;
begin
   repeat
   Writeln('Введите строку, содержащую до 4х цифровых символов');
   Readln(s);
   until (CheckString(s));
   UserInputFromConsole := s;
end;

function UserInputFromFile(Path: String): string;
var
   s: string;
   MyFile: TextFile;
begin
   AssignFile(MyFile, Path);
   reset(MyFile);
   Readln(MyFile, s);
   closefile(MyFile);
   UserInputFromFile := s;
end;

function CheckPath(Path: String): Boolean;
begin
   if FileExists(Path) then
   begin
      Writeln(Path, ' существует');
      CheckPath := True;
   end
   else
   begin
      Writeln(Path, ' не существует');
      Writeln('Введите корректный путь к файлу');
   end;
end;

function UserOutputPath(): String;
var
   Path: String;
begin
   Writeln('Введите абсолютный путь к файлу для вывода результата');
   Readln(Path);
   UserOutputPath := Path;
end;

procedure PrintInConsole(value: Integer; s: String);
begin
   Writeln('Введённное число: ', value);
   Writeln('Данное число в римской системе счисления: ', s);
end;

procedure PrintInFile(Path: String; value: Integer; s: string);
var
   i: Integer;
   MyFile: TextFile;
begin
   AssignFile(MyFile, Path);
   rewrite(MyFile);
   Writeln(MyFile, 'Введённное число: ', value);
   Writeln(MyFile, 'Данное число в римской системе счисления: ', s);
   close(MyFile);
   Writeln('Результат работы помещён в файл');
end;

function CheckFile(Path: String): Boolean;
var
   IsValid: Boolean;
   s: string;
   MyFile: TextFile;
begin
   AssignFile(MyFile, Path);
   reset(MyFile);
   Readln(MyFile, s);
   if s <> '' then IsValid := True;
   close(MyFile);
   CheckFile := IsValid;
end;

function UserInputPath(): String;
var
   Path: String;
begin
   repeat
      repeat
         Writeln('Введите абсолютный путь к файлу с входными данными');
         Readln(Path);
      until CheckPath(Path);
      if not(CheckFile(Path)) then
         Writeln('Неккоректные данные в файле, исправьте файл');
   until (CheckFile(Path));
   UserInputPath := Path;
end;

function InputMethod: Word;
var
   Method: Word;
   IsValid: Boolean;
begin
   Writeln('Каким способом хотите ввести данные?');
   Writeln('1 - с помощью консоли');
   Writeln('2 - с помощью файла');
   repeat
      IsValid := True;
      try
         Readln(Method);
      except
         begin
            IsValid := False;
            Writeln('Введено нецелое число');
         end;
      end;
      if IsValid then
         if (Method <> 1) and (Method <> 2) then
         begin
            IsValid := False;
            Writeln('Введите 1 или 2');
         end;
   until IsValid;
   InputMethod := Method;
end;

function OutputMethod(): Word;
var
   Method: Word;
   IsValid: Boolean;
begin
   Writeln('Куда хотите вывести результат?');
   Writeln('1 - в консоль');
   Writeln('2 - в файл');
   repeat
      IsValid := True;
      try
         Readln(Method);
      except
         begin
            IsValid := False;
            Writeln('Введено нецелое число');
         end;
      end;
      if IsValid then
         if (Method <> 1) and (Method <> 2) then
         begin
            IsValid := False;
            Writeln('Введите 1 или 2');
         end;
   until IsValid;
   OutputMethod := Method;
end;

function DeleteNotSym(s: string): string;
var
   i: Integer;
   const sym = ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9'];
begin
   i := 1;
   while (i <= length(s)) do
      if not(s[i] in sym) then
         delete(s, i, 1)
      else
         Inc(i);
   DeleteNotSym := s;
end;

function ConvertToRim(a: Integer): String;
var
   s: string;
   i: Integer;
begin
   i := 7;
   while (a > 0) do
   begin
      while (a div num[i] > 0) do
      begin
         Dec(a, num[i]);
         s := s + sym[i];
      end;
      Dec(i);
   end;
   ConvertToRim := s;
end;

function Check4Same(s: string): string;
var
   i, j, Temp: Integer;
begin
   i := 1;
   while (i < Length(s) - 2) do
   begin
      if (s[i] = s[i + 1]) and (s[i + 1] = s[i + 2]) and (s[i + 2] = s[i + 3]) then
      begin
         for j := 1 to 7 do
            if sym[j] = s[i] then
               Temp := j;
         Delete(s, i + 1, 3);
         Insert(sym[Temp + 1], s, i + 1);
      end;
      Inc(i);
   end;
   Check4Same := s;
end;

function FixNotValid(s: string): string;
var
   i, j, Temp, Temp1: Integer;
begin
   i := 1;
   while (i < length(s) - 1) do
   begin
      if (s[i] = s[i + 2]) then
      begin
         for j := 1 to 7 do
            if sym[j] = s[i] then
               Temp := j;
         for j := 1 to 7 do
            if sym[j] = s[i + 1] then
               Temp1 := j;
         if Temp = Temp1 + 1 then
         begin
            delete(s, i, 3);
            insert(sym[Temp1], s, i);
            insert(sym[Temp + 1], s, i + 1);
         end;
      end;
      Inc(i);
   end;
   FixNotValid := s;
end;

procedure PrintTask;
begin
   Writeln('Данная программа переводит введёное число(до 2000) в римскую систему счисления');
end;

procedure Main();
var
   Method: Word;
   Path, s: String;
   Value, Err: Integer;
begin
   PrintTask;
   Method := InputMethod;
   if (Method = 1) then
      s := UserInputFromConsole
   else
   begin
      Path := UserInputPath;
      s := UserInputFromFile(Path);
   end;
   s := DeleteNotSym(s);
   val(s, Value, Err);
   s := ConvertToRim(Value);
   s := Check4Same(s);
   s := FixNotValid(s);
   Method := OutputMethod;
   if (Method = 1) then
      PrintInConsole(value, s)
   else
   begin
      Path := UserOutputPath;
      PrintInFile(Path, value, s);
   end;
   Writeln('Нажмите Enter для выхода из программы');
   Readln;
end;

begin
   Main();
end.