Program simulation;

(***************************************************************************)
(* Programme de systŠme de fenetrage avec boutons et gestion de la souris  *)
(* ainsi que de simulation d'un r‚seau routier en ville.                   *)
(* BARETS Olivier & PATAUD Fr‚d‚ric & PEYRAT Fran‡ois            1993/1994 *)
(*  plateforme : PC-DOS_386 avec clavier 102 touches / mode VGA / souris   *)
(*               PC 486DX33 16Mo Ram                                       *)
(***************************************************************************)

Begin
Pref iiuwgraph block
  
  Begin
  Pref mouse block

 Const Noir       = 0, Bleu        = 1, Vert        = 2, Cyan        = 3,
       Rouge      = 4, Magenta     = 5, Marron      = 6, GrisClair   = 7,
       GrisFonce  = 8, BleuClair   = 9, VertClair   =10, CyanClair   =11,
       RougeClair =12, MagentaClair=13, Jaune       =14, Blanc       =15;
 
 Const T_F1     =315, T_F2     =316, T_F3     =317, T_F4     =318,
       T_F5     =319, T_F6     =320, T_F7     =321, T_F8     =322,
       T_F9     =323, T_F10    =324, T_SHFTF1 =340, T_SHFTF2 =341,
       T_SHFTF3 =342, T_SHFTF4 =343, T_SHFTF5 =344, T_SHFTF6 =345,
       T_SHFTF7 =346, T_SHFTF8 =347, T_SHFTF9 =348, T_SHFTF10=349,
       T_CTRLF1 =350, T_CTRLF2 =351, T_CTRLF3 =352, T_CTRLF4 =353, 
       T_CTRLF5 =354, T_CTRLF6 =355, T_CTRLF7 =356, T_CTRLF8 =357, 
       T_CTRLF9 =358, T_CTRLF10=359, T_ALTF1  =360, T_ALTF2  =361, 
       T_ALTF3  =362, T_ALTF4  =363, T_ALTF5  =364, T_ALTF6  =365, 
       T_ALTF7  =366, T_ALTF8  =367, T_ALTF9  =368, T_ALTF10 =369,
       Tou_Ent  =013, T_ESC    =027, T_N      =078, T_Y      =089,
       T_FLGCH  =331, T_FLDTE  =333, T_FLHAU  =328, T_FLBAS  =336,
       T_ALT1   =376, T_ALT2   =377, T_PGUP   =329, T_PGDOWN =337;

 Var   SIZEX : integer,
       SIZEY : integer;


(* les variables du systŠme de fenetrage   *)

 Var code     : integer,
     Larg_Vil : integer,  (* largeur de la ville                          *)
     Haut_Vil : integer,  (* Hauteur de la ville                          *)
     Larg_Aff : integer,  (* largeur de l'interieur de la fenetre maine   *)
     Haut_Aff : integer,  (* hauteur de l'interieur de la fenetre maine   *)
     Xdep_Aff : integer,  (* Point de depart de l'affichage en X ds maine *)
     Ydep_Aff : integer,  (* point de depart de l'affichage en Y ds maine *)
     COEF_X   : real,     (* coeficient de zoom en x                      *)
     COEF_Y   : real,     (* coeficient de zoom en y                      *)
     COORD_X  : integer,  (* coordonn‚e en X de Xdep_Aff en relatif       *)
     COORD_Y  : integer,  (* coordonn‚e en Y de Ydep_Aff en relatif       *)
     W        : Maine,
     Keys     : ListKey,
     M        : arrayof Menu,
     clics    : cliquer;


(* les variables de la simulation *)

 Var RaciSomm   : Sommets,
     RaciArcs   : Arcs,
     NbCarActiv : integer,
     NBSOMMETS  : integer;

   Unit pointeur : class;
   End pointeur;



(***************************************************************************)
(*          definition des classes et procedures de simprocess             *)
(***************************************************************************)


UNIT PRIORITYQUEUE: CLASS;

  (* HEAP AS BINARY LINKED TREE WITH FATHER LINK*)


     UNIT QUEUEHEAD: CLASS;
	(* HEAP ACCESING MODULE *)
	     VAR LAST,ROOT:NODE;
 
	     UNIT MIN: FUNCTION: ELEM;
		  BEGIN
		IF ROOT=/= NONE THEN RESULT:=ROOT.EL FI;
		 END MIN;
 
	     UNIT INSERT: PROCEDURE(R:ELEM);
	       (* INSERTION INTO HEAP *)
		   VAR X,Z:NODE;
		 BEGIN
		       X:= R.LAB;
		       IF LAST=NONE THEN
			 ROOT:=X;
			 ROOT.LEFT,ROOT.RIGHT,LAST:=ROOT
		       ELSE
			 IF LAST.NS=0 THEN
			   LAST.NS:=1;
			   Z:=LAST.LEFT;
			   LAST.LEFT:=X;
			   X.UP:=LAST;
			   X.LEFT:=Z;
			   Z.RIGHT:=X;
			 ELSE
			   LAST.NS:=2;
			   Z:=LAST.RIGHT;
			   LAST.RIGHT:=X;
			   X.RIGHT:=Z;
			   X.UP:=LAST;
			   Z.LEFT:=X;
			   LAST.LEFT.RIGHT:=X;
			   X.LEFT:=LAST.LEFT;
			   LAST:=Z;
			 FI
		       FI;
		       CALL CORRECT(R,FALSE)
		       END INSERT;

UNIT DELETE: PROCEDURE(R: ELEM);
     VAR X,Y,Z:NODE;
     BEGIN
     X:=R.LAB;
     Z:=LAST.LEFT;
     IF LAST.NS =0 THEN
	   Y:= Z.UP;
	   Y.RIGHT:= LAST;
	   LAST.LEFT:=Y;
	   LAST:=Y;
		   ELSE
	   Y:= Z.LEFT;
	   Y.RIGHT:= LAST;
	    LAST.LEFT:= Y;
		    FI;
       Z.EL.LAB:=X;
       X.EL:= Z.EL;
       LAST.NS:= LAST.NS-1;
       R.LAB:=Z;
       Z.EL:=R;
       IF X.LESS(X.UP) THEN CALL CORRECT(X.EL,FALSE)
		       ELSE CALL CORRECT(X.EL,TRUE) FI;
     END DELETE;

UNIT CORRECT: PROCEDURE(R:ELEM,DOWN:BOOLEAN);
   (* CORRECTION OF THE HEAP WITH STRUCTURE BROKEN BY R *)
     VAR X,Z:NODE,T:ELEM,FIN,LOG:BOOLEAN;
     BEGIN
     Z:=R.LAB;
     IF DOWN THEN
	  WHILE NOT FIN DO
		 IF Z.NS =0 THEN FIN:=TRUE ELSE
		      IF Z.NS=1 THEN X:=Z.LEFT ELSE
		      IF Z.LEFT.LESS(Z.RIGHT) THEN X:=Z.LEFT ELSE X:=Z.RIGHT
		       FI; FI;
		      IF Z.LESS(X) THEN FIN:=TRUE ELSE
			    T:=X.EL;
			    X.EL:=Z.EL;
			    Z.EL:=T;
			    Z.EL.LAB:=Z;
			   X.EL.LAB:=X
		      FI; FI;
		 Z:=X;
		       OD
	      ELSE
    X:=Z.UP;
    IF X=NONE THEN LOG:=TRUE ELSE LOG:=X.LESS(Z); FI;
    WHILE NOT LOG DO
	  T:=Z.EL;
	  Z.EL:=X.EL;
	   X.EL:=T;
	  X.EL.LAB:=X;
	  Z.EL.LAB:=Z;
	  Z:=X;
	  X:=Z.UP;
	   IF X=NONE THEN LOG:=TRUE ELSE LOG:=X.LESS(Z);
	    FI;
		OD
     FI;
 END CORRECT;

END QUEUEHEAD;


     UNIT NODE: CLASS (EL:ELEM);
       (* ELEMENT OF THE HEAP *)
	   VAR LEFT,RIGHT,UP: NODE, NS:INTEGER;
	   UNIT LESS: FUNCTION(X:NODE): BOOLEAN;
	       BEGIN
	       IF X= NONE THEN RESULT:=FALSE
			 ELSE RESULT:=EL.LESS(X.EL) FI;
	       END LESS;
	  END NODE;


     UNIT ELEM: CLASS(PRIOR:REAL);
       (* PREFIX OF INFORMATION TO BE STORED IN NODE *)
	VAR LAB: NODE;
	UNIT VIRTUAL LESS: FUNCTION(X:ELEM):BOOLEAN;
		 BEGIN
		 IF X=NONE THEN RESULT:= FALSE ELSE
				RESULT:= PRIOR< X.PRIOR FI;
		 END LESS;
	 BEGIN
	 LAB:= NEW NODE(THIS ELEM);
	 END ELEM;


END PRIORITYQUEUE;


 
UNIT SIMULATION: PRIORITYQUEUE CLASS;
(* THE LANGUAGE FOR SIMULATION PURPOSES *)
 
  VAR CURR: SIMPROCESS,  (*ACTIVE PROCESS *)
      PQ:QUEUEHEAD,  (* THE TIME AXIS *)
       MAINPR: MAINPROGRAM;
 
 
      UNIT SIMPROCESS: pointeur COROUTINE;
	(* USER PROCESS PREFIX *)
	     VAR EVENT,  (* ACTIVATION MOMENT NOTICE *)
		 EVENTAUX: EVENTNOTICE,
		 (* THIS IS FOR AVOIDING MANY NEW CALLS AS AN RESULT OF *)
		 (* SUBSEQUENT PASSIVATIONS AND ACTIVATIONS             *)
		 FINISH: BOOLEAN;
 
	     UNIT IDLE: FUNCTION: BOOLEAN;
		   BEGIN
		   RESULT:= EVENT= NONE;
		   END IDLE;
 
	     UNIT TERMINATED: FUNCTION :BOOLEAN;
		   BEGIN
		  RESULT:= FINISH;
		   END TERMINATED;
 
	     UNIT EVTIME: FUNCTION: REAL;
	     (* TIME OF ACTIVATION *)
		  BEGIN
		  IF IDLE THEN CALL ERROR1;
					   FI;
		  RESULT:= EVENT.EVENTTIME;
		  END EVTIME;
 
    UNIT ERROR1:PROCEDURE;
		BEGIN
		ATTACH(MAIN);
		WRITELN(" AN ATTEMPT TO ACCESS AN IDLE PROCESS TIME");
		END ERROR1;
 
     UNIT ERROR2:PROCEDURE;
		 BEGIN
		 ATTACH(MAIN);
		 WRITELN(" AN ATTEMPT TO ACCESS A TERMINATED PROCESS TIME");
		 END ERROR2;
	     BEGIN
 
	     RETURN;
	     INNER;
	     FINISH:=TRUE;
	      CALL PASSIVATE;
	     CALL ERROR2;
	  END SIMPROCESS;
 
 
UNIT EVENTNOTICE: ELEM CLASS;
  (* A PROCESS ACTIVATION NOTICE TO BE PLACED ONTO THE TIME AXIS PQ *)
      VAR EVENTTIME: REAL, PROC: SIMPROCESS;
 
      UNIT VIRTUAL LESS: FUNCTION(X: EVENTNOTICE):BOOLEAN;
       (* OVERWRITE THE FORMER VERSION CONSIDERING EVENTTIME *)
		  BEGIN
		  IF X=NONE THEN RESULT:= FALSE ELSE
		  RESULT:= EVENTTIME< X.EVENTTIME OR
		  (EVENTTIME=X.EVENTTIME AND PRIOR< X.PRIOR); FI;
 
	       END LESS;
    END EVENTNOTICE;
 
 
UNIT MAINPROGRAM: SIMPROCESS CLASS;
 (* IMPLEMENTING MASTER PROGRAM AS A PROCESS *)
      BEGIN
      DO ATTACH(MAIN) OD;
      END MAINPROGRAM;
 
UNIT TIME:FUNCTION:REAL;
 (* CURRENT VALUE OF SIMULATION TIME *)
     BEGIN
     RESULT:=CURRENT.EVTIME
     END TIME;
 
UNIT CURRENT: FUNCTION: SIMPROCESS;
   (* THE FIRST PROCESS ON THE TIME AXIS *)
     BEGIN
     RESULT:=CURR;
     END CURRENT;

UNIT SCHEDULE: PROCEDURE(P:SIMPROCESS,T:REAL);
 (* ACTIVATION OF PROCESS P AT TIME T AND DEFINITION OF "PRIOR"- PRIORITY *)
 (* WITHIN TIME MOMENT T                                                  *)
      BEGIN
      IF T<TIME THEN T:= TIME FI;
      IF P=CURRENT THEN CALL HOLD(T-TIME) ELSE
      IF P.IDLE AND P.EVENTAUX=NONE THEN (* HAS NOT BEEN SCHEDULED YET*)
		P.EVENT,P.EVENTAUX:= NEW EVENTNOTICE(RANDOM);
		P.EVENT.PROC:= P;
				      ELSE
       IF P.IDLE (* P HAS ALREADY BEEN SCHEDULED *) THEN
	       P.EVENT:= P.EVENTAUX;
	       P.EVENT.PRIOR:=RANDOM;
					  ELSE
   (* NEW SCHEDULING *)
	       P.EVENT.PRIOR:=RANDOM;
	       CALL PQ.DELETE(P.EVENT)
				FI; FI;
      P.EVENT.EVENTTIME:= T;
      CALL PQ.INSERT(P.EVENT) FI;
END SCHEDULE;
 
UNIT HOLD:PROCEDURE(T:REAL);
 (* MOVE THE ACTIVE PROCESS T MINUTES BACK ALONG PQ *)
 (* REDEFINE PRIOR                                  *)
     BEGIN
     CALL PQ.DELETE(CURRENT.EVENT);
     CURRENT.EVENT.PRIOR:=RANDOM;
     IF T<0 THEN T:=0; FI;
      CURRENT.EVENT.EVENTTIME:=TIME+T;
     CALL PQ.INSERT(CURRENT.EVENT);
     CALL CHOICEPROCESS;
     END HOLD;
 
UNIT PASSIVATE: PROCEDURE;
  (* REMOVE THE ACTVE PROCESS FROM PQ AND ACTIVATE THE NEXT ONE *)
     BEGIN
      CALL PQ.DELETE(CURRENT.EVENT);
      CURRENT.EVENT:=NONE;
      CALL CHOICEPROCESS
     END PASSIVATE;
 
UNIT RUN: PROCEDURE(P:SIMPROCESS);
 (* ACTIVATE P IMMEDIATELY AND DELAY THE FORMER FIRST PROCESS BY REDEFINING*)
 (* PRIOR                                                              *)
     BEGIN
     CURRENT.EVENT.PRIOR:=RANDOM;
     IF NOT P.IDLE THEN
	    P.EVENT.PRIOR:=0;
	    P.EVENT.EVENTTIME:=TIME;
	    CALL PQ.CORRECT(P.EVENT,FALSE)
		    ELSE
      IF P.EVENTAUX=NONE THEN
	    P.EVENT,P.EVENTAUX:=NEW EVENTNOTICE(0);
	    P.EVENT.EVENTTIME:=TIME;
	    P.EVENT.PROC:=P;
	    CALL PQ.INSERT(P.EVENT)
			ELSE
	     P.EVENT:=P.EVENTAUX;
	     P.EVENT.PRIOR:=0;
	     P.EVENT.EVENTTIME:=TIME;
	     P.EVENT.PROC:=P;
	     CALL PQ.INSERT(P.EVENT);
			  FI;FI;
      CALL CHOICEPROCESS;
END RUN;
 
UNIT CANCEL:PROCEDURE(P: SIMPROCESS);
 (* REMOVE PROCESS P FROM PQ AND CONTINUE SIMULATION *)
   BEGIN
   IF P= CURRENT THEN CALL PASSIVATE ELSE
    CALL PQ.DELETE(P.EVENT);
    P.EVENT:=NONE;  FI;
 END CANCEL;
 
UNIT CHOICEPROCESS:PROCEDURE;
 (* CHOOSE THE FIRST PROCESS FROM PQ TO BE ACTIVATED *)
   VAR P:SIMPROCESS;
   BEGIN
   P:=CURR;
   CURR:= PQ.MIN QUA EVENTNOTICE.PROC;
    IF CURR=NONE THEN WRITE(" ERROR IN THE HEAP"); WRITELN;
		      ATTACH(MAIN);
		 ELSE ATTACH(CURR); FI;
END CHOICEPROCESS;
 
BEGIN
  PQ:=NEW QUEUEHEAD;  (* SIMULATION TIME AXIS*)
  CURR,MAINPR:=NEW MAINPROGRAM;
  MAINPR.EVENT,MAINPR.EVENTAUX:=NEW EVENTNOTICE(0);
  MAINPR.EVENT.EVENTTIME:=0;
  MAINPR.EVENT.PROC:=MAINPR;
  CALL PQ.INSERT(MAINPR.EVENT);
  (* THE FIRST PROCESS TO BE ACTIVATED IS MAIN PROGRAM *)
  INNER;
  PQ:=NONE; 
END SIMULATION;
 
 
 
UNIT LISTS:SIMULATION CLASS;
 (* WE WISH TO USE LISTS FOR QUEUEING PROCESSES DURING SIMULATION*)
 
	   UNIT LINKAGE:CLASS;
	    (*WE WILL USE TWO WAY LISTS *)
		VAR SUC1,PRED1:LINKAGE;
			  END LINKAGE;
	    UNIT HEAD:LINKAGE CLASS;
	    (* EACH LIST WILL HAVE ONE ELEMENT ESTABLISHED *)
		      UNIT FIRST:FUNCTION:LINK;
				 BEGIN
			     IF SUC1 IN LINK THEN RESULT:=SUC1
					     ELSE RESULT:=NONE FI;
				 END;
		      UNIT EMPTY:FUNCTION:BOOLEAN;
				 BEGIN
				 RESULT:=SUC1=THIS LINKAGE;
				 END EMPTY;
		   BEGIN
		   SUC1,PRED1:=THIS LINKAGE;
		     END HEAD;
 
	  UNIT LINK:LINKAGE CLASS;
	   (* ORDINARY LIST ELEMENT PREFIX *)
		     UNIT OUT:PROCEDURE;
			      BEGIN
			      IF SUC1=/=NONE THEN
				    SUC1.PRED1:=PRED1;
				    PRED1.SUC1:=SUC1;
				    SUC1,PRED1:=NONE FI;
			       END OUT;
		     UNIT INTO:PROCEDURE(S:HEAD);
			       BEGIN
 
			       CALL OUT;
			       IF S=/= NONE THEN
				    IF S.SUC1=/=NONE THEN
					    SUC1:=S;
					    PRED1:=S.PRED1;
					    PRED1.SUC1:=THIS LINKAGE;
					    S.PRED1:=THIS LINKAGE;
						 FI FI;
				  END INTO;
		  END LINK;

     UNIT ELEM:LINK CLASS(SPROCESS:SIMPROCESS);
     (* USER DEFINED  PROCESS WILL BE JOINED INTO LISTS  *)
		    END ELEM;

    END LISTS;

(***************************************************************************)
(* definition des procedures de lecture des fichiers de donn‚es et mise en *)
(* m‚moire des structures de la 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 sera de type car lors des affectations *)
    occpsens : arrayof pointeur, (*si <>none alors il y a une voiture cette place*)
    occpinve : arrayof pointeur; (*en sens inverse de initial final *)
End Arcs;

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

Unit Sommets : class;
var Nom      : char,     (* Nom du sommet *) 
    typecar  : integer,  (* Type carrefour 0:feu , 1:priorite , 2:stop *)
    afftype  : integer,  (* type carrefour 1..9 pour affichage *)
    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;
	     NBSOMMETS:=NBSOMMETS+1; (* on comptabilise le nombre de sommets*)
	     Noeud.Nom := tampon;
	     read(f,Noeud.typecar);
	     read(f,Noeud.afftype);
	     read(f,Noeud.colonne);
	     if(Noeud.colonne>Larg_Vil) then Larg_Vil:=Noeud.colonne; fi;
	     readln(f,Noeud.ligne);
	     if(Noeud.ligne>Haut_Vil) then Haut_Vil:=Noeud.ligne; fi;
	     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;


(***************************************************************************)
(*              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,
    aux2 : char,
    aux3 : char,
    i    : integer;
Begin
   readln(f);
   readln(f);
   while ( not(eof(f)))
   do
 
 i:=i+1;    
 call color(Blanc);
 call move(10,400);
 call outstring("coucou");
 call hascii(48+i);

      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);
      array Noeud.occpsens dim (1:Noeud.distance); (* on met la voie en place*)
      array Noeud.occpinve dim (1: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 lecture de la ville appell‚e par bo_load         *)
(***************************************************************************)

Unit Lit_Ville : procedure( fenet : Windows);
var fichier  : file,
    flagbool : boolean;
begin
   Larg_Vil:=0;
   Haut_Vil:=0;
   NBSOMMETS:=0;
   open (fichier,text,unpack("Ville.dat"));
   call color(VertClair);
   flagbool:=fenet.outgtext(".",1);
   call reset (fichier);
   call color(VertClair);
   flagbool:=fenet.outgtext("..",2);
   Call CreeSomm(fichier);
   call color(VertClair);
   flagbool:=fenet.outgtext("..",2);
   Call CreeArcs(fichier);
   call color(VertClair);
   flagbool:=fenet.outgtext("..",2);
end Lit_Ville;

(***************************************************************************)
(*          definition des procedures d'utilitaires graphiques             *)
(***************************************************************************)

(***************************************************************************)
   Unit Line : procedure (x1,y1,x2,y2,c : integer);
   Begin
      call color(c);
      call move(x1,y1);
      call draw(x2,y2);
   End Line;

(***************************************************************************)
   Unit Linep : procedure (x1,y1,x2,y2,c,s :integer);
   Var i :integer;
   Begin (* ne fonctionne que pour des horizontales ou des verticales *)
    if (x1=x2)
    then for i:=y1 step s*2 to y2 
	 do
	  call line(x1,i,x1,i+s,c);
	 od;
    else if (y1=y2)
	 then for i:=x1 step s*2 to x2 
	      do
	       call line(i,y1,i+s,y1,c);
	      od;
	 fi;
    fi;
   End linep;

(***************************************************************************)
   Unit Rectangle : procedure (x1,y1,x2,y2,c : integer);
   Begin
    call color(c);
    call move(x1,y1);
    call draw(x2,y1);
    call draw(x2,y2);
    call draw(x1,y2);
    call draw(x1,y1);
   End Rectangle;

(***************************************************************************)
   Unit Rectanglef : procedure (x1,y1,x2,y2,c : integer);
   var i : integer;
   Begin
    for i:=y1 to y2
    do
      call Line(x1,i,x2,i,c);
    od
   End Rectanglef;

(****************************************************************************)
   Unit Readcara : function (x,y,col_f,col_e : integer) : integer;
   Var i    : integer,
      sx,sy : integer;
   Begin
    sx:=x;
    sy:=y;
    i:=inkey;
    while i=0
     do
      call color(col_f);
      call move(x,y);
      call outstring("_");
      for i:=1 to 300 do od;
      call color(col_e);
      call move(x,y);
      call outstring("_");
      for i:=1 to 100 do od;
      i:=inkey;
     od;
     call color(col_f);
     call move(x,y);
     call outstring("_");
     call move(sx,sy);
     call color(col_e);
     result:=i;
   End Readcara;

(****************************************************************************)
(*   lecture d'un entier en mode graphique, esc revient au debut de saisie  *)
(****************************************************************************)
   Unit gscanf : function (rangmin,rangmax : integer) : integer;
   Var valeur : integer,
       sauvx  : integer,
       sauvy  : integer,
       flag   : integer;
   Begin
     sauvx:=inxpos;
     sauvy:=inypos;
     do
       valeur:=0;
       do
	flag:=readcara(inxpos,inypos,Noir,BleuClair);
	if (flag>=48 and flag<=57)
	then valeur:=valeur*10+flag-48;
	     call move(inxpos,inypos);
	     call hascii(flag);
	fi;
	if (flag=13) then exit; fi;
	if (flag=27)                          (* on a demand‚ annulation *)
	then valeur:=0;
	     call rectanglef(sauvx-1,sauvy-1,inxpos,sauvy+13,Noir);
	     call color(BleuClair);
	     call move(sauvx,sauvy);
	fi;
       od;
      if (valeur>=rangmin and valeur<=rangmax)
      then exit;
      else call rectanglef(sauvx-1,sauvy-1,inxpos,sauvy+13,Noir);
	   call color(BleuClair);
	   call move(sauvx,sauvy);
      fi;
     od;
     result:=valeur;
   End gscanf;


(***************************************************************************)
(*                definition des classes d'‚l‚ments des listes             *)
(***************************************************************************)
	
   Unit Elmt : class(id : integer);
   End Elmt;
	
   Unit elm : Elmt class(x1,y1,x2,y2 :integer);
   End elm;

(***************************************************************************)
(*                   definition de la classe Bottons                       *)
(***************************************************************************)
   
   Unit Bottons : Elmt class(touche,x1,y1,x2,y2 : integer);  
			       (* x2-x1 et y2-y1 doit au mini etre de 8*)
      (*  x1,y1   : integer  coordonn‚es du point haut gauche          *)
      (*  x2,y2   : integer  coordonn‚es du point bas droit            *)
   Var etat    : boolean; (* true si bouton enable                     *)
   
	Unit affiche : procedure;
	Begin
	  call Line(x1,y1,x2,y1,Blanc);                 (* Lignes en blanc *) 
	  call Line(x1,y1+1,x2-1,y1+1,Blanc);
	  call Line(x1,y1,x1,y2,Blanc);
	  call Line(x1+1,y1+2,x1+1,y2-1,Blanc);
	  call Line(x1+1,y2,x2,y2,GrisFonce);      (* Lignes en gris fonce *)
	  call Line(x1+2,y2-1,x2,y2-1,GrisFonce);
	  call Line(x2,y2,x2,y1+1,GrisFonce);
	  call Line(x2-1,y2-1,x2-1,y1+2,GrisFonce);
	  call Rectanglef(x1+2,y1+2,x2-2,y2-2,GrisClair); (* centre en gris *)
	  call AfficheSuite;
	End affiche;

	Unit virtual AfficheSuite : procedure;
	End;

	Unit virtual bot_enable : procedure;
	End;

	Unit virtual bot_disable : procedure;
	End;
   
   End Bottons;

(***************************************************************************)
(*            definition de la classe Menu derivant de Bottons             *)
(***************************************************************************)
   
   Unit Menu : Bottons class;
   Var cnom    : integer, (* couleur du nom du bouton                  *) 
       nom     : string;  (* nom du bouton                             *)
	
	Unit affiche_nom : procedure;
	Begin 
	  call move(x1+5,y1+(y2-y1)/4);
	  call color(cnom);
	  call outstring(nom);
	End affiche_nom;

	Unit virtual bot_enable : procedure;
	var e : elm;
	Begin
	 cnom:=RougeClair;
	 e:=new elm(id,x1,y1,x2,y2);
	 call clics.Insert(e);
	 if (touche<>-1)
	 then call Keys.Insert(new elmt(touche));
	 fi;
	 call affiche_nom;
	End bot_enable;

	Unit virtual bot_disable : procedure;
	var e : elm;
	Begin
	 cnom:=Rouge;
	 e:=new elm(id,x1,y1,x2,y2);
	 call clics.Delete(e);
	 if (touche<>-1)
	 then call Keys.delete(new elmt(touche));
	 fi;
	 call affiche_nom;
	End bot_disable;

	Unit virtual AfficheSuite : procedure;
	Begin
	  if (etat) 
	  then call bot_enable;
	  else call bot_disable;
	  fi;
	End AfficheSuite;

   End Menu;

(***************************************************************************)
(*            definition de la classe Racc derivant de Bottons             *)
(***************************************************************************)
   
   Unit Racc : Bottons class (procedure sprite(x1,y1,x2,y2,col :integer));

	Unit virtual bot_enable : procedure;
	var e : elm;
	Begin 
	 e:=new elm(id,x1,y1,x2,y2);
	 call clics.Insert(e);
	 if (touche<>-1)
	 then call Keys.Insert(new elmt(touche));
	 fi;
	End bot_enable;

	Unit virtual bot_disable : procedure;
	var e : elm;
	Begin 
	 e:=new elm(id,x1,y1,x2,y2);
	 call clics.Delete(e);
	 if (touche<>-1)
	 then call Keys.delete(new elmt(touche));
	 fi;
	End bot_disable;

	Unit virtual AfficheSuite : procedure;
	Begin
	 if etat
	 then call bot_enable;
	      call sprite(x1,y1,x2,y2,Noir);
	 else call bot_disable;
	      call sprite(x1,y1,x2,y2,GrisFonce);
	 fi;
	End AfficheSuite;

   End Racc;

(***************************************************************************)
(*                       definition de la classe Windows                   *)
(***************************************************************************)
   
   Unit Windows : class(numero,x1,y1,x2,y2,lborder : integer; 
			r1,r2,r3 : boolean);   
   hidden x,y,xp,yp;   
			   (* x2-x1 et y2-y1 doit au mini etre 33      *)
   Var cborder : integer,  (* couleur du pourtour                      *)
       cnom    : integer,  (* couleur du nom de la fenetre             *)
       nom     : string,
       Bout    : ListBot,  (* liste des boutons rattaches              *)
       Hauteur : integer,  (* hauteur de la bande                      *)
       Largeur : integer,  (* largeur des raccourcis                   *)
       cbande  : integer,  (* couleur de la bande                      *)
       WhereXd : integer,  (* position en x de depart dans la fenetre  *)
       WhereX  : integer,  (* position courante en X dans la fenetre   *)
       WhereYd : integer,  (* position en y de depart dans la fenetre  *)
       WhereY  : integer;  (* position courante en Y dans la fenetre   *)
   var B       : arrayof Racc, (* variables locales *)
       x,y     : integer,
       xp,yp   : integer;
	
       Unit affiche : procedure;
       var i : integer; 
	Begin
	 call rectanglef(x1,y1,x2,y2,Noir);
	 for i:=0 to lborder
	 do
	  call rectangle(x1+i,y1+i,x2-i,y2-i,cborder);
	 od;
	 call Line(x1+16,y1,x1+16,y1+lborder,Noir);  (* Lignes noires *)
	 call Line(x2-16,y1,x2-16,y1+lborder,Noir);
	 call Line(x1+16,y2,x1+16,y2-lborder,Noir);
	 call Line(x2-16,y2,x2-16,y2-lborder,Noir);
	 call Line(x1,y1+16,x1+lborder,y1+16,Noir);
	 call Line(x1,y2-16,x1+lborder,y2-16,Noir);
	 call Line(x2,y1+16,x2-lborder,y1+16,Noir);
	 call Line(x2,y2-16,x2-lborder,y2-16,Noir);
	 call Rectanglef(x1+lborder+1,y1+lborder+1,x2-lborder-1,
			 y1+lborder+hauteur+1,cbande);
	 call move(x1+(x2-x1)/3,y1+lborder+hauteur/4);
	 call color(cnom);
	 call outstring(nom);
	 call AffSuite;
	End affiche;
   
	Unit virtual AffSuite : procedure;
	End AffSuite;
	
	Unit virtual clear : procedure;
	End clear;
	
	Unit gestionnaire : function : integer;
	Var  l,r,c : boolean,
	     x,y   : integer,
	     rep   : integer,
	     nbbot : integer;
	Begin
	 do
	  call getpress(0,x,y,nbbot,l,r,c);
	  if (l) and (clics<>none)
	  then result:=clics.Appartient(x,y); exit;
	  fi;
	  rep:=inkey;
	  if (rep>=97 and rep<=122) (* passe les lettres en majuscule *)
	  then rep:=rep-32;
	  fi;
	  if keys.Appartient(rep)
	  then result:=rep; exit;
	  fi;
	 od;
	End gestionnaire;

	Unit moveto : function (x,y :integer) : boolean;
	Begin
	  if (x>0 and x<(x2-x1)) and (y>0 and y<y2-y1)
	  then WhereX:=WhereXd+x;
	       WhereY:=WhereYd+y;
	       call move(WhereX,WhereY);
	       result:=True;
	  else result:=False;
	  fi;
	End moveto;

	Unit outgtext : function (chaine : string; long : integer) : boolean;
	Begin
	 if (long*8+WhereX)<(x2-lborder-5)
	 then call move(WhereX,WhereY);
	      call outstring(chaine);
	      WhereX:=WhereX+long*8;
	      if WhereX>= x2-lborder-16
	      then WhereX:=WhereXd;
		   WhereY:=WhereY+16;
	      fi;
	      result:=True;
	 else result:=False;
	 fi;
	End outgtext;

	Unit outchar : function (tmp : char) : boolean;
	Begin
	 if (10+WhereX)<(x2-lborder-5-largeur)
	 then call move(WhereX,WhereY);
	      call hascii(ord(tmp));
	      WhereX:=WhereX+10;
	      if WhereX>= x2-lborder-16-largeur
	      then WhereX:=WhereXd;
		   WhereY:=WhereY+16;
	      fi;
	      result:=True;
	 else result:=False;
	 fi;
	End outchar;

   Begin
    
    Bout:=new ListBot;
    Keys:=new ListKey;
   
    array B dim (0:2);

    x:=x2-Larg_bot-lborder-1;
    y:=y1+lborder+1;
    xp:=x2-lborder-1;
    yp:=y+Haut_bot;
    B(2):=new Racc(numero+3,-1,x,y,xp,yp,spr_upper);
    B(2).etat:=r3;
    call Bout.Insert(B(2));
   
    xp:=x-1;
    x:=xp-Larg_bot;
    B(1):=new Racc(numero+2,-1,x,y,xp,yp,spr_lower);
    B(1).etat:=r2;
    call Bout.Insert(B(1));
   
    x:=x1+lborder+1;
    xp:=x+Larg_bot;
    B(0):=new Racc(numero+1,-1,x,y,xp,yp,spr_close);
    B(0).etat:=r1;
    call Bout.Insert(B(0));

   End Windows;

(***************************************************************************)
(*            definition de main d‚rivant de la classe Windows             *)
(***************************************************************************)
   
   Unit Maine : Windows class;
   var icname  : string,   (* nom une fois iconise                     *)
       Lwind   : ListW,    (* liste des fenetres filles                *)
       Horiz   : AccelerateH, (* accelerateur horizontal               *)
       Verti   : AccelerateV; (* accelerateur vertical                 *)

       Unit virtual AffSuite : procedure;
	Begin
	 call Rectanglef(x1+lborder+1,y1+lborder+hauteur+3,
			 x2-lborder-1,y1+lborder+2*(hauteur+2),cbande);
	 if (Horiz<>none)
	 then call Horiz.affiche;
	 fi;
	 if (Verti<>none)
	 then call Verti.affiche;
	 fi;
	 Bout.Courant:=Bout.head;
	 while(Bout.Courant<>none)
	  do
	   call Bout.Courant.data qua Bottons.affiche;
	   Bout.Courant:=Bout.Courant.next;
	  od;
	 call Keys.Insert(new elmt(T_ALTF4)); (* alt/f4 pour quitter *)
	End AffSuite;

	Unit virtual clear : procedure;
	Var xf,yf : integer;
	Begin
	 if Verti<>none then xf:=Verti.x1-1;
	 else xf:=x2-lborder-1;
	 fi;
	 if Horiz<>none then yf:=Horiz.y1-1;
	 else yf:=y2-lborder-1;
	 fi;
	 call Rectanglef(x1+lborder+1,y1+lborder+2*(hauteur+2)+1,xf,yf,Noir);
	 WhereX:=WhereXd;
	 WhereY:=WhereYd;
	end;

	Unit iconify : procedure;
	var i     : integer,
	    l,r,c : boolean,
	    x,y   : integer,
	    nboot : integer,
	    rep   : integer;

	Begin
	  call cls;
	  kill(clics);
	  call rectangle(1,SIZEY-40,40,SIZEY,BleuClair);
	  call rectangle(2,SIZEY-39,39,SIZEY-1,BleuClair);
	  call move(5,SIZEY-20);
	  call outstring(icname);
	  call showcursor;
	  do
	    call getpress(0,x,y,nboot,l,r,c);
	    if l 
	    then if(x>=1 and x<=40 and y<=SIZEY and y>=SIZEY-40)
		 then exit;
		 fi;
	    fi;
	    rep:=inkey;
	    if (rep=13)   (* validation *)
	    then exit;
	    fi;
	  od;
	  call hidecursor;
	  call cls;
	  clics:=new cliquer;
	  call W.affiche;
	End iconify;

   Begin
    WhereXd:=x1+lborder+5;
    WhereYd:=y1+lborder+2*(Haut_Bot+2)+5+8;
    WhereX:=WhereXd;
    WhereY:=WhereYd;
   End Maine;

(***************************************************************************)
(*    definition de la classe Son d‚rivant des classes Windows et elmt     *)
(***************************************************************************)
   
   Unit Son : Windows coroutine;
   Var aa      : Elmt,
       Horiz   : AccelerateH, (* accelerateur horizontal               *)
       Verti   : AccelerateV; (* accelerateur vertical                 *)
   
	Unit virtual AffSuite : procedure;
	Begin
	 if Horiz<>none
	 then call Horiz.affiche;
	 fi;
	 if Verti<>none
	 then call Verti.affiche;
	 fi;
	 Bout.Courant:=Bout.Head;
	 while(Bout.Courant<>none)
	 do
	  call Bout.Courant.data qua Bottons.affiche;
	  Bout.Courant:=bout.Courant.next;
	 od;
	End AffSuite;

	Unit virtual clear : procedure;
	Var xf,yf : integer;
	Begin
	 if Verti<>none then xf:=Verti.x1-1;
	 else xf:=x2-lborder-1;
	 fi;
	 if Horiz<>none then yf:=Horiz.y1-1;
	 else yf:=y2-lborder-1;
	 fi;
	 call Rectanglef(x1+lborder+1,y1+lborder+(hauteur+1)+1,xf,yf,Noir);
	 WhereX:=WhereXd;
	 WhereY:=WhereYd;
	end;
       
   Begin
     return;
     pref Elmt(0) block
     begin
       aa:=this Elmt;
       WhereXd:=x1+lborder+5;
       WhereYd:=y1+lborder+(Haut_Bot+1)+5+8;
       WhereX:=WhereXd;
       WhereY:=WhereYd;
       detach;
     end
   End Son;


(***************************************************************************)
(*    definition de Accelerate d‚rivant des classes Windows et Bottons     *)
(***************************************************************************)
   
   Unit Accelerate : Bottons class(mother : Windows);
   Var Bs   : arrayof Racc,
       PosX : integer,
       PosY : integer,
       LX,LY: integer,
       C    : integer;  (* valeur du pas d'affichage *)
       
	Unit virtual AfficheSuite : procedure;  (* descend de bottons *)
	End AfficheSuite;
       
	Unit virtual bot_enable : procedure;
	Begin
	 call mother.Bout.Insert(Bs(1));
	 call mother.Bout.Insert(Bs(2));
	 Call mother.Bout.Insert(Bs(3));
	 etat:=True;
	End bot_enable;

	Unit virtual bot_disable : procedure;
	Begin
	 call mother.Bout.Delete(Bs(1));
	 call mother.Bout.Delete(Bs(2));
	 call mother.Bout.Delete(Bs(3));
	 etat:=False;
	End bot_disable;


	Unit virtual Deplacer : procedure( i :integer);
	End Deplacer;
  
	Unit virtual Reset_Bot : procedure;
	End Reset_Bot;

   Begin  
    C:=5; (* valeur par defaut *)
    inner;
    call bot_enable;
   End Accelerate;

(***************************************************************************)
(*             definition de AccelerateH d‚rivant de Accelerate            *)
(***************************************************************************)

   Unit AccelerateH : Accelerate class;
   Var x    : integer,     
       MaxX : integer,
       MinX : integer;
   
	Unit virtual AfficheSuite : procedure;  (* descend de bottons *)
	Begin
	 call Rectanglef(x1+18,y1+3,x2-18,y2-3,Noir);
	 MaxX:=x2-18-LX;
	 MinX:=x1+18;
	End AfficheSuite;

	Unit DeplacerLeft : procedure;
	var e : elm;
	Begin
	 call Bs(2).bot_disable;
	 call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);
	 PosX:=PosX-C;
	 if PosX<MinX
	 then PosX:=MinX;
	      Bs(1).etat:=False;
	      call Bs(1).bot_disable;
	 fi;
	 if not (Bs(3).etat)
	 then Bs(3).etat:=True;
	      call Bs(3).bot_enable;
	 fi; 
	 Bs(2).x1:=PosX;    Bs(2).y1:=PosY;
	 Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;
	 call Bs(2).affiche;
	End DeplacerLeft;
	
	Unit virtual Deplacer : procedure (x : integer);
	Begin
	 call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);
	 PosX:=x;
	 Bs(2).x1:=PosX;    Bs(2).y1:=PosY;
	 Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;
	 call Bs(2).affiche;
	End Deplacer;

	Unit DeplacerRight : procedure;
	var e : elm;
	Begin
	 call Bs(2).bot_disable;
	 call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);
	 PosX:=PosX+C;
	 if PosX>MaxX
	 then PosX:=MaxX;
	      Bs(3).etat:=False;
	      call Bs(3).bot_disable;
	 fi;
	 if not (Bs(1).etat)
	 then Bs(1).etat:=True;
	      call Bs(1).bot_enable;
	 fi;  
	 Bs(2).x1:=PosX;    Bs(2).y1:=PosY;
	 Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;
	 call Bs(2).affiche;
	End DeplacerRight;

	Unit virtual Reset_Bot : procedure;
	Begin
	 call Bs(2).bot_disable;
	 call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);
	 x:=(x2-x1)/2;
	 PosX:=x-5;
	 PosY:=y1+3;
	 LX:=11;
	 LY:=y2-y1-6;
	 Bs(2).x1:=PosX;
	 Bs(2).y1:=PosY;
	 Bs(2).x2:=PosX+LX;
	 Bs(2).y2:=PosY+LY;
	 call Bs(2).affiche;
	End Reset_Bot;

    Begin  
      array Bs dim (1:3);
      Bs(1):=new Racc(id+1,T_FLDTE,x1+2,y1+2,x1+15,y1+15,spr_right);
      Bs(1).etat:=True;
      x:=(x2-x1)/2;
      PosX:=x-5;
      PosY:=y1+3;
      LX:=11;
      LY:=y2-y1-6;
      Bs(2):=new Racc(id+2,-1,PosX,PosY,PosX+LX,PosY+LY,spr_point);
      Bs(2).etat:=True;
      Bs(3):=new Racc(id+3,T_FLGCH,x2-15,y2-16,x2-2,y2-3,spr_left);
      Bs(3).etat:=True;
   End AccelerateH;

(***************************************************************************)
(*             definition de AccelerateV d‚rivant de Accelerate            *)
(***************************************************************************)

   Unit AccelerateV : Accelerate class;
   Var y    : integer,
       MaxY : integer,
       MinY : integer;     

	Unit virtual AfficheSuite : procedure;  (* descend de bottons *)
	Begin
	 call Rectanglef(x1+3,y1+18,x2-3,y2-18,Noir);
	 MaxY:=y2-18-LY;
	 MinY:=y1+18;
	End AfficheSuite;
      
	Unit DeplacerUp : procedure;
	var e : elm;
	Begin
	 call Bs(2).bot_disable;
	 call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);
	 PosY:=PosY-C;
	 if PosY<MinY
	 then PosY:=MinY;
	      Bs(1).etat:=False;
	      call Bs(1).bot_disable;
	 fi;
	 if not (Bs(3).etat)
	 then Bs(3).etat:=True;
	      call Bs(3).bot_enable;
	 fi; 
	 Bs(2).x1:=PosX;    Bs(2).y1:=PosY;
	 Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;
	 call Bs(2).affiche;
	End DeplacerUp;

	Unit virtual Deplacer : procedure (y : integer);
	Begin
	 call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);
	 PosY:=y;
	 Bs(2).x1:=PosX;    Bs(2).y1:=PosY;
	 Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;
	 call Bs(2).affiche;
	End Deplacer;
	
	Unit DeplacerDown : procedure;
	var e : elm;
	Begin
	 call Bs(2).bot_disable;
	 call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);
	 PosY:=PosY+C;
	 if PosY>MaxY
	 then PosY:=MaxY;
	      Bs(3).etat:=False;
	      call Bs(3).bot_disable;
	 fi;
	 if not (Bs(1).etat)
	 then Bs(1).etat:=True;
	      call Bs(1).bot_enable;
	 fi; 
	 Bs(2).x1:=PosX;    Bs(2).y1:=PosY;
	 Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;
	 call Bs(2).affiche;
	End DeplacerDown;

	Unit virtual Reset_Bot : procedure;
	Begin
	 call Bs(2).bot_disable;
	 call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);
	 y:=(y2-y1)/2;
	 PosX:=x1+3;
	 PosY:=y-5;
	 LX:=x2-x1-6;
	 LY:=11;
	 Bs(2).x1:=PosX;
	 Bs(2).y1:=PosY;
	 Bs(2).x2:=PosX+LX;
	 Bs(2).y2:=PosY+LY;
	 call Bs(2).affiche;
	End Reset_Bot;

   Begin
      array Bs dim (1:3);
      Bs(1):=new Racc(id+1,T_FLHAU,x1+2,y1+2,x1+15,y1+15,spr_upper);
      Bs(1).etat:=True;
      y:=(y2-y1)/2;
      PosX:=x1+3;
      PosY:=y-5;
      LX:=x2-x1-6;
      LY:=11;
      Bs(2):=new Racc(id+2,-1,PosX,PosY,PosX+LX,PosY+LY,spr_point);
      Bs(2).etat:=True;
      Bs(3):=new Racc(id+3,T_FLBAS,x2-15,y2-16,x2-2,y2-3,spr_lower);
      Bs(3).etat:=True;
   End AccelerateV;


(***************************************************************************)
(*          definition de la classe Ensemble (c'est une liste)             *)
(***************************************************************************)

   Unit Ensemble : class;
   Var Head    : Node,
       Courant : Node,
       Last    : Node;

	Unit Node : class(data : elmt);
	Var next  : Node;
	End Node;
	
	Unit virtual egalite : function (x,y : elmt) :boolean;
	End egalite;

	Unit Empty : function : boolean;        
	Begin
	 if Head=none
	 then result:=True;
	 else result:=False;
	 fi;
	End;

	Unit Member : function (n : elmt) : boolean;
	Var bl      : boolean,
	    saveCou : Node;
	Begin
	 Courant:=Head;
	 saveCou:=Courant;
	 bl:=False;
	 While (Courant<>none)
	  do
	   if not egalite(Courant.data,n)
	   then saveCou:=Courant; Courant:=Courant.next;
	   else bl:=True; exit;
	   fi;
	  od;
	 Courant:=SaveCou;
	 result:=bl;
	End Member;

	Unit Insert : procedure (n : elmt);
	Var bl : boolean;
	Begin
	 bl:=Member(n);
	 if not bl
	 then if Empty
	      then Head:=new Node(n); Last:=Head;
	      else Last.next:=new Node(n);
		   Last:=Last.next;
	      fi;
	 fi;
	End Insert;

	Unit Delete : procedure (n : elmt);
	Var bl   : boolean,
	    flag : Node;
	Begin 
	 bl:=Member(n);
	 if bl
	 then flag:=Courant.next; 
	      if flag=Last
	      then Last:=Courant; courant.next:=none; kill(flag);
	      else if Courant.next<>none 
		   then Courant.next:=Courant.next.next; kill(flag);
		   fi;
	      fi;
	 fi;
	End Delete;

   End Ensemble;
	
(***************************************************************************)
(*      definition de la classe cliquer derivant de la classe ensemble     *) 
(***************************************************************************)
   
   Unit cliquer : Ensemble class;        
   
	Unit virtual egalite : function (x,y : elmt) : boolean;
	Begin
	 if (x.id)=(y.id)
	 then result:=True;
	 else result:=False;
	 fi;
	End egalite;
	
	Unit Appartient : function(x,y : integer) : integer;
	var bl : boolean;
	Begin
	  bl:=False;
	  Courant:=Head;
	  while (Courant<>none)
	  do
	   if(x<(Courant.data qua elm.x2) and x>(Courant.data qua elm.x1) and 
	      y<(Courant.data qua elm.y2) and y>(Courant.data qua elm.y1))
	   then bl:=True; exit;
	   else Courant:=Courant.next;
	   fi;
	  od;
	  if bl
	  then result:=Courant.data qua elm.id;
	  else result:=-1;
	  fi;
	End Appartient;

   End cliquer;

(***************************************************************************)
(*          definition de la classe Listbot d‚rivant de ensemble           *)
(***************************************************************************)
   
   Unit Listbot : Ensemble class;

	Unit virtual egalite : function (x,y : elmt) : boolean;
	Begin
	 if (x.id) = (y.id)
	 then result:=True;
	 else result:=False;
	 fi;
	End egalite;

   End Listbot;

(***************************************************************************)
(*          definition de la classe ListKey d‚rivant de ensemble           *)
(***************************************************************************)
   
   Unit ListKey : Ensemble class;

	Unit virtual egalite : function (x,y : elmt) : boolean;
	Begin
	 if (x.id) = (y.id)
	 then result:=True;
	 else result:=False;
	 fi;
	End egalite;

	Unit Appartient : function(x : integer) : boolean;
	var bl : boolean;
	Begin
	  bl:=False;
	  Courant:=Head;
	  while (Courant<>none)
	  do
	   if(Courant.data.id = x)
	   then bl:=True; exit;
	   else Courant:=Courant.next;
	   fi;
	  od;
	  result:=bl;
	End Appartient;

   End ListKey;

(***************************************************************************)
(*           definition de la classe ListW d‚rivant de ensemble            *)
(***************************************************************************)
 
   Unit ListW : Ensemble class;

	Unit virtual egalite : function (x,y : elmt) : boolean;
	Begin
     (*    if (x qua Son.numero) = (y qua Son.numero)
	 then result:=True;
	 else result:=False;
	 fi; *)
	End egalite;

   End ListW;

(***************************************************************************)
(*             procedure d'affichage des sprites des boutons               *)
(***************************************************************************)

(***************************************************************************)
   Unit spr_upper : procedure(x1,y1,x2,y2,couleur : integer);
   var i,x,y : integer;
   Begin
    x:=(x2-x1)/2;
    y:=(y2-y1)/2;
    for i:=1 to y
    do
     call Line(x1+x-i/2,y1+y/2+i,x1+x+i/2,y1+y/2+i,couleur);
    od
   End spr_upper;

(***************************************************************************)
   Unit spr_lower : procedure(x1,y1,x2,y2,couleur : integer);
   var i,x,y : integer;
   Begin
    x:=(x2-x1)/2;
    y:=(y2-y1)/2;
    for i:=1 to y
    do
     call Line(x1+x-i/2,y2-y/2-i,x1+x+i/2,y2-y/2-i,couleur);
    od
   End spr_lower;

(***************************************************************************)
   Unit spr_left : procedure(x1,y1,x2,y2,couleur : integer);
   var i,x,y : integer;
   Begin
    x:=(x2-x1)/2;
    y:=(y2-y1)/2;
    for i:=1 to x
    do
     call Line(x2-x/2-i,y1+y-i/2,x2-x/2-i,y1+y+i/2,couleur);
    od
   End spr_left;

(***************************************************************************)
   Unit spr_right : procedure(x1,y1,x2,y2,couleur : integer);
   var i,x,y : integer;
   Begin
    x:=(x2-x1)/2;
    y:=(y2-y1)/2;
    for i:=1 to x
    do
     call Line(x1+x/2+i,y1+y-i/2,x1+x/2+i,y1+y+i/2,couleur);
    od
   End spr_right;

(***************************************************************************)
   Unit spr_close : procedure(x1,y1,x2,y2,couleur : integer);
   var y : integer;
   Begin
    y:=(y2-y1)/2;
    call Rectanglef(x1+3,y1+y-1,x2-3,y1+y+1,couleur);
   End spr_close;

(***************************************************************************)
   Unit spr_point : procedure(x1,y1,x2,y2,couleur : integer);;
   var x,y : integer;
   Begin
    y:=(y2-y1)/2;
    x:=(x2-x1)/2;
    call Rectanglef(x1+x-1,y1+y-1,x1+x+1,y1+y+1,couleur);
   End spr_point;

(***************************************************************************)
(*                   procedure de gestion  des boutons                     *)
(***************************************************************************)

(***************************************************************************)
   Unit Bot_Load : procedure;
   Const Largeur=300,
	 Hauteur=100;
   Var   fenet     : Son,
	 x,y       : integer,
	 Posx,Posy : integer,
	 code      : integer,
	 flagbool  : boolean;
   Begin
    x:=(W.x2-W.x1)/2;
    y:=(W.y2-W.y1)/2;
    Posx:=x-Largeur/2;
    Posy:=y-Hauteur/2;
    fenet:=new Son(10,x-Largeur/2,y-Hauteur/2,x+Largeur/2,y+Hauteur/2,
		   2,False,False,False);
    attach(fenet);
    fenet.hauteur:=Haut_Bot;
    fenet.cborder:=RougeClair;
    fenet.cbande:=Rouge;
    kill(clics);
    clics:=new cliquer;
    call fenet.affiche;
    flagbool:=fenet.moveto(10,10);
    call color(BleuClair);
    flagbool:=fenet.outgtext("Chargement de Ville.dat en cours",32);
    flagbool:=fenet.moveto(10,25);
    call color(VertClair);
    flagbool:=fenet.outgtext(".",1);
    call Lit_Ville(fenet);
    flagbool:=fenet.moveto(10,40);
    call color(BleuClair);
    flagbool:=fenet.outgtext("Chargement termine : 'Enter'",28);
    fenet.B(0).etat:=True;
    call fenet.bout.insert(fenet.B(0));
    call fenet.B(0).affiche;
    call keys.insert(new elmt(Tou_Ent));
    call showcursor;
    do
     code:=fenet.gestionnaire;
     if code=Tou_Ent or code=11 then exit fi;
    od;
    call hidecursor;
    attach(fenet);
    kill(fenet);
    kill(clics);
    clics:=new cliquer;
    call cls;
    call Etat_Menu(True,True,False,False,True);
    call W.affiche;
    COEF_X:=Larg_Aff/Larg_Vil;
    COEF_Y:=Haut_Aff/Haut_Vil;
    boolaf:=True;
    call Ville_aff(1);
    call showcursor;
   End Bot_Load;

(***************************************************************************)
   Unit Bot_Run : procedure;
   Const Largeur=330,
	 Hauteur=100;
   Var   fenet     : Son,
	 x,y       : integer,
	 Posx,Posy : integer,
	 code      : integer,
	 flagbool  : boolean,
	 nbcar     : integer;
   Begin
    x:=(W.x2-W.x1)/2;
    y:=(W.y2-W.y1)/2;
    Posx:=x-Largeur/2;
    Posy:=y-Hauteur/2;
    fenet:=new Son(10,x-Largeur/2,y-Hauteur/2,x+Largeur/2,y+Hauteur/2,
		   2,False,False,False);
    attach(fenet);
    fenet.hauteur:=Haut_Bot;
    fenet.cborder:=RougeClair;
    fenet.cbande:=Rouge;
    kill(clics);
    clics:=new cliquer;
    call fenet.affiche;
    call color(BleuClair);
    flagbool:=fenet.moveto(10,10);
    flagbool:=fenet.outgtext("Entrez le nombre de voitures (1-50)",32);
    flagbool:=fenet.moveto(145,30);
    nbcar:=gscanf(1,50);
    call prg.generator(nbcar);
    attach(fenet);
    kill(fenet);
    kill(clics);
    clics:=new cliquer;
    call cls;
    call Etat_Menu(False,False,True,False,False);
    call W.affiche;
    call Ville_aff(1);
   End Bot_Run;

(***************************************************************************)
   Unit Bot_Stop : procedure;
   Const Largeur=280,
	 Hauteur=100;
   Var   fenet     : Son,
	 x,y       : integer,
	 Posx,Posy : integer,
	 code      : integer,
	 flagbool  : boolean;
   Begin
    x:=(W.x2-W.x1)/2;
    y:=(W.y2-W.y1)/2;
    Posx:=x-Largeur/2;
    Posy:=y-Hauteur/2;
    fenet:=new Son(10,x-Largeur/2,y-Hauteur/2,x+Largeur/2,y+Hauteur/2,
		   2,False,False,False);
    attach(fenet);
    fenet.hauteur:=Haut_Bot;
    fenet.cborder:=RougeClair;
    fenet.cbande:=Rouge;
    kill(clics);
    clics:=new cliquer;
    call fenet.affiche;
    call color(BleuClair);
    flagbool:=fenet.moveto(60,10);
    flagbool:=fenet.outgtext("Simulation stopp‚e",18);
    flagbool:=fenet.moveto(40,30);
    flagbool:=fenet.outgtext("Appuyez sur une touche",22);
    do
     code:=inkey;
     if code<>0 then exit; fi;
    od;
    attach(fenet);
    kill(fenet);
    kill(clics);
    clics:=new cliquer;
    call cls;
    call Etat_Menu(True,False,False,True,True);
    call W.affiche;
    call Ville_aff(1);
   End Bot_Stop;

(***************************************************************************)
   Unit Bot_continue : procedure;
   Const Largeur=300,
	 Hauteur=100;
   Var   fenet     : Son,
	 x,y       : integer,
	 Posx,Posy : integer,
	 code      : integer,
	 flagbool  : boolean;
   Begin
    x:=(W.x2-W.x1)/2;
    y:=(W.y2-W.y1)/2;
    Posx:=x-Largeur/2;
    Posy:=y-Hauteur/2;
    fenet:=new Son(10,x-Largeur/2,y-Hauteur/2,x+Largeur/2,y+Hauteur/2,
		   2,False,False,False);
    attach(fenet);
    fenet.hauteur:=Haut_Bot;
    fenet.cborder:=RougeClair;
    fenet.cbande:=Rouge;
    kill(clics);
    clics:=new cliquer;
    call fenet.affiche;
    do
     code:=inkey;
     if code=13 then exit fi;
    od;
    attach(fenet);
    kill(fenet);
    kill(clics);
    clics:=new cliquer;
    call cls;
    call Etat_Menu(False,False,True,False,False);
    call W.affiche;
    call Ville_aff(1);
   End Bot_Continue;

(***************************************************************************)
   Unit Bot_Quit : function : boolean;
   Const Largeur=300,
	 Hauteur=90;
   Var   fenet     : Son,
	 x,y       : integer,
	 Posx,Posy : integer,
	 fin       : boolean,
	 code      : integer,
	 Yes,No    : Menu;
   Begin
    x:=(W.x2-W.x1)/2;
    y:=(W.y2-W.y1)/2;
    Posx:=x-Largeur/2;
    Posy:=y-Hauteur/2;
    fenet:=new Son(10,Posx,Posy,Posx+Largeur,Posy+hauteur,2,True,False,False);
    attach(fenet);
    fenet.hauteur:=Haut_Bot;
    fenet.cborder:=RougeClair;
    fenet.nom:="Q U I T";
    fenet.cnom:=RougeClair;
    fenet.cbande:=Rouge;
    kill(clics);
    clics:=new cliquer;
    Yes:=new Menu(1,T_Y,Posx+60,Posy+61,Posx+100,Posy+61+Haut_bot);
    Yes.nom:="Yes";
    Yes.etat:=True;
    call fenet.Bout.Insert(Yes);
    No:=new Menu(2,T_N,Posx+190,Posy+61,Posx+220,Posy+61+Haut_bot);
    No.nom:="No";
    No.etat:=True;
    call fenet.Bout.Insert(No);
    call fenet.affiche;
    call move(Posx+10,Posy+35);
    call color(BleuClair);
    call outstring("Do you want to quit the application");
    call Keys.Insert(new elmt(T_ESC));
    call showcursor;
    do
     code:=fenet.gestionnaire;
     case code
      when T_ESC : fin:=False; exit; (* touche racc exit *)
      when T_Y   : fin:=True;  exit; (* touche Y         *)
      when T_N   : fin:=False; exit; (* touche N         *)
      when 1       : fin:=True;  exit; (* bouton yes       *)
      when 2       : fin:=False; exit; (* bouton no        *) 
      when 11      : fin:=False; exit; (* racc exit        *)
     esac;
    od; 
    call hidecursor;
    if not fin
    then attach(fenet);
	 kill(fenet);
	 kill(clics);
	 clics:=new cliquer;
	 call cls;
	 call W.affiche;
	 call Ville_aff(1);
	 result:=False;
    else result:=True;
    fi;
    call showcursor;
   End Bot_Quit;

(***************************************************************************)
   Unit Bot_Help : procedure;
   Const Largeur=410,
	 Hauteur=350;
   Var   fen         : Son,
	 x,y,i,j     : integer,
	 code        : integer,
	 COORD_Y     : integer,
	 fp          : file,
	 tmp         : char,
	 boolaff     : boolean,
	 help        : arrayof arrayof char,
	 nb_lign_hlp : integer;

   
      Unit affiche_hlp : procedure;
      Begin
	call fen.clear;
	call color(BleuClair);
	for i:=COORD_Y to imin(COORD_Y+18,nb_lign_hlp)
	 do
	  for j:=1 to 37
	   do
	    if (ord(help(i,j))>=28 and ord(help(i,j))<=255)
	    then boolaff:=fen.outchar(help(i,j));
	    fi;
	   od;   
	 od;
      End affiche_hlp;
   
   Begin
    x:=(W.x2-W.x1)/2;
    y:=(W.y2-W.y1)/2;
    fen:=new Son(10,x-Largeur/2,y-Hauteur/2,x+Largeur/2,y+Hauteur/2,2,
		 True,False,False);
    attach(fen);
    fen.cnom:=RougeClair;
    fen.nom:="H E L P";
    fen.hauteur:=Haut_Bot;
    fen.largeur:=Larg_Bot;
    fen.cborder:=RougeClair;
    fen.cbande:=Rouge;
    kill(clics);
    clics:=new cliquer;
    kill(Keys);
    Keys:=new ListKey;
    x:=fen.x2-fen.lborder-1-fen.hauteur;
    y:=fen.y1+fen.hauteur+fen.lborder+1;
    fen.Verti:=new AccelerateV(20,-1,x,y,x+fen.largeur,fen.y2-fen.lborder-1,fen);
    call fen.affiche;
    call fen.Verti.deplacer(fen.Verti.MinY);
    call Keys.Insert(new elmt(T_ESC)); (* pour sortir de la fenetre *)
    call Keys.Insert(new elmt(T_PGUP)); (* page up *)
    call Keys.Insert(new elmt(T_PGDOWN)); (* page dow *)
    COORD_Y:=1;
    open(fp,text,unpack("simula.hlp"));
    call reset(fp);
    readln(fp,nb_lign_hlp);
    array help dim (1:nb_lign_hlp);
    for i:=1 to nb_lign_hlp
     do 
      array help(i) dim (1:38);
     od;
    call color(BleuClair);
    i:=1;
    j:=1;
    while not eof(fp)
     do
      read(fp,help(i,j));
      j:=j+1;
      if j=39 then j:=1;
		   i:=i+1;
      fi;
     od;
    call affiche_hlp;
    call setposition(fen.x1,fen.y1);
    call showcursor;
    do
     code:=fen.gestionnaire;
     call hidecursor;
     if (code=T_ESC) or (code=11) then exit;
     else
      if (code=21) or (code=T_FLHAU) then COORD_Y:=COORD_Y-5;
					  if COORD_Y<=0 then COORD_Y:=1; fi;
					  call fen.Verti.DeplacerUp;
					  call affiche_hlp;
      else
       if (code=22) then COORD_Y:=1;
			 call fen.Verti.Reset_Bot;
			 call affiche_hlp;
       else
	if (code=23) or (code=T_FLBAS) then COORD_Y:=COORD_Y+5;
					    if COORD_Y>(nb_lign_hlp-5)
					    then COORD_Y:=nb_lign_hlp-5;
					    fi;
					    call fen.Verti.DeplacerDown;
					    call affiche_hlp;
	else
	 if (code=T_PGUP) then COORD_Y:=COORD_Y-19;
			       if COORD_Y<=0
			       then COORD_Y:=1;
				    call fen.Verti.Deplacer(fen.Verti.MinY);
			       else call fen.Verti.DeplacerDown;
			       fi;
			       call affiche_hlp;
	 else
	  if (code=T_PGDOWN) then COORD_Y:=COORD_Y+19;
				  if COORD_Y>(nb_lign_hlp-5)
				  then COORD_Y:=nb_lign_hlp-5;
				       call fen.Verti.Deplacer(fen.Verti.MaxY);
				  else call fen.Verti.DeplacerDown;
				  fi;
				  call affiche_hlp;
	  fi;
	 fi;
	fi;
       fi;
      fi;
     fi;
     call showcursor;
    od;
    attach(fen);  (* correspond a la 1ere etape kill *)
    kill(fen);
    kill(clics);
    clics:=new cliquer; (* on prepare pour la 'resurection' *)
    kill(Keys);
    Keys:=new ListKey;
    call cls;
    call W.affiche;
    call Ville_aff(1);
   End Bot_Help;

(***************************************************************************)
   Unit Etat_Menu : procedure (ml,mr,ms,mc,mq : boolean);
   Begin
     if (ml and not M(1).etat)  (* load devient enable *)
     then M(1).etat:=True;
	  M(1).Touche:=T_F1;
	  call M(1).bot_enable;
     fi;
     if (not ml and M(1).etat) (* load devient disable *)
     then M(1).etat:=False;
	  M(1).Touche:=-1;
	  call M(1).bot_disable;
     fi;
     if (mr and not M(2).etat)  (* run devient enable *)
     then M(2).etat:=True;
	  M(2).Touche:=T_F2;
	  call M(2).bot_enable;
     fi;
     if (not mr and M(2).etat) (* run devient disable *)
     then M(2).etat:=False;
	  M(2).Touche:=-1;
	  call M(2).bot_disable;
     fi;
     if (ms and not M(3).etat)  (* stop devient enable *)
     then M(3).etat:=True;
	  M(3).Touche:=T_F3;
	  call M(3).bot_enable;
     fi;
     if (not ms and M(3).etat) (* stop devient disable *)
     then M(3).etat:=False;
	  M(3).Touche:=-1;
	  call M(3).bot_disable;
     fi;
     if (mc and not M(4).etat)  (* continue devient enable *)
     then M(4).etat:=True;
	  M(4).Touche:=T_F4;
	  call M(4).bot_enable;
     fi;
     if (not mc and M(4).etat) (* continue devient disable *)
     then M(4).etat:=False;
	  M(4).Touche:=-1;
	  call M(4).bot_disable;
     fi;
     if (mq and not M(5).etat)  (* quit devient enable *)
     then M(5).etat:=True;
	  M(5).Touche:=T_F5;
	  call M(5).bot_enable;
     fi;
     if (not mq and M(5).etat) (* quit devient disable *)
     then M(5).etat:=False;
	  M(5).Touche:=-1;
	  call M(5).bot_disable;
     fi;
   End;

(***************************************************************************)
(*    procedure d'affichage de la ville - on deborde de l'ecran            *)
(*    tracer d'une ligne verticale qui peut depasser le cadre              *)
(***************************************************************************)
  
  Unit Trace_Vil1 : procedure (x1,y1,x2,y2 : real ; zoom : integer);
  Var C     : integer,
      min_x : integer,
      max_x : integer,
      min_y : integer,
      max_y : integer;
  Begin
   C:=5*zoom;
   min_x:=imin(x1,x2);
   max_x:=imax(x1,x2);
   min_y:=imin(y1,y2);
   max_y:=imax(y1,y2);
   if (min_y>=Ydep_Aff and max_y<=(Ydep_Aff+Haut_Aff))
   then (* on est en plein dans le cadre, on peut tracer normalement *)
	call line(x1-C,imin(y1,y2)+C,x2-C,imax(y1,y2)-C,GrisClair);
	call linep(x1,imin(y1,y2)+C,x2,imax(y1,y2)-C,Blanc,C);
	call line(x1+C,imin(y1,y2)+C,x2+C,imax(y1,y2)-C,GrisClair);
   else if (min_y<Ydep_Aff) (* c'est le minimum qui pose pb *)
	then call line(x1-C,Ydep_Aff+C,x2-C,imax(y1,y2)-C,GrisClair);
	     call linep(x1,Ydep_Aff+C,x2,imax(y1,y2)-C,Blanc,C);
	     call line(x1+C,Ydep_Aff+C,x2+C,imax(y1,y2)-C,GrisClair);
	else call line(x1-C,imin(y1,y2)+C,x2-C,Ydep_Aff+Haut_Aff-C,GrisClair);
	     call linep(x1,imin(y1,y2)+C,x2,Ydep_Aff+Haut_Aff-C,Blanc,C);
	     call line(x1+C,imin(y1,y2)+C,x2+C,Ydep_Aff+Haut_Aff-C,GrisClair);
	fi;
   fi;
  End Trace_Vil1;


(***************************************************************************)
(*    procedure d'affichage de la ville - on deborde de l'ecran            *)
(*    tracer d'une ligne horizontale qui peut depasser le cadre            *)
(***************************************************************************)
  
  Unit Trace_Vil2 : procedure (x1,y1,x2,y2 : real ; zoom : integer);
  Var C     : integer,
      min_x : integer,
      max_x : integer,
      min_y : integer,
      max_y : integer;
  Begin
   C:=5*zoom;
   min_x:=imin(x1,x2);
   max_x:=imax(x1,x2);
   min_y:=imin(y1,y2);
   max_y:=imax(y1,y2);
   if (min_x>=Xdep_Aff and max_x<=(Xdep_Aff+Larg_Aff))
   then (* on est en plein dans le cadre, on peut tracer normalement *)
	call line(imin(x1,x2)+C,y1-C,imax(x2,x1)-C,y2-C,GrisClair);
	call linep(imin(x1,x2)+C,y1,imax(x2,x1)-C,y2,Blanc,C);
	call line(imin(x1,x2)+C,y1+C,imax(x1,x2)-C,y2+C,GrisClair);
   else if (min_x<Xdep_Aff)  (* c'est le minimum qui pose pb *)
	then  call line(Xdep_Aff+C,y1-C,imax(x1,x2)-C,y2-C,GrisClair);
	      call linep(Xdep_Aff+C,y1,imax(x1,x2)-C,y2,Blanc,C);
	      call line(Xdep_Aff+C,y1+C,imax(x1,x2)-C,y2+C,GrisClair);
	else  call line(imin(x1,x2)+C,y1-C,Xdep_Aff+Larg_Aff-C,y2-C,GrisClair);
	      call linep(imin(x1,x2)+C,y1,Xdep_Aff+Larg_Aff-C,y2,Blanc,C);
	      call line(imin(x1,x2)+C,y1+C,Xdep_Aff+Larg_Aff-C,y2+C,GrisClair);
	fi;
   fi;
  End Trace_Vil2;

(***************************************************************************)
(*                     procedure d'affichage de la ville                   *)
(***************************************************************************)
   Unit Ville_Aff : procedure(zoom : integer);
   var r     : arcs,
       s     : sommets,
       l     : Liste,
       C     : integer,
       x1,y1 : integer,
       x2,y2 : integer,
       min_x : integer,
       max_x : integer,
       min_y : integer,
       max_y : integer;
   Begin
    if boolaf
    then
      call W.clear;
      r:=RaciArcs;
      while (r<> none)
       do 
	x1:=Xdep_Aff+COORD_X+(r.initial.colonne*COEF_X*zoom);
	y1:=Ydep_Aff+COORD_Y+(r.initial.Ligne*COEF_Y*zoom);
	x2:=Xdep_Aff+COORD_X+(r.final.colonne*COEF_X*zoom);
	y2:=Ydep_Aff+COORD_Y+(r.final.Ligne*COEF_Y*zoom);
	min_x:=imin(x1,x2);
	max_x:=imax(x1,x2);
	min_y:=imin(y1,y2);
	max_y:=imax(y1,y2);
	if(x1=x2)        (* c'est une ligne verticale *)
	then 
	 if (x1<Xdep_Aff or x2>(Xdep_Aff+Larg_Aff)) (* on est hors de l'ecran*)
	 then (* on ne fait rien *) 
	 else (* on va peut etre afficher qqch *)
	      if (max_y<Ydep_Aff or min_y>(Ydep_Aff+Haut_Aff))
	      then (* on ne doit rien afficher *) 
	      else (* on va afficher qqch *)
		   call trace_vil1(x1,y1,x2,y2,zoom);
	      fi;
	 fi;
	fi;
	if(y1=y2)        (* c'est une ligne horizontale   *)
	then 
	 if (y1<Ydep_Aff or y2>(Ydep_Aff+Haut_Aff)) (* on est hors de l'ecran*)
	 then (*on ne fait rien *)
	 else (*on va peut etre afficher qqch *)
	      if (max_x<Xdep_Aff or min_x>(Xdep_Aff+Larg_Aff))
	      then (* on ne doit rien afficher *) 
	      else (* on va afficher qqch *)
		   call trace_vil2(x1,y1,x2,y2,zoom);
	      fi;
	 fi;
	fi;
	r:=r.suivants;
       od;
      s:=RaciSomm;
      C:=5*zoom;
      while(s<>none)
       do
	x1:=Xdep_Aff+COORD_X+(s.colonne*COEF_X*zoom);
	y1:=Ydep_Aff+COORD_Y+(s.Ligne*COEF_Y*zoom);
	if (x1>=Xdep_Aff and x1<=(Xdep_Aff+Larg_Aff) 
	   and y1>=Ydep_Aff and y1<=(Ydep_Aff+Haut_Aff))
	then case s.afftype
	       when 1  : call line(x1-C,y1-C,x1+C,y1-C,GrisClair);
			 call line(x1+C,y1-C,x1+C,y1+C,GrisClair);
	       when 2  : call line(x1-C,y1+C,x1+C,y1+C,GrisClair);
			 call line(x1+C,y1+C,x1+C,y1-C,GrisClair);
	       when 3  : call line(x1-C,y1+C,x1-C,y1-C,GrisClair);
			 call line(x1-C,y1-C,x1+C,y1-C,GrisClair);
	       when 4  : call line(x1-C,y1-C,x1-C,y1+C,GrisClair);
			 call line(x1-C,y1+C,x1+C,y1+C,GrisClair);
	       when 5  : call line(x1-C,y1-C,x1+C,y1-C,GrisClair);
	       when 6  : call line(x1-C,y1+C,x1+C,y1+C,GrisClair);
	       when 7  : call line(x1+C,y1-C,x1+C,y1+C,GrisClair);
	       when 8  : call line(x1-C,y1-C,x1-C,y1+C,GrisClair);
	       when 9  :
	       when 10 : call line(x1-C,y1-C,x1+C,y1-C,GrisClair);
			 call line(x1-C,y1+C,x1+C,y1+C,GrisClair);
	       when 11 : call line(x1-C,y1-C,x1-C,y1+C,GrisClair);
			 call line(x1+C,y1-C,x1+C,y1+C,GrisClair);
	     esac;
	fi;
	s:=s.suivant;
       od;
    fi;
   End Ville_Aff;

(***************************************************************************)
(*                                                                         *)
(***************************************************************************)
Unit prog : Lists class;

(***************************************************************************)
(*         procedure de mise en route du generateur de voitures            *)
(***************************************************************************)
   Unit generator : procedure (nbcar : integer);
   Begin
    call schedule(new Generate(nbcar),time);
    call hold(10);
   End generator;

(***************************************************************************)
(*               simprocess de generation des voitures                     *)
(***************************************************************************)
   Unit Generate : Simprocess class(nbcar : integer);
   Begin
    do
     if NbCarActiv<=nbcar
     then call schedule(new car,time);
	  NbCarActiv:=NbCarActiv+1;
     fi;
     call hold(10);
    od;
   End Generate;

(***************************************************************************)
(*                     simprocess des voitures                             *)
(*       on se limite au cas o— toutes les voies sont … double sens        *)
(***************************************************************************)
   Unit Car : Simprocess class;
   
	(* procedure d'affichage de la voiture dans la ville *)
	Unit affiche_car : procedure;
	Begin

	End affiche_car;
	
	(* fonction se deplacant dans l'arc courant *)
	Unit avance : function : boolean;
	Begin
	 if sens=1
	 then arccour.occpsens(km):=none;
	      km:=km+1;
	      if km<=arccour.distance
	      then arccour.occpsens(km):=this car;
		   result:=True; (* on n'a pas encore fini *)
	      else result:=False; (* on est arrive au sommet final *)
	      fi;
	 else arccour.occpinve(km):=none;
	      km:=km+1;
	      if km<=arccour.distance
	      then arccour.occpinve(km):=this car;
		   result:=True; (* on n'a pas encore fini *)
	      else result:=False; (* on est arrive au sommet final *)
	      fi;
	 fi;
	 call affiche_car; 
	End avance;
   
	(* fonction choisissant le sommet de depart *)
	Unit choix_sommet : function : sommets;
	var som : sommets,
	    ch  : integer,
	    i   : integer;
	Begin
	 som:=RaciSomm;
	 ch:=RANDOM*NBSOMMETS+1; (* on choisit le numero du sommet *)
	 for i:=1 to ch-1
	  do
	   som:=som.suivant;
	  od;
	 result:=som;
	End choix_sommet;

	(* fonction choisissant l'arc suivant que l'on va prendre *)        
	Unit choix_arc : function : arcs;
	Var i         : integer,
	    nbarcs    : integer,
	    numarcdep : integer,
	    lst       : liste;
	Begin
	 nbarcs:=2;
	 if (dep.afftype<=8 and dep.afftype>=5)
	 then nbarcs:=nbarcs+1;
	 else if dep.afftype=9
	      then nbarcs:=nbarcs+2;
	      fi;
	 fi;
	 numarcdep:=RANDOM*nbarcs+1;
	 lst:=dep.ptrarc;
	 for i:=1 to numarcdep-1   (* on recherche cet arc dans la liste *)
	  do
	   lst:=lst.suivante;
	  od;
	 km:=1; (* kilometrage dans l'arc *)
	 result:=lst.pointeur;  (* on possŠde l'arc *)
	 if result.initial=dep
	 then sens:=1;
	 else sens:=-1;
	 fi;
	End choix_arc;

   Var dep       : sommets, (* sommet de depart du voyage *)
       arccour   : arcs,    (* arc de depart du voyage *)
       boo       : boolean,
       sens      : integer, (* 1 si ini-fin , -1 si fin-ini *)
       km        : integer; (* distance ds l'arc courant depuis sommet initial*)
   Begin
     dep:=choix_sommet;
     arccour:=choix_arc;
     do
      boo:=avance; (* on avance d'un pas *)
      if boo (* on est … la fin de l'arc, il faut savoir si on va en *)
	      (* prendre un autre *)
      then km:=RANDOM*100;
	   if km>60 
	   then arccour:=choix_arc; (* on a 60% de chance de continuer *)
		boo:=True;  (* on doit donc continuer *)
	   else boo:=False; (* on s'arrete *)
	   fi;
      fi;
      if boo  (* si boo alors on n'est pas encore au point d'arrivee *)
      then call hold(100);
      else exit;
      fi;
     od;
     NbCarActiv:=NbCarActiv-1;
     call passivate;
    End Car;


(***************************************************************************)
(*                   simprocess de gestion de l'affichage                  *)
(***************************************************************************)
   Unit affichage : simprocess class;
   Begin
   do 
    code:=W.Gestionnaire;
    call hidecursor;
    if (code=T_F1) or (code=1) then call Bot_Load; 
    else 
     if (code=T_F5) or (code=5) then if Bot_Quit then fin:=True; exit; fi; 
     else 
      if (code=T_F8) or (code=8) then call Bot_help; 
      else 
       if (code=T_ALTF4) then if Bot_Quit then fin:=True; exit; fi;
       else 
	if (code=T_F2) or (code=2) then call Bot_Run;
	else 
	 if (code=T_F3) or (code=3) then call Bot_Stop;
	 else 
	  if (code=T_f4) or (code=4) then call Bot_Continue;
	  else 
	   if (code=T_FLGCH) or (code=51) then call W.Horiz.DeplacerLeft;
					       COORD_X:=COORD_X+30;
					       call Ville_Aff(ZOOM);
	   else
	    if (code=T_FLDTE) or (code=53) then call W.Horiz.DeplacerRight;
						COORD_X:=COORD_X-30;
						call Ville_Aff(ZOOM);
	    else
	     if (code=T_FLHAU) or (code=61) then call W.Verti.DeplacerUp;
						 COORD_Y:=COORD_Y+30;
						 call Ville_Aff(ZOOM);
	     else
	      if (code=T_FLBAS) or (code=63) then call W.verti.DeplacerDown;
						  COORD_Y:=COORD_Y-30;
						  call Ville_Aff(ZOOM);
	      else
	       if (code=101) then if Bot_Quit then fin:=True; exit fi;
	       else
		if (code=102) then call W.iconify;
				   call Ville_Aff(ZOOM);
		else
		 if (code=52) then COORD_X:=0; 
				   call W.Horiz.Reset_Bot;
				   call Ville_Aff(ZOOM);
		 else
		  if (code=62) then COORD_Y:=0;
				    call W.Verti.Reset_Bot;
				    call Ville_Aff(ZOOM);
		  else 
		   if (code=6) or (code=T_F6) 
			then Zoom:=Zoom+1;
			     if zoom=5 then M(6).etat:=False;
					     call M(6).bot_disable;
			     fi;
			     if not M(7).etat then M(7).etat:=True;
						   call M(7).bot_enable;
			     fi;
			     C:=5*Zoom;
			     Larg_Aff:=W.Horiz.x2-W.Horiz.x1-20-2*C;
			     Haut_Aff:=W.Verti.y2-W.Verti.y1-20-2*C;
			     Xdep_Aff:=W.Horiz.x1+10+C;
			     Ydep_Aff:=W.Verti.y1+10+C;
			     call Ville_Aff(Zoom);
		   else
		    if (code=7) or (code=T_F7)
			 then Zoom:=Zoom-1;
			      if zoom=1 then M(7).etat:=False;
					     call M(7).bot_disable;
			      fi;
			      if not M(6).etat then M(6).etat:=True;
						    call M(6).bot_Enable;
			      fi;
			      C:=5*Zoom;
			      Larg_Aff:=W.Horiz.x2-W.Horiz.x1-20-2*C;
			      Haut_Aff:=W.Verti.y2-W.Verti.y1-20-2*C;
			      Xdep_Aff:=W.Horiz.x1+10+C;
			      Ydep_Aff:=W.Verti.y1+10+C;
			      call Ville_Aff(Zoom);
		    fi;
		   fi;
		  fi;
		 fi;
		fi;
	       fi;
	      fi;
	     fi;
	    fi;
	   fi;
	  fi;
	 fi;
	fi;
       fi;
      fi;
     fi;
    fi;
    call showcursor;
   od;
   End affichage;

Var sim_aff : affichage;
Begin
 sim_aff:=new affichage;
 call schedule(sim_aff,time);
 call hold(1);
End prog;

(***************************************************************************)
(*                 P R O G R A M M E   P R I  N C I P A L                  *)
(***************************************************************************)
Const  Larg_bot=18,
       Haut_bot=18;

var    prg    : prog,
       fin    : boolean,
       x1,y1  : integer,
       x2,y2  : integer,
       ZOOM   : integer, (*coeficient de zoom *)
       C      : integer, (* largeur des voies *)
       boolAf : boolean; (* vrai si il faut afficher la ville *)

Begin
   
   call gron(1);                (* mode 640x480x256 avec driver stealth.grn*)
   SIZEX:=640; 
   SIZEY:=480;

   clics:=new cliquer;             (* ensemble des zones de clic possible  *)

   W:=new Maine(100,1,1,SIZEX,SIZEY,3,True,True,False);
   W.hauteur:=Haut_bot;
   W.cborder:=BleuClair;
   W.cbande:=GrisClair;
   W.cnom:=BleuClair;
   W.nom:="Simulation de r‚seau routier";
   W.icname:="Root";
   
   array M dim (1:8);

   y1:=W.y1+W.lborder+1+W.hauteur+2;
   y2:=y1+Haut_bot;
   M(1):=new Menu(1,T_F1,W.x1+8,y1,W.x1+50,y2);
   M(1).nom:="Load";
   M(1).etat:=True;
   call W.Bout.Insert(M(1));

   M(2):=new Menu(2,-1,W.x1+55,y1,W.x1+89,y2);
   M(2).nom:="Run";
   M(2).etat:=False;
   call W.Bout.Insert(M(2));

   M(3):=new Menu(3,-1,W.x1+94,y1,W.x1+136,y2);
   M(3).nom:="Stop";
   M(3).etat:=False;
   call W.Bout.Insert(M(3)); 
   
   M(4):=new Menu(4,-1,W.x1+141,y1,W.x1+215,y2);
   M(4).nom:="Continue";
   M(4).etat:=False;
   call W.Bout.Insert(M(4));

   M(5):=new Menu(5,T_F5,W.x1+220,y1,W.x1+262,y2);
   M(5).nom:="Quit";
   M(5).etat:=True;
   call W.Bout.Insert(M(5));
   
   M(6):=new Menu(6,T_F6,W.x2-94,y1,W.x2-77,y2);
   M(6).nom:="+";
   M(6).etat:=True;
   call W.Bout.Insert(M(6));

   M(7):=new Menu(7,T_F7,W.x2-72,y1,W.x2-55,y2);
   M(7).nom:="-";
   M(7).etat:=False;
   call W.Bout.Insert(M(7));
   
   M(8):=new Menu(8,T_F8,W.x2-30,y1,W.x2-13,y2);
   M(8).nom:="?";
   M(8).etat:=True;
   call W.Bout.Insert(M(8)); 

   x1:=W.x1+W.lborder+1;
   y1:=W.y2-W.lborder-Haut_bot-1;
   x2:=W.x2-W.lborder-Larg_bot-1;
   y2:=W.y2-W.lborder-1;
   W.Horiz:=new AccelerateH(50,-1,x1,y1,x2,y2,W);

   x1:=W.x2-W.lborder-Larg_bot-1; 
   y1:=W.y1+W.lborder+2*(Haut_bot+2);
   x2:=W.x2-W.lborder-1;
   y2:=W.y2-W.lborder-Haut_bot;
   W.Verti:=new AccelerateV(60,-1,x1,y1,x2,y2,W);
   
   Larg_Aff:=W.Horiz.x2-W.Horiz.x1-20;
   Haut_Aff:=W.Verti.y2-W.Verti.y1-20;
   Xdep_Aff:=W.Horiz.x1+10;
   Ydep_Aff:=W.Verti.y1+10;
   COEF_X:=1;
   COEF_Y:=1;
   COORD_X:=0;
   COORD_Y:=0;
   ZOOM:=1;
   C:=5*ZOOM;
   call W.affiche;
   
   call showcursor;
   
   prg:=new prog; (* on met la simulation en route *)
		  (* NB: elle commence par l'affichage et sa gestion *)
   call hidecursor;
   
   call cls;
   
   call groff;

   end
  end
end.