program Roemer_pas;
        {Liest roemisch "codierte" Zahlen ein. markus schaber}

uses crt;
const max = 20; {Die Maximale "Stellenzahl" der r”mischen Zahl}

var laenge, summe: integer; {die L„nge der Eingabe, und das Ergebnis}
    i: integer; {Hilfsvariable Zwischenausgabe}
    eingabe: string; {Die Eingabe des Benutzers}
    wert: array[1..max] of integer; {um jeder Eingabe an einer Stelle
                                   den entsprechenden wert zuzuordnen}

procedure abbruch; {allgemeine Abbruchroutine}
begin
   writeln ('Tut mir leid, aber das ist keine korrekte r”mische Zahl!');
   writeln ('Oder die Eingabe war zu lang.');
   writeln ('Bitte Programm nochmal starten.');
   halt;
end; {abbruch}

procedure auswertung; {šbersetzt die Ziffern in Werte}
var r: integer; {Z„hlvariable}
begin {auswertung}
   for r := 1 to laenge do
   begin
      case eingabe[r] of {Unterscheidung f�r die einzelnen Ziffern}
         'I', 'i': wert[r] := 1;     'V', 'v': wert[r] := 5;
         'X', 'x': wert[r] := 10;    'L', 'l': wert[r] := 50;
         'C', 'c': wert[r] := 100;   'D', 'd': wert[r] := 500;
         'M', 'm': wert[r] := 1000
      else abbruch; {fehleingaben fuehren zu der procedure abbruch}
      end; {case}
   end; {for}
end; {auswertung}

procedure fehlerkontrolle;
          {Diese Routine �berpr�ft anhand g„ngiger Regeln den
           korrekten Aufbau einer R”mischen Zahl.}
var r, gleiche, roemZahl: integer;
begin
   gleiche := 1; {Z„hlvariable f�r Zeichenwiederholungen}
   roemZahl := wert[laenge]; {speichert, welche Ziffer wiederholt wird}
   for r:= (laenge - 1) downto 2 do {Pr�ft die Zahl von rechts her,
                                     die Enden m�ssen nicht ger�ft werden.}
   begin {for} {die if-abfragen enthalten die regeln}
      if (wert[r-1] < wert[r+1])                           then abbruch;

      if (wert[r-1] = wert[r+1]) and (wert[r] > wert[r-1]) then abbruch;

      if (wert[r-1] < wert[r]) and ((wert[r-1] = 5)
                               or   (wert[r-1] = 50)
                               or   (wert[r-1] = 500))
                                                           then abbruch;
      if wert[r] = wert[r-1] then
         gleiche := gleiche + 1
         {zu Beginn wurde gleiche auf 1 gesetzt!}
      else begin
         gleiche := 1;
         roemZahl := wert[r];
      end; {if}

      if (gleiche > 3)
      or ((gleiche > 1) and ((wert[r] = 5)
                        or   (wert[r] = 50)
                        or   (wert[r] = 500)))             then abbruch;

   end; {for}
end; {fehlerkontrolle}

procedure berechnung; {berechnet die dezimalzahl}
var r:   integer;
begin
     {summe := wert[laenge];}
     for r := laenge downto 1 do {nur eingegebene Ziffern berechnen}
     begin {Ueberpr�ft, ob die Ziffern addiert oder subtrahiert werden m�ssen}
        if wert[r+1] > wert[r] then
           summe := summe - wert[r]
        else
           summe := summe + wert[r];
     end;
end;

begin {HAUPTPROGRAMM}
   writeln ('Bitte eine roemische Zahl eingeben (nicht mehr als ',max,' Zeichen!)');
   readln (eingabe);

   laenge := Length(eingabe);

   if laenge>max then abbruch;

   auswertung;

   for i:=1 to laenge do write(wert[i],'  ');  {Debug-Ausgabe}
   writeln;

   fehlerkontrolle;

   berechnung;

   writeln ('In der dezimalen Schreibweise lautet die Zahl: ', summe);

end. {HP}