program topsort;
{Topologisches Sortieren v1.01}
uses crt;

const 	n=10;

type	Adjazenzliste = ^Nachbar;
	Nachbar = Record
		    key: Integer;
		    next: Adjazenzliste;
		  end;
	Graphtyp = array[1..n] of Adjazenzliste;
	Schlange = Record
		     inhalt: Array [1..n] of Integer;
		     anfang, ende: Integer;
		   end;

var a, b, i, knotenzahl  : Integer;
    graph		 : Graphtyp;
    neu, hilf		 : Adjazenzliste;
    eingangsgrad 	 : Array[1..n] of Integer;
    nullgrad, sortierung : Schlange;
    
procedure show(queue: schlange);

var i: integer;

begin
  writeln();
  write('Ausgabe Schlange:');
  if (queue.anfang < queue.ende) then
    for i:= queue.anfang to queue.ende - 1 do 
	write( ' ', queue.inhalt[i]);
end;

procedure insert(key: integer; var queue: schlange); {am Ende}
begin
  if queue.ende <= n then
    queue.inhalt[queue.ende] := key;
  inc(queue.ende);
end;

function delete(var queue: schlange): integer;	{am Anfang, Key zurück}
begin
  if queue.anfang < queue.ende 
  then
    begin
	delete := queue.inhalt[queue.anfang];
	inc(queue.anfang);
    end
  else delete := 0;
end;

begin
  a := 1;
  for i:=1 to n do graph[i] := NIL;
  for i:=1 to n do eingangsgrad[i] := 0;
  nullgrad.anfang := 1; nullgrad.ende := 1;
  for i:=1 to n do nullgrad.inhalt[i] := 0;
  sortierung.anfang := 1; sortierung.ende := 1;
  for i:=1 to n do sortierung.inhalt[i] := 0;

  writeln('Knoteneingabe (z.B. "1 2" für Kante 1 nach 2. Ende mit 0 0');
  while a > 0 do
    begin
	write('Kante (Ende 0 0): '); read(a, b);
	if (a > 0) then
	  begin
		neu := New(Adjazenzliste);
		neu^.key := b;
		neu^.next:= nil;
		if graph[a] = nil 
	  	  then graph[a] := neu
	  	  else begin
		  	 hilf:=graph[a];
		  	 while (hilf^.next <> nil) AND (hilf^.next^.key < b) do
			   hilf:= hilf^.next;	{geordnet: richtige Position}
		  	 if hilf^.key > b 
			   then begin
				  neu^.next:= hilf;
				  graph[a]:= neu;
				end
			   else begin
				  neu^.next:= hilf^.next;	{Einfügen}
		  	 	  hilf^.next:= neu;
				end;
	       	       end;{of else graph[a]=nil}
	  end;{of if a}
    end;{of while a}

  write('Knotenanzahl: '); read(knotenzahl);
  write('Graphausgabe: ');
  for i:=1 to knotenzahl do
    begin
	writeln;
	hilf := graph[i];
	write(i);
	while hilf <> NIL do
	  begin
	    write(' ', hilf^.key);
	    hilf := hilf^.next;
	  end;
    end;

  writeln;
  for i:=1 to knotenzahl do			{Eingangsgrad bestimmen}
    begin
	hilf := graph[i];
	while hilf <> NIL do
	  begin
	    inc(eingangsgrad[ hilf^.key ]);		{ +1}
	    hilf := hilf^.next;
	  end;
    end;

  for i:=1 to knotenzahl do			{Schlange mit egrad=0 fuellen}
    if eingangsgrad[i] = 0 then insert(i, nullgrad);

  for i:=1 to knotenzahl do			{Sortierung machen}
    begin
	show(nullgrad);
	a := delete(nullgrad);
      	if a > 0 then insert(a, sortierung);
	if a > 0 then hilf := graph[a]
		 else hilf := NIL;
	while hilf <> NIL do			{Schlange auffuellen}
	  begin
	    dec( eingangsgrad[ hilf^.key ] ); { -1}
	    if eingangsgrad[ hilf^.key ] = 0 
	      then insert(hilf^.key, nullgrad);
	    hilf := hilf^.next;
	  end;
    end;

  writeln;
  writeln('Ausgabe topologische Sortierung: ');
  a := delete(sortierung);
  while a > 0 do
    begin
	write(a, ' ');
	a := delete(sortierung);	
    end;
  writeln;
end.