program philos5;
 
       (********************************************************)
       (*        procedure qui efface l'‚cran                  *)
       (********************************************************)
       UNIT NewPage : procedure;
       begin
         write( chr(27), "[2J");
       END Newpage;
 
 
       (********************************************************)
       (* Processus gerant l'‚cran pour chaque philosophe      *)
       (********************************************************)
       UNIT ecran : iiuwgraph process (n : integer);
       const  PI = 3.14159;
       var compteur : integer,
           xf, yf, xa, ya, ra, r, i : integer,
           angle : real;
 
       (********************************************************)
       (*  procedure qui dessine une fourchette … l'‚cran      *)
       (********************************************************)
       UNIT fourchette : procedure(num_phi, o, couleur : integer);
       var r1, r2, r3, r4, x, y : integer,
           angle : real;
       begin
         call color(couleur);
         r1 := 30;
         r2 := 15;
         r3 := 15;
         r4 := 15;
         angle := (num_phi * 2 + o) * PI/5;
         x := round((rt-50) *cos(angle) + xt);
         y := round((rt-50) *sin(angle) + yt);
         call move(x,y);
         call draw(round(r1*cos(angle)+x), round(r1*sin(angle)+y));
         call move(x,y);
         call draw(round(r2*cos(angle+3*PI/4)+x),round(r2*sin(angle+3*PI/4)+y));
         call move(x,y);
         call draw(round(r3*cos(angle-3*PI/4)+x),round(r3*sin(angle-3*PI/4)+y));
         call move(x,y);
         call draw(round(r4*cos(angle+PI)+x),round(r4*sin(angle+PI)+y));
         call color(7);
       END fourchette;
 
 
       (********************************************************)
       (*  procedure qui dessine un guardien … l'‚cran      *)
       (********************************************************)
 
       UNIT Guard :  procedure(x,y,c:integer);
       begin
           call color(c);
           call cirb(x, y, 15, 1, 0, 1, 1, 1, 1);
           call move(x,y+15);
           call draw(x,y+50);
 
           call draw(x-25,y+100);
           call move(x,y+50);
           call draw(x+25,y+100);
           call move(x-25,y+25); call draw(x+25,y+25);
           call cirb(x+25,y+25,5,0,0,1,1,1,1);
           call cirb(x-25,y+25,5,0,0,1,1,1,1);
           call move(x+25,y-20); call draw(x+25,y+95);
       end Guard;
 
       (********************************************************)
       (*  procedure affichant les bulles dans lesquelles les  *)
       (*  philosophes pourront ‚crire leurs actions           *)
       (********************************************************)
       UNIT bulles : procedure(n : integer);
       var x1, x2, x3, y1, y2, y3, num, r1, r2, r3 : integer,
           angle : real;
       begin
         num := n - 1;
         angle := (2*num+1)*PI/5;
         r1 := rt + 5;
         r2 := r1 + 15;
         r3 := r1 + 55;
         x1 := round(r1*cos(angle) + xt);
         y1 := round(r1*sin(angle) + yt);
         x2 := round(r2*cos(angle + PI/64) + xt);
         y2 := round(r2*sin(angle + PI/64) + yt);
         x3 := round(r3*cos(angle - PI/64) + xt);
         y3 := round(r3*sin(angle - PI/64) + yt);
         call cirb(x1, y1, 5, 0, 0, 1, 0, 1, 1);
         call cirb(x2, y2, 10, 0, 0, 1, 0, 1, 1);
         call cirb(x3, y3, 35, 0, 0, 1, 0, 1, 1);
       END bulles;
 
       (********************************************************)
       (*  procedure qui affiche les actions des philosophes   *)
       (********************************************************)
       UNIT actionp :   procedure(n, action : integer);
       var x1, x2, x3, y1, y2, y3, num, r1, r2, r3, i, j : integer,
           angle : real;
       begin
         num := n - 1;
         angle := (2*num+1)*PI/5;
         r1 := rt + 5;
         r3 := r1 + 55;
         x3 := round(r3*cos(angle - PI/64) + xt);
         y3 := round(r3*sin(angle - PI/64) + yt);
         j := x3 - 32;
         i := y3 - 5;
         call move(j,i);
         case action
              when 1: call outstring(" PENSER ");
              when 2: call outstring(" RENTRER");
              when 3: call outstring(" MANGER ");
 
              when 4: call outstring(" SORTIR ");
              when 5: call outstring(" ANORMAL");
              when 6: call outstring("G RENDUE");
              call fourchette(n,0,14);
 
 
              when 7:  call outstring("D RENDUE");
              call fourchette(n-1,0,14);
 
 
              when 8: call outstring(" PARTIR ");
              when 9:  call outstring("G PRISE ");
              call fourchette(n ,0,0);
 
 
              when 10:  call outstring("D PRISE ");
              call fourchette(n-1,0,0);
 
 
              when 11: call outstring("G REFUS ");
              when 12: call outstring("D REFUS ");
         esac;
         call color(7);
       END actionp;
 
       (*******************************************************)
       (* procedure affichant un cercle                       *)
       (*******************************************************)
       UNIT cercle :  procedure (x,y,r : integer);
       var xp, yp, xn, yn, i : integer,
           Dangle, angle : real;
       begin
         Dangle := 2*PI/100;
         xp := r + x;
         yp := yt;
         for i := 0 to 100
         do
           angle := Dangle * i;
           xn := round((r*cos(angle)) + x);
           yn := round((r*sin(angle)) + y);
           call move(xp, yp);
           call draw(xn, yn);
           xp := xn;
           yp := yn;
         od;
       END cercle;
 
       unit table: procedure(xt,yt,rt : integer);
       begin
           (* affichage de la table *)
           call cercle(xt, yt, rt);
           (* affichage des assiettes *)
           for i := 0 to 4
           do
             angle := ( (i*2)+1 ) *PI/5;
             r := rt - ra - 5;
             xa := round ( (r*cos(angle)) + xt);
             ya := round ( (r*sin(angle)) + yt);
             call color(2);
             call cirb(xa, ya, ra, 0, 0, 1, 1, 1, 1);
             call move(xa, ya);
             call color(0);
             call hascii (48 + (i-1) div 10);
             call Hascii (48 + (i+1) mod 10);
             call color(7);
           od;
        end table;
 
         UNIT finir : procedure;
         begin
           compteur := compteur + 1;
           if compteur = 5
           then call groff;
                call endrun;
           fi;
         END finir;
 
       begin
         call gron(1);
         ra :=30;
         return;
         do
           accept bulles, fourchette, finir,guard, table,actionp, cercle;
         od;
       END ecran;
 
       (*******************************************************)
       (*        processus philosophe                         *)
       (*******************************************************)
       UNIT philosophe : iiuwgraph process( node, num_phi : integer,
            gardien : doorman, fourch_g, fourch_d : fork, e : ecran);
       var i, compt_m : integer,
           Goccupee, Doccupee : boolean;
 
           unit waitt : procedure(n:integer);
           var j : integer;
           begin
              for j := 1 to n do od;
           end waitt;
       begin
         return;
         compt_m := 1;
         call e.bulles(num_phi);
         call e.actionp(num_phi, 1);
         call waitt(1500);
         while (compt_m < 3)
         do
           call gardien.dem_entrer(num_phi);
           call e.actionp(num_phi, 2);
           call waitt(1500);
           (* tant que le philosophe n'a pas les deux fourchettes *)
           while ( (not Goccupee) or (not Doccupee) )
           do
             (* demander … avoir la fourchette de gauche *)
             if (not Goccupee) then
                call fourch_g.prendref(Goccupee,num_phi,0);
                call waitt(1500);
             fi;
 
             (* demander … avoir la fourchette de droite *)
             if (not Doccupee) then
                call fourch_d.prendref(Doccupee,num_phi,1);
                call waitt(1500);
             fi;
           od;
           (* le philosophe a obtenu les 2 fourchettes *)
           (* il mange                                 *)
           call e.actionp(num_phi, 3);
           call waitt(4000);
           (* le philosophe a fini de manger           *)
           (* il rend la fourchette de gauche          *)
           call fourch_g.rendref(Goccupee,num_phi,0);
           call waitt(1500);
 
           (* il rend la fourchette de droite          *)
           call fourch_d.rendref(Doccupee, num_phi,1);
           call waitt(1500);
 
           (* le philosophe demande … sortir de table *)
           call gardien.sortir(num_phi);
 
           call waitt(5000);
 
           compt_m := compt_m + 1;
         od;
         (* le philosophe a mange 5 fois              *)
         (* il part d‚finitivement                    *)
         call e.actionp(num_phi, 8);
         call waitt(1500);
         call e.finir;
       END philosophe;
 
       (*******************************************************)
       (*  processus qui gere les entrees et sorties des      *)
       (*  philosophes                                        *)
       (*******************************************************)
       UNIT doorman : iiuwgraph process(node, place_dispo : integer, e : ecran);
 
         UNIT dem_entrer : procedure(num : integer);
         begin
           if place_dispo > 0
           then
             (* il y a des places disponibles … table  *)
             (* le philosophe peut rentrer             *)
             place_dispo := place_dispo - 1;
             call e.actionp(num, 2);
             if place_dispo = 0 then
               (* il n'y a plus de places disponibles  *)
               (* aucun philosophe ne peut entrer      *)
               return disable dem_entrer;
             fi;
           else
             call e.actionp(num, 5);
             return;
           fi;
         END dem_entrer;
 
         UNIT sortir : procedure(num : integer);
         begin
           (* un philosophe sort de la salle           *)
           (* une place est liberee                    *)
           place_dispo := place_dispo + 1;
           call e.actionp(num, 4);
           return enable dem_entrer;
         END sortir;
 
       begin
         enable dem_entrer, sortir;
         return;
         do od;
       END doorman;
 
       (*******************************************************)
       (* processus permettant de prendre et rendre les       *)
       (* fourchettes                                         *)
       (*******************************************************)
       UNIT fork : iiuwgraph process (node : integer,e:ecran);
       var aux : boolean;
 
         UNIT prendref : procedure (output foccupee : boolean;
                                input num,i:integer);
         begin
           if aux
           then foccupee := true;
                aux := false;
 
           else foccupee := false;
           fi;
           if i=0 then
                 if foccupee
                then
                  call e.actionp(num, 9);
                else
                  call e.actionp(num, 11);
                fi;
           else
                if foccupee
                then
                  call e.actionp(num, 10);
                else
                  call e.actionp(num, 12);
                fi;
           fi;
         END prendref;
 
         UNIT rendref : procedure (output foccup : boolean;
                   input num:integer,i:integer);
         begin
           aux := true;
           foccup := false;
           if i=0 then call e.actionp(num, 6)
               else call e.actionp(num,7 ) fi;
         END rendref;
 
       begin
         aux := true;
         enable prendref, rendref;
         return;
         do
           accept prendref, rendref;
         od;
       END fork;
 
       (*******************************************************)
       (*                   PROGRAMME PRINCIPAL               *)
       (*******************************************************)
       CONST
             xt = 300,
             yt = 170,
             rt = 105;
 
       VAR i : integer,
           gardien : doorman,
           f : arrayof fork,
           f0 : fork,
           ph : arrayof philosophe,
           ph0 : philosophe,
           e : ecran;
 
       BEGIN   (********* programme principale ***********)
 
           call newpage;
           e := new ecran(0);
           resume(e);
 
           call e.table(xt,yt,rt);
 
           (* affichage des fourchettes *)
           for i := 0 to 4
           do
             call e.fourchette(i, 0, 14);
           od;
           (* affichage de gardien *)
           call e.guard(50,250,14);
           gardien := new doorman(0, 4, e);
           array ph dim (1:5);
           array f dim (0:4);
           for i := 0 to 4
           do
             f0 := new fork(0,e);
             f(i) := f0;
             resume(f(i));
           od;
           resume (gardien);
           for i:= 1 to 5
           do
             ph0 := new philosophe(0, i, gardien, f(i mod 5), f(i-1), e);
             ph(i) :=ph0;
           od;
           for i := 1 to 5
           do
             resume(ph(i));
           od;
 
 
END philos5.