program ville;

(***************************************************************************)
(*                 Structure d une place de parking                        *)
(***************************************************************************)

Unit Place : class (N : integer );
var P1 : arrayof boolean;
Begin
   array P1 dim (1:N);
End Place;

(***************************************************************************)
(*        Structure de la liste des arc qui peuvent etre atteind           *)
(***************************************************************************)

Unit Liste : class;
var pointeur: Arcs,
    suivante: Liste;
end Liste;

(***************************************************************************)
(*                         Structure des arcs                              *)
(***************************************************************************)

Unit Arcs : class;
var Numero  : integer,  (* Identification de l'arc *)
    Initial : Sommets,  (* Sommet initial *)
    Final   : Sommets,  (* Sommet final *)
    Sens    : integer,     (* Sens de circulation *)
    Distance: integer,  (* Distance de initial a final*)
    NbvoieIF: integer,  (* Nombre de voie dans le sens 1 *)
    NbvoieFI: integer,  (* Nombre de voie dans le sens -1 *)
    Suivants: Arcs;     (* Pointeur sur les suivants *)
End Arcs;

(***************************************************************************)
(*                          Structure des sommets                          *)
(***************************************************************************)

Unit Sommets : class;
var Nom      : char,     (* Nom du sommet *) 
    typecar  : integer,  (* Type carrefour 0:feu , 1:priorite , 2:stop *)
    Ligne    : integer,  (* Correspond a la position en Y sur ecran *)
    Colonne  : integer,  (* Correspond a la position en X sur ecran *)
    etat     : integer,  (* Etat du carrefour *)
    ptrarc   : Liste,    (* Pointeur sur la liste pointant sur les arcs *)
    suivant  : Sommets;  (* Pointeur sur les suivants *)
End Sommets;

(***************************************************************************)
(*              Procedure creant la liste des Sommets                      *)
(*    Ici il y a juste creation d un liste simple de sommet en mode pile   *)
(***************************************************************************)

Unit CreeSomm : procedure( f: file);
var Noeud : Sommets,
    tampon: char,
    arret : boolean;

Begin
   readln(f);
   arret := false;
   while  not arret 
   do
      read(f,tampon);
      if ( tampon <> '.') then
             Noeud := new Sommets;
             Noeud.Nom := tampon;
             read(f,Noeud.typecar);
             read(f,Noeud.colonne);
             readln(f,Noeud.ligne);
             Noeud.etat := 0;
             Noeud.ptrarc := none;
             Noeud.Suivant := RaciSomm;
             RaciSomm := Noeud;
         else arret := true;
      fi
   od;
End CreeSomm;


(***************************************************************************)
(* Procedure affichant chaque sommet ainsi que les arcs que l'on peut      *)
(* prendre depuis ce sommet en considerant les sens de circulation etc...  *)
(***************************************************************************)
Unit ParcSomm : procedure;
var Noeud : Sommets;
var parcours : Liste;
Begin
   Noeud := RaciSomm;
   while (Noeud <> none)
   do
     write("Nom: ");
     writeln(Noeud.Nom);
     writeln("X : ",Noeud.Colonne);
     writeln("Y : ",Noeud.ligne);
     parcours := Noeud.ptrarc;
     while (parcours <> none )
     do
       writeln("Arc: ",parcours.pointeur.Numero);
       parcours := parcours.suivante;
     od;
     Noeud := Noeud.suivant;
   od;
End ParcSomm;

Unit ParcArc : procedure;
var Noeud : Arcs;
Begin
   Noeud := RaciArcs;
   while (Noeud <> none)
   do
     write("Arc: ");
     writeln(Noeud.Numero);
     writeln("Initial:",Noeud.Initial.Nom);
     writeln("Coordonnees:",Noeud.Initial.Ligne,",",Noeud.Initial.Colonne);
     writeln("Final:",Noeud.Final.Nom);
     writeln("Coordonnees:",Noeud.Final.Ligne,",",Noeud.Final.Colonne);
     Noeud := Noeud.suivants;
   od;
End ParcArc;


(***************************************************************************)
(*              Procedure creant la liste des Arc                          *)
(* Ici on cree la liste des Arc sur la base d'une pile, puis il y a        *)
(* rattachement des pointeurs final et initial avec la liste des sommets   *)
(* et ce grace a la procedure rattache.                                    *)           
(***************************************************************************)

Unit CreeArcs : procedure( f: file);
var Noeud : Arcs;
var aux1 : char;
var aux2 : char;
var aux3 : char;
Begin
   readln(f);
   readln(f);
   while ( not(eof(f)))
   do
      Noeud := new Arcs;
      read(f,Noeud.Numero);
      read(f,aux3);
      read(f,aux1);
      read(f,aux3);
      read(f,aux2);
      read(f,aux3);
      read(f,Noeud.Sens);
      read(f,Noeud.distance);
      read(f,Noeud.NbvoieIF);
      readln(f,Noeud.NbvoieFI);
      Noeud.Initial := none;
      Noeud.Final := none;
      Noeud.Suivants:= RaciArcs;
      RaciArcs := Noeud;
      Call rattache(Noeud,aux1,aux2);
   od;
End CreeArcs;

(***************************************************************************)
(*             Rattachement du pointeur arc avec le sommet                 *)
(* Cette procedure rattache les pointeurs final et initial des arcs avec   *)
(* un sommet de la liste des sommets.                                      *)
(* Puis il y a la procedure creant la liste des arcs que l'on peut         *)
(* emprunter depuis ce sommet. Cette procedure est appele ici.             *) 
(* Pour l appelle de cette procedure RattaListe nous verifions le sens de  *)
(* circulation dans les arcs, en effet des arcs ne peuvent pas etre pris a *)
(* partir de certain sommets, donc il ne doivent pas figurer dans cette    *)
(* liste( Sens interdits ).                                                *)
(***************************************************************************)
Unit Rattache : procedure ( inout  Noeud : Arcs ; aux1,aux2:char);
var Parcours : Sommets;

begin
   Parcours := RaciSomm;
   while((Parcours<>none) and (Parcours.Nom<>aux1) and (Parcours.Nom<>aux2))
   do
      Parcours := Parcours.suivant;
   od;
   if Parcours.Nom = aux1
      then
        Noeud.Initial := Parcours;
        if Noeud.Sens <> -1
        then
            Call rattaListe(Parcours,Noeud);
        fi;
      else if Parcours.Nom = aux2  
                then
                   Noeud.Final := Parcours;         
                   if Noeud.Sens <> 1
                   then
                       Call rattaListe(Parcours,Noeud);
                   fi
                else
                    write("ERREUR de rattachement initial");
                    exit;
           fi;
   fi;
   Parcours := Parcours.suivant;
   while((Parcours<>none) and (Parcours.Nom<>aux1) and (Parcours.Nom<>aux2))
   do
      Parcours := Parcours.suivant;
   od;
   if Parcours.Nom = aux1
      then
         Noeud.Initial := Parcours;         
         if Noeud.Sens <> -1
         then
              Call rattaListe(Parcours,Noeud);
         fi;
      else if Parcours.Nom = aux2  
                then
                    Noeud.final := parcours;
                    if Noeud.Sens <> 1
                    then
                         Call rattaListe(Parcours,Noeud);
                    fi;
                else
                   write("ERREUR de rattachement du final");
           fi;
   fi;
end rattache;

(***************************************************************************)
(*  Rattachement des sommets a la liste des arc qui peuvent etres atteinds *)
(***************************************************************************)
Unit RattaListe : procedure (inout NoeudSom : sommets; NoeudArc : Arcs);
var Noeud : Liste;

begin
  Noeud := new Liste;
  Noeud.suivante := NoeudSom.ptrarc;
  Noeud.pointeur := NoeudArc;
  NoeudSom.ptrarc := Noeud;
End RattaListe;


(***************************************************************************)
(*               Procedure de remplissage de la structure                  *)
(***************************************************************************)

Unit Remplie : procedure;
var fichier : file;
begin
   open (fichier,text,unpack("Ville1.doc"));
   call reset (fichier);
   Call CreeSomm(fichier);
   Call CreeArcs(fichier);
   Call ParcSomm;
end Remplie;

(***************************************************************************)
(*                          PROGRAMME PRINCIPAL                            *)
(***************************************************************************)

var RaciSomm : Sommets;
var RaciArcs : Arcs;

Begin
   Call Remplie;
End ville;