examples/examples/helpcor.log

   1 PROGRAM COROUTINE;\r
   2   signal fin;\r
   3 (* Projet LI1 : Didacticiel sur les coroutines. *)\r
   4 (*              Realise par CHICHER Corinne et DOME Nadege - UPPA 1993/1994 - *)\r
   5 \r
   6 BEGIN\r
   7   pref iiuwgraph block\r
   8   BEGIN\r
   9     pref mouse block\r
  10 \r
  11     VAR nooper,typexec,touche:integer, \r
  12           i,b,h,v,num,xpa,ypa:integer,\r
  13           g,d,c,driver,selection,demarrage,ptarok,stopexec:boolean;\r
  14 \r
  15   (* nooper:correspond soit a l'execution du programmes soit a l'affichage*)\r
  16   (* d'informations sur les coroutines.*)\r
  17   (* typexec:type de l'execution du programme ou types de renseignements sur*)\r
  18   (* les coroutines.*)\r
  19   (* demarrage a vrai si choix de l'icone Execution*)\r
  20   (* ptarok a vrai l'utilisateur a choisi un point d'arret*)\r
  21   (* stopexec a vrai si l'utilisateur a clique sur l'icone Quitter*)\r
  22 \r
  23 \r
  24 (******************************************************************************)\r
  25 (* Procedures permettant la gestion de l'ecran en mode texte et graphique     *)\r
  26 (******************************************************************************)\r
  27 \r
  28   (* NewPage vide l'ecran en mode texte *)\r
  29   UNIT NewPage : PROCEDURE;\r
  30   BEGIN\r
  31     write( chr(27), "[2J");\r
  32   END NewPage;\r
  33 \r
  34   (* SetCursor positionne le curseur aux lignes et colonnes indiquees *)\r
  35   UNIT SetCursor : PROCEDURE(ligne,colonne:integer);\r
  36   VAR c,d,e,f :char,\r
  37       i,j :integer;\r
  38   BEGIN\r
  39     i:=ligne div 10;\r
  40     j:=ligne mod 10;\r
  41     c:=chr(48+i);\r
  42     d:=chr(48+j);\r
  43     i:=colonne div 10;\r
  44     j:=colonne mod 10;\r
  45     e:=chr(48+i);\r
  46     f:=chr(48+j);\r
  47     write( chr(27), "[", c, d, ";", e, f, "H");\r
  48   END SetCursor;\r
  49 \r
  50 \r
  51   (* inchar saisit un caractere en mode graphique *)\r
  52   UNIT inchar : FUNCTION : integer;\r
  53   VAR i:integer;\r
  54   BEGIN\r
  55     DO \r
  56       i:=INKEY;\r
  57       if i <> 0 then\r
  58         exit\r
  59       fi;\r
  60     OD;\r
  61     result:=i;\r
  62   END inchar;\r
  63 \r
  64 \r
  65   (* ReadInteger lit un entier positif a 3 chiffres avec echo a l'ecran *)\r
  66   UNIT ReadInteger : FUNCTION : integer;\r
  67   VAR X,Y,i,OrdN : integer,\r
  68       Number : arrayof integer;\r
  69   BEGIN\r
  70     array Number dim( 1 : 4 );\r
  71     i:=0;\r
  72     X:=InXPos;\r
  73     Y:=InYPos;\r
  74     DO\r
  75       OrdN:=inchar;\r
  76       if i=8 or (OrdN < 48 and OrdN > 57) then\r
  77         exit\r
  78       fi;\r
  79       CASE OrdN\r
  80         when 48 : i:=i+1;\r
  81                   Number(i):=0;\r
  82         when 49 : i:=i+1;\r
  83                   Number(i):=1;\r
  84         when 50 : i:=i+1;\r
  85                   Number(i):=2;\r
  86         when 51 : i:=i+1;\r
  87                   Number(i):=3;\r
  88         when 52 : i:=i+1;\r
  89                   Number(i):=4;\r
  90         when 53 : i:=i+1;\r
  91                   Number(i):=5;\r
  92         when 54 : i:=i+1;\r
  93                   Number(i):=6;\r
  94         when 55 : i:=i+1;\r
  95                   Number(i):=7;\r
  96         when 56 : i:=i+1;\r
  97                   Number(i):=8;\r
  98         when 57 : i:=i+1;\r
  99                   Number(i):=9;\r
 100         when 8 : if i > 0 then\r
 101                    Number(i):=0;\r
 102                    i:=i-1;\r
 103                    call hascii(0);\r
 104                  fi;\r
 105         when 13 : if i > 0 then\r
 106                     exit\r
 107                   fi;\r
 108       ESAC;\r
 109       if i=1 then\r
 110         call Move(X,Y);\r
 111         call hascii(0);\r
 112         call hascii(48+Number(1));\r
 113       fi;\r
 114       if i=2 then\r
 115         call Move(X+8,Y);\r
 116         call hascii(0);\r
 117         call hascii(48+Number(2));\r
 118       fi; \r
 119       if i=3 then\r
 120         call Move(X+16,Y);\r
 121         call hascii(0);\r
 122         call hascii(48+Number(3));\r
 123       fi;        \r
 124     OD;\r
 125     if (Number(1) = 0) or (Number(1) = 0 and Number(2) = 0) \r
 126        or (Number(1) = 0 and Number(2) = 0 and Number(3) = 0) then\r
 127       call Move(X,Y);\r
 128       call hascii(0);\r
 129       call hascii(48);\r
 130       call hascii(0);\r
 131     fi;\r
 132     if i=1 then\r
 133       result:=Number(1);\r
 134     else\r
 135       if i=2 then\r
 136         result:=10 * Number(1) + Number(2);\r
 137       else\r
 138         result:=100 * Number(1) + 10 * Number(2) + Number(3);\r
 139       fi;\r
 140     fi;\r
 141     kill(Number);\r
 142   END ReadInteger;\r
 143   \r
 144   (* WriteInteger permet d'afficher un entier positif a 3 chiffres a l'ecran *)\r
 145   UNIT WriteInteger : PROCEDURE(Number:integer);\r
 146   VAR i,j,k:integer;\r
 147   BEGIN\r
 148     if Number < 10 then\r
 149       call HASCII(0);\r
 150       call HASCII(Number+48);\r
 151       call HASCII(0);\r
 152     else\r
 153       if Number < 100 then\r
 154         i:=Number div 10;\r
 155         j:=Number - i * 10;\r
 156         call HASCII(0);\r
 157         call HASCII(i+48);\r
 158         call HASCII(0);\r
 159         call HASCII(j+48);\r
 160       else\r
 161         i:=Number div 100;\r
 162         j:=(Number - i * 100) div 10;\r
 163         k:=Number - i * 100 - j * 10;\r
 164         call HASCII(0);\r
 165         call HASCII(i+48);\r
 166         call HASCII(0);\r
 167         call HASCII(j+48);\r
 168         call HASCII(0);\r
 169         call HASCII(k+48);\r
 170       fi;\r
 171     fi;\r
 172   END WriteInteger;\r
 173 \r
 174 \r
 175 (*******************************************************************************)\r
 176 (* Procedures gerant un click de la souris sur l'ecran                         *)\r
 177 (*******************************************************************************)\r
 178 \r
 179   (* Si choix=0 l'utilisateur a clique sur l'icone Quitter*)\r
 180   (* presentbout gere le click lors de la page de presentation*)\r
 181   UNIT presentbout : PROCEDURE(x,y:integer;inout bonclic:boolean,choix:integer);\r
 182   BEGIN\r
 183     if (x >= 12) and (x <= 92) then\r
 184       if (y >= 296) and (y <= 312) then\r
 185         bonclic:=true;\r
 186         choix:=0;  \r
 187       fi;\r
 188     fi;\r
 189     if (x >= 116) and (x<=284) then\r
 190       if (y >= 296) and (y <= 312) then\r
 191         bonclic:=true;\r
 192         choix:=1;  (* Click sur l'icone execution*)\r
 193       fi;\r
 194     fi;\r
 195   END presentbout;\r
 196 \r
 197 \r
 198   (* Mousepos gere la position de la souris a l'endroit ou le bouton gauche *)\r
 199   (* a ete presse dans le premier ecran *)\r
 200   UNIT MOUSEPOS : PROCEDURE(x,y:integer;inout bonclic:boolean;output choix:integer);\r
 201   BEGIN\r
 202     if (x >= 24) and (x <= 544) then\r
 203       if (y >= 96) and (y <= 104) then\r
 204         choix:=1;     (* Click sur execution du programme*)\r
 205         bonclic:=true;\r
 206       fi;\r
 207 \r
 208       if (y >= 112) and (y <= 120) then\r
 209         choix:=2;     (* Click sur A propos des coroutines*)\r
 210         bonclic:=true;\r
 211       fi;\r
 212 \r
 213       if (y >= 160) and (y <= 168) then\r
 214         choix:=3;     (* Click sur execution normale du programme   *)\r
 215                       (* ou sur definition et interet des coroutines*)\r
 216         bonclic:=true;\r
 217       fi;\r
 218 \r
 219       if (y >= 176) and (y <= 184) then\r
 220         choix:=4;     (* Click sur execution pas a pas du programme*)\r
 221                       (* ou sur le schema de la semantique *)\r
 222         bonclic:=true;\r
 223       fi;\r
 224 \r
 225       if (y >= 192) and (y <= 200) then\r
 226         choix:=5;     (* click sur l'execution avec point d'arret*)\r
 227         bonclic:=true;\r
 228       fi;\r
 229 \r
 230       if (y >= 224) and (y <= 232) then\r
 231         call CLS;\r
 232         choix:=0;\r
 233         bonclic:=true;\r
 234       fi;\r
 235     fi;\r
 236   END MOUSEPOS;\r
 237 \r
 238 \r
 239   (* POSmouse gere la position de la souris a l'endroit ou le bouton gauche *)\r
 240   (* a ete presse dans le deuxieme ecran*)\r
 241   UNIT POSmouse : PROCEDURE(x,y:integer;inout bonclic:boolean;output choix:integer);\r
 242   BEGIN\r
 243     if (x >= 12) and (x <= 92) then\r
 244       if (y >= 236) and (y <= 252) then\r
 245         choix:=1;\r
 246         bonclic:=true;\r
 247       fi;\r
 248       if (y >= 256) and (y <= 272) then\r
 249         choix:=0;\r
 250         bonclic:=true;\r
 251       fi;\r
 252     fi;\r
 253   END POSmouse;\r
 254 \r
 255 \r
 256   (* ptarret gere la position de la souris a l'endroit ou le bouton gauche *)\r
 257   (* a ete presse pour la selection du point d'arret*)\r
 258   UNIT ptarret : PROCEDURE(x,y:integer;inout bonclic:boolean;output choix:integer);\r
 259   BEGIN\r
 260     choix:=0;\r
 261     (* Click sur une ligne du main*)\r
 262     if (x >= 12) and (x <= 200) then\r
 263       if ((y > 24) and (y < 32))or((y > 48) and (y < 80))\r
 264          or ((y > 88) and (y < 144)) then\r
 265         choix:=1;\r
 266         bonclic:=true;\r
 267       fi;\r
 268     fi;\r
 269 \r
 270     (* Click sur une ligne de producer*)\r
 271     if (x >= 216) and (x <= 412) then\r
 272       if ((y > 24) and (y < 32)) or ((y >40) and (y < 136)) then\r
 273         choix:=2;\r
 274         bonclic:=true;\r
 275       fi;\r
 276     fi;\r
 277 \r
 278     (* Click sur une ligne de consumer*)\r
 279     if (x >= 428) and (x <= 628) then\r
 280       if ((y > 24) and (y < 32)) or ((y > 48) and (y < 248)) then\r
 281         choix:=3;\r
 282         bonclic:=true;\r
 283       fi;\r
 284     fi;\r
 285 \r
 286     (* Click sur l'icone "Quitter"*)\r
 287     if (x>=12) and (x<=92) then\r
 288       if(y>=256) and (y<=272) then\r
 289         choix:=0;\r
 290         bonclic:=true;                     \r
 291       fi;\r
 292     fi;        \r
 293   END ptarret;\r
 294 \r
 295   (* GoStop gere la position de la souris a l'endroit ou le bouton gauche *)\r
 296   (* a ete presse dans le deuxieme ecran avec l'execution pas a pas*)\r
 297   UNIT GoStop : PROCEDURE(x,y:integer;inout bonclic:boolean,choix:integer);\r
 298   BEGIN\r
 299     if (x >= 120) and (x <= 200) then\r
 300       if (y >= 236) and (y <= 252) then\r
 301         choix:=1;\r
 302         bonclic:=true;\r
 303       fi;\r
 304     fi;\r
 305     if (x >= 12) and (x <= 92) then\r
 306       if (y >= 256) and (y <= 272) then\r
 307         choix:=0;\r
 308         bonclic:=true;\r
 309       fi;\r
 310     fi;\r
 311   END GoStop;\r
 312 \r
 313 \r
 314   (* clicquit gere le click sur quitter quand le point d'arret a ete atteint*)\r
 315   UNIT clicquit : PROCEDURE(x,y:integer;inout bonclic:boolean);\r
 316   BEGIN\r
 317     if (x >= 12) and (x <= 92) then\r
 318       if (y >= 256) and (y <= 272) then\r
 319         bonclic:=true;\r
 320       fi;\r
 321     fi;\r
 322   END clicquit;\r
 323 \r
 324   (*textquit gere le click sur quitter quand l'utilisateur a lu les informations*)\r
 325   UNIT textquit : PROCEDURE(x,y:integer;inout bonclic:boolean,choix:integer);\r
 326   BEGIN\r
 327     if (x >= 8) and (x <= 88) then\r
 328       if (y >= 320) and (y <= 336) then\r
 329         bonclic:=true;\r
 330         choix:=0;\r
 331       fi;\r
 332     fi;\r
 333     if (x >= 428) and (x<=558) then\r
 334       if (y >= 320) and (y <= 336) then\r
 335         bonclic:=true;\r
 336         choix:=1;\r
 337       fi;\r
 338     fi;\r
 339   END textquit;\r
 340 \r
 341 \r
 342 (********************************************************************************)\r
 343 (* Procedures gerant les dessins geometriques a l'ecran                         *)\r
 344 (********************************************************************************)\r
 345 \r
 346   (* cadre trace un rectangle *)\r
 347   UNIT cadre : PROCEDURE(xg,yg,xd,yd,couleur:integer);\r
 348   BEGIN\r
 349     call COLOR(couleur);\r
 350     call MOVE(xg,yg);\r
 351     call DRAW(xd,yg);\r
 352     call MOVE(xd,yg);\r
 353     call DRAW(xd,yd);\r
 354     call MOVE(xd,yd);\r
 355     call DRAW(xg,yd);\r
 356     call MOVE(xg,yd);\r
 357     call DRAW(xg,yg);\r
 358   END cadre;\r
 359 \r
 360   (* encadrpt determine et encadre la ligne correspondant au point d'arret*)\r
 361   UNIT encadrpt : PROCEDURE(input numcode:integer;inout y:integer);\r
 362   VAR ycadre,bornesup,xdeb,xfin,couleur:integer,\r
 363       trouve:boolean;\r
 364   BEGIN \r
 365     if numcode=1 then\r
 366       bornesup:=140;\r
 367       xdeb:=14;\r
 368       xfin:=198;\r
 369     fi;\r
 370     if numcode=2 then\r
 371       bornesup:=132;\r
 372       xdeb:=218;\r
 373       xfin:=410;\r
 374     fi;\r
 375     if numcode=3 then\r
 376       bornesup:=244;\r
 377       xdeb:=430;\r
 378       xfin:=626;\r
 379     fi; \r
 380     ycadre:=24;\r
 381     while not trouve and ycadre<=bornesup\r
 382     do\r
 383       if y >=ycadre and y<=ycadre+8 then\r
 384         trouve:=true;\r
 385       else \r
 386         ycadre:=ycadre+8;\r
 387       fi;\r
 388     od;\r
 389     couleur:=12;\r
 390     call cadre(xdeb,ycadre,xfin,ycadre+8,couleur);\r
 391     y:=ycadre+4;    \r
 392   END encadrpt;\r
 393 \r
 394 \r
 395 (********************************************************************************)\r
 396 (* Procedures mettant en place les differents ecrans                            *)\r
 397 (********************************************************************************)\r
 398 \r
 399   (* Presentation de l'application*)\r
 400   UNIT presentation : PROCEDURE;\r
 401   VAR couleur,choix:integer;\r
 402   BEGIN\r
 403     call CLS;\r
 404     call BORDER(7);\r
 405     (* Mise en place des boutons*)\r
 406     call cadre(12,296,92,312,12);\r
 407     call MOVE(26,300);\r
 408     call OUTSTRING("Quitter");\r
 409 \r
 410     call cadre(116,296,284,312,12);\r
 411     call MOVE(120,300);\r
 412     call OUTSTRING("Lancer l'application");\r
 413 \r
 414     call COLOR(12);\r
 415     call MOVE(370,304);\r
 416     call OUTSTRING("Licence informatique - UPPA 1994");\r
 417 \r
 418     call COLOR(12);\r
 419     call MOVE(184,64);\r
 420     call OUTSTRING("Corinne CHICHER & Nadege DOME");\r
 421     call MOVE(241,88);\r
 422     call OUTSTRING("Vous presentent");\r
 423     call MOVE(169,128);\r
 424     call OUTSTRING("UN DIDACTICIEL SUR LES COROUTINES");\r
 425     call MOVE(157,152);\r
 426     call OUTSTRING("DANS LE LANGAGE ORIENTE OBJET LOGLAN");\r
 427    \r
 428 \r
 429     call STYLE(5);\r
 430     call cadre(137,48,465,176,7);\r
 431 \r
 432     (* Gestion de la souris *)\r
 433     driver:=INIT(b);\r
 434     call SETPOSITION(0,0);\r
 435     call SHOWCURSOR;\r
 436     DO\r
 437       call GETPRESS(0,h,v,b,g,d,c);\r
 438       if g then\r
 439         call presentbout(h,v,selection,choix);\r
 440         if not selection then\r
 441           g:=false;\r
 442           repeat;\r
 443         else\r
 444           if choix=0 then   (* L'utilisateur a selectionne Quitter*)\r
 445             call HIDECURSOR;\r
 446             call quitter;\r
 447           else\r
 448             call HIDECURSOR;\r
 449             exit;\r
 450           fi;\r
 451         fi;\r
 452       fi;\r
 453     OD;\r
 454   END presentation;\r
 455 \r
 456   (* menu propose les programmes a executer et le type d'execution *)\r
 457   UNIT menu : PROCEDURE(inout numop1,numop2:integer);\r
 458   VAR i,touche,couleur:integer,\r
 459       selection:boolean;\r
 460   BEGIN\r
 461       call CLS;\r
 462       call BORDER(20);\r
 463       selection:=false;\r
 464       g:=false;\r
 465       d:=false;\r
 466       c:=false;\r
 467       call COLOR(15);\r
 468       call MOVE(184,24);\r
 469       call OUTSTRING("DIDACTICIEL SUR LES COROUTINES");\r
 470       couleur:=6;\r
 471       call cadre(24,56,544,240,couleur);\r
 472       call COLOR(7);\r
 473       call MOVE(64,96);\r
 474       call OUTSTRING("Execution du programme 'Producteur-Consommateur'");\r
 475       call MOVE(64,112);\r
 476       call OUTSTRING("A propos des 'Coroutines'...");\r
 477 \r
 478       call MOVE(64,224);\r
 479       call OUTSTRING("Quitter l'application");\r
 480       call MOVE(24,256);\r
 481       call COLOR(15);\r
 482       call OUTSTRING("Selectionnez l'operation avec le bouton gauche de la souris...");\r
 483       call COLOR(7);    \r
 484 \r
 485       (* Gestion de la souris *)\r
 486       driver:=INIT(b);\r
 487       call SETPOSITION(0,0);\r
 488       call SHOWCURSOR;\r
 489       DO\r
 490         call GETPRESS(0,h,v,b,g,d,c);\r
 491         if g then\r
 492           call MOUSEPOS(h,v,selection,numop1);\r
 493           if not selection then\r
 494             g:=false;\r
 495             repeat;\r
 496           else\r
 497             if numop1=0 then   (* L'utilisateur a selectionne Quitter*)\r
 498               call HIDECURSOR;\r
 499               exit\r
 500             else\r
 501               selection:=false;\r
 502               call HIDECURSOR;\r
 503               g:=false;\r
 504               d:=false;\r
 505               c:=false;\r
 506               call MOVE(64,160);\r
 507 \r
 508               if numop1=1 then (* L'utilisateur a selectionne l'exemple*)\r
 509                 call OUTSTRING("Execution normale du programme ");\r
 510                 call MOVE(64,176);\r
 511                 call OUTSTRING("Execution pas a pas du programme ");\r
 512                 call MOVE(64,192);\r
 513                 call OUTSTRING("Execution avec point d'arret du programme ");\r
 514                 driver:=INIT(b);\r
 515                 call SHOWCURSOR;\r
 516                 DO\r
 517                   call GETPRESS(0,h,v,b,g,d,c);\r
 518                   if g then\r
 519                     call MOUSEPOS(h,v,selection,numop2);\r
 520                     if not selection then\r
 521                       g:=false;\r
 522                       repeat;\r
 523                     else\r
 524                       call HIDECURSOR;\r
 525                       exit exit\r
 526                     fi;\r
 527                   fi;\r
 528                 OD;\r
 529               else   \r
 530               (* L'utilisateur a selectionne le "dictionnaire" sur les coroutines*)\r
 531                 call OUTSTRING("Definition et interet des coroutines ");\r
 532                 call MOVE(64,176);\r
 533                 call OUTSTRING("Instructions associees aux coroutines ");                \r
 534                 driver:=INIT(b);\r
 535                 call SHOWCURSOR;\r
 536                 DO\r
 537                   call GETPRESS(0,h,v,b,g,d,c);\r
 538                   if g then\r
 539                     call MOUSEPOS(h,v,selection,numop2);\r
 540                     if not selection then\r
 541                       g:=false;\r
 542                       repeat;\r
 543                     else\r
 544                       call HIDECURSOR;\r
 545                       exit exit\r
 546                     fi;\r
 547                   fi;\r
 548                 OD;\r
 549               fi;\r
 550             fi;\r
 551           fi;\r
 552         fi;\r
 553       OD;\r
 554   END menu;\r
 555 \r
 556 \r
 557   (* Contexte met en place les differentes parties servant a l'execution *)\r
 558   UNIT contexte : PROCEDURE(input typexec:integer,ptarok:boolean);\r
 559   VAR touche,couleur:integer;\r
 560 \r
 561   BEGIN\r
 562       call CLS;\r
 563       call COLOR(12);\r
 564       call MOVE(216,4);\r
 565       call OUTSTRING("EXECUTION DU PROGRAMME");\r
 566       (* Cadre entourant le code du main et coroutines *)\r
 567       couleur:=7; \r
 568       call cadre(8,16,632,280,couleur);\r
 569 \r
 570       (* Cadre simulant l'ecran *)\r
 571       call cadre(8,288,632,336,couleur);\r
 572       (* Boutons pour lancer l'execution et quitter *)\r
 573       call cadre(12,236,92,252,couleur);\r
 574       call MOVE(16,240);\r
 575       if typexec=5 and not ptarok then\r
 576         call COLOR(8);\r
 577       else\r
 578         call COLOR(12);\r
 579       fi;\r
 580       call OUTSTRING("Execution");            \r
 581       call cadre(12,256,92,272,couleur);\r
 582       call MOVE(16,260);\r
 583       call COLOR(12);      \r
 584       call OUTSTRING("Quitter");\r
 585       driver:=INIT(b);\r
 586       call SETPOSITION(0,0);\r
 587       call SHOWCURSOR;\r
 588   END contexte; \r
 589 \r
 590   (* mainvisu affiche dans le cadre le code du main *)\r
 591   UNIT mainvisu : PROCEDURE;\r
 592   VAR couleur:integer;\r
 593   BEGIN\r
 594     call COLOR(7);\r
 595     (* cadre entourant le code du main *)\r
 596     couleur:=7;\r
 597     call cadre(12,20,200,228,couleur);\r
 598     call MOVE(12,192);\r
 599     call HFILL(200);\r
 600     call MOVE(16,24);\r
 601     call OUTSTRING("PROGRAM prodcons;");\r
 602     call MOVE(16,40);\r
 603     call OUTSTRING("VAR"); \r
 604     call MOVE(16,48);\r
 605     call OUTSTRING(" prod:producer,");\r
 606     call MOVE(16,56);\r
 607     call OUTSTRING(" cons:consumer,");\r
 608     call MOVE(16,64);\r
 609     call OUTSTRING(" n,mag:integer,");\r
 610     call MOVE(16,72);\r
 611     call OUTSTRING(" last:boolean;");\r
 612     call MOVE(16,88);\r
 613     call OUTSTRING("BEGIN");\r
 614     call MOVE(16,96);\r
 615     call OUTSTRING(" prod:=new producer;");\r
 616     call MOVE(16,104);\r
 617     call OUTSTRING(" read(n);");\r
 618     call MOVE(16,112);\r
 619     call OUTSTRING(" cons:=new consumer(n);");\r
 620     call MOVE(16,120);\r
 621     call OUTSTRING(" attach(prod);");\r
 622     call MOVE(16,128);\r
 623     call OUTSTRING(" writeln;");\r
 624     call MOVE(16,136);\r
 625     call OUTSTRING("END prodcons;");\r
 626   END mainvisu;\r
 627 \r
 628   (* prodvisu (coroutine 1) affiche dans le cadre le code de producer *)\r
 629   UNIT prodvisu : PROCEDURE;\r
 630   VAR couleur:integer;\r
 631   BEGIN\r
 632     (* Cadre de la 1ere coroutine *)\r
 633     couleur:=7;\r
 634     call cadre(216,20,412,272,couleur);\r
 635     (* Ecriture du code de la 1ere coroutine *)\r
 636     call MOVE(220,24);\r
 637     call OUTSTRING("UNIT producer:COROUTINE;");\r
 638     call MOVE(220,40);\r
 639     call OUTSTRING("BEGIN");\r
 640     call MOVE(220,48);\r
 641     call OUTSTRING(" return;");\r
 642     call MOVE(220,56);\r
 643     call OUTSTRING(" DO");\r
 644     call MOVE(220,64);\r
 645     call OUTSTRING("  read(mag);");\r
 646     call MOVE(220,72);\r
 647     call OUTSTRING("  if mag=0 then");\r
 648     call MOVE(220,80);\r
 649     call OUTSTRING("   last:=true;");\r
 650     call MOVE(220,88);\r
 651     call OUTSTRING("   exit;");\r
 652     call MOVE(220,96);\r
 653     call OUTSTRING("  fi;");\r
 654     call MOVE(220,104);\r
 655     call OUTSTRING("  attach(cons);");\r
 656     call MOVE(220,112);\r
 657     call OUTSTRING(" OD;");\r
 658     call MOVE(220,120);\r
 659     call OUTSTRING(" attach(cons);");\r
 660     call MOVE(220,128);\r
 661     call OUTSTRING("END producer;");\r
 662   END prodvisu;\r
 663 \r
 664   (* consvisu (coroutine 2) affiche dans le cadre le code de consumer *)\r
 665   UNIT consvisu : PROCEDURE;\r
 666   VAR couleur:integer;\r
 667   BEGIN\r
 668     couleur:=7;\r
 669     call cadre(428,20,628,272,couleur); (* Cadre de la coroutine 2 cad consumer*)\r
 670     call MOVE(428,252);\r
 671     call HFILL(628);\r
 672     (* Ecriture du code de la 2eme coroutine *)\r
 673     call MOVE(432,24);\r
 674     call OUTSTRING("UNIT consumer:coroutine");\r
 675     call MOVE(432,32);\r
 676     call OUTSTRING("     (n:integer);");\r
 677     call MOVE(432,48);\r
 678     call OUTSTRING("VAR buf:arrayof integer,");\r
 679     call MOVE(432,56);\r
 680     call OUTSTRING("    i,j:integer;");\r
 681     call MOVE(432,64);\r
 682     call OUTSTRING("BEGIN");\r
 683     call MOVE(432,72);\r
 684     call OUTSTRING(" array buf dim(1:n);");\r
 685     call MOVE(432,80);\r
 686     call OUTSTRING(" return;");\r
 687     call MOVE(432,88);\r
 688     call OUTSTRING(" DO");\r
 689     call MOVE(432,96);\r
 690     call OUTSTRING("  for i:=1 to n");\r
 691     call MOVE(432,104);\r
 692     call OUTSTRING("  DO");\r
 693     call MOVE(432,112);\r
 694     call OUTSTRING("   buf(i):=mag;");\r
 695     call MOVE(432,120);\r
 696     call OUTSTRING("   attach(prod);");\r
 697     call MOVE(432,128);\r
 698     call OUTSTRING("   if last then");\r
 699     call MOVE(432,136);\r
 700     call OUTSTRING("   exit exit fi;");\r
 701     call MOVE(432,144);\r
 702     call OUTSTRING("  OD");\r
 703     call MOVE(432,152);\r
 704     call OUTSTRING("  for i:=1 to n");\r
 705     call MOVE(432,160);\r
 706     call OUTSTRING("  DO");\r
 707     call MOVE(432,168);\r
 708     call OUTSTRING("   write(' ',buf(i));");\r
 709     call MOVE(432,176);\r
 710     call OUTSTRING("  OD;");\r
 711     call MOVE(432,184);\r
 712     call OUTSTRING("  writeln;");\r
 713     call MOVE(432,192);\r
 714     call OUTSTRING(" OD");\r
 715     call MOVE(432,200);\r
 716     call OUTSTRING(" for j:=1 to i DO");\r
 717     call MOVE(432,208);\r
 718     call OUTSTRING("  write(' ',buf(i));");\r
 719     call MOVE(432,216);\r
 720     call OUTSTRING("  OD;");\r
 721     call MOVE(432,224);\r
 722     call OUTSTRING(" writeln;");\r
 723     call MOVE(432,232);\r
 724     call OUTSTRING(" attach(main);");\r
 725     call MOVE(432,240);\r
 726     call OUTSTRING("END consumer;");\r
 727   END consvisu;\r
 728 \r
 729 \r
 730   (* instalnorm affiche le code du main et attend click sur execution/quitter *)\r
 731   UNIT instalnorm : PROCEDURE(typexec,xpa,ypa:integer;inout execok:boolean);\r
 732   VAR i,touche,rep,couleur:integer,\r
 733       selection:boolean;\r
 734   HANDLERS\r
 735     when fin:stopexec:=true;\r
 736              terminate;\r
 737   END HANDLERS;\r
 738   BEGIN\r
 739       selection:=false;\r
 740       g:=false;\r
 741       d:=false;\r
 742       c:=false;\r
 743       (* Affichage du code du main*) \r
 744       call mainvisu;\r
 745       if typexec=5 and xpa=14 then\r
 746         couleur:=12;\r
 747         call cadre(xpa,ypa-4,198,ypa+4,couleur);\r
 748       fi;\r
 749       call COLOR(12);\r
 750       call MOVE(12,296);\r
 751       call OUTSTRING("Selectionnez 'execution' ou 'quitter' en cliquant sur l'icone correspondante");\r
 752       (* Gestion de la souris *)\r
 753       DO\r
 754         call GETPRESS(0,h,v,b,g,d,c);\r
 755         if g then\r
 756           call POSmouse(h,v,selection,rep);\r
 757           call HIDECURSOR;\r
 758           if not selection then\r
 759             g:=false;\r
 760             call SHOWCURSOR;\r
 761             repeat;\r
 762           else\r
 763             if rep=0 then   (* l'utilisateur a clique sur quitter *) \r
 764               raise fin;\r
 765             else   (* l'utilisateur a clicke sur execution *) \r
 766               call COLOR(0);\r
 767               call MOVE(12,296);\r
 768               call OUTSTRING("Selectionnez 'execution' ou 'quitter' en cliquant sur l'icone correspondante");\r
 769               call COLOR(8);\r
 770               call MOVE(16,240);\r
 771               call OUTSTRING("Execution");\r
 772        \r
 773               if typexec=3 or typexec=5 then \r
 774                 call COLOR(8);           \r
 775                 call MOVE(16,260);\r
 776                 call OUTSTRING("Quitter");\r
 777                 call SHOWCURSOR;\r
 778 \r
 779               else (*typexec=4*)\r
 780                 call COLOR(7);\r
 781                 (* Bouton "continuer" pour avancer pas a pas dans l'execution*)\r
 782                 couleur:=7;\r
 783                 call cadre(120,236,200,252,couleur);\r
 784                 call MOVE(124,240);\r
 785                 call COLOR(12);\r
 786                 call OUTSTRING("Continuer");\r
 787                 call SHOWCURSOR;\r
 788               fi;          \r
 789               execok:=true;\r
 790 \r
 791             fi;\r
 792             exit;\r
 793           fi;\r
 794         fi;\r
 795       OD;\r
 796   END instalnorm;\r
 797 \r
 798 \r
 799 (********************************************************************************)\r
 800 (* Procedure permettant la prise en compte d'une execution avec point d'arret   *)\r
 801 (********************************************************************************)\r
 802 \r
 803   (* selectpoint permet de prendre en compte le point d'arret choisi*)\r
 804   (* par l'utilisateur*)\r
 805   UNIT selectpoint : PROCEDURE(inout x,y:integer);\r
 806   VAR i,touche,rep,numcode:integer,\r
 807       selection:boolean;\r
 808   HANDLERS\r
 809     when fin:stopexec:=true;\r
 810              terminate;\r
 811   END HANDLERS;\r
 812   BEGIN\r
 813       selection:=false;\r
 814       g:=false;\r
 815       d:=false;\r
 816       c:=false;\r
 817 \r
 818       (* Affichage du message demandant la selection du point d'arret*)\r
 819       call COLOR(12);\r
 820       call MOVE(16,296);\r
 821       call OUTSTRING("Cliquez sur la ligne qui sera le point d'arret de l'execution");\r
 822 \r
 823       (* Gestion de la souris *)\r
 824       DO\r
 825         call GETPRESS(0,h,v,b,g,d,c);\r
 826         if g then\r
 827           call ptarret(h,v,selection,numcode);\r
 828           call HIDECURSOR;\r
 829           if not selection then\r
 830             g:=false;\r
 831             call SHOWCURSOR;\r
 832             repeat;\r
 833           else\r
 834             if numcode=0 then\r
 835               raise fin;\r
 836             fi;                       \r
 837             call encadrpt(numcode,v); \r
 838             call COLOR(0);\r
 839             call MOVE(16,296);\r
 840             call OUTSTRING("Cliquez sur la ligne qui sera le point d'arret de l'execution");\r
 841             call COLOR(8);\r
 842             call MOVE(16,260);\r
 843             call OUTSTRING("Quitter");\r
 844             call COLOR(12);\r
 845             call MOVE(16,296);\r
 846             call OUTSTRING("Tapez <RC> pour valider votre selection");\r
 847             touche:=inchar;\r
 848             call COLOR(0);\r
 849             call MOVE(16,296);\r
 850             call OUTSTRING("Tapez <RC> pour valider votre selection");\r
 851             y:=v;\r
 852             if numcode=1 then\r
 853               x:=14;\r
 854             else\r
 855               if numcode=2 then \r
 856                 x:=218;\r
 857               else\r
 858                 x:=430;\r
 859               fi;\r
 860             fi;               \r
 861             exit;\r
 862           fi;\r
 863         fi;\r
 864       OD;\r
 865   END selectpoint;\r
 866 \r
 867 \r
 868 (********************************************************************************)\r
 869 (* Procedures utilisees pour l'execution du programme                           *)\r
 870 (********************************************************************************)\r
 871 \r
 872   (* fleche permet d'afficher une fleche devant l'instruction courante *)\r
 873   UNIT fleche : PROCEDURE(input x,y,xpa,ypa,numcode,choixexe:integer);\r
 874   VAR rempli,atteint:boolean;\r
 875   BEGIN\r
 876     call MOVE(x,y); \r
 877     call COLOR(12);\r
 878     call OUTSTRING("->");\r
 879 \r
 880     (*Execution avec point d'arret*)\r
 881     if numcode=1 then\r
 882       if (xpa=x+14) and (ypa-4=y) then\r
 883         atteint:=true;\r
 884         call finexecut(choixexe,rempli,atteint);\r
 885       fi;\r
 886     fi;\r
 887     if numcode=2 or numcode=3 then\r
 888       if (xpa=x+18) and (ypa-4=y) then\r
 889         atteint:=true;\r
 890         call finexecut(choixexe,rempli,atteint);\r
 891       fi;\r
 892     fi;\r
 893   END fleche; \r
 894 \r
 895   (* Changecoul permet de modifier la couleur du cadre des record selon*)\r
 896   (* qu'ils sont actifs ou non*)\r
 897   UNIT changecoul : PROCEDURE(couleur,numcode:integer);\r
 898   BEGIN\r
 899     if numcode=1 then\r
 900       call cadre(12,20,200,228,couleur);\r
 901     fi;\r
 902     if numcode=2 then\r
 903       call cadre(216,20,412,272,couleur);\r
 904     fi;    \r
 905     if numcode=3 then\r
 906       call cadre(428,20,628,272,couleur);\r
 907     fi;\r
 908     call COLOR(12); \r
 909   END changecoul;\r
 910 \r
 911   (* restaure permet de supprimer la fleche courante et provoque un temps d'arret*)\r
 912   (* apres chaque instruction.                                                   *)\r
 913   UNIT restaure : PROCEDURE(debx,deby,choixexe,numcode:integer);    \r
 914   VAR i,touche,rep:integer,\r
 915       selection:boolean;\r
 916   BEGIN\r
 917       selection:=false;\r
 918       g:=false;\r
 919       d:=false;\r
 920       c:=false;\r
 921       CASE choixexe\r
 922         when 3: (* Execution normale du programme choisi*)\r
 923           for i:=1 to 10000  do  od;\r
 924 \r
 925         when 4: (* Execution pas a pas du programme choisi*)\r
 926           (* Gestion de la souris *)\r
 927           driver:=init(b);\r
 928           call SETPOSITION(160,244);\r
 929 \r
 930           call SHOWCURSOR;\r
 931           DO\r
 932             call GETPRESS(0,h,v,b,g,d,c);\r
 933             if g then\r
 934               call GoStop(h,v,selection,rep);\r
 935               call HIDECURSOR;\r
 936               if not selection then\r
 937                 g:=false;\r
 938                 call SHOWCURSOR;\r
 939                 repeat;\r
 940               else\r
 941                 if rep=0 then   (* l'utilisateur a clique sur quitter *) \r
 942                   raise fin;\r
 943                 fi;\r
 944                 (* l'utilisateur a clique sur continuer *) \r
 945                 exit;\r
 946               fi;\r
 947             fi;\r
 948           OD;\r
 949         \r
 950         when 5: (* Execution avec point d'arret du programme choisi*) \r
 951           for i:=1 to 10000  do  od;\r
 952         \r
 953       ESAC;\r
 954       (* Effacement de la fleche se trouvant devant la ligne courante*)\r
 955       call MOVE(debx,deby);\r
 956       call COLOR(0);\r
 957       call OUTSTRING("->");\r
 958       call COLOR(7);\r
 959       if numcode=1 then\r
 960         call MOVE(8,deby);\r
 961         call VFILL(deby+8);\r
 962         call COLOR(10);\r
 963         call MOVE(12,deby);\r
 964         call VFILL(deby+8);\r
 965       fi;\r
 966       if numcode=2 then\r
 967         call MOVE(200,deby);\r
 968         call VFILL(deby+8);\r
 969       fi;\r
 970       if numcode=3 then\r
 971         call MOVE(412,deby);\r
 972         call VFILL(deby+8);\r
 973       fi;\r
 974   END restaure;\r
 975 \r
 976   (* execut permet l'execution du programme *)\r
 977   UNIT execut : PROCEDURE(input choixexe,xpa,ypa:integer);\r
 978   VAR touche,k,x,y,i,j,n,mag,numcode,nbaffic,nbcases,rep,couleur:integer,\r
 979       passe,last,encore,magzero,rempli,atteint:boolean,\r
 980       buf:arrayof integer;\r
 981   HANDLERS\r
 982     when fin:stopexec:=true;\r
 983          terminate;\r
 984   END HANDLERS;\r
 985 \r
 986   BEGIN \r
 987     array buf dim(1:10);\r
 988     rempli:=false;\r
 989     (* 1ere ligne du main*)\r
 990     numcode:=1;\r
 991     call changecoul(10,numcode);\r
 992     x:=0;\r
 993     y:=24;\r
 994     call fleche(x,y,xpa,ypa,numcode,choixexe);\r
 995     call restaure(x,y,choixexe,numcode);\r
 996     (* 3eme ligne du main*)\r
 997     y:=48;\r
 998     call fleche(x,y,xpa,ypa,numcode,choixexe);\r
 999     call restaure(x,y,choixexe,numcode);\r
1000     (* 4eme ligne du main*)\r
1001     y:=56;\r
1002     call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1003     call restaure(x,y,choixexe,numcode);\r
1004     (* 5eme ligne du main*)\r
1005     y:=64;\r
1006     call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1007     (* Affichage de la valeur de n et mag *)\r
1008     call MOVE(16,196);\r
1009     call OUTSTRING("n = 0  et mag = 0");\r
1010     call restaure(x,y,choixexe,numcode);\r
1011     (* 6eme ligne du main*)\r
1012     y:=72;\r
1013     call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1014     (* Affichage de la valeur de last*)\r
1015     call MOVE(16,212);\r
1016     call OUTSTRING("last = false");\r
1017     call restaure(x,y,choixexe,numcode);\r
1018     (* 7eme ligne du main*)\r
1019     y:=88;\r
1020     call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1021     call restaure(x,y,choixexe,numcode);\r
1022     (* 8eme ligne du main*)\r
1023     y:=96;\r
1024     call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1025     call changecoul(7,numcode);\r
1026 \r
1027     (* Affichage du code de la coroutine 1 cad producer*)\r
1028     call prodvisu;\r
1029     if typexec=5 and xpa=218 then\r
1030       couleur:=12;\r
1031       call cadre(xpa,ypa-4,410,ypa+4,couleur);\r
1032     fi;\r
1033     (* Debut de l'execution de la 1ere coroutine*)\r
1034     (* 1ere ligne de la coroutine 1*)\r
1035     x:=200;\r
1036     numcode:=2;\r
1037     call changecoul(10,numcode);\r
1038     y:=24;\r
1039     call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1040     call restaure(x,y,choixexe,numcode);\r
1041     (* 2eme ligne de la coroutine 1*)\r
1042     y:=40;\r
1043     call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1044     call restaure(x,y,choixexe,numcode);\r
1045     (* 3eme ligne de la coroutine 1*)\r
1046     y:=48;\r
1047     call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1048     call changecoul(7,numcode);\r
1049 \r
1050     (* On revient au programme appelant cad le main*)\r
1051     x:=0;\r
1052     numcode:=1;\r
1053     call changecoul(10,numcode);\r
1054     y:=96;\r
1055     call restaure(x,y,choixexe,numcode);\r
1056     (* 9eme ligne du main*)\r
1057     y:=104;\r
1058     call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1059 \r
1060     DO\r
1061       call COLOR(12);\r
1062       call MOVE(12,296);\r
1063       call OUTSTRING("Entrez la taille du tableau buf (<=10) et tapez <RC>: ");\r
1064       n:=ReadInteger;\r
1065       call WriteInteger(n);\r
1066       call HIDECURSOR;\r
1067       call COLOR(0);\r
1068       call MOVE(12,296);\r
1069       call OUTSTRING("Entrez la taille du tableau buf (<=10) et tapez <RC>: ");\r
1070       call WriteInteger(n);\r
1071       call SHOWCURSOR;\r
1072       (* Test sur la valeur de la taille du tableau*)\r
1073       if n=0 or n>10 then\r
1074         call COLOR(12);\r
1075         call MOVE(12,296);\r
1076         call OUTSTRING("Vous devez entrer une valeur comprise entre 1 et 10 (tapez <RC>) !");\r
1077         touche:=inchar;\r
1078         call COLOR(0);\r
1079         call MOVE(12,296);\r
1080         call OUTSTRING("Vous devez entrer une valeur comprise entre 1 et 10 (tapez <RC>) !");\r
1081       else\r
1082         exit\r
1083       fi; \r
1084     od;\r
1085       \r
1086     (* Mise a jour de la valeur de n*)\r
1087     call COLOR(12);\r
1088     call MOVE(48,196);\r
1089     call WriteInteger(n);\r
1090     call restaure(x,y,choixexe,numcode);   \r
1091     (* 10eme ligne du main*)\r
1092     y:=112;\r
1093     call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1094     call changecoul(7,numcode);\r
1095 \r
1096     (* Affichage du code de la coroutine 2 cad consumer*)\r
1097     call consvisu;\r
1098     if typexec=5 and xpa=430 then\r
1099       couleur:=12;\r
1100       call cadre(xpa,ypa-4,626,ypa+4,couleur);\r
1101     fi;\r
1102     (* Debut de l'execution de la coroutine 2*)\r
1103     (* ligne 1 de la coroutine 2*)\r
1104     x:=412;\r
1105     numcode:=3;\r
1106     call changecoul(10,numcode);\r
1107     y:=24;\r
1108     call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1109     call restaure(x,y,choixexe,numcode);\r
1110     (* ligne 3 de la coroutine 2*)\r
1111     y:=48;\r
1112     call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1113     call restaure(x,y,choixexe,numcode);\r
1114     (* ligne 4 de la coroutine 2*)\r
1115     y:=56;\r
1116     call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1117     call MOVE(432,264);\r
1118     call OUTSTRING("i = 0  et j = 0"); \r
1119     call restaure(x,y,choixexe,numcode); \r
1120     (* ligne 5 de la coroutine 2*)\r
1121     y:=64;\r
1122     call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1123     call restaure(x,y,choixexe,numcode);\r
1124     (* ligne 6 de la coroutine 2*)\r
1125     y:=72;\r
1126     call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1127     call MOVE(432,256);\r
1128     call OUTSTRING("buf :");\r
1129     for i:=0 to n-1 \r
1130     DO\r
1131       call MOVE(472+i*16,256);\r
1132       if i=n-1 then\r
1133         call OUTSTRING("0");\r
1134       else\r
1135         call OUTSTRING("0,");\r
1136       fi;\r
1137     OD;\r
1138     call restaure(x,y,choixexe,numcode);  \r
1139     (* ligne 7 de la coroutine 2*)\r
1140     y:=80;\r
1141     call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1142     call changecoul(7,numcode);\r
1143     \r
1144     (* Retour a la procedure appelante cad le main*)\r
1145     x:=0;\r
1146     numcode:=1;\r
1147     call changecoul(10,numcode);\r
1148     y:=112;\r
1149     call restaure(x,y,choixexe,numcode);\r
1150     (* 11eme ligne du main*)\r
1151     y:=120;\r
1152     call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1153     call changecoul(7,numcode);\r
1154     \r
1155     (* Retour a la coroutine 1 cad producer*)\r
1156     x:=200;\r
1157     numcode:=2;\r
1158     call changecoul(10,numcode);\r
1159     y:=48;\r
1160     call restaure(x,y,choixexe,numcode);\r
1161 \r
1162     DO  (* Gros DO*)\r
1163       x:=200;\r
1164       numcode:=2;\r
1165       call changecoul(10,numcode);\r
1166       (* 4eme ligne de la coroutine 1*)\r
1167       y:=56;\r
1168       call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1169       call restaure(x,y,choixexe,numcode); \r
1170       (* 5eme ligne de la coroutine 1*)\r
1171       y:=64;\r
1172       call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1173 \r
1174       if nbaffic=4 then\r
1175         rempli:=true;\r
1176         call finexecut(choixexe,rempli,atteint);\r
1177         exit\r
1178       fi;\r
1179       DO\r
1180         call COLOR(12);\r
1181         call MOVE(12,296);\r
1182         if nbaffic=3 then\r
1183           call OUTSTRING("Vous devez a present taper zero comme valeur du tableau et <RC>: ");\r
1184         else\r
1185           call OUTSTRING("Entrez la valeur (<10) a stocker dans le tableau et tapez <RC>: ");\r
1186         fi;\r
1187         mag:=ReadInteger;\r
1188         (* Mise a jour de la valeur de mag*)\r
1189         call MOVE(144,196);\r
1190         call WriteInteger(mag);\r
1191         call COLOR(0);\r
1192         call MOVE(12,296);\r
1193         call OUTSTRING("Entrez la valeur (<10) a stocker dans le tableau et tapez <RC>: ");\r
1194         call WriteInteger(mag);\r
1195         (* Test sur la valeur de mag qui doit etre < 10*)\r
1196         if mag > 9 then\r
1197           call COLOR(12);\r
1198           call MOVE(12,296);\r
1199           call OUTSTRING("Vous devez entrer une valeur comprise entre 0 et 9 (tapez <RC>) !");\r
1200           touche:=inchar;\r
1201           call COLOR(0);\r
1202           call MOVE(12,296);\r
1203           call OUTSTRING("Vous devez entrer une valeur comprise entre 0 et 9 (tapez <RC>) !");\r
1204         else\r
1205           exit;\r
1206         fi;\r
1207       OD;\r
1208       call restaure(x,y,choixexe,numcode);\r
1209       (* 6eme ligne de la coroutine 1*)\r
1210       y:=72;\r
1211       call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1212       if mag=0 then\r
1213         if not passe then\r
1214           magzero:=true;\r
1215         fi;\r
1216         call restaure(x,y,choixexe,numcode);\r
1217         (* 7eme ligne de la coroutine 1*)\r
1218         y:=80;\r
1219         call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1220         (* MAJ de la variable last*)\r
1221         last:=true;\r
1222         call MOVE(72,212);\r
1223         call COLOR(0);\r
1224         call OUTSTRING("false");\r
1225         call MOVE(72,212);\r
1226         call COLOR(12);\r
1227         call OUTSTRING("true");\r
1228         call restaure(x,y,choixexe,numcode);\r
1229         (* 8eme ligne de la coroutine 1 *)\r
1230         y:=88;\r
1231         call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1232         call restaure(x,y,choixexe,numcode);\r
1233         (* 12eme ligne de la coroutine 1*)\r
1234         y:=120;\r
1235         call fleche(x,y,xpa,ypa,numcode,choixexe);  (* on va au moyen DO*)\r
1236       else\r
1237         call restaure(x,y,choixexe,numcode);\r
1238         (* 9eme ligne de la coroutine1*)\r
1239         y:=96;\r
1240         call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1241         call restaure(x,y,choixexe,numcode);\r
1242         (* 10eme ligne de la coroutine1 *)\r
1243         y:=104;\r
1244         call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1245       fi;\r
1246       call changecoul(7,numcode);\r
1247 \r
1248       (* retour a la coroutine 2 cad consumer*)\r
1249       DO (* Moyen DO*)\r
1250         x:=412;\r
1251         numcode:=3;\r
1252         call changecoul(10,numcode);\r
1253         if not passe or encore then\r
1254           if not passe then\r
1255             y:=80;\r
1256             call restaure(x,y,choixexe,numcode);\r
1257           fi;\r
1258           (* 8eme ligne de la coroutine 2 *)\r
1259           y:=88;\r
1260           call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1261           call restaure(x,y,choixexe,numcode);\r
1262           passe:=true;\r
1263           encore:=false;\r
1264         else\r
1265           y:=120;\r
1266           call restaure(x,y,choixexe,numcode);\r
1267           (* 13eme ligne de la coroutine 2 *)\r
1268           y:=128;\r
1269           call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1270           if last then\r
1271             call restaure(x,y,choixexe,numcode);\r
1272             (* 14eme ligne de la coroutine 2*)\r
1273             y:=136;\r
1274             call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1275             call restaure(x,y,choixexe,numcode);\r
1276             exit exit\r
1277           else\r
1278             nbcases:=nbcases+1;\r
1279             call restaure(x,y,choixexe,numcode);            \r
1280             (* 15eme ligne de la coroutine 2*)\r
1281             y:=144;\r
1282             call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1283             call restaure(x,y,choixexe,numcode);\r
1284           fi;\r
1285         fi;\r
1286              \r
1287         DO (* Petit DO*)\r
1288           (* 9eme ligne de la coroutine 2 *)\r
1289           y:=96;\r
1290           call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1291           (* Affichage de l'indice de buf*)\r
1292           call MOVE(464,264); \r
1293           call WriteInteger(nbcases+1);        \r
1294           call restaure(x,y,choixexe,numcode);\r
1295           if nbcases=n then\r
1296             exit\r
1297           fi;\r
1298           (* 10eme ligne de la coroutine 2 *)\r
1299           y:=104;\r
1300           call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1301           call restaure(x,y,choixexe,numcode);\r
1302           (* 11eme ligne de la coroutine 2 *)\r
1303           y:=112;\r
1304           call fleche(x,y,xpa,ypa,numcode,choixexe); \r
1305           (* MAJ du tableau buf avec la valeur de mag*)\r
1306           buf(nbcases+1):=mag;\r
1307           call MOVE(472+nbcases*16,256);\r
1308           call WriteInteger(buf(nbcases+1));\r
1309           if nbcases+1<>n then\r
1310             call MOVE(480+nbcases*16,256);\r
1311             call OUTSTRING(",");\r
1312           fi;\r
1313           call restaure(x,y,choixexe,numcode);\r
1314           (* 12eme ligne de la coroutine 2 *)\r
1315           y:=120;\r
1316           call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1317           call changecoul(7,numcode); \r
1318  \r
1319           (* Retour a la coroutine 1 cad producer*)\r
1320           x:=200;\r
1321           numcode:=2;\r
1322           call changecoul(10,numcode);\r
1323           if magzero then\r
1324             y:=120;\r
1325             call restaure(x,y,choixexe,numcode);\r
1326             (* 13eme ligne de la coroutine 1*)\r
1327             y:=128;\r
1328             call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1329             call restaure(x,y,choixexe,numcode);\r
1330             (* Destruction du record d'activation de la coroutine 1 cad producer*)\r
1331             call COLOR(10);\r
1332             call MOVE(216,20);\r
1333             call DRAW(412,272);\r
1334             call MOVE(412,20);\r
1335             call DRAW(216,272);\r
1336             call COLOR(12);\r
1337             call changecoul(7,numcode);\r
1338             call MOVE(12,296);\r
1339             call COLOR(10);\r
1340             call OUTSTRING("ATTENTION : Le record d'activation de Producer vient d'etre detruit !");\r
1341             for i:=1 to 20000 do od;\r
1342             call MOVE(12,296);\r
1343             call COLOR(0);\r
1344             call OUTSTRING("ATTENTION : Le record d'activation de Producer vient d'etre detruit !");\r
1345             exit\r
1346           else\r
1347             y:=104;\r
1348             call restaure(x,y,choixexe,numcode);\r
1349             (* ligne 11 de la coroutine 1*)\r
1350             y:=112;\r
1351             call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1352             call restaure(x,y,choixexe,numcode);\r
1353             exit exit\r
1354           fi;\r
1355         od;\r
1356 \r
1357         if not magzero then\r
1358           call COLOR(8);\r
1359           (* Retour a la coroutine 2 cad consumer*)\r
1360           (* Impression du tampon buf*)\r
1361           nbcases:=0;\r
1362           i:=0;\r
1363           do\r
1364             (* 16eme ligne de la coroutine 2*)\r
1365             y:=152;\r
1366             call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1367             call restaure(x,y,choixexe,numcode);\r
1368             (* Affichage de l'indice de buf*)\r
1369             call COLOR(12);\r
1370             call MOVE(464,264); \r
1371             call WriteInteger(i+1); \r
1372             if i<>n then\r
1373               (* 17eme ligne de la coroutine 2*)\r
1374               y:=160;\r
1375               call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1376               call restaure(x,y,choixexe,numcode);\r
1377               (* 18eme ligne de la coroutine 2*)\r
1378               y:=168;\r
1379               call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1380               call MOVE(12+i*16,304+nbaffic*8);\r
1381               call OUTSTRING(" ");\r
1382               call WriteInteger(buf(i+1));\r
1383               call restaure(x,y,choixexe,numcode);\r
1384             fi;\r
1385             (* 19eme ligne de la coroutine 2*)\r
1386             y:=176;\r
1387             call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1388             call restaure(x,y,choixexe,numcode);\r
1389             if i=n then\r
1390               exit\r
1391             fi;\r
1392             i:=i+1;\r
1393           od;\r
1394           (* ligne 20 de la coroutine 2*)\r
1395           y:=184;\r
1396           call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1397           call restaure(x,y,choixexe,numcode);\r
1398           nbaffic:=nbaffic+1;\r
1399           encore:=true;\r
1400         fi;\r
1401       od;\r
1402     od;\r
1403                 \r
1404     (* Imprime le reste du tampon buf*)\r
1405     (* 22eme ligne de la coroutine 2*)\r
1406     k:=0;\r
1407     for j:=1 to nbcases+1 \r
1408     do\r
1409       y:=200;\r
1410       call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1411       (* Affichage de l'indice de buf*)\r
1412       call MOVE(544,264); \r
1413       call WriteInteger(j); \r
1414       call restaure(x,y,choixexe,numcode);\r
1415       (* 23eme ligne de la coroutine 2*)\r
1416       y:=208;\r
1417       call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1418       call MOVE(12+k*16,304+nbaffic*8);\r
1419       call OUTSTRING(" ");\r
1420       call WriteInteger(buf(j));\r
1421       call restaure(x,y,choixexe,numcode);\r
1422       (* 24eme ligne de la coroutine 2*) \r
1423       y:=216;\r
1424       call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1425       call restaure(x,y,choixexe,numcode);\r
1426       k:=k+1; \r
1427     od;\r
1428     (* 25eme ligne de la coroutine 2*)\r
1429     y:=224;\r
1430     call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1431     call restaure(x,y,choixexe,numcode);\r
1432     (* 26eme ligne de la coroutine 2*) \r
1433     y:=232;\r
1434     call fleche(x,y,xpa,ypa,numcode,choixexe);   \r
1435     call changecoul(7,numcode);\r
1436 \r
1437     (* Retour a la ligne 11 du main*)\r
1438     x:=0;\r
1439     numcode:=1;\r
1440     call changecoul(10,numcode);\r
1441     y:=120;\r
1442     call restaure(x,y,choixexe,numcode);\r
1443     (* 12eme ligne du main*)\r
1444     y:=128;\r
1445     call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1446     call restaure(x,y,choixexe,numcode);\r
1447     (* 13eme et derniere ligne du main*)\r
1448     y:=136;\r
1449     call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1450     call restaure(x,y,choixexe,numcode);\r
1451     (* Destruction du record d'activation du main*)\r
1452     call COLOR(10);\r
1453     call MOVE(12,20);\r
1454     call DRAW(200,228);\r
1455     call MOVE(200,20);\r
1456     call DRAW(12,228);\r
1457     call changecoul(7,numcode);\r
1458     call MOVE(12,296);\r
1459     call COLOR(10);\r
1460     call OUTSTRING("ATTENTION : Le record d'activation du Main vient d'etre detruit !");\r
1461     for i:=1 to 20000 do od;\r
1462     call MOVE(12,296);\r
1463     call COLOR(0);\r
1464     call OUTSTRING("ATTENTION : Le record d'activation du Main vient d'etre detruit !");\r
1465     \r
1466     call COLOR(12);\r
1467     (* Retour a la ligne 26 de la coroutine2*)\r
1468     x:=412;\r
1469     numcode:=3;\r
1470     call changecoul(10,numcode);\r
1471     y:=232;\r
1472     call restaure(x,y,choixexe,numcode);\r
1473     (* 27eme ligne de la coroutine2*)\r
1474     y:=240;\r
1475     call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1476     call restaure(x,y,choixexe,numcode);\r
1477     (* Destruction du record d'activation de la coroutine 2 cad consumer*)\r
1478     call COLOR(10);\r
1479     call MOVE(428,20);\r
1480     call DRAW(628,272);\r
1481     call MOVE(628,20);\r
1482     call DRAW(428,272);\r
1483     call changecoul(7,numcode);\r
1484     call MOVE(12,296);\r
1485     call COLOR(10);\r
1486     call OUTSTRING("ATTENTION : Le record d'activation de Consumer vient d'etre detruit !");\r
1487     for i:=1 to 20000 do od;\r
1488     call MOVE(12,296);\r
1489     call COLOR(0);\r
1490     call OUTSTRING("ATTENTION : Le record d'activation de Consumer vient d'etre detruit !");\r
1491     call COLOR(12);\r
1492     if not magzero then\r
1493       (* Retour a la ligne 12 de la coroutine1*)\r
1494       x:=200;\r
1495       numcode:=2;\r
1496       call changecoul(10,numcode);\r
1497       y:=120;\r
1498       call restaure(x,y,choixexe,numcode);\r
1499        (* 13eme ligne de la coroutine 1*)\r
1500       y:=128;\r
1501       call fleche(x,y,xpa,ypa,numcode,choixexe);\r
1502       call restaure(x,y,choixexe,numcode);\r
1503       (* Destruction du record d'activation de la coroutine 1 cad producer*)\r
1504       call COLOR(10);\r
1505       call MOVE(216,20);\r
1506       call DRAW(412,272);\r
1507       call MOVE(412,20);\r
1508       call DRAW(216,272);\r
1509       call changecoul(7,numcode);\r
1510       call MOVE(12,296);\r
1511       call COLOR(10);\r
1512       call OUTSTRING("ATTENTION : Le record d'activation du Producer vient d'etre detruit !");\r
1513       for i:=1 to 20000 do od;\r
1514       call MOVE(12,296);\r
1515       call COLOR(0);\r
1516       call OUTSTRING("ATTENTION : Le record d'activation de Producer vient d'etre detruit !");\r
1517     fi;\r
1518     if choixexe=4 then\r
1519       call COLOR(8);  (* L'execution est terminee on ne peut donc plus cliquer*)\r
1520                       (* sur Continuer*)\r
1521       call MOVE(124,240);\r
1522       call OUTSTRING("Continuer");\r
1523       call SHOWCURSOR;\r
1524     fi;\r
1525     call COLOR(12);\r
1526     call finexecut(choixexe,rempli,atteint);\r
1527   END execut;\r
1528 \r
1529 \r
1530 (********************************************************************************)\r
1531 (* Procedures gerant l'option A propos des coroutines                           *)\r
1532 (********************************************************************************)\r
1533 \r
1534   (* boutontxt met en place et gere les boutons concernat l'option *)\r
1535   (* A propos des coroutines*)\r
1536   UNIT boutontxt : FUNCTION :integer;\r
1537   VAR choix:integer;\r
1538   BEGIN\r
1539     (* Mise en place du bouton Page suivante*)\r
1540     call cadre(428,320,558,336,12);\r
1541 \r
1542     (* Mise en place du bouton Quitter*)\r
1543     call cadre(8,320,88,336,12);\r
1544     call MOVE(20,324);\r
1545     call COLOR(12);\r
1546     call OUTSTRING("Quitter");\r
1547 \r
1548     (* Mise en place de la souris*)\r
1549     driver:=init(b);\r
1550     call SHOWCURSOR;\r
1551     selection:=false;\r
1552     g:=false;\r
1553     d:=false;\r
1554     c:=false;\r
1555     DO\r
1556       call GETPRESS(0,h,v,b,g,d,c);\r
1557       if g then\r
1558         call textquit(h,v,selection,choix);\r
1559         call HIDECURSOR;\r
1560         if not selection then\r
1561           g:=false;\r
1562           call SHOWCURSOR;\r
1563           repeat;\r
1564         else\r
1565           if choix=0 then\r
1566             result:=0;\r
1567           else\r
1568             result:=1;\r
1569           fi;\r
1570           exit;\r
1571         fi;\r
1572       fi;\r
1573     OD;\r
1574   END boutontxt;\r
1575 \r
1576 \r
1577   (* afficdef affiche a l'ecran la definition et l'utilite des coroutines*)\r
1578   UNIT afficdef : PROCEDURE;\r
1579   VAR touche,choix:integer;\r
1580   BEGIN\r
1581     call CLS;\r
1582     (* Mise en place du texte*)\r
1583     call MOVE(170,16);\r
1584     call COLOR(12);\r
1585     call OUTSTRING("DEFINITION ET INTERET DES COROUTINES");\r
1586     call MOVE(16,40);\r
1587     call OUTSTRING("I> Definition d'une coroutine");\r
1588     call COLOR(7);\r
1589     call MOVE(56,56);\r
1590     call OUTSTRING("Une coroutine est un objet tel que l'execution de sa sequence");\r
1591     call MOVE(56,64);\r
1592     call OUTSTRING("d'instructions peut etre suspendue et relancee de maniere pro-");\r
1593     call MOVE(56,72);\r
1594     call OUTSTRING("grammee."); \r
1595     call MOVE(56,80);\r
1596     call OUTSTRING("Il est important de preciser, qu'a un instant donne, une seule");\r
1597     call MOVE(56,88);\r
1598     call OUTSTRING("coroutine est active (en execution)."); \r
1599     call MOVE(56,100);\r
1600     call OUTSTRING("Par ailleurs, c'est une extension de la notion de classe, une");\r
1601     call MOVE(56,108);\r
1602     call OUTSTRING("classe etant une construction dans laquelle peuvent etre regrou-");\r
1603     call MOVE(56,116);\r
1604     call OUTSTRING("pes toutes sortes d'objets.");\r
1605     call COLOR(12);\r
1606     call MOVE(56,132);\r
1607     call OUTSTRING("Syntaxe");\r
1608     call COLOR(7);\r
1609     call MOVE(80,144);\r
1610     call OUTSTRING("UNIT <nom_coroutine> : <prefixe> COROUTINE(<parametres formels>);");\r
1611     call MOVE(120,152);\r
1612     call OUTSTRING("<declarations variables locales,fonctions,procedures,classes>");\r
1613     call MOVE(80,160);\r
1614     call OUTSTRING("BEGIN");\r
1615     call MOVE(120,168);\r
1616     call OUTSTRING("<instruction 1>");\r
1617     call MOVE(120,176);\r
1618     call OUTSTRING("return;");\r
1619     call MOVE(120,184);\r
1620     call OUTSTRING("<instruction 2...instruction n>");\r
1621     call MOVE(80,192);\r
1622     call OUTSTRING("END nom_coroutine;");\r
1623     call COLOR(12);\r
1624     call MOVE(16,216);\r
1625     call OUTSTRING("II> Interet des coroutines");\r
1626     call COLOR(7);\r
1627     call MOVE(56,232);\r
1628     call OUTSTRING("Les coroutines jouent un role essentiel dans les taches de simu-");\r
1629     call MOVE(56,240);\r
1630     call OUTSTRING("lation.");\r
1631     call MOVE(56,248);\r
1632     call OUTSTRING("Ainsi, divers problemes de simulation de grande complexite et de");\r
1633     call MOVE(56,256);\r
1634     call OUTSTRING("taille importante sont traitees avec succes par les coroutines.");\r
1635 \r
1636     (* Mise en place du bouton Quitter*)\r
1637     call cadre(8,320,88,336,10);\r
1638     call MOVE(20,324);\r
1639     call COLOR(10);\r
1640     call OUTSTRING("Quitter");\r
1641 \r
1642     (* Mise en place de la souris*)\r
1643     call SHOWCURSOR;\r
1644     selection:=false;\r
1645     g:=false;\r
1646     d:=false;\r
1647     c:=false;\r
1648     DO\r
1649       call GETPRESS(0,h,v,b,g,d,c);\r
1650       if g then\r
1651         call textquit(h,v,selection,choix);\r
1652         call HIDECURSOR;\r
1653         if not selection then\r
1654           g:=false;\r
1655           call SHOWCURSOR;\r
1656           repeat;\r
1657         else\r
1658           if choix=0 then\r
1659             (* l'utilisateur a clique sur quitter *) \r
1660             exit exit\r
1661           else\r
1662             repeat;\r
1663           fi;\r
1664         fi;\r
1665       fi;\r
1666     OD;\r
1667   END afficdef;\r
1668 \r
1669 \r
1670 (* afficinstr affiche a l'ecran le schema de la semantique des coroutines*)\r
1671   UNIT afficinstr : PROCEDURE;\r
1672   VAR touche,choix:integer;\r
1673   HANDLERS\r
1674     when fin:stopexec:=true;\r
1675          terminate;\r
1676   END HANDLERS;\r
1677   BEGIN\r
1678     call CLS;\r
1679     (* Mise en place du texte*)\r
1680     call MOVE(154,16);\r
1681     call COLOR(12);\r
1682     call OUTSTRING("INSTRUCTIONS ASSOCIEES AUX COROUTINES");\r
1683     call MOVE(258,32);\r
1684     call OUTSTRING("SEMANTIQUE");\r
1685 \r
1686     call MOVE(76,60);\r
1687     call COLOR(7);\r
1688     call OUTSTRING("Declaration : VAR C:nom_coroutine;"); \r
1689 \r
1690     call COLOR(12);\r
1691     call MOVE(206,76);\r
1692     call VFILL(90);\r
1693     call MOVE(202,90);\r
1694     call OUTSTRING("V");\r
1695     call cadre(146,100,266,116,10);\r
1696     call COLOR(7);\r
1697     call MOVE(174,104);\r
1698     call OUTSTRING("CREATION");\r
1699     call MOVE(222,83);\r
1700     call OUTSTRING("C:=new nom_coroutine(<parametres formels>);");\r
1701 \r
1702     call COLOR(12);\r
1703     call MOVE(206,118);\r
1704     call VFILL(130);\r
1705     call MOVE(202,130);\r
1706     call OUTSTRING("V");\r
1707     call cadre(146,140,266,156,10);\r
1708     call COLOR(7);\r
1709     call MOVE(150,144);\r
1710     call OUTSTRING("INITIALISATION");\r
1711 \r
1712     call COLOR(12);\r
1713     call MOVE(206,158);\r
1714     call VFILL(170);\r
1715     call MOVE(202,170);\r
1716     call OUTSTRING("V");\r
1717     call cadre(146,180,266,196,10);\r
1718     call COLOR(7);\r
1719     call MOVE(154,184);\r
1720     call OUTSTRING("DESACTIVATION"); \r
1721     call MOVE(222,164);\r
1722     call OUTSTRING("return;");\r
1723 \r
1724     call COLOR(12);\r
1725     call MOVE(176,198);\r
1726     call VFILL(210);\r
1727     call MOVE(172,210);\r
1728     call OUTSTRING("V");\r
1729     call MOVE(236,198);\r
1730     call VFILL(216);\r
1731     call MOVE(232,198);\r
1732     call OUTSTRING("^");    \r
1733     call cadre(146,220,266,236,10);\r
1734     call COLOR(7);\r
1735     call MOVE(168,224);\r
1736     call OUTSTRING("ACTIVATION");\r
1737     call MOVE(80,204);\r
1738     call OUTSTRING("attach(C);");\r
1739     call MOVE(252,204);\r
1740     call OUTSTRING("detach;");\r
1741 \r
1742     call COLOR(12);\r
1743     call MOVE(206,238);\r
1744     call VFILL(250);\r
1745     call MOVE(202,250);\r
1746     call OUTSTRING("V");\r
1747     call cadre(146,260,266,276,10);\r
1748     call COLOR(7);\r
1749     call MOVE(178,264);\r
1750     call OUTSTRING("TERMINE");\r
1751 \r
1752     call COLOR(12);\r
1753     call MOVE(206,278);\r
1754     call VFILL(290);\r
1755     call MOVE(202,290);\r
1756     call OUTSTRING("V");\r
1757 \r
1758     call MOVE(116,298);\r
1759     call COLOR(7);\r
1760     call OUTSTRING("Destruction : kill(C);");\r
1761 \r
1762     call MOVE(444,324);\r
1763     call COLOR(12);\r
1764     call OUTSTRING("Page suivante");\r
1765     choix:=boutontxt;\r
1766     if choix=0 then\r
1767       (* l'utilisateur a clique sur quitter *) \r
1768       raise fin;\r
1769     else\r
1770       (* L'utilisateur a clique sur page suivante*)\r
1771       call pagesuiv;\r
1772     fi;\r
1773   END afficinstr;\r
1774 \r
1775 \r
1776 (* pagesuiv affiche a l'ecran les informations sur les instructions *)\r
1777 (* associees aux coroutines*)\r
1778   UNIT pagesuiv : PROCEDURE;\r
1779   VAR touche,choix:integer;\r
1780   BEGIN\r
1781     call CLS;\r
1782     (* Mise en place du texte*)\r
1783     call MOVE(154,16);\r
1784     call COLOR(12);\r
1785     call OUTSTRING("INSTRUCTIONS ASSOCIEES AUX COROUTINES");\r
1786     call MOVE(258,32);\r
1787     call OUTSTRING("Suite...");\r
1788     call COLOR(12);\r
1789     call MOVE(16,48);\r
1790     call OUTSTRING("I> New");\r
1791     call COLOR(7);\r
1792     call MOVE(56,64);\r
1793     call OUTSTRING("Instruction generatrice (allocateur) de creation  d'un objet");\r
1794     call MOVE(56,72);\r
1795     call OUTSTRING("d'une classe donnee (dans le cas present coroutine).");\r
1796     call MOVE(88,84);\r
1797     call OUTSTRING("Exemple : C:=NEW nom_coroutine;");\r
1798 \r
1799     call COLOR(12);\r
1800     call MOVE(16,100);\r
1801     call OUTSTRING("II> Return");\r
1802     call COLOR(7);\r
1803     call MOVE(56,116);\r
1804     call OUTSTRING("Apres que le record d'activation de la coroutine ait ete cree,");\r
1805     call MOVE(56,124);\r
1806     call OUTSTRING("(instruction NEW), et que les initialisations aient ete effec-");\r
1807     call MOVE(56,132);\r
1808     call OUTSTRING("tuees, l'instruction de retour RETURN (obligatoire) a pour effet");\r
1809     call MOVE(56,140);\r
1810     call OUTSTRING("de rendre le controle au programme appelant.");  \r
1811 \r
1812     call COLOR(12);\r
1813     call MOVE(16,156);\r
1814     call OUTSTRING("III> Attach");\r
1815     call COLOR(7);\r
1816     call MOVE(56,172);\r
1817     call OUTSTRING("Des qu'un objet de type coroutine a ete cree, il peut etre soit");\r
1818     call MOVE(56,180);\r
1819     call OUTSTRING("actif, soit suspendu. Toute reactivation d'une coroutine X ");\r
1820     call MOVE(56,188);\r
1821     call OUTSTRING("(ATTACH(X);) se traduit par la suspension de la coroutine active");\r
1822     call MOVE(56,196);\r
1823     call OUTSTRING("et par la poursuite de l'execution a l'instruction de x suivant"); \r
1824     call MOVE(56,204);\r
1825     call OUTSTRING("celle ayant ete executee lors de la precedente reactivation.");\r
1826 \r
1827     call COLOR(12);\r
1828     call MOVE(16,220);\r
1829     call OUTSTRING("IV> Detach");\r
1830     call COLOR(7);\r
1831     call MOVE(56,236);\r
1832     call OUTSTRING("L'instruction DETACH a pour effet de desactiver la coroutine");\r
1833     call MOVE(56,244);\r
1834     call OUTSTRING("active qui contient la dite instruction et de rendre la main a");\r
1835     call MOVE(56,252);\r
1836     call OUTSTRING("la coroutine appelante (i.e. celle contenant le dernier ATTACH).");\r
1837 \r
1838     call COLOR(12);\r
1839     call MOVE(16,268);\r
1840     call OUTSTRING("V> Kill");\r
1841     call COLOR(7);\r
1842     call MOVE(56,284);\r
1843     call OUTSTRING("L'instruction KILL(X) a pour consequence la destruction du ");\r
1844     call MOVE(56,292);\r
1845     call OUTSTRING("record d'activation de la coroutine designee par la variable");\r
1846     call MOVE(56,300);\r
1847     call OUTSTRING("de reference X.");\r
1848 \r
1849     call MOVE(434,324);\r
1850     call COLOR(12);\r
1851     call OUTSTRING("Page precedente");\r
1852     choix:=boutontxt;\r
1853     if choix=0 then\r
1854       (* l'utilisateur a clique sur quitter *) \r
1855       raise fin;\r
1856     else\r
1857       (* L'utilisateur a clique sur page suivante*)\r
1858       call afficinstr;\r
1859     fi;\r
1860   END pagesuiv;\r
1861 \r
1862 \r
1863 (********************************************************************************)\r
1864 (* Procedures permettant de quitter l'application ou de revenir au menu         *)\r
1865 (********************************************************************************)\r
1866 \r
1867   (* Gestion du click sur l'icone 'Quitter' car execution terminee ou point *)\r
1868   (* d'arret atteint*)\r
1869   UNIT finexecut: PROCEDURE(typexec:integer,rempli,atteint:boolean);\r
1870   VAR i,touche:integer,\r
1871       selection:boolean;\r
1872   BEGIN\r
1873       call MOVE(16,296);\r
1874       call COLOR(10);\r
1875       if rempli then\r
1876         call OUTSTRING("LE NOMBRE MAXIMUM DE SAISIE DES VALEURS DU TABLEAU EST ATTEINT !");\r
1877         call MOVE(150,304);\r
1878         call OUTSTRING("Cliquez sur l'icone Quitter afin de retourner au menu");\r
1879       else\r
1880         if typexec=5 then\r
1881           if atteint then\r
1882             call OUTSTRING("POINT D'ARRET ATTEINT !.Pour retourner au menu, cliquez sur l'icone Quitter");\r
1883           else\r
1884             call OUTSTRING("LE PROGRAMME S'EST TERMINE SANS ETRE PASSE PAR LE POINT D'ARRET !");\r
1885             call MOVE(150,304);\r
1886             call OUTSTRING("Cliquez sur l'icone Quitter afin de retourner au menu");\r
1887           fi;\r
1888         fi;\r
1889 \r
1890         if typexec=3 or typexec=4 then\r
1891           call OUTSTRING("PROGRAMME TERMINE !.Pour retourner au menu, cliquez sur l'icone Quitter");\r
1892         fi;\r
1893       fi;\r
1894       call SHOWCURSOR;\r
1895       call COLOR(12);           \r
1896       call MOVE(16,260);\r
1897       call OUTSTRING("Quitter");\r
1898       selection:=false;\r
1899       g:=false;\r
1900       d:=false;\r
1901       c:=false;\r
1902       (* Gestion de la souris *)\r
1903       DO\r
1904         call GETPRESS(0,h,v,b,g,d,c);\r
1905         if g then\r
1906           call clicquit(h,v,selection);\r
1907           call HIDECURSOR;\r
1908           if not selection then\r
1909             g:=false;\r
1910             call SHOWCURSOR;\r
1911             repeat;\r
1912           else\r
1913             (* l'utilisateur a clique sur quitter *) \r
1914             raise fin;\r
1915           fi;\r
1916         fi;\r
1917       OD;\r
1918   END finexecut;\r
1919 \r
1920   (* quitter permet de sortir de l'application convenablement *)\r
1921   UNIT quitter : PROCEDURE;\r
1922   BEGIN\r
1923     call GROFF;\r
1924     call NewPage;\r
1925     call Setcursor(5,20);\r
1926     writeln("**********TERMINE**********");\r
1927     call ENDRUN;\r
1928   END quitter;\r
1929 \r
1930 \r
1931 (********************************************************************************)\r
1932 (* PROGRAMME PRINCIPAL : main                                                   *)\r
1933 (********************************************************************************)\r
1934 \r
1935   BEGIN\r
1936       (* Utilisation du mode graphique *)\r
1937       call GRON(0);\r
1938       (* Mise en place de l'ecran de presentation de l'application *)\r
1939       call presentation;\r
1940       DO\r
1941         call COLOR(9);\r
1942         call style(1);\r
1943         demarrage:=false;\r
1944         ptarok:=false;\r
1945         xpa:=0;\r
1946         ypa:=0;\r
1947         call menu(nooper,typexec); (* Recuperation des choix de l'utilisateur*)\r
1948         call BORDER(16);\r
1949         CASE nooper\r
1950           when 0:\r
1951             (*l'utilisateur veut quitter l'application*)\r
1952             call quitter;\r
1953 \r
1954           when 1:\r
1955             (*l'utilisateur choisit d'executer le programme prod-cons*)\r
1956             if typexec=0 then\r
1957               (* L'utilisateur choisit de quitter l'application *)\r
1958               call quitter;\r
1959             else\r
1960               call contexte(typexec,ptarok);\r
1961               (* Si typexec=3 alors execution normale du programme  *)\r
1962               (* Si typexec=4 alors execution pas a pas du programme*)\r
1963               (* Si typexec=5 alors execution avec point d'arret    *)\r
1964 \r
1965               if typexec=3 or typexec=4 then\r
1966                 call instalnorm(typexec,xpa,ypa,demarrage);\r
1967                 if demarrage then   (* Choix de l'option execution*)\r
1968                   call execut(typexec,xpa,ypa);\r
1969                   if stopexec then  \r
1970                     (* Choix a un moment donne de l'option Quitter*)\r
1971                     stopexec:=false;\r
1972                     repeat;\r
1973                   fi;\r
1974                 fi;\r
1975                 if stopexec then\r
1976                   stopexec:=false;\r
1977                 fi;               \r
1978               fi;\r
1979 \r
1980               if typexec=5 then\r
1981                 call mainvisu;\r
1982                 call prodvisu;\r
1983                 call consvisu;\r
1984                 (* Selection du point d'arret par l'utilisateur*)\r
1985                 call selectpoint(xpa,ypa);\r
1986                 if stopexec then\r
1987                   stopexec:=false;\r
1988                 else\r
1989                   ptarok:=true;\r
1990                   call contexte(typexec,ptarok);\r
1991                   call instalnorm(typexec,xpa,ypa,demarrage);\r
1992                   if stopexec then \r
1993                     stopexec:=false;\r
1994                   else\r
1995                     call execut(typexec,xpa,ypa);\r
1996                     if stopexec then\r
1997                       stopexec:=false;\r
1998                     fi;\r
1999                   fi;\r
2000                 fi;\r
2001               fi; \r
2002             fi;\r
2003           when 2: (* L'utilisateur desire des renseignements sur les coroutines*)\r
2004             if typexec=0 then\r
2005               call quitter;\r
2006             else\r
2007               (* Si typexec=3 alors affichage de la definition et de l'interet*)\r
2008               (* des coroutines*)\r
2009               (* Si typexec=4 alors affichage du shema de la semantique des*)\r
2010               (* coroutines*)\r
2011 \r
2012               if typexec=3 then\r
2013                 call afficdef;\r
2014                 if stopexec then\r
2015                   stopexec:=false;\r
2016                 fi;\r
2017               else\r
2018                 if typexec=4 then\r
2019                   call afficinstr;\r
2020                   if stopexec then\r
2021                     stopexec:=false;\r
2022                   fi;\r
2023                 fi;\r
2024               fi;\r
2025             fi;        \r
2026           repeat;\r
2027         ESAC;\r
2028       OD;\r
2029     END;\r
2030    END;\r
2031   END COROUTINE.\r
2032 \r
2033 (********************************************************************************)\r