{****************************************************************************}
{*                         Drucker-Ausgabe                                  *}
{****************************************************************************}

   PROCEDURE drucke ( VAR x : line );
     VAR i : linelength;
         a : line;

    FUNCTION reserviert ( VAR x : line ) : boolean;
     CONST ResWords : ARRAY[1..45] of STRING[10] =
                   ('ABSOLUTE','AND','ARRAY','BEGIN','CASE','CONST',
                    'DIV','DO','DOWNTO','ELSE','END','END.','EXTERNAL','FILE',
                    'FOR','FORWARD','FUNCTION','GOTO','IF','IN','INLINE',
                    'LABEL','MOD','NIL','NOT','OF','OR','OVERLAY','PACKED',
                    'PROCEDURE','PROGRAM','RECORD','REPEAT','SET','SHL',
                    'SHR','STRING','THEN','TO','TYPE','UNTIL','VAR',
                    'WHILE','WITH','XOR');
     VAR i,j,m : 1..50; h : boolean; w : line;
     BEGIN
       h:=false; i:=1; j:=45; w:=gross(x);
       IF NOT(KommentarFlag) AND NOT(StringFlag) THEN BEGIN
         REPEAT m:=(i+j) DIV 2; IF w<=ResWords[m] THEN j:=m ELSE i:=m+1
         UNTIL i=j; h:=(ResWords[i]=w) END;
       reserviert:=h;
       IF h
        THEN IF (w='BEGIN') or (w='REPEAT')
               THEN Iter:=Iter+1
               ELSE IF (w='RECORD') THEN
                    BEGIN CaseFlag:=false; Iter:=Iter+1 END
               ELSE IF (w='CASE') AND CaseFlag THEN Iter:=Iter+1
               ELSE IF (w='END') OR (w='UNTIL') OR (w='END.') THEN
                    BEGIN CaseFlag:=true; Iter:=Iter-1 END

     END;

    PROCEDURE markiere (VAR x : line );
     {Hier koennen die gewuenschten Sequenzen zum Markieren der
      reservierten Woerter eingesetzt werden. Hier ein Beispiel
      fuer Typenrad-Drucker: Gross und vierfach.}
     VAR i,j : Byte;
     BEGIN
       IF RMark IN Options
        THEN BEGIN
          FOR i:=1 TO 3 DO
            BEGIN
              write(LST,gross(x)); FOR j:=1 TO length(x) DO write(LST,#8)
            END;
            write(LST,gross(x))
          END
        ELSE write(LST,x)
     END;

    BEGIN {drucke}
       write(LST,'':PO);
       IF LNummer IN Options THEN write(LST,ZeilenNummer:5,': ');
       IF Versch  IN Options THEN write(LST,Iter:2,'  ');
        a:=''; i:=1;
        WHILE i<=length(x) DO
           BEGIN
             IF x[i] IN ['^','A'..'Z','a'..'z'] THEN
                 BEGIN a:=x[i]; i:=succ(i);
                   WHILE (x[i] IN ['.','^','0'..'9','A'..'Z','a'..'z','_'])
                         AND (i<=length(x)) DO
                           BEGIN a:=a+x[i]; i:=succ(i) END
                   END
                ELSE BEGIN
                       IF a<>'' THEN
                         IF reserviert(a) THEN markiere(a)
                                          ELSE BEGIN write(LST,a);
                                          IF Cross IN Options THEN
                                           IF NOT KommentarFlag THEN
                                             IF NOT StringFlag
                                               THEN Einfuegen(a,ZeilenNummer)
                                           END;
                       a:='';
                       write(LST,x[i]);
                       IF NOT(StringFlag) AND ((x[i]='{') OR ((x[i]='(')
                          AND (x[i+1]='*'))) THEN KommentarFlag:=true;
                       IF NOT(StringFlag) AND((x[i]='}') OR ((x[i]='*')
                          AND (x[i+1]=')'))) THEN KommentarFlag:=false;
                       IF NOT(KommentarFlag) AND(x[i]=chr(39))
                          THEN StringFlag:=NOT(StringFlag); i:=succ(i)
                END
           END;
           IF a<>'' THEN IF reserviert(a)
              THEN markiere(a) ELSE
              BEGIN write(LST,a);
                IF NOT(KommentarFlag OR StringFlag) AND (Cross IN Options)
                 THEN Einfuegen(a,ZeilenNummer) END;
           writeln(LST); StringFlag:=false
    END;

   PROCEDURE SeitenKopf;
     VAR i : linelength;
     BEGIN
      IF ListFlag THEN BEGIN
       writeln(LST); write(LST,'':PO);
       FOR i:=1 TO length(HE) DO IF HE[i]='#' THEN write(LST,SeitenZahl)
                                              ELSE write(LST,HE[i]);
       writeln(LST);
       FOR i:=1 TO MT DO writeln(LST);
       ZeilenZahl:=MT+3
      END
     END;

   PROCEDURE NeueSeite;
     VAR i : linelength;
     BEGIN
      PufferGroesse:=0;
      IF ListFlag THEN BEGIN write(LST,'':PO);
       FOR i:=ZeilenZahl TO PL-3 DO writeln(LST);
       FOR i:=1 TO length(FO) DO IF FO[i]='#' THEN write(LST,SeitenZahl)
                                              ELSE write(LST,FO[i]);
       FOR i:=1 TO 3 DO writeln(LST);
       SeitenZahl:=SeitenZahl+1;
       IF WarteFlag THEN BEGIN write('Weiter mit RETURN'); readln END;
       SeitenKopf
      END {if ListFlag}
     END;