program graph_demo (infile1, output);

const
  vtmax = 50; {maximum number of vertices in the graph}

{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

      GRAPH ADT  -  DECLARATIONS}

type
  infotype = integer;
  list = ^listype;
  position = list;
  listype = record
              info: infotype;
              next: list
            end;
  graph = ^graphtype;
  vtposition = graph;
  graphtype = record
                info: infotype;
                child: list;
                next: graph
              end;
  vtmarkers = array[1..vtmax] of boolean;

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}

var
  infile1: text;
  G: graph;
  A: vtmarkers;
  c: integer;

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

       LIST ADT (WITHOUT HEADER)  -  CODE}

function FIRST (var L: list): position;
  begin
    FIRST:=L
  end;
function ENDLIS (L: list): position;
  begin
    ENDLIS:= nil
  end;
function NEXT (p: position; L:list): position;
  begin
    NEXT:= p^.next
  end;
function LOCATE (x: infotype; L: list): position;
  var
    p: position;
    found: boolean;
  begin
    p:= L;
    found:= false;
    while ((p<>nil) and (not found)) do
      if p^.info = x
        then
          found:= true
        else
          p:= p^.next;
    LOCATE:= p
  end;
function RETRIEVE (p: position; L: list): infotype;
  begin
    RETRIEVE:= p^.info
  end;
procedure DELETE (var p: position; var L: list);
  var
    s,t: position;
  begin
    if p=L
      then
        begin
          L:= L^.next;
          p:= L
        end
      else
        begin
          s:= L;
          t:= L^.next;
          while t<>p do
            begin
              s:= s^.next;
              t:= t^.next
            end;
          s^.next:= p^.next;
          s:= p;
          p:= p^.next;
          dispose (s)
        end
  end;
procedure MAKENULLIS (var L: list);
  begin
    L:=nil
  end;
procedure INSERT (x: infotype; var p: position; var L: list);
  var
    q: position;
  begin
    new(q);
    q^.info:=x;
    q^.next:=nil;
    if p=nil
      then
        L:=q
      else
        p^.next:= q;
    p:= q
  end;

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

        GRAPH ADT  -  CODE}

function LOCATEVRTX (x: infotype; G: graph): vtposition;
  var
    p: vtposition;
    found: boolean;
  begin
    p:= G;
    found:= false;
    while ((p<>nil) and (not found)) do
      if p^.info = x
        then
          found:= true
        else
          p:= p^.next;
    LOCATEVRTX:= p
  end;
procedure MAKENULLG (var G: graph);
  begin
    G:= nil
  end;
procedure INSERTVRTX (x: infotype; var p: vtposition; var G: graph);
  var
    q: vtposition;
  begin
    new(q);
    q^.info:= x;
    q^.next:= nil;
    MAKENULLIS(q^.child);
    if p=nil
      then
        G:= q
      else
        p^.next:= q;
    p:= q
  end;
procedure INSERTEDGE (x: infotype; var ep: position; vp: vtposition);
  begin
    INSERT (x, ep, vp^.child)
  end;
function FIRSTEDGE (p: vtposition; G: graph): position;
  begin
    FIRSTEDGE:= p^.child
  end;
function VRTXLABEL (n: vtposition; G: graph): infotype;
  begin
    VRTXLABEL:= n^.info
  end;
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}

procedure read_in (var f: text; var G: graph);
    {read_in reads the input text file and puts the elements in graph G.
     Each line consists of one integer for the graph vertex label, followed
     by a list of the adjacent vertices.}
  var
    i: infotype;
    vp: vtposition;
    ep: position;
  begin
    MAKENULLG(G);
    vp:= nil;
    while not eof(f) do
      begin
        read (f,i);
        write (i:3,' : ');
        INSERTVRTX (i, vp, G);
        ep:= FIRSTEDGE (vp, G);
        while not eoln(f) do
          begin
            read (f,i);
            write (i:3);
            INSERTEDGE (i, ep, vp);
          end;
        readln (f);
        writeln
      end
  end;

procedure dfs (v: infotype; var A: vtmarkers);
  var
    w: position;
    L: list;
  begin
    A[v]:= true; {mark this node as visited and print it}
    write (v:3);
    L:= FIRSTEDGE( LOCATEVRTX(v, G), G); {get its adjacency list}
    w:= FIRST(L);
    while w <> ENDLIS(L) do
      begin
        if not A[ RETRIEVE (w, L)]   {call dfs for all unvisited vertices}
          then                       {on the adjacency list}
            dfs( RETRIEVE(w, L), A);
        w:= NEXT(w, L)
      end
  end;

{     *  *  *     MAIN PROGRAM CODE STARTS HERE    *  *  *}

  begin
    reset(infile1);
    for c:=1 to vtmax do {initialize marker array, all vertices are unvisited}
      A[c]:= false;
    writeln;
    read_in (infile1, G);
    writeln;
    writeln;
    writeln ('The vertices are listed below in the order visited by dfs.');
    writeln;
    dfs (VRTXLABEL(G, G), A);
    writeln
  end.
