{-- 26/abr/2010 --}
program BuscaEmProfundidadeMatriz;
const MAXNUMVERTICES = 100;
      MAXNUMARESTAS  = 100;
type
  TipoValorVertice = 0..MAXNUMVERTICES;
  TipoPeso         = integer;
  TipoGrafo        = record
                       Mat:array[TipoValorVertice,TipoValorVertice]
                                 of TipoPeso;
                       NumVertices: 0..MaxNumvertices;
                       NumArestas : 0..MAXNUMARESTAS;
                     end;
  TipoApontador    = TipoValorVertice;
  TipoCor          = (branco, cinza, preto);
  TipoValorTempo   = 0..2*MAXNUMVERTICES;
var
  Aux         : TipoApontador;
  i           : integer;
  V1, V2, Adj : TipoValorVertice;
  Peso        : TipoPeso;
  Grafo,Grafot: TipoGrafo;
  NVertices   : TipoValorVertice;
  NArestas    : 0..MAXNUMARESTAS;
  FimListaAdj : boolean;

procedure FGVazio (var Grafo: TipoGrafo);
var i, j: integer;
begin
  for i := 0 to Grafo.NumVertices do
    for j := 0 to Grafo.NumVertices do
      Grafo.mat[i, j] := 0;
end;

procedure InsereAresta (var V1, V2: TipoValorVertice;
                        var Peso  : TipoPeso;
                        var Grafo : TipoGrafo);
begin
  Grafo.Mat[V1, V2] := peso;
end;

function ExisteAresta (Vertice1, Vertice2: TipoValorVertice;
                       var Grafo: TipoGrafo): boolean;
begin
  ExisteAresta := Grafo.Mat[vertice1, Vertice2] > 0;
end; { ExisteAresta }

{-- Operadores para obter a lista de adjacentes --}
function ListaAdjVazia (var Vertice: TipoValorVertice;
                       var Grafo: TipoGrafo): boolean;
var Aux       : TipoApontador;
    ListaVazia: boolean;
begin
  ListaVazia := true;
  Aux := 0;
  while (Aux < Grafo.NumVertices) and ListaVazia do
    if Grafo.Mat[Vertice, Aux] > 0
    then ListaVazia := false
    else Aux := Aux + 1;
  ListaAdjVazia := ListaVazia = true;
end; { ListaAdjVazia }

function PrimeiroListaAdj (var Vertice: TipoValorVertice;
                           var Grafo: TipoGrafo): TipoApontador;
var Aux       : TipoApontador;
    Listavazia: boolean;
begin
  ListaVazia := true;
  Aux := 0;
  while (Aux < Grafo.NumVertices) and ListaVazia do
    if Grafo.Mat[Vertice, Aux] > 0
    then begin
         PrimeiroListaAdj := Aux;
         ListaVazia := false;
         end
    else Aux := Aux + 1;
  if Aux = Grafo.NumVertices 
  then writeln ('Erro: Lista adjacencia vazia (PrimeiroListaAdj)');
end; { PrimeiroListaAdj }

procedure ProxAdj (var Vertice     : TipoValorVertice;
                   var Grafo       : TipoGrafo;
                   var Adj         : TipoValorVertice;
                   var Peso        : TipoPeso;
                   var Prox        : TipoApontador;
                   var FimListaAdj : boolean);
{ --Retorna Adj apontado por Prox--}
begin
  Adj    := Prox;
  Peso   := Grafo.Mat[Vertice, Prox];
  Prox   := Prox + 1;
  while (Prox < Grafo.NumVertices) and
        (Grafo.Mat[Vertice, Prox] = 0) do
    Prox := Prox + 1;
  if Prox = Grafo.NumVertices then FimListaAdj := true;
end; { ProxAdj- }

procedure RetiraAresta (var V1, V2: TipoValorVertice;
                        var Peso  : TipoPeso;
                        var Grafo : TipoGrafo);
begin
  if Grafo.Mat[V1, V2] = 0
  then writeln ('Aresta nao existe')
  else begin
       Peso := Grafo.Mat[V1, V2];
       Grafo.Mat[V1, V2] := 0;
       end;
end; { RetiraAresta }

procedure LiberaGrafo (var Grafo: TipoGrafo);
begin { Nao faz nada no caso de matrizes de adjacencia }
end; { LiberaGrafo }

procedure ImprimeGrafo (var Grafo : TipoGrafo);
var i, j: integer;
begin
  write ('   ');
  for i := 0 to Grafo.NumVertices-1 do write (i:3); writeln;
  for i := 0 to Grafo.NumVertices-1 do
    begin
    write (i:3);
    for j := 0 to Grafo.NumVertices-1 do
      write (Grafo.mat[i, j]:3);
    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       : TipoPeso;
      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, Grafo, 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, Peso);
    Grafo.NumArestas := Grafo.NumArestas + 1;
    InsereAresta (V1, V2, Peso, Grafo); {1 chamada : G direcionado}
   {InsereAresta (V2, V1, Peso, Grafo);} {2 chamadas: G nao-direcionado}
    end;
  ImprimeGrafo (Grafo);
  readln;
  BuscaEmProfundidade (Grafo);
  readln;
end.