PROGRAM wochentg(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 = 10;
      feldlaenge = 7;

TYPE tag  = ARRAY[1..wortlaenge] OF char;
     tage = ARRAY[1..feldlaenge] OF tag;

VAR zeichen : char;
    wort    : tag;
    feld    : tage;
    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] := 'M'; feld[1,2] := 'O'; feld[1,3] := 'N'; feld[1,4] := 'T';
  feld[1,5] := 'A'; feld[1,6] := 'G';

  feld[2,1] := 'D'; feld[2,2] := 'I'; feld[2,3] := 'E'; feld[2,4] := 'N';
  feld[2,5] := 'S'; feld[2,6] := 'T'; feld[2,7] := 'A'; feld[2,8] := 'G';

  feld[3,1] := 'M'; feld[3,2] := 'I'; feld[3,3] := 'T'; feld[3,4] := 'T';
  feld[3,5] := 'W'; feld[3,6] := 'O'; feld[3,7] := 'C'; feld[3,8] := 'H';

  feld[4,1] := 'D'; feld[4,2] := 'O'; feld[4,3] := 'N'; feld[4,4] := 'N';
  feld[4,5] := 'E'; feld[4,6] := 'R'; feld[4,7] := 'S'; feld[4,8] := 'T';
  feld[4,9] := 'A'; feld[4,10] := 'G';

  feld[5,1] := 'F'; feld[5,2] := 'R'; feld[5,3] := 'E'; feld[5,4] := 'I';
  feld[5,5] := 'T'; feld[5,6] := 'A'; feld[5,7] := 'G';

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

  feld[7,1] := 'S'; feld[7,2] := 'O'; feld[7,3] := 'N'; feld[7,4] := 'N';
  feld[7,5] := 'T'; feld[7,6] := 'A'; feld[7,7] := 'G';

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

VAR i : integer;

BEGIN  { einlesen }

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

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

  read(zeichen);
{ Abfrage der Tastatur ist VOR der Zuweisung zu einer Feldvariablen (hier
  wort[i]) noetig, da sonst ein CR-Zeichen auch 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,'. Tag in der Woche.')
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 }