{ Musterloesung - Level-Order! }

program heizoelabstossabdaempfung;
uses Crt;

type ref = ^baum;
       baum = record
       value: char;
       left, right: ref;
end;

    t = ref;
    zeiger = ^element;

    element = record
    data: t;
    next: zeiger;
    end;

var tree: ref;

{ STANDARD-Proceduren }

function Is_Empty(p: zeiger): boolean;
begin
is_Empty:=(p = nil);
{ if (p = nil) then writeLN('LISTE LEER!'); }
end;

procedure Ins_First(var p: zeiger; i: t);
var h: zeiger;
begin
h:=p;
new(p);
p^.data:=i;
p^.next:=h;
end;

procedure ins_Last(var p: zeiger; i: t);
var h: zeiger;
begin
if is_Empty(p) then ins_First(p,i) else begin
h:=p;
while h^.next <> nil do h:=h^.next;
new(h^.next);
h^.next^.data:=i;
h^.next^.next:=nil;
end;
end;

function Del_First(var p: zeiger): t;
var h: zeiger;
begin
if not(is_empty(p)) then begin
del_first:=p^.data;
h:=p^.next;
{dispose(p);}
p:=h;
end;
end;

{ STANDARD-Proceduren }


{ Tree-Demo Proceduren }

procedure Draw_Tree(var tree: ref; tiefe: integer);
var Zahl: string;
begin
  if tree <> nil then begin
    Zahl:=tree^.Value;
    if tree^.right <> nil
      then draw_tree(tree^.right,Tiefe + Length(Zahl));
    Write(' ':Tiefe);
    Writeln(Zahl);
    if tree^.left <> nil
      then draw_tree(tree^.left,Tiefe + Length(Zahl));
  end else Writeln('Leerer Baum');
end;

procedure Insert_Node(var tree: ref; i: char);
begin
 if tree = nil then
 begin
   new(tree);
   tree^.left:=nil;
   tree^.right:=nil;
   tree^.value:=i;
  end else
  begin
   if i < tree^.value then
   Insert_Node(tree^.left,i)
  else
   Insert_Node(tree^.right,i);
  end;
end;

{ Rekursiv }

procedure Run(b: ref; Akt, Ausgabe: integer; var fertig: boolean);
begin
  if b <> nil
  then if akt = ausgabe
     then begin write(b^.value); fertig:= false;
          end
     else begin run(b^.left,akt+1,ausgabe,fertig);
                run(b^.right,akt+1,ausgabe,fertig);
          end;
end;

procedure Level_order_1(b: ref);
var l: integer;
    fertig: boolean;

begin l:=0;
      repeat inc(l);
      run(b,1,l,fertig);
      until fertig or keypressed;
end;

{ Iterativ - Mit Schlange }

procedure Level_order_2(b: ref);
var l: zeiger;
begin
l:=nil;

if b <> nil then ins_Last(l,b);

while not(is_Empty(l)) do
begin b:=del_first(l); write(b^.value);
      if b^.left <> nil then ins_Last(l,b^.left);
      if b^.right <> nil then ins_Last(l,b^.right);
end;
end;

{ level_order }

{                 h
              e       i
            z       l     r
            c      k s  t   o
         ss a      b d     m p
           f u           q }

begin
 TextMode(CO80 xor Lo(LastMode)+Font8x8 xor LASTMODE);

{Aus programmiertechnischen Grnden, hier anderer Baum}

   insert_Node(tree,'4');
   insert_Node(tree,'2');
   insert_Node(tree,'6');
   insert_Node(tree,'3');
   insert_Node(tree,'1');
   insert_Node(tree,'5');
   insert_Node(tree,'8');
   insert_Node(tree,'7');
   insert_Node(tree,'9');

 ClrScr;
 Draw_Tree(tree,1);
 writeLN;
 WriteLN('Level Order 1:');
 level_order_1(tree);
 writeLN;
 WriteLN('Level Order 2:');
 level_order_2(tree);
 readLN;
 readLN;
end.