program processus4;
 
(* czytelnicy pisarze *)
   unit elem : class;
   var ile , nr : integer,qui:pi;
   (*nr procesu ktory zostawil informacje lub ostatni FreePl w buforze*)
   end elem;
 
   unit ecran :IIUWGRAPH process(node:integer);
 
      unit outtext : procedure(x,y:integer, s:string);
      var A: arrayof char, i: integer;
      begin
          call move(x,y);
          call color(14);   (* yellow *)
          A := unpack(s);
          for i := lower(A) to upper(A) do
                          (*  call HASCII(0);  *)
             call HASCII(ord(A(i)));
          od;
      end outtext;
      
      unit outmessage: procedure(x,y:integer, s: string);
         var A: arrayof char, i: integer;
      begin
        call move(x,y);
        call color(12);  (* rouge clair *)
        A := unpack(s);
        for i := lower(A) to upper(A) do
           call HASCII(ord(A(i)))
        od
      end outmessage;

      unit circle: procedure(col,x,y,r : integer);
         var i: integer;
      begin
           call color(col);
           call rectangle(x,y,r,r);  
           for i := 1 to r-1 do
              call line(col,x,y+i,r,true)
           od
      end circle;
 
      unit line : procedure(col,x,y,dlugosc:integer,poziomo:boolean);
      begin
           call color(col);
           call move(x,y); (* pozycja linii *)
           if poziomo
           then
              call draw(x+dlugosc,y);
           else (* linia pionowa *)
              call draw(x, y+dlugosc);
           fi;
      end line;
 
 
      unit Fin:procedure;
      begin
         call GrOFF; call endRun
      end fin;
 
      unit pisarz: procedure(nr:integer);
      begin
          call color(2*nr+1);
          call circle(2*nr+1,(nr-1)*150+20,8,10);
        (*  call rectangle((nr-1)*150+20,10,10,10);*)  
          call rectangle((Nr-1)*150+10,20,80,200);
      end pisarz;
 
      unit rectangle:procedure(x,y,dl,wys:integer);
      var i: integer;
      begin
          call move(x,y);
          call draw(x+dl,y);
          call draw(x+dl,y+wys);
          call draw(x,y+wys);
          call draw(x,y);
      end rectangle;
 
      unit magazyn : procedure;
      begin
          call color(1);
          call rectangle(10,250,600,50);
      end magazyn;
   begin
       call gron(1);
       return;
       enable magazyn,pisarz;
       do
            accept  Fin, line, circle, outtext, outmessage
       od;
 
   end ecran;
 
   unit pi : elem process(node,nr : integer, M : monitor,ek:ecran);
   (*  nr jest numerem pisarza *)
   const stala=62;(* dludosc linii rysowanej przez pisarza *)
   var posX, posY:integer; (* pozycja pisarza na ekranie *)
 
   unit tempo : procedure(n:integer);
   var i : integer;
   begin
       for i :=1 to n do i:=i od
   end tempo;
 
 
   unit wezwij_put : procedure(e:elem);
   var czekaj : boolean;
   begin
         (* najpierw wymazuje z obszaru pisarza *)
         call ek.outtext((nr-1)*150+20,200,"sends   ");
         for i := 1 to e.ile
         do
             call ek.line(0,(nr-1)*150+22,32+i,stala, true);
             call tempo(200);
         od;
         call ek.outtext((nr-1)*150+20,200,"waiting ");
         do
            call M.putt(e.nr, e.qui, e.ile, czekaj);
            if czekaj 
            then
               call ek.outmessage((nr-1)*150+20,180,"stopped"); 
               stop 
            else 
               exit 
            fi;
         od;
    end wezwij_put;
 
    unit wezwij_get : procedure(inout e:elem);
       var czekaj : boolean, qui:pi,n,ch:integer ;
    begin
 
       do
           n := e.nr; qui := e.qui;
           call m.gett(n,qui,ch, czekaj);
           if czekaj then 
             call ek.outmessage((nr-1)*150+20,180,"stopped");
             stop
           else
               e:=new elem; e.nr :=n;
               e.qui:=qui; e.ile :=ch;
               call ek.outtext((nr-1)*150+20,200,"receives");
               for i := 1 to ch
               do
                  call ek.line(2*n+1,(nr-1)*150+22,32+i,stala,true);
                  call tempo(200);
               od;
               call ek.outtext((nr-1)*150+20,200, "        ");
(*           otrzymalem wiadomosc od pisarza nr        *)
               exit
           fi;
       od;
    end wezwij_get;
 
    unit fin : procedure;
    end;
 
var el: elem, r : real;
begin
   call ek.pisarz(nr);
   call ek.outtext((nr-1)*150+36,8,"Actor");
   return;
   do
       r := random*100;
       if r=0 then accept fin; exit fi;
       (* to niezbt dobre rozwiazanie ze wzgl na kolejnosc *)
       if r<50 then
            (*  pisarz cos produkuje i chce to wyslac *)
            el := new elem;
            el.qui := this pi;
            el.nr := nr;
            el.ile := random*175;
            call ek.outtext((nr-1)*150+20,200,"writes  ");
            for i := 1 to el.ile
            do
               call ek.line(2*nr+1,(nr-1)*150+22,26+i,stala,true);
               call tempo(250);
            od;
            call ek.outtext((nr-1)*150+20,200,"        ");
            call tempo(400);
            call wezwij_put(el)
       else
           (* pisarz zdecydowal sie cos przeczytac  *)
             el := new elem;
             el.nr := nr; el.qui := this pi;
            call ek.outtext((nr-1)*150+20,200,"demands ");
            call wezwij_get(el);
            call ek.outtext((nr-1)*150+20,200,"        ");
            call tempo(500);
            call ek.outtext((nr-1)*150+20,200,"reads   ");
            (* czytam przesylke *)
            for i := el.ile downto 1
            do
               call ek.line(0,(nr-1)*150+22,26+i,stala,true);
               call tempo(250);
            od;
             call ek.outtext((nr-1)*150+20,200,"        ");
 
       fi;
    od;
end pi;
 
unit monitor : elem  process(node,size,max_proc : integer, ek:ecran);
const posX = 30,
      posY = 250;
   unit Belem : class(e:elem,posx:integer);
   end Belem;
 
var buffer : arrayof Belem,
   queue_pour_lire,
   queue_pour_ecrire: queue,
   Qpos:integer,
   counter, ilosc_ak, i,x, nb_proc: integer;
   (* zmienna counter mowi ile jest elementow w buforze *)
   (* ilosc_ak = ilosc miejsca w magazynie juz wykorzystana*)
   (* nb_proc  = ilosc procesow stojacuch w obu kolejkach *)
 
   unit qEl: class;
    var  qui : pi, next : qEL;
   end qEL;
 
   unit queue: class(pos:integer);
   var first, last : qEL;
 
      unit into : procedure(p: pi,nr: integer (* nr is the no of pi*));
      var aux : qEL, c:integer;
      begin
 
           call ek.circle(2*nr+1,pos+30,339,10);
           pos := pos+30;
           (* rysowanie kolka w odpowiedniej kolejce i odp.kolorem*)
           nb_proc := nb_proc+1;
           aux := new qEL;
           aux .qui :=p;
           aux . next := none;
           if first=none then
                first := aux; last := aux
           else
              last.next := aux;
              last := aux;
           fi;
      end into;
 
      unit out : function : pi;
      begin
          if first=none then exit else
             nb_proc := nb_proc -1;
             call ek.circle(0,pos,339,10);
             pos :=pos-30;
             (* wymazanie kolka w odpowiedniej kolejce *)
             result := first.qui;
             first := first.next;
          fi;
      end out;
 
      unit empty : function: boolean;
      begin
          result :=  (first=none) ;
      end empty;
   end queue;
 
   unit tempo : procedure(n:integer);
   var j,x:integer;
   begin
        for j := 1 to n do x:=x od;
   end tempo;
 
   unit putt : procedure(n:integer,qui:pi,ch:integer; output czekaj : boolean);
   var  aux, i : integer,e : elem;
   begin
 
         if (counter< 20 and ilosc_ak+ch<size)
         then
                e := new elem;
                e.nr :=n;
                e.ile := ch;
                e.qui := qui;
                counter := counter +1;
                buffer(counter) := new Belem(e,x);
 
    (*         monitor zapisuje przesylke od        *)
                for i :=1 to ch do
                      call ek.line(2*n+1,x+i,posY+7,39,false);
                      call tempo(300);
                od;
                x := x+ ch;
                ilosc_ak := ilosc_ak+ch;
                czekaj := false;
                if not queue_pour_lire.empty
                then
(*                monitor budzi pisarza z kolejki czytelnikow  *)
                    p := queue_pour_lire.out;
                    call ek.outtext((nr-1)*150,180,"       ");
                    resume(p);
                 fi;
            else
(*               nie ma miejsca w buforze dla pisarza      *)
                 czekaj := true;
                 call queue_pour_ecrire.into(qui,n);
 
            fi;
      end putt;
 
      unit gett:procedure(inout nr:integer, qui:pi, ch:integer, czekaj:boolean);
      var i ,j : integer, e:elem , p:pi;
      begin
         p := qui;
         if counter<> 0  then (* mozna cos zabrac z magazynu *)
                e := buffer(counter).e;
                nr := e.nr; qui := e.qui; ch := e.ile;
                counter := counter - 1;
                czekaj := false;
                for i := x downto x-ch
                do
                   call ek.line(0,i,posY+7,39,false);
                   call tempo(200);
 
                od;
                x := x-ch;
                ilosc_ak := ilosc_ak-ch;
                (* w magazynie zwolnilo sie miejsce i ktos moze wpisac *)
 
                if not queue_pour_ecrire.empty
                then
       (*           writeln("M budzi pisarza ktory chce pisac ");*)
                    p := queue_pour_ecrire.out;
                    call ek.outtext((nr-1)*150,180,"       ");
                    resume(p);
                 fi;
            else (*jezeli counter=0 tzn. nic nie ma w magazynie *)
(*                 writeln("M wpisuje pisarza",nr,"do kolejki czytelnikow");*)
                 czekaj := true;
                 qui := p;(* to jest instrukcja niepotrzebna *)
                 call queue_pour_lire.into(p,nr);
            fi;
      end gett;
 
begin  (*   tu sie zaczyna tresc monitora *)
 
     array buffer dim(1:20);
 
     counter := 0;
     x := 12; ilosc_ak := 0;
     Qpos := posX;
     queue_pour_lire := new queue(Qpos);
     queue_pour_ecrire := new queue(Qpos+300);
     call ek.magazyn;
     call ek.outtext(posX,posY-6,"BUFFER");
     call ek.outtext(posX,posY+60,"READERS' QUEUE");
     call ek.outtext(posX+ 300, posY+60,"WRITERS'QUEUE");
     return;
     do
          accept putt, gett;
          if nb_proc = max_proc
          then
              call ek.outmessage(470,339,"DEADLOCK! press CR");
              readln;
              call ek.fin;
           fi;
     od;
end monitor;
 
 
 (*  M A I N *)    

var PROC : arrayof pi,p,P1,P2,P3 : pi,
    M : monitor,
    EK : ecran,
    i, NbProc : integer;
 
begin  
 
     write("NbProc : ");
     readln(NbProc);
     array Proc dim(1:NbProc);
 
     ek := new ecran(0);
     resume(ek);
     M := new monitor(0,550,NbProc,ek);
     resume(M);
     for i := 1 to NbProc
     do
           P := new pi(0,i,M,ek);
           Proc(i) := P;
     od;
 
 
       call  ek.outmessage(550,320,"press CR");
       readln;
       call  ek.outtext(550,320,"        ");
 
        for i :=1 to NbProc
        do   p := Proc(i);
             resume(p);
        od;
 
 
end processus4;