3 (***************************************************************************)
\r
4 (* Structure d une place de parking *)
\r
5 (***************************************************************************)
\r
7 Unit Place : class (N : integer );
\r
8 var P1 : arrayof boolean;
\r
13 (***************************************************************************)
\r
14 (* Structure de la liste des arc qui peuvent etre atteind *)
\r
15 (***************************************************************************)
\r
22 (***************************************************************************)
\r
23 (* Structure des arcs *)
\r
24 (***************************************************************************)
\r
27 var Numero : integer, (* Identification de l'arc *)
\r
28 Initial : Sommets, (* Sommet initial *)
\r
29 Final : Sommets, (* Sommet final *)
\r
30 Sens : integer, (* Sens de circulation *)
\r
31 Distance: integer, (* Distance de initial a final*)
\r
32 NbvoieIF: integer, (* Nombre de voie dans le sens 1 *)
\r
33 NbvoieFI: integer, (* Nombre de voie dans le sens -1 *)
\r
34 Suivants: Arcs; (* Pointeur sur les suivants *)
\r
37 (***************************************************************************)
\r
38 (* Structure des sommets *)
\r
39 (***************************************************************************)
\r
41 Unit Sommets : class;
\r
42 var Nom : char, (* Nom du sommet *)
\r
43 typecar : integer, (* Type carrefour 0:feu , 1:priorite , 2:stop *)
\r
44 Ligne : integer, (* Correspond a la position en Y sur ecran *)
\r
45 Colonne : integer, (* Correspond a la position en X sur ecran *)
\r
46 etat : integer, (* Etat du carrefour *)
\r
47 ptrarc : Liste, (* Pointeur sur la liste pointant sur les arcs *)
\r
48 suivant : Sommets; (* Pointeur sur les suivants *)
\r
51 (***************************************************************************)
\r
52 (* Procedure creant la liste des Sommets *)
\r
53 (* Ici il y a juste creation d un liste simple de sommet en mode pile *)
\r
54 (***************************************************************************)
\r
56 Unit CreeSomm : procedure( f: file);
\r
57 var Noeud : Sommets,
\r
67 if ( tampon <> '.') then
\r
68 Noeud := new Sommets;
\r
69 Noeud.Nom := tampon;
\r
70 read(f,Noeud.typecar);
\r
71 read(f,Noeud.colonne);
\r
72 readln(f,Noeud.ligne);
\r
74 Noeud.ptrarc := none;
\r
75 Noeud.Suivant := RaciSomm;
\r
83 (***************************************************************************)
\r
84 (* Procedure affichant chaque sommet ainsi que les arcs que l'on peut *)
\r
85 (* prendre depuis ce sommet en considerant les sens de circulation etc... *)
\r
86 (***************************************************************************)
\r
87 Unit ParcSomm : procedure;
\r
88 var Noeud : Sommets;
\r
89 var parcours : Liste;
\r
92 while (Noeud <> none)
\r
96 writeln("X : ",Noeud.Colonne);
\r
97 writeln("Y : ",Noeud.ligne);
\r
98 parcours := Noeud.ptrarc;
\r
99 while (parcours <> none )
\r
101 writeln("Arc: ",parcours.pointeur.Numero);
\r
102 parcours := parcours.suivante;
\r
104 Noeud := Noeud.suivant;
\r
108 Unit ParcArc : procedure;
\r
112 while (Noeud <> none)
\r
115 writeln(Noeud.Numero);
\r
116 writeln("Initial:",Noeud.Initial.Nom);
\r
117 writeln("Coordonnees:",Noeud.Initial.Ligne,",",Noeud.Initial.Colonne);
\r
118 writeln("Final:",Noeud.Final.Nom);
\r
119 writeln("Coordonnees:",Noeud.Final.Ligne,",",Noeud.Final.Colonne);
\r
120 Noeud := Noeud.suivants;
\r
125 (***************************************************************************)
\r
126 (* Procedure creant la liste des Arc *)
\r
127 (* Ici on cree la liste des Arc sur la base d'une pile, puis il y a *)
\r
128 (* rattachement des pointeurs final et initial avec la liste des sommets *)
\r
129 (* et ce grace a la procedure rattache. *)
\r
130 (***************************************************************************)
\r
132 Unit CreeArcs : procedure( f: file);
\r
140 while ( not(eof(f)))
\r
143 read(f,Noeud.Numero);
\r
149 read(f,Noeud.Sens);
\r
150 read(f,Noeud.distance);
\r
151 read(f,Noeud.NbvoieIF);
\r
152 readln(f,Noeud.NbvoieFI);
\r
153 Noeud.Initial := none;
\r
154 Noeud.Final := none;
\r
155 Noeud.Suivants:= RaciArcs;
\r
157 Call rattache(Noeud,aux1,aux2);
\r
161 (***************************************************************************)
\r
162 (* Rattachement du pointeur arc avec le sommet *)
\r
163 (* Cette procedure rattache les pointeurs final et initial des arcs avec *)
\r
164 (* un sommet de la liste des sommets. *)
\r
165 (* Puis il y a la procedure creant la liste des arcs que l'on peut *)
\r
166 (* emprunter depuis ce sommet. Cette procedure est appele ici. *)
\r
167 (* Pour l appelle de cette procedure RattaListe nous verifions le sens de *)
\r
168 (* circulation dans les arcs, en effet des arcs ne peuvent pas etre pris a *)
\r
169 (* partir de certain sommets, donc il ne doivent pas figurer dans cette *)
\r
170 (* liste( Sens interdits ). *)
\r
171 (***************************************************************************)
\r
172 Unit Rattache : procedure ( inout Noeud : Arcs ; aux1,aux2:char);
\r
173 var Parcours : Sommets;
\r
176 Parcours := RaciSomm;
\r
177 while((Parcours<>none) and (Parcours.Nom<>aux1) and (Parcours.Nom<>aux2))
\r
179 Parcours := Parcours.suivant;
\r
181 if Parcours.Nom = aux1
\r
183 Noeud.Initial := Parcours;
\r
184 if Noeud.Sens <> -1
\r
186 Call rattaListe(Parcours,Noeud);
\r
188 else if Parcours.Nom = aux2
\r
190 Noeud.Final := Parcours;
\r
193 Call rattaListe(Parcours,Noeud);
\r
196 write("ERREUR de rattachement initial");
\r
200 Parcours := Parcours.suivant;
\r
201 while((Parcours<>none) and (Parcours.Nom<>aux1) and (Parcours.Nom<>aux2))
\r
203 Parcours := Parcours.suivant;
\r
205 if Parcours.Nom = aux1
\r
207 Noeud.Initial := Parcours;
\r
208 if Noeud.Sens <> -1
\r
210 Call rattaListe(Parcours,Noeud);
\r
212 else if Parcours.Nom = aux2
\r
214 Noeud.final := parcours;
\r
217 Call rattaListe(Parcours,Noeud);
\r
220 write("ERREUR de rattachement du final");
\r
225 (***************************************************************************)
\r
226 (* Rattachement des sommets a la liste des arc qui peuvent etres atteinds *)
\r
227 (***************************************************************************)
\r
228 Unit RattaListe : procedure (inout NoeudSom : sommets; NoeudArc : Arcs);
\r
232 Noeud := new Liste;
\r
233 Noeud.suivante := NoeudSom.ptrarc;
\r
234 Noeud.pointeur := NoeudArc;
\r
235 NoeudSom.ptrarc := Noeud;
\r
239 (***************************************************************************)
\r
240 (* Procedure de remplissage de la structure *)
\r
241 (***************************************************************************)
\r
243 Unit Remplie : procedure;
\r
244 var fichier : file;
\r
246 open (fichier,text,unpack("Ville1.doc"));
\r
247 call reset (fichier);
\r
248 Call CreeSomm(fichier);
\r
249 Call CreeArcs(fichier);
\r
253 (***************************************************************************)
\r
254 (* PROGRAMME PRINCIPAL *)
\r
255 (***************************************************************************)
\r
257 var RaciSomm : Sommets;
\r
258 var RaciArcs : Arcs;
\r