Program vykonáva prevod medzi rímskym a arabským číslom

{ RIMAN.PAS                 Copyright (c) TrSek alias Zdeno Sekerak }
{ Program vykonava prevod medzi rimskymi a arabskymi cislami.       }
{                                                                   }
{ Datum:11.06.2005                                                  }
 
program rimske_cisla;
 
const
  MAX_C = 7;
  RC: array[1..MAX_C] of char = ('I','V','X','L','C','D','M');
  AC: array[1..MAX_C] of integer = (1, 5, 10, 50, 100, 500, 1000 );
 
var cis:string;
 
 
{ zisti arabsky ekvivalent k rimskenu cislu }
function Arab(ch:char):integer;
var i:integer;
begin
  for i:=1 to MAX_C do
     if( RC[i] = UpCase(ch) )then
         Arab := AC[i];
end;
 
 
{ prevedie retazec na cislo word }
function ToWord(s:string):word;
var v:word;
    err:integer;
begin
  Val(s,v,err);
  ToWord:=v;
end;
 
 
{ vykona prevod z rimskeho na arabske cislo }
function RimToArab(s:string):word;
var v:word;
    a,p:word;
    i:integer;
begin
  p:=0; { posledne spracovany znak }
  v:=0; { vysledok }
 
  for i:=length(s) downto 1 do
  begin
    a:=Arab(s[i]);
 
    { posledne spracovany znak urci ci +/- }
    if(a<p)then
       v:=v-a
    else
    begin
       v:=v+a;
       p:=a;
    end;
  end;
 
  { vysledok }
  RimToArab:=v;
end;
 
 
{ aka je prva cisfa cisla }
function FirstCif(c:word):byte;
begin
  while(c>10) do
    c:= c div 10;
 
  FirstCif:=c;
end;
 
 
{ vykona prevod z rimskeho na arabske cislo }
function ArabToRim(c:word):string;
var v:string;
    p:word;
    i:integer;
begin
  v:='';
 
  for i:=MAX_C downto 1 do
  begin
    p:=AC[i];
 
    { pre obycajne cisla }
    while(c>=p) do
    begin
      v:=v+RC[i];
      c:=c-p;
    end;
 
    { specialita pre 4 }
    if(( FirstCif(c)=4 ) and ( c>AC[i-1]))then begin
      v:=v+RC[i-1]+RC[i];
      c:=c+AC[i-1]-p;
    end;
 
    { specialita pre 9 }
    if(( FirstCif(c)=9 ) and ( c>AC[i-1]))then begin
      v:=v+RC[i-2]+RC[i];
      c:=c+AC[i-2]-p;
    end;
 
  end;
 
  { vysledok }
  ArabToRim:=v;
end;
 
 
begin
  WriteLn('Program vykonava prevod medzi rimskymi a arabskymi cislami.');
  Write  ('Zadaj rimske/arabske cislo:');
  ReadLn (cis);
 
  { zistim ci je to arabske cislo }
  if(cis[1] in ['0'..'9'])then
     WriteLn('Rimske cislo je:', ArabToRim(ToWord(cis)) )
  else
     WriteLn('Arabske cislo je:', RimToArab(cis));
 
  ReadLn;
end.