PROGRAM baumdemo;

TYPE wort    = STRING [9];
     treeptr = ^tree;
     tree    = RECORD
                 e    : wort;
                 l, r : treeptr
               END;

VAR  baum    : treeptr;
     eingabe : wort;

{====================================================================}

FUNCTION center (s : wort; l : byte) : wort;

BEGIN { center }
  WHILE length (s) < l DO
    s := ' '+s+' ';
  center := copy (s, 1, l)
END;  { center }

{====================================================================}

PROCEDURE einfuegen (VAR b : treeptr; w : wort);

VAR gefunden : boolean;
    p, q     : treeptr;

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

PROCEDURE machzweig (VAR b : treeptr; w : wort);

BEGIN { machzweig }
  new (b);
  gefunden := true;
  WITH b^ DO
    BEGIN
      l := NIL;
      r := NIL;
      e := w
    END
END;  { machzweig }

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

BEGIN { einfuegen }
  gefunden := false;
  q := b;
  IF b = NIL
    THEN
      machzweig (b, w)
    ELSE
      REPEAT
        IF w < q^.e
          THEN
            IF q^.l = NIL
              THEN
                BEGIN
                  machzweig (p, w);
                  q^.l := p
                END
              ELSE
                q := q^.l
          ELSE
            IF w > q^.e
              THEN
                IF q^.r = NIL
                  THEN
                    BEGIN
                      machzweig (p, w);
                      q^.r := p
                    END
                  ELSE
                    q := q^.r
              ELSE
                gefunden := true
      UNTIL gefunden
END;  { einfuegen }

{====================================================================}

PROCEDURE linie (von ,bis, zeile : integer);

VAR i : integer;

BEGIN { linie }
  IF von < bis
    THEN
      FOR i := von TO bis DO
        BEGIN
          gotoxy (i, zeile);
          write ('-')
        END
    ELSE
      FOR i := von DOWNTO bis DO
        BEGIN
          gotoxy (i, zeile);
          write ('-')
        END;
  gotoxy (bis, zeile+1);
  write ('!')
END;  { linie }

{====================================================================}
{$A-}
PROCEDURE schreibbaum (b : treeptr; x, y, astbreite : integer);

BEGIN { schreibbaum }
  IF b <> NIL
    THEN
      BEGIN
        IF b^.l <> NIL
          THEN
            BEGIN
              linie (x-4, x-astbreite DIV 2, y);
              schreibbaum(b^.l,x-astbreite DIV 2,y+2,astbreite DIV 2)
            END;
        gotoxy (x-3, y);
        write (center (b^.e, 7));
        IF b^.r <> NIL
          THEN
            BEGIN
              linie (x+4, x+astbreite DIV 2, y);
              schreibbaum(b^.r,x+astbreite DIV 2,y+2,astbreite DIV 2)
            END
      END
END;  { schreibbaum }
{$A+}

{====================================================================}

BEGIN { baumdemo }
  clrscr;
  baum := NIL;
  writeln ('Demonstration einer Baum-Struktur');
  writeln ('---------------------------------');
  gotoxy (1, 20);
  write ('Eingabe eines Wortes : ');
  REPEAT
    gotoxy (23, 20);
    clreol;
    read (eingabe);
    IF eingabe <> 'end'
      THEN
        BEGIN
          einfuegen (baum, eingabe);
          schreibbaum (baum, 40, 5, 40)
        END
  UNTIL eingabe = 'end'
END.  { baumdemo }