PROGRAM station;
(*_________________________________________________________*)
(*    loglan station h+                                    *)
(*    hgen station                                         *)
(*    egahint /m50000 station                              *)
(*---------------------------------------------------------*)
 
(*----------------------------------------------------------*)
(* CALSSE DEFINISSANT LES PROCEDURES DE GRAPHISME UTILISEES *)
(*----------------------------------------------------------*)
  UNIT graph : IIUWGRAPH CLASS;
  CONST MAXx = 635,
        MAXy = 348,
        LETDIMY = 08,  (* Hauteur lettre *)
        LETDIMX = 8,   (* Largeur lettre *)
        Fgauche = -75, (* Fleche gauche *)
        Fdroite = -77, (* Fleche droite *)
        ESC = 27,      (* Touche escape *)
        RETOUR = 13,   (* Touche return *)
        BKSPACE = 8,   (* Touche Backspace *)
        MOINS = 45;    (* Touche signe moins *)
 
  (*---------------------------------------------------*)
  (* PROCEDURE permettant d'utiliser le mode GRAPHIQUE *)
  (*---------------------------------------------------*)
  UNIT initgraph : PROCEDURE;
  BEGIN CALL GRON(1); END initgraph;
 
  (*---------------------------------------------------*)
  (* PROCEDURE permettant de fermer le mode GRAPHIQUE  *)
  (*---------------------------------------------------*)
  UNIT closegraph : PROCEDURE;
  BEGIN CALL GROFF; END closegraph;
 
 
  (*-----------------------------------------------------------------*)
  (* AFFICHAGE en (x,y) d'un RECTANGLE de longueur l et de hauteur h *)
  (*-----------------------------------------------------------------*)
  UNIT rectangle : PROCEDURE(x,y,l,h : INTEGER);
  BEGIN
    CALL MOVE (x,y);
    CALL DRAW (x+l,y);
    CALL DRAW(x+l,y+h);
    CALL DRAW(x,y+h);
    CALL DRAW(x,y);
  END rectangle;
 
 
  (*--------------------------------------------------------------------*)
  (* ECRITURE d'une CHAINE de caracteres sur l'ecran graphique en (x,y) *)
  (*--------------------------------------------------------------------*)
  UNIT ecrit_text : PROCEDURE(x,y : INTEGER;str : string);
  VAR ch : ARRAYOF CHARACTER,
      lg,i : INTEGER;
  BEGIN
    call color(14);
    CALL move (x,y);
    ch := UNPACK(str);
    lg := UPPER(ch) - LOWER(ch) + 1;
    FOR i := 1 TO lg DO
      CALL HASCII(0);
      CALL HASCII(ORD(ch(i)));
    OD;
    call color(15);
  END;
 
  (*---------------------------------*)
  (* LECTURE d'une touche au clavier *)
  (*---------------------------------*)
  UNIT inchar : FUNCTION : INTEGER;
  VAR i : INTEGER;
  BEGIN
    DO
      i := INKEY;
      IF i =/= 0 THEN EXIT;
      FI;
    OD;
    result := i;
  END inchar;
 
  (*-------------------------------------------------------------------*)
  (* LECTURE d'un ENTIER au clavier et AFFICHAGE sur l'ecran graphique *)
  (*-------------------------------------------------------------------*)
  UNIT lire_entier: FUNCTION(x,y:INTEGER;OUTPUT valeur :INTEGER): BOOLEAN;
  VAR nbchiffre,key,i,cas : INTEGER,
      negatif : BOOLEAN;
  BEGIN
    CALL MOVE(x,y);
    FOR i := 1 TO 6 DO
      CALL HASCII(0);
      CALL MOVE(INXPOS+8,INYPOS);
    OD;
    CALL MOVE(x,y);
    DO
      DO  (* Lecture de la touche *)
        key := inchar;
        cas := key;
        IF (key >= 48 AND key <= 57)
          THEN cas := 1;
               EXIT;
        FI;
        IF (key = RETOUR) OR (key = ESC) OR (key = MOINS) OR (key = BKSPACE)
          THEN EXIT;
        FI;
      OD;
        CASE cas
          WHEN 1 : (* Saisie d'un chiffre *)
                   IF (nbchiffre < 5 )
                     THEN valeur := valeur*10 + key - 48;
                          IF x = INXPOS
                            THEN negatif := FALSE;
                          FI;
                          CALL HASCII(0);
                          CALL HASCII(key);
                          nbchiffre := nbchiffre + 1;
                     ELSE valeur :=(valeur DIV 10)*10 + key - 48;
                          CALL MOVE(inxpos-8,y);
                          CALL HASCII(0);
                          CALL HASCII(key);
                   FI;
          WHEN MOINS : (* Saisie du signe moins *)
                       IF x = INXPOS
                       THEN negatif := TRUE;
                            CALL HASCII(0);
                            CALL HASCII(MOINS);
                       FI;
          WHEN RETOUR : (* Validation du chiffre eventuellement entre *)
                        IF negatif
                          THEN valeur := 0 - valeur;
                        FI;
                        IF nbchiffre > 0
                          THEN result := true;
                        FI;
                        RETURN;
          WHEN ESC : (* Abandon de la saisie *)
                     RETURN;
          WHEN BKSPACE : (* Saisie de la touche Backspace *)
                         IF nbchiffre > 0
                            THEN valeur := valeur DIV 10;
                                 CALL MOVE(INXPOS-8,y);
                                 CALL HASCII(0);
                                 nbchiffre := nbchiffre -1
                            ELSE IF negatif
                                   THEN negatif := FALSE;
                                        CALL MOVE(inxpos-8,y);
                                        CALL HASCII(0);
                                  FI;
                          FI;
        ESAC;
    OD;
  END lire_entier;
 
  (*---------------------------------------------------------------------*)
  (* ECRITURE d'un ENTIER sur l'‚cran graphique au coordonn‚es courantes *)
  (*---------------------------------------------------------------------*)
  UNIT ecrit_entier : PROCEDURE (x : INTEGER);
  VAR val,i : INTEGER,
      strx : ARRAYOF CHARACTER;
  BEGIN
    ARRAY strx DIM(1:7);
    i := 7;
    val := ABS(x);
    DO
      strx(i) := chr(48+(val MOD 10));
      val := val DIV 10;
      IF (val = 0) THEN EXIT; FI;
      i := i - 1;
    OD;
    IF x < 0
      THEN i := i - 1;
           strx(i) := chr(MOINS);
    FI;
    WHILE i <= 7 DO
      CALL HASCII(0);
      CALL HASCII(ORD(strx(i)));
      i := i + 1;
    OD;
  END ecrit_entier;
 
  (*-------------------------------------------------------*)
  (* PROCEDURE d'ECRITURE de l'HEURE sur l'‚cran graphique *)
  (*-------------------------------------------------------*)
  UNIT ecrit_heure : PROCEDURE(posx,posy : INTEGER,time : REAL);
  VAR h,m,s : INTEGER;
  BEGIN
    h := ENTIER(time / 3600.0);
    m := ENTIER(time - ENTIER(time/3600)*3600) DIV 60;
    s := ENTIER(time - ENTIER(time/3600)*3600) MOD 60;
    IF ( h < 10)
      THEN CALL ecrit_text(posx,posy,"0");
      ELSE CALL MOVE(posx,posy);
    FI;
    CALL ecrit_entier(h);
    CALL ecrit_text(INXPOS,INYPOS,":");
    IF ( m < 10) THEN CALL ecrit_text(INXPOS,INYPOS,"0"); FI;
    CALL ecrit_entier(m);
    CALL ecrit_text(INXPOS,INYPOS,":");
    IF ( s < 10) THEN CALL ecrit_text(INXPOS,INYPOS,"0"); FI;
    CALL ecrit_entier(s);
   END ecrit_heure;
 
  END graph;
 
 
(*----------------------------------------------------------*)
(* IMPLEMENTATION d'une QUEUE DE PRIORITE sous forme de TAS *)
(*----------------------------------------------------------*)
UNIT priorityqueue : graph CLASS;
 
  (*----------------------------*)
  (* CLASSE repr‚sentant le TAS *)
  (*----------------------------*)
  UNIT queuehead: CLASS;
  VAR last,root:node;
 
    (*---------------------------------------------*)
    (* FONCTION renvoyant l'ELEMENT MINIMUM du TAS *)
    (*---------------------------------------------*)
    UNIT min: FUNCTION: elem;
    BEGIN
      IF root=/= NONE THEN RESULT:=root.el FI;
    END MIN;
 
    (*------------------------------------*)
    (* INSERTION d'un element dans le TAS *)
    (*------------------------------------*)
    UNIT insert: PROCEDURE(r:elem);
    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;
 
    (*---------------------------------*)
    (* SUPPRESSION d'un ELEMENT du TAS *)
    (*---------------------------------*)
    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;
        if y<>none then     (*!!!!!!!!dopisalam !!!!!*)
             Y.right:= last else root :=none fi;
             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;
 
  (*------------------------------------------------------------------------*)
  (* CORRECTION-REEQUILIBRAGE du TAS aprŠs une insertion ou une suppression *)
  (*------------------------------------------------------------------------*)
  UNIT correct: PROCEDURE(r:elem,down:BOOLEAN);
  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;    (* !!!!!!!!!!refference to none **********)
           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;
 
(*-----------------------------------*)
(* NOEUD du TAS contenant un element *)
(*-----------------------------------*)
UNIT node: CLASS (el:elem);
VAR left,right,up: node, ns:INTEGER;
 
  (*-----------------------------------*)
  (* COMPARAISON de deux NOEUDS du TAS *)
  (*-----------------------------------*)
  UNIT less: FUNCTION(x:node): BOOLEAN;
  BEGIN
    IF x= NONE
      THEN RESULT:=FALSE
      ELSE RESULT:=el.less(x.el)
    FI;
  END less;
END node;
 
(*-----------------------------------*)
(* TYPE generique des element du TAS *)
(*-----------------------------------*)
UNIT elem: CLASS(prior:REAL);
VAR lab: node;
 
  (*----------------------------------------------------*)
  (* FONCTION generique de comparaison de deux elements *)
  (*----------------------------------------------------*)
  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;
 
(*----------------------------------------------------------------------------*)
 
(*--------------------------------*)
(* MODULE GENERIQUE de SIMULATION *)
(*--------------------------------*)
UNIT simulation: priorityqueue CLASS;
 
VAR curr: simprocess,  (* Processus actif *)
    pq:queuehead,  (* L'axe des temps *)
    mainpr: mainprogram;
 
  UNIT simprocess: COROUTINE;
  VAR event,
      eventaux: eventnotice,
      finish: BOOLEAN;
 
    (*---------------------------------------------------------*)
    (* FONCTION permettant de savoir si le processus est actif *)
    (*---------------------------------------------------------*)
    UNIT IDLE: FUNCTION: BOOLEAN;
    BEGIN
      RESULT:= EVENT= NONE;
    END IDLE;
 
    (*-----------------------------------------------------------*)
    (* FONCTION permettant de savoir si le processus est termin‚ *)
    (*-----------------------------------------------------------*)
    UNIT TERMINATED: FUNCTION :BOOLEAN;
    BEGIN
      RESULT:= finish;
    END TERMINATED;
 
    UNIT evtime: FUNCTION: REAL;
    BEGIN
      IF IDLE
        THEN CALL ERROR1;
      FI;
      RESULT := event.eventtime;
    END evtime;
 
    UNIT ERROR1:PROCEDURE;
    BEGIN
      ATTACH(main);
      WRITELN(" Erreur tentative d'acces a un processus endormi");
    END ERROR1;
 
     UNIT ERROR2:PROCEDURE;
     BEGIN
       ATTACH(main);
       WRITELN(" Erreur : tentative d'acces a un processus deja termine");
     END ERROR2;
 
  BEGIN
    RETURN;
    INNER;
    finish:=TRUE;
    CALL passivate;
    CALL ERROR2;
  END simprocess;
 
  (*-------------------------------------------------*)
  (* PLACEMENT du processus actif sur l'axe du temps *)
  (*-------------------------------------------------*)
  UNIT eventnotice: elem CLASS;
  VAR eventtime: REAL, proc: simprocess;
 
    UNIT VIRTUAL less: FUNCTION(x: eventnotice):BOOLEAN;
    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;
  BEGIN
    DO
      ATTACH(main);
    OD;
  END mainprogram;
  (*-----------------------------------------------------------*)
  (* FONCTION permettant de savoir quel est le processus actif *)
  (*-----------------------------------------------------------*)
  UNIT time:FUNCTION:REAL;
  BEGIN
    RESULT:=current.evtime;
  END time;
 
  (*--------------------------------------------------------------------*)
  (* FONCTION retournant le premier processus place sur l'axe des temps *)
  (*--------------------------------------------------------------------*)
  UNIT current: FUNCTION: simprocess;
  BEGIN
    RESULT:=curr;
  END current;
 
  (*-----------------------------------------------------------*)
  (* PROCEDURE permettant d'activer le processus p … l'heure t *)
  (*-----------------------------------------------------------*)
  UNIT schedule: PROCEDURE(p:simprocess,t:REAL);
  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 p.event,p.eventaux:= NEW eventnotice(RANDOM);
                  p.event.proc:=p ;
             ELSE IF p.IDLE
                    THEN p.event:= p.eventaux;
                         p.event.prior:=RANDOM;
                    ELSE 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);
  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;
 
  (*----------------------------------------------------------*)
  (*   PROCEDURE permettant de desactiver le processus p et   *)
  (* d'activer le suivant processus situ‚ sur l'axe des temps *)
  (*----------------------------------------------------------*)
  UNIT passivate: PROCEDURE;
  BEGIN
    CALL pq.delete(current.event);
    current.event:=NONE;
    (* Choix du processus suivant … activer *)
    CALL choiceprocess
  END passivate;
 
  UNIT run: PROCEDURE(P:simprocess);
  BEGIN
    current.event.prior:=RANDOM;
    IF NOT p.IDLE                   (* !!! SL-chain cut off !!!!!!*)
      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);
  BEGIN
    IF p= current
      THEN CALL passivate;
      ELSE CALL pq.delete(p.EVENT);
           p.EVENT:=NONE;
    FI;
  END cancel;
 
  (*---------------------------------------------------------------------*)
  (*   PROCEDURE permettant de choisir le prochain processus qui va etre *)
  (*  activer , c'est … dir le premier de l'axe des temps                *)
  (*---------------------------------------------------------------------*)
  UNIT choiceprocess:PROCEDURE;
  VAR p:simprocess;
  BEGIN
    p:=curr;
    curr:= pq.MIN QUA eventnotice.proc;
    IF curr=NONE
      THEN WRITE(" ERREUR DANS LE TAS"); WRITELN;
           ATTACH(main);
      ELSE ATTACH(curr);
    FI;
  END choiceprocess;
 
BEGIN
  (* Simulation de l'axe des temps *)
  pq:=NEW queuehead;
  curr,mainpr:=NEW mainprogram;
  mainpr.event,mainpr.eventaux:=NEW eventnotice(0);
  mainpr.event.eventtime:=0;
  mainpr.event.proc:=mainpr;
  (* Insertion du processus sur l'axe des temps *)
  CALL pq.insert(mainpr.event);
  INNER;
  PQ:=NONE;
END simulation;
 
(*----------------------------------------------------------------------------*)
 
 
(* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *)
(* *         SIMULATION D'UNE STATION SERVICE DE 4 POMPES        * *)
(* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *)
 
UNIT stationservice : simulation CLASS;
 
(* DECLARATION DE CONSTANTES PERMETTANT DE DEFINIR LA HAUTEUR ET LA  *)
(*      LONGUEUR D'UNE POMPE, DE LA CAISSE ET D'UNE VOITURE          *)
const lhpompe =90,
      hhpompe = 40,
      lbpompe = 20,
      hbpompe = 20,
      lcaisse = 90,
      hcaisse = 40,
      lvoiture = 25,
      hvoiture = 15;
 
  (*-----------------------------------------------------------------*)
  (* Processus permettant l'affichage du temps courant de simulation *)
  (*-----------------------------------------------------------------*)
  UNIT clock : simprocess CLASS;
  BEGIN
    CALL rectangle (1,330,150,18);
    CALL ecrit_text (3,334,"TIME");
 
    (* BOUCLE INFINIE : AFFICHAGE de l'HEURE … CHAQUE FOIS que la *)
    (*                  proc‚dure est REVEILLE                    *)
    DO
      CALL ecrit_heure (55,334,time);
      CALL HOLD(60);
    OD;
  END clock;
 
 
  (*----------------------------------------*)
  (*     Processus simulant une POMPE       *)
  (*----------------------------------------*)
  (*  tip  : Style de carburant de la pompe *)
  (*  tipe : Numero de la pompe             *)
  (*  lig  : Coordonn‚es Y de l'‚cran       *)
  (*  col  : Coordonn‚es X de l'‚cran       *)
  (*----------------------------------------*)
  UNIT pompe : simprocess CLASS(tip : string,tipe,lig,col : INTEGER);
 
  VAR   nbcli : integer,  (* Nbre de clients a la pompe  *)
        libre: boolean,(* Booleen indiquant si la pompe  est libre *)
        cli : client,
        i,li :INTEGER;
  BEGIN
 
     i := pos_carb+(tipe-1)*80;
     (* TANT QUE la pompe est en attente *)
 
    (* BOUCLE INFINIE : FONCTIONNEMENT DES POMPES *)
    DO
 
       (* Si des clients attendent pour etre servis *)
       IF (file_pompe(tipe).tete =/= NONE and libre)
        THEN
 
             cli := file_pompe(tipe).tete.el;
 
             (* Mise en marche  de la pompe libre *)
             CALL ecrit_text (205,i,"MARCHE ");
 
             (* Affichage du numero du client qui est actuellement servi *)
             call move (265,i);
             call ecrit_entier(cli.num);
 
 
             (* CHOIX al‚atoire du nombre de litres de carburant *)
             li:=irandom (1,30);
             libre := false; (* la pompe est occupe par le client *)
             (* D‚roulement du service de li litres de carburant *)
             CALL HOLD(60*li);
 
              (* Mise en attente de la pompe  et decrementation du    *)
             (* nombre de clients souhaitant etre servi … cette mˆme pompe *)
 
             nbcli := nbcli - 1;
             call move(253,i+25 );
             call ecrit_entier(nbcli);
 
             (* Affichage … l'‚cran des differents clients d‚sirant prendre *)
             (*             du carburant … cette pompe                      *)
             call file_pompe(tipe).supprimer;
             call aff_queue_pompe(file_pompe(tipe), tipe);
 
             (* AFFICHAGE   sur la pompe signalant qu'elle est bloque *)
             CALL ecrit_text (205,i,"BLOQUE ");
 
             call schedule(cli, time);
             call hold(60);
 
        ELSE (* S'il n'y a pas de client : DESACTIVATION du processus *)
             CALL PASSIVATE;
       FI;
 
    OD;
 
  END pompe;
 
 
  (*-----------------------------------------------*)
  (* AFFICHAGE … l'‚cran d'une POMPE et du TYPE de *)
  (*       carburant qu'elle distribue             *)
  (*-----------------------------------------------*)
  UNIT aff_pompe : PROCEDURE(x : pompe);
  VAR i,ligne : INTEGER;
  BEGIN
    CALL rectangle (x.col,x.lig,lhpompe,hhpompe);
    CALL rectangle (x.col-2,x.lig-2,lhpompe+4,hhpompe+4);
    CALL rectangle (x.col+20,x.lig +hhpompe,lbpompe,hbpompe);
    CALL ecrit_text (x.col + 3, x.lig +10,x.tip);
  END aff_pompe;
 
 
  (*--------------------------------------------------*)
  (*           Processus simulant la caisse           *)
  (*--------------------------------------------------*)
  UNIT caisse : simprocess CLASS;
  VAR cli : client,
      i,num, nbcli : INTEGER,
      libre : boolean;
  BEGIN
    (* BOUCLE INFINIE : FONCTIONNEMENT DE LA CAISSE *)
 
    DO
      call move (45,180);
      call ecrit_entier(nbcli);
 
      (* SI la FILE de la caisse n'est pas vide   *)
      (*  ALORS traitement du client              *)
      (*  SINON desactivation du processus caisse *)
      IF (file_caisse.tete =/= NONE and libre)
       THEN
            cli := file_caisse.tete.el;
            nbc:=nbc +1;
 
            (* MISE en marche de la caisse *)
            CALL ecrit_text (35,170,"MARCHE ");
            libre := false;
            (* SUPPRESSION du client de la file d'attente de la caisse *)
            CALL file_caisse.supprimer;
 
           (* AFFICHAGE des clients se trouvant la la FILE de la caisse *)
            (*                 aprŠs le passage de ce client             *)
            CALL affiche_queue(file_caisse);
 
            (* AFFICHAGE du numero du client se trouvant … la caisse *)
            call move (90,170);
            call ecrit_entier(cli.num);
            call color(cli.col);
 
           (* AFFICHAGE le client qui paye??  a la caisse *)
            call aff_voiture(70,200,cli.num);
            call color(15);
 
            (* La dur‚e du PAIEMENT est de 10x60 *)
            CALL HOLD(300*random);
 
            (* MISE A L'ARRET de la caisee *)
            (* AFFICHAGE du nombre de client se trouvant dans la file *)
            nbcli := nbcli-1;
            CALL move (45,180);
            CALL ecrit_entier(nbcli);
 
            CALL ecrit_text (35,170,"STOP   ");
            call ecrit_text (90,170,"   ");
 
            (* CALCUL du temps total n‚c‚ssaire pour se servir et payer *)
            cli.temps_attente := time - cli.temps_arrive;
 
            (* CUMUL des differents temps d'attente *)
            temps := temps + cli.temps_attente;
 
            (* effacement de client qui deja paye *)
            call color(0);
            call aff_voiture(70,200,cli.num);
 
            call color(15);
            i := cli.val;
            KILL (cli);
            libre := true;
            (* ACTIVATION de la pompe qui viend d'ˆtre liberer aprŠs *)
            (*                 paiement … la caisse                  *)
             mach_pompe(i).libre := true;
             call schedule(mach_pompe(i), time);
             i := pos_carb+(i-1)*80;
             CALL ecrit_text (205,i,"PRET     ");
             call hold(120);
       ELSE CALL passivate;
      FI;
    OD;
    CALL passivate;
  END caisse;
 
  (*-------------------------------------------------*)
  (*            AFFICHAGE de la caisse               *)
  (*-------------------------------------------------*)
  UNIT aff_caisse : PROCEDURE( x : caisse);
    VAR i : INTEGER;
  BEGIN
    CALL rectangle (30,150,90,40);
    CALL ecrit_text (33,160,"CAISSE");
  END aff_caisse;
 
  (*------------------------------------------------*)
  (* AFFICHAGE  DE LA FILE D'ATTENTE DES POMPES     *)
  (*------------------------------------------------*)
 
 
 UNIT aff_queue_pompe : PROCEDURE ( q:file_attente, tip : integer);
    VAR val:client;
  BEGIN
       posx(tip):=300;
 
       (* POUR CHAQUE element du tas *)
       WHILE (q.prem <> NONE) DO
         (* AFFICHAGE eventuel de la voiture … l'‚cran, c'est *)
         (*     … dire s'il y a assez de place sur l'‚cran    *)
         IF ((posx(tip) >= 635) OR ((posx(tip) +25) >=635)) THEN EXIT; FI;
         call color(q.prem.el.col);
         CALL aff_voiture(posx(tip),posy(tip),q.prem.el.num);
 
         q.prem:=q.prem.succ;
         posx(tip):=posx(tip)+30;
       OD;
 
       (* EFFACEMENT de la derniere voiture qui vient d'avancer *)
       IF ((posx(tip) < 635) AND ((posx(tip) +25) <635)) THEN
         FOR i := posy(tip) TO (posy(tip)+25)
         DO
           CALL ecrit_text(posx(tip),i,"    ");
         OD;
       FI;
 
  END aff_queue_pompe;
 
 
 
 
  (*--------------------------------------------------*)
  (*    AFFICHAGE DE LA FILE D'ATTENTE DE LA CAISSE   *)
  (*--------------------------------------------------*)
 
  UNIT affiche_queue : PROCEDURE( q:file_attente ) ;
  BEGIN
     poscay:= 150;
 
      (* POUR CHAQUE element du tas *)
      WHILE (q.prem <> NONE) DO
        call ecrit_text(poscax+5,poscay+2,"  ");
        call color(q.prem.el.col);
        (* AFFICHAGE de la voiture … l'‚cran *)
        CALL aff_voiture(poscax,poscay,q.prem.el.num);
        q.prem:=q.prem.succ;
        poscay:=poscay-30;
        if poscay<50  then exit fi;
      OD;
 
      (* EFFACEMENT de la derniere voiture qui vient d'avancer *)
      FOR i := poscay TO (poscay+20) DO
        CALL ecrit_text(poscax,i,"    ");
      OD;
 
  END affiche_queue;
 
 
 
 
 
  (*----------------------------------------------*)
  (*      AFFICHAGE d'une voiture … l'‚cran       *)
  (*----------------------------------------------*)
  (* posx : position X de la voiture              *)
  (* posy : position Y de la voiture              *)
  (* x    : Numero … afficher sur la voiture,     *)
  (*        c'est … dire le num‚ro du client      *)
  (*----------------------------------------------*)
  UNIT aff_voiture : PROCEDURE(posx,posy,x:INTEGER);
  BEGIN
    CALL rectangle(posx,posy,25,15);
    CALL move (posx+5,posy+2);
    CALL ecrit_entier(x);
  END aff_voiture;
 
  (*----------------------------------------------------*)
  (* FONCTION RETOURNANT UN NOMBRE COMPRIS ENTRE a ET b *)
  (*----------------------------------------------------*)
  UNIT irandom : FUNCTION(a,b:INTEGER):INTEGER;
   begin
    result := entier((b-a)*random +a)
   end irandom;
 
 
  (*--------------------------------------------------------*)
  (*       Processus simulant UN CLIENT de la station       *)
  (*--------------------------------------------------------*)
  UNIT client : simprocess CLASS(num : INTEGER);
  VAR  val, col : integer, (* numero de pompe et couleur de voiture choisit*)
       bb : boolean,  (* bb= true si le client est premier*)
      temps_attente,temps_arrive : REAL; (* Temps d'attente dans la file *)
 
    (* On DETERMINE a l'ARRIVEE du client quel type de carburant il *)
    (*                          souhaite                            *)
    UNIT arrive : PROCEDURE;
    VAR i,j : INTEGER;
     BEGIN
 
      (* CHOIX ALEATOIRE du numero de pompe P que le client choisit *)
      val := irandom(1,5);
      col := irandom(1,14);
 
      (* SELON le numero de pompe :                                    *)
      (*    - INSERTION du client dans la file d'attente de la pompe P *)
      (*    - INCREMENTATION et AFFICHAGE du nombre de client se       *)
      (*                     trouvant … la pompe                       *)
 
      call file_pompe(val).inserer(this client);
 
      j:= mach_pompe(val).nbcli + 1;
      call move(253,75+(val-1)*80);
      call ecrit_entier(j);
      mach_pompe(val).nbcli :=j;
 
 
      (* AFFICHAGE de la voiture du nouveau client *)
      call color(col);
      CALL aff_queue_pompe(file_pompe(val),val);
      call color(15);
    END arrive;
 
  BEGIN
 
      CALL arrive;
      temps_arrive := time;
      if (mach_pompe(val).libre and  mach_pompe(val).idle )
      then
          call run(mach_pompe(val))
      fi;
 
      call passivate;
 
      (* INSERTION du client dans la liste d'attente de la caisse *)
      CALL file_caisse.inserer(this client);
 
      (* AFFICHAGE de l'ensemble des voitures qui se trouvent dans la  *)
      (* file d'attente de la caisse et du nombre decrement‚ du        *)
      (*           de  clients se trouvant dans la caisse              *)
      CALL affiche_queue(file_caisse);
      caissiere.nbcli:= caissiere.nbcli +1;
      if (caissiere.libre and  caissiere.idle )
      then
          CALL run(caissiere)  else call passivate;
      fi;
 
  END client;
 
  (*-------------------------------------------*)
  (*          GENERATEUR de client             *)
  (*-------------------------------------------*)
  UNIT gen_client : simprocess CLASS;
  BEGIN
    noclient := 0;
    nombre := 1;
    (* BOUCLE INFINIE : GENERATION D'UN CLIENT *)
    DO
      IF (noclient = 100)
        THEN noclient := 1;
      FI;
 
      (* GENERATION des clients plus ou moins rapide *)
      (*          selon la m‚t‚o qu'il fait          *)
      CALL schedule(NEW client(nombre),time);
      CASE (weather)
        WHEN 1 : CALL hold(RANDOM*300 +50);
        WHEN 2 : CALL hold(RANDOM*300 +100);
        WHEN 3 : CALL hold(RANDOM*300 +500);
      ESAC;
      noclient := noclient +1;
      nombre := nombre + 1;
    OD;
  END gen_client;
 
(*---------------------------------------------*)
(*      TYPE  des elements mis dans la file    *)
(*---------------------------------------------*)
 UNIT link : CLASS(el : client);
  VAR succ : link;
 END;
 
  UNIT file_attente : CLASS;
  VAR tete, queue,prem : link;
 
  (* INSERTION d'un CLIENT dans la FILE D'ATTENTE *)
  UNIT inserer : PROCEDURE(x : client);
  VAR inter : INTEGER;
  BEGIN
    IF tete = NONE
      THEN tete := NEW LINK(x);
           queue := tete;
      ELSE queue.succ := NEW link(x);
           queue := queue.succ;
    FI;
    prem:=tete;
  END inserer;
 
  (* SUPPRESSION d'un client de la file d'attente *)
  UNIT supprimer: PROCEDURE;
  BEGIN
    IF (tete =/= NONE)
      THEN
           tete := tete.succ;
    FI;
    prem:=tete;
  END supprimer;
END file_attente;
 
 
(*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*)
(*/*/*/*/*/*        P R O G R A M M E   P R I N C I P A L        */*/*/*/*/*)
(*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*)
  CONST poscax = 150,
        pos_carb   = 50;
  VAR
      posx,posy : ARRAYOF INTEGER,(* Indice pour l'affichage *)
      caissiere :caisse,          (* Caisse *)
      mach_pompe : ARRAYOF pompe, (* TABLEAU d'‚l‚ments de type pompe *)
      poscay,    (* Indice de positionnement de la caisse *)
      nombre,    (* Nombre de clients g‚n‚r‚s *)
      nbc,       (* Nombre de clients servis de carburant *)
                 (*            et ayant pay‚              *)
      i,         (* Variable de boucle *)
      noclient,  (* Nbre totale des clients               *)
      y,         (* *)
      car,       (* Variable permettant la saisie d'une touche *)
      time_simulation,
      weather : INTEGER,   (* Variable signalant le temps qu'il fait *)
      horloge : clock,     (* Compteur de l'heure *)
      cli : client,        (* UN client *)
      file_pompe : ARRAYOF file_attente, (* TABLEAU de FILES D'ATTENTE  *)
                                         (*       pour les pompes       *)
      file_caisse : file_attente,        (* FILE D'ATTENTE de la caisse *)
      temps :real,  (* TEMPS MOYEN d'attente de chaque client *)
      bol: boolean;(* booleen retourn‚ par une fonction de la class GRAPH *)
 
 
  BEGIN
 
       (* CREATION et INITIALISATION DES DIFFERENTS TABLEAUX *)
       (*       d'indice pour les affichages graphiques      *)
 
        ARRAY posy DIM(1:4);
        ARRAY posx DIM(1:4);
        FOR i:=1 TO 4 DO
            posx(i):=300;
        OD;
        posy(1):=45;
        posy(2):=125;
        posy(3):=205;
        posy(4):=285;
 
       (* OUVERTURE DU MODE GRAPHIQUE *)
       CALL initgraph;
 
       (* AFFICHAGE sommaire du sujet de la simulation et de la presentation *)
       CALL cls;
       CALL rectangle (1,1,635,348);
       CALL move (15,174);
       CALL ecrit_text (15,174,
       "  SIMULATION D'UNE STATION SERVICE COMPRENANT 4 POMPES
 ET D'UNE CAISSE ");
 
       (* LECTURE ET CONTROLE d'une hypothese n‚c‚ssaire *)
       (*        au d‚roulement de la simulation         *)
       (*        (temps qu'il fait)                      *)
       CALL ecrit_text (50,190," 1 - BEAU TEMPS");
       CALL ecrit_text (50,210," 2 - TEMPS COUVERT");
       CALL ecrit_text (50,230," 3 - NUIT");
       CALL ecrit_text (50,250,"   VOTRE CHOIX :");
       DO
          bol:= lire_entier(250,250,weather);
          IF (weather>0 and weather<4)  then
               exit
          ELSE
               CALL ecrit_text (50,250,"REDONNER VOTRE CHOIX :");
          FI;
       OD;
       call ecrit_text (50, 270," simulation time en minutes: ");
       bol := lire_entier(270,270,time_simulation);
       CALL ecrit_text (200,300,"< TAPER SUR UNE TOUCHE POUR CONTINUER >");
 
       (* CREATION de la file d'attente de clients pour chaque pompe *)
       ARRAY file_pompe DIM(1:4);
       FOR i:= 1 TO 4
       DO
             file_pompe(i) := new file_attente;
       OD;
 
       (* CREATION de la file d'attente de clients pour la caisse *)
       file_caisse := NEW file_attente;
 
       (* CREATION de l'HORLOGE de la simulation *)
       horloge := NEW clock;
       CALL schedule(horloge,time);
 
       (* CREATION de 4 POMPES *)
       ARRAY mach_pompe DIM(1:4);
       mach_pompe(1) := new pompe ("ESSENCE",1,25,200);
       mach_pompe(2) := new pompe ("SUPER",2,105,200);
       mach_pompe(3) := new pompe ("S PLOMB",3,185,200);
       mach_pompe(4) := new pompe ("GAZOIL",4,265,200);
 
 
       (* AFFICHAGE d'une page vierge *)
       CALL cls;
       CALL rectangle (1,1,635,348);
 
       (* AFFICHAGE des 4 pompes de la STATION *)
       y := pos_carb;
       FOR i := 1 TO 4 DO
            CALL color(i+1);
            CALL aff_pompe(mach_pompe(i));
            CALL ecrit_text(205,y,"LIBRE  ");
            mach_pompe(i).libre := true;
            y := y +80;
       OD;
       CALL color(15);
 
       (* CREATION de la caisse *)
       caissiere := NEW caisse;
       CALL aff_caisse(caissiere);
       Call ecrit_text(35,170,"LIBRE  ");
       caissiere.libre := true;
 
       CALL ecrit_text (60,10,"FILE DE LA CAISSE ");
       CALL ecrit_text (360,10, "FILES D'ATTENTE DES POMPES");
END;
 
BEGIN
 PREF stationservice BLOCK
 VAR car,sauv : INTEGER;
 
 (* Procedure permettant la recherche du type de pompe qu'il faut rajouter *)
 (*                         … la station service                           *)
 UNIT recherche :PROCEDURE(i,j:integer);
 var n : integer;
   BEGIN
     for n :=1 to 4 do
     IF mach_pompe(n).nbcli>=j THEN
          case n
            when 1 : CALL ecrit_text(300,i,"- ESSENCE");
            when 2 : CALL ecrit_text(300,i,"- SUPER");
            when 3 : CALL ecrit_text(300,i,"- S PLOMB");
            when 4 : CALL ecrit_text(300,i,"- GAZOIL ");
          esac;
       i:=i+10;
     FI;
     od;
 
   END recherche;
 
  BEGIN
      CALL schedule(NEW gen_client,TIME);
      CALL hold(Time_simulation*60);
      CALL ecrit_text (400,324,"FIN DE LA SIMULATION");
      CALL ecrit_text (200,335,"< TAPER SUR UNE TOUCHE POUR CONTINUER >");
      car := inchar;
      CALL cls;
      CALL ecrit_text(100,10,
      " OBSERVATION FINALE DE LA SIMULATION DE LA STATION");
 
    (* SI le nombre de client ayant pay‚ est diff‚rent de z‚ro *)
    IF (nbc <> 0) THEN
 
    (* AFFICHAGE DES OBSERVATIONS FINALES SELON LA METEO *)
    temps := (temps/nbc);
    CALL ecrit_text (100,100,"PENDANT LE TEMPS DE LA SIMILATION, SEULEMENT ");
    CALL move (460,100);
    CALL ecrit_entier(nbc);
    CALL ecrit_text (100,125,"PERSONNES ONT ETE TOTALEMENT SATISFAITES");
    CALL ecrit_text (100,150,"LE TEMPS MOYEN PASSE A LA STATION EST : ");
    CALL ecrit_heure (450,150,temps);
 
 
 
    sauv := 0;
     for i :=1 to 4 do
         y := mach_pompe(i).nbcli;
         if sauv< y then sauv := y fi;
    od;
 
 
    case weather
      when 1 : If ((sauv <=6) and (temps <=3000)) then
                  CALL ecrit_text (50,200,"LA STATION FONCTIONNE BIEN ");
               fi;
               If ((sauv <=6) and (temps >3000)) then
                  CALL ecrit_text (50,200,
                  "LES POMPES NE SONT PAS ASSEZ PUISSANTES");
               fi;
               If ((sauv >6) and (temps <=3000)) then
                  CALL ecrit_text (50,200,
                  "LES POMPES NE SONT PAS ASEZ PUISSANTES
VEILLEZ A AJOUTER DES POMPES : ");
                  CALL RECHERCHE (225,6)
               fi;
               If ((sauv >6) and (temps >3000)) then
                  CALL ecrit_text (50,200,"LA CONSTRUCTION D'UNE AUTRE STATION");
                  CALL ecrit_text (50,225," PARAIT NECESSAIRE ");
               fi;
      when 2 : If ((sauv <=5) and (temps <=2400)) then
                  CALL ecrit_text (50,200,"LA STATION FONCTIONNE BIEN ");
               fi;
               If ((sauv <=5) and (temps >2400)) then
                  CALL ecrit_text (50,200,"LES POMPES NE SONT PAS ASSEZ PUISSANTES");
               fi;
               If ((sauv >5) and (temps <=2400)) then
                  CALL ecrit_text (50,200,"LES POMPES NE SONT PAS ASEZ PUISSANTES
VEILLEZ A AJOUTER DES POMPES : ");
                  CALL RECHERCHE (225,5)
               fi;
               If ((sauv >5) and (temps >2400)) then
                  CALL ecrit_text (50,200,"LA CONSTRUCTION D'UNE AUTRE STATION");
                  CALL ecrit_text (50,225," PARAIT NECESSAIRE ");
               fi;
      when 3 : If ((sauv <=2) and (temps <=1800)) then
                  CALL ecrit_text (50,200,"LA STATION FONCTIONNE BIEN COMPTE
TENUE QUE C'EST LA NUIT ");
               fi;
               If ((sauv <=2) and (temps >1800)) then
                  CALL ecrit_text (50,200,"LES POMPES NE SONT PAS ASSEZ PUISSANTES");
               fi;
               If ((sauv >2) and (temps <=1800)) then
                  CALL ecrit_text (50,200,"LES POMPES NE SONT PAS ASEZ PUISSANTES
VEILLEZ A AJOUTER DES POMPES : ");
                  CALL RECHERCHE (225,2)
               fi;
               If ((sauv >2) and (temps >1800)) then
                  CALL ecrit_text (50,200,"LA CONSTRUCTION D'UNE AUTRE STATION");
                  CALL ecrit_text (50,225," PARAIT NECESSAIRE ");
               fi;
 
         esac;
 
    (* SINON AFFICHAGE D'UN MESSAGE SIGNALANT QU'AUCUN CLIENT N'A PAYE *)
    ELSE CALL ecrit_text (100,150,"AUCUN CLIENT N'A EU LE TEMPS DE SE SERVIR
ET DE PAYER");
    FI;
    CALL rectangle (1,1,635,348);
    CALL rectangle (10,30,612,300);
    car:=inchar;
 
    (* FERMETURE DU MODE GRAPHIQUE *)
    CALL closegraph;
 
  END;
END station;