<>=
MODULE Tree;
  <Convenient constants>
  <Utility procedures>
  <Annotating the tree structure>
  <Producing the HTML output>
This code is written to a file (or else not used).

* 
<Convenient constants>=
CONST
  StdFont = '<FONT FACE="ARIAL, GENEVA" SIZE=-1>',
  EndFont = '</FONT>';
Used above.

<Utility procedures>=
PROCEDURE EnclosingBlock(x);
  BEGIN
  IF x <> VOID THEN
    RESULT := x.Father;
    WHILE (RESULT <> VOID) AND NOT (RESULT IS StatementBlock) DO
      RESULT := RESULT.Father;
      END;
    END;
  END EnclosingBlock;
Used above; next definition.

<Utility procedures>+=
PROCEDURE SubTreeImage (Bl, OnRoot);
  VAR
    a, l, Last, Child;
  BEGIN
  IF (#Bl.Ancest = 1) AND NOT OnRoot THEN
    a := "<A NAME=T" & Bl.Nr & ">" & Bl.Label & "</A>";
    a := a & " <A HREF=" & Bl.HRef & ">Go to source...</A>";
   ELSE
    a := Bl.Label;
    END;
  RESULT := { a };
  Last := FALSE;
  FOR i := 1 TO #Bl.Children DO
    Child := Bl.Children [i];
    IF #Child.Ancest = 1 THEN
      l := SubTreeImage(Child, FALSE);
     ELSE
      l := { LocalRef(Child) };
      END;
    IF i = #Bl.Children THEN
      Last := TRUE;
      END;
    RESULT := RESULT & {"  +- " & l[1]};  
    FOR j := 2 TO #l DO
      IF Last THEN
        RESULT := RESULT & { "   " & l[j] };
       ELSE
        RESULT := RESULT & { "  |" & l[j] };
        END;
      END;    
    END;
  END SubTreeImage;
Used above; previous definition.

<Producing the HTML output>=
PROCEDURE DumpSubTree (Bl);
  VAR
    a;
  BEGIN
  a := SubTreeImage (Bl, TRUE);
  FOR IN a DO
    FILE1.WriteLn (X);
    END;
  END DumpSubTree;
Used above; next definition.

<Producing the HTML output>+=
PROCEDURE LocalRef (Bl);
  BEGIN
  RESULT := "<A HREF=#T" &  Bl.Nr & ">" & Bl.Label & "</A>";
  END LocalRef;
Used above; previous and next definitions.

<Producing the HTML output>+=
PROCEDURE DumpRoot (Bl);
  BEGIN
  FILE1.WriteLn ("<HR><A NAME=T", Bl.Nr, 
                   ">", StdFont, "Paragraph ", 
                       Bl.Label, EndFont, "</A>");
  FILE1.WriteLn (StdFont, "<A HREF=", Bl.HRef, "> (Goto source)</A>", EndFont);                     
  IF #Bl.Ancest > 0 THEN
    FILE1.WriteLn (StdFont, " used in:", EndFont, "<UL>");
    FOR x IN Bl.Ancest DO
      FILE1.WriteLn ("<LI>", StdFont, LocalRef (x), EndFont, "</LI>");
      END;
    FILE1.WriteLn ("</UL>");  
    END;
  IF #Bl.Children > 0 THEN
    FILE1.WriteLn ("<PRE>");  
    DumpSubTree (Bl);  
    FILE1.WriteLn ("</PRE>");  
    END;
  END DumpRoot;
Used above; previous and next definitions.

<Producing the HTML output>+=
PROCEDURE ProduceTreeOutput(FName);
  BEGIN
  AnnotateParagraphDependencies (ROOT);
  FILE1.Redirect (FName);
  FILE1.WriteLn ("<!RainCode Generated document>",
                 "<HTML><HEAD><TITLE>" & 
                     ROOT.SourceName & 
                 " - Tree representation</TITLE>",
                 "</HEAD><BODY>");
  FILE1.WriteLn ("<H2>", ROOT.SourceName, "</H2>");               
  FOR Bl IN ROOT.ProcedureDivision.Blocks | #X.Ancest= 0 DO
    DumpRoot (Bl);
    FILE1.WriteLn;
    END;
  FOR Bl IN ROOT.ProcedureDivision.Blocks | #X.Ancest > 1 DO
    DumpRoot (Bl);
    FILE1.WriteLn;
    END;
  FILE1.WriteLn ("</BODY></HTML>");  
  FILE1.Redirect;  
  END ProduceTreeOutput;
Used above; previous definition.

<Annotating the tree structure>=
PROCEDURE AnnotateParagraphDependencies (Root);
  VAR
    l, e;
  BEGIN
  IF NOT (Root CAN AnnotatedTree) THEN
    Root.AnnotatedTree := TRUE;
    FOR IN Root.ProcedureDivision.Blocks DO
      X.Ancest := {};
      X.Children := {};
      END;
    FOR p IN Root.SubNodes | (X IS PerformStatement) AND 
                             (X.Label <> VOID) DO
      l := Root.ProcedureDivision.FindBlock (p.Label.Image);
      e := EnclosingBlock(p);
      IF (l <> VOID) AND (e <> VOID) THEN
        ASSERT e IS StatementBlock;
        ASSERT l IS StatementBlock;
        l.Ancest := l.Ancest & {e};
        e.Children := e.Children & {l};
        END;
      END;
    FOR IN Root.ProcedureDivision.Blocks DO
      X.Ancest := LIST.Unique (X.Ancest | X <> VOID );
      X.Children := LIST.Unique(X.Children | X <> VOID);
      END;
    END;  
  END AnnotateParagraphDependencies;
Used above.