3 (* DEFINITION DE LA PAGE GRAPHIQUE GENERALE *)
\r
9 (* PROCEDURE PAUSE POUR ATTENTE AU CLAVIER *)
\r
11 UNIT PAUSE:procedure;
\r
16 call outstring(" Appuyer sur ENTREE pour passer a la suite");
\r
20 (* PROCEDURE D ATTENTE PAR BOUCLE ACTIVE *)
\r
22 UNIT attend:procedure(tmp:integer);
\r
25 for i:=0 to tmp * 10 do od;
\r
28 (* PROCEDURE D ATTENTE AVEC COMPTEUR POUR LA SORTIE DE L APPLICATION *)
\r
30 UNIT attend_sortie:procedure;
\r
31 VAR x,y,i,k,j:integer;
\r
40 for i:=0 to 4000 do od;
\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
50 (* PAGE DE PRESENTATION GENERALE DE DEBUT *)
\r
52 UNIT presentation:iiuwgraph procedure;
\r
54 (* creation d'une bordure*)
\r
57 (*creation d'un cadre pour la fenetre*)
\r
60 call draw( 628,340);
\r
65 (*contenu du titre*)
\r
67 call outstring("IMPLEMENTATION D'UNE SIMULATION");
\r
69 call outstring("DE GARE SNCF");
\r
72 call outstring("PROJET NUMERO 2");
\r
75 call outstring("PAR : Mr AC'H Fabrice et CLAVERIE Jean-Fran
\87ois");
\r
77 call outstring(" Mr GOUGEON Jean-Yves et Mr RICHARD Jerome");
\r
79 (*appel de la procedure pause pour passer a la suite*)
\r
82 (*appel de l'effacage de l'ecran*)
\r
86 (* FONCTION DEFINISSANT UNE MESSAGE-BOX *)
\r
87 (* ARGUMENTS : Text_message, Longueur_message, Couleur_text, Coordonnees *)
\r
89 UNIT msgbox : function(message:string,long,couleur,x,y:integer):boolean;
\r
90 VAR centrage:integer,reponse:boolean,
\r
96 (* si texte petit met longueur a 6 par defaut *)
\r
97 if(long<6) then long:=6; fi;
\r
100 call color(couleur);
\r
101 call rectangle_double(x,y,x+(long * 9 + 20)+2,y + 52);
\r
103 (* centrage du texte dans le rectangle *)
\r
104 centrage:=((long * 9+20) div 2) - ((long div 2)*8);
\r
106 for i:=(y + 3) to (y+49) do
\r
109 call draw(x+(long * 9) +19 ,i);
\r
111 call color(couleur);
\r
112 call move(x+centrage,y+5);
\r
113 call outstring(message);
\r
116 (* definition des boutons OUI et NON *)
\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
126 call getpress(0,h,v,b,gauche,droit,centre);
\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
132 if((h>(x+(long * 9)-centrage +1))and(h<(x+(long * 9)-centrage +26)))
\r
133 then reponse:=false;gauche:=false; exit;
\r
144 (* PROCEDURE DE TRACAGE DE RECTANGLE SIMPLE *)
\r
146 UNIT rectangle:iiuwgraph procedure(x_h,y_h,x_b,y_b:integer);
\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
155 (* PROCEDURE DE TRACAGE DE RECTANGLE DOUBLE AVEC RECTANGLE SIMPLE *)
\r
157 UNIT rectangle_double : iiuwgraph procedure(x_h,y_h,x_b,y_b:integer);
\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
163 (* PROCEDURE DE CHOIX DES PARAMETRES DE LA SIMULATION *)
\r
164 (* RENVOIE LA DUREE ET LE TYPE DE SIMULATION *)
\r
166 UNIT param : iiuwgraph procedure(inout duree,typ :integer);
\r
167 VAR haut,bas:boolean,h,v,b:integer;
\r
172 (*initialisation *)
\r
180 call outstring(" CHER UTILISATEUR CHOISISSEZ UNE DUREE PARMI :");
\r
181 call rectangle_double(100,60,550,100);
\r
183 (* fait les bares verticales *)
\r
201 (* fin bare verticales *)
\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
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
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
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
234 (* definition de la souris *)
\r
236 while(haut or bas) do
\r
237 call getpress(0,h,v,b,gauche,droit,centre);
\r
239 if(h>100 and h<550) then
\r
242 if(v>60 and v<100) then
\r
243 if(h>100 and h<150) then duree:=10;
\r
247 call outstring("1 min");
\r
251 call outstring("1 min");
\r
253 if(h>150 and h<200) then duree:=20;
\r
257 call outstring("2 min");
\r
261 call outstring("2 min");
\r
264 if(h>200 and h<250) then duree:=30;
\r
268 call outstring("3 min");
\r
272 call outstring("3 min");
\r
275 if(h>250 and h<300) then duree:=40;
\r
279 call outstring("4 min");
\r
283 call outstring("4 min");
\r
286 if(h>300 and h<350) then duree:=50;
\r
290 call outstring("5 min");
\r
294 call outstring("5 min");
\r
297 if(h>350 and h<400) then duree:=60;
\r
301 call outstring("6 min");
\r
305 call outstring("6 min");
\r
308 if(h>400 and h<450) then duree:=70;
\r
312 call outstring("7 min");
\r
316 call outstring("7 min");
\r
319 if(h>450 and h<500) then duree:=80;
\r
323 call outstring("8 min");
\r
327 call outstring("8 min");
\r
330 if (h>500 and h<550) then duree:=90;
\r
334 call outstring("9 min");
\r
338 call outstring("9 min");
\r
340 fi;fi;fi;fi;fi;fi;fi;fi;fi;
\r
345 if(v>170 and v<210) then
\r
346 if (h>100 and h<250) then typ:=1;
\r
349 call move(121,184);
\r
350 call outstring(" Nuit");
\r
353 call move(121,184);
\r
354 call outstring(" Nuit");
\r
357 if (h>250 and h<400) then typ:=2;
\r
360 call move(275,184);
\r
361 call outstring(" Jour");
\r
364 call move(275,184);
\r
365 call outstring(" Jour");
\r
367 if (h>400 and h<550) then typ:=3;
\r
370 call move(425,184);
\r
371 call outstring(" Dense");
\r
374 call move(425,184);
\r
375 call outstring(" Dense");
\r
386 call move(100,300);
\r
387 call outstring(" La duree sera de : ");call color(15);
\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
400 call outstring(" et le type sera : ");call color(15);
\r
402 when 1:call outstring("Nuit");
\r
403 when 2:call outstring("Jour");
\r
404 when 3:call outstring("Dense");
\r
412 (* PROCEDURE D ECRITURE D UN ENTIER A L ECRAN *)
\r
413 (* PARAMETRES TEMPS:REAL et COORDONNEES *)
\r
415 UNIT ecrit_chiffre : procedure(TIME:real,x,y:integer);
\r
416 VAR wtime :integer;
\r
420 wtime:=entier(TIME);
\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
427 call HASCII(wtime div 10 + 48);
\r
428 call HASCII(wtime mod 10 + 48);
\r
431 (* PROCEDURE D EFFACEMENT DU CHIFFRE ECRIT *)
\r
433 UNIT EFFACE_chiffre : procedure(x,y:integer);
\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
442 (* PROCEDURE DE TRACAGE DES VOIES *)
\r
444 UNIT voie:iiuwgraph procedure;
\r
447 call rectangle_double(4,170,635,176);
\r
448 call rectangle_double(5,171,634,175);
\r
451 call outstring("QUAI 1");
\r
453 call rectangle(4,177,635,195);
\r
455 call rectangle_double(4,220,635,226);
\r
456 call rectangle_double(5,221,634,225);
\r
459 call outstring("QUAI 2");
\r
461 call rectangle(4,227,635,245);
\r
463 call rectangle_double(4,270,635,276);
\r
464 call rectangle_double(5,271,634,275);
\r
467 call outstring("QUAI 3");
\r
469 call rectangle(4,277,635,295);
\r
471 call rectangle_double(4,320,635,326);
\r
472 call rectangle_double(5,321,634,325);
\r
475 call outstring("QUAI 4");
\r
477 call rectangle(4,327,635,345);
\r
480 (* PROCEDURE DE TRACAGE DES CAISSES *)
\r
482 UNIT caisse : iiuwgraph procedure;
\r
487 call rectangle_double(10,3,80,23);
\r
490 call rectangle_double(10,26,80,43);
\r
493 call rectangle_double(10,47,80,65);
\r
496 call rectangle_double(10,68,80,86);
\r
501 call outstring("Caisse 1");
\r
504 call outstring("Caisse 2");
\r
507 call outstring("Caisse 3");
\r
510 call outstring("Caisse 4");
\r
513 (* PROCEDURE D ECRITURE DES MESSAGES D ARRIVEE DES TRAIN DANS TABLEAU *)
\r
515 UNIT mes_train :procedure(num:integer);
\r
521 call outstring("le train quai 1 arrive");
\r
525 call outstring("le train quai 2 arrive");
\r
529 call outstring("le train quai 3 arrive");
\r
533 call outstring("le train quai 4 arrive");
\r
538 UNIT mes_train_rep :procedure(num:integer);
\r
544 call outstring("le train quai 1 REPART");
\r
548 call outstring("le train quai 2 REPART");
\r
552 call outstring("le train quai 3 REPART");
\r
556 call outstring("le train quai 4 REPART");
\r
561 UNIT eff_mestrn:procedure(num:integer);
\r
567 call outstring("le train quai 1 arrive");
\r
570 call outstring("le train quai 2 arrive");
\r
573 call outstring("le train quai 3 arrive");
\r
576 call outstring("le train quai 4 arrive");
\r
581 UNIT eff_mestrn_rep:procedure(num:integer);
\r
587 call outstring("le train quai 1 REPART");
\r
590 call outstring("le train quai 2 REPART");
\r
593 call outstring("le train quai 3 REPART");
\r
596 call outstring("le train quai 4 REPART");
\r
599 END eff_mestrn_rep;
\r
601 (* PROCEDURE DE TRACAGE DES TRAINS *)
\r
603 UNIT DESSINE_TRAIN : procedure(num,deplacement :integer);
\r
604 VAR wdepl,wbdepl:integer;
\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
614 call rectangle_double(wdepl,179,wbdepl,193);
\r
617 call rectangle_double(wdepl,229,wbdepl,243);
\r
620 call rectangle_double(wdepl,279,wbdepl,293);
\r
623 call rectangle_double(wdepl,329,wbdepl,343);
\r
628 UNIT EFFACE_TRAIN : iiuwgraph procedure(num,deplacement :integer);
\r
629 VAR wdepl,wbdepl :integer;
\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
638 call rectangle_double(wdepl,179,wbdepl,193);
\r
640 call rectangle_double(wdepl,229,wbdepl,243);
\r
642 call rectangle_double(wdepl,279,wbdepl,293);
\r
644 call rectangle_double(wdepl,329,wbdepl,343);
\r
648 UNIT arrive_TRAIN:procedure(num:integer);
\r
649 VAR indice,temp:integer;
\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
656 call DESSINE_TRAIN(num,indice);
\r
659 UNIT REPART_TRAIN:procedure(num:integer);
\r
660 VAR indice,temp:integer;
\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
668 call eff_mestrn_rep(num);
\r
671 (* PROCEDURE DE TRACAGE DU TABLEAU DES ARRIVEES *)
\r
673 UNIT tableau : iiuwgraph procedure;
\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
685 call outstring("Quai 1");
\r
688 call outstring("Quai 2");
\r
691 call outstring("Quai 3");
\r
694 call outstring("Quai 4");
\r
698 (* PROCEDURE DE TRACAGE DES VOYAGEURS *)
\r
700 UNIT VOYAGEUR:iiuwgraph procedure(x,y:integer);
\r
704 call draw(x-2,y+10);
\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
715 UNIT affiche_VOYAGEUR:iiuwgraph procedure(x,y:integer);
\r
718 call VOYAGEUR(x,y);
\r
719 END affiche_VOYAGEUR;
\r
721 UNIT EFFACE_VOYAGEUR:iiuwgraph procedure(x,y:integer);
\r
724 call VOYAGEUR(x,y);
\r
725 END EFFACE_VOYAGEUR;
\r
727 (* PROCEDURE D AFFICHAGE DE LA GARE *)
\r
729 UNIT gar:iiuwgraph procedure;
\r
733 call rectangle_double(0,0,639,349);
\r
740 (* PROCEDURE DE TRACAGE DU COMPOSTEUR *)
\r
742 UNIT composteuse : iiuwgraph procedure;
\r
746 call draw(460,125);
\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
754 UNIT PRIORITYQUEUE: CLASS;
\r
755 (* HEAP AS BINARY LINKED TREE WITH FATHER LINK*)
\r
757 UNIT QUEUEHEAD: CLASS;
\r
758 (* HEAP ACCESING MODULE *)
\r
759 VAR LAST,ROOT:NODE;
\r
761 UNIT MIN: FUNCTION: ELEM;
\r
763 IF ROOT=/= NONE THEN RESULT:=ROOT.EL FI;
\r
766 UNIT INSERT: PROCEDURE(R:ELEM);
\r
767 (* INSERTION INTO HEAP *)
\r
773 ROOT.LEFT,ROOT.RIGHT,LAST:=ROOT
\r
789 LAST.LEFT.RIGHT:=X;
\r
794 CALL CORRECT(R,FALSE)
\r
797 UNIT DELETE: PROCEDURE(R: ELEM);
\r
814 LAST.NS:= LAST.NS-1;
\r
817 IF X.LESS(X.UP) THEN CALL CORRECT(X.EL,FALSE)
\r
818 ELSE CALL CORRECT(X.EL,TRUE) FI;
\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
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
832 IF Z.LESS(X) THEN FIN:=TRUE ELSE
\r
843 IF X=NONE THEN LOG:=TRUE ELSE LOG:=X.LESS(Z); FI;
\r
852 IF X=NONE THEN LOG:=TRUE ELSE LOG:=X.LESS(Z);
\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
865 IF X= NONE THEN RESULT:=FALSE
\r
866 ELSE RESULT:=EL.LESS(X.EL) FI;
\r
870 UNIT ELEM: CLASS(PRIOR:REAL);
\r
871 (* PREFIX OF INFORMATION TO BE STORED IN NODE *)
\r
873 UNIT VIRTUAL LESS: FUNCTION(X:ELEM):BOOLEAN;
\r
875 IF X=NONE THEN RESULT:= FALSE ELSE
\r
876 RESULT:= PRIOR< X.PRIOR FI;
\r
879 LAB:= NEW NODE(THIS ELEM);
\r
884 UNIT SIMULATION: PRIORITYQUEUE CLASS;
\r
885 (* THE LANGUAGE FOR SIMULATION PURPOSES *)
\r
887 VAR CURR: SIMPROCESS, (*ACTIVE PROCESS *)
\r
888 PQ:QUEUEHEAD, (* THE TIME AXIS *)
\r
889 MAINPR: MAINPROGRAM;
\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
900 UNIT IDLE: FUNCTION: BOOLEAN;
\r
902 RESULT:= EVENT= NONE;
\r
905 UNIT TERMINATED: FUNCTION :BOOLEAN;
\r
910 UNIT EVTIME: FUNCTION: REAL;
\r
911 (* TIME OF ACTIVATION *)
\r
913 IF IDLE THEN CALL ERROR1;
\r
915 RESULT:= EVENT.EVENTTIME;
\r
918 UNIT ERROR1:PROCEDURE;
\r
921 call outstring(" AN ATTEMPT TO ACCESS AN IDLE PROCESS TIME");
\r
924 UNIT ERROR2:PROCEDURE;
\r
927 call outstring(" AN ATTEMPT TO ACCESS A TERMINATED PROCESS TIME");
\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
943 UNIT VIRTUAL LESS: FUNCTION(X: EVENTNOTICE):BOOLEAN;
\r
944 (* OVERWRITE THE FORMER VERSION CONSIDERING EVENTTIME *)
\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
952 UNIT MAINPROGRAM: SIMPROCESS CLASS;
\r
953 (* IMPLEMENTING MASTER PROGRAM AS A PROCESS *)
\r
955 DO ATTACH(MAIN) OD;
\r
958 UNIT TIME:FUNCTION:REAL;
\r
959 (* CURRENT VALUE OF SIMULATION TIME *)
\r
961 RESULT:=CURRENT.EVTIME
\r
964 UNIT CURRENT: FUNCTION: SIMPROCESS;
\r
965 (* THE FIRST PROCESS ON THE TIME AXIS *)
\r
970 UNIT SCHEDULE: PROCEDURE(P:SIMPROCESS,T:REAL);
\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
978 IF P.IDLE (* P HAS ALREADY BEEN SCHEDULED *) THEN
\r
979 P.EVENT:= P.EVENTAUX;
\r
980 P.EVENT.PRIOR:=RANDOM;
\r
982 (* NEW SCHEDULING *)
\r
983 P.EVENT.PRIOR:=RANDOM;
\r
984 CALL PQ.DELETE(P.EVENT)
\r
986 P.EVENT.EVENTTIME:= T;
\r
987 CALL PQ.INSERT(P.EVENT) FI;
\r
990 UNIT HOLD:PROCEDURE(T:REAL);
\r
991 (* MOVE THE ACTIVE PROCESS T MINUTES BACK ALONG PQ *)
\r
992 (* REDEFINE PRIOR *)
\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
1002 UNIT PASSIVATE: PROCEDURE;
\r
1003 (* REMOVE THE ACTVE PROCESS FROM PQ AND ACTIVATE THE NEXT ONE *)
\r
1005 CALL PQ.DELETE(CURRENT.EVENT);
\r
1006 CURRENT.EVENT:=NONE;
\r
1007 CALL CHOICEPROCESS
\r
1010 UNIT RUN: PROCEDURE(P:SIMPROCESS);
\r
1011 (* ACTIVATE P IMMEDIATELY AND DELAY THE FORMER FIRST PROCESS BY REDEFINING*)
\r
1014 CURRENT.EVENT.PRIOR:=RANDOM;
\r
1015 IF NOT P.IDLE THEN
\r
1017 P.EVENT.EVENTTIME:=TIME;
\r
1018 CALL PQ.CORRECT(P.EVENT,FALSE)
\r
1020 IF P.EVENTAUX=NONE THEN
\r
1021 P.EVENT,P.EVENTAUX:=NEW EVENTNOTICE(0);
\r
1022 P.EVENT.EVENTTIME:=TIME;
\r
1024 CALL PQ.INSERT(P.EVENT)
\r
1026 P.EVENT:=P.EVENTAUX;
\r
1028 P.EVENT.EVENTTIME:=TIME;
\r
1030 CALL PQ.INSERT(P.EVENT);
\r
1032 CALL CHOICEPROCESS;
\r
1035 UNIT CANCEL:PROCEDURE(P: SIMPROCESS);
\r
1036 (* REMOVE PROCESS P FROM PQ AND CONTINUE SIMULATION *)
\r
1038 IF P= CURRENT THEN CALL PASSIVATE ELSE
\r
1039 CALL PQ.DELETE(P.EVENT);
\r
1040 P.EVENT:=NONE; FI;
\r
1043 UNIT CHOICEPROCESS:PROCEDURE;
\r
1044 (* CHOISIR THE FIRST PROCESS FROM PQ TO BE ACTIVATED *)
\r
1048 CURR:= PQ.MIN QUA EVENTNOTICE.PROC;
\r
1050 WRITE(" ERROR IN THE HEAP"); WRITELN;
\r
1052 ELSE ATTACH(CURR); FI;
\r
1053 END CHOICEPROCESS;
\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
1067 UNIT LISTS:SIMULATION CLASS;
\r
1068 (* WE WISH TO USE LISTS FOR QUEUEING PROCESSES DURING SIMULATION*)
\r
1070 UNIT LINKAGE:CLASS;
\r
1071 (*WE WILL USE TWO WAY LISTS *)
\r
1072 VAR SUC1,PRED1:LINKAGE;
\r
1075 UNIT HEAD:LINKAGE CLASS;
\r
1076 (* EACH LIST WILL HAVE ONE ELEMENT ESTABLISHED *)
\r
1077 UNIT FIRST:FUNCTION:LINK;
\r
1079 IF SUC1 IN LINK THEN RESULT:=SUC1
\r
1084 UNIT EMPTY:FUNCTION:BOOLEAN;
\r
1086 RESULT:=SUC1=THIS LINKAGE;
\r
1089 SUC1,PRED1:=THIS LINKAGE;
\r
1092 UNIT LINK:LINKAGE CLASS;
\r
1093 (* ORDINARY LIST ELEMENT PREFIX *)
\r
1094 UNIT OUT:PROCEDURE;
\r
1096 IF SUC1=/=NONE THEN
\r
1097 SUC1.PRED1:=PRED1;
\r
1102 UNIT INTO:PROCEDURE(S:HEAD);
\r
1106 IF S.SUC1=/=NONE THEN
\r
1109 PRED1.SUC1:=THIS LINKAGE;
\r
1110 S.PRED1:=THIS LINKAGE;
\r
1116 UNIT ELEM:LINK CLASS(SPROCESS:SIMPROCESS);
\r
1117 (* USER DEFINED PROCESS WILL BE JOINED INTO LISTS *)
\r
1122 UNIT GARE:LISTS CLASS; (*AN GARE*)
\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
1130 VAR CSTM:VOYAGEUR, (*THE VOYAGEUR BEING SERVED*)
\r
1132 COMPTEUR : INTEGER;
\r
1137 REST:=REST+TIME-PAUSE;
\r
1138 WHILE NOT QUEUE.EMPTY DO
\r
1139 CSTM:=QUEUE.FIRST QUA ELEM.SPROCESS;
\r
1147 UNIT VOYAGEUR:SIMPROCESS CLASS;
\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
1154 ELLIST:=NEW ELEM(THIS VOYAGEUR);
\r
1155 call ELLIST.INTO(S.QUEUE); (* mit dans la file d'attente*)
\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
1163 S.COMPTEUR:=S.COMPTEUR+1;
\r
1164 IF S.IDLE THEN CALL SCHEDULE(S,TIME); FI;
\r
1170 UNIT TRAIN:SIMPROCESS CLASS;
\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
1176 IF (NOT TAB_STOPQ(QUAI)) THEN
\r
1177 TAB_STOPQ(QUAI):=TRUE;
\r
1180 call arrive_TRAIN(QUAI);
\r
1182 (* DEPLACER TRAIN JUSQU'A DEBUT FILE *)
\r
1183 (* CHARGER VOYAGEUR*)
\r
1188 WHEN 1 :(* QUAI 1 *)
\r
1189 while(CPTQU1>=0) do
\r
1190 call EFFACE_VOYAGEUR(100+CPTQU1*20,155);
\r
1192 call HOLD(RANDOM * 10);
\r
1195 WHEN 2 :(* QUAI 2 *)
\r
1196 while(CPTQU2>=0) do
\r
1197 call EFFACE_VOYAGEUR(100+CPTQU2*20,205);
\r
1199 call HOLD(RANDOM * 11);
\r
1202 WHEN 3 :(* QUAI 3 *)
\r
1203 while(CPTQU3>=0) do
\r
1204 call EFFACE_VOYAGEUR(100+CPTQU3*20,255);
\r
1206 call HOLD(RANDOM * 12);
\r
1209 WHEN 4 :(* QUAI 4 *)
\r
1210 while(CPTQU4>=0) do
\r
1211 call EFFACE_VOYAGEUR(100+CPTQU4*20,305);
\r
1213 call HOLD(RANDOM * 13);
\r
1220 call REPART_TRAIN(QUAI);
\r
1221 TAB_STOPQ(QUAI) := FALSE;
\r
1223 (* le train sort de la gare *)
\r
1230 UNIT GAREDEPARTMENT:GARE CLASS;
\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
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
1248 CSTM.NUMGUICHET := RANDOM *4 +1;
\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
1256 when 2 : (* QUAI 2 *)
\r
1257 nbvoyageurQ2 := nbvoyageurQ2 + 1;
\r
1258 call affiche_VOYAGEUR(100+CPTQU2*20,205);
\r
1260 when 3 :(* QUAI 3 *)
\r
1261 nbvoyageurQ3 := nbvoyageurQ3 + 1;
\r
1262 call affiche_VOYAGEUR(100+CPTQU3*20,255);
\r
1264 when 4 :(* QUAI 4*)
\r
1265 nbvoyageurQ4 := nbvoyageurQ4 + 1;
\r
1266 call affiche_VOYAGEUR(100+CPTQU4*20,305);
\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
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
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
1294 UNIT GENERATORVOYAGEUR:SIMPROCESS CLASS(nb1,nb2 : integer);
\r
1295 (* VOYAGEURS GENERATION *)
\r
1296 VAR nbvoyageurs,wtime : integer;
\r
1299 call move(500,100);
\r
1301 call outstring("TEMPS:");
\r
1302 call EFFACE_chiffre(550,100);
\r
1304 call ecrit_chiffre(TIME,550,100);
\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
1311 call move(500,100);
\r
1313 call outstring("TEMPS:");
\r
1314 call EFFACE_chiffre(550,100);
\r
1316 call ecrit_chiffre(TIME,550,100);
\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
1323 END GENERATORVOYAGEUR;
\r
1325 UNIT GENERATORTRAIN:SIMPROCESS CLASS(nb3 : integer,numquai :integer);
\r
1326 (* TRAIN GENERATION *)
\r
1327 VAR nbtrains,wtime: integer;
\r
1330 call move(500,100);
\r
1332 call outstring("TEMPS:");
\r
1333 call EFFACE_chiffre(550,100);
\r
1335 call ecrit_chiffre(TIME,550,100);
\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
1342 END GENERATORTRAIN;
\r
1345 UNIT GAREVOYAGEUR:VOYAGEUR CLASS(NO:INTEGER);
\r
1346 VAR ARRIVALTIME,STAYTIME:REAL,CHOISIRGUICHET:INTEGER;
\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
1358 UNIT GARETRAIN:TRAIN CLASS(numquai : integer);
\r
1359 VAR ARRIVALTIME,STAYTIME:REAL;
\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
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
1373 BEGIN (* NEW GARE DEPARTMENT GENERATION *)
\r
1374 call param(dur,affluence);
\r
1377 call outstring(" La duree est de : ");call color(15);
\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
1390 call outstring(" et le type est : ");call color(15);
\r
1392 when 1:call outstring("Nuit");
\r
1393 when 2:call outstring("Jour");
\r
1394 when 3:call outstring("Dense");
\r
1398 when 1 :nb1:=40; nb2:=35;
\r
1399 nb3:= 1200;nb4:=2;nombreguichets := 2;
\r
1400 call move(100,52);
\r
1402 call outstring("FERMEE");
\r
1403 call move(100,73);
\r
1405 call outstring("FERMEE");
\r
1407 when 2 :nb1:=26; nb2:=27; nb3:= 400;nb4:=5;
\r
1408 nombreguichets := 3;
\r
1409 call move(100,73);
\r
1411 call outstring("FERMEE");
\r
1413 when 3 :nb1:=10; nb2:=12; nb3:= 400;nb4:=5;
\r
1414 nombreguichets := 4;
\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
1424 END GAREDEPARTMENT;
\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
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
1443 call HPAGE(0,0,0);
\r
1444 call HPAGE(0,639,639);
\r
1447 call presentation;
\r
1449 PREF GAREDEPARTMENT BLOCK
\r
1450 VAR generatecli : GENERATORVOYAGEUR;
\r
1451 VAR generatetr1, generatetr2, generatetr3,generatetr4: GENERATORTRAIN;
\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
1470 call HOLD (dur * 10);
\r
1472 rep1:=msgbox("Voulez-vous les statistiques sur la simulation ?",48,14,100,200);
\r
1475 call move(150,10);
\r
1477 call outstring("CHER UTILISATEUR VOICI LES STATISTIQUES !!!");
\r
1478 call move(120,40);
\r
1480 call outstring("le nombre total de voyageurs est de ");
\r
1482 call ecrit_chiffre(generatecli.nbvoyageurs,420,40);
\r
1485 call outstring("le nombre total de trains sur le quai 1 est de");
\r
1487 call ecrit_chiffre(generatetr1.nbtrains,420,70);
\r
1490 call outstring("le nombre total de trains sur le quai 2 est de");
\r
1492 call ecrit_chiffre(generatetr2.nbtrains,420,90);
\r
1493 call move(20,110);
\r
1495 call outstring("le nombre total de trains sur le quai 3 est de");
\r
1497 call ecrit_chiffre(generatetr3.nbtrains,420,110);
\r
1498 call move(20,130);
\r
1500 call outstring("le nombre total de trains sur le quai 4 est de");
\r
1502 call ecrit_chiffre(generatetr4.nbtrains,420,130);
\r
1503 call move(120,170);
\r
1505 call outstring("total voyageurs du quai1 est de ");
\r
1507 call ecrit_chiffre(COMPOSTBOX.nbvoyageurQ1,420,170);
\r
1508 call move(120,190);
\r
1510 call outstring("total voyageurs du quai2 est de ");
\r
1512 call ecrit_chiffre(COMPOSTBOX.nbvoyageurQ2,420,190);
\r
1513 call move(120,210);
\r
1515 call outstring("total voyageurs du quai3 est de ");
\r
1517 call ecrit_chiffre(COMPOSTBOX.nbvoyageurQ3,420,210);
\r
1518 call move(120,230);
\r
1520 call outstring("total voyageurs du quai4 est de ");
\r
1522 call ecrit_chiffre(COMPOSTBOX.nbvoyageurQ4,420,230);
\r
1523 call move(60,280);
\r
1525 call outstring("total voyageurs ayant compost
\82s leur billet : ");
\r
1527 billcomp1 := COMPOSTBOX.nbvoyageurQ1+COMPOSTBOX.nbvoyageurQ2;
\r
1528 billcomp2 := COMPOSTBOX.nbvoyageurQ3+COMPOSTBOX.nbvoyageurQ4;
\r
1529 billcomp3:=billcomp1+billcomp2;
\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
1536 call outstring(" REMARQUE : Il serait utile de rajouter un composteur");
\r
1541 choix:=msgbox("VOULEZ-VOUS CONTINUER (O/N)?",30,14,200,175);
\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
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
1559 (****************************
\r
1560 ************************************************)
\r