(*******************************************************)
(*        PD/L PRETTYPRINTER VERSION 1.0               *)
(*     COPYRIGHT  1984 BY WILLIAM H. HAPGOOD           *)
(*       LAST REVISION NOV.   6, 1984                  *)
(*******************************************************)

{To use this prettyprinter, use the command:
{
{               PRETTY <INFILE  >OUTFILE
{
{ where INFILE is the program to prettyprint, and
{ OUTFILE is the name of the new, pretty file. They must not be the same!
{
{This is an example of using re-directed input and output, a handy part
{of DOS 2.0; you can write programs using INPUT and OUTPUT for files,
{and later, when you run the program, decide what files should be used
{for the input and output.
                                }
PROGRAM PRETTY;

  
CONST
  S = ' ';
  APOSTROPHE = "'";
  QUOTES = '"';
  
  
TYPE
  SYMBOL = (NOTHING,FIRST1,COMMENT,PROCSY,BEGINSY,IFSY,THENSY,DECLSY,
  ELSESY,REPEATSY,UNTILSY,WHILESY,DOSY,FORSY,
  CASESY,ENDSY,RECORDSY,NOBLKSYS,
  SEMI,LBRACK,RBRACK,LPAREN,RPAREN,ENDOFILE);
  
VAR
  SY : SYMBOL;
  FIRSTSY : SYMBOL;
  ID : STRING;
  CH : CHAR;
  
  CLINE : STRING;
  CHCNT : INTEGER;
  INDENT : INTEGER;
  QUANTUM : INTEGER;
  
  NESTLEVEL : INTEGER;
  SOLNEST : INTEGER;
  NOBLOCK : BOOLEAN;
  MAKEUC  : BOOLEAN;



PROCEDURE FINDKEYWORD;  {if a keyword, set sy to correct value}
BEGIN
  IF ID = 'END' THEN SY := ENDSY ELSE
  IF ID = 'BEGIN' THEN SY := BEGINSY ELSE
  IF ID = 'IF' THEN SY := IFSY ELSE
  IF ID = 'THEN' THEN SY := THENSY ELSE
  IF ID = 'ELSE' THEN SY := ELSESY ELSE
  IF ID = 'REPEAT' THEN SY := REPEATSY ELSE
  IF ID = 'UNTIL' THEN SY := UNTILSY ELSE
  IF ID = 'VAR' THEN SY := DECLSY ELSE
  IF ID = 'FOR' THEN SY := FORSY ELSE
  IF ID = 'WHILE' THEN SY := WHILESY ELSE
  IF ID = 'CASE' THEN SY := CASESY ELSE
  IF ID = 'PROCEDURE' THEN SY := PROCSY ELSE
  IF ID = 'TYPE' THEN SY := DECLSY ELSE
  IF ID = 'CONST' THEN SY := DECLSY ELSE
  IF ID = 'FUNCTION' THEN SY := PROCSY;
END;


PROCEDURE WRITELINE;
BEGIN
  INDENT := SOLNEST*QUANTUM;
  IF (INDENT<>0) AND (FIRSTSY IN [THENSY,ELSESY]) THEN INDENT := INDENT-1;
  CLINE[0] := CHR(CHCNT-1);
  WRITELN(CLINE:CHCNT-1+INDENT);
  SOLNEST := NESTLEVEL; FIRSTSY := FIRST1;
END;

FUNCTION UPCASE(CH:CHAR):CHAR;
BEGIN
  IF CH IN ['a'..'z'] THEN UPCASE := CHR(ORD(CH)-32) ELSE UPCASE := CH;
END;


PROCEDURE NEXTCH;
BEGIN
  IF EOLN THEN {line feed}
    BEGIN
      WRITELINE;
      CHCNT := 1;     {1st char.}
      IF NOT EOF THEN
        REPEAT READ(CH); IF EOLN THEN WRITELINE UNTIL EOF OR (CH <> ' ');
    END ELSE BEGIN READ(CH); CHCNT := CHCNT + 1; END;
  IF MAKEUC THEN CH := UPCASE(CH);
  CLINE[CHCNT] := CH;
END;


PROCEDURE INSYMBOL;
VAR
  K:INTEGER;
BEGIN
  SY := NOTHING;
  WHILE (CH = ' ') AND NOT EOF DO NEXTCH;
  IF (CH IN ['A'..'Z','a'..'z','0'..'9','$',':',',','.','+','-','*','/',
    APOSTROPHE, QUOTES, '{','(',')','[',']',';','<','>','=']) 
    AND NOT EOF THEN
    CASE CH OF
    'A'..'Z','a'..'z': 
    BEGIN
      K := 0;
      REPEAT
        IF K < 9 THEN BEGIN K := K+1; ID[K] := CH; END;
        NEXTCH;
      UNTIL NOT (CH IN ['A'..'Z', '0'..'9', '_']) OR EOF;
      ID[0] := CHR(K);
      FINDKEYWORD;      {see if key, return sy set correctly if so}
    END;
    
    '0'..'9',  '$' : 
    REPEAT NEXTCH UNTIL NOT (CH IN ['0'..'9', 'A'..'F']) OR EOF;
    ':',',','.','<','>','=','+','-','*','/':
    REPEAT NEXTCH
    UNTIL NOT (CH IN [':',',','.','<','>','=','+','-','*','/']) OR EOF;
    
    APOSTROPHE: 
      BEGIN MAKEUC := FALSE; 
        REPEAT NEXTCH UNTIL (CH = APOSTROPHE) OR EOF;
        MAKEUC := TRUE; NEXTCH;
      END;
    QUOTES: 
      BEGIN MAKEUC := FALSE;
        REPEAT NEXTCH UNTIL (CH = QUOTES) OR EOF;
        MAKEUC := TRUE; NEXTCH;
      END;
    ')': BEGIN NEXTCH; SY := RPAREN; END;
    '[': BEGIN NEXTCH; SY := LBRACK; END;
    ']': BEGIN NEXTCH; SY := RBRACK; END;
    ';': BEGIN NEXTCH; SY := SEMI; END;
    '{': BEGIN MAKEUC := FALSE; REPEAT NEXTCH UNTIL (CH = '}') OR EOF;
          MAKEUC := TRUE; NEXTCH; SY := COMMENT; END;
    '(':
    BEGIN
      NEXTCH;
      IF CH = '*' THEN
        BEGIN
          MAKEUC := FALSE; NEXTCH;
          REPEAT
            WHILE (CH <> '*') AND NOT EOF DO NEXTCH;
            NEXTCH;
          UNTIL (CH = ')') OR EOF;
          MAKEUC := TRUE; NEXTCH; SY := COMMENT;
        END ELSE SY := LPAREN;
    END;
  END ELSE NEXTCH;
  IF FIRSTSY = FIRST1 THEN FIRSTSY := SY;
  IF EOF THEN SY := ENDOFILE;
END;

PROCEDURE INSYM;
BEGIN
  REPEAT INSYMBOL UNTIL SY <> COMMENT;
END;



(*           *******END SOURCE READING SECTION  **********)


PROCEDURE DECLARATIONS; {enter --> declbegsys; leave --> begin,proc,func}
BEGIN
  IF SY = DECLSY THEN
    REPEAT
      NESTLEVEL := NESTLEVEL + 1;
      REPEAT 
        INSYM;
        IF SY IN [RECORDSY,LPAREN] THEN NESTLEVEL := NESTLEVEL + 1;
        IF (SY IN [ENDSY,RPAREN]) AND  (NESTLEVEL > 0)
         THEN NESTLEVEL := NESTLEVEL - 1;
      UNTIL SY IN [BEGINSY,PROCSY,DECLSY];
      IF NESTLEVEL > 0 THEN NESTLEVEL := NESTLEVEL - 1; SOLNEST := NESTLEVEL;
    UNTIL SY IN [PROCSY,BEGINSY,ENDOFILE];
END;

PROCEDURE PARAMETERLIST; {enter --> (  ; leave past  )    }
VAR PLEV : INTEGER; ENTNL:INTEGER;
BEGIN
  PLEV := 0; ENTNL := NESTLEVEL; 
  IF QUANTUM <> 0 THEN NESTLEVEL := NESTLEVEL + CHCNT / QUANTUM;
  INSYM;
  REPEAT
    IF SY = LPAREN THEN PLEV := PLEV + 1 ELSE
      IF SY = RPAREN THEN PLEV := PLEV - 1;
    INSYM;
  UNTIL ((PLEV=0) AND (SY = RPAREN)) OR EOF;
  NESTLEVEL := ENTNL; INSYM;
END;


PROCEDURE BLOCK; {enter -->begin; leave just past end}
VAR ENTNL,SOLNL:INTEGER;
BEGIN
  ENTNL := NESTLEVEL; SOLNL := SOLNEST;
  NESTLEVEL := NESTLEVEL + 1;
  REPEAT
    INSYM;
    IF SY IN [IFSY,WHILESY,FORSY] THEN NESTLEVEL := NESTLEVEL+1 ELSE
      IF SY IN [BEGINSY,REPEATSY,CASESY,LBRACK] THEN BLOCK;
    IF SY = SEMI THEN NESTLEVEL := ENTNL+1;
  UNTIL SY IN [ENDSY,UNTILSY,RBRACK,ENDOFILE];
  NESTLEVEL := ENTNL; SOLNEST := SOLNL;
  IF SY = UNTILSY THEN
    REPEAT
      INSYM;
      IF SY = LBRACK THEN 
        BEGIN REPEAT INSYM UNTIL (SY = RBRACK) OR EOF; INSYM; END;
    UNTIL SY IN [SEMI,ENDSY,RBRACK,ELSESY,UNTILSY,ENDOFILE]
   ELSE INSYM;
END;

{------------------------------------------------------------------------}

BEGIN
  QUANTUM := 2;
  INDENT := 0;  NESTLEVEL := 0;  SOLNEST := 0;  MAKEUC := TRUE;
  FIRSTSY := FIRST1;  CHCNT := 0; NEXTCH;
  REPEAT INSYM UNTIL SY IN [BEGINSY,PROCSY,DECLSY,ENDOFILE];
  DECLARATIONS;  {global}
  REPEAT
    IF SY = PROCSY THEN
      BEGIN
        REPEAT INSYM UNTIL SY IN [SEMI,LPAREN,ENDOFILE];
        IF SY = LPAREN THEN PARAMETERLIST;
        NOBLOCK := FALSE;
        REPEAT
          INSYM;
          IF SY = NOBLKSYS THEN NOBLOCK := TRUE; {forward, extern, external}
        UNTIL SY IN [BEGINSY,PROCSY,DECLSY,ENDOFILE];
        DECLARATIONS;
        IF NOT NOBLOCK THEN NESTLEVEL := NESTLEVEL + 1; SOLNEST := NESTLEVEL;
      END;
    IF SY = BEGINSY THEN
      BEGIN
        IF NESTLEVEL > 0 THEN NESTLEVEL := NESTLEVEL-1;
        SOLNEST := NESTLEVEL;
        BLOCK;
        WHILE NOT (SY IN [BEGINSY,PROCSY,ENDOFILE]) DO INSYM;
      END;
  UNTIL SY = ENDOFILE;
END.