PROGRAM monate(input,output);

{$B- Select Input-Mode.}

{ Liest einen Wochentag in der Form "WOCHENTAG" ein, und gibt dazu }
{ den passenden Zahlenwert ( 1..7 ) aus. }

CONST wortlaenge = 9;
      feldlaenge = 12;

TYPE monat  = ARRAY[1..wortlaenge] OF char;
     monate = ARRAY[1..feldlaenge] OF monat;

VAR zeichen : char;
    wort    : monat;
    feld    : monate;
    ausgabe : integer;
    richtig : boolean;
    nochmal : boolean;

{----------------------------------------------------------------------------}
PROCEDURE feldaufbau;

VAR i,j : integer;

BEGIN { feldaufbau }

{ Bereich loeschen. }
  FOR i := 1 TO feldlaenge DO
    FOR j := 1 TO wortlaenge DO
      feld[i,j] := ' ';

  feld[1,1] := 'J'; feld[1,2] := 'A'; feld[1,3] := 'N'; feld[1,4] := 'U';
  feld[1,5] := 'A'; feld[1,6] := 'R';

  feld[2,1] := 'F'; feld[2,2] := 'E'; feld[2,3] := 'B'; feld[2,4] := 'R';
  feld[2,5] := 'U'; feld[2,6] := 'A'; feld[2,7] := 'R';

  feld[3,1] := 'M'; feld[3,2] := 'A'; feld[3,3] := 'E'; feld[3,4] := 'R';
  feld[3,5] := 'Z';

  feld[4,1] := 'A'; feld[4,2] := 'P'; feld[4,3] := 'R'; feld[4,4] := 'I';
  feld[4,5] := 'L';

  feld[5,1] := 'M'; feld[5,2] := 'A'; feld[5,3] := 'I';

  feld[6,1] := 'J'; feld[6,2] := 'U'; feld[6,3] := 'N'; feld[6,4] := 'I';

  feld[7,1] := 'J'; feld[7,2] := 'U'; feld[7,3] := 'L'; feld[7,4] := 'Y';

  feld[8,1] := 'A'; feld[8,2] := 'U'; feld[8,3] := 'G'; feld[8,4] := 'U';
  feld[8,5] := 'S'; feld[8,6] := 'T';

  feld[9,1] := 'S'; feld[9,2] := 'E'; feld[9,3] := 'P'; feld[9,4] := 'T';
  feld[9,5] := 'E'; feld[9,6] := 'M'; feld[9,7] := 'B'; feld[9,8] := 'E';
  feld[9,9] := 'R';

  feld[10,1] := 'O'; feld[10,2] := 'K'; feld[10,3] := 'T'; feld[10,4] := 'O';
  feld[10,5] := 'B'; feld[10,6] := 'E'; feld[10,7] := 'R';

  feld[11,1] := 'N'; feld[11,2] := 'O'; feld[11,3] := 'V'; feld[11,4] := 'E';
  feld[11,5] := 'M'; feld[11,6] := 'B'; feld[11,7] := 'E'; feld[11,8] := 'R';

  feld[12,1] := 'D'; feld[12,2] := 'E'; feld[12,3] := 'Z'; feld[12,4] := 'E';
  feld[12,5] := 'M'; feld[12,6] := 'B'; feld[12,7] := 'E'; feld[12,8] := 'R';

END;  { feldaufbau }
{----------------------------------------------------------------------------}
PROCEDURE einlesen;

VAR i : integer;

BEGIN  { einlesen }

  FOR i := 1 TO wortlaenge DO
    wort[i] := ' ';

  writeln;
  write('Geben Sie einen Monat in Grossbuchstaben ein: ');
  i := 1;

  read(zeichen);
{ Abfrage der Tastatur ist VOR Zuweisung zu einer Feldvariablen (hier
  wort[i]) noetig, da sonst ein CR-Zeichen mit abgespeichert wird! }

  WHILE (i <= wortlaenge) AND (NOT eoln) DO
    BEGIN
      wort[i] := zeichen;
      read(zeichen);
      i := i+1
    END;
  writeln

END;  { einlesen }
{----------------------------------------------------------------------------}

PROCEDURE vergleichen;

VAR i : integer;

BEGIN { vergleichen }
  ausgabe := 0;
  FOR i := 1 TO feldlaenge DO
    BEGIN
      IF wort = feld[i]
        THEN ausgabe := i
        ELSE
    END;
  IF ausgabe = 0
    THEN richtig := false
    ELSE richtig := true
END;  { vergleichen }
{----------------------------------------------------------------------------}

PROCEDURE ausgeben;

BEGIN { ausgeben }
  IF ausgabe = 0
    THEN writeln('Fehlerhafte Angaben.')
    ELSE writeln(wort,' ist der ',ausgabe,'. Monat im Jahr.')
END;  { ausgeben }
{----------------------------------------------------------------------------}

PROCEDURE nochmals;

VAR richtig : boolean;

BEGIN { nochmals }
  REPEAT
    richtig := true;
    IF ausgabe = 0
      THEN
        BEGIN
          write('Wollen Sie es nochmal versuchen? (Y/N) ');
          read(zeichen);
          writeln
        END
      ELSE
        BEGIN
          write('Noch eine Eingabe? (Y/N) ');
          read(zeichen);
          writeln
       END;
    IF zeichen = 'Y'
      THEN nochmal := true
      ELSE
        IF zeichen = 'N'
          THEN nochmal := false
          ELSE richtig := false
  UNTIL richtig
END;  { nochmals }
{----------------------------------------------------------------------------}

BEGIN { wochentg }

  feldaufbau;

  REPEAT
    einlesen;
    vergleichen;
    ausgeben;
    nochmals
  UNTIL nochmal = false

END.  { wochentg }