program Riman;
{U tyhle verze nefunguje prevod z rimskych na arabska, tu funkcni jsem nenasel}


Function PrevedCifru(Cifra, DekRad : Byte) : string;
const RimCifry : array[1..4,1..2] of Char = (('I','V'),('X','L'),('C','D'),('M','-'));
var TempRim : String[4];
    pp : Byte;
begin
 If Cifra IN [5..8] then TempRim:=RimCifry[DekRad,2] else TempRim:='';
 If Cifra IN [1..3] then For pp:=1 to Cifra do TempRim:=TempRim+RimCifry[DekRad,1];
 If Cifra IN [6..8] then For pp:=1 to Cifra-5 do TempRim:=TempRim+RimCifry[DekRad,1];
 If Cifra IN [4,9] then TempRim:=TempRim+RimCifry[DekRad,1];
 If Cifra IN [4] then TempRim:=TempRim+RimCifry[DekRad,2];
 If Cifra IN [9] then TempRim:=TempRim+RimCifry[DekRad+1,1];
 PrevedCifru:=TempRim;
{ 0
 1       Nizsi
 2       Nizsi+Nizsi
 3       Nizsi+Nizsi+Nizsi
 4       Nizsi            +Vyssi
 5 Vyssi
 6 Vyssi+Nizsi
 7 Vyssi+Nizsi+Nizsi
 8 Vyssi+Nizsi+Nizsi+Nizsi
 9       Nizsi                  +VVyssi}
end;

Function PrevedCislo(Arabsky : Word) : String;
var Rimsky : String;
    n : Word;
    Rad : ShortInt;
begin
 Rad:=4; n:=1000; Rimsky:='';
  While Arabsky > 0 do
   begin
    Rimsky:=Rimsky+PrevedCifru(Arabsky div n, Rad);
    Arabsky:=Arabsky mod n;
    n:=n div 10; Dec(Rad);
   end;
 PrevedCislo:=Rimsky;
end;

Function PrevedCisloA(Rimsky : String) : Word;
var Arabsky : Word;
    p : Byte;
    Pouzito : array[1..7] of Boolean;
    Posledni : Byte;
begin
 Arabsky:=0;
 For p:=1 to 7 do Pouzito[p]:=FALSE;
 For p:=Length(Rimsky) downto 1 do
   Case Rimsky[p] of
   'I':If Pouzito[1] then Dec(Arabsky,1) else begin Inc(Arabsky,1); Posledni:=1; end;
   'V':If Pouzito[2] then Dec(Arabsky,5) else
        begin Inc(Arabsky,5); If Posledni<>2 then Pouzito[Posledni]:=TRUE; Posledni:=2; end;
   'X':If Pouzito[3] then Dec(Arabsky,10) else
        begin Inc(Arabsky,10); If Posledni<>3 then Pouzito[Posledni]:=TRUE; Posledni:=3; end;
   'L':If Pouzito[4] then Dec(Arabsky,50) else
        begin Inc(Arabsky,50); If Posledni<>4 then Pouzito[Posledni]:=TRUE; Posledni:=4; end;
   'C':If Pouzito[5] then Dec(Arabsky,100) else
        begin Inc(Arabsky,100); If Posledni<>5 then Pouzito[Posledni]:=TRUE; Posledni:=5; end;
   'D':If Pouzito[6] then Dec(Arabsky,500) else
        begin Inc(Arabsky,500); If Posledni<>6 then Pouzito[Posledni]:=TRUE; Posledni:=6; end;
   'M': begin Inc(Arabsky,1000); If Posledni<>7 then Pouzito[Posledni]:=TRUE; Posledni:=7; end;
   end;
 PrevedCisloA:=Arabsky;
end;


const MaxCislo = 3000;

var Rimsky : string;
    Arabsky : integer;
    Volba : string;
    ValCode : Integer;

begin
 Arabsky:=1981;

 Repeat
  WriteLn(' Prevod arabskych cisel na rimska a zpet');
  WriteLn('  Cislo je v rozsahu 0..',MaxCislo);
  WriteLn('  a) Arabska -> Rimska');
  WriteLn('  b) Rimska -> Arabska');
  WriteLn('  c) Konec');
  Write('Vase volba: '); ReadLn(Volba);
  WriteLn;
  If (Volba = 'a')OR(Volba = 'A') then
   begin
    Repeat
     Write('Zadejte arabske cislo v rozmezi 0..',MaxCislo,' :'); ReadLn(Volba);
     Val(Volba,Arabsky,ValCode);
     If (ValCode <> 0)OR(Arabsky < 0)OR(Arabsky > MaxCislo) then WriteLn('Chyba zadani, zadejte znovu.');
    Until (ValCode = 0)AND(Arabsky >= 0)AND(Arabsky < MaxCislo);
    Write(' Cislo ',Arabsky,' je rimsky ',PrevedCislo(Arabsky));
   end;

  If (Volba = 'b')OR(Volba = 'B') then
   begin
    Write('Zadejte rimske cislo :'); ReadLn(Volba);
    Rimsky:='';
    For ValCode:=1 to Length(Volba) do If Volba[ValCode] IN ['I','V','X','L','C','D','M'] then Rimsky:=Rimsky+Volba[ValCode];
    Write(' Cislo ',Rimsky,' je arabsky ',PrevedCisloA(Rimsky));
   end;

 Until (Volba='c')OR(Volba='C')
end.