PROGRAM COROUTINE;
  signal fin;
(* Projet LI1 : Didacticiel sur les coroutines. *)
(*              Realise par CHICHER Corinne et DOME Nadege - UPPA 1993/1994 - *)

BEGIN
  pref iiuwgraph block
  BEGIN
    pref mouse block

    VAR nooper,typexec,touche:integer, 
          i,b,h,v,num,xpa,ypa:integer,
          g,d,c,driver,selection,demarrage,ptarok,stopexec:boolean;

  (* nooper:correspond soit a l'execution du programmes soit a l'affichage*)
  (* d'informations sur les coroutines.*)
  (* typexec:type de l'execution du programme ou types de renseignements sur*)
  (* les coroutines.*)
  (* demarrage a vrai si choix de l'icone Execution*)
  (* ptarok a vrai l'utilisateur a choisi un point d'arret*)
  (* stopexec a vrai si l'utilisateur a clique sur l'icone Quitter*)


(******************************************************************************)
(* Procedures permettant la gestion de l'ecran en mode texte et graphique     *)
(******************************************************************************)

  (* NewPage vide l'ecran en mode texte *)
  UNIT NewPage : PROCEDURE;
  BEGIN
    write( chr(27), "[2J");
  END NewPage;

  (* SetCursor positionne le curseur aux lignes et colonnes indiquees *)
  UNIT SetCursor : PROCEDURE(ligne,colonne:integer);
  VAR c,d,e,f :char,
      i,j :integer;
  BEGIN
    i:=ligne div 10;
    j:=ligne mod 10;
    c:=chr(48+i);
    d:=chr(48+j);
    i:=colonne div 10;
    j:=colonne mod 10;
    e:=chr(48+i);
    f:=chr(48+j);
    write( chr(27), "[", c, d, ";", e, f, "H");
  END SetCursor;


  (* inchar saisit un caractere en mode graphique *)
  UNIT inchar : FUNCTION : integer;
  VAR i:integer;
  BEGIN
    DO 
      i:=INKEY;
      if i <> 0 then
	exit
      fi;
    OD;
    result:=i;
  END inchar;


  (* ReadInteger lit un entier positif a 3 chiffres avec echo a l'ecran *)
  UNIT ReadInteger : FUNCTION : integer;
  VAR X,Y,i,OrdN : integer,
      Number : arrayof integer;
  BEGIN
    array Number dim( 1 : 4 );
    i:=0;
    X:=InXPos;
    Y:=InYPos;
    DO
      OrdN:=inchar;
      if i=8 or (OrdN < 48 and OrdN > 57) then
	exit
      fi;
      CASE OrdN
	when 48 : i:=i+1;
		  Number(i):=0;
	when 49 : i:=i+1;
		  Number(i):=1;
	when 50 : i:=i+1;
		  Number(i):=2;
	when 51 : i:=i+1;
		  Number(i):=3;
	when 52 : i:=i+1;
		  Number(i):=4;
	when 53 : i:=i+1;
		  Number(i):=5;
	when 54 : i:=i+1;
		  Number(i):=6;
	when 55 : i:=i+1;
		  Number(i):=7;
	when 56 : i:=i+1;
		  Number(i):=8;
	when 57 : i:=i+1;
		  Number(i):=9;
	when 8 : if i > 0 then
		   Number(i):=0;
		   i:=i-1;
		   call hascii(0);
		 fi;
	when 13 : if i > 0 then
		    exit
		  fi;
      ESAC;
      if i=1 then
	call Move(X,Y);
	call hascii(0);
	call hascii(48+Number(1));
      fi;
      if i=2 then
	call Move(X+8,Y);
	call hascii(0);
	call hascii(48+Number(2));
      fi; 
      if i=3 then
	call Move(X+16,Y);
	call hascii(0);
	call hascii(48+Number(3));
      fi;        
    OD;
    if (Number(1) = 0) or (Number(1) = 0 and Number(2) = 0) 
       or (Number(1) = 0 and Number(2) = 0 and Number(3) = 0) then
      call Move(X,Y);
      call hascii(0);
      call hascii(48);
      call hascii(0);
    fi;
    if i=1 then
      result:=Number(1);
    else
      if i=2 then
	result:=10 * Number(1) + Number(2);
      else
	result:=100 * Number(1) + 10 * Number(2) + Number(3);
      fi;
    fi;
    kill(Number);
  END ReadInteger;
  
  (* WriteInteger permet d'afficher un entier positif a 3 chiffres a l'ecran *)
  UNIT WriteInteger : PROCEDURE(Number:integer);
  VAR i,j,k:integer;
  BEGIN
    if Number < 10 then
      call HASCII(0);
      call HASCII(Number+48);
      call HASCII(0);
    else
      if Number < 100 then
	i:=Number div 10;
	j:=Number - i * 10;
	call HASCII(0);
	call HASCII(i+48);
	call HASCII(0);
	call HASCII(j+48);
      else
	i:=Number div 100;
	j:=(Number - i * 100) div 10;
	k:=Number - i * 100 - j * 10;
	call HASCII(0);
	call HASCII(i+48);
	call HASCII(0);
	call HASCII(j+48);
	call HASCII(0);
	call HASCII(k+48);
      fi;
    fi;
  END WriteInteger;


(*******************************************************************************)
(* Procedures gerant un click de la souris sur l'ecran                         *)
(*******************************************************************************)

  (* Si choix=0 l'utilisateur a clique sur l'icone Quitter*)
  (* presentbout gere le click lors de la page de presentation*)
  UNIT presentbout : PROCEDURE(x,y:integer;inout bonclic:boolean,choix:integer);
  BEGIN
    if (x >= 12) and (x <= 92) then
      if (y >= 296) and (y <= 312) then
	bonclic:=true;
        choix:=0;  
      fi;
    fi;
    if (x >= 116) and (x<=284) then
      if (y >= 296) and (y <= 312) then
        bonclic:=true;
        choix:=1;  (* Click sur l'icone execution*)
      fi;
    fi;
  END presentbout;


  (* Mousepos gere la position de la souris a l'endroit ou le bouton gauche *)
  (* a ete presse dans le premier ecran *)
  UNIT MOUSEPOS : PROCEDURE(x,y:integer;inout bonclic:boolean;output choix:integer);
  BEGIN
    if (x >= 24) and (x <= 544) then
      if (y >= 96) and (y <= 104) then
	choix:=1;     (* Click sur execution du programme*)
	bonclic:=true;
      fi;

      if (y >= 112) and (y <= 120) then
	choix:=2;     (* Click sur A propos des coroutines*)
	bonclic:=true;
      fi;

      if (y >= 160) and (y <= 168) then
	choix:=3;     (* Click sur execution normale du programme   *)
                      (* ou sur definition et interet des coroutines*)
	bonclic:=true;
      fi;

      if (y >= 176) and (y <= 184) then
	choix:=4;     (* Click sur execution pas a pas du programme*)
                      (* ou sur le schema de la semantique *)
	bonclic:=true;
      fi;

      if (y >= 192) and (y <= 200) then
	choix:=5;     (* click sur l'execution avec point d'arret*)
	bonclic:=true;
      fi;

      if (y >= 224) and (y <= 232) then
	call CLS;
	choix:=0;
	bonclic:=true;
      fi;
    fi;
  END MOUSEPOS;


  (* POSmouse gere la position de la souris a l'endroit ou le bouton gauche *)
  (* a ete presse dans le deuxieme ecran*)
  UNIT POSmouse : PROCEDURE(x,y:integer;inout bonclic:boolean;output choix:integer);
  BEGIN
    if (x >= 12) and (x <= 92) then
      if (y >= 236) and (y <= 252) then
	choix:=1;
	bonclic:=true;
      fi;
      if (y >= 256) and (y <= 272) then
	choix:=0;
	bonclic:=true;
      fi;
    fi;
  END POSmouse;


  (* ptarret gere la position de la souris a l'endroit ou le bouton gauche *)
  (* a ete presse pour la selection du point d'arret*)
  UNIT ptarret : PROCEDURE(x,y:integer;inout bonclic:boolean;output choix:integer);
  BEGIN
    choix:=0;
    (* Click sur une ligne du main*)
    if (x >= 12) and (x <= 200) then
      if ((y > 24) and (y < 32))or((y > 48) and (y < 80))
         or ((y > 88) and (y < 144)) then
	choix:=1;
	bonclic:=true;
      fi;
    fi;

    (* Click sur une ligne de producer*)
    if (x >= 216) and (x <= 412) then
      if ((y > 24) and (y < 32)) or ((y >40) and (y < 136)) then
	choix:=2;
	bonclic:=true;
      fi;
    fi;

    (* Click sur une ligne de consumer*)
    if (x >= 428) and (x <= 628) then
      if ((y > 24) and (y < 32)) or ((y > 48) and (y < 248)) then
	choix:=3;
	bonclic:=true;
      fi;
    fi;

    (* Click sur l'icone "Quitter"*)
    if (x>=12) and (x<=92) then
      if(y>=256) and (y<=272) then
        choix:=0;
        bonclic:=true;                     
      fi;
    fi;        
  END ptarret;

  (* GoStop gere la position de la souris a l'endroit ou le bouton gauche *)
  (* a ete presse dans le deuxieme ecran avec l'execution pas a pas*)
  UNIT GoStop : PROCEDURE(x,y:integer;inout bonclic:boolean,choix:integer);
  BEGIN
    if (x >= 120) and (x <= 200) then
      if (y >= 236) and (y <= 252) then
	choix:=1;
	bonclic:=true;
      fi;
    fi;
    if (x >= 12) and (x <= 92) then
      if (y >= 256) and (y <= 272) then
	choix:=0;
	bonclic:=true;
      fi;
    fi;
  END GoStop;


  (* clicquit gere le click sur quitter quand le point d'arret a ete atteint*)
  UNIT clicquit : PROCEDURE(x,y:integer;inout bonclic:boolean);
  BEGIN
    if (x >= 12) and (x <= 92) then
      if (y >= 256) and (y <= 272) then
	bonclic:=true;
      fi;
    fi;
  END clicquit;

  (*textquit gere le click sur quitter quand l'utilisateur a lu les informations*)
  UNIT textquit : PROCEDURE(x,y:integer;inout bonclic:boolean,choix:integer);
  BEGIN
    if (x >= 8) and (x <= 88) then
      if (y >= 320) and (y <= 336) then
	bonclic:=true;
        choix:=0;
      fi;
    fi;
    if (x >= 428) and (x<=558) then
      if (y >= 320) and (y <= 336) then
        bonclic:=true;
        choix:=1;
      fi;
    fi;
  END textquit;


(********************************************************************************)
(* Procedures gerant les dessins geometriques a l'ecran                         *)
(********************************************************************************)

  (* cadre trace un rectangle *)
  UNIT cadre : PROCEDURE(xg,yg,xd,yd,couleur:integer);
  BEGIN
    call COLOR(couleur);
    call MOVE(xg,yg);
    call DRAW(xd,yg);
    call MOVE(xd,yg);
    call DRAW(xd,yd);
    call MOVE(xd,yd);
    call DRAW(xg,yd);
    call MOVE(xg,yd);
    call DRAW(xg,yg);
  END cadre;

  (* encadrpt determine et encadre la ligne correspondant au point d'arret*)
  UNIT encadrpt : PROCEDURE(input numcode:integer;inout y:integer);
  VAR ycadre,bornesup,xdeb,xfin,couleur:integer,
      trouve:boolean;
  BEGIN 
    if numcode=1 then
      bornesup:=140;
      xdeb:=14;
      xfin:=198;
    fi;
    if numcode=2 then
      bornesup:=132;
      xdeb:=218;
      xfin:=410;
    fi;
    if numcode=3 then
      bornesup:=244;
      xdeb:=430;
      xfin:=626;
    fi; 
    ycadre:=24;
    while not trouve and ycadre<=bornesup
    do
      if y >=ycadre and y<=ycadre+8 then
        trouve:=true;
      else 
        ycadre:=ycadre+8;
      fi;
    od;
    couleur:=12;
    call cadre(xdeb,ycadre,xfin,ycadre+8,couleur);
    y:=ycadre+4;    
  END encadrpt;


(********************************************************************************)
(* Procedures mettant en place les differents ecrans                            *)
(********************************************************************************)

  (* Presentation de l'application*)
  UNIT presentation : PROCEDURE;
  VAR couleur,choix:integer;
  BEGIN
    call CLS;
    call BORDER(7);
    (* Mise en place des boutons*)
    call cadre(12,296,92,312,12);
    call MOVE(26,300);
    call OUTSTRING("Quitter");

    call cadre(116,296,284,312,12);
    call MOVE(120,300);
    call OUTSTRING("Lancer l'application");

    call COLOR(12);
    call MOVE(370,304);
    call OUTSTRING("Licence informatique - UPPA 1994");

    call COLOR(12);
    call MOVE(184,64);
    call OUTSTRING("Corinne CHICHER & Nadege DOME");
    call MOVE(241,88);
    call OUTSTRING("Vous presentent");
    call MOVE(169,128);
    call OUTSTRING("UN DIDACTICIEL SUR LES COROUTINES");
    call MOVE(157,152);
    call OUTSTRING("DANS LE LANGAGE ORIENTE OBJET LOGLAN");
   

    call STYLE(5);
    call cadre(137,48,465,176,7);

    (* Gestion de la souris *)
    driver:=INIT(b);
    call SETPOSITION(0,0);
    call SHOWCURSOR;
    DO
      call GETPRESS(0,h,v,b,g,d,c);
      if g then
        call presentbout(h,v,selection,choix);
        if not selection then
	  g:=false;
	  repeat;
	else
          if choix=0 then   (* L'utilisateur a selectionne Quitter*)
            call HIDECURSOR;
            call quitter;
          else
            call HIDECURSOR;
            exit;
          fi;
        fi;
      fi;
    OD;
  END presentation;

  (* menu propose les programmes a executer et le type d'execution *)
  UNIT menu : PROCEDURE(inout numop1,numop2:integer);
  VAR i,touche,couleur:integer,
      selection:boolean;
  BEGIN
      call CLS;
      call BORDER(20);
      selection:=false;
      g:=false;
      d:=false;
      c:=false;
      call COLOR(15);
      call MOVE(184,24);
      call OUTSTRING("DIDACTICIEL SUR LES COROUTINES");
      couleur:=6;
      call cadre(24,56,544,240,couleur);
      call COLOR(7);
      call MOVE(64,96);
      call OUTSTRING("Execution du programme 'Producteur-Consommateur'");
      call MOVE(64,112);
      call OUTSTRING("A propos des 'Coroutines'...");

      call MOVE(64,224);
      call OUTSTRING("Quitter l'application");
      call MOVE(24,256);
      call COLOR(15);
      call OUTSTRING("Selectionnez l'operation avec le bouton gauche de la souris...");
      call COLOR(7);    

      (* Gestion de la souris *)
      driver:=INIT(b);
      call SETPOSITION(0,0);
      call SHOWCURSOR;
      DO
	call GETPRESS(0,h,v,b,g,d,c);
	if g then
	  call MOUSEPOS(h,v,selection,numop1);
	  if not selection then
	    g:=false;
	    repeat;
	  else
            if numop1=0 then   (* L'utilisateur a selectionne Quitter*)
              call HIDECURSOR;
              exit
            else
              selection:=false;
              call HIDECURSOR;
              g:=false;
              d:=false;
              c:=false;
              call MOVE(64,160);

              if numop1=1 then (* L'utilisateur a selectionne l'exemple*)
                call OUTSTRING("Execution normale du programme ");
                call MOVE(64,176);
                call OUTSTRING("Execution pas a pas du programme ");
                call MOVE(64,192);
                call OUTSTRING("Execution avec point d'arret du programme ");
                driver:=INIT(b);
                call SHOWCURSOR;
                DO
                  call GETPRESS(0,h,v,b,g,d,c);
                  if g then
                    call MOUSEPOS(h,v,selection,numop2);
                    if not selection then
                      g:=false;
                      repeat;
                    else
	              call HIDECURSOR;
	              exit exit
                    fi;
                  fi;
                OD;
              else   
              (* L'utilisateur a selectionne le "dictionnaire" sur les coroutines*)
                call OUTSTRING("Definition et interet des coroutines ");
                call MOVE(64,176);
                call OUTSTRING("Instructions associees aux coroutines ");                
                driver:=INIT(b);
                call SHOWCURSOR;
                DO
                  call GETPRESS(0,h,v,b,g,d,c);
                  if g then
                    call MOUSEPOS(h,v,selection,numop2);
                    if not selection then
                      g:=false;
                      repeat;
                    else
	              call HIDECURSOR;
	              exit exit
                    fi;
                  fi;
                OD;
              fi;
            fi;
          fi;
	fi;
      OD;
  END menu;


  (* Contexte met en place les differentes parties servant a l'execution *)
  UNIT contexte : PROCEDURE(input typexec:integer,ptarok:boolean);
  VAR touche,couleur:integer;

  BEGIN
      call CLS;
      call COLOR(12);
      call MOVE(216,4);
      call OUTSTRING("EXECUTION DU PROGRAMME");
      (* Cadre entourant le code du main et coroutines *)
      couleur:=7; 
      call cadre(8,16,632,280,couleur);

      (* Cadre simulant l'ecran *)
      call cadre(8,288,632,336,couleur);
      (* Boutons pour lancer l'execution et quitter *)
      call cadre(12,236,92,252,couleur);
      call MOVE(16,240);
      if typexec=5 and not ptarok then
        call COLOR(8);
      else
        call COLOR(12);
      fi;
      call OUTSTRING("Execution");            
      call cadre(12,256,92,272,couleur);
      call MOVE(16,260);
      call COLOR(12);      
      call OUTSTRING("Quitter");
      driver:=INIT(b);
      call SETPOSITION(0,0);
      call SHOWCURSOR;
  END contexte; 

  (* mainvisu affiche dans le cadre le code du main *)
  UNIT mainvisu : PROCEDURE;
  VAR couleur:integer;
  BEGIN
    call COLOR(7);
    (* cadre entourant le code du main *)
    couleur:=7;
    call cadre(12,20,200,228,couleur);
    call MOVE(12,192);
    call HFILL(200);
    call MOVE(16,24);
    call OUTSTRING("PROGRAM prodcons;");
    call MOVE(16,40);
    call OUTSTRING("VAR"); 
    call MOVE(16,48);
    call OUTSTRING(" prod:producer,");
    call MOVE(16,56);
    call OUTSTRING(" cons:consumer,");
    call MOVE(16,64);
    call OUTSTRING(" n,mag:integer,");
    call MOVE(16,72);
    call OUTSTRING(" last:boolean;");
    call MOVE(16,88);
    call OUTSTRING("BEGIN");
    call MOVE(16,96);
    call OUTSTRING(" prod:=new producer;");
    call MOVE(16,104);
    call OUTSTRING(" read(n);");
    call MOVE(16,112);
    call OUTSTRING(" cons:=new consumer(n);");
    call MOVE(16,120);
    call OUTSTRING(" attach(prod);");
    call MOVE(16,128);
    call OUTSTRING(" writeln;");
    call MOVE(16,136);
    call OUTSTRING("END prodcons;");
  END mainvisu;

  (* prodvisu (coroutine 1) affiche dans le cadre le code de producer *)
  UNIT prodvisu : PROCEDURE;
  VAR couleur:integer;
  BEGIN
    (* Cadre de la 1ere coroutine *)
    couleur:=7;
    call cadre(216,20,412,272,couleur);
    (* Ecriture du code de la 1ere coroutine *)
    call MOVE(220,24);
    call OUTSTRING("UNIT producer:COROUTINE;");
    call MOVE(220,40);
    call OUTSTRING("BEGIN");
    call MOVE(220,48);
    call OUTSTRING(" return;");
    call MOVE(220,56);
    call OUTSTRING(" DO");
    call MOVE(220,64);
    call OUTSTRING("  read(mag);");
    call MOVE(220,72);
    call OUTSTRING("  if mag=0 then");
    call MOVE(220,80);
    call OUTSTRING("   last:=true;");
    call MOVE(220,88);
    call OUTSTRING("   exit;");
    call MOVE(220,96);
    call OUTSTRING("  fi;");
    call MOVE(220,104);
    call OUTSTRING("  attach(cons);");
    call MOVE(220,112);
    call OUTSTRING(" OD;");
    call MOVE(220,120);
    call OUTSTRING(" attach(cons);");
    call MOVE(220,128);
    call OUTSTRING("END producer;");
  END prodvisu;

  (* consvisu (coroutine 2) affiche dans le cadre le code de consumer *)
  UNIT consvisu : PROCEDURE;
  VAR couleur:integer;
  BEGIN
    couleur:=7;
    call cadre(428,20,628,272,couleur); (* Cadre de la coroutine 2 cad consumer*)
    call MOVE(428,252);
    call HFILL(628);
    (* Ecriture du code de la 2eme coroutine *)
    call MOVE(432,24);
    call OUTSTRING("UNIT consumer:coroutine");
    call MOVE(432,32);
    call OUTSTRING("     (n:integer);");
    call MOVE(432,48);
    call OUTSTRING("VAR buf:arrayof integer,");
    call MOVE(432,56);
    call OUTSTRING("    i,j:integer;");
    call MOVE(432,64);
    call OUTSTRING("BEGIN");
    call MOVE(432,72);
    call OUTSTRING(" array buf dim(1:n);");
    call MOVE(432,80);
    call OUTSTRING(" return;");
    call MOVE(432,88);
    call OUTSTRING(" DO");
    call MOVE(432,96);
    call OUTSTRING("  for i:=1 to n");
    call MOVE(432,104);
    call OUTSTRING("  DO");
    call MOVE(432,112);
    call OUTSTRING("   buf(i):=mag;");
    call MOVE(432,120);
    call OUTSTRING("   attach(prod);");
    call MOVE(432,128);
    call OUTSTRING("   if last then");
    call MOVE(432,136);
    call OUTSTRING("   exit exit fi;");
    call MOVE(432,144);
    call OUTSTRING("  OD");
    call MOVE(432,152);
    call OUTSTRING("  for i:=1 to n");
    call MOVE(432,160);
    call OUTSTRING("  DO");
    call MOVE(432,168);
    call OUTSTRING("   write(' ',buf(i));");
    call MOVE(432,176);
    call OUTSTRING("  OD;");
    call MOVE(432,184);
    call OUTSTRING("  writeln;");
    call MOVE(432,192);
    call OUTSTRING(" OD");
    call MOVE(432,200);
    call OUTSTRING(" for j:=1 to i DO");
    call MOVE(432,208);
    call OUTSTRING("  write(' ',buf(i));");
    call MOVE(432,216);
    call OUTSTRING("  OD;");
    call MOVE(432,224);
    call OUTSTRING(" writeln;");
    call MOVE(432,232);
    call OUTSTRING(" attach(main);");
    call MOVE(432,240);
    call OUTSTRING("END consumer;");
  END consvisu;


  (* instalnorm affiche le code du main et attend click sur execution/quitter *)
  UNIT instalnorm : PROCEDURE(typexec,xpa,ypa:integer;inout execok:boolean);
  VAR i,touche,rep,couleur:integer,
      selection:boolean;
  HANDLERS
    when fin:stopexec:=true;
             terminate;
  END HANDLERS;
  BEGIN
      selection:=false;
      g:=false;
      d:=false;
      c:=false;
      (* Affichage du code du main*) 
      call mainvisu;
      if typexec=5 and xpa=14 then
        couleur:=12;
        call cadre(xpa,ypa-4,198,ypa+4,couleur);
      fi;
      call COLOR(12);
      call MOVE(12,296);
      call OUTSTRING("Selectionnez 'execution' ou 'quitter' en cliquant sur l'icone correspondante");
      (* Gestion de la souris *)
      DO
	call GETPRESS(0,h,v,b,g,d,c);
	if g then
	  call POSmouse(h,v,selection,rep);
          call HIDECURSOR;
	  if not selection then
	    g:=false;
            call SHOWCURSOR;
	    repeat;
	  else
            if rep=0 then   (* l'utilisateur a clique sur quitter *) 
              raise fin;
            else   (* l'utilisateur a clicke sur execution *) 
              call COLOR(0);
              call MOVE(12,296);
              call OUTSTRING("Selectionnez 'execution' ou 'quitter' en cliquant sur l'icone correspondante");
              call COLOR(8);
              call MOVE(16,240);
              call OUTSTRING("Execution");
       
              if typexec=3 or typexec=5 then 
                call COLOR(8);           
                call MOVE(16,260);
                call OUTSTRING("Quitter");
                call SHOWCURSOR;

              else (*typexec=4*)
                call COLOR(7);
                (* Bouton "continuer" pour avancer pas a pas dans l'execution*)
                couleur:=7;
                call cadre(120,236,200,252,couleur);
                call MOVE(124,240);
                call COLOR(12);
                call OUTSTRING("Continuer");
                call SHOWCURSOR;
              fi;          
              execok:=true;

            fi;
            exit;
          fi;
        fi;
      OD;
  END instalnorm;


(********************************************************************************)
(* Procedure permettant la prise en compte d'une execution avec point d'arret   *)
(********************************************************************************)

  (* selectpoint permet de prendre en compte le point d'arret choisi*)
  (* par l'utilisateur*)
  UNIT selectpoint : PROCEDURE(inout x,y:integer);
  VAR i,touche,rep,numcode:integer,
      selection:boolean;
  HANDLERS
    when fin:stopexec:=true;
             terminate;
  END HANDLERS;
  BEGIN
      selection:=false;
      g:=false;
      d:=false;
      c:=false;

      (* Affichage du message demandant la selection du point d'arret*)
      call COLOR(12);
      call MOVE(16,296);
      call OUTSTRING("Cliquez sur la ligne qui sera le point d'arret de l'execution");

      (* Gestion de la souris *)
      DO
	call GETPRESS(0,h,v,b,g,d,c);
	if g then
	  call ptarret(h,v,selection,numcode);
          call HIDECURSOR;
	  if not selection then
	    g:=false;
            call SHOWCURSOR;
	    repeat;
	  else
            if numcode=0 then
              raise fin;
            fi;                       
            call encadrpt(numcode,v); 
            call COLOR(0);
            call MOVE(16,296);
            call OUTSTRING("Cliquez sur la ligne qui sera le point d'arret de l'execution");
            call COLOR(8);
            call MOVE(16,260);
            call OUTSTRING("Quitter");
            call COLOR(12);
            call MOVE(16,296);
            call OUTSTRING("Tapez <RC> pour valider votre selection");
            touche:=inchar;
            call COLOR(0);
            call MOVE(16,296);
            call OUTSTRING("Tapez <RC> pour valider votre selection");
            y:=v;
            if numcode=1 then
              x:=14;
            else
              if numcode=2 then 
                x:=218;
              else
                x:=430;
              fi;
            fi;               
            exit;
          fi;
        fi;
      OD;
  END selectpoint;


(********************************************************************************)
(* Procedures utilisees pour l'execution du programme                           *)
(********************************************************************************)

  (* fleche permet d'afficher une fleche devant l'instruction courante *)
  UNIT fleche : PROCEDURE(input x,y,xpa,ypa,numcode,choixexe:integer);
  VAR rempli,atteint:boolean;
  BEGIN
    call MOVE(x,y); 
    call COLOR(12);
    call OUTSTRING("->");

    (*Execution avec point d'arret*)
    if numcode=1 then
      if (xpa=x+14) and (ypa-4=y) then
        atteint:=true;
        call finexecut(choixexe,rempli,atteint);
      fi;
    fi;
    if numcode=2 or numcode=3 then
      if (xpa=x+18) and (ypa-4=y) then
        atteint:=true;
        call finexecut(choixexe,rempli,atteint);
      fi;
    fi;
  END fleche; 

  (* Changecoul permet de modifier la couleur du cadre des record selon*)
  (* qu'ils sont actifs ou non*)
  UNIT changecoul : PROCEDURE(couleur,numcode:integer);
  BEGIN
    if numcode=1 then
      call cadre(12,20,200,228,couleur);
    fi;
    if numcode=2 then
      call cadre(216,20,412,272,couleur);
    fi;    
    if numcode=3 then
      call cadre(428,20,628,272,couleur);
    fi;
    call COLOR(12); 
  END changecoul;

  (* restaure permet de supprimer la fleche courante et provoque un temps d'arret*)
  (* apres chaque instruction.                                                   *)
  UNIT restaure : PROCEDURE(debx,deby,choixexe,numcode:integer);    
  VAR i,touche,rep:integer,
      selection:boolean;
  BEGIN
      selection:=false;
      g:=false;
      d:=false;
      c:=false;
      CASE choixexe
        when 3: (* Execution normale du programme choisi*)
          for i:=1 to 10000  do  od;

        when 4: (* Execution pas a pas du programme choisi*)
          (* Gestion de la souris *)
          driver:=init(b);
          call SETPOSITION(160,244);

          call SHOWCURSOR;
          DO
	    call GETPRESS(0,h,v,b,g,d,c);
	    if g then
	      call GoStop(h,v,selection,rep);
              call HIDECURSOR;
	      if not selection then
	        g:=false;
                call SHOWCURSOR;
	        repeat;
	      else
                if rep=0 then   (* l'utilisateur a clique sur quitter *) 
                  raise fin;
                fi;
                (* l'utilisateur a clique sur continuer *) 
                exit;
              fi;
            fi;
          OD;
        
        when 5: (* Execution avec point d'arret du programme choisi*) 
          for i:=1 to 10000  do  od;
        
      ESAC;
      (* Effacement de la fleche se trouvant devant la ligne courante*)
      call MOVE(debx,deby);
      call COLOR(0);
      call OUTSTRING("->");
      call COLOR(7);
      if numcode=1 then
        call MOVE(8,deby);
        call VFILL(deby+8);
        call COLOR(10);
        call MOVE(12,deby);
        call VFILL(deby+8);
      fi;
      if numcode=2 then
        call MOVE(200,deby);
        call VFILL(deby+8);
      fi;
      if numcode=3 then
        call MOVE(412,deby);
        call VFILL(deby+8);
      fi;
  END restaure;

  (* execut permet l'execution du programme *)
  UNIT execut : PROCEDURE(input choixexe,xpa,ypa:integer);
  VAR touche,k,x,y,i,j,n,mag,numcode,nbaffic,nbcases,rep,couleur:integer,
      passe,last,encore,magzero,rempli,atteint:boolean,
      buf:arrayof integer;
  HANDLERS
    when fin:stopexec:=true;
         terminate;
  END HANDLERS;

  BEGIN 
    array buf dim(1:10);
    rempli:=false;
    (* 1ere ligne du main*)
    numcode:=1;
    call changecoul(10,numcode);
    x:=0;
    y:=24;
    call fleche(x,y,xpa,ypa,numcode,choixexe);
    call restaure(x,y,choixexe,numcode);
    (* 3eme ligne du main*)
    y:=48;
    call fleche(x,y,xpa,ypa,numcode,choixexe);
    call restaure(x,y,choixexe,numcode);
    (* 4eme ligne du main*)
    y:=56;
    call fleche(x,y,xpa,ypa,numcode,choixexe);
    call restaure(x,y,choixexe,numcode);
    (* 5eme ligne du main*)
    y:=64;
    call fleche(x,y,xpa,ypa,numcode,choixexe);
    (* Affichage de la valeur de n et mag *)
    call MOVE(16,196);
    call OUTSTRING("n = 0  et mag = 0");
    call restaure(x,y,choixexe,numcode);
    (* 6eme ligne du main*)
    y:=72;
    call fleche(x,y,xpa,ypa,numcode,choixexe);
    (* Affichage de la valeur de last*)
    call MOVE(16,212);
    call OUTSTRING("last = false");
    call restaure(x,y,choixexe,numcode);
    (* 7eme ligne du main*)
    y:=88;
    call fleche(x,y,xpa,ypa,numcode,choixexe);
    call restaure(x,y,choixexe,numcode);
    (* 8eme ligne du main*)
    y:=96;
    call fleche(x,y,xpa,ypa,numcode,choixexe);
    call changecoul(7,numcode);

    (* Affichage du code de la coroutine 1 cad producer*)
    call prodvisu;
    if typexec=5 and xpa=218 then
      couleur:=12;
      call cadre(xpa,ypa-4,410,ypa+4,couleur);
    fi;
    (* Debut de l'execution de la 1ere coroutine*)
    (* 1ere ligne de la coroutine 1*)
    x:=200;
    numcode:=2;
    call changecoul(10,numcode);
    y:=24;
    call fleche(x,y,xpa,ypa,numcode,choixexe);
    call restaure(x,y,choixexe,numcode);
    (* 2eme ligne de la coroutine 1*)
    y:=40;
    call fleche(x,y,xpa,ypa,numcode,choixexe);
    call restaure(x,y,choixexe,numcode);
    (* 3eme ligne de la coroutine 1*)
    y:=48;
    call fleche(x,y,xpa,ypa,numcode,choixexe);
    call changecoul(7,numcode);

    (* On revient au programme appelant cad le main*)
    x:=0;
    numcode:=1;
    call changecoul(10,numcode);
    y:=96;
    call restaure(x,y,choixexe,numcode);
    (* 9eme ligne du main*)
    y:=104;
    call fleche(x,y,xpa,ypa,numcode,choixexe);

    DO
      call COLOR(12);
      call MOVE(12,296);
      call OUTSTRING("Entrez la taille du tableau buf (<=10) et tapez <RC>: ");
      n:=ReadInteger;
      call WriteInteger(n);
      call HIDECURSOR;
      call COLOR(0);
      call MOVE(12,296);
      call OUTSTRING("Entrez la taille du tableau buf (<=10) et tapez <RC>: ");
      call WriteInteger(n);
      call SHOWCURSOR;
      (* Test sur la valeur de la taille du tableau*)
      if n=0 or n>10 then
        call COLOR(12);
        call MOVE(12,296);
        call OUTSTRING("Vous devez entrer une valeur comprise entre 1 et 10 (tapez <RC>) !");
        touche:=inchar;
        call COLOR(0);
        call MOVE(12,296);
        call OUTSTRING("Vous devez entrer une valeur comprise entre 1 et 10 (tapez <RC>) !");
      else
        exit
      fi; 
    od;
      
    (* Mise a jour de la valeur de n*)
    call COLOR(12);
    call MOVE(48,196);
    call WriteInteger(n);
    call restaure(x,y,choixexe,numcode);   
    (* 10eme ligne du main*)
    y:=112;
    call fleche(x,y,xpa,ypa,numcode,choixexe);
    call changecoul(7,numcode);

    (* Affichage du code de la coroutine 2 cad consumer*)
    call consvisu;
    if typexec=5 and xpa=430 then
      couleur:=12;
      call cadre(xpa,ypa-4,626,ypa+4,couleur);
    fi;
    (* Debut de l'execution de la coroutine 2*)
    (* ligne 1 de la coroutine 2*)
    x:=412;
    numcode:=3;
    call changecoul(10,numcode);
    y:=24;
    call fleche(x,y,xpa,ypa,numcode,choixexe);
    call restaure(x,y,choixexe,numcode);
    (* ligne 3 de la coroutine 2*)
    y:=48;
    call fleche(x,y,xpa,ypa,numcode,choixexe);
    call restaure(x,y,choixexe,numcode);
    (* ligne 4 de la coroutine 2*)
    y:=56;
    call fleche(x,y,xpa,ypa,numcode,choixexe);
    call MOVE(432,264);
    call OUTSTRING("i = 0  et j = 0"); 
    call restaure(x,y,choixexe,numcode); 
    (* ligne 5 de la coroutine 2*)
    y:=64;
    call fleche(x,y,xpa,ypa,numcode,choixexe);
    call restaure(x,y,choixexe,numcode);
    (* ligne 6 de la coroutine 2*)
    y:=72;
    call fleche(x,y,xpa,ypa,numcode,choixexe);
    call MOVE(432,256);
    call OUTSTRING("buf :");
    for i:=0 to n-1 
    DO
      call MOVE(472+i*16,256);
      if i=n-1 then
        call OUTSTRING("0");
      else
        call OUTSTRING("0,");
      fi;
    OD;
    call restaure(x,y,choixexe,numcode);  
    (* ligne 7 de la coroutine 2*)
    y:=80;
    call fleche(x,y,xpa,ypa,numcode,choixexe);
    call changecoul(7,numcode);
    
    (* Retour a la procedure appelante cad le main*)
    x:=0;
    numcode:=1;
    call changecoul(10,numcode);
    y:=112;
    call restaure(x,y,choixexe,numcode);
    (* 11eme ligne du main*)
    y:=120;
    call fleche(x,y,xpa,ypa,numcode,choixexe);
    call changecoul(7,numcode);
    
    (* Retour a la coroutine 1 cad producer*)
    x:=200;
    numcode:=2;
    call changecoul(10,numcode);
    y:=48;
    call restaure(x,y,choixexe,numcode);

    DO  (* Gros DO*)
      x:=200;
      numcode:=2;
      call changecoul(10,numcode);
      (* 4eme ligne de la coroutine 1*)
      y:=56;
      call fleche(x,y,xpa,ypa,numcode,choixexe);
      call restaure(x,y,choixexe,numcode); 
      (* 5eme ligne de la coroutine 1*)
      y:=64;
      call fleche(x,y,xpa,ypa,numcode,choixexe);

      if nbaffic=4 then
        rempli:=true;
        call finexecut(choixexe,rempli,atteint);
        exit
      fi;
      DO
        call COLOR(12);
        call MOVE(12,296);
        if nbaffic=3 then
          call OUTSTRING("Vous devez a present taper zero comme valeur du tableau et <RC>: ");
        else
          call OUTSTRING("Entrez la valeur (<10) a stocker dans le tableau et tapez <RC>: ");
        fi;
        mag:=ReadInteger;
        (* Mise a jour de la valeur de mag*)
        call MOVE(144,196);
        call WriteInteger(mag);
        call COLOR(0);
        call MOVE(12,296);
        call OUTSTRING("Entrez la valeur (<10) a stocker dans le tableau et tapez <RC>: ");
        call WriteInteger(mag);
        (* Test sur la valeur de mag qui doit etre < 10*)
        if mag > 9 then
          call COLOR(12);
          call MOVE(12,296);
          call OUTSTRING("Vous devez entrer une valeur comprise entre 0 et 9 (tapez <RC>) !");
          touche:=inchar;
          call COLOR(0);
          call MOVE(12,296);
          call OUTSTRING("Vous devez entrer une valeur comprise entre 0 et 9 (tapez <RC>) !");
        else
          exit;
        fi;
      OD;
      call restaure(x,y,choixexe,numcode);
      (* 6eme ligne de la coroutine 1*)
      y:=72;
      call fleche(x,y,xpa,ypa,numcode,choixexe);
      if mag=0 then
        if not passe then
          magzero:=true;
        fi;
        call restaure(x,y,choixexe,numcode);
        (* 7eme ligne de la coroutine 1*)
        y:=80;
        call fleche(x,y,xpa,ypa,numcode,choixexe);
        (* MAJ de la variable last*)
        last:=true;
        call MOVE(72,212);
        call COLOR(0);
        call OUTSTRING("false");
        call MOVE(72,212);
        call COLOR(12);
        call OUTSTRING("true");
        call restaure(x,y,choixexe,numcode);
        (* 8eme ligne de la coroutine 1 *)
        y:=88;
        call fleche(x,y,xpa,ypa,numcode,choixexe);
        call restaure(x,y,choixexe,numcode);
        (* 12eme ligne de la coroutine 1*)
        y:=120;
        call fleche(x,y,xpa,ypa,numcode,choixexe);  (* on va au moyen DO*)
      else
        call restaure(x,y,choixexe,numcode);
        (* 9eme ligne de la coroutine1*)
        y:=96;
        call fleche(x,y,xpa,ypa,numcode,choixexe);
        call restaure(x,y,choixexe,numcode);
        (* 10eme ligne de la coroutine1 *)
        y:=104;
        call fleche(x,y,xpa,ypa,numcode,choixexe);
      fi;
      call changecoul(7,numcode);

      (* retour a la coroutine 2 cad consumer*)
      DO (* Moyen DO*)
        x:=412;
        numcode:=3;
        call changecoul(10,numcode);
        if not passe or encore then
          if not passe then
            y:=80;
            call restaure(x,y,choixexe,numcode);
          fi;
          (* 8eme ligne de la coroutine 2 *)
          y:=88;
          call fleche(x,y,xpa,ypa,numcode,choixexe);
          call restaure(x,y,choixexe,numcode);
          passe:=true;
          encore:=false;
        else
          y:=120;
          call restaure(x,y,choixexe,numcode);
          (* 13eme ligne de la coroutine 2 *)
          y:=128;
          call fleche(x,y,xpa,ypa,numcode,choixexe);
          if last then
            call restaure(x,y,choixexe,numcode);
            (* 14eme ligne de la coroutine 2*)
            y:=136;
            call fleche(x,y,xpa,ypa,numcode,choixexe);
            call restaure(x,y,choixexe,numcode);
            exit exit
          else
            nbcases:=nbcases+1;
            call restaure(x,y,choixexe,numcode);            
            (* 15eme ligne de la coroutine 2*)
            y:=144;
            call fleche(x,y,xpa,ypa,numcode,choixexe);
            call restaure(x,y,choixexe,numcode);
          fi;
        fi;
             
        DO (* Petit DO*)
          (* 9eme ligne de la coroutine 2 *)
          y:=96;
          call fleche(x,y,xpa,ypa,numcode,choixexe);
          (* Affichage de l'indice de buf*)
          call MOVE(464,264); 
          call WriteInteger(nbcases+1);        
          call restaure(x,y,choixexe,numcode);
          if nbcases=n then
            exit
          fi;
          (* 10eme ligne de la coroutine 2 *)
          y:=104;
          call fleche(x,y,xpa,ypa,numcode,choixexe);
          call restaure(x,y,choixexe,numcode);
          (* 11eme ligne de la coroutine 2 *)
          y:=112;
          call fleche(x,y,xpa,ypa,numcode,choixexe); 
          (* MAJ du tableau buf avec la valeur de mag*)
          buf(nbcases+1):=mag;
          call MOVE(472+nbcases*16,256);
          call WriteInteger(buf(nbcases+1));
          if nbcases+1<>n then
            call MOVE(480+nbcases*16,256);
            call OUTSTRING(",");
          fi;
          call restaure(x,y,choixexe,numcode);
          (* 12eme ligne de la coroutine 2 *)
          y:=120;
          call fleche(x,y,xpa,ypa,numcode,choixexe);
          call changecoul(7,numcode); 
 
          (* Retour a la coroutine 1 cad producer*)
          x:=200;
          numcode:=2;
          call changecoul(10,numcode);
          if magzero then
            y:=120;
            call restaure(x,y,choixexe,numcode);
            (* 13eme ligne de la coroutine 1*)
            y:=128;
            call fleche(x,y,xpa,ypa,numcode,choixexe);
            call restaure(x,y,choixexe,numcode);
            (* Destruction du record d'activation de la coroutine 1 cad producer*)
            call COLOR(10);
            call MOVE(216,20);
            call DRAW(412,272);
            call MOVE(412,20);
            call DRAW(216,272);
            call COLOR(12);
            call changecoul(7,numcode);
            call MOVE(12,296);
            call COLOR(10);
            call OUTSTRING("ATTENTION : Le record d'activation de Producer vient d'etre detruit !");
            for i:=1 to 20000 do od;
            call MOVE(12,296);
            call COLOR(0);
            call OUTSTRING("ATTENTION : Le record d'activation de Producer vient d'etre detruit !");
            exit
          else
            y:=104;
            call restaure(x,y,choixexe,numcode);
            (* ligne 11 de la coroutine 1*)
            y:=112;
            call fleche(x,y,xpa,ypa,numcode,choixexe);
            call restaure(x,y,choixexe,numcode);
            exit exit
          fi;
        od;

        if not magzero then
          call COLOR(8);
          (* Retour a la coroutine 2 cad consumer*)
          (* Impression du tampon buf*)
          nbcases:=0;
          i:=0;
          do
            (* 16eme ligne de la coroutine 2*)
            y:=152;
            call fleche(x,y,xpa,ypa,numcode,choixexe);
            call restaure(x,y,choixexe,numcode);
            (* Affichage de l'indice de buf*)
            call COLOR(12);
            call MOVE(464,264); 
            call WriteInteger(i+1); 
            if i<>n then
              (* 17eme ligne de la coroutine 2*)
              y:=160;
              call fleche(x,y,xpa,ypa,numcode,choixexe);
              call restaure(x,y,choixexe,numcode);
              (* 18eme ligne de la coroutine 2*)
              y:=168;
              call fleche(x,y,xpa,ypa,numcode,choixexe);
              call MOVE(12+i*16,304+nbaffic*8);
              call OUTSTRING(" ");
              call WriteInteger(buf(i+1));
              call restaure(x,y,choixexe,numcode);
            fi;
            (* 19eme ligne de la coroutine 2*)
            y:=176;
            call fleche(x,y,xpa,ypa,numcode,choixexe);
            call restaure(x,y,choixexe,numcode);
            if i=n then
              exit
            fi;
            i:=i+1;
          od;
          (* ligne 20 de la coroutine 2*)
          y:=184;
          call fleche(x,y,xpa,ypa,numcode,choixexe);
          call restaure(x,y,choixexe,numcode);
          nbaffic:=nbaffic+1;
          encore:=true;
        fi;
      od;
    od;
                
    (* Imprime le reste du tampon buf*)
    (* 22eme ligne de la coroutine 2*)
    k:=0;
    for j:=1 to nbcases+1 
    do
      y:=200;
      call fleche(x,y,xpa,ypa,numcode,choixexe);
      (* Affichage de l'indice de buf*)
      call MOVE(544,264); 
      call WriteInteger(j); 
      call restaure(x,y,choixexe,numcode);
      (* 23eme ligne de la coroutine 2*)
      y:=208;
      call fleche(x,y,xpa,ypa,numcode,choixexe);
      call MOVE(12+k*16,304+nbaffic*8);
      call OUTSTRING(" ");
      call WriteInteger(buf(j));
      call restaure(x,y,choixexe,numcode);
      (* 24eme ligne de la coroutine 2*) 
      y:=216;
      call fleche(x,y,xpa,ypa,numcode,choixexe);
      call restaure(x,y,choixexe,numcode);
      k:=k+1; 
    od;
    (* 25eme ligne de la coroutine 2*)
    y:=224;
    call fleche(x,y,xpa,ypa,numcode,choixexe);
    call restaure(x,y,choixexe,numcode);
    (* 26eme ligne de la coroutine 2*) 
    y:=232;
    call fleche(x,y,xpa,ypa,numcode,choixexe);   
    call changecoul(7,numcode);

    (* Retour a la ligne 11 du main*)
    x:=0;
    numcode:=1;
    call changecoul(10,numcode);
    y:=120;
    call restaure(x,y,choixexe,numcode);
    (* 12eme ligne du main*)
    y:=128;
    call fleche(x,y,xpa,ypa,numcode,choixexe);
    call restaure(x,y,choixexe,numcode);
    (* 13eme et derniere ligne du main*)
    y:=136;
    call fleche(x,y,xpa,ypa,numcode,choixexe);
    call restaure(x,y,choixexe,numcode);
    (* Destruction du record d'activation du main*)
    call COLOR(10);
    call MOVE(12,20);
    call DRAW(200,228);
    call MOVE(200,20);
    call DRAW(12,228);
    call changecoul(7,numcode);
    call MOVE(12,296);
    call COLOR(10);
    call OUTSTRING("ATTENTION : Le record d'activation du Main vient d'etre detruit !");
    for i:=1 to 20000 do od;
    call MOVE(12,296);
    call COLOR(0);
    call OUTSTRING("ATTENTION : Le record d'activation du Main vient d'etre detruit !");
    
    call COLOR(12);
    (* Retour a la ligne 26 de la coroutine2*)
    x:=412;
    numcode:=3;
    call changecoul(10,numcode);
    y:=232;
    call restaure(x,y,choixexe,numcode);
    (* 27eme ligne de la coroutine2*)
    y:=240;
    call fleche(x,y,xpa,ypa,numcode,choixexe);
    call restaure(x,y,choixexe,numcode);
    (* Destruction du record d'activation de la coroutine 2 cad consumer*)
    call COLOR(10);
    call MOVE(428,20);
    call DRAW(628,272);
    call MOVE(628,20);
    call DRAW(428,272);
    call changecoul(7,numcode);
    call MOVE(12,296);
    call COLOR(10);
    call OUTSTRING("ATTENTION : Le record d'activation de Consumer vient d'etre detruit !");
    for i:=1 to 20000 do od;
    call MOVE(12,296);
    call COLOR(0);
    call OUTSTRING("ATTENTION : Le record d'activation de Consumer vient d'etre detruit !");
    call COLOR(12);
    if not magzero then
      (* Retour a la ligne 12 de la coroutine1*)
      x:=200;
      numcode:=2;
      call changecoul(10,numcode);
      y:=120;
      call restaure(x,y,choixexe,numcode);
       (* 13eme ligne de la coroutine 1*)
      y:=128;
      call fleche(x,y,xpa,ypa,numcode,choixexe);
      call restaure(x,y,choixexe,numcode);
      (* Destruction du record d'activation de la coroutine 1 cad producer*)
      call COLOR(10);
      call MOVE(216,20);
      call DRAW(412,272);
      call MOVE(412,20);
      call DRAW(216,272);
      call changecoul(7,numcode);
      call MOVE(12,296);
      call COLOR(10);
      call OUTSTRING("ATTENTION : Le record d'activation du Producer vient d'etre detruit !");
      for i:=1 to 20000 do od;
      call MOVE(12,296);
      call COLOR(0);
      call OUTSTRING("ATTENTION : Le record d'activation de Producer vient d'etre detruit !");
    fi;
    if choixexe=4 then
      call COLOR(8);  (* L'execution est terminee on ne peut donc plus cliquer*)
                      (* sur Continuer*)
      call MOVE(124,240);
      call OUTSTRING("Continuer");
      call SHOWCURSOR;
    fi;
    call COLOR(12);
    call finexecut(choixexe,rempli,atteint);
  END execut;


(********************************************************************************)
(* Procedures gerant l'option A propos des coroutines                           *)
(********************************************************************************)

  (* boutontxt met en place et gere les boutons concernat l'option *)
  (* A propos des coroutines*)
  UNIT boutontxt : FUNCTION :integer;
  VAR choix:integer;
  BEGIN
    (* Mise en place du bouton Page suivante*)
    call cadre(428,320,558,336,12);

    (* Mise en place du bouton Quitter*)
    call cadre(8,320,88,336,12);
    call MOVE(20,324);
    call COLOR(12);
    call OUTSTRING("Quitter");

    (* Mise en place de la souris*)
    driver:=init(b);
    call SHOWCURSOR;
    selection:=false;
    g:=false;
    d:=false;
    c:=false;
    DO
      call GETPRESS(0,h,v,b,g,d,c);
      if g then
        call textquit(h,v,selection,choix);
        call HIDECURSOR;
        if not selection then
          g:=false;
          call SHOWCURSOR;
	  repeat;
        else
          if choix=0 then
            result:=0;
          else
            result:=1;
          fi;
          exit;
        fi;
      fi;
    OD;
  END boutontxt;


  (* afficdef affiche a l'ecran la definition et l'utilite des coroutines*)
  UNIT afficdef : PROCEDURE;
  VAR touche,choix:integer;
  BEGIN
    call CLS;
    (* Mise en place du texte*)
    call MOVE(170,16);
    call COLOR(12);
    call OUTSTRING("DEFINITION ET INTERET DES COROUTINES");
    call MOVE(16,40);
    call OUTSTRING("I> Definition d'une coroutine");
    call COLOR(7);
    call MOVE(56,56);
    call OUTSTRING("Une coroutine est un objet tel que l'execution de sa sequence");
    call MOVE(56,64);
    call OUTSTRING("d'instructions peut etre suspendue et relancee de maniere pro-");
    call MOVE(56,72);
    call OUTSTRING("grammee."); 
    call MOVE(56,80);
    call OUTSTRING("Il est important de preciser, qu'a un instant donne, une seule");
    call MOVE(56,88);
    call OUTSTRING("coroutine est active (en execution)."); 
    call MOVE(56,100);
    call OUTSTRING("Par ailleurs, c'est une extension de la notion de classe, une");
    call MOVE(56,108);
    call OUTSTRING("classe etant une construction dans laquelle peuvent etre regrou-");
    call MOVE(56,116);
    call OUTSTRING("pes toutes sortes d'objets.");
    call COLOR(12);
    call MOVE(56,132);
    call OUTSTRING("Syntaxe");
    call COLOR(7);
    call MOVE(80,144);
    call OUTSTRING("UNIT <nom_coroutine> : <prefixe> COROUTINE(<parametres formels>);");
    call MOVE(120,152);
    call OUTSTRING("<declarations variables locales,fonctions,procedures,classes>");
    call MOVE(80,160);
    call OUTSTRING("BEGIN");
    call MOVE(120,168);
    call OUTSTRING("<instruction 1>");
    call MOVE(120,176);
    call OUTSTRING("return;");
    call MOVE(120,184);
    call OUTSTRING("<instruction 2...instruction n>");
    call MOVE(80,192);
    call OUTSTRING("END nom_coroutine;");
    call COLOR(12);
    call MOVE(16,216);
    call OUTSTRING("II> Interet des coroutines");
    call COLOR(7);
    call MOVE(56,232);
    call OUTSTRING("Les coroutines jouent un role essentiel dans les taches de simu-");
    call MOVE(56,240);
    call OUTSTRING("lation.");
    call MOVE(56,248);
    call OUTSTRING("Ainsi, divers problemes de simulation de grande complexite et de");
    call MOVE(56,256);
    call OUTSTRING("taille importante sont traitees avec succes par les coroutines.");

    (* Mise en place du bouton Quitter*)
    call cadre(8,320,88,336,10);
    call MOVE(20,324);
    call COLOR(10);
    call OUTSTRING("Quitter");

    (* Mise en place de la souris*)
    call SHOWCURSOR;
    selection:=false;
    g:=false;
    d:=false;
    c:=false;
    DO
      call GETPRESS(0,h,v,b,g,d,c);
      if g then
        call textquit(h,v,selection,choix);
        call HIDECURSOR;
        if not selection then
          g:=false;
          call SHOWCURSOR;
	  repeat;
        else
          if choix=0 then
            (* l'utilisateur a clique sur quitter *) 
            exit exit
          else
            repeat;
          fi;
        fi;
      fi;
    OD;
  END afficdef;


(* afficinstr affiche a l'ecran le schema de la semantique des coroutines*)
  UNIT afficinstr : PROCEDURE;
  VAR touche,choix:integer;
  HANDLERS
    when fin:stopexec:=true;
         terminate;
  END HANDLERS;
  BEGIN
    call CLS;
    (* Mise en place du texte*)
    call MOVE(154,16);
    call COLOR(12);
    call OUTSTRING("INSTRUCTIONS ASSOCIEES AUX COROUTINES");
    call MOVE(258,32);
    call OUTSTRING("SEMANTIQUE");

    call MOVE(76,60);
    call COLOR(7);
    call OUTSTRING("Declaration : VAR C:nom_coroutine;"); 

    call COLOR(12);
    call MOVE(206,76);
    call VFILL(90);
    call MOVE(202,90);
    call OUTSTRING("V");
    call cadre(146,100,266,116,10);
    call COLOR(7);
    call MOVE(174,104);
    call OUTSTRING("CREATION");
    call MOVE(222,83);
    call OUTSTRING("C:=new nom_coroutine(<parametres formels>);");

    call COLOR(12);
    call MOVE(206,118);
    call VFILL(130);
    call MOVE(202,130);
    call OUTSTRING("V");
    call cadre(146,140,266,156,10);
    call COLOR(7);
    call MOVE(150,144);
    call OUTSTRING("INITIALISATION");

    call COLOR(12);
    call MOVE(206,158);
    call VFILL(170);
    call MOVE(202,170);
    call OUTSTRING("V");
    call cadre(146,180,266,196,10);
    call COLOR(7);
    call MOVE(154,184);
    call OUTSTRING("DESACTIVATION"); 
    call MOVE(222,164);
    call OUTSTRING("return;");

    call COLOR(12);
    call MOVE(176,198);
    call VFILL(210);
    call MOVE(172,210);
    call OUTSTRING("V");
    call MOVE(236,198);
    call VFILL(216);
    call MOVE(232,198);
    call OUTSTRING("^");    
    call cadre(146,220,266,236,10);
    call COLOR(7);
    call MOVE(168,224);
    call OUTSTRING("ACTIVATION");
    call MOVE(80,204);
    call OUTSTRING("attach(C);");
    call MOVE(252,204);
    call OUTSTRING("detach;");

    call COLOR(12);
    call MOVE(206,238);
    call VFILL(250);
    call MOVE(202,250);
    call OUTSTRING("V");
    call cadre(146,260,266,276,10);
    call COLOR(7);
    call MOVE(178,264);
    call OUTSTRING("TERMINE");

    call COLOR(12);
    call MOVE(206,278);
    call VFILL(290);
    call MOVE(202,290);
    call OUTSTRING("V");

    call MOVE(116,298);
    call COLOR(7);
    call OUTSTRING("Destruction : kill(C);");

    call MOVE(444,324);
    call COLOR(12);
    call OUTSTRING("Page suivante");
    choix:=boutontxt;
    if choix=0 then
      (* l'utilisateur a clique sur quitter *) 
      raise fin;
    else
      (* L'utilisateur a clique sur page suivante*)
      call pagesuiv;
    fi;
  END afficinstr;


(* pagesuiv affiche a l'ecran les informations sur les instructions *)
(* associees aux coroutines*)
  UNIT pagesuiv : PROCEDURE;
  VAR touche,choix:integer;
  BEGIN
    call CLS;
    (* Mise en place du texte*)
    call MOVE(154,16);
    call COLOR(12);
    call OUTSTRING("INSTRUCTIONS ASSOCIEES AUX COROUTINES");
    call MOVE(258,32);
    call OUTSTRING("Suite...");
    call COLOR(12);
    call MOVE(16,48);
    call OUTSTRING("I> New");
    call COLOR(7);
    call MOVE(56,64);
    call OUTSTRING("Instruction generatrice (allocateur) de creation  d'un objet");
    call MOVE(56,72);
    call OUTSTRING("d'une classe donnee (dans le cas present coroutine).");
    call MOVE(88,84);
    call OUTSTRING("Exemple : C:=NEW nom_coroutine;");

    call COLOR(12);
    call MOVE(16,100);
    call OUTSTRING("II> Return");
    call COLOR(7);
    call MOVE(56,116);
    call OUTSTRING("Apres que le record d'activation de la coroutine ait ete cree,");
    call MOVE(56,124);
    call OUTSTRING("(instruction NEW), et que les initialisations aient ete effec-");
    call MOVE(56,132);
    call OUTSTRING("tuees, l'instruction de retour RETURN (obligatoire) a pour effet");
    call MOVE(56,140);
    call OUTSTRING("de rendre le controle au programme appelant.");  

    call COLOR(12);
    call MOVE(16,156);
    call OUTSTRING("III> Attach");
    call COLOR(7);
    call MOVE(56,172);
    call OUTSTRING("Des qu'un objet de type coroutine a ete cree, il peut etre soit");
    call MOVE(56,180);
    call OUTSTRING("actif, soit suspendu. Toute reactivation d'une coroutine X ");
    call MOVE(56,188);
    call OUTSTRING("(ATTACH(X);) se traduit par la suspension de la coroutine active");
    call MOVE(56,196);
    call OUTSTRING("et par la poursuite de l'execution a l'instruction de x suivant"); 
    call MOVE(56,204);
    call OUTSTRING("celle ayant ete executee lors de la precedente reactivation.");

    call COLOR(12);
    call MOVE(16,220);
    call OUTSTRING("IV> Detach");
    call COLOR(7);
    call MOVE(56,236);
    call OUTSTRING("L'instruction DETACH a pour effet de desactiver la coroutine");
    call MOVE(56,244);
    call OUTSTRING("active qui contient la dite instruction et de rendre la main a");
    call MOVE(56,252);
    call OUTSTRING("la coroutine appelante (i.e. celle contenant le dernier ATTACH).");

    call COLOR(12);
    call MOVE(16,268);
    call OUTSTRING("V> Kill");
    call COLOR(7);
    call MOVE(56,284);
    call OUTSTRING("L'instruction KILL(X) a pour consequence la destruction du ");
    call MOVE(56,292);
    call OUTSTRING("record d'activation de la coroutine designee par la variable");
    call MOVE(56,300);
    call OUTSTRING("de reference X.");

    call MOVE(434,324);
    call COLOR(12);
    call OUTSTRING("Page precedente");
    choix:=boutontxt;
    if choix=0 then
      (* l'utilisateur a clique sur quitter *) 
      raise fin;
    else
      (* L'utilisateur a clique sur page suivante*)
      call afficinstr;
    fi;
  END pagesuiv;


(********************************************************************************)
(* Procedures permettant de quitter l'application ou de revenir au menu         *)
(********************************************************************************)

  (* Gestion du click sur l'icone 'Quitter' car execution terminee ou point *)
  (* d'arret atteint*)
  UNIT finexecut: PROCEDURE(typexec:integer,rempli,atteint:boolean);
  VAR i,touche:integer,
      selection:boolean;
  BEGIN
      call MOVE(16,296);
      call COLOR(10);
      if rempli then
        call OUTSTRING("LE NOMBRE MAXIMUM DE SAISIE DES VALEURS DU TABLEAU EST ATTEINT !");
        call MOVE(150,304);
        call OUTSTRING("Cliquez sur l'icone Quitter afin de retourner au menu");
      else
        if typexec=5 then
          if atteint then
            call OUTSTRING("POINT D'ARRET ATTEINT !.Pour retourner au menu, cliquez sur l'icone Quitter");
          else
            call OUTSTRING("LE PROGRAMME S'EST TERMINE SANS ETRE PASSE PAR LE POINT D'ARRET !");
            call MOVE(150,304);
            call OUTSTRING("Cliquez sur l'icone Quitter afin de retourner au menu");
          fi;
        fi;

        if typexec=3 or typexec=4 then
          call OUTSTRING("PROGRAMME TERMINE !.Pour retourner au menu, cliquez sur l'icone Quitter");
        fi;
      fi;
      call SHOWCURSOR;
      call COLOR(12);           
      call MOVE(16,260);
      call OUTSTRING("Quitter");
      selection:=false;
      g:=false;
      d:=false;
      c:=false;
      (* Gestion de la souris *)
      DO
        call GETPRESS(0,h,v,b,g,d,c);
        if g then
          call clicquit(h,v,selection);
          call HIDECURSOR;
          if not selection then
            g:=false;
            call SHOWCURSOR;
	    repeat;
          else
            (* l'utilisateur a clique sur quitter *) 
            raise fin;
          fi;
        fi;
      OD;
  END finexecut;

  (* quitter permet de sortir de l'application convenablement *)
  UNIT quitter : PROCEDURE;
  BEGIN
    call GROFF;
    call NewPage;
    call Setcursor(5,20);
    writeln("**********TERMINE**********");
    call ENDRUN;
  END quitter;


(********************************************************************************)
(* PROGRAMME PRINCIPAL : main                                                   *)
(********************************************************************************)

  BEGIN
      (* Utilisation du mode graphique *)
      call GRON(0);
      (* Mise en place de l'ecran de presentation de l'application *)
      call presentation;
      DO
        call COLOR(9);
        call style(1);
        demarrage:=false;
        ptarok:=false;
        xpa:=0;
        ypa:=0;
        call menu(nooper,typexec); (* Recuperation des choix de l'utilisateur*)
        call BORDER(16);
        CASE nooper
          when 0:
            (*l'utilisateur veut quitter l'application*)
            call quitter;

          when 1:
            (*l'utilisateur choisit d'executer le programme prod-cons*)
            if typexec=0 then
              (* L'utilisateur choisit de quitter l'application *)
              call quitter;
            else
              call contexte(typexec,ptarok);
              (* Si typexec=3 alors execution normale du programme  *)
              (* Si typexec=4 alors execution pas a pas du programme*)
              (* Si typexec=5 alors execution avec point d'arret    *)

              if typexec=3 or typexec=4 then
                call instalnorm(typexec,xpa,ypa,demarrage);
                if demarrage then   (* Choix de l'option execution*)
                  call execut(typexec,xpa,ypa);
                  if stopexec then  
                    (* Choix a un moment donne de l'option Quitter*)
                    stopexec:=false;
                    repeat;
                  fi;
                fi;
                if stopexec then
                  stopexec:=false;
                fi;               
              fi;

              if typexec=5 then
                call mainvisu;
                call prodvisu;
                call consvisu;
                (* Selection du point d'arret par l'utilisateur*)
                call selectpoint(xpa,ypa);
                if stopexec then
                  stopexec:=false;
                else
                  ptarok:=true;
                  call contexte(typexec,ptarok);
                  call instalnorm(typexec,xpa,ypa,demarrage);
                  if stopexec then 
                    stopexec:=false;
                  else
                    call execut(typexec,xpa,ypa);
                    if stopexec then
                      stopexec:=false;
                    fi;
                  fi;
                fi;
              fi; 
            fi;
          when 2: (* L'utilisateur desire des renseignements sur les coroutines*)
            if typexec=0 then
              call quitter;
            else
              (* Si typexec=3 alors affichage de la definition et de l'interet*)
              (* des coroutines*)
              (* Si typexec=4 alors affichage du shema de la semantique des*)
              (* coroutines*)

              if typexec=3 then
                call afficdef;
                if stopexec then
                  stopexec:=false;
                fi;
              else
                if typexec=4 then
                  call afficinstr;
                  if stopexec then
                    stopexec:=false;
                  fi;
                fi;
              fi;
            fi;        
          repeat;
        ESAC;
      OD;
    END;
   END;
  END COROUTINE.

(********************************************************************************)