examples/process/binda3.log

   1      program philos5;\r
   2  \r
   3        (********************************************************)\r
   4        (*        procedure qui efface l'\82cran                  *)\r
   5        (********************************************************)\r
   6        UNIT NewPage : procedure;\r
   7        begin\r
   8          write( chr(27), "[2J");\r
   9        END Newpage;\r
  10  \r
  11  \r
  12        (********************************************************)\r
  13        (* Processus gerant l'\82cran pour chaque philosophe      *)\r
  14        (********************************************************)\r
  15        UNIT ecran : iiuwgraph process (n : integer);\r
  16        const  PI = 3.14159;\r
  17        var compteur : integer,\r
  18            xf, yf, xa, ya, ra, r, i : integer,\r
  19            angle : real;\r
  20  \r
  21        (********************************************************)\r
  22        (*  procedure qui dessine une fourchette \85 l'\82cran      *)\r
  23        (********************************************************)\r
  24        UNIT fourchette : procedure(num_phi, o, couleur : integer);\r
  25        var r1, r2, r3, r4, x, y : integer,\r
  26            angle : real;\r
  27        begin\r
  28          call color(couleur);\r
  29          r1 := 30;\r
  30          r2 := 15;\r
  31          r3 := 15;\r
  32          r4 := 15;\r
  33          angle := (num_phi * 2 + o) * PI/5;\r
  34          x := round((rt-50) *cos(angle) + xt);\r
  35          y := round((rt-50) *sin(angle) + yt);\r
  36          call move(x,y);\r
  37          call draw(round(r1*cos(angle)+x), round(r1*sin(angle)+y));\r
  38          call move(x,y);\r
  39          call draw(round(r2*cos(angle+3*PI/4)+x),round(r2*sin(angle+3*PI/4)+y));\r
  40          call move(x,y);\r
  41          call draw(round(r3*cos(angle-3*PI/4)+x),round(r3*sin(angle-3*PI/4)+y));\r
  42          call move(x,y);\r
  43          call draw(round(r4*cos(angle+PI)+x),round(r4*sin(angle+PI)+y));\r
  44          call color(7);\r
  45        END fourchette;\r
  46  \r
  47  \r
  48        (********************************************************)\r
  49        (*  procedure qui dessine un guardien \85 l'\82cran      *)\r
  50        (********************************************************)\r
  51  \r
  52        UNIT Guard :  procedure(x,y,c:integer);\r
  53        begin\r
  54            call color(c);\r
  55            call cirb(x, y, 15, 1, 0, 1, 1, 1, 1);\r
  56            call move(x,y+15);\r
  57            call draw(x,y+50);\r
  58  \r
  59            call draw(x-25,y+100);\r
  60            call move(x,y+50);\r
  61            call draw(x+25,y+100);\r
  62            call move(x-25,y+25); call draw(x+25,y+25);\r
  63            call cirb(x+25,y+25,5,0,0,1,1,1,1);\r
  64            call cirb(x-25,y+25,5,0,0,1,1,1,1);\r
  65            call move(x+25,y-20); call draw(x+25,y+95);\r
  66        end Guard;\r
  67  \r
  68        (********************************************************)\r
  69        (*  procedure affichant les bulles dans lesquelles les  *)\r
  70        (*  philosophes pourront \82crire leurs actions           *)\r
  71        (********************************************************)\r
  72        UNIT bulles : procedure(n : integer);\r
  73        var x1, x2, x3, y1, y2, y3, num, r1, r2, r3 : integer,\r
  74            angle : real;\r
  75        begin\r
  76          num := n - 1;\r
  77          angle := (2*num+1)*PI/5;\r
  78          r1 := rt + 5;\r
  79          r2 := r1 + 15;\r
  80          r3 := r1 + 55;\r
  81          x1 := round(r1*cos(angle) + xt);\r
  82          y1 := round(r1*sin(angle) + yt);\r
  83          x2 := round(r2*cos(angle + PI/64) + xt);\r
  84          y2 := round(r2*sin(angle + PI/64) + yt);\r
  85          x3 := round(r3*cos(angle - PI/64) + xt);\r
  86          y3 := round(r3*sin(angle - PI/64) + yt);\r
  87          call cirb(x1, y1, 5, 0, 0, 1, 0, 1, 1);\r
  88          call cirb(x2, y2, 10, 0, 0, 1, 0, 1, 1);\r
  89          call cirb(x3, y3, 35, 0, 0, 1, 0, 1, 1);\r
  90        END bulles;\r
  91  \r
  92        (********************************************************)\r
  93        (*  procedure qui affiche les actions des philosophes   *)\r
  94        (********************************************************)\r
  95        UNIT actionp :   procedure(n, action : integer);\r
  96        var x1, x2, x3, y1, y2, y3, num, r1, r2, r3, i, j : integer,\r
  97            angle : real;\r
  98        begin\r
  99          num := n - 1;\r
 100          angle := (2*num+1)*PI/5;\r
 101          r1 := rt + 5;\r
 102          r3 := r1 + 55;\r
 103          x3 := round(r3*cos(angle - PI/64) + xt);\r
 104          y3 := round(r3*sin(angle - PI/64) + yt);\r
 105          j := x3 - 32;\r
 106          i := y3 - 5;\r
 107          call move(j,i);\r
 108          case action\r
 109               when 1: call outstring(" PENSER ");\r
 110               when 2: call outstring(" RENTRER");\r
 111               when 3: call outstring(" MANGER ");\r
 112  \r
 113               when 4: call outstring(" SORTIR ");\r
 114               when 5: call outstring(" ANORMAL");\r
 115               when 6: call outstring("G RENDUE");\r
 116               call fourchette(n,0,14);\r
 117  \r
 118  \r
 119               when 7:  call outstring("D RENDUE");\r
 120               call fourchette(n-1,0,14);\r
 121  \r
 122  \r
 123               when 8: call outstring(" PARTIR ");\r
 124               when 9:  call outstring("G PRISE ");\r
 125               call fourchette(n ,0,0);\r
 126  \r
 127  \r
 128               when 10:  call outstring("D PRISE ");\r
 129               call fourchette(n-1,0,0);\r
 130  \r
 131  \r
 132               when 11: call outstring("G REFUS ");\r
 133               when 12: call outstring("D REFUS ");\r
 134          esac;\r
 135          call color(7);\r
 136        END actionp;\r
 137  \r
 138        (*******************************************************)\r
 139        (* procedure affichant un cercle                       *)\r
 140        (*******************************************************)\r
 141        UNIT cercle :  procedure (x,y,r : integer);\r
 142        var xp, yp, xn, yn, i : integer,\r
 143            Dangle, angle : real;\r
 144        begin\r
 145          Dangle := 2*PI/100;\r
 146          xp := r + x;\r
 147          yp := yt;\r
 148          for i := 0 to 100\r
 149          do\r
 150            angle := Dangle * i;\r
 151            xn := round((r*cos(angle)) + x);\r
 152            yn := round((r*sin(angle)) + y);\r
 153            call move(xp, yp);\r
 154            call draw(xn, yn);\r
 155            xp := xn;\r
 156            yp := yn;\r
 157          od;\r
 158        END cercle;\r
 159  \r
 160        unit table: procedure(xt,yt,rt : integer);\r
 161        begin\r
 162            (* affichage de la table *)\r
 163            call cercle(xt, yt, rt);\r
 164            (* affichage des assiettes *)\r
 165            for i := 0 to 4\r
 166            do\r
 167              angle := ( (i*2)+1 ) *PI/5;\r
 168              r := rt - ra - 5;\r
 169              xa := round ( (r*cos(angle)) + xt);\r
 170              ya := round ( (r*sin(angle)) + yt);\r
 171              call color(2);\r
 172              call cirb(xa, ya, ra, 0, 0, 1, 1, 1, 1);\r
 173              call move(xa, ya);\r
 174              call color(0);\r
 175              call hascii (48 + (i-1) div 10);\r
 176              call Hascii (48 + (i+1) mod 10);\r
 177              call color(7);\r
 178            od;\r
 179         end table;\r
 180  \r
 181          UNIT finir : procedure;\r
 182          begin\r
 183            compteur := compteur + 1;\r
 184            if compteur = 5\r
 185            then call groff;\r
 186                 call endrun;\r
 187            fi;\r
 188          END finir;\r
 189  \r
 190        begin\r
 191          call gron(1);\r
 192          ra :=30;\r
 193          return;\r
 194          do\r
 195            accept bulles, fourchette, finir,guard, table,actionp, cercle;\r
 196          od;\r
 197        END ecran;\r
 198  \r
 199        (*******************************************************)\r
 200        (*        processus philosophe                         *)\r
 201        (*******************************************************)\r
 202        UNIT philosophe : iiuwgraph process( node, num_phi : integer,\r
 203             gardien : doorman, fourch_g, fourch_d : fork, e : ecran);\r
 204        var i, compt_m : integer,\r
 205            Goccupee, Doccupee : boolean;\r
 206  \r
 207            unit waitt : procedure(n:integer);\r
 208            var j : integer;\r
 209            begin\r
 210               for j := 1 to n do od;\r
 211            end waitt;\r
 212        begin\r
 213          return;\r
 214          compt_m := 1;\r
 215          call e.bulles(num_phi);\r
 216          call e.actionp(num_phi, 1);\r
 217          call waitt(1500);\r
 218          while (compt_m < 3)\r
 219          do\r
 220            call gardien.dem_entrer(num_phi);\r
 221            call e.actionp(num_phi, 2);\r
 222            call waitt(1500);\r
 223            (* tant que le philosophe n'a pas les deux fourchettes *)\r
 224            while ( (not Goccupee) or (not Doccupee) )\r
 225            do\r
 226              (* demander \85 avoir la fourchette de gauche *)\r
 227              if (not Goccupee) then\r
 228                 call fourch_g.prendref(Goccupee,num_phi,0);\r
 229                 call waitt(1500);\r
 230              fi;\r
 231  \r
 232              (* demander \85 avoir la fourchette de droite *)\r
 233              if (not Doccupee) then\r
 234                 call fourch_d.prendref(Doccupee,num_phi,1);\r
 235                 call waitt(1500);\r
 236              fi;\r
 237            od;\r
 238            (* le philosophe a obtenu les 2 fourchettes *)\r
 239            (* il mange                                 *)\r
 240            call e.actionp(num_phi, 3);\r
 241            call waitt(4000);\r
 242            (* le philosophe a fini de manger           *)\r
 243            (* il rend la fourchette de gauche          *)\r
 244            call fourch_g.rendref(Goccupee,num_phi,0);\r
 245            call waitt(1500);\r
 246  \r
 247            (* il rend la fourchette de droite          *)\r
 248            call fourch_d.rendref(Doccupee, num_phi,1);\r
 249            call waitt(1500);\r
 250  \r
 251            (* le philosophe demande \85 sortir de table *)\r
 252            call gardien.sortir(num_phi);\r
 253  \r
 254            call waitt(5000);\r
 255  \r
 256            compt_m := compt_m + 1;\r
 257          od;\r
 258          (* le philosophe a mange 5 fois              *)\r
 259          (* il part d\82finitivement                    *)\r
 260          call e.actionp(num_phi, 8);\r
 261          call waitt(1500);\r
 262          call e.finir;\r
 263        END philosophe;\r
 264  \r
 265        (*******************************************************)\r
 266        (*  processus qui gere les entrees et sorties des      *)\r
 267        (*  philosophes                                        *)\r
 268        (*******************************************************)\r
 269        UNIT doorman : iiuwgraph process(node, place_dispo : integer, e : ecran);\r
 270  \r
 271          UNIT dem_entrer : procedure(num : integer);\r
 272          begin\r
 273            if place_dispo > 0\r
 274            then\r
 275              (* il y a des places disponibles \85 table  *)\r
 276              (* le philosophe peut rentrer             *)\r
 277              place_dispo := place_dispo - 1;\r
 278              call e.actionp(num, 2);\r
 279              if place_dispo = 0 then\r
 280                (* il n'y a plus de places disponibles  *)\r
 281                (* aucun philosophe ne peut entrer      *)\r
 282                return disable dem_entrer;\r
 283              fi;\r
 284            else\r
 285              call e.actionp(num, 5);\r
 286              return;\r
 287            fi;\r
 288          END dem_entrer;\r
 289  \r
 290          UNIT sortir : procedure(num : integer);\r
 291          begin\r
 292            (* un philosophe sort de la salle           *)\r
 293            (* une place est liberee                    *)\r
 294            place_dispo := place_dispo + 1;\r
 295            call e.actionp(num, 4);\r
 296            return enable dem_entrer;\r
 297          END sortir;\r
 298  \r
 299        begin\r
 300          enable dem_entrer, sortir;\r
 301          return;\r
 302          do od;\r
 303        END doorman;\r
 304  \r
 305        (*******************************************************)\r
 306        (* processus permettant de prendre et rendre les       *)\r
 307        (* fourchettes                                         *)\r
 308        (*******************************************************)\r
 309        UNIT fork : iiuwgraph process (node : integer,e:ecran);\r
 310        var aux : boolean;\r
 311  \r
 312          UNIT prendref : procedure (output foccupee : boolean;\r
 313                                 input num,i:integer);\r
 314          begin\r
 315            if aux\r
 316            then foccupee := true;\r
 317                 aux := false;\r
 318  \r
 319            else foccupee := false;\r
 320            fi;\r
 321            if i=0 then\r
 322                  if foccupee\r
 323                 then\r
 324                   call e.actionp(num, 9);\r
 325                 else\r
 326                   call e.actionp(num, 11);\r
 327                 fi;\r
 328            else\r
 329                 if foccupee\r
 330                 then\r
 331                   call e.actionp(num, 10);\r
 332                 else\r
 333                   call e.actionp(num, 12);\r
 334                 fi;\r
 335            fi;\r
 336          END prendref;\r
 337  \r
 338          UNIT rendref : procedure (output foccup : boolean;\r
 339                    input num:integer,i:integer);\r
 340          begin\r
 341            aux := true;\r
 342            foccup := false;\r
 343            if i=0 then call e.actionp(num, 6)\r
 344                else call e.actionp(num,7 ) fi;\r
 345          END rendref;\r
 346  \r
 347        begin\r
 348          aux := true;\r
 349          enable prendref, rendref;\r
 350          return;\r
 351          do\r
 352            accept prendref, rendref;\r
 353          od;\r
 354        END fork;\r
 355  \r
 356        (*******************************************************)\r
 357        (*                   PROGRAMME PRINCIPAL               *)\r
 358        (*******************************************************)\r
 359        CONST\r
 360              xt = 300,\r
 361              yt = 170,\r
 362              rt = 105;\r
 363  \r
 364        VAR i : integer,\r
 365            gardien : doorman,\r
 366            f : arrayof fork,\r
 367            f0 : fork,\r
 368            ph : arrayof philosophe,\r
 369            ph0 : philosophe,\r
 370            e : ecran;\r
 371  \r
 372        BEGIN   (********* programme principale ***********)\r
 373  \r
 374            call newpage;\r
 375            e := new ecran(0);\r
 376            resume(e);\r
 377  \r
 378            call e.table(xt,yt,rt);\r
 379  \r
 380            (* affichage des fourchettes *)\r
 381            for i := 0 to 4\r
 382            do\r
 383              call e.fourchette(i, 0, 14);\r
 384            od;\r
 385            (* affichage de gardien *)\r
 386            call e.guard(50,250,14);\r
 387            gardien := new doorman(0, 4, e);\r
 388            array ph dim (1:5);\r
 389            array f dim (0:4);\r
 390            for i := 0 to 4\r
 391            do\r
 392              f0 := new fork(0,e);\r
 393              f(i) := f0;\r
 394              resume(f(i));\r
 395            od;\r
 396            resume (gardien);\r
 397            for i:= 1 to 5\r
 398            do\r
 399              ph0 := new philosophe(0, i, gardien, f(i mod 5), f(i-1), e);\r
 400              ph(i) :=ph0;\r
 401            od;\r
 402            for i := 1 to 5\r
 403            do\r
 404              resume(ph(i));\r
 405            od;\r
 406  \r
 407  \r
 408 END philos5.\r