examples/pataud/ville.log

   1 program ville;\r
   2 \r
   3 (***************************************************************************)\r
   4 (*                 Structure d une place de parking                        *)\r
   5 (***************************************************************************)\r
   6 \r
   7 Unit Place : class (N : integer );\r
   8 var P1 : arrayof boolean;\r
   9 Begin\r
  10    array P1 dim (1:N);\r
  11 End Place;\r
  12 \r
  13 (***************************************************************************)\r
  14 (*        Structure de la liste des arc qui peuvent etre atteind           *)\r
  15 (***************************************************************************)\r
  16 \r
  17 Unit Liste : class;\r
  18 var pointeur: Arcs,\r
  19     suivante: Liste;\r
  20 end Liste;\r
  21 \r
  22 (***************************************************************************)\r
  23 (*                         Structure des arcs                              *)\r
  24 (***************************************************************************)\r
  25 \r
  26 Unit Arcs : class;\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
  35 End Arcs;\r
  36 \r
  37 (***************************************************************************)\r
  38 (*                          Structure des sommets                          *)\r
  39 (***************************************************************************)\r
  40 \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
  49 End Sommets;\r
  50 \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
  55 \r
  56 Unit CreeSomm : procedure( f: file);\r
  57 var Noeud : Sommets,\r
  58     tampon: char,\r
  59     arret : boolean;\r
  60 \r
  61 Begin\r
  62    readln(f);\r
  63    arret := false;\r
  64    while  not arret \r
  65    do\r
  66       read(f,tampon);\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
  73              Noeud.etat := 0;\r
  74              Noeud.ptrarc := none;\r
  75              Noeud.Suivant := RaciSomm;\r
  76              RaciSomm := Noeud;\r
  77          else arret := true;\r
  78       fi\r
  79    od;\r
  80 End CreeSomm;\r
  81 \r
  82 \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
  90 Begin\r
  91    Noeud := RaciSomm;\r
  92    while (Noeud <> none)\r
  93    do\r
  94      write("Nom: ");\r
  95      writeln(Noeud.Nom);\r
  96      writeln("X : ",Noeud.Colonne);\r
  97      writeln("Y : ",Noeud.ligne);\r
  98      parcours := Noeud.ptrarc;\r
  99      while (parcours <> none )\r
 100      do\r
 101        writeln("Arc: ",parcours.pointeur.Numero);\r
 102        parcours := parcours.suivante;\r
 103      od;\r
 104      Noeud := Noeud.suivant;\r
 105    od;\r
 106 End ParcSomm;\r
 107 \r
 108 Unit ParcArc : procedure;\r
 109 var Noeud : Arcs;\r
 110 Begin\r
 111    Noeud := RaciArcs;\r
 112    while (Noeud <> none)\r
 113    do\r
 114      write("Arc: ");\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
 121    od;\r
 122 End ParcArc;\r
 123 \r
 124 \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
 131 \r
 132 Unit CreeArcs : procedure( f: file);\r
 133 var Noeud : Arcs;\r
 134 var aux1 : char;\r
 135 var aux2 : char;\r
 136 var aux3 : char;\r
 137 Begin\r
 138    readln(f);\r
 139    readln(f);\r
 140    while ( not(eof(f)))\r
 141    do\r
 142       Noeud := new Arcs;\r
 143       read(f,Noeud.Numero);\r
 144       read(f,aux3);\r
 145       read(f,aux1);\r
 146       read(f,aux3);\r
 147       read(f,aux2);\r
 148       read(f,aux3);\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
 156       RaciArcs := Noeud;\r
 157       Call rattache(Noeud,aux1,aux2);\r
 158    od;\r
 159 End CreeArcs;\r
 160 \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
 174 \r
 175 begin\r
 176    Parcours := RaciSomm;\r
 177    while((Parcours<>none) and (Parcours.Nom<>aux1) and (Parcours.Nom<>aux2))\r
 178    do\r
 179       Parcours := Parcours.suivant;\r
 180    od;\r
 181    if Parcours.Nom = aux1\r
 182       then\r
 183         Noeud.Initial := Parcours;\r
 184         if Noeud.Sens <> -1\r
 185         then\r
 186             Call rattaListe(Parcours,Noeud);\r
 187         fi;\r
 188       else if Parcours.Nom = aux2  \r
 189                 then\r
 190                    Noeud.Final := Parcours;         \r
 191                    if Noeud.Sens <> 1\r
 192                    then\r
 193                        Call rattaListe(Parcours,Noeud);\r
 194                    fi\r
 195                 else\r
 196                     write("ERREUR de rattachement initial");\r
 197                     exit;\r
 198            fi;\r
 199    fi;\r
 200    Parcours := Parcours.suivant;\r
 201    while((Parcours<>none) and (Parcours.Nom<>aux1) and (Parcours.Nom<>aux2))\r
 202    do\r
 203       Parcours := Parcours.suivant;\r
 204    od;\r
 205    if Parcours.Nom = aux1\r
 206       then\r
 207          Noeud.Initial := Parcours;         \r
 208          if Noeud.Sens <> -1\r
 209          then\r
 210               Call rattaListe(Parcours,Noeud);\r
 211          fi;\r
 212       else if Parcours.Nom = aux2  \r
 213                 then\r
 214                     Noeud.final := parcours;\r
 215                     if Noeud.Sens <> 1\r
 216                     then\r
 217                          Call rattaListe(Parcours,Noeud);\r
 218                     fi;\r
 219                 else\r
 220                    write("ERREUR de rattachement du final");\r
 221            fi;\r
 222    fi;\r
 223 end rattache;\r
 224 \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
 229 var Noeud : Liste;\r
 230 \r
 231 begin\r
 232   Noeud := new Liste;\r
 233   Noeud.suivante := NoeudSom.ptrarc;\r
 234   Noeud.pointeur := NoeudArc;\r
 235   NoeudSom.ptrarc := Noeud;\r
 236 End RattaListe;\r
 237 \r
 238 \r
 239 (***************************************************************************)\r
 240 (*               Procedure de remplissage de la structure                  *)\r
 241 (***************************************************************************)\r
 242 \r
 243 Unit Remplie : procedure;\r
 244 var fichier : file;\r
 245 begin\r
 246    open (fichier,text,unpack("Ville1.doc"));\r
 247    call reset (fichier);\r
 248    Call CreeSomm(fichier);\r
 249    Call CreeArcs(fichier);\r
 250    Call ParcSomm;\r
 251 end Remplie;\r
 252 \r
 253 (***************************************************************************)\r
 254 (*                          PROGRAMME PRINCIPAL                            *)\r
 255 (***************************************************************************)\r
 256 \r
 257 var RaciSomm : Sommets;\r
 258 var RaciArcs : Arcs;\r
 259 \r
 260 Begin\r
 261    Call Remplie;\r
 262 End ville;\r