{-- 26/abr/2010 --}
program BuscaEmProfundidadeListaAp;
{ Implementacao TAD Grafo com listas/apontadores }
const MAXNUMVERTICES = 100;
      MAXNUMARESTAS  = 100;
{--Entram aqui os tipos do Programa 6.1 --}
type
  TipoValorVertice = 0..MAXNUMVERTICES;
  TipoValorAresta  = 0..MAXNUMARESTAS;
  TipoItem         = record
                       Vertice: TipoValorVertice;
                       Aresta : TipoValorAresta;
                     end;
  TipoApontador    = ^TipoCelula;
  TipoCelula       = record
                       Item: TipoItem;
                       Prox: TipoApontador;
                     end;
  TipoLista        = record
                       Primeiro: TipoApontador;
                       Ultimo: TipoApontador;
                     end;
  TipoGrafo        = record
                       Adj: array[TipoValorVertice] of TipoLista;
                       NumVertices: TipoValorVertice;
                       NumArestas: TipoValorAresta;
                     end;
  TipoValorTempo   = 0..2*MaxNumvertices;
  TipoCor          = (branco, cinza, preto);
var
  i          : integer;
  V1, V2, Adj: TipoValorVertice;
  A          : TipoValorAresta;
  Grafo      : TipoGrafo;
  x          : TipoItem;
  FimListaAdj: boolean;
  NVertices  : TipoValorVertice;
  NArestas   : TipoValorAresta;

{--Entram aqui os operadores do Programa 2.4--}
procedure FLVazia (var Lista: TipoLista);
begin
  new (Lista.Primeiro);
  Lista.Ultimo := Lista.Primeiro;
  Lista.Primeiro^.Prox := nil
end; { FLVazia }

function Vazia (Lista: TipoLista): boolean;
begin
  Vazia := Lista.Primeiro = Lista.Ultimo
end; { Vazia }

procedure Insere (var x: TipoItem; var Lista: TipoLista);
{-- Insere depois do ultimo item da lista --}
begin
  new (Lista.Ultimo^.Prox);
  Lista.Ultimo := Lista.Ultimo^.Prox;
  Lista.Ultimo^.Item := x;
  Lista.Ultimo^.Prox := nil
end; { Insere }

{-- Entram aqui os operadores do Programa 6.2 --}
procedure InsereAresta (var V1, V2: TipoValorVertice;
                        var Aresta: TipoValorAresta;
                        var Grafo : TipoGrafo);
var x    : TipoItem;
    Lista: TipoLista;
begin
  x.Vertice := V2;
  x.Aresta  := Aresta;
  Insere (x, Grafo.Adj[V1]);
end; { InsereAresta }

procedure FGVazio (var Grafo: TipoGrafo);
var i: integer;
begin
  for i := 0 to Grafo.NumVertices-1 do FLVazia (Grafo.Adj[i]);
end; { FGVazio }

function ExisteAresta (Vertice1, Vertice2: TipoValorVertice;
                       var Grafo: TipoGrafo): boolean;
var Aux: TipoApontador;
    EncontrouAresta: boolean;
begin
  Aux := Grafo.Adj[Vertice1].Primeiro^.Prox;
  EncontrouAresta := false;
  while (Aux <> nil) and (EncontrouAresta = false) do
    begin
    if Vertice2 = Aux^.Item.Vertice then EncontrouAresta := true;
    Aux := Aux^.Prox;
    end;
  ExisteAresta := EncontrouAresta;
end; { ExisteAresta }

function ListaAdjVazia(var Vertice: TipoValorVertice;
                       var Grafo: TipoGrafo): boolean;
begin
  ListaAdjVazia := Grafo.Adj[Vertice].Primeiro =
                   Grafo.Adj[Vertice].Ultimo;
end; { ListaAdjVazia }

function PrimeiroListaAdj (var Vertice: TipoValorVertice;
                          var Grafo: TipoGrafo): TipoApontador;
begin
  PrimeiroListaAdj := Grafo.Adj[Vertice].Primeiro^.Prox;
end; { PrimeiroListaAdj }

procedure ProxAdj (var Vertice    : TipoValorVertice;
                   var Adj        : TipoValorVertice;
                   var Aresta     : TipoValorAresta;
                   var Prox       : TipoApontador;
                   var FimListaAdj: boolean);
{ --Retorna Adj apontado por Prox--}
begin
  Adj    := Prox^.Item.Vertice;
  Aresta := Prox^.Item.Aresta;
  Prox   := Prox^.Prox;
  if Prox = nil then FimListaAdj := true;
end; { ProxAdj }

procedure ImprimeGrafo (var Grafo: TipoGrafo);
var i: integer;

  procedure ImprimeLista (Lista: TipoLista);
  var
    Aux: TipoApontador;
  begin
    Aux := Lista.Primeiro^.Prox;
    while Aux <> nil do begin
      write (Aux^.Item.Vertice:3,' (',Aux^.Item.Aresta,')');
      Aux := Aux^.Prox;
    end;
  end; { ImprimeLista }
begin
  for i:= 0 to Grafo.NumVertices-1 do
    begin
    write ('Vertice', i:2,':');
    if not Vazia (Grafo.Adj[i]) then ImprimeLista (Grafo.Adj[i]);
    writeln;
    end;
end; { ImprimeGrafo }

procedure BuscaEmProfundidade (var Grafo: TipoGrafo);
var
  Tempo     : TipoValorTempo;
  x         : TipoValorVertice;
  d, t      : array[TipoValorVertice] of TipoValorTempo;
  Cor       : array[TipoValorVertice] of TipoCor;
  Antecessor: array[TipoValorVertice] of integer;

   procedure VisitaDfs (u:TipoValorVertice);
   var FimListaAdj: boolean;
       Peso       : TipoValorAresta;
       Aux        : TipoApontador;
       v          : TipoValorVertice;
   begin
     Cor[u] := cinza;  
     Tempo := Tempo + 1;  
     d[u] := Tempo;
     writeln('Visita',u:2,' Tempo descoberta:',d[u]:2,' cinza'); readln;
     if not ListaAdjVazia (u, Grafo)
     then begin
          Aux := PrimeiroListaAdj (u, Grafo);
          FimListaAdj := false;
          while not FimListaAdj do
            begin
            ProxAdj (u, v, Peso, Aux, FimListaAdj);
            if Cor[v] = branco
            then begin
                 Antecessor[v] := u;  VisitaDfs (v);
                 end;
            end;
          end;
     Cor[u] := preto;  
     Tempo := Tempo + 1;  t[u] := Tempo;
     writeln ('Visita',u:2,' Tempo termino:',t[u]:2,' preto'); readln;
   end; { VisitaDfs }

begin
  Tempo := 0;
  for x := 0 to Grafo.NumVertices-1 do
    begin  Cor[x] := branco;  Antecessor[x] := -1;  end;
  for x := 0 to Grafo.Numvertices-1 do
    if Cor[x] = branco then VisitaDfs (x);
end; { BuscaEmProfundidade }

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

begin {-- Programa principal --}
{ -- NumVertices: definido antes da leitura das arestas --}
{ -- NumArestas: inicializado com zero e incrementado a --}
{ -- cada chamada de InsereAresta                       --}
  write ('No. vertices:'); readln (NVertices);
  write ('No. arestas:');  readln (NArestas);
  Grafo.NumVertices := NVertices;
  Grafo.NumArestas := 0;
  FGVazio (Grafo);
  for i := 0 to NArestas-1 do
    begin
    write ('Insere V1 -- V2 -- Aresta:');
    readln (V1, V2, A);
    Grafo.NumArestas := Grafo.NumArestas + 1;
    InsereAresta (V1, V2, A, Grafo); {1 chamada : G direcionado}
   {InsereAresta (V2, V1, A, Grafo);} {2 chamadas: G nao-direcionado}
    end;
  ImprimeGrafo (Grafo);
  readln;
  BuscaEmProfundidade (Grafo);
  readln;
end.