program WR_ROMAN ;
{$IFDEF WINDOWS} uses WinCrt ; {$ENDIF}

function Roman(Number : longint) : string ;
const Digits = 7 ;
type Decades = 0..Pred(Digits) ;
const Pattern : array ['0'..'9'] of string [4] =
  ('', 'x', 'xx', 'xxx', 'xy', 'y', 'yx', 'yxx', 'yxxx', 'xz') ;
const DecXlatn : array [Decades] of array ['x'..'z'] of char =
  ('IVX', 'XLC', 'CDM', 'Mvx', 'xlc', 'cdm', 'm??' {, ...}) ;
var DigitNum, CharNumb : byte ;
NumStr : string [10] ; ChrPattn, PartRomn : string [4] ;
Romn : string [4*Digits] ;
begin Romn := '' ;
  Str(Number, NumStr) ; { Write(' NumStr = "', NumStr, '" ') ; }
  if Number<0 then begin Roman := 'Negative' ; EXIT end ;
  if Length(NumStr)>Digits then begin Roman := 'Too Big' ; EXIT end ;
  for DigitNum := 1 to Length(NumStr) do begin
    ChrPattn := Pattern[NumStr[DigitNum]] ; { Write(' ChrPattn = "', ChrPattn, '"-') ; }
    PartRomn[0] := ChrPattn[0] ;
    for CharNumb := 1 to Length(ChrPattn) do PartRomn[CharNumb] :=
      DecXlatn[Length(NumStr)-DigitNum][ChrPattn[CharNumb]] ;
    { Write('> PartRomn = "', PartRomn, '" ') ; }
    Romn := Romn + PartRomn end {DigitNum} ;
  Roman := Romn end {Roman} ;

var Z : longint ;

BEGIN Writeln('WR_ROMAN - lower-case letters need over-bar => *1000') ;
repeat
  Write(' Input? ') ; Readln(Z) ; Write(Z:12) ;
  Writeln(' "'+Roman(Z)+'"':30) until false ;
END.