examples/grazyna.xmp/station.log

   1 PROGRAM station;\r
   2 (*_________________________________________________________*)\r
   3 (*    loglan station h+                                    *)\r
   4 (*    hgen station                                         *)\r
   5 (*    egahint /m50000 station                              *)\r
   6 (*---------------------------------------------------------*)\r
   7  \r
   8 (*----------------------------------------------------------*)\r
   9 (* CALSSE DEFINISSANT LES PROCEDURES DE GRAPHISME UTILISEES *)\r
  10 (*----------------------------------------------------------*)\r
  11   UNIT graph : IIUWGRAPH CLASS;\r
  12   CONST MAXx = 635,\r
  13         MAXy = 348,\r
  14         LETDIMY = 08,  (* Hauteur lettre *)\r
  15         LETDIMX = 8,   (* Largeur lettre *)\r
  16         Fgauche = -75, (* Fleche gauche *)\r
  17         Fdroite = -77, (* Fleche droite *)\r
  18         ESC = 27,      (* Touche escape *)\r
  19         RETOUR = 13,   (* Touche return *)\r
  20         BKSPACE = 8,   (* Touche Backspace *)\r
  21         MOINS = 45;    (* Touche signe moins *)\r
  22  \r
  23   (*---------------------------------------------------*)\r
  24   (* PROCEDURE permettant d'utiliser le mode GRAPHIQUE *)\r
  25   (*---------------------------------------------------*)\r
  26   UNIT initgraph : PROCEDURE;\r
  27   BEGIN CALL GRON(1); END initgraph;\r
  28  \r
  29   (*---------------------------------------------------*)\r
  30   (* PROCEDURE permettant de fermer le mode GRAPHIQUE  *)\r
  31   (*---------------------------------------------------*)\r
  32   UNIT closegraph : PROCEDURE;\r
  33   BEGIN CALL GROFF; END closegraph;\r
  34  \r
  35  \r
  36   (*-----------------------------------------------------------------*)\r
  37   (* AFFICHAGE en (x,y) d'un RECTANGLE de longueur l et de hauteur h *)\r
  38   (*-----------------------------------------------------------------*)\r
  39   UNIT rectangle : PROCEDURE(x,y,l,h : INTEGER);\r
  40   BEGIN\r
  41     CALL MOVE (x,y);\r
  42     CALL DRAW (x+l,y);\r
  43     CALL DRAW(x+l,y+h);\r
  44     CALL DRAW(x,y+h);\r
  45     CALL DRAW(x,y);\r
  46   END rectangle;\r
  47  \r
  48  \r
  49   (*--------------------------------------------------------------------*)\r
  50   (* ECRITURE d'une CHAINE de caracteres sur l'ecran graphique en (x,y) *)\r
  51   (*--------------------------------------------------------------------*)\r
  52   UNIT ecrit_text : PROCEDURE(x,y : INTEGER;str : string);\r
  53   VAR ch : ARRAYOF CHARACTER,\r
  54       lg,i : INTEGER;\r
  55   BEGIN\r
  56     call color(14);\r
  57     CALL move (x,y);\r
  58     ch := UNPACK(str);\r
  59     lg := UPPER(ch) - LOWER(ch) + 1;\r
  60     FOR i := 1 TO lg DO\r
  61       CALL HASCII(0);\r
  62       CALL HASCII(ORD(ch(i)));\r
  63     OD;\r
  64     call color(15);\r
  65   END;\r
  66  \r
  67   (*---------------------------------*)\r
  68   (* LECTURE d'une touche au clavier *)\r
  69   (*---------------------------------*)\r
  70   UNIT inchar : FUNCTION : INTEGER;\r
  71   VAR i : INTEGER;\r
  72   BEGIN\r
  73     DO\r
  74       i := INKEY;\r
  75       IF i =/= 0 THEN EXIT;\r
  76       FI;\r
  77     OD;\r
  78     result := i;\r
  79   END inchar;\r
  80  \r
  81   (*-------------------------------------------------------------------*)\r
  82   (* LECTURE d'un ENTIER au clavier et AFFICHAGE sur l'ecran graphique *)\r
  83   (*-------------------------------------------------------------------*)\r
  84   UNIT lire_entier: FUNCTION(x,y:INTEGER;OUTPUT valeur :INTEGER): BOOLEAN;\r
  85   VAR nbchiffre,key,i,cas : INTEGER,\r
  86       negatif : BOOLEAN;\r
  87   BEGIN\r
  88     CALL MOVE(x,y);\r
  89     FOR i := 1 TO 6 DO\r
  90       CALL HASCII(0);\r
  91       CALL MOVE(INXPOS+8,INYPOS);\r
  92     OD;\r
  93     CALL MOVE(x,y);\r
  94     DO\r
  95       DO  (* Lecture de la touche *)\r
  96         key := inchar;\r
  97         cas := key;\r
  98         IF (key >= 48 AND key <= 57)\r
  99           THEN cas := 1;\r
 100                EXIT;\r
 101         FI;\r
 102         IF (key = RETOUR) OR (key = ESC) OR (key = MOINS) OR (key = BKSPACE)\r
 103           THEN EXIT;\r
 104         FI;\r
 105       OD;\r
 106         CASE cas\r
 107           WHEN 1 : (* Saisie d'un chiffre *)\r
 108                    IF (nbchiffre < 5 )\r
 109                      THEN valeur := valeur*10 + key - 48;\r
 110                           IF x = INXPOS\r
 111                             THEN negatif := FALSE;\r
 112                           FI;\r
 113                           CALL HASCII(0);\r
 114                           CALL HASCII(key);\r
 115                           nbchiffre := nbchiffre + 1;\r
 116                      ELSE valeur :=(valeur DIV 10)*10 + key - 48;\r
 117                           CALL MOVE(inxpos-8,y);\r
 118                           CALL HASCII(0);\r
 119                           CALL HASCII(key);\r
 120                    FI;\r
 121           WHEN MOINS : (* Saisie du signe moins *)\r
 122                        IF x = INXPOS\r
 123                        THEN negatif := TRUE;\r
 124                             CALL HASCII(0);\r
 125                             CALL HASCII(MOINS);\r
 126                        FI;\r
 127           WHEN RETOUR : (* Validation du chiffre eventuellement entre *)\r
 128                         IF negatif\r
 129                           THEN valeur := 0 - valeur;\r
 130                         FI;\r
 131                         IF nbchiffre > 0\r
 132                           THEN result := true;\r
 133                         FI;\r
 134                         RETURN;\r
 135           WHEN ESC : (* Abandon de la saisie *)\r
 136                      RETURN;\r
 137           WHEN BKSPACE : (* Saisie de la touche Backspace *)\r
 138                          IF nbchiffre > 0\r
 139                             THEN valeur := valeur DIV 10;\r
 140                                  CALL MOVE(INXPOS-8,y);\r
 141                                  CALL HASCII(0);\r
 142                                  nbchiffre := nbchiffre -1\r
 143                             ELSE IF negatif\r
 144                                    THEN negatif := FALSE;\r
 145                                         CALL MOVE(inxpos-8,y);\r
 146                                         CALL HASCII(0);\r
 147                                   FI;\r
 148                           FI;\r
 149         ESAC;\r
 150     OD;\r
 151   END lire_entier;\r
 152  \r
 153   (*---------------------------------------------------------------------*)\r
 154   (* ECRITURE d'un ENTIER sur l'\82cran graphique au coordonn\82es courantes *)\r
 155   (*---------------------------------------------------------------------*)\r
 156   UNIT ecrit_entier : PROCEDURE (x : INTEGER);\r
 157   VAR val,i : INTEGER,\r
 158       strx : ARRAYOF CHARACTER;\r
 159   BEGIN\r
 160     ARRAY strx DIM(1:7);\r
 161     i := 7;\r
 162     val := ABS(x);\r
 163     DO\r
 164       strx(i) := chr(48+(val MOD 10));\r
 165       val := val DIV 10;\r
 166       IF (val = 0) THEN EXIT; FI;\r
 167       i := i - 1;\r
 168     OD;\r
 169     IF x < 0\r
 170       THEN i := i - 1;\r
 171            strx(i) := chr(MOINS);\r
 172     FI;\r
 173     WHILE i <= 7 DO\r
 174       CALL HASCII(0);\r
 175       CALL HASCII(ORD(strx(i)));\r
 176       i := i + 1;\r
 177     OD;\r
 178   END ecrit_entier;\r
 179  \r
 180   (*-------------------------------------------------------*)\r
 181   (* PROCEDURE d'ECRITURE de l'HEURE sur l'\82cran graphique *)\r
 182   (*-------------------------------------------------------*)\r
 183   UNIT ecrit_heure : PROCEDURE(posx,posy : INTEGER,time : REAL);\r
 184   VAR h,m,s : INTEGER;\r
 185   BEGIN\r
 186     h := ENTIER(time / 3600.0);\r
 187     m := ENTIER(time - ENTIER(time/3600)*3600) DIV 60;\r
 188     s := ENTIER(time - ENTIER(time/3600)*3600) MOD 60;\r
 189     IF ( h < 10)\r
 190       THEN CALL ecrit_text(posx,posy,"0");\r
 191       ELSE CALL MOVE(posx,posy);\r
 192     FI;\r
 193     CALL ecrit_entier(h);\r
 194     CALL ecrit_text(INXPOS,INYPOS,":");\r
 195     IF ( m < 10) THEN CALL ecrit_text(INXPOS,INYPOS,"0"); FI;\r
 196     CALL ecrit_entier(m);\r
 197     CALL ecrit_text(INXPOS,INYPOS,":");\r
 198     IF ( s < 10) THEN CALL ecrit_text(INXPOS,INYPOS,"0"); FI;\r
 199     CALL ecrit_entier(s);\r
 200    END ecrit_heure;\r
 201  \r
 202   END graph;\r
 203  \r
 204  \r
 205 (*----------------------------------------------------------*)\r
 206 (* IMPLEMENTATION d'une QUEUE DE PRIORITE sous forme de TAS *)\r
 207 (*----------------------------------------------------------*)\r
 208 UNIT priorityqueue : graph CLASS;\r
 209  \r
 210   (*----------------------------*)\r
 211   (* CLASSE repr\82sentant le TAS *)\r
 212   (*----------------------------*)\r
 213   UNIT queuehead: CLASS;\r
 214   VAR last,root:node;\r
 215  \r
 216     (*---------------------------------------------*)\r
 217     (* FONCTION renvoyant l'ELEMENT MINIMUM du TAS *)\r
 218     (*---------------------------------------------*)\r
 219     UNIT min: FUNCTION: elem;\r
 220     BEGIN\r
 221       IF root=/= NONE THEN RESULT:=root.el FI;\r
 222     END MIN;\r
 223  \r
 224     (*------------------------------------*)\r
 225     (* INSERTION d'un element dans le TAS *)\r
 226     (*------------------------------------*)\r
 227     UNIT insert: PROCEDURE(r:elem);\r
 228     VAR x,z:node;\r
 229     BEGIN\r
 230       x:= r.lab;\r
 231       IF last=NONE\r
 232         THEN root:=x;\r
 233              root.left,root.right,last:=root\r
 234         ELSE IF last.ns=0\r
 235                THEN last.ns:=1;\r
 236                     z:=last.left;\r
 237                     last.left:=x;\r
 238                     x.up:=last;\r
 239                     x.left:=z;\r
 240                     z.right:=x;\r
 241                ELSE last.ns:=2;\r
 242                     z:=last.right;\r
 243                     last.right:=x;\r
 244                     x.right:=z;\r
 245                     x.up:=last;\r
 246                     z.left:=x;\r
 247                     last.left.right:=x;\r
 248                     x.left:=last.left;\r
 249                     last:=z;\r
 250              FI;\r
 251       FI;\r
 252       CALL correct(R,FALSE)\r
 253     END insert;\r
 254  \r
 255     (*---------------------------------*)\r
 256     (* SUPPRESSION d'un ELEMENT du TAS *)\r
 257     (*---------------------------------*)\r
 258     UNIT delete: PROCEDURE(r: elem);\r
 259     VAR x,Y,z:node;\r
 260     BEGIN\r
 261       x:=r.lab;\r
 262       z:=last.left;\r
 263       IF last.ns =0\r
 264         THEN Y:= z.up;\r
 265         if y<>none then     (*!!!!!!!!dopisalam !!!!!*)\r
 266              Y.right:= last else root :=none fi;\r
 267              last.left:=Y;\r
 268              last:=Y;\r
 269         ELSE Y:= z.left;\r
 270              Y.right:= last;\r
 271              last.left:= Y;\r
 272       FI;\r
 273       z.el.lab:=x;\r
 274       x.el:= z.el;\r
 275       last.ns:= last.ns-1;\r
 276       r.lab:=z;\r
 277       z.el:=R;\r
 278       IF x.less(x.up)\r
 279         THEN CALL correct(x.el,FALSE)\r
 280         ELSE CALL correct(x.el,TRUE)\r
 281       FI;\r
 282     END delete;\r
 283  \r
 284   (*------------------------------------------------------------------------*)\r
 285   (* CORRECTION-REEQUILIBRAGE du TAS apr\8as une insertion ou une suppression *)\r
 286   (*------------------------------------------------------------------------*)\r
 287   UNIT correct: PROCEDURE(r:elem,down:BOOLEAN);\r
 288   VAR x,z:node,\r
 289       t:elem,\r
 290       fin,log:BOOLEAN;\r
 291   BEGIN\r
 292     z:=r.lab;\r
 293     IF down\r
 294       THEN WHILE NOT fin DO\r
 295              IF z.ns =0\r
 296                THEN fin:=TRUE;\r
 297                ELSE IF z.ns=1\r
 298                       THEN x:=z.left;\r
 299                       ELSE IF z.left.less(z.right)\r
 300                              THEN x:=z.left;\r
 301                              ELSE x:=z.right;\r
 302                            FI;\r
 303                     FI;\r
 304                     IF z.less(x)\r
 305                       THEN fin:=TRUE;\r
 306                       ELSE t:=x.el;\r
 307                            x.el:=z.el;\r
 308                            z.el:=t;\r
 309                            z.el.lab:=z;\r
 310                            x.el.lab:=x\r
 311                     FI;\r
 312                FI;\r
 313                z:=x;\r
 314              OD;\r
 315       ELSE x:=z.up;    (* !!!!!!!!!!refference to none **********)\r
 316            IF x=NONE\r
 317              THEN log:=TRUE;\r
 318              ELSE log:=x.less(z);\r
 319            FI;\r
 320            WHILE NOT log DO\r
 321              t:=z.el;\r
 322              z.el:=x.el;\r
 323              x.el:=t;\r
 324              x.el.lab:=x;\r
 325              z.el.lab:=z;\r
 326              z:=x;\r
 327              x:=z.up;\r
 328              IF x=NONE\r
 329                THEN log:=TRUE\r
 330                ELSE log:=x.less(z);\r
 331              FI;\r
 332            OD;\r
 333     FI;\r
 334   END correct;\r
 335  \r
 336 END queuehead;\r
 337  \r
 338 (*-----------------------------------*)\r
 339 (* NOEUD du TAS contenant un element *)\r
 340 (*-----------------------------------*)\r
 341 UNIT node: CLASS (el:elem);\r
 342 VAR left,right,up: node, ns:INTEGER;\r
 343  \r
 344   (*-----------------------------------*)\r
 345   (* COMPARAISON de deux NOEUDS du TAS *)\r
 346   (*-----------------------------------*)\r
 347   UNIT less: FUNCTION(x:node): BOOLEAN;\r
 348   BEGIN\r
 349     IF x= NONE\r
 350       THEN RESULT:=FALSE\r
 351       ELSE RESULT:=el.less(x.el)\r
 352     FI;\r
 353   END less;\r
 354 END node;\r
 355  \r
 356 (*-----------------------------------*)\r
 357 (* TYPE generique des element du TAS *)\r
 358 (*-----------------------------------*)\r
 359 UNIT elem: CLASS(prior:REAL);\r
 360 VAR lab: node;\r
 361  \r
 362   (*----------------------------------------------------*)\r
 363   (* FONCTION generique de comparaison de deux elements *)\r
 364   (*----------------------------------------------------*)\r
 365   UNIT VIRTUAL less: FUNCTION(x:elem):BOOLEAN;\r
 366     BEGIN\r
 367       IF x=NONE\r
 368         THEN RESULT:= FALSE\r
 369         ELSE RESULT:= prior< x.prior\r
 370       FI;\r
 371     END less;\r
 372  \r
 373  BEGIN\r
 374    lab:= NEW node(THIS elem);\r
 375  END elem;\r
 376  \r
 377 END priorityqueue;\r
 378  \r
 379 (*----------------------------------------------------------------------------*)\r
 380  \r
 381 (*--------------------------------*)\r
 382 (* MODULE GENERIQUE de SIMULATION *)\r
 383 (*--------------------------------*)\r
 384 UNIT simulation: priorityqueue CLASS;\r
 385  \r
 386 VAR curr: simprocess,  (* Processus actif *)\r
 387     pq:queuehead,  (* L'axe des temps *)\r
 388     mainpr: mainprogram;\r
 389  \r
 390   UNIT simprocess: COROUTINE;\r
 391   VAR event,\r
 392       eventaux: eventnotice,\r
 393       finish: BOOLEAN;\r
 394  \r
 395     (*---------------------------------------------------------*)\r
 396     (* FONCTION permettant de savoir si le processus est actif *)\r
 397     (*---------------------------------------------------------*)\r
 398     UNIT IDLE: FUNCTION: BOOLEAN;\r
 399     BEGIN\r
 400       RESULT:= EVENT= NONE;\r
 401     END IDLE;\r
 402  \r
 403     (*-----------------------------------------------------------*)\r
 404     (* FONCTION permettant de savoir si le processus est termin\82 *)\r
 405     (*-----------------------------------------------------------*)\r
 406     UNIT TERMINATED: FUNCTION :BOOLEAN;\r
 407     BEGIN\r
 408       RESULT:= finish;\r
 409     END TERMINATED;\r
 410  \r
 411     UNIT evtime: FUNCTION: REAL;\r
 412     BEGIN\r
 413       IF IDLE\r
 414         THEN CALL ERROR1;\r
 415       FI;\r
 416       RESULT := event.eventtime;\r
 417     END evtime;\r
 418  \r
 419     UNIT ERROR1:PROCEDURE;\r
 420     BEGIN\r
 421       ATTACH(main);\r
 422       WRITELN(" Erreur tentative d'acces a un processus endormi");\r
 423     END ERROR1;\r
 424  \r
 425      UNIT ERROR2:PROCEDURE;\r
 426      BEGIN\r
 427        ATTACH(main);\r
 428        WRITELN(" Erreur : tentative d'acces a un processus deja termine");\r
 429      END ERROR2;\r
 430  \r
 431   BEGIN\r
 432     RETURN;\r
 433     INNER;\r
 434     finish:=TRUE;\r
 435     CALL passivate;\r
 436     CALL ERROR2;\r
 437   END simprocess;\r
 438  \r
 439   (*-------------------------------------------------*)\r
 440   (* PLACEMENT du processus actif sur l'axe du temps *)\r
 441   (*-------------------------------------------------*)\r
 442   UNIT eventnotice: elem CLASS;\r
 443   VAR eventtime: REAL, proc: simprocess;\r
 444  \r
 445     UNIT VIRTUAL less: FUNCTION(x: eventnotice):BOOLEAN;\r
 446     BEGIN\r
 447       IF x=NONE\r
 448         THEN RESULT:= FALSE;\r
 449         ELSE RESULT:= eventtime< x.eventtime OR\r
 450                       (eventtime=x.eventtime AND prior< x.prior);\r
 451       FI;\r
 452     END less;\r
 453  \r
 454   END eventnotice;\r
 455  \r
 456   UNIT mainprogram: simprocess CLASS;\r
 457   BEGIN\r
 458     DO\r
 459       ATTACH(main);\r
 460     OD;\r
 461   END mainprogram;\r
 462   (*-----------------------------------------------------------*)\r
 463   (* FONCTION permettant de savoir quel est le processus actif *)\r
 464   (*-----------------------------------------------------------*)\r
 465   UNIT time:FUNCTION:REAL;\r
 466   BEGIN\r
 467     RESULT:=current.evtime;\r
 468   END time;\r
 469  \r
 470   (*--------------------------------------------------------------------*)\r
 471   (* FONCTION retournant le premier processus place sur l'axe des temps *)\r
 472   (*--------------------------------------------------------------------*)\r
 473   UNIT current: FUNCTION: simprocess;\r
 474   BEGIN\r
 475     RESULT:=curr;\r
 476   END current;\r
 477  \r
 478   (*-----------------------------------------------------------*)\r
 479   (* PROCEDURE permettant d'activer le processus p \85 l'heure t *)\r
 480   (*-----------------------------------------------------------*)\r
 481   UNIT schedule: PROCEDURE(p:simprocess,t:REAL);\r
 482   BEGIN\r
 483     IF t<time\r
 484       THEN t:= time\r
 485     FI;\r
 486     IF p=current\r
 487       THEN CALL hold(T-time)\r
 488       ELSE IF p.IDLE AND p.eventaux=NONE\r
 489              THEN p.event,p.eventaux:= NEW eventnotice(RANDOM);\r
 490                   p.event.proc:=p ;\r
 491              ELSE IF p.IDLE\r
 492                     THEN p.event:= p.eventaux;\r
 493                          p.event.prior:=RANDOM;\r
 494                     ELSE p.event.prior:=RANDOM;\r
 495                          CALL pq.delete(p.event);\r
 496  \r
 497                   FI;\r
 498            FI;\r
 499            p.event.eventtime:= T;\r
 500            CALL pq.insert(p.event);\r
 501     FI;\r
 502   END schedule;\r
 503  \r
 504   UNIT hold:PROCEDURE(t:REAL);\r
 505   BEGIN\r
 506     CALL pq.delete(current.event);\r
 507     current.event.prior:=RANDOM;\r
 508     IF t<0 THEN t:=0; FI;\r
 509     current.event.eventtime:=time+T;\r
 510     CALL pq.insert(current.event);\r
 511     CALL choiceprocess;\r
 512   END hold;\r
 513  \r
 514   (*----------------------------------------------------------*)\r
 515   (*   PROCEDURE permettant de desactiver le processus p et   *)\r
 516   (* d'activer le suivant processus situ\82 sur l'axe des temps *)\r
 517   (*----------------------------------------------------------*)\r
 518   UNIT passivate: PROCEDURE;\r
 519   BEGIN\r
 520     CALL pq.delete(current.event);\r
 521     current.event:=NONE;\r
 522     (* Choix du processus suivant \85 activer *)\r
 523     CALL choiceprocess\r
 524   END passivate;\r
 525  \r
 526   UNIT run: PROCEDURE(P:simprocess);\r
 527   BEGIN\r
 528     current.event.prior:=RANDOM;\r
 529     IF NOT p.IDLE                   (* !!! SL-chain cut off !!!!!!*)\r
 530       THEN p.event.prior:=0;\r
 531            p.event.eventtime:=time;\r
 532            CALL pq.correct(p.event,FALSE);\r
 533       ELSE IF p.eventaux=NONE\r
 534              THEN p.event,p.eventaux:=NEW eventnotice(0);\r
 535                   p.event.eventtime:=time;\r
 536                   p.event.proc:=p;\r
 537                   CALL pq.insert(p.event);\r
 538              ELSE p.event:=p.eventaux;\r
 539                   p.event.prior:=0;\r
 540                   p.event.eventtime:=time;\r
 541                   p.event.proc:=p;\r
 542                   CALL pq.insert(p.event);\r
 543            FI;\r
 544     FI;\r
 545     CALL choiceprocess;\r
 546   END run;\r
 547  \r
 548   UNIT cancel:PROCEDURE(P: simprocess);\r
 549   BEGIN\r
 550     IF p= current\r
 551       THEN CALL passivate;\r
 552       ELSE CALL pq.delete(p.EVENT);\r
 553            p.EVENT:=NONE;\r
 554     FI;\r
 555   END cancel;\r
 556  \r
 557   (*---------------------------------------------------------------------*)\r
 558   (*   PROCEDURE permettant de choisir le prochain processus qui va etre *)\r
 559   (*  activer , c'est \85 dir le premier de l'axe des temps                *)\r
 560   (*---------------------------------------------------------------------*)\r
 561   UNIT choiceprocess:PROCEDURE;\r
 562   VAR p:simprocess;\r
 563   BEGIN\r
 564     p:=curr;\r
 565     curr:= pq.MIN QUA eventnotice.proc;\r
 566     IF curr=NONE\r
 567       THEN WRITE(" ERREUR DANS LE TAS"); WRITELN;\r
 568            ATTACH(main);\r
 569       ELSE ATTACH(curr);\r
 570     FI;\r
 571   END choiceprocess;\r
 572  \r
 573 BEGIN\r
 574   (* Simulation de l'axe des temps *)\r
 575   pq:=NEW queuehead;\r
 576   curr,mainpr:=NEW mainprogram;\r
 577   mainpr.event,mainpr.eventaux:=NEW eventnotice(0);\r
 578   mainpr.event.eventtime:=0;\r
 579   mainpr.event.proc:=mainpr;\r
 580   (* Insertion du processus sur l'axe des temps *)\r
 581   CALL pq.insert(mainpr.event);\r
 582   INNER;\r
 583   PQ:=NONE;\r
 584 END simulation;\r
 585  \r
 586 (*----------------------------------------------------------------------------*)\r
 587  \r
 588  \r
 589 (* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *)\r
 590 (* *         SIMULATION D'UNE STATION SERVICE DE 4 POMPES        * *)\r
 591 (* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *)\r
 592  \r
 593 UNIT stationservice : simulation CLASS;\r
 594  \r
 595 (* DECLARATION DE CONSTANTES PERMETTANT DE DEFINIR LA HAUTEUR ET LA  *)\r
 596 (*      LONGUEUR D'UNE POMPE, DE LA CAISSE ET D'UNE VOITURE          *)\r
 597 const lhpompe =90,\r
 598       hhpompe = 40,\r
 599       lbpompe = 20,\r
 600       hbpompe = 20,\r
 601       lcaisse = 90,\r
 602       hcaisse = 40,\r
 603       lvoiture = 25,\r
 604       hvoiture = 15;\r
 605  \r
 606   (*-----------------------------------------------------------------*)\r
 607   (* Processus permettant l'affichage du temps courant de simulation *)\r
 608   (*-----------------------------------------------------------------*)\r
 609   UNIT clock : simprocess CLASS;\r
 610   BEGIN\r
 611     CALL rectangle (1,330,150,18);\r
 612     CALL ecrit_text (3,334,"TIME");\r
 613  \r
 614     (* BOUCLE INFINIE : AFFICHAGE de l'HEURE \85 CHAQUE FOIS que la *)\r
 615     (*                  proc\82dure est REVEILLE                    *)\r
 616     DO\r
 617       CALL ecrit_heure (55,334,time);\r
 618       CALL HOLD(60);\r
 619     OD;\r
 620   END clock;\r
 621  \r
 622  \r
 623   (*----------------------------------------*)\r
 624   (*     Processus simulant une POMPE       *)\r
 625   (*----------------------------------------*)\r
 626   (*  tip  : Style de carburant de la pompe *)\r
 627   (*  tipe : Numero de la pompe             *)\r
 628   (*  lig  : Coordonn\82es Y de l'\82cran       *)\r
 629   (*  col  : Coordonn\82es X de l'\82cran       *)\r
 630   (*----------------------------------------*)\r
 631   UNIT pompe : simprocess CLASS(tip : string,tipe,lig,col : INTEGER);\r
 632  \r
 633   VAR   nbcli : integer,  (* Nbre de clients a la pompe  *)\r
 634         libre: boolean,(* Booleen indiquant si la pompe  est libre *)\r
 635         cli : client,\r
 636         i,li :INTEGER;\r
 637   BEGIN\r
 638  \r
 639      i := pos_carb+(tipe-1)*80;\r
 640      (* TANT QUE la pompe est en attente *)\r
 641  \r
 642     (* BOUCLE INFINIE : FONCTIONNEMENT DES POMPES *)\r
 643     DO\r
 644  \r
 645        (* Si des clients attendent pour etre servis *)\r
 646        IF (file_pompe(tipe).tete =/= NONE and libre)\r
 647         THEN\r
 648  \r
 649              cli := file_pompe(tipe).tete.el;\r
 650  \r
 651              (* Mise en marche  de la pompe libre *)\r
 652              CALL ecrit_text (205,i,"MARCHE ");\r
 653  \r
 654              (* Affichage du numero du client qui est actuellement servi *)\r
 655              call move (265,i);\r
 656              call ecrit_entier(cli.num);\r
 657  \r
 658  \r
 659              (* CHOIX al\82atoire du nombre de litres de carburant *)\r
 660              li:=irandom (1,30);\r
 661              libre := false; (* la pompe est occupe par le client *)\r
 662              (* D\82roulement du service de li litres de carburant *)\r
 663              CALL HOLD(60*li);\r
 664  \r
 665               (* Mise en attente de la pompe  et decrementation du    *)\r
 666              (* nombre de clients souhaitant etre servi \85 cette m\88me pompe *)\r
 667  \r
 668              nbcli := nbcli - 1;\r
 669              call move(253,i+25 );\r
 670              call ecrit_entier(nbcli);\r
 671  \r
 672              (* Affichage \85 l'\82cran des differents clients d\82sirant prendre *)\r
 673              (*             du carburant \85 cette pompe                      *)\r
 674              call file_pompe(tipe).supprimer;\r
 675              call aff_queue_pompe(file_pompe(tipe), tipe);\r
 676  \r
 677              (* AFFICHAGE   sur la pompe signalant qu'elle est bloque *)\r
 678              CALL ecrit_text (205,i,"BLOQUE ");\r
 679  \r
 680              call schedule(cli, time);\r
 681              call hold(60);\r
 682  \r
 683         ELSE (* S'il n'y a pas de client : DESACTIVATION du processus *)\r
 684              CALL PASSIVATE;\r
 685        FI;\r
 686  \r
 687     OD;\r
 688  \r
 689   END pompe;\r
 690  \r
 691  \r
 692   (*-----------------------------------------------*)\r
 693   (* AFFICHAGE \85 l'\82cran d'une POMPE et du TYPE de *)\r
 694   (*       carburant qu'elle distribue             *)\r
 695   (*-----------------------------------------------*)\r
 696   UNIT aff_pompe : PROCEDURE(x : pompe);\r
 697   VAR i,ligne : INTEGER;\r
 698   BEGIN\r
 699     CALL rectangle (x.col,x.lig,lhpompe,hhpompe);\r
 700     CALL rectangle (x.col-2,x.lig-2,lhpompe+4,hhpompe+4);\r
 701     CALL rectangle (x.col+20,x.lig +hhpompe,lbpompe,hbpompe);\r
 702     CALL ecrit_text (x.col + 3, x.lig +10,x.tip);\r
 703   END aff_pompe;\r
 704  \r
 705  \r
 706   (*--------------------------------------------------*)\r
 707   (*           Processus simulant la caisse           *)\r
 708   (*--------------------------------------------------*)\r
 709   UNIT caisse : simprocess CLASS;\r
 710   VAR cli : client,\r
 711       i,num, nbcli : INTEGER,\r
 712       libre : boolean;\r
 713   BEGIN\r
 714     (* BOUCLE INFINIE : FONCTIONNEMENT DE LA CAISSE *)\r
 715  \r
 716     DO\r
 717       call move (45,180);\r
 718       call ecrit_entier(nbcli);\r
 719  \r
 720       (* SI la FILE de la caisse n'est pas vide   *)\r
 721       (*  ALORS traitement du client              *)\r
 722       (*  SINON desactivation du processus caisse *)\r
 723       IF (file_caisse.tete =/= NONE and libre)\r
 724        THEN\r
 725             cli := file_caisse.tete.el;\r
 726             nbc:=nbc +1;\r
 727  \r
 728             (* MISE en marche de la caisse *)\r
 729             CALL ecrit_text (35,170,"MARCHE ");\r
 730             libre := false;\r
 731             (* SUPPRESSION du client de la file d'attente de la caisse *)\r
 732             CALL file_caisse.supprimer;\r
 733  \r
 734            (* AFFICHAGE des clients se trouvant la la FILE de la caisse *)\r
 735             (*                 apr\8as le passage de ce client             *)\r
 736             CALL affiche_queue(file_caisse);\r
 737  \r
 738             (* AFFICHAGE du numero du client se trouvant \85 la caisse *)\r
 739             call move (90,170);\r
 740             call ecrit_entier(cli.num);\r
 741             call color(cli.col);\r
 742  \r
 743            (* AFFICHAGE le client qui paye??  a la caisse *)\r
 744             call aff_voiture(70,200,cli.num);\r
 745             call color(15);\r
 746  \r
 747             (* La dur\82e du PAIEMENT est de 10x60 *)\r
 748             CALL HOLD(300*random);\r
 749  \r
 750             (* MISE A L'ARRET de la caisee *)\r
 751             (* AFFICHAGE du nombre de client se trouvant dans la file *)\r
 752             nbcli := nbcli-1;\r
 753             CALL move (45,180);\r
 754             CALL ecrit_entier(nbcli);\r
 755  \r
 756             CALL ecrit_text (35,170,"STOP   ");\r
 757             call ecrit_text (90,170,"   ");\r
 758  \r
 759             (* CALCUL du temps total n\82c\82ssaire pour se servir et payer *)\r
 760             cli.temps_attente := time - cli.temps_arrive;\r
 761  \r
 762             (* CUMUL des differents temps d'attente *)\r
 763             temps := temps + cli.temps_attente;\r
 764  \r
 765             (* effacement de client qui deja paye *)\r
 766             call color(0);\r
 767             call aff_voiture(70,200,cli.num);\r
 768  \r
 769             call color(15);\r
 770             i := cli.val;\r
 771             KILL (cli);\r
 772             libre := true;\r
 773             (* ACTIVATION de la pompe qui viend d'\88tre liberer apr\8as *)\r
 774             (*                 paiement \85 la caisse                  *)\r
 775              mach_pompe(i).libre := true;\r
 776              call schedule(mach_pompe(i), time);\r
 777              i := pos_carb+(i-1)*80;\r
 778              CALL ecrit_text (205,i,"PRET     ");\r
 779              call hold(120);\r
 780        ELSE CALL passivate;\r
 781       FI;\r
 782     OD;\r
 783     CALL passivate;\r
 784   END caisse;\r
 785  \r
 786   (*-------------------------------------------------*)\r
 787   (*            AFFICHAGE de la caisse               *)\r
 788   (*-------------------------------------------------*)\r
 789   UNIT aff_caisse : PROCEDURE( x : caisse);\r
 790     VAR i : INTEGER;\r
 791   BEGIN\r
 792     CALL rectangle (30,150,90,40);\r
 793     CALL ecrit_text (33,160,"CAISSE");\r
 794   END aff_caisse;\r
 795  \r
 796   (*------------------------------------------------*)\r
 797   (* AFFICHAGE  DE LA FILE D'ATTENTE DES POMPES     *)\r
 798   (*------------------------------------------------*)\r
 799  \r
 800  \r
 801  UNIT aff_queue_pompe : PROCEDURE ( q:file_attente, tip : integer);\r
 802     VAR val:client;\r
 803   BEGIN\r
 804        posx(tip):=300;\r
 805  \r
 806        (* POUR CHAQUE element du tas *)\r
 807        WHILE (q.prem <> NONE) DO\r
 808          (* AFFICHAGE eventuel de la voiture \85 l'\82cran, c'est *)\r
 809          (*     \85 dire s'il y a assez de place sur l'\82cran    *)\r
 810          IF ((posx(tip) >= 635) OR ((posx(tip) +25) >=635)) THEN EXIT; FI;\r
 811          call color(q.prem.el.col);\r
 812          CALL aff_voiture(posx(tip),posy(tip),q.prem.el.num);\r
 813  \r
 814          q.prem:=q.prem.succ;\r
 815          posx(tip):=posx(tip)+30;\r
 816        OD;\r
 817  \r
 818        (* EFFACEMENT de la derniere voiture qui vient d'avancer *)\r
 819        IF ((posx(tip) < 635) AND ((posx(tip) +25) <635)) THEN\r
 820          FOR i := posy(tip) TO (posy(tip)+25)\r
 821          DO\r
 822            CALL ecrit_text(posx(tip),i,"    ");\r
 823          OD;\r
 824        FI;\r
 825  \r
 826   END aff_queue_pompe;\r
 827  \r
 828  \r
 829  \r
 830  \r
 831   (*--------------------------------------------------*)\r
 832   (*    AFFICHAGE DE LA FILE D'ATTENTE DE LA CAISSE   *)\r
 833   (*--------------------------------------------------*)\r
 834  \r
 835   UNIT affiche_queue : PROCEDURE( q:file_attente ) ;\r
 836   BEGIN\r
 837      poscay:= 150;\r
 838  \r
 839       (* POUR CHAQUE element du tas *)\r
 840       WHILE (q.prem <> NONE) DO\r
 841         call ecrit_text(poscax+5,poscay+2,"  ");\r
 842         call color(q.prem.el.col);\r
 843         (* AFFICHAGE de la voiture \85 l'\82cran *)\r
 844         CALL aff_voiture(poscax,poscay,q.prem.el.num);\r
 845         q.prem:=q.prem.succ;\r
 846         poscay:=poscay-30;\r
 847         if poscay<50  then exit fi;\r
 848       OD;\r
 849  \r
 850       (* EFFACEMENT de la derniere voiture qui vient d'avancer *)\r
 851       FOR i := poscay TO (poscay+20) DO\r
 852         CALL ecrit_text(poscax,i,"    ");\r
 853       OD;\r
 854  \r
 855   END affiche_queue;\r
 856  \r
 857  \r
 858  \r
 859  \r
 860  \r
 861   (*----------------------------------------------*)\r
 862   (*      AFFICHAGE d'une voiture \85 l'\82cran       *)\r
 863   (*----------------------------------------------*)\r
 864   (* posx : position X de la voiture              *)\r
 865   (* posy : position Y de la voiture              *)\r
 866   (* x    : Numero \85 afficher sur la voiture,     *)\r
 867   (*        c'est \85 dire le num\82ro du client      *)\r
 868   (*----------------------------------------------*)\r
 869   UNIT aff_voiture : PROCEDURE(posx,posy,x:INTEGER);\r
 870   BEGIN\r
 871     CALL rectangle(posx,posy,25,15);\r
 872     CALL move (posx+5,posy+2);\r
 873     CALL ecrit_entier(x);\r
 874   END aff_voiture;\r
 875  \r
 876   (*----------------------------------------------------*)\r
 877   (* FONCTION RETOURNANT UN NOMBRE COMPRIS ENTRE a ET b *)\r
 878   (*----------------------------------------------------*)\r
 879   UNIT irandom : FUNCTION(a,b:INTEGER):INTEGER;\r
 880    begin\r
 881     result := entier((b-a)*random +a)\r
 882    end irandom;\r
 883  \r
 884  \r
 885   (*--------------------------------------------------------*)\r
 886   (*       Processus simulant UN CLIENT de la station       *)\r
 887   (*--------------------------------------------------------*)\r
 888   UNIT client : simprocess CLASS(num : INTEGER);\r
 889   VAR  val, col : integer, (* numero de pompe et couleur de voiture choisit*)\r
 890        bb : boolean,  (* bb= true si le client est premier*)\r
 891       temps_attente,temps_arrive : REAL; (* Temps d'attente dans la file *)\r
 892  \r
 893     (* On DETERMINE a l'ARRIVEE du client quel type de carburant il *)\r
 894     (*                          souhaite                            *)\r
 895     UNIT arrive : PROCEDURE;\r
 896     VAR i,j : INTEGER;\r
 897      BEGIN\r
 898  \r
 899       (* CHOIX ALEATOIRE du numero de pompe P que le client choisit *)\r
 900       val := irandom(1,5);\r
 901       col := irandom(1,14);\r
 902  \r
 903       (* SELON le numero de pompe :                                    *)\r
 904       (*    - INSERTION du client dans la file d'attente de la pompe P *)\r
 905       (*    - INCREMENTATION et AFFICHAGE du nombre de client se       *)\r
 906       (*                     trouvant \85 la pompe                       *)\r
 907  \r
 908       call file_pompe(val).inserer(this client);\r
 909  \r
 910       j:= mach_pompe(val).nbcli + 1;\r
 911       call move(253,75+(val-1)*80);\r
 912       call ecrit_entier(j);\r
 913       mach_pompe(val).nbcli :=j;\r
 914  \r
 915  \r
 916       (* AFFICHAGE de la voiture du nouveau client *)\r
 917       call color(col);\r
 918       CALL aff_queue_pompe(file_pompe(val),val);\r
 919       call color(15);\r
 920     END arrive;\r
 921  \r
 922   BEGIN\r
 923  \r
 924       CALL arrive;\r
 925       temps_arrive := time;\r
 926       if (mach_pompe(val).libre and  mach_pompe(val).idle )\r
 927       then\r
 928           call run(mach_pompe(val))\r
 929       fi;\r
 930  \r
 931       call passivate;\r
 932  \r
 933       (* INSERTION du client dans la liste d'attente de la caisse *)\r
 934       CALL file_caisse.inserer(this client);\r
 935  \r
 936       (* AFFICHAGE de l'ensemble des voitures qui se trouvent dans la  *)\r
 937       (* file d'attente de la caisse et du nombre decrement\82 du        *)\r
 938       (*           de  clients se trouvant dans la caisse              *)\r
 939       CALL affiche_queue(file_caisse);\r
 940       caissiere.nbcli:= caissiere.nbcli +1;\r
 941       if (caissiere.libre and  caissiere.idle )\r
 942       then\r
 943           CALL run(caissiere)  else call passivate;\r
 944       fi;\r
 945  \r
 946   END client;\r
 947  \r
 948   (*-------------------------------------------*)\r
 949   (*          GENERATEUR de client             *)\r
 950   (*-------------------------------------------*)\r
 951   UNIT gen_client : simprocess CLASS;\r
 952   BEGIN\r
 953     noclient := 0;\r
 954     nombre := 1;\r
 955     (* BOUCLE INFINIE : GENERATION D'UN CLIENT *)\r
 956     DO\r
 957       IF (noclient = 100)\r
 958         THEN noclient := 1;\r
 959       FI;\r
 960  \r
 961       (* GENERATION des clients plus ou moins rapide *)\r
 962       (*          selon la m\82t\82o qu'il fait          *)\r
 963       CALL schedule(NEW client(nombre),time);\r
 964       CASE (weather)\r
 965         WHEN 1 : CALL hold(RANDOM*300 +50);\r
 966         WHEN 2 : CALL hold(RANDOM*300 +100);\r
 967         WHEN 3 : CALL hold(RANDOM*300 +500);\r
 968       ESAC;\r
 969       noclient := noclient +1;\r
 970       nombre := nombre + 1;\r
 971     OD;\r
 972   END gen_client;\r
 973  \r
 974 (*---------------------------------------------*)\r
 975 (*      TYPE  des elements mis dans la file    *)\r
 976 (*---------------------------------------------*)\r
 977  UNIT link : CLASS(el : client);\r
 978   VAR succ : link;\r
 979  END;\r
 980  \r
 981   UNIT file_attente : CLASS;\r
 982   VAR tete, queue,prem : link;\r
 983  \r
 984   (* INSERTION d'un CLIENT dans la FILE D'ATTENTE *)\r
 985   UNIT inserer : PROCEDURE(x : client);\r
 986   VAR inter : INTEGER;\r
 987   BEGIN\r
 988     IF tete = NONE\r
 989       THEN tete := NEW LINK(x);\r
 990            queue := tete;\r
 991       ELSE queue.succ := NEW link(x);\r
 992            queue := queue.succ;\r
 993     FI;\r
 994     prem:=tete;\r
 995   END inserer;\r
 996  \r
 997   (* SUPPRESSION d'un client de la file d'attente *)\r
 998   UNIT supprimer: PROCEDURE;\r
 999   BEGIN\r
1000     IF (tete =/= NONE)\r
1001       THEN\r
1002            tete := tete.succ;\r
1003     FI;\r
1004     prem:=tete;\r
1005   END supprimer;\r
1006 END file_attente;\r
1007  \r
1008  \r
1009 (*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*)\r
1010 (*/*/*/*/*/*        P R O G R A M M E   P R I N C I P A L        */*/*/*/*/*)\r
1011 (*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*)\r
1012   CONST poscax = 150,\r
1013         pos_carb   = 50;\r
1014   VAR\r
1015       posx,posy : ARRAYOF INTEGER,(* Indice pour l'affichage *)\r
1016       caissiere :caisse,          (* Caisse *)\r
1017       mach_pompe : ARRAYOF pompe, (* TABLEAU d'\82l\82ments de type pompe *)\r
1018       poscay,    (* Indice de positionnement de la caisse *)\r
1019       nombre,    (* Nombre de clients g\82n\82r\82s *)\r
1020       nbc,       (* Nombre de clients servis de carburant *)\r
1021                  (*            et ayant pay\82              *)\r
1022       i,         (* Variable de boucle *)\r
1023       noclient,  (* Nbre totale des clients               *)\r
1024       y,         (* *)\r
1025       car,       (* Variable permettant la saisie d'une touche *)\r
1026       time_simulation,\r
1027       weather : INTEGER,   (* Variable signalant le temps qu'il fait *)\r
1028       horloge : clock,     (* Compteur de l'heure *)\r
1029       cli : client,        (* UN client *)\r
1030       file_pompe : ARRAYOF file_attente, (* TABLEAU de FILES D'ATTENTE  *)\r
1031                                          (*       pour les pompes       *)\r
1032       file_caisse : file_attente,        (* FILE D'ATTENTE de la caisse *)\r
1033       temps :real,  (* TEMPS MOYEN d'attente de chaque client *)\r
1034       bol: boolean;(* booleen retourn\82 par une fonction de la class GRAPH *)\r
1035  \r
1036  \r
1037   BEGIN\r
1038  \r
1039        (* CREATION et INITIALISATION DES DIFFERENTS TABLEAUX *)\r
1040        (*       d'indice pour les affichages graphiques      *)\r
1041  \r
1042         ARRAY posy DIM(1:4);\r
1043         ARRAY posx DIM(1:4);\r
1044         FOR i:=1 TO 4 DO\r
1045             posx(i):=300;\r
1046         OD;\r
1047         posy(1):=45;\r
1048         posy(2):=125;\r
1049         posy(3):=205;\r
1050         posy(4):=285;\r
1051  \r
1052        (* OUVERTURE DU MODE GRAPHIQUE *)\r
1053        CALL initgraph;\r
1054  \r
1055        (* AFFICHAGE sommaire du sujet de la simulation et de la presentation *)\r
1056        CALL cls;\r
1057        CALL rectangle (1,1,635,348);\r
1058        CALL move (15,174);\r
1059        CALL ecrit_text (15,174,\r
1060        "  SIMULATION D'UNE STATION SERVICE COMPRENANT 4 POMPES\r
1061  ET D'UNE CAISSE ");\r
1062  \r
1063        (* LECTURE ET CONTROLE d'une hypothese n\82c\82ssaire *)\r
1064        (*        au d\82roulement de la simulation         *)\r
1065        (*        (temps qu'il fait)                      *)\r
1066        CALL ecrit_text (50,190," 1 - BEAU TEMPS");\r
1067        CALL ecrit_text (50,210," 2 - TEMPS COUVERT");\r
1068        CALL ecrit_text (50,230," 3 - NUIT");\r
1069        CALL ecrit_text (50,250,"   VOTRE CHOIX :");\r
1070        DO\r
1071           bol:= lire_entier(250,250,weather);\r
1072           IF (weather>0 and weather<4)  then\r
1073                exit\r
1074           ELSE\r
1075                CALL ecrit_text (50,250,"REDONNER VOTRE CHOIX :");\r
1076           FI;\r
1077        OD;\r
1078        call ecrit_text (50, 270," simulation time en minutes: ");\r
1079        bol := lire_entier(270,270,time_simulation);\r
1080        CALL ecrit_text (200,300,"< TAPER SUR UNE TOUCHE POUR CONTINUER >");\r
1081  \r
1082        (* CREATION de la file d'attente de clients pour chaque pompe *)\r
1083        ARRAY file_pompe DIM(1:4);\r
1084        FOR i:= 1 TO 4\r
1085        DO\r
1086              file_pompe(i) := new file_attente;\r
1087        OD;\r
1088  \r
1089        (* CREATION de la file d'attente de clients pour la caisse *)\r
1090        file_caisse := NEW file_attente;\r
1091  \r
1092        (* CREATION de l'HORLOGE de la simulation *)\r
1093        horloge := NEW clock;\r
1094        CALL schedule(horloge,time);\r
1095  \r
1096        (* CREATION de 4 POMPES *)\r
1097        ARRAY mach_pompe DIM(1:4);\r
1098        mach_pompe(1) := new pompe ("ESSENCE",1,25,200);\r
1099        mach_pompe(2) := new pompe ("SUPER",2,105,200);\r
1100        mach_pompe(3) := new pompe ("S PLOMB",3,185,200);\r
1101        mach_pompe(4) := new pompe ("GAZOIL",4,265,200);\r
1102  \r
1103  \r
1104        (* AFFICHAGE d'une page vierge *)\r
1105        CALL cls;\r
1106        CALL rectangle (1,1,635,348);\r
1107  \r
1108        (* AFFICHAGE des 4 pompes de la STATION *)\r
1109        y := pos_carb;\r
1110        FOR i := 1 TO 4 DO\r
1111             CALL color(i+1);\r
1112             CALL aff_pompe(mach_pompe(i));\r
1113             CALL ecrit_text(205,y,"LIBRE  ");\r
1114             mach_pompe(i).libre := true;\r
1115             y := y +80;\r
1116        OD;\r
1117        CALL color(15);\r
1118  \r
1119        (* CREATION de la caisse *)\r
1120        caissiere := NEW caisse;\r
1121        CALL aff_caisse(caissiere);\r
1122        Call ecrit_text(35,170,"LIBRE  ");\r
1123        caissiere.libre := true;\r
1124  \r
1125        CALL ecrit_text (60,10,"FILE DE LA CAISSE ");\r
1126        CALL ecrit_text (360,10, "FILES D'ATTENTE DES POMPES");\r
1127 END;\r
1128  \r
1129 BEGIN\r
1130  PREF stationservice BLOCK\r
1131  VAR car,sauv : INTEGER;\r
1132  \r
1133  (* Procedure permettant la recherche du type de pompe qu'il faut rajouter *)\r
1134  (*                         \85 la station service                           *)\r
1135  UNIT recherche :PROCEDURE(i,j:integer);\r
1136  var n : integer;\r
1137    BEGIN\r
1138      for n :=1 to 4 do\r
1139      IF mach_pompe(n).nbcli>=j THEN\r
1140           case n\r
1141             when 1 : CALL ecrit_text(300,i,"- ESSENCE");\r
1142             when 2 : CALL ecrit_text(300,i,"- SUPER");\r
1143             when 3 : CALL ecrit_text(300,i,"- S PLOMB");\r
1144             when 4 : CALL ecrit_text(300,i,"- GAZOIL ");\r
1145           esac;\r
1146        i:=i+10;\r
1147      FI;\r
1148      od;\r
1149  \r
1150    END recherche;\r
1151  \r
1152   BEGIN\r
1153       CALL schedule(NEW gen_client,TIME);\r
1154       CALL hold(Time_simulation*60);\r
1155       CALL ecrit_text (400,324,"FIN DE LA SIMULATION");\r
1156       CALL ecrit_text (200,335,"< TAPER SUR UNE TOUCHE POUR CONTINUER >");\r
1157       car := inchar;\r
1158       CALL cls;\r
1159       CALL ecrit_text(100,10,\r
1160       " OBSERVATION FINALE DE LA SIMULATION DE LA STATION");\r
1161  \r
1162     (* SI le nombre de client ayant pay\82 est diff\82rent de z\82ro *)\r
1163     IF (nbc <> 0) THEN\r
1164  \r
1165     (* AFFICHAGE DES OBSERVATIONS FINALES SELON LA METEO *)\r
1166     temps := (temps/nbc);\r
1167     CALL ecrit_text (100,100,"PENDANT LE TEMPS DE LA SIMILATION, SEULEMENT ");\r
1168     CALL move (460,100);\r
1169     CALL ecrit_entier(nbc);\r
1170     CALL ecrit_text (100,125,"PERSONNES ONT ETE TOTALEMENT SATISFAITES");\r
1171     CALL ecrit_text (100,150,"LE TEMPS MOYEN PASSE A LA STATION EST : ");\r
1172     CALL ecrit_heure (450,150,temps);\r
1173  \r
1174  \r
1175  \r
1176     sauv := 0;\r
1177      for i :=1 to 4 do\r
1178          y := mach_pompe(i).nbcli;\r
1179          if sauv< y then sauv := y fi;\r
1180     od;\r
1181  \r
1182  \r
1183     case weather\r
1184       when 1 : If ((sauv <=6) and (temps <=3000)) then\r
1185                   CALL ecrit_text (50,200,"LA STATION FONCTIONNE BIEN ");\r
1186                fi;\r
1187                If ((sauv <=6) and (temps >3000)) then\r
1188                   CALL ecrit_text (50,200,\r
1189                   "LES POMPES NE SONT PAS ASSEZ PUISSANTES");\r
1190                fi;\r
1191                If ((sauv >6) and (temps <=3000)) then\r
1192                   CALL ecrit_text (50,200,\r
1193                   "LES POMPES NE SONT PAS ASEZ PUISSANTES\r
1194 VEILLEZ A AJOUTER DES POMPES : ");\r
1195                   CALL RECHERCHE (225,6)\r
1196                fi;\r
1197                If ((sauv >6) and (temps >3000)) then\r
1198                   CALL ecrit_text (50,200,"LA CONSTRUCTION D'UNE AUTRE STATION");\r
1199                   CALL ecrit_text (50,225," PARAIT NECESSAIRE ");\r
1200                fi;\r
1201       when 2 : If ((sauv <=5) and (temps <=2400)) then\r
1202                   CALL ecrit_text (50,200,"LA STATION FONCTIONNE BIEN ");\r
1203                fi;\r
1204                If ((sauv <=5) and (temps >2400)) then\r
1205                   CALL ecrit_text (50,200,"LES POMPES NE SONT PAS ASSEZ PUISSANTES");\r
1206                fi;\r
1207                If ((sauv >5) and (temps <=2400)) then\r
1208                   CALL ecrit_text (50,200,"LES POMPES NE SONT PAS ASEZ PUISSANTES\r
1209 VEILLEZ A AJOUTER DES POMPES : ");\r
1210                   CALL RECHERCHE (225,5)\r
1211                fi;\r
1212                If ((sauv >5) and (temps >2400)) then\r
1213                   CALL ecrit_text (50,200,"LA CONSTRUCTION D'UNE AUTRE STATION");\r
1214                   CALL ecrit_text (50,225," PARAIT NECESSAIRE ");\r
1215                fi;\r
1216       when 3 : If ((sauv <=2) and (temps <=1800)) then\r
1217                   CALL ecrit_text (50,200,"LA STATION FONCTIONNE BIEN COMPTE\r
1218 TENUE QUE C'EST LA NUIT ");\r
1219                fi;\r
1220                If ((sauv <=2) and (temps >1800)) then\r
1221                   CALL ecrit_text (50,200,"LES POMPES NE SONT PAS ASSEZ PUISSANTES");\r
1222                fi;\r
1223                If ((sauv >2) and (temps <=1800)) then\r
1224                   CALL ecrit_text (50,200,"LES POMPES NE SONT PAS ASEZ PUISSANTES\r
1225 VEILLEZ A AJOUTER DES POMPES : ");\r
1226                   CALL RECHERCHE (225,2)\r
1227                fi;\r
1228                If ((sauv >2) and (temps >1800)) then\r
1229                   CALL ecrit_text (50,200,"LA CONSTRUCTION D'UNE AUTRE STATION");\r
1230                   CALL ecrit_text (50,225," PARAIT NECESSAIRE ");\r
1231                fi;\r
1232  \r
1233          esac;\r
1234  \r
1235     (* SINON AFFICHAGE D'UN MESSAGE SIGNALANT QU'AUCUN CLIENT N'A PAYE *)\r
1236     ELSE CALL ecrit_text (100,150,"AUCUN CLIENT N'A EU LE TEMPS DE SE SERVIR\r
1237 ET DE PAYER");\r
1238     FI;\r
1239     CALL rectangle (1,1,635,348);\r
1240     CALL rectangle (10,30,612,300);\r
1241     car:=inchar;\r
1242  \r
1243     (* FERMETURE DU MODE GRAPHIQUE *)\r
1244     CALL closegraph;\r
1245  \r
1246   END;\r
1247 END station;\r
1248  \r