examples/gare/gare.log

   1 program gar;\r
   2  \r
   3 (* DEFINITION DE LA PAGE GRAPHIQUE GENERALE *)\r
   4  \r
   5 BEGIN\r
   6  \r
   7 PREF iiuwgraph BLOCK\r
   8  \r
   9 (* PROCEDURE PAUSE POUR ATTENTE AU CLAVIER *)\r
  10  \r
  11 UNIT PAUSE:procedure;\r
  12   VAR touche:char;\r
  13 BEGIN\r
  14   call color(12);\r
  15   call move(100,320);\r
  16   call outstring("        Appuyer sur ENTREE pour passer a la suite");\r
  17   read(touche);\r
  18 END PAUSE;\r
  19  \r
  20 (* PROCEDURE D ATTENTE PAR BOUCLE ACTIVE *)\r
  21  \r
  22 UNIT attend:procedure(tmp:integer);\r
  23   VAR i:integer;\r
  24 BEGIN\r
  25   for i:=0 to tmp * 10 do od;\r
  26 END attend;\r
  27  \r
  28 (* PROCEDURE D ATTENTE AVEC COMPTEUR POUR LA SORTIE DE L APPLICATION *)\r
  29  \r
  30 UNIT attend_sortie:procedure;\r
  31   VAR x,y,i,k,j:integer;\r
  32 BEGIN\r
  33   j:=9;\r
  34   x:=300;\r
  35   y:=200;\r
  36   for k:=1 to 10 do\r
  37     call color(11);\r
  38     call move(300,200);\r
  39     call HASCII(j+48);\r
  40     for i:=0 to 4000 do od;\r
  41     call color(0);\r
  42     call rectangle_double(x,y-1,x+25,y+9);\r
  43     call rectangle_double(x+1,y,x+24,y+8);\r
  44     call rectangle_double(x+4,y+2,x+22,y+6);\r
  45     call rectangle_double(x+5,y+3,x+21,y+5);\r
  46     j:=j-1;\r
  47   od;\r
  48 END attend_sortie;\r
  49  \r
  50 (* PAGE DE PRESENTATION GENERALE DE DEBUT *)\r
  51  \r
  52 UNIT presentation:iiuwgraph procedure;\r
  53 BEGIN\r
  54   (* creation d'une bordure*)\r
  55   call border(13);\r
  56  \r
  57   (*creation d'un cadre pour la fenetre*)\r
  58   call move(10,10);\r
  59   call draw(10,340);\r
  60   call draw( 628,340);\r
  61   call draw(628,10);\r
  62   call draw(10,10);\r
  63   call color(2);\r
  64  \r
  65   (*contenu du titre*)\r
  66   call move(180,80);\r
  67   call outstring("IMPLEMENTATION D'UNE SIMULATION");\r
  68   call move(260,100);\r
  69   call outstring("DE GARE SNCF");\r
  70   call color(12);\r
  71   call move(250,180);\r
  72   call outstring("PROJET NUMERO 2");\r
  73   call color(14);\r
  74   call move(130,280);\r
  75   call outstring("PAR : Mr AC'H Fabrice et CLAVERIE Jean-Fran\87ois");\r
  76   call move(130,300);\r
  77   call outstring("      Mr GOUGEON Jean-Yves et Mr RICHARD Jerome");\r
  78  \r
  79   (*appel de la procedure pause pour passer a la suite*)\r
  80   call PAUSE;\r
  81  \r
  82   (*appel de l'effacage de l'ecran*)\r
  83   call cls;\r
  84 END presentation;\r
  85  \r
  86 (* FONCTION DEFINISSANT UNE MESSAGE-BOX *)\r
  87 (* ARGUMENTS : Text_message, Longueur_message, Couleur_text, Coordonnees *)\r
  88  \r
  89 UNIT msgbox : function(message:string,long,couleur,x,y:integer):boolean;\r
  90   VAR centrage:integer,reponse:boolean,\r
  91       h,v,b,i:integer;\r
  92 BEGIN\r
  93   PREF mouse BLOCK\r
  94   BEGIN\r
  95  \r
  96     (* si texte petit met longueur a 6 par defaut *)\r
  97     if(long<6) then long:=6; fi;\r
  98  \r
  99     call move(x,y);\r
 100     call color(couleur);\r
 101     call rectangle_double(x,y,x+(long * 9 + 20)+2,y + 52);\r
 102  \r
 103     (* centrage du texte dans le rectangle *)\r
 104     centrage:=((long * 9+20) div 2) - ((long div 2)*8);\r
 105  \r
 106     for i:=(y + 3) to (y+49) do\r
 107       call color(7);\r
 108       call move(x+3,i);\r
 109       call draw(x+(long * 9) +19 ,i);\r
 110     od;\r
 111     call color(couleur);\r
 112     call move(x+centrage,y+5);\r
 113     call outstring(message);\r
 114     call color(14);\r
 115  \r
 116     (* definition des boutons OUI et NON *)\r
 117  \r
 118     call rectangle(x+centrage+1,y+29,x+centrage+26,y+41);\r
 119     call move(x+centrage+2,y+32);\r
 120     call outstring("OUI");\r
 121     call rectangle(x+(long * 9) -centrage +1,y+29,x+(long * 9) -centrage +26,y+41);\r
 122     call move(x+(long * 9) - centrage +2,y+32);\r
 123     call outstring("NON");\r
 124     call showcursor;\r
 125     do\r
 126       call getpress(0,h,v,b,gauche,droit,centre);\r
 127       if(gauche) then\r
 128       if((v> y + 29)and(v> y + 32)) then\r
 129       if((h>(x+centrage+1))and(h<(x+centrage+26)))\r
 130       then reponse:=true; gauche:=false; exit;\r
 131       else\r
 132        if((h>(x+(long * 9)-centrage +1))and(h<(x+(long * 9)-centrage +26)))\r
 133         then reponse:=false;gauche:=false; exit;\r
 134         fi;\r
 135       fi;\r
 136       fi;\r
 137       fi;\r
 138     od;\r
 139     call hidecursor;\r
 140     result:=reponse;\r
 141   END;\r
 142 END msgbox;\r
 143  \r
 144 (* PROCEDURE DE TRACAGE DE RECTANGLE SIMPLE *)\r
 145  \r
 146 UNIT rectangle:iiuwgraph procedure(x_h,y_h,x_b,y_b:integer);\r
 147 BEGIN\r
 148   call move(x_h,y_h);\r
 149   call draw(x_b,y_h);\r
 150   call draw(x_b,y_b);\r
 151   call draw(x_h,y_b);\r
 152   call draw(x_h,y_h);\r
 153 END rectangle;\r
 154  \r
 155 (* PROCEDURE DE TRACAGE DE RECTANGLE DOUBLE AVEC RECTANGLE SIMPLE *)\r
 156  \r
 157 UNIT rectangle_double : iiuwgraph procedure(x_h,y_h,x_b,y_b:integer);\r
 158 BEGIN\r
 159   call rectangle(x_h,y_h,x_b,y_b);\r
 160   call rectangle(x_h+2,y_h+2,x_b-2,y_b-2);\r
 161 END rectangle_double;\r
 162  \r
 163 (* PROCEDURE DE CHOIX DES PARAMETRES DE LA SIMULATION *)\r
 164 (* RENVOIE LA DUREE ET LE TYPE DE SIMULATION *)\r
 165  \r
 166 UNIT param : iiuwgraph procedure(inout duree,typ :integer);\r
 167   VAR haut,bas:boolean,h,v,b:integer;\r
 168 BEGIN\r
 169   PREF mouse BLOCK\r
 170   BEGIN\r
 171  \r
 172     (*initialisation *)\r
 173     haut:=true;\r
 174     typ:=0;\r
 175     duree:=0;\r
 176     h:=0;v:=0;b:=0;\r
 177     bas:=true;\r
 178     call color(14);\r
 179     call move(100,40);\r
 180     call outstring("      CHER UTILISATEUR CHOISISSEZ UNE DUREE PARMI :");\r
 181     call rectangle_double(100,60,550,100);\r
 182  \r
 183     (* fait les bares verticales *)\r
 184     call move(150,62);\r
 185     call draw(150,98);\r
 186     call move(200,62);\r
 187     call draw(200,98);\r
 188     call move(250,62);\r
 189     call draw(250,98);\r
 190     call move(300,62);\r
 191     call draw(300,98);\r
 192     call move(350,62);\r
 193     call draw(350,98);\r
 194     call move(400,62);\r
 195     call draw(400,98);\r
 196     call move(450,62);\r
 197     call draw(450,98);\r
 198     call move(500,62);\r
 199     call draw(500,98);\r
 200  \r
 201     (* fin bare verticales *)\r
 202     (*texte*)\r
 203     call color(15);\r
 204     call move(105,78);call outstring("1 min");\r
 205     call move(155,78);call outstring("2 min");\r
 206     call move(205,78);call outstring("3 min");\r
 207     call move(255,78);call outstring("4 min");\r
 208     call move(305,78);call outstring("5 min");\r
 209     call move(355,78);call outstring("6 min");\r
 210     call move(405,78);call outstring("7 min");\r
 211     call move(455,78);call outstring("8 min");\r
 212     call move(505,78);call outstring("9 min");\r
 213     (*fin texte*)\r
 214  \r
 215     call color(14);\r
 216     call move(100,150);\r
 217     call outstring("   ET UN TYPE DE SIMULATION ( densite des VOYAGEURs ) :");\r
 218     call rectangle_double(100,170,550,210);\r
 219  \r
 220     (* bares verticales *)\r
 221     call move(250,172);\r
 222     call draw(250,208);\r
 223     call move(400,172);\r
 224     call draw(400,208);\r
 225     (* fin bare verticales *)\r
 226  \r
 227     (*texte*)\r
 228      call color(15);\r
 229      call move(121,184);call outstring("    Nuit");\r
 230      call move(275,184);call outstring("    Jour");\r
 231      call move(425,184);call outstring("    Dense");\r
 232     (*fin texte*)\r
 233  \r
 234     (* definition de la souris *)\r
 235     call showcursor;\r
 236     while(haut or bas) do\r
 237       call getpress(0,h,v,b,gauche,droit,centre);\r
 238       if (gauche) then\r
 239       if(h>100 and h<550) then\r
 240         call HIDECURSOR;\r
 241         if(haut) then\r
 242                 if(v>60 and v<100) then\r
 243                 if(h>100 and h<150) then duree:=10;\r
 244  \r
 245                         call color(0);\r
 246                         call move(105,78);\r
 247                         call outstring("1 min");\r
 248  \r
 249                         call color(12);\r
 250                         call move(105,78);\r
 251                         call outstring("1 min");\r
 252                 else\r
 253                 if(h>150 and h<200) then duree:=20;\r
 254  \r
 255                         call color(0);\r
 256                         call move(155,78);\r
 257                         call outstring("2 min");\r
 258  \r
 259                         call color(12);\r
 260                         call move(155,78);\r
 261                         call outstring("2 min");\r
 262  \r
 263                 else\r
 264                 if(h>200 and h<250) then duree:=30;\r
 265  \r
 266                         call color(0);\r
 267                         call move(205,78);\r
 268                         call outstring("3 min");\r
 269  \r
 270                         call color(12);\r
 271                         call move(205,78);\r
 272                         call outstring("3 min");\r
 273  \r
 274                 else\r
 275                 if(h>250 and h<300) then duree:=40;\r
 276  \r
 277                         call color(0);\r
 278                         call move(255,78);\r
 279                         call outstring("4 min");\r
 280  \r
 281                         call color(12);\r
 282                         call move(255,78);\r
 283                         call outstring("4 min");\r
 284  \r
 285                 else\r
 286                 if(h>300 and h<350) then duree:=50;\r
 287  \r
 288                         call color(0);\r
 289                         call move(305,78);\r
 290                         call outstring("5 min");\r
 291  \r
 292                         call color(12);\r
 293                         call move(305,78);\r
 294                         call outstring("5 min");\r
 295  \r
 296                 else\r
 297                 if(h>350 and h<400) then duree:=60;\r
 298  \r
 299                         call color(0);\r
 300                         call move(355,78);\r
 301                         call outstring("6 min");\r
 302  \r
 303                         call color(12);\r
 304                         call move(355,78);\r
 305                         call outstring("6 min");\r
 306  \r
 307                 else\r
 308                 if(h>400 and h<450) then duree:=70;\r
 309  \r
 310                         call color(0);\r
 311                         call move(405,78);\r
 312                         call outstring("7 min");\r
 313  \r
 314                         call color(12);\r
 315                         call move(405,78);\r
 316                         call outstring("7 min");\r
 317  \r
 318                 else\r
 319                 if(h>450 and h<500) then duree:=80;\r
 320  \r
 321                         call color(0);\r
 322                         call move(455,78);\r
 323                         call outstring("8 min");\r
 324  \r
 325                         call color(12);\r
 326                         call move(455,78);\r
 327                         call outstring("8 min");\r
 328  \r
 329                 else\r
 330                 if (h>500 and h<550) then duree:=90;\r
 331  \r
 332                         call color(0);\r
 333                         call move(505,78);\r
 334                         call outstring("9 min");\r
 335  \r
 336                         call color(12);\r
 337                         call move(505,78);\r
 338                         call outstring("9 min");\r
 339  \r
 340                 fi;fi;fi;fi;fi;fi;fi;fi;fi;\r
 341                 haut:=false;\r
 342                fi;\r
 343             fi;\r
 344             if (bas) then\r
 345                 if(v>170 and v<210) then\r
 346                 if (h>100 and h<250) then typ:=1;\r
 347  \r
 348                         call color(0);\r
 349                         call move(121,184);\r
 350                         call outstring("    Nuit");\r
 351  \r
 352                         call color(12);\r
 353                         call move(121,184);\r
 354                         call outstring("    Nuit");\r
 355  \r
 356                 else\r
 357                 if (h>250 and h<400) then typ:=2;\r
 358  \r
 359                         call color(0);\r
 360                         call move(275,184);\r
 361                         call outstring("    Jour");\r
 362  \r
 363                         call color(12);\r
 364                         call move(275,184);\r
 365                         call outstring("    Jour");\r
 366                 else\r
 367                 if (h>400 and h<550) then typ:=3;\r
 368  \r
 369                         call color(0);\r
 370                         call move(425,184);\r
 371                         call outstring("    Dense");\r
 372  \r
 373                         call color(12);\r
 374                         call move(425,184);\r
 375                         call outstring("    Dense");\r
 376                 fi;fi;fi;\r
 377                 bas:=false;\r
 378                 fi;\r
 379             fi;\r
 380             call SHOWCURSOR;\r
 381           fi;\r
 382          gauche:=false;\r
 383         fi;\r
 384     od;\r
 385     call color(10);\r
 386     call move(100,300);\r
 387     call outstring("     La duree sera de : ");call color(15);\r
 388     case duree\r
 389       when 10:call outstring("1 min");\r
 390       when 20:call outstring("2 min");\r
 391       when 30:call outstring("3 min");\r
 392       when 40:call outstring("4 min");\r
 393       when 50:call outstring("5 min");\r
 394       when 60:call outstring("6 min");\r
 395       when 70:call outstring("7 min");\r
 396       when 80:call outstring("8 min");\r
 397       when 90:call outstring("9 min");\r
 398     esac;\r
 399     call color(10);\r
 400     call outstring(" et le type sera : ");call color(15);\r
 401     case typ\r
 402       when 1:call outstring("Nuit");\r
 403       when 2:call outstring("Jour");\r
 404       when 3:call outstring("Dense");\r
 405     esac;\r
 406     call PAUSE;\r
 407     call hidecursor;\r
 408     call cls;\r
 409   END;\r
 410 END param;\r
 411  \r
 412 (* PROCEDURE D ECRITURE D UN ENTIER A L ECRAN *)\r
 413 (* PARAMETRES TEMPS:REAL et COORDONNEES *)\r
 414  \r
 415 UNIT ecrit_chiffre : procedure(TIME:real,x,y:integer);\r
 416   VAR wtime :integer;\r
 417 BEGIN\r
 418   call move(x,y);\r
 419   call HASCII(0);\r
 420   wtime:=entier(TIME);\r
 421   (* temps <1000 *);\r
 422   if(wtime>=100) then\r
 423     call HASCII(wtime div 100+48);\r
 424     wtime:=wtime mod 100;\r
 425   else call HASCII(0);\r
 426   fi;\r
 427   call HASCII(wtime div 10 + 48);\r
 428   call HASCII(wtime mod 10 + 48);\r
 429 END ecrit_chiffre;\r
 430  \r
 431 (* PROCEDURE D EFFACEMENT DU CHIFFRE ECRIT *)\r
 432  \r
 433 UNIT EFFACE_chiffre : procedure(x,y:integer);\r
 434 BEGIN\r
 435   call color(0);\r
 436   call rectangle_double(x,y-1,x+25,y+9);\r
 437   call rectangle_double(x+1,y,x+24,y+8);\r
 438   call rectangle_double(x+4,y+2,x+22,y+6);\r
 439   call rectangle_double(x+5,y+3,x+21,y+5);\r
 440 END EFFACE_chiffre;\r
 441  \r
 442 (* PROCEDURE DE TRACAGE DES VOIES *)\r
 443  \r
 444 UNIT voie:iiuwgraph procedure;\r
 445 BEGIN\r
 446   call color(9);\r
 447   call rectangle_double(4,170,635,176);\r
 448   call rectangle_double(5,171,634,175);\r
 449   call move(5,171);\r
 450   call color(14);\r
 451   call outstring("QUAI 1");\r
 452   call color(9);\r
 453   call rectangle(4,177,635,195);\r
 454   call color(10);\r
 455   call rectangle_double(4,220,635,226);\r
 456   call rectangle_double(5,221,634,225);\r
 457   call move(5,221);\r
 458   call color(14);\r
 459   call outstring("QUAI 2");\r
 460   call color(10);\r
 461   call rectangle(4,227,635,245);\r
 462   call color(11);\r
 463   call rectangle_double(4,270,635,276);\r
 464   call rectangle_double(5,271,634,275);\r
 465   call move(5,271);\r
 466   call color(14);\r
 467   call outstring("QUAI 3");\r
 468   call color(11);\r
 469   call rectangle(4,277,635,295);\r
 470   call color(12);\r
 471   call rectangle_double(4,320,635,326);\r
 472   call rectangle_double(5,321,634,325);\r
 473   call move(5,321);\r
 474   call color(14);\r
 475   call outstring("QUAI 4");\r
 476   call color(12);\r
 477   call rectangle(4,327,635,345);\r
 478 END voie;\r
 479  \r
 480 (* PROCEDURE DE TRACAGE DES CAISSES *)\r
 481  \r
 482 UNIT caisse : iiuwgraph procedure;\r
 483 BEGIN\r
 484   call color(15);\r
 485  \r
 486   (*caisse1*)\r
 487   call rectangle_double(10,3,80,23);\r
 488  \r
 489   (*caisse2*)\r
 490   call rectangle_double(10,26,80,43);\r
 491  \r
 492   (*caisse3*)\r
 493   call rectangle_double(10,47,80,65);\r
 494  \r
 495   (*caisse4*)\r
 496   call rectangle_double(10,68,80,86);\r
 497  \r
 498   (*texte caisse*)\r
 499   call color(9);\r
 500   call move(14,9);\r
 501   call outstring("Caisse 1");\r
 502   call move(14,31);\r
 503   call color(10);\r
 504   call outstring("Caisse 2");\r
 505   call move(14,52);\r
 506   call color(11);\r
 507   call outstring("Caisse 3");\r
 508   call move(14,73);\r
 509   call color(12);\r
 510   call outstring("Caisse 4");\r
 511 END caisse;\r
 512  \r
 513 (* PROCEDURE D ECRITURE DES MESSAGES D ARRIVEE DES TRAIN DANS TABLEAU *)\r
 514  \r
 515 UNIT mes_train :procedure(num:integer);\r
 516 BEGIN\r
 517   case num\r
 518     when 1:\r
 519               call color(9);\r
 520               call move(435,9);\r
 521               call outstring("le train quai 1 arrive");\r
 522     when 2:\r
 523               call color(10);\r
 524               call move(435,31);\r
 525               call outstring("le train quai 2 arrive");\r
 526     when 3:\r
 527               call color(11);\r
 528               call move(435,52);\r
 529               call outstring("le train quai 3 arrive");\r
 530     when 4:\r
 531               call color(12);\r
 532               call move(435,73);\r
 533               call outstring("le train quai 4 arrive");\r
 534  \r
 535   esac;\r
 536 END mes_train;\r
 537  \r
 538 UNIT mes_train_rep :procedure(num:integer);\r
 539 BEGIN\r
 540   case num\r
 541     when 1:\r
 542               call color(9);\r
 543               call move(435,9);\r
 544               call outstring("le train quai 1 REPART");\r
 545     when 2:\r
 546               call color(10);\r
 547               call move(435,31);\r
 548               call outstring("le train quai 2 REPART");\r
 549     when 3:\r
 550               call color(11);\r
 551               call move(435,52);\r
 552               call outstring("le train quai 3 REPART");\r
 553     when 4:\r
 554               call color(12);\r
 555               call move(435,73);\r
 556               call outstring("le train quai 4 REPART");\r
 557  \r
 558   esac;\r
 559 END mes_train_rep;\r
 560  \r
 561 UNIT eff_mestrn:procedure(num:integer);\r
 562 BEGIN\r
 563   call color(0);\r
 564   case num\r
 565     when 1:\r
 566               call move(435,9);\r
 567               call outstring("le train quai 1 arrive");\r
 568     when 2:\r
 569               call move(435,31);\r
 570               call outstring("le train quai 2 arrive");\r
 571     when 3:\r
 572               call move(435,52);\r
 573               call outstring("le train quai 3 arrive");\r
 574     when 4:\r
 575               call move(435,73);\r
 576               call outstring("le train quai 4 arrive");\r
 577  \r
 578   esac;\r
 579 END eff_mestrn;\r
 580  \r
 581 UNIT eff_mestrn_rep:procedure(num:integer);\r
 582 BEGIN\r
 583   call color(0);\r
 584   case num\r
 585     when 1:\r
 586               call move(435,9);\r
 587               call outstring("le train quai 1 REPART");\r
 588     when 2:\r
 589               call move(435,31);\r
 590               call outstring("le train quai 2 REPART");\r
 591     when 3:\r
 592               call move(435,52);\r
 593               call outstring("le train quai 3 REPART");\r
 594     when 4:\r
 595               call move(435,73);\r
 596               call outstring("le train quai 4 REPART");\r
 597  \r
 598   esac;\r
 599 END eff_mestrn_rep;\r
 600  \r
 601 (* PROCEDURE DE TRACAGE DES TRAINS *)\r
 602  \r
 603         UNIT DESSINE_TRAIN : procedure(num,deplacement :integer);\r
 604         VAR wdepl,wbdepl:integer;\r
 605         BEGIN\r
 606                 wdepl:=deplacement+5;\r
 607                 wbdepl:=deplacement+100;\r
 608                 if wdepl >=632 then wdepl:=632; fi;\r
 609                 if wbdepl>=632 then wbdepl:=632; fi;\r
 610  \r
 611                 case num\r
 612                         when  1:\r
 613                                 call color(9);\r
 614                                 call rectangle_double(wdepl,179,wbdepl,193);\r
 615                         when 2:\r
 616                                 call color(10);\r
 617                                 call rectangle_double(wdepl,229,wbdepl,243);\r
 618                         when 3:\r
 619                                 call color(11);\r
 620                                 call rectangle_double(wdepl,279,wbdepl,293);\r
 621                         when 4:\r
 622                                 call color(12);\r
 623                                 call rectangle_double(wdepl,329,wbdepl,343);\r
 624                         esac;\r
 625         END DESSINE_TRAIN;\r
 626  \r
 627  \r
 628 UNIT EFFACE_TRAIN : iiuwgraph procedure(num,deplacement :integer);\r
 629   VAR wdepl,wbdepl :integer;\r
 630 BEGIN\r
 631   wdepl:=deplacement+5;\r
 632   wbdepl:=deplacement+100;\r
 633   if wdepl >=632 then wdepl:=632; fi;\r
 634   if wbdepl>=632 then wbdepl:=632 fi;\r
 635   call color(0);\r
 636   case num\r
 637     when 1:\r
 638               call rectangle_double(wdepl,179,wbdepl,193);\r
 639     when 2:\r
 640               call rectangle_double(wdepl,229,wbdepl,243);\r
 641     when 3:\r
 642               call rectangle_double(wdepl,279,wbdepl,293);\r
 643     when 4:\r
 644               call rectangle_double(wdepl,329,wbdepl,343);\r
 645   esac;\r
 646 END EFFACE_TRAIN;\r
 647  \r
 648 UNIT arrive_TRAIN:procedure(num:integer);\r
 649   VAR indice,temp:integer;\r
 650 BEGIN\r
 651   call mes_train(num);\r
 652   for indice:=0 to 100 do\r
 653     call DESSINE_TRAIN(num,indice);\r
 654     call EFFACE_TRAIN(num,indice);\r
 655   od;\r
 656   call DESSINE_TRAIN(num,indice);\r
 657 END arrive_TRAIN;\r
 658  \r
 659 UNIT REPART_TRAIN:procedure(num:integer);\r
 660   VAR indice,temp:integer;\r
 661 BEGIN\r
 662   call eff_mestrn(num);\r
 663   call mes_train_rep(num);\r
 664   for indice:=100 to 636 do\r
 665     call DESSINE_TRAIN(num,indice);\r
 666     call EFFACE_TRAIN(num,indice);\r
 667   od;\r
 668   call eff_mestrn_rep(num);\r
 669 END REPART_TRAIN;\r
 670  \r
 671 (* PROCEDURE DE TRACAGE DU TABLEAU DES ARRIVEES *)\r
 672  \r
 673 UNIT tableau : iiuwgraph procedure;\r
 674 BEGIN\r
 675   call color(15);\r
 676   call rectangle(350,3,635,86);\r
 677   call rectangle(410,5,633,19);\r
 678   call rectangle(410,28,633,42);\r
 679   call rectangle(410,49,633,63);\r
 680   call rectangle(410,70,633,84);\r
 681  \r
 682   (*texte tableau*)\r
 683   call color(9);\r
 684   call move(354,9);\r
 685   call outstring("Quai 1");\r
 686   call move(354,31);\r
 687   call color(10);\r
 688   call outstring("Quai 2");\r
 689   call move(354,52);\r
 690   call color(11);\r
 691   call outstring("Quai 3");\r
 692   call move(354,73);\r
 693   call color(12);\r
 694   call outstring("Quai 4");\r
 695  \r
 696 END tableau;\r
 697  \r
 698 (* PROCEDURE DE TRACAGE DES VOYAGEURS *)\r
 699  \r
 700 UNIT VOYAGEUR:iiuwgraph procedure(x,y:integer);\r
 701 BEGIN\r
 702   call move(x,y);\r
 703   call draw(x,y+6);\r
 704   call draw(x-2,y+10);\r
 705   call move(x,y+6);\r
 706   call draw(x+2,y+10);\r
 707   call move(x-2,y+2);\r
 708   call draw(x+2,y+2);\r
 709   call move(x-2,y+2);\r
 710   call draw(x-4,y+4);\r
 711   call move(x+2,y+2);\r
 712   call draw(x+4,y+4)\r
 713 END;\r
 714  \r
 715 UNIT affiche_VOYAGEUR:iiuwgraph procedure(x,y:integer);\r
 716 BEGIN\r
 717   call color(14);\r
 718   call VOYAGEUR(x,y);\r
 719 END affiche_VOYAGEUR;\r
 720  \r
 721 UNIT EFFACE_VOYAGEUR:iiuwgraph procedure(x,y:integer);\r
 722 BEGIN\r
 723   call color(0);\r
 724   call VOYAGEUR(x,y);\r
 725 END EFFACE_VOYAGEUR;\r
 726  \r
 727 (* PROCEDURE D AFFICHAGE DE LA GARE *)\r
 728  \r
 729 UNIT gar:iiuwgraph procedure;\r
 730 BEGIN\r
 731   call color(15);\r
 732   call attend(400);\r
 733   call rectangle_double(0,0,639,349);\r
 734   call caisse;\r
 735   call voie;\r
 736   call tableau;\r
 737   call composteuse;\r
 738 END gar;\r
 739  \r
 740 (* PROCEDURE DE TRACAGE DU COMPOSTEUR *)\r
 741  \r
 742 UNIT composteuse : iiuwgraph procedure;\r
 743 BEGIN\r
 744   call color(7);\r
 745   call move(3,125);\r
 746   call draw(460,125);\r
 747   call move(3,126);\r
 748   call draw(460,126);\r
 749   call rectangle(500,125,633,150);\r
 750   call move(528,135);\r
 751   call outstring("COMPOSTEUR");\r
 752 END composteuse;\r
 753  \r
 754 UNIT PRIORITYQUEUE: CLASS;\r
 755 (* HEAP AS BINARY LINKED TREE WITH FATHER LINK*)\r
 756  \r
 757   UNIT QUEUEHEAD: CLASS;\r
 758   (* HEAP ACCESING MODULE *)\r
 759     VAR LAST,ROOT:NODE;\r
 760  \r
 761     UNIT MIN: FUNCTION: ELEM;\r
 762     BEGIN\r
 763          IF ROOT=/= NONE THEN RESULT:=ROOT.EL FI;\r
 764     END MIN;\r
 765  \r
 766     UNIT INSERT: PROCEDURE(R:ELEM);\r
 767     (* INSERTION INTO HEAP *)\r
 768          VAR X,Z:NODE;\r
 769     BEGIN\r
 770       X:= R.LAB;\r
 771       IF LAST=NONE THEN\r
 772            ROOT:=X;\r
 773            ROOT.LEFT,ROOT.RIGHT,LAST:=ROOT\r
 774       ELSE\r
 775         IF LAST.NS=0 THEN\r
 776              LAST.NS:=1;\r
 777              Z:=LAST.LEFT;\r
 778              LAST.LEFT:=X;\r
 779              X.UP:=LAST;\r
 780              X.LEFT:=Z;\r
 781              Z.RIGHT:=X;\r
 782            ELSE\r
 783                 LAST.NS:=2;\r
 784                 Z:=LAST.RIGHT;\r
 785                 LAST.RIGHT:=X;\r
 786                 X.RIGHT:=Z;\r
 787                 X.UP:=LAST;\r
 788                 Z.LEFT:=X;\r
 789                 LAST.LEFT.RIGHT:=X;\r
 790                 X.LEFT:=LAST.LEFT;\r
 791                 LAST:=Z;\r
 792            FI\r
 793          FI;\r
 794       CALL CORRECT(R,FALSE)\r
 795     END INSERT;\r
 796  \r
 797     UNIT DELETE: PROCEDURE(R: ELEM);\r
 798       VAR X,Y,Z:NODE;\r
 799     BEGIN\r
 800       X:=R.LAB;\r
 801       Z:=LAST.LEFT;\r
 802       IF LAST.NS =0 THEN\r
 803            Y:= Z.UP;\r
 804            Y.RIGHT:= LAST;\r
 805            LAST.LEFT:=Y;\r
 806            LAST:=Y;\r
 807          ELSE\r
 808            Y:= Z.LEFT;\r
 809            Y.RIGHT:= LAST;\r
 810            LAST.LEFT:= Y;\r
 811       FI;\r
 812       Z.EL.LAB:=X;\r
 813       X.EL:= Z.EL;\r
 814       LAST.NS:= LAST.NS-1;\r
 815       R.LAB:=Z;\r
 816       Z.EL:=R;\r
 817       IF X.LESS(X.UP) THEN CALL CORRECT(X.EL,FALSE)\r
 818       ELSE CALL CORRECT(X.EL,TRUE) FI;\r
 819     END DELETE;\r
 820  \r
 821     UNIT CORRECT: PROCEDURE(R:ELEM,DOWN:BOOLEAN);\r
 822     (* CORRECTION OF THE HEAP WITH STRUCTURE BROKEN BY R *)\r
 823       VAR X,Z:NODE,T:ELEM,FIN,LOG:BOOLEAN;\r
 824     BEGIN\r
 825       Z:=R.LAB;\r
 826       IF DOWN THEN\r
 827            WHILE NOT FIN DO\r
 828                 IF Z.NS =0 THEN FIN:=TRUE ELSE\r
 829                 IF Z.NS=1 THEN X:=Z.LEFT ELSE\r
 830                 IF Z.LEFT.LESS(Z.RIGHT) THEN X:=Z.LEFT ELSE X:=Z.RIGHT\r
 831                 FI; FI;\r
 832                 IF Z.LESS(X) THEN FIN:=TRUE ELSE\r
 833                T:=X.EL;\r
 834                   X.EL:=Z.EL;\r
 835                Z.EL:=T;\r
 836                   Z.EL.LAB:=Z;\r
 837                X.EL.LAB:=X\r
 838                 FI; FI;\r
 839                 Z:=X;\r
 840            OD\r
 841          ELSE\r
 842         X:=Z.UP;\r
 843         IF X=NONE THEN LOG:=TRUE ELSE LOG:=X.LESS(Z); FI;\r
 844         WHILE NOT LOG DO\r
 845              T:=Z.EL;\r
 846              Z.EL:=X.EL;\r
 847              X.EL:=T;\r
 848              X.EL.LAB:=X;\r
 849              Z.EL.LAB:=Z;\r
 850              Z:=X;\r
 851              X:=Z.UP;\r
 852              IF X=NONE THEN LOG:=TRUE ELSE LOG:=X.LESS(Z);\r
 853              FI;\r
 854         OD\r
 855       FI;\r
 856     END CORRECT;\r
 857  \r
 858   END QUEUEHEAD;\r
 859  \r
 860   UNIT NODE: CLASS (EL:ELEM);\r
 861   (* ELEMENT OF THE HEAP *)\r
 862     VAR LEFT,RIGHT,UP: NODE, NS:INTEGER;\r
 863     UNIT LESS: FUNCTION(X:NODE): BOOLEAN;\r
 864     BEGIN\r
 865          IF X= NONE THEN RESULT:=FALSE\r
 866          ELSE RESULT:=EL.LESS(X.EL) FI;\r
 867     END LESS;\r
 868   END NODE;\r
 869  \r
 870   UNIT ELEM: CLASS(PRIOR:REAL);\r
 871   (* PREFIX OF INFORMATION TO BE STORED IN NODE *)\r
 872     VAR LAB: NODE;\r
 873     UNIT VIRTUAL LESS: FUNCTION(X:ELEM):BOOLEAN;\r
 874     BEGIN\r
 875          IF X=NONE THEN RESULT:= FALSE ELSE\r
 876         RESULT:= PRIOR< X.PRIOR FI;\r
 877     END LESS;\r
 878   BEGIN\r
 879     LAB:= NEW NODE(THIS ELEM);\r
 880   END ELEM;\r
 881  \r
 882 END PRIORITYQUEUE;\r
 883  \r
 884 UNIT SIMULATION: PRIORITYQUEUE CLASS;\r
 885 (* THE LANGUAGE FOR SIMULATION PURPOSES *)\r
 886  \r
 887   VAR CURR: SIMPROCESS,  (*ACTIVE PROCESS *)\r
 888       PQ:QUEUEHEAD,  (* THE TIME AXIS *)\r
 889       MAINPR: MAINPROGRAM;\r
 890  \r
 891  \r
 892   UNIT SIMPROCESS: COROUTINE;\r
 893   (* USER PROCESS PREFIX *)\r
 894     VAR EVENT,  (* ACTIVATION MOMENT NOTICE *)\r
 895            EVENTAUX: EVENTNOTICE,\r
 896         (* THIS IS FOR AVOIDING MANY NEW CALLS AS AN RESULT OF *)\r
 897         (* SUBSEQUENT PASSIVATIONS AND ACTIVATIONS             *)\r
 898         FINISH: BOOLEAN;\r
 899  \r
 900     UNIT IDLE: FUNCTION: BOOLEAN;\r
 901     BEGIN\r
 902          RESULT:= EVENT= NONE;\r
 903     END IDLE;\r
 904  \r
 905     UNIT TERMINATED: FUNCTION :BOOLEAN;\r
 906     BEGIN\r
 907       RESULT:= FINISH;\r
 908     END TERMINATED;\r
 909  \r
 910     UNIT EVTIME: FUNCTION: REAL;\r
 911     (* TIME OF ACTIVATION *)\r
 912     BEGIN\r
 913       IF IDLE THEN CALL ERROR1;\r
 914          FI;\r
 915       RESULT:= EVENT.EVENTTIME;\r
 916     END EVTIME;\r
 917  \r
 918     UNIT ERROR1:PROCEDURE;\r
 919     BEGIN\r
 920          ATTACH(MAIN);\r
 921          call outstring(" AN ATTEMPT TO ACCESS AN IDLE PROCESS TIME");\r
 922     END ERROR1;\r
 923  \r
 924     UNIT ERROR2:PROCEDURE;\r
 925     BEGIN\r
 926          ATTACH(MAIN);\r
 927          call outstring(" AN ATTEMPT TO ACCESS A TERMINATED PROCESS TIME");\r
 928     END ERROR2;\r
 929         \r
 930   BEGIN\r
 931     RETURN;\r
 932     INNER;\r
 933     FINISH:=TRUE;\r
 934     CALL PASSIVATE;\r
 935     CALL ERROR2;\r
 936   END SIMPROCESS;\r
 937  \r
 938  \r
 939   UNIT EVENTNOTICE: ELEM CLASS;\r
 940   (* A PROCESS ACTIVATION NOTICE TO BE PLACED ONTO THE TIME AXIS PQ *)\r
 941     VAR EVENTTIME: REAL, PROC: SIMPROCESS;\r
 942  \r
 943     UNIT VIRTUAL LESS: FUNCTION(X: EVENTNOTICE):BOOLEAN;\r
 944     (* OVERWRITE THE FORMER VERSION CONSIDERING EVENTTIME *)\r
 945     BEGIN\r
 946          IF X=NONE THEN RESULT:= FALSE ELSE\r
 947            RESULT:= EVENTTIME< X.EVENTTIME OR\r
 948            (EVENTTIME=X.EVENTTIME AND PRIOR< X.PRIOR); FI;\r
 949     END LESS;\r
 950   END EVENTNOTICE;\r
 951  \r
 952   UNIT MAINPROGRAM: SIMPROCESS CLASS;\r
 953   (* IMPLEMENTING MASTER PROGRAM AS A PROCESS *)\r
 954   BEGIN\r
 955     DO ATTACH(MAIN) OD;\r
 956   END MAINPROGRAM;\r
 957  \r
 958   UNIT TIME:FUNCTION:REAL;\r
 959   (* CURRENT VALUE OF SIMULATION TIME *)\r
 960   BEGIN\r
 961     RESULT:=CURRENT.EVTIME\r
 962   END TIME;\r
 963  \r
 964   UNIT CURRENT: FUNCTION: SIMPROCESS;\r
 965   (* THE FIRST PROCESS ON THE TIME AXIS *)\r
 966   BEGIN\r
 967     RESULT:=CURR;\r
 968   END CURRENT;\r
 969  \r
 970   UNIT SCHEDULE: PROCEDURE(P:SIMPROCESS,T:REAL);\r
 971   BEGIN\r
 972     IF T<TIME THEN T:= TIME FI;\r
 973     IF P=CURRENT THEN CALL HOLD(T-TIME) ELSE\r
 974     IF P.IDLE AND P.EVENTAUX=NONE THEN (* HAS NOT BEEN SCHEDULED YET*)\r
 975          P.EVENT,P.EVENTAUX:= NEW EVENTNOTICE(RANDOM);\r
 976       P.EVENT.PROC:= P;\r
 977     ELSE\r
 978       IF P.IDLE (* P HAS ALREADY BEEN SCHEDULED *) THEN\r
 979            P.EVENT:= P.EVENTAUX;\r
 980            P.EVENT.PRIOR:=RANDOM;\r
 981          ELSE\r
 982         (* NEW SCHEDULING *)\r
 983            P.EVENT.PRIOR:=RANDOM;\r
 984            CALL PQ.DELETE(P.EVENT)\r
 985     FI; FI;\r
 986     P.EVENT.EVENTTIME:= T;\r
 987     CALL PQ.INSERT(P.EVENT) FI;\r
 988   END SCHEDULE;\r
 989  \r
 990   UNIT HOLD:PROCEDURE(T:REAL);\r
 991   (* MOVE THE ACTIVE PROCESS T MINUTES BACK ALONG PQ *)\r
 992   (* REDEFINE PRIOR                                  *)\r
 993   BEGIN\r
 994     CALL PQ.DELETE(CURRENT.EVENT);\r
 995     CURRENT.EVENT.PRIOR:=RANDOM;\r
 996     IF T<0 THEN T:=0; FI;\r
 997     CURRENT.EVENT.EVENTTIME:=TIME+T;\r
 998     CALL PQ.INSERT(CURRENT.EVENT);\r
 999     CALL CHOICEPROCESS;\r
1000   END HOLD;\r
1001  \r
1002   UNIT PASSIVATE: PROCEDURE;\r
1003   (* REMOVE THE ACTVE PROCESS FROM PQ AND ACTIVATE THE NEXT ONE *)\r
1004   BEGIN\r
1005     CALL PQ.DELETE(CURRENT.EVENT);\r
1006     CURRENT.EVENT:=NONE;\r
1007     CALL CHOICEPROCESS\r
1008   END PASSIVATE;\r
1009  \r
1010   UNIT RUN: PROCEDURE(P:SIMPROCESS);\r
1011   (* ACTIVATE P IMMEDIATELY AND DELAY THE FORMER FIRST PROCESS BY REDEFINING*)\r
1012   (* PRIOR                                                              *)\r
1013   BEGIN\r
1014     CURRENT.EVENT.PRIOR:=RANDOM;\r
1015     IF NOT P.IDLE THEN\r
1016          P.EVENT.PRIOR:=0;\r
1017          P.EVENT.EVENTTIME:=TIME;\r
1018          CALL PQ.CORRECT(P.EVENT,FALSE)\r
1019     ELSE\r
1020       IF P.EVENTAUX=NONE THEN\r
1021            P.EVENT,P.EVENTAUX:=NEW EVENTNOTICE(0);\r
1022            P.EVENT.EVENTTIME:=TIME;\r
1023            P.EVENT.PROC:=P;\r
1024            CALL PQ.INSERT(P.EVENT)\r
1025       ELSE\r
1026            P.EVENT:=P.EVENTAUX;\r
1027            P.EVENT.PRIOR:=0;\r
1028            P.EVENT.EVENTTIME:=TIME;\r
1029         P.EVENT.PROC:=P;\r
1030            CALL PQ.INSERT(P.EVENT);\r
1031     FI;FI;\r
1032     CALL CHOICEPROCESS;\r
1033   END RUN;\r
1034  \r
1035   UNIT CANCEL:PROCEDURE(P: SIMPROCESS);\r
1036   (* REMOVE PROCESS P FROM PQ AND CONTINUE SIMULATION *)\r
1037   BEGIN\r
1038     IF P= CURRENT THEN CALL PASSIVATE ELSE\r
1039       CALL PQ.DELETE(P.EVENT);\r
1040       P.EVENT:=NONE;  FI;\r
1041   END CANCEL;\r
1042  \r
1043   UNIT CHOICEPROCESS:PROCEDURE;\r
1044   (* CHOISIR THE FIRST PROCESS FROM PQ TO BE ACTIVATED *)\r
1045     VAR P:SIMPROCESS;\r
1046   BEGIN\r
1047     P:=CURR;\r
1048     CURR:= PQ.MIN QUA EVENTNOTICE.PROC;\r
1049     IF CURR=NONE THEN\r
1050       WRITE(" ERROR IN THE HEAP"); WRITELN;\r
1051          ATTACH(MAIN);\r
1052     ELSE ATTACH(CURR); FI;\r
1053   END CHOICEPROCESS;\r
1054  \r
1055 BEGIN\r
1056   PQ:=NEW QUEUEHEAD;  (* SIMULATION TIME AXIS*)\r
1057   CURR,MAINPR:=NEW MAINPROGRAM;\r
1058   MAINPR.EVENT,MAINPR.EVENTAUX:=NEW EVENTNOTICE(0);\r
1059   MAINPR.EVENT.EVENTTIME:=0;\r
1060   MAINPR.EVENT.PROC:=MAINPR;\r
1061   CALL PQ.INSERT(MAINPR.EVENT);\r
1062   (* THE FIRST PROCESS TO BE ACTIVATED IS MAIN PROGRAM *)\r
1063   INNER;\r
1064   PQ:=NONE;\r
1065 END SIMULATION;\r
1066  \r
1067 UNIT LISTS:SIMULATION CLASS;\r
1068  (* WE WISH TO USE LISTS FOR QUEUEING PROCESSES DURING SIMULATION*)\r
1069  \r
1070   UNIT LINKAGE:CLASS;\r
1071   (*WE WILL USE TWO WAY LISTS *)\r
1072     VAR SUC1,PRED1:LINKAGE;\r
1073   END LINKAGE;\r
1074  \r
1075   UNIT HEAD:LINKAGE CLASS;\r
1076   (* EACH LIST WILL HAVE ONE ELEMENT ESTABLISHED *)\r
1077     UNIT FIRST:FUNCTION:LINK;\r
1078     BEGIN\r
1079          IF SUC1 IN LINK THEN RESULT:=SUC1\r
1080          ELSE RESULT:=NONE\r
1081          FI;\r
1082     END FIRST;\r
1083                 \r
1084     UNIT EMPTY:FUNCTION:BOOLEAN;\r
1085     BEGIN\r
1086          RESULT:=SUC1=THIS LINKAGE;\r
1087     END EMPTY;\r
1088   BEGIN\r
1089     SUC1,PRED1:=THIS LINKAGE;\r
1090   END HEAD;\r
1091  \r
1092   UNIT LINK:LINKAGE CLASS;\r
1093   (* ORDINARY LIST ELEMENT PREFIX *)\r
1094     UNIT OUT:PROCEDURE;\r
1095     BEGIN\r
1096          IF SUC1=/=NONE THEN\r
1097            SUC1.PRED1:=PRED1;\r
1098            PRED1.SUC1:=SUC1;\r
1099            SUC1,PRED1:=NONE;\r
1100          FI;\r
1101     END OUT;\r
1102     UNIT INTO:PROCEDURE(S:HEAD);\r
1103     BEGIN\r
1104          CALL OUT;\r
1105          IF S=/= NONE THEN\r
1106            IF S.SUC1=/=NONE THEN\r
1107              SUC1:=S;\r
1108              PRED1:=S.PRED1;\r
1109              PRED1.SUC1:=THIS LINKAGE;\r
1110              S.PRED1:=THIS LINKAGE;\r
1111            FI;\r
1112          FI;\r
1113     END INTO;\r
1114   END LINK;\r
1115  \r
1116   UNIT ELEM:LINK CLASS(SPROCESS:SIMPROCESS);\r
1117   (* USER DEFINED  PROCESS WILL BE JOINED INTO LISTS  *)\r
1118   END ELEM;\r
1119  \r
1120 END LISTS;\r
1121  \r
1122 UNIT GARE:LISTS CLASS; (*AN GARE*)\r
1123  \r
1124   UNIT TILL:SIMPROCESS CLASS(QUEUE:HEAD);\r
1125   (* GUICHET WITH VOYAGEURS QUEUEING UP *)\r
1126     UNIT VIRTUAL SERVICE:PROCEDURE;\r
1127     (* SERVICE OF THIS GUICHET WILL BE PRECISED LATER *)\r
1128     END SERVICE;\r
1129  \r
1130     VAR CSTM:VOYAGEUR,  (*THE VOYAGEUR BEING SERVED*)\r
1131            REST,PAUSE:REAL,\r
1132            COMPTEUR : INTEGER;\r
1133  \r
1134   BEGIN\r
1135     PAUSE:=TIME;\r
1136     DO\r
1137       REST:=REST+TIME-PAUSE;\r
1138       WHILE NOT QUEUE.EMPTY DO\r
1139            CSTM:=QUEUE.FIRST QUA ELEM.SPROCESS;\r
1140            CALL SERVICE;\r
1141       OD;\r
1142       PAUSE:=TIME;\r
1143       CALL PASSIVATE;\r
1144     OD;\r
1145   END TILL;\r
1146  \r
1147   UNIT VOYAGEUR:SIMPROCESS CLASS;\r
1148  \r
1149     VAR ELLIST:ELEM, K:INTEGER,NUMGUICHET:INTEGER;\r
1150     UNIT ARRIVAL:PROCEDURE(S:TILL);\r
1151     (* le VOYAGEUR va a un guichet ou au composteur *)\r
1152     BEGIN\r
1153       IF S=/=NONE THEN\r
1154         ELLIST:=NEW ELEM(THIS VOYAGEUR);\r
1155         call ELLIST.INTO(S.QUEUE); (* mit dans la file d'attente*)\r
1156         case NUMGUICHET\r
1157           when 1: call affiche_VOYAGEUR(90+S.COMPTEUR*10,10);\r
1158           when 2: call affiche_VOYAGEUR(90+S.COMPTEUR*10,33);\r
1159           when 3: call affiche_VOYAGEUR(90+S.COMPTEUR*10,54);\r
1160           when 4: call affiche_VOYAGEUR(90+S.COMPTEUR*10,75);\r
1161           when 5: call affiche_VOYAGEUR(500-S.COMPTEUR*10,110);\r
1162         esac;\r
1163         S.COMPTEUR:=S.COMPTEUR+1;\r
1164         IF S.IDLE THEN CALL SCHEDULE(S,TIME); FI;\r
1165         call PASSIVATE;\r
1166       FI;\r
1167     END ARRIVAL;\r
1168   END VOYAGEUR;\r
1169  \r
1170   UNIT TRAIN:SIMPROCESS CLASS;\r
1171  \r
1172     UNIT ARRIVAL:PROCEDURE(inout QUAI:integer);\r
1173     (* le train arrive en gare, prend les voyageurs et REPART*)\r
1174       VAR CLI : VOYAGEUR,TEMP:INTEGER;\r
1175     BEGIN\r
1176      IF (NOT TAB_STOPQ(QUAI)) THEN\r
1177       TAB_STOPQ(QUAI):=TRUE;    \r
1178       TEMP:=RANDOM*10;\r
1179       call HOLD(TEMP);     \r
1180       call arrive_TRAIN(QUAI);\r
1181       if(TEMP>0) THEN\r
1182         (* DEPLACER TRAIN JUSQU'A DEBUT FILE *)\r
1183         (* CHARGER VOYAGEUR*)\r
1184         call attend(20);\r
1185         write(chr(07));\r
1186      \r
1187         CASE QUAI\r
1188                 WHEN 1 :(* QUAI 1 *)\r
1189                         while(CPTQU1>=0) do\r
1190                                 call EFFACE_VOYAGEUR(100+CPTQU1*20,155);\r
1191                                 CPTQU1:=CPTQU1-1;\r
1192                                 call HOLD(RANDOM * 10);\r
1193                                 od;\r
1194                         CPTQU1:=0;\r
1195                 WHEN 2 :(* QUAI 2 *)\r
1196                         while(CPTQU2>=0) do\r
1197                                 call EFFACE_VOYAGEUR(100+CPTQU2*20,205);\r
1198                                 CPTQU2:=CPTQU2-1;\r
1199                                 call HOLD(RANDOM * 11);\r
1200                                 od;\r
1201                         CPTQU2:=0;\r
1202                 WHEN 3 :(* QUAI 3 *)\r
1203                         while(CPTQU3>=0) do\r
1204                                 call EFFACE_VOYAGEUR(100+CPTQU3*20,255);\r
1205                                 CPTQU3:=CPTQU3-1;\r
1206                                 call HOLD(RANDOM * 12);\r
1207                                 od;\r
1208                         CPTQU3:=0;\r
1209                 WHEN 4 :(* QUAI 4 *)\r
1210                         while(CPTQU4>=0) do\r
1211                                 call EFFACE_VOYAGEUR(100+CPTQU4*20,305);\r
1212                                 CPTQU4:=CPTQU4-1;\r
1213                                 call HOLD(RANDOM * 13);\r
1214                                 od;\r
1215                         CPTQU4:=0;\r
1216         ESAC;\r
1217          write(chr(07));\r
1218          write(chr(07));     \r
1219       fi;\r
1220       call REPART_TRAIN(QUAI);\r
1221       TAB_STOPQ(QUAI) := FALSE;\r
1222       call HOLD(10); \r
1223       (* le train sort de la gare *)\r
1224      fi;\r
1225    END ARRIVAL;\r
1226  END TRAIN;\r
1227  \r
1228 END GARE;\r
1229  \r
1230 UNIT GAREDEPARTMENT:GARE CLASS;\r
1231  \r
1232   UNIT COMPOSTEUR:TILL CLASS;\r
1233     VAR SERVICETIME:REAL;\r
1234     VAR nbvoyageurQ1,nbvoyageurQ2,nbvoyageurQ3,nbvoyageurQ4 : integer;\r
1235     UNIT VIRTUAL SERVICE:PROCEDURE;\r
1236     (* represente le service dispense par le composteur *)\r
1237     BEGIN\r
1238       CALL CSTM.ELLIST.OUT; (* un voyageur a composte son billet\r
1239                                et sort de la file du composteur*)\r
1240       call EFFACE_VOYAGEUR(500-COMPTEUR*10,110);\r
1241       COMPTEUR:= COMPTEUR-1;\r
1242       SERVICETIME:=RANDOM*4+nb4;\r
1243       CALL HOLD(SERVICETIME);\r
1244       (* on attends le temps passe pour composter le billet *)\r
1245       CSTM.NUMGUICHET := RANDOM * 4 + 1; (* 4 = nombre de quais *)\r
1246       while (TAB_STOPQ(CSTM.NUMGUICHET) ) do\r
1247         call HOLD(1);\r
1248         CSTM.NUMGUICHET := RANDOM *4 +1;\r
1249       od;\r
1250       (* le voyageur va sur le bon quai *)\r
1251       CASE CSTM.NUMGUICHET\r
1252         when 1 : (* QUAI 1 *)\r
1253                  nbvoyageurQ1 := nbvoyageurQ1 + 1;\r
1254                  call affiche_VOYAGEUR(100+CPTQU1*20,155);\r
1255                  CPTQU1:=CPTQU1+1;\r
1256         when 2 : (* QUAI 2 *)\r
1257                  nbvoyageurQ2 := nbvoyageurQ2 + 1;\r
1258                  call affiche_VOYAGEUR(100+CPTQU2*20,205);\r
1259                  CPTQU2:=CPTQU2+1;\r
1260         when 3 :(* QUAI 3 *)\r
1261                  nbvoyageurQ3 := nbvoyageurQ3 + 1;\r
1262                  call affiche_VOYAGEUR(100+CPTQU3*20,255);\r
1263                  CPTQU3:=CPTQU3+1;\r
1264         when 4 :(* QUAI 4*)\r
1265                  nbvoyageurQ4 := nbvoyageurQ4 + 1;\r
1266                  call affiche_VOYAGEUR(100+CPTQU4*20,305);\r
1267                  CPTQU4:=CPTQU4+1;\r
1268       ESAC;\r
1269     END SERVICE;\r
1270   END COMPOSTEUR;\r
1271  \r
1272 \r
1273   UNIT GUICHET:TILL CLASS(NUMBER:INTEGER);\r
1274     VAR SERVICETIME:REAL;\r
1275     UNIT VIRTUAL SERVICE:PROCEDURE;\r
1276     (* service dispense au guichet de la gare*)\r
1277     BEGIN\r
1278       case CSTM.NUMGUICHET\r
1279         when 1: call EFFACE_VOYAGEUR(90+COMPTEUR*10,10);\r
1280         when 2: call EFFACE_VOYAGEUR(90+COMPTEUR*10,33);\r
1281         when 3: call EFFACE_VOYAGEUR(90+COMPTEUR*10,54);\r
1282         when 4: call EFFACE_VOYAGEUR(90+COMPTEUR*10,75);\r
1283       esac;\r
1284       CALL CSTM.ELLIST.OUT; (* sort de la file du guichet *)\r
1285       COMPTEUR := COMPTEUR -1;\r
1286       SERVICETIME:=RANDOM*4+10;  (*augmente temps du guichet*)\r
1287       CALL HOLD(SERVICETIME); \r
1288       (* attend le temp du service au guichet *)\r
1289       CSTM.NUMGUICHET:=5; (* 5 = COMPOSTEUR *)\r
1290       CALL CSTM.ARRIVAL(COMPOSTBOX);\r
1291       (* le voyageur va au composteur *)\r
1292     END SERVICE;\r
1293   END GUICHET;\r
1294       UNIT GENERATORVOYAGEUR:SIMPROCESS CLASS(nb1,nb2 : integer);\r
1295       (* VOYAGEURS GENERATION *)\r
1296            VAR nbvoyageurs,wtime : integer;\r
1297       BEGIN\r
1298         DO\r
1299           call move(500,100);\r
1300           call color(12);\r
1301           call outstring("TEMPS:");\r
1302           call EFFACE_chiffre(550,100);\r
1303           call color(12);\r
1304           call ecrit_chiffre(TIME,550,100);\r
1305                                         \r
1306           call SCHEDULE(NEW GAREVOYAGEUR(RANDOM*100+1),TIME);\r
1307           nbvoyageurs := nbvoyageurs+1;\r
1308           (* temps d'attente entre la generation deux voyageurs *)\r
1309           call HOLD(RANDOM * nb1);\r
1310  \r
1311           call move(500,100);\r
1312           call color(12);\r
1313           call outstring("TEMPS:");\r
1314           call EFFACE_chiffre(550,100);\r
1315           call color(12);\r
1316           call ecrit_chiffre(TIME,550,100);\r
1317  \r
1318           call SCHEDULE(NEW GAREVOYAGEUR(RANDOM*100+1),TIME);\r
1319           nbvoyageurs := nbvoyageurs+1;\r
1320           (* temps d'attente entre la generation de deux voyageurs *)\r
1321           call HOLD(RANDOM * nb2);\r
1322         OD\r
1323       END GENERATORVOYAGEUR;\r
1324  \r
1325       UNIT GENERATORTRAIN:SIMPROCESS CLASS(nb3 : integer,numquai :integer);\r
1326       (* TRAIN GENERATION *)\r
1327            VAR nbtrains,wtime: integer;\r
1328       BEGIN\r
1329         DO\r
1330           call move(500,100);\r
1331           call color(12);\r
1332           call outstring("TEMPS:");\r
1333           call EFFACE_chiffre(550,100);\r
1334           call color(12);\r
1335           call ecrit_chiffre(TIME,550,100);\r
1336  \r
1337           call SCHEDULE(NEW GARETRAIN(numquai),TIME);\r
1338           nbtrains := nbtrains + 1;\r
1339         (* temps d'attente entre la generation de deux trains*)\r
1340           call HOLD(RANDOM * nb3);\r
1341         OD\r
1342       END GENERATORTRAIN;\r
1343    \r
1344 \r
1345   UNIT GAREVOYAGEUR:VOYAGEUR CLASS(NO:INTEGER);\r
1346     VAR ARRIVALTIME,STAYTIME:REAL,CHOISIRGUICHET:INTEGER;\r
1347   BEGIN\r
1348     I:=I+1;\r
1349     K:=I;\r
1350     ARRIVALTIME:=TIME;\r
1351     CHOISIRGUICHET:=RANDOM*nombreguichets +1;\r
1352     NUMGUICHET := CHOISIRGUICHET;\r
1353     (* un voyageur va a un guichet de la gare *)\r
1354     CALL ARRIVAL(GUICHETS(CHOISIRGUICHET));\r
1355     STAYTIME:=TIME-ARRIVALTIME;\r
1356   END GAREVOYAGEUR;\r
1357  \r
1358   UNIT GARETRAIN:TRAIN CLASS(numquai : integer);\r
1359     VAR ARRIVALTIME,STAYTIME:REAL;\r
1360   BEGIN\r
1361     ARRIVALTIME:=TIME;\r
1362     (* un train arrive en gare sur un quai *)\r
1363     CALL ARRIVAL(numquai);\r
1364     STAYTIME:=TIME-ARRIVALTIME;\r
1365   END GARETRAIN;\r
1366       \r
1367   VAR COMPOSTBOX:COMPOSTEUR,I:INTEGER,dur : integer;\r
1368   VAR nombreguichets, nbvoyageurs, nbtrains :integer;\r
1369   VAR GUICHETS:ARRAYOF GUICHET;\r
1370   var nb1,nb2,nb3,nb4,billcomp1,billcomp2,billcomp3,pourcent : integer;  \r
1371  \r
1372 \r
1373 BEGIN   (* NEW GARE DEPARTMENT GENERATION *)\r
1374     call param(dur,affluence);\r
1375     call color(14);\r
1376     call move(3,130);\r
1377     call outstring("     La duree est de : ");call color(15);\r
1378     case dur\r
1379       when 10:call outstring("1 min");\r
1380       when 20:call outstring("2 min");\r
1381       when 30:call outstring("3 min");\r
1382       when 40:call outstring("4 min");\r
1383       when 50:call outstring("5 min");\r
1384       when 60:call outstring("6 min");\r
1385       when 70:call outstring("7 min");\r
1386       when 80:call outstring("8 min");\r
1387       when 90:call outstring("9 min");\r
1388     esac;\r
1389     call color(14);\r
1390     call outstring(" et le type est : ");call color(15);\r
1391     case affluence\r
1392       when 1:call outstring("Nuit");\r
1393       when 2:call outstring("Jour");\r
1394       when 3:call outstring("Dense");\r
1395     esac;\r
1396 \r
1397     case affluence\r
1398          when 1 :nb1:=40; nb2:=35;\r
1399                  nb3:= 1200;nb4:=2;nombreguichets := 2;\r
1400                  call move(100,52);\r
1401                  call color(11);\r
1402                  call outstring("FERMEE");\r
1403                  call move(100,73);\r
1404                  call color(12);\r
1405                  call outstring("FERMEE");\r
1406                         \r
1407          when 2 :nb1:=26; nb2:=27; nb3:= 400;nb4:=5;\r
1408                  nombreguichets := 3;\r
1409                  call move(100,73);\r
1410                  call color(12);\r
1411                  call outstring("FERMEE");\r
1412         \r
1413          when 3 :nb1:=10; nb2:=12; nb3:= 400;nb4:=5;\r
1414                  nombreguichets := 4;\r
1415     esac;\r
1416     COMPOSTBOX:=NEW COMPOSTEUR(NEW HEAD); (* creation du composteur *)\r
1417     ARRAY GUICHETS DIM(1:nombreguichets);  (* WE DEAL WITH 5 TELLES *)\r
1418     (* creation des guichets *)\r
1419     FOR I:=1 TO nombreguichets DO\r
1420          GUICHETS(I):=NEW GUICHET(NEW HEAD,I);\r
1421     OD;\r
1422     I:=0;\r
1423 \r
1424 END GAREDEPARTMENT;\r
1425 \r
1426   var gauche,droit,centre,rep,rep1,choix:boolean,\r
1427       affluence,i : integer;\r
1428   VAR CPTQU1,CPTQU2,CPTQU3,CPTQU4 : integer;\r
1429   VAR TAB_STOPQ : ARRAYOF boolean;\r
1430  \r
1431  \r
1432  \r
1433  BEGIN (* OF PROGRAM *)\r
1434     ARRAY TAB_STOPQ DIM(1:4);\r
1435     TAB_STOPQ(1):= false;\r
1436     TAB_STOPQ(2):= false;\r
1437     TAB_STOPQ(3):= false;\r
1438     TAB_STOPQ(4):= false;\r
1439     i:= exec(unpack("new-1.exe"));\r
1440     droit:=FALSE;\r
1441     centre:=FALSE;\r
1442     gauche:=FALSE;\r
1443     call HPAGE(0,0,0);\r
1444     call HPAGE(0,639,639);\r
1445     call GRON(0);\r
1446     choix:=TRUE;\r
1447     call presentation;\r
1448     while (choix) do \r
1449     PREF GAREDEPARTMENT BLOCK\r
1450          VAR generatecli : GENERATORVOYAGEUR; \r
1451          VAR generatetr1,  generatetr2, generatetr3,generatetr4: GENERATORTRAIN;    \r
1452     BEGIN\r
1453         call gar;\r
1454         (* creation du generateur de voyageurs *)\r
1455         generatecli := NEW GENERATORVOYAGEUR(nb1,nb2);\r
1456         call SCHEDULE(generatecli,TIME);\r
1457         (* creation du generateur de trains pour le quai 1*)\r
1458         generatetr1 := NEW GENERATORTRAIN(nb3,1);\r
1459         call SCHEDULE(generatetr1,TIME);\r
1460         (* creation du generateur de trains pour le quai 2 *)\r
1461         generatetr2 := NEW GENERATORTRAIN(nb3,2);\r
1462         call SCHEDULE(generatetr2,TIME);\r
1463         (* creation du generateur de trains pour le quai 3 *)\r
1464         generatetr3 := NEW GENERATORTRAIN(nb3,3);\r
1465         call SCHEDULE(generatetr3,TIME);\r
1466         (* creation du generateur de trains pour le quai 4 *)\r
1467         generatetr4 := NEW GENERATORTRAIN(nb3,4);\r
1468         call SCHEDULE(generatetr4,TIME);\r
1469                 \r
1470         call HOLD (dur * 10);\r
1471  \r
1472         rep1:=msgbox("Voulez-vous les statistiques sur la simulation ?",48,14,100,200);\r
1473         if (rep1) then\r
1474                 call cls;\r
1475         call move(150,10);\r
1476         call color(13);\r
1477         call outstring("CHER UTILISATEUR VOICI LES STATISTIQUES !!!");\r
1478         call move(120,40);\r
1479         call color(3);\r
1480         call outstring("le nombre total de voyageurs est de ");\r
1481         call color(11);\r
1482         call ecrit_chiffre(generatecli.nbvoyageurs,420,40);\r
1483         call move(20,70);\r
1484         call color(3);\r
1485         call outstring("le nombre total de trains sur le quai 1 est de");\r
1486         call color(11);\r
1487         call ecrit_chiffre(generatetr1.nbtrains,420,70);\r
1488         call move(20,90);\r
1489         call color(3);\r
1490         call outstring("le nombre total de trains sur le quai 2 est de");\r
1491         call color(11);\r
1492         call ecrit_chiffre(generatetr2.nbtrains,420,90);\r
1493         call move(20,110);\r
1494         call color(3);\r
1495         call outstring("le nombre total de trains sur le quai 3 est de");\r
1496         call color(11);\r
1497         call ecrit_chiffre(generatetr3.nbtrains,420,110);\r
1498         call move(20,130);\r
1499         call color(3);\r
1500         call outstring("le nombre total de trains sur le quai 4 est de");\r
1501         call color(11);\r
1502         call ecrit_chiffre(generatetr4.nbtrains,420,130);\r
1503         call move(120,170);\r
1504         call color(3);\r
1505         call outstring("total voyageurs du quai1 est de ");\r
1506         call color(11);\r
1507         call ecrit_chiffre(COMPOSTBOX.nbvoyageurQ1,420,170);\r
1508         call move(120,190);\r
1509         call color(3);\r
1510         call outstring("total voyageurs du quai2 est de ");\r
1511         call color(11);\r
1512         call ecrit_chiffre(COMPOSTBOX.nbvoyageurQ2,420,190);\r
1513         call move(120,210);\r
1514         call color(3);\r
1515         call outstring("total voyageurs du quai3 est de ");\r
1516         call color(11);\r
1517         call ecrit_chiffre(COMPOSTBOX.nbvoyageurQ3,420,210);\r
1518         call move(120,230);\r
1519         call color(3);\r
1520         call outstring("total voyageurs du quai4 est de ");\r
1521         call color(11);\r
1522         call ecrit_chiffre(COMPOSTBOX.nbvoyageurQ4,420,230);\r
1523         call move(60,280);\r
1524         call color(3);\r
1525         call outstring("total voyageurs ayant compost\82s leur billet :  ");\r
1526         call color(11);\r
1527         billcomp1 := COMPOSTBOX.nbvoyageurQ1+COMPOSTBOX.nbvoyageurQ2;\r
1528         billcomp2 := COMPOSTBOX.nbvoyageurQ3+COMPOSTBOX.nbvoyageurQ4;\r
1529         billcomp3:=billcomp1+billcomp2;\r
1530         \r
1531         call ecrit_chiffre(billcomp3,420,280);\r
1532                 pourcent:=100-((100*billcomp3)DIV generatecli.nbvoyageurs);\r
1533                 IF (pourcent >= 30) THEN\r
1534                 call move(70,300);\r
1535                 call color(10);\r
1536                 call outstring("       REMARQUE : Il serait utile de rajouter un composteur");\r
1537                 FI;\r
1538                 call PAUSE;\r
1539                 \r
1540         fi;\r
1541         choix:=msgbox("VOULEZ-VOUS CONTINUER (O/N)?",30,14,200,175);\r
1542         call cls;\r
1543         TAB_STOPQ(1):= false;\r
1544         TAB_STOPQ(2):= false;\r
1545         TAB_STOPQ(3):= false;\r
1546         TAB_STOPQ(4):= false;\r
1547         \r
1548      END;\r
1549     od;\r
1550     call color(14);\r
1551     call move(65,150);\r
1552     call outstring("     MERCI POUR L'UTILISATION DE CETTE SUPERBE APPLICATION");\r
1553     call move(250,320);\r
1554     call outstring("VEUILLEZ PATIENTER");\r
1555     call attend_sortie;\r
1556     call GROFF;\r
1557     END;\r
1558 END gar;\r
1559 (****************************\r
1560 ************************************************)\r
1561  \r