PROGRAM zahlwort(input,output);

{ Gibt zu den Zahlworten EINS bis ZEHN die entsprechenden Zahlen aus }

CONST leer       = ' ';
      wortlaenge = 6;
      maxworte = 10;

TYPE wortindex = 1..wortlaenge;
     wort      = ARRAY[wortindex] OF char;
     woerter   = ARRAY[1..maxworte] OF wort;

VAR zahlen : woerter;
    zahl   : wort;
    ende   : boolean;

PROCEDURE initialisieren;

{ Baut das Feld "zahlen" auf }

VAR i,j : integer;

BEGIN { initialisieren }
  { zahlen loeschen }
  FOR i := 1 TO maxworte DO
    FOR j := 1 TO wortlaenge DO
      zahlen[i,j] := leer;

  zahlen[1,1]  := 'E'; zahlen[1,2]  := 'I'; zahlen[1,3]  := 'N';
  zahlen[1,4]  := 'S';

  zahlen[2,1]  := 'Z'; zahlen[2,2]  := 'W'; zahlen[2,3]  := 'E';
  zahlen[2,4]  := 'I';

  zahlen[3,1]  := 'D'; zahlen[3,2]  := 'R'; zahlen[3,3]  := 'E';
  zahlen[3,4]  := 'I';

  zahlen[4,1]  := 'V'; zahlen[4,2]  := 'I'; zahlen[4,3]  := 'E';
  zahlen[4,4]  := 'R';

  zahlen[5,1]  := 'F'; zahlen[5,2]  := 'U'; zahlen[5,3]  := 'E';
  zahlen[5,4]  := 'N'; zahlen[5,5]  := 'F';

  zahlen[6,1]  := 'S'; zahlen[6,2]  := 'E'; zahlen[6,3]  := 'C';
  zahlen[6,4]  := 'H'; zahlen[6,5]  := 'S';

  zahlen[7,1]  := 'S'; zahlen[7,2]  := 'I'; zahlen[7,3]  := 'E';
  zahlen[7,4]  := 'B'; zahlen[7,5]  := 'E'; zahlen[7,6]  := 'N';

  zahlen[8,1]  := 'A'; zahlen[8,2]  := 'C'; zahlen[8,3]  := 'H';
  zahlen[8,4]  := 'T';

  zahlen[9,1]  := 'N'; zahlen[9,2]  := 'E'; zahlen[9,3]  := 'U';
  zahlen[9,4]  := 'N';

  zahlen[10,1] := 'Z'; zahlen[10,2] := 'E'; zahlen[10,3] := 'H';
  zahlen[10,4] := 'N'
END;  { initialisieren }
{----------------------------------------------------------------------------}

PROCEDURE uebernehmen;

{ Uebernimmt ein Zahlwort in Grossbuchstaben von der Tastatur. }

VAR i       : integer;
    eingabe : char;

BEGIN { uebernehmen }
  { zahl loeschen }
  FOR i := 1 TO wortlaenge DO
    zahl[i] := leer;

  writeln; writeln;
  writeln('Geben Sie ein Zahlwort zwischen EINS und ZEHN ein.');
  write('Benutzen Sie dazu nur Grossbuchstaben. ');
  i := 1;
  WHILE (i < wortlaenge) AND (NOT eoln) DO
    BEGIN
      read(eingabe);
      zahl[i] := eingabe;
      i := i+1
    END;
  writeln;writeln
END;  { uebernehmen }
{----------------------------------------------------------------------------}

PROCEDURE zahlsuchen;

{ Vergleicht das Feld "zahl" mit den Teilfeldern in "zahlen" und meldet }
{ um welches Zahlwort es sich handelt. }

VAR i        : integer;
    gefunden : boolean;

BEGIN { zahlsuchen }
  gefunden := FALSE;
  i := 1;
  REPEAT
    IF zahl = zahlen[i] THEN
      gefunden := TRUE;
    i := i+1;
  UNTIL gefunden OR (i>maxworte);
  IF gefunden
    THEN
      writeln('Dazu gehoert die Nummer ',i-1:0,'.')
    ELSE
      writeln('Unzulaessige Eingabe!');
    writeln
END;  { zahlsuchen }
{----------------------------------------------------------------------------}

FUNCTION beendet : boolean;

VAR antwort : char;
    korrekt : boolean;

BEGIN { beendet }
  REPEAT
    korrekt := TRUE;
    write('Noch einmal (J/N)? ');
    read(antwort);
    writeln;
    IF (antwort<>'J') AND (antwort<>'N')
      THEN
        BEGIN
          writeln;
          writeln('Fehlerhafte Eingabe! Bitte nochmal.');
          korrekt := FALSE
        END
      ELSE
        IF antwort = 'N'
          THEN
            beendet := TRUE
          ELSE
            beendet := FALSE
  UNTIL korrekt;
END; { beeendet }
{----------------------------------------------------------------------------}

BEGIN { zahlwort }
  initialisieren;
  REPEAT
    uebernehmen;
    zahlsuchen
  UNTIL beendet;
  writeln; writeln;
END.  { zahlwort }


