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                                       *)
(* ligne de commande de lancement : 'svgaint simula'                       *)
(***************************************************************************)

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,
       T_Back   =008, T_ESPACE =032, T_CTRLENT=010;

Const  Larg_bot=18, (* largeur des boutons *)
       Haut_bot=18; (* hauteur des boutons *)

 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       *)
     Keys     : ListKey,
     SLKEYS   : arrayof listkey,
     SLCLICS  : arrayof cliquer,
     clics    : cliquer,
     EDIT     : editor,
     edit_bool: boolean,
     SIMULA   : simulateur,
     DOS      : MS_DOS;
 

(* les variables de la simulation *)

 Var RaciSomm   : Sommets,
     RaciArcs   : Arcs,
     Activ      : arrayof Pointeur,  (* liste des vehicules en activite *)
     NbCarActiv : integer,
     NbMaxCar   : integer,
     NBSOMMETS  : integer,
     SimStop    : boolean;

(***************************************************************************)
(*                  Permet de cr‚er un pointeur en loglan                  *)
(***************************************************************************)
 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 sur l'arc suivant dans la liste *)
     (* 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);
	     (* on met en place les variables permettant de d‚finir les coef*)
	     (* de l'affichage en vectoriel                                 *)
	     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; (* servira pour les ‚volutions futures *)
	     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 affichant chaque arc                     *)
(***************************************************************************)
Unit ParcArc : procedure;
var Noeud : arcs;
var parcours : Liste;
Begin
   Noeud := RaciArcs;
   while (Noeud <> none)
   do
     write("Numero: ");
     write(Noeud.Numero);
     write(" Sommet initial: ");
     write(Noeud.initial.nom);
     write(" Sommet final: ");
     write(Noeud.final.nom);
     write(" Distance: ");
     writeln(Noeud.Distance);
     Noeud := Noeud.suivants;
   od;
End ParcArc;


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

Unit CreeArcs : procedure( f: file);
var Noeud : Arcs;
var aux1 : char,
    aux2 : char,
    aux3 : char;
Begin
   readln(f);
   readln(f);
   while ( not(eof(f)))
   do
      Noeud := new Arcs;
      read(f,Noeud.Numero);
      read(f,aux3);
      read(f,aux1);
      read(f,aux3);
      read(f,aux2);
      read(f,aux3);
      read(f,Noeud.Sens);
      read(f,Noeud.distance);
      (* on va supposer qu'il y a toujours 2 voies, une dans chaque sens *)
      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; a : arrayof char);
var fichier  : file,
    flagbool : boolean;
begin
   Larg_Vil:=0;
   Haut_Vil:=0;
   NBSOMMETS:=0;
   open (fichier,text,a);
   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             *)
(***************************************************************************)

(***************************************************************************)
(*        trace une ligne entre 2 points, change la position courante      *)
(***************************************************************************)
   Unit Line : procedure (x1,y1,x2,y2,c : integer);
   Begin
      call color(c);
      call move(x1,y1);
      call draw(x2,y2);
   End Line;

(***************************************************************************)
(* tracer d'une ligne de pointill‚s, ne fonctionne qu'en horiz ou en verti *)
(***************************************************************************)
   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;

(***************************************************************************)
(*                   tracer d'un rectangle plein                           *)
(***************************************************************************)
   Unit Rectanglef : procedure (x1,y1,x2,y2,c : integer);
   var i : integer;
   Begin
    for i:=imin(y1,y2) to imax(y1,y2)
    do
      call Line(x1,i,x2,i,c);
    od
   End Rectanglef;

(****************************************************************************)
(*     Lecture d'une touche (bloquant) en affichant un curseur clignotant   *)
(***************************************************************************)
   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  *)
(*  l'entier doit se trouver dans une plage d‚finie par rangmin et rangmax  *)
(****************************************************************************)
   Unit gscanf_num : 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_num;

(****************************************************************************)
(*  lecture d'une chaine en mode graphique, esc revient au debut de saisie  *)
(****************************************************************************)
   Unit gscanf_char : function (x,y,larg : integer;inout nbmax : integer) : arrayof char;
   Var depx,posx   : integer,
       rep         : integer,
       col_e,col_f : integer,
       resultat    : arrayof char; 

    Unit affiche : procedure;
    Var i :integer;
    Begin
     call Rectanglef(x-1,y-1,x+larg*8,y+14,col_f);
     for i:=depx to posx
      do
       call move(x+(i-depx)*8,y);
       call hascii(ord(resultat(i)));
      od;
    End;

   Begin
    call hidecursor;
    array resultat dim (0:nbmax);
    resultat(0):=chr(0);
    col_f:=BleuClair;
    col_e:=Noir;
    depx:=0;
    posx:=0;
    call affiche;
    do
     do
      if depx=0
      then rep:=readcara(x+posx*8,y,col_f,col_e);
      else rep:=readcara(x+(larg-1)*8,y,col_f,col_e);
      fi;
      if ((rep>=32 and rep<=122) or rep=T_Back or rep=Tou_Ent)
      then exit;
      fi;
     od;
      if (rep>=32 and rep<=122)
      then resultat(posx):=chr(rep);
	   posx:=posx+1;
	   if posx>=nbmax
	   then posx:=posx-1;
	   else if posx>=larg
		then depx:=depx+1;
		fi;
	   fi;
	   call affiche;
      else if rep=Tou_ent
	   then exit;
	   else posx:=posx-1;
		if posx<0 then posx:=0; fi;
		resultat(posx):=chr(0);
		depx:=depx-1;
		if depx<0 then depx:=0; fi;
		call affiche;
	   fi;
      fi;
    od;
    nbmax:=posx;
    call showcursor;
    result:=resultat;
   End gscanf_char;


(****************************************************************************)
(*          affiche un entier en mode graphique, maximum 10 chiffres        *)
(****************************************************************************)
unit writint : procedure( valeur : integer);
var flag,i : integer;
var tbl    : arrayof integer;
begin
  array tbl dim (1:10);
  flag:=1;                                  (* on 'empile' en ordre reverse *)
  while valeur<>0
  do
   tbl(flag):=valeur mod 10;
   valeur:=valeur div 10;
   flag:=flag+1
  od;
  for i:=flag-1 downto 1                    (* on affiche dans le bon ordre *)
  do
   call hascii(48+tbl(i))
  od
end writint;



(***************************************************************************)
(*                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-1);
	  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             *)
(* la procedure sprite permet d'afficher le sprite correspondant au bouton *)
(***************************************************************************)
   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) (* si une touche a ‚t‚ d‚finie pour ce bouton *)
	 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) (* si une touche a ‚t‚ d‚finie pour ce bouton *)
	 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,   (* nom de la fenetre, sera affich‚ en haut  *)
       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,
       map     : arrayof integer, (* pour le getmap du dessous *)
       savmap  : arrayof integer; (* pour le getmap du dessus *)
	
       Unit affiche : procedure;
       var i : integer; 
	Begin
	 call move(x1,y1);
	 map:=getmap(x2,y2);
	 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;
	 call move(x1,y1);
	 savmap:=getmap(x2,y2);
	End affiche;
   
	Unit virtual AffSuite : procedure;
	End AffSuite;

	Unit restore : procedure;
	Begin
	 call move(x1,y1);
	 call putmap(map);
	 kill(map);
	End restore;

	Unit virtual clear : procedure;
	End clear;
	
	(* gestionnaire d'‚v‚nement de la fenetre *)
	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;
   (* ligne rajoutee pour que cela ne soit pas bloquant pdt la simulation *)
	  if not SimStop then exit fi;
	 od;
	End gestionnaire;

	(* permet de se deplacer dans la fenetre *)
	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;

	(* affichage d'une chaine de longueur connue 'long' *)
	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;

	(* affichage d'un caractŠre *)
	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; (* liste des boutons rattach‚s *)
    
    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   : AccelerateV1; (* 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 *)
	 call Keys.Insert(new elmt(T_SHFTF4)); (* shift/f4 pour about *)
	 call Keys.Insert(new elmt(T_CTRLF4)); (* ctrl/f4 pour iconify *)
	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,
	    sclic : cliquer,
	    mmap  : arrayof integer;

	Begin
	  call move(x1,y1);
	  mmap:=getmap(x2,y2);
	  call move(1,1);
	  call putmap(this maine qua windows.map);
	  sclic:=clics;
	  clics:=none;
	  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;
	  kill(clics);
	  clics:=sclic;
	  call move(1,1);
	  call putmap(mmap);
	  kill(mmap);
	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   : AccelerateV1; (* 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;
	 call AffSuite1;
	End AffSuite;

	Unit virtual AffSuite1 : procedure;
	End AffSuite1;

	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 la classe dialogue d‚rivant de la classe Son         *)
(***************************************************************************)
   
   Unit Dialogue : Son coroutine;
   Var ok, cancel : Menu,
       nomfic     : arrayof char,
       lgnomfic   : integer,
       flagbool   : boolean,
       temp       : file,
       pwd        : arrayof char,
       rep,i,j    : integer,
       lgpwd      : integer,
       fichiers   : liste_chaine,
       nbfichiers : integer,
       tampon     : arrayof arrayof char,
       creation   : boolean; (* true si le fichier doit ˆtre cr‚‚ *)

     
      Unit virtual AffSuite1 : procedure;
      var j : integer;
      Begin 
       call color(RougeClair);
       flagbool:=moveto(5,1);
       flagbool:=outgtext("Nom du fichier:",15);
       flagbool:=moveto(175,1);
       flagbool:=outgtext("Repertoires:",12);
       flagbool:=moveto(175,18);
       if lgpwd<13
       then for j:=0 to lgpwd 
	     do
	      flagbool:=outchar(pwd(j));
	     od;
       else for j:=0 to 2
	     do
	       flagbool:=outchar(pwd(j));
	     od;
	    flagbool:=outchar('.');
	    flagbool:=outchar('.');
	    flagbool:=outchar('.');
	    for j:=lgpwd-8 to lgpwd
	     do
	      flagbool:=outchar(pwd(j));
	     od;
       fi;
       call rectanglef(x1+9,y1+51,x1+147,y1+66,BleuClair);
       call clics.insert(new elm(512,x1+9,y1+52,x1+147,y1+66));
       call rectangle(x1+18,y1+70,x1+147,y1+150,BleuClair);
       call affiche_fic(0);
       if nbfichiers>5
       then verti:=new accelerateV1(520,-1,x1+148,y1+70,x1+164,y1+150,this windows);
	    call verti.affiche;
	    Bout.courant:=Bout.head;
	    while(Bout.Courant<>none)
	     do
	      call Bout.courant.data qua Bottons.affiche;
	      Bout.courant:=Bout.courant.next;
	     od;
       fi;
      End AffSuite1;

      Unit affiche_fic : procedure (depuis : integer);
      Var i,j : integer;
      Begin
	call rectanglef(x1+19,y1+71,x1+146,y1+149,Noir);
	call color(BleuClair);
	fichiers.depl:=fichiers.root;
	for i:=1 to depuis
	 do
	  fichiers.depl:=fichiers.depl.ptr;
	 od;
	(* on est positionn‚ sur le premier *)
	for j:=0 to imin(4,nbfichiers-depuis-1)
	 do
	  flagbool:=moveto(15,39+j*15);
	  call clics.insert(new elm(j+1,x1+20,y1+72+j*15,x1+147,y1+72+(j+1)*15));
	  tampon(j):=copy(fichiers.depl.data);
	  for i:=0 to 11
	   do
	    if fichiers.depl.data(i)=chr(0) then exit fi;
	    flagbool:=outchar(fichiers.depl.data(i));
	   od;
	  fichiers.depl:=fichiers.depl.ptr;
	 od;
      End affiche_fic;

      Unit Lecture : function : boolean;
      Var rep          : integer,  
	  depuis       : integer;
       
       Unit Aff_nom : procedure;
       Var i : integer;
       Begin
	call rectanglef(x1+9,y1+51,x1+147,y1+66,BleuClair);
	nomfic:=copy(tampon(rep-1));
	for i:=0 to upper(tampon(rep-1))
	 do
	  if tampon(rep-1,i)=chr(0) then exit fi;
	  flagbool:=moveto(3+i*8,18);
	  flagbool:=outchar(tampon(rep-1,i));
	 od;
       End Aff_nom;

       Unit Veux_creation : function : boolean;
       Const Largeur=320,
	     Hauteur=100;
       Var x,y,code     : integer,
	   Posx,Posy    : integer,
	   fille        : son,
	   fille_yes    : Menu,
	   fille_no     : Menu,
	   skey         : listkey,
	   sclic        : cliquer,
	   flagbool     : boolean;
       
       Begin
	 x:=(x2-x1-largeur)/2;
	 y:=(y2-y1-hauteur)/2;
	 Posx:=x1+x;
	 Posy:=y1+y;
	 sclic:=clics;
	 clics:=new cliquer;
	 skey:=keys;
	 keys:=new listkey;
	 fille:=new Son(20,Posx,Posy,Posx+Largeur,Posy+hauteur,2,
		   True,False,False);
	 attach(fille);
	 fille.hauteur:=Haut_Bot;
	 fille.cborder:=RougeClair;
	 fille.cbande:=Rouge;
	 call color(RougeClair);
	 fille_Yes:=new Menu(1,T_Y,Posx+60,Posy+61,Posx+100,Posy+61+Haut_bot);
	 fille_Yes.nom:="Yes";
	 fille_Yes.etat:=True;
	 call fille.Bout.Insert(fille_Yes);
	 fille_No:=new Menu(2,T_N,Posx+190,Posy+61,Posx+220,Posy+61+Haut_bot);
	 fille_No.nom:="No";
	 fille_No.etat:=True;
	 call fille.Bout.Insert(fille_No);
	 call keys.insert(new elmt(T_ESC));
	 call hidecursor;
	 call fille.affiche;       
	 flagbool:=fille.outgtext(" File not found : Do you want to creat",30);
	 call showcursor;
	 do
	  code:=fille.gestionnaire;
	  case code
	   when T_ESC : result:=false; exit;
	   when T_N   : result:=false; exit;
	   when T_Y   : result:=true; exit;
	   when 1     : result:=true; exit; (* menu yes *)
	   when 2     : result:=false; exit; (* menu no *)
	   when 11    : result:=false; exit; (*racc exit *)
	  esac; 
	 od;
	 call hidecursor;
	 call fille.restore;
	 attach(fille);
	 kill(fille);
	 kill(keys);
	 keys:=skey;
	 kill(clics);
	 clics:=sclic;
	 call showcursor;
       End Veux_creation;

      Begin
       do
	rep:=gestionnaire;
	if rep=512 or rep=T_ESPACE (* zone clics pr entr‚e clavier nomfichier *)
	then lgnomfic:=80;
	     nomfic:=gscanf_char(x1+10,y1+52,17,lgnomfic);
	     if nomfic(0)=chr(0)
	     then call hidecursor;
		  call rectanglef(x1+9,y1+51,x1+147,y1+66,BleuClair);
		  call showcursor;
		  call ok.bot_disable;
	     else if not fichiers.appartient(nomfic)
		  then if Veux_creation
		       then result:=true;
			    creation:=true;
			    exit;
		       else call hidecursor;
			    call rectanglef(x1+9,y1+51,x1+147,y1+66,BleuClair);
			    call showcursor;
			    nomfic(0):=chr(0);
			    call ok.bot_disable;
		       fi;
		  else call ok.bot_enable;
		  fi;
	     fi;
	else if rep>=1 and rep<=5
	     then call aff_nom;
		  call ok.bot_enable;
	     else if rep=510 or rep=Tou_Ent
		  then result:=true; exit;
		  else if rep=511  or rep=T_ESC
		       then result:=false; exit;
		       else if rep=521 or rep=T_FLHAU (* il y a plus de 5 fichiers : up *)
			    then depuis:=depuis-1;
				 if depuis<0 then depuis:=0; fi;
				 call affiche_fic(depuis);
			    else if rep=523 or rep=T_FLBAS(*  down *)
				 then depuis:=depuis+1; 
				      if depuis>(nbfichiers-4)
				      then depuis:=nbfichiers-4;
				      fi;
				      call affiche_fic(depuis);
				 fi;
			    fi;
		       fi;
		  fi;
	     fi;
	fi;
       od;
      End Lecture;

      Unit liste_chaine : class;
      Var root : node,
	  depl : node, (* pour les parcours *)
	  cour : node;

	Unit node : class;
	Var data : arrayof char,
	    ptr  : node;
	End node;

	Unit appartient : function (a : arrayof char) : boolean;
	Var fl :boolean;  
	
	  Unit egalite : function (a,b : arrayof char) :boolean;
	  Var i,j : integer;

	    Unit toupper : function (a : char) : char;
	    Begin
	     if (ord(a)>=97 and ord(a)<=122)
	     then result:=chr(ord(a)-32);
	     else result:=a;
	     fi;
	    End toupper;

	  Begin
	   result:=true;
	   i:=0;
	   while i<=upper(a)
	    do
	     if toupper(a(i))<>toupper(b(i))
	     then result:=false;
		  exit;
	     fi;
	     i:=i+1;
	     if a(i)=chr(0) then exit; fi;
	    od
	  End egalite;

	Begin
	 depl:=root;
	 fl:=false;
	 call move(10,400);
	 while (not(fl) and depl<>none)
	  do
	   fl:=egalite(a,depl.data);
	   depl:=depl.ptr;
	  od;
	  result:=fl; 
	End appartient;

	Unit insert : procedure (a : arrayof char);
	Var nouveau : node;
	Begin
	 nouveau:=new node;
	 nouveau.data:=copy(a);
	 if root=none
	 then root:=nouveau;
	      cour:=root;
	 else cour.ptr:=nouveau;
	      cour:=nouveau;
	 fi;
	End insert;
      
      End liste_chaine;

   Begin
     return;
    (* on va maintenant lire le pwd  et le mettre dans la variable pwd *)
     rep:=exec(unpack("cd > simula.tmp"));
     open(temp,text,unpack("simula.tmp"));
     call reset(temp);
     i:=0;
     array pwd dim (0:256);
     lgnomfic:=256;
     array nomfic dim (0:lgnomfic);
     while (not(eof(temp)) and i<=256)
      do
       read(temp,pwd(i));
       i:=i+1;
      od;
     lgpwd:=i-2;  (* -1 pour le i:=i+1 en trop + -1 pour le RC *)
     call unlink(temp);
     rep:=exec(unpack("dir *.dat /a /b > simula.tmp")); 
     open(temp,text,unpack("simula.tmp"));
     call reset(temp);
     fichiers:=new liste_chaine;
     while not(eof(temp))
      do
       i:=0;
	do
	  read(temp,nomfic(i));
	  if nomfic(i)=' ' then nomfic(i):=chr(0); fi;
	  if nomfic(i)=chr(10) or eof(temp)
	  then nomfic(i):=chr(0);
	       exit
	  else i:=i+1;
	  fi;
	od;
	call fichiers.insert(nomfic);
	nbfichiers:=nbfichiers+1;
      od;
     call unlink(temp);
     array tampon dim (0:5);
     for i:=0 to 5
      do
       array tampon(i) dim (0:15);
      od;
     ok:=new menu(510,Tou_Ent,x2-56,y1+30,x2-16,y1+30+Haut_Bot);
     ok.nom:=" Ok ";
     ok.etat:=False;
     call Bout.insert(ok);
     cancel:=new menu(511,T_ESC,x2-66,y1+60,x2-8,y1+60+Haut_Bot);
     cancel.nom:="Cancel";
     cancel.etat:=True;
     call Bout.insert(cancel);
     call Keys.insert(new elmt(T_ESPACE));
     detach;
   End Dialogue;


(***************************************************************************)
(*    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(3));
	 call bot_enable_suite;
	 etat:=True;
	End bot_enable;

	Unit virtual bot_enable_suite : procedure;
	End bot_enable_suite;

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

	Unit virtual bot_disable_suite : procedure;
	End bot_disable_suite;

	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 bot_enable_suite : procedure;
	Begin
	 call mother.bout.insert(Bs(2));
	End bot_enable_suite;
	
	Unit virtual bot_disable_suite : procedure;
	Begin
	 call mother.bout.delete(Bs(2));
	End bot_disable_suite;
	
	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 AccelerateV1 d‚rivant de Accelerate           *)
(***************************************************************************)

   Unit AccelerateV1 : 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 virtual bot_enable_suite : procedure;
	End bot_enable_suite;
      
	Unit virtual bot_disable_suite : procedure;
	End bot_disable_suite;

	Unit virtual DeplacerUp : procedure;
	var e : elm;
	Begin
	 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; 
	End DeplacerUp;

	Unit virtual Deplacer : procedure (y : integer);
	End Deplacer;
	
	Unit virtual DeplacerDown : procedure;
	var e : elm;
	Begin
	 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; 
	End DeplacerDown;

	Unit virtual Reset_Bot : procedure;
	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;
      inner;
      Bs(3):=new Racc(id+3,T_FLBAS,x2-15,y2-16,x2-2,y2-3,spr_lower);
      Bs(3).etat:=True;
   End AccelerateV1;

(***************************************************************************)
(*             definition de AccelerateV2 d‚rivant de AccelerateV1         *)
(***************************************************************************)

   Unit AccelerateV2 : AccelerateV1 class;

	Unit virtual bot_enable_suite : procedure;
	Begin
	 call mother.bout.insert(Bs(2));
	End bot_enable_suite;
	
	Unit virtual bot_disable_suite : procedure;
	Begin
	 call mother.bout.delete(Bs(2));
	End bot_disable_suite;
	
	Unit virtual 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
	 if y>=MinY and y<=MaxY
	 then 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;
	 fi;
	End Deplacer;
	
	Unit virtual 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
      Bs(2):=new Racc(id+2,-1,PosX,PosY,PosX+LX,PosY+LY,spr_point);
      Bs(2).etat:=True;
   End AccelerateV2;

(***************************************************************************)
(*          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;


(***************************************************************************)
(***************************************************************************)
(*                    PROGRAMME NUMERO 1 : SIMULATEUR                      *)
(***************************************************************************)
(***************************************************************************)
Unit simulateur : Logiciel coroutine;

var    prg    : prog,    (* programme principal, g‚r‚ par des simprocess *)
       fin    : boolean,
       x1,y1  : integer,
       x2,y2  : integer,
       ZOOM   : integer, (* coeficient de zoom *)
       C      : integer, (* largeur des voies *)
       M      : arrayof Menu,
       boolAf : boolean; (* vrai si il faut afficher la ville *)

(***************************************************************************)
   Unit Bot_Load : procedure;
   Const Largeur1=400,
	 Hauteur1=180,
	 Largeur2=340,
	 Hauteur2=100;
   Var   fenet1    : Dialogue,
	 fenet2    : Son,
	 x,y,i     : integer,
	 code      : integer,
	 flagbool  : boolean,
	 sclic     : cliquer,
	 skey      : listkey;

   Begin
    x:=(W.x2-W.x1)/2;
    y:=(W.y2-W.y1)/2;
    sclic:=clics;
    clics:=new cliquer;
    skey:=keys;
    keys:=new listkey;
    fenet1:=new dialogue(10,x-Largeur1/2,y-Hauteur1/2,x+Largeur1/2,y+Hauteur1/2,
		   2,False,False,False);
    attach(fenet1);
    attach(fenet1);
    fenet1.hauteur:=Haut_Bot;
    fenet1.cborder:=RougeClair;
    fenet1.cbande:=Rouge;
    call fenet1.affiche;
    call showcursor;
    flagbool:=fenet1.lecture;
    if flagbool and not fenet1.creation
    then call hidecursor;
	 kill(keys);
	 keys:=new listkey;
	 kill(clics);
	 clics:=new cliquer; 
	 fenet2:=new Son(20,x-Largeur2/2,y-Hauteur2/2,x+Largeur2/2,y+hauteur2/2,2,
		   False,False,False);
	 attach(fenet2);
	 fenet2.hauteur:=Haut_Bot;
	 fenet2.cborder:=RougeClair;
	 fenet2.cbande:=Rouge;
	 call fenet2.affiche;
	 flagbool:=fenet2.moveto(10,10);
	 call color(BleuClair);
	 flagbool:=fenet2.outgtext("Chargement de",14);  
	 for i:=0 to 12
	  do
	   if fenet1.nomfic(i)=chr(0) then exit fi;
	   flagbool:=fenet2.outchar(fenet1.nomfic(i));
	  od;
	 flagbool:=fenet2.outgtext("  en cours",8);
	 flagbool:=fenet2.moveto(10,25);
	 call color(VertClair);
	 flagbool:=fenet2.outgtext(".",1);
	 if RaciSomm<>none then RaciSomm:=none; fi;
	 if RaciArcs<>none then RaciArcs:=none; fi;
	 call W.verti.reset_bot;
	 call W.horiz.reset_bot;
	 call Lit_Ville(fenet2,fenet1.nomfic);
	 flagbool:=fenet2.moveto(10,40);
	 call color(BleuClair);
	 flagbool:=fenet2.outgtext("Chargement termin‚ : 'Enter'",28);
	 fenet2.B(0).etat:=True;
	 call fenet2.bout.insert(fenet2.B(0));
	 call fenet2.B(0).affiche;
	 call keys.insert(new elmt(Tou_Ent));
	 call showcursor;
	 do
	  code:=fenet2.gestionnaire;
	  if (code=Tou_Ent or code=21) then exit; fi;
	 od;
	 call hidecursor;
	 call fenet2.restore;
    else if flagbool and fenet1.creation
	 then EDIT.nomfic:=fenet1.nomfic;
	      attach(EDIT);
	      if edit_bool (* on a cr‚‚ un fichier coherant *)
	      then
	       call Etat_Menu(True,True,False,False,False,True);
	       COEF_X:=Larg_Aff/Larg_Vil;
	       COEF_Y:=Haut_Aff/Haut_Vil;
	       boolaf:=True;
	       Zoom:=1;
	       COORD_X:=0;
	       COORD_Y:=0;
	       call ville_aff(zoom);
	      fi;
	      call hidecursor;
	 else call hidecursor;
	 fi;
    fi;
    call fenet1.restore;
    kill(keys);
    keys:=skey;
    kill(clics);
    clics:=sclic;
    if flagbool and not fenet1.creation
    then attach(fenet2);
	 kill(fenet2);
	 call Etat_Menu(True,True,False,False,False,True);
	 COEF_X:=Larg_Aff/Larg_Vil;
	 COEF_Y:=Haut_Aff/Haut_Vil;
	 boolaf:=True;
	 Zoom:=1;
	 COORD_X:=0;
	 COORD_Y:=0;
	 call ville_aff(zoom);
    fi;
    attach(fenet1);
    kill(fenet1);
    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,
	 sclic     : cliquer,
	 skey      : listkey;

   Begin
    x:=(W.x2-W.x1)/2;
    y:=(W.y2-W.y1)/2;
    Posx:=x-Largeur/2;
    Posy:=y-Hauteur/2;
    sclic:=clics;
    clics:=new cliquer;
    skey:=keys;
    keys:=new listkey;
    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);
    NbMaxCar:=gscanf_num(1,50);
    array Activ dim (0:NbMaxCar); (* on genere le tableau des car actives *)
    call fenet.restore;
    kill(keys);
    keys:=skey;
    kill(clics);
    clics:=sclic;
    attach(fenet);
    kill(fenet);
    call Etat_Menu(False,False,True,False,False,False);
    SimStop:=False;
  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,
	 skey      : listkey,
	 sclic     : cliquer;

   Begin
    x:=(W.x2-W.x1)/2;
    y:=(W.y2-W.y1)/2;
    Posx:=x-Largeur/2;
    Posy:=y-Hauteur/2;
    sclic:=clics;
    clics:=new cliquer;
    skey:=keys;
    keys:=new listkey;
    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);
    call showcursor;
    do
     code:=inkey;
     if code<>0 then exit; fi;
    od;
    call hidecursor;
    call fenet.restore;
    kill(keys);
    keys:=skey;
    kill(clics);
    clics:=sclic;
    attach(fenet);
    kill(fenet);
    call Etat_Menu(True,False,False,True,True,True);
    SimStop:=True;
   End Bot_Stop;

(***************************************************************************)
   Unit Bot_continue : procedure;
   Const Largeur=290,
	 Hauteur=100;
   Var   fenet     : Son,
	 x,y       : integer,
	 Posx,Posy : integer,
	 code      : integer,
	 flagbool  : boolean,
	 sclic     : cliquer,
	 skey      : listkey;

   Begin
    x:=(W.x2-W.x1)/2;
    y:=(W.y2-W.y1)/2;
    Posx:=x-Largeur/2;
    Posy:=y-Hauteur/2;
    sclic:=clics;
    clics:=new cliquer;
    skey:=keys;
    keys:=new listkey;
    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;
    call fenet.affiche;
    call color(BleuClair);
    flagbool:=fenet.moveto(20,10);
    flagbool:=fenet.outgtext("La simulation va reprendre...",29);
    flagbool:=fenet.moveto(50,30);
    flagbool:=fenet.outgtext("Appuyez sur une touche",22);
    call showcursor;
    code:=0;
    do
     code:=inkey;
     if code<>0 then exit fi;
    od;
    call hidecursor;
    call fenet.restore;
    kill(keys);
    keys:=skey;
    kill(clics);
    clics:=sclic;
    attach(fenet);
    kill(fenet);
    call Etat_Menu(False,False,True,False,False,False);
    SimStop:=False;
   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,
	 sclic     : cliquer,
	 skey      : listkey;

   Begin
    x:=(W.x2-W.x1)/2;
    y:=(W.y2-W.y1)/2;
    Posx:=x-Largeur/2;
    Posy:=y-Hauteur/2;
    sclic:=clics;
    clics:=new cliquer;
    skey:=keys;
    keys:=new listkey;
    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;
    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 simulation");
    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 result:=False;
    else result:=True;
    fi;
    call fenet.restore;
    kill(keys);
    keys:=skey;
    kill(clics);
    clics:=sclic;
    attach(fenet);
    kill(fenet);
    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,
	 skey        : ListKey,
	 sclic       : cliquer;

   
      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;
    sclic:=clics;
    clics:=new cliquer;
    skey:=keys;
    keys:=new listkey;
    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;
    x:=fen.x2-fen.lborder-1-fen.hauteur;
    y:=fen.y1+fen.hauteur+fen.lborder+1;
    fen.Verti:=new AccelerateV2(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;
    call fen.restore; (* restore le getmap et free de la ram *)
    kill(keys);
    Keys:=skey;
    kill(clics);
    clics:=sclic;
    attach(fen);  (* correspond a la 1ere etape kill *)
    kill(fen);
   End Bot_Help;

(***************************************************************************)
   Unit About : procedure;
   Const Largeur=400,
	 Hauteur=195;
   Var   fenet     : Son,
	 x,y       : integer,
	 Posx,Posy : integer,
	 code      : integer,
	 flagbool  : boolean,
	 sclic     : cliquer,
	 skey      : Listkey;

   Begin
    x:=(W.x2-W.x1)/2;
    y:=(W.y2-W.y1)/2;
    Posx:=x-Largeur/2;
    Posy:=y-Hauteur/2;
    sclic:=clics;
    clics:=new cliquer;
    skey:=keys;
    keys:=new listkey;
    fenet:=new Son(10,x-Largeur/2,y-Hauteur/2,x+Largeur/2,y+Hauteur/2,2,
		   True,False,False);
    attach(fenet);
    fenet.hauteur:=Haut_Bot;
    fenet.cborder:=RougeClair;
    fenet.cbande:=Rouge;
    call fenet.affiche;
    call color(BleuClair);
    flagbool:=fenet.moveto(18,10);
    flagbool:=fenet.outgtext("Logiciel r‚alis‚ dans  le cadre d'un projet",43);
    flagbool:=fenet.moveto(18,40);
    flagbool:=fenet.outgtext("de Licence Informatique - Univertit‚ de PAU",43);
    flagbool:=fenet.moveto(10,70);
    flagbool:=fenet.outgtext("BARETS Olivier/PATAUD Fr‚d‚ric/PEYRAT Fran‡ois",43);
    flagbool:=fenet.moveto(10,100);
    flagbool:=fenet.outgtext("LI1                                  1993/1994",43);
    flagbool:=fenet.moveto(10,130);
    flagbool:=fenet.outgtext("M‚moire disponible : ",25);
    call writint(memavail*4); (* sizeof (word) = 32 *)
    flagbool:=fenet.moveto(230,130);
    flagbool:=fenet.outgtext("Ko",2);
    call Keys.Insert(new elmt(Tou_Ent));
    call Keys.Insert(new elmt(T_ESC));
    call showcursor;
    do
     code:=fenet.gestionnaire;
     if (code=11 or code=Tou_Ent or code=T_ESC) then exit; fi;
    od;
    call hidecursor;
    call fenet.restore;
    kill(keys);
    Keys:=skey;
    kill(clics);
    clics:=sclic;
    attach(fenet);
    kill(fenet);
   End About;



(***************************************************************************)
   Unit Etat_Menu : procedure (ml,mr,msto,mc,msta,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 (msto 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 msto 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 (msta and not M(5).etat)  (* stats devient enable *)
     then M(5).etat:=True;
	  M(5).Touche:=T_F5;
	  call M(5).bot_enable;
     fi;
     if (not msta and M(5).etat) (* stats devient disable *)
     then M(5).etat:=False;
	  M(5).Touche:=-1;
	  call M(5).bot_disable;
     fi;
     if (mq and not M(6).etat)  (* quit devient enable *)
     then M(6).etat:=True;
	  M(6).Touche:=T_F6;
	  call M(6).bot_enable;
     fi;
     if (not mq and M(6).etat) (* quit devient disable *)
     then M(6).etat:=False;
	  M(6).Touche:=-1;
	  call M(6).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;

(***************************************************************************)
   Unit Bot_Stats : procedure;
   Const Largeur=450,
	 Hauteur=350;
   Var   fenet     : Son,
	 x,y,i     : integer,
	 Posx,Posy : integer,
	 code      : integer,
	 flagbool  : boolean,
	 c         : integer,
	 skey      : listkey,
	 sclic     : cliquer;
   
   Begin
    x:=(W.x2-W.x1)/2;
    y:=(W.y2-W.y1)/2;
    Posx:=x-Largeur/2;
    Posy:=y-Hauteur/2;
    sclic:=clics;
    clics:=new cliquer;
    skey:=keys;
    keys:=new listkey;
    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;
    call fenet.affiche;
    call color(BleuClair);
    flagbool:=fenet.moveto(60,5);
    flagbool:=fenet.outgtext("Appuyez sur une touche pour continuer",38);
    call color(RougeClair);
    if NbCarActiv>0
    then for c:=0 to imax((NbCarActiv div 18)-1,0)
	 do
	  for i:=c*18 to imin(NbCarActiv-1-c*18,18*(c+1)) (*maxi 18 car … la fois *)
	   do
	    flagbool:=fenet.moveto(10,25+(i-c*18)*15);
	    call color(RougeClair);
	    call writint(i+1+c);
	    flagbool:=fenet.moveto(40,25+(i-c*18)*15);
	    call color(VertClair);
	    flagbool:=fenet.outgtext("En partance de ",15);
	    flagbool:=fenet.outchar(Activ(i) qua car.dep.nom);
	    call color(BleuClair);
	    flagbool:=fenet.moveto(170,25+(i-c*18)*15);
	    if Activ(i) qua car.km<>0
	    then flagbool:=fenet.outgtext(" position ",10);
		 call writint(Activ(i) qua car.km);
	    else flagbool:=fenet.outgtext(" position 0",11);
	    fi;
	    call color(VertClair);
	    flagbool:=fenet.moveto(266,25+(i-c*18)*15);
	    flagbool:=fenet.outgtext(" vers ",6);
	    if (Activ(i) qua car.arccour.initial.nom)=(Activ(i) qua car.dep.nom)
	    then flagbool:=fenet.outchar(Activ(i) qua car.arccour.final.nom);
	    else flagbool:=fenet.outchar(Activ(i) qua car.arccour.initial.nom);
	    fi;
	   od;
	   code:=0;
	   do
	    code:=inkey;
	    if code<>0 then exit fi;
	   od;
	   call fenet.clear;
	   call color(BleuClair);
	   flagbool:=fenet.moveto(60,5);
	   flagbool:=fenet.outgtext("Appuyez sur une touche pour continuer",38);
	  od;
    else flagbool:=fenet.moveto(10,25);
	 flagbool:=fenet.outgtext("NbCarActiv = 0",14);
	 code:=0;
	 do
	  code:=inkey;
	  if code<>0 then exit fi;
	 od;
    fi;
    call fenet.restore;
    kill(keys);
    keys:=skey;
    kill(clics);
    clics:=sclic;
    attach(fenet);
    kill(fenet);
   End Bot_Stats;


(***************************************************************************)
(*               simprocess de generation des voitures                     *)
(***************************************************************************)
   Unit Generate : Simprocess class;
   Begin
    do
     if NbCarActiv<NbMaxCar
     then Activ(NbCarActiv):=new car;
	  call schedule(Activ(NbCarActiv),time);
	  NbCarActiv:=NbCarActiv+1;
	  call hold(5);
     else call hold(70);
     fi;
    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;
	Var flagbool : boolean;
	   
	   Unit dessine_car : procedure (x1,y1,x2,y2 : integer);
	   Begin
	      call color(col);
	      x1:=COORD_X+x1*COEF_X*Zoom;
	      y1:=COORD_Y+y1*COEF_Y*Zoom;
	      x2:=COORD_X+x2*COEF_X*Zoom;
	      y2:=COORD_Y+y2*COEF_Y*Zoom;
	      if (x1>=0 and y1>=0 and x2<=Larg_Aff and y2<=Haut_Aff)
	      then call rectanglef(Xdep_Aff+x1,Ydep_Aff+y1,Xdep_Aff+x2,Ydep_Aff+y2,col);
	      fi;
	   End dessine_car;

	Begin
	 if arccour.Initial.colonne=arccour.final.colonne
	 then (* on est vertical *)
	      if sens=1 
	      then       (* on va de initial … final *)
		   if arccour.initial.ligne<arccour.final.ligne
		   then  (* l'initial est plus 'haut' que le final *)
			call dessine_car(arccour.initial.colonne+1,
			   arccour.initial.ligne+(km-1),
					 arccour.initial.colonne+(1+Zoom),
			     arccour.initial.ligne+(km));
		   else  (* l'initial est plus 'bas' que le final *)
			call dessine_car(arccour.initial.colonne+1,
			   arccour.initial.ligne-(km-1),
					 arccour.initial.colonne+(1+Zoom),
			     arccour.initial.ligne-(km));
		   fi;
	      else       (* on va de final … initial *)
		   if arccour.initial.ligne<arccour.final.ligne
		   then  (* l'initial est plus 'haut' que le final *)
			call dessine_car(arccour.final.colonne-1,
			   arccour.final.ligne-(km-1),
					 arccour.final.colonne-(1+Zoom),
			     arccour.final.ligne-(km));
		   else  (* l'initial est plus 'bas' que le final *)
			call dessine_car(arccour.final.colonne-1,
			   arccour.final.ligne+(km-1),
					 arccour.final.colonne-(1+Zoom),
			     arccour.final.ligne+(km));
		   fi;
	      fi;
	 else (* on est horizontal *)
	      if sens=1
	      then (* on va de initial … final *)
		   if arccour.initial.colonne<arccour.final.colonne
		   then  (* l'initial est plus 'gche' que le final *)
			call dessine_car(arccour.initial.colonne+(km-1),
							   arccour.initial.ligne+1,
					   arccour.initial.colonne+(km),
							  arccour.initial.ligne+(1+Zoom));
		   else  (* l'initial est plus 'dte' que le final *)
			call dessine_car(arccour.initial.colonne-(km-1),
							   arccour.initial.ligne+1,
					   arccour.initial.colonne-(km),
							  arccour.initial.ligne+(1+Zoom));
		   fi;
	      else (* on va de final … initial *)
		   if arccour.initial.colonne<arccour.final.colonne
		   then  (* l'initial est plus 'gche' que le final *)
			call dessine_car(arccour.final.colonne-(km-1),
							   arccour.final.ligne-1,
					   arccour.final.colonne-(km),
							  arccour.final.ligne-(1+Zoom));
		   else  (* l'initial est plus 'dte' que le final *)
			call dessine_car(arccour.final.colonne+(km-1),
							   arccour.final.ligne-1,
					   arccour.final.colonne+(km),
							  arccour.final.ligne-(1+Zoom));
		   fi;
	      fi;
	 fi;
	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 if arccour.occpsens(km)=none (* si il n'y a personne devant*)
		   then arccour.occpsens(km):=this car;
		   else km:=km-1;
		   fi;
		   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 if arccour.occpinve(km)=none (* s'il n'y a personne devant *)
		   then arccour.occpinve(km):=this car; (* on avance *)
		   else km:=km-1; (* sinon on reste en place *)
		   fi;
		   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,
	    sl        : liste;  (* sauvegarde du precedent *)
	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;
	 sl:=lst;
	 for i:=1 to numarcdep-1   (* on recherche cet arc dans la liste *)
	  do
	   sl:=lst;
	   lst:=lst.suivante;
	  od;
	 km:=1; (* kilometrage dans l'arc *)
	 if lst.pointeur=arccour (* on a repris le meme arc *)
	 then if sl<>lst
	      then result:=sl.pointeur; (* on prend le precedent *)
	      else result:=lst.suivante.pointeur; (* sinon le suivant *)
	      fi;
	 else result:=lst.pointeur;  (* on possŠde l'arc *)
	 fi;
	 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*)
       pourcent  : integer,
       col       : integer;  (* couleur de la voiture *)
   Begin
     dep:=choix_sommet;
     arccour:=dep.ptrarc.pointeur;
     if dep=arccour.initial
     then sens:=1;
     else sens:=-1;
     fi;
     col:=RANDOM*15+1; (* tout sauf noir *)
     km:=1;
     do
      boo:=avance; (* on avance d'un pas *)
      if not boo (* on est … la fin de l'arc, il faut savoir si on va en *)
		 (* prendre un autre *)
      then pourcent:=RANDOM*100;
	   if pourcent>20 
	   then if dep=arccour.initial
		then dep:=arccour.final;
		else dep:=arccour.initial;
		fi;
		arccour:=choix_arc; (* on a 80% 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(90);
      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_F6) or (code=6) then if Bot_Quit then fin:=True; exit; fi; 
     else 
      if (code=T_F9) or (code=9) 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;
		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=7) or (code=T_F7) 
			then Zoom:=Zoom+1;
			     if zoom=5 then M(7).etat:=False;
					     call M(7).bot_disable;
			     fi;
			     if not M(8).etat then M(8).etat:=True;
						   call M(8).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=8) or (code=T_F8)
			 then Zoom:=Zoom-1;
			      if zoom=1 then M(8).etat:=False;
					     call M(8).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=5) or (code=T_F5) then call Bot_Stats; 
		     else
		      if (code=T_SHFTF4) then call About;
		      else
		       if (code=T_CTRLF4) then call W.iconify;
		       else
			if code=T_CTRLENT then call rattacher(SIMULA,EDIT);
			fi;
		       fi;
		      fi;
		     fi;
		    fi;
		   fi;
		  fi;
		 fi;
		fi;
	       fi;
	      fi;
	     fi;
	    fi;
	   fi;
	  fi;
	 fi;
	fi;
       fi;
      fi;
     fi;
    fi;
    call showcursor;
    (* si on n'est pas en pause dans la simulation, on doit faire un hold *)
    (* pour pouvoir passer la 'main' au generateur et aux voitures        *)
    if not SimStop then call hold(120); fi;
   od;
   End affichage;

Var sim_aff : affichage;
Begin
 sim_aff:=new affichage;
 call schedule(new generate,time); (* mise dans la file du generateur de car *)
 call hold(10);
 call schedule(sim_aff,time); (* mise dans la file du systŠme d'affichage *)
 do 
  call hold(150);
  if fin then exit; fi;
 od;
End prog;



Begin

   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:9);

   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,-1,W.x1+220,y1,W.x1+270,y2);
   M(5).nom:="Stats";
   M(5).etat:=False;
   call W.Bout.Insert(M(5));

   M(6):=new Menu(6,T_F6,W.x1+275,y1,W.x1+317,y2);
   M(6).nom:="Quit";
   M(6).etat:=True;
   call W.Bout.Insert(M(6));
   
   M(7):=new Menu(7,T_F7,W.x2-94,y1,W.x2-77,y2);
   M(7).nom:="+";
   M(7).etat:=True;
   call W.Bout.Insert(M(7));

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

   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 AccelerateV2(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;
   
   return;

   call keys.insert(new elmt(T_CTRLENT)); (* pour le chgt de programme *)

   call W.affiche;
   notfirst:=true; (* on a deja fait un affichage de la fenetre *)

   call About;  (* about en presentation *)
   
   call showcursor;

   prg:=new prog; (* on met la simulation en route *)
		  (* NB: elle commence par l'affichage et sa gestion *)
   call hidecursor;
   
   call W.restore;
   
end simulateur;
  
(***************************************************************************)
(***************************************************************************)
(*                 PROGRAMME NUMERO 2 : EDITEUR DE VILLES                  *)
(***************************************************************************)
(***************************************************************************)
   Unit editor : Logiciel coroutine (nomfic : arrayof char;output resultat : boolean);
   Var largeur : integer,
       hauteur : integer,
       y1,y2   : integer,
       M       : arrayof menu;

(***************************************************************************)
   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,
	 sclic     : cliquer,
	 skey      : listkey;

   Begin
    x:=(W.x2-W.x1)/2;
    y:=(W.y2-W.y1)/2;
    Posx:=x-Largeur/2;
    Posy:=y-Hauteur/2;
    sclic:=clics;
    clics:=new cliquer;
    skey:=keys;
    keys:=new listkey;
    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;
    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 editor");
    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 result:=False;
    else result:=True;
    fi;
    call fenet.restore;
    kill(keys);
    keys:=skey;
    kill(clics);
    clics:=sclic;
    attach(fenet);
    kill(fenet);
    call showcursor;
   End Bot_Quit;
   
   
   
   
   Begin
    largeur:=SIZEX;
    hauteur:=SIZEY;
    W:=new Maine(100,1,1,largeur,hauteur,3,True,True,False);
    W.hauteur:=Haut_bot;
    W.cborder:=BleuClair;
    W.cbande:=GrisClair;
    W.cnom:=BleuClair;
    W.nom:="Editeur de r‚seau routier";
    W.icname:="Edit";
   
    array M dim (1:6);

    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,T_F2,W.x1+55,y1,W.x1+99,y2);
    M(2).nom:="Save";
    M(2).etat:=False;
    call W.Bout.Insert(M(2));
 
    M(3):=new Menu(3,T_F3,W.x1+104,y1,W.x1+146,y2);
    M(3).nom:="Quit";
    M(3).etat:=True;
    call W.Bout.Insert(M(3)); 

    M(4):=new Menu(4,T_F4,W.x2-94,y1,W.x2-77,y2);
    M(4).nom:="+";
    M(4).etat:=True;
    call W.Bout.Insert(M(4));
 
    M(5):=new Menu(5,-1,W.x2-72,y1,W.x2-55,y2);
    M(5).nom:="-";
    M(5).etat:=False;
    call W.Bout.Insert(M(5));
    
    M(6):=new Menu(6,T_F6,W.x2-30,y1,W.x2-13,y2);
    M(6).nom:="?";
    M(6).etat:=True;
    call W.Bout.Insert(M(6)); 
    
    return; (* fin de l'initialisation de la coroutine *)

    call keys.insert(new elmt(T_CTRLENT)); (* pour le chgt de programme *)

    call W.affiche;
    notfirst:=true; (* on a deja fait un affichage de la fenetre *)

    do
     code:=W.gestionnaire;
     if code=T_F3 or code=3 then if bot_quit then exit; fi;
     else 
      if code=T_F1 or code=1 then 
      else 
       if code=T_F2 or code=2 then
       else 
	if code=T_CTRLF4 then call W.iconify;
	else 
	 if code=T_F4 or code=4 then
	 else  
	  if code=T_F5 or code=5 then
	  else
	   if code=T_F6 or code=6 then
	   else
	    if code=T_CTRLENT then call rattacher(EDIT,DOS);
	    fi;
	   fi;
	  fi;
	 fi;
	fi;
       fi;
      fi;
     fi;
    od;
    call hidecursor;
    call W.restore;
    call showcursor;
    kill(W);
   End editor;

  
(***************************************************************************)
(***************************************************************************)
(*                 PROGRAMME NUMERO 3 : FENETRE MS-DOS                     *)
(***************************************************************************)
(***************************************************************************)
   Unit MS_DOS : Logiciel coroutine; 
   Var largeur : integer,
       hauteur : integer,
       y1,y2   : integer,
       M       : arrayof menu;

(***************************************************************************)
   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,
	 sclic     : cliquer,
	 skey      : listkey;

   Begin
    x:=(W.x2-W.x1)/2;
    y:=(W.y2-W.y1)/2;
    Posx:=x-Largeur/2;
    Posy:=y-Hauteur/2;
    sclic:=clics;
    clics:=new cliquer;
    skey:=keys;
    keys:=new listkey;
    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;
    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 DOS session");
    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 result:=False;
    else result:=True;
    fi;
    call fenet.restore;
    kill(keys);
    keys:=skey;
    kill(clics);
    clics:=sclic;
    attach(fenet);
    kill(fenet);
    call showcursor;
   End Bot_Quit;
   
   
   
   
   Begin
    largeur:=SIZEX;
    hauteur:=SIZEY;
    W:=new Maine(100,1,1,largeur,hauteur,3,True,True,False);
    W.hauteur:=Haut_bot;
    W.cborder:=BleuClair;
    W.cbande:=GrisClair;
    W.cnom:=BleuClair;
    W.nom:="Fenetre MS-DOS";
    W.icname:="MS-DOS";
   
    array M dim (1:2);

    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:="Quit";
    M(1).etat:=True;
    call W.Bout.Insert(M(1));
 
    M(2):=new Menu(2,T_F2,W.x2-30,y1,W.x2-13,y2);
    M(2).nom:="?";
    M(2).etat:=True;
    call W.Bout.Insert(M(2)); 
    
    return; (* fin de l'initialisation de la coroutine *)

    call keys.insert(new elmt(T_CTRLENT)); (* pour le chgt de programme *)

    call W.affiche;
    notfirst:=true; (* on a deja fait un affichage de la fenetre *)

    do
     code:=W.gestionnaire;
     if code=T_F1 or code=1 then if bot_quit then exit; fi;
     else 
      if code=T_CTRLF4 then call W.iconify;
      else 
       if code=T_CTRLENT then call rattacher(DOS,SIMULA);
       fi;
      fi;
     fi;
    od;
    call hidecursor;
    call W.restore;
    call showcursor;
    kill(W);
   End MS_DOS;

  
  
(***************************************************************************)
(***************************************************************************)
(*                P R O G R A M M  E     P R IN C I P A L                  *)
(***************************************************************************)
(***************************************************************************)
  
  Unit Logiciel : coroutine(id : integer);
  Var W        : Maine,
      notfirst : boolean; (* false si c'est la premiŠre fois *)
  End logiciel;



  Unit rattacher : procedure (co_prov,co_dest : Logiciel);
  Begin
    if co_dest<>none
    then SLKEYS(co_prov.id):=Keys; (* on sauve les liste de l'ancien actif *)
	 SLCLICS(co_prov.id):=clics;
	 call move(co_prov.W.x1,co_prov.W.y1);
	 co_prov.W.savmap:=getmap(co_prov.W.x2,co_prov.W.y2);
      
	 Keys:=SLKEYS(co_dest.id);   (* on met les listes du prog actif en place *)
	 clics:=SLCLICS(co_dest.id);
	 if co_dest.notfirst
	 then call move(co_dest.W.x1,co_dest.W.y1);
	      call putmap(co_dest.W.savmap);
	 fi;
    
	 attach(co_dest); (* on met actif le programme *)
    fi;
  End rattacher;

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

    array SLKEYS  dim (1:3);
    array SLCLICS dim (1:3);
    
    clics:=new cliquer;             (* ensemble des zones de clic possible  *)
    Keys:=new ListKey;              (* liste des touches rattach‚es *)
    SIMULA:=new simulateur(1);
    SLKEYS(1):=keys;
    SLCLICS(1):=clics;
    
    clics:=new cliquer;             (* ensemble des zones de clic possible  *)
    Keys:=new ListKey;              (* liste des touches rattach‚es *)
    EDIT:=new editor(2,none,edit_bool);
    SLKEYS(2):=keys;
    SLCLICS(2):=clics;
    
    clics:=new cliquer;             (* ensemble des zones de clic possible  *)
    Keys:=new ListKey;              (* liste des touches rattach‚es *)
    DOS:=new MS_DOS(3);
    SLKEYS(3):=keys;
    SLCLICS(3):=clics;

    Keys:=SLKEYS(1);   (* on met les listes du prog actif en place *)
    clics:=SLCLICS(1);
    do
     attach(SIMULA);
    od;
    
    call groff;
  End

  end
end.