Program SystemedeFenetrage;
begin
pref iiuwgraph block
(* version lightweight processus *)
Const Noir        =0,Bleu          =1,Vert        =2,Cyan          =3,
      Rouge       =4,Magenta       =5,Marron      =6,GrisCLair     =7,
      GrisFonce   =8,BleuClair     =9,VertClair  =10,CyanClair    =11,
      RougeClair =12,MagentaClair =13,Jaune      =14,Blanc        =15;


   (*********************************************************************)
   (*        notion de lightweight process                              *)
   (*********************************************************************)
var actualp: proces;
var active: set;
var suspended :set;

  unit semafor : class;
    hidden close SEM, SUSPENDED;
    var SEM : boolean;
    var SUSPENDED : set;

    unit tsp : function : boolean;
      begin
       result := SEM;
       sem := true;
    end tsp;

    unit up : procedure;
      begin
       SEM := false;
    end up;

    unit lockp : procedure;
      begin
       if SEM
       then
        call active.delete(actualp);
        call suspended.insert(actualp);
        actualp.suspndd := true;
        actualp := active.amember;
        attach(actualp);
       else
        SEM := true
       fi
    end lockp;

    unit unlockp : procedure;
      var aux : proces;

      begin
       if suspended.empty
       then
        SEM := false
       else
        aux := suspended.min;
        call suspended.delete(aux);
        aux.suspndd := false;
        call active.insert(aux)
       fi
    end unlockp;

    begin (* initialization of a semaphore*)
     suspended := new set
   end semafor;


   unit set : class;
    (* in this version it will be a queue *)

     unit link : class(x : proces);
       var next : link
     end link;

     var head, tail : link;

     unit insert : procedure(x : proces);
       var ogniwo : link;
     begin
       ogniwo := new link(x);
       if tail = none
       then
        head := ogniwo
       else
        tail.next := ogniwo
       fi;
       tail := ogniwo
     end insert;

     unit empty : function : boolean;
       begin
        result := (head = none)
     end empty;

     unit min : function : proces;
       begin
        result := head.x;
     end min;

     unit delete : procedure (x : proces);
       var o,ogniwo : link;
     begin
      o,ogniwo := head;
      while ogniwo.x =/= x
      do
       o := ogniwo;
       ogniwo := ogniwo.next;
       if ogniwo = none
       then
        writeln(" deleted process does not exist");
        return
       fi;
      od;
      if ogniwo = head
      then
       head := head.next
      fi;
      o.next := ogniwo.next;
      if ogniwo = tail
      then
       tail := o;
       tail.next := none
      fi;
      kill(ogniwo)
   end delete;

   unit amember : function : proces;
     var o : link;
   begin
     result := head.x;
     if head.next =/= none
     then
      o := head;
      tail.next := o;
      tail := o;
      head := head.next;
      o.next := none
     fi
   end amember;

 end set;



 unit proces : coroutine;
   (* this class implements notion of process*)
   var nrofsons : integer;
   var waiting, terminated, suspndd : boolean;
   var father, nameofson : proces;

   unit resumep : procedure(x : proces);
    begin
      if x.suspndd
      then
       call suspended.delete(x);
       call active.insert(x);
       x.suspndd := false;
      else
       if x.terminated
       then
        (* error *)
        writeln(" you are resuming a terminated process?!");
        return
       fi
      fi
   end resumep;


   unit stopp : procedure;
    begin
      call active.delete(actualp);
      call suspended.insert(actualp);
      suspndd := true;
      actualp := active.amember;
      attach(actualp)
  end stopp;

  unit waitp : function(y : proces) : proces;
    begin
      if y = none
      then
       (*error*)
       writeln(" waiting for a process which does not exist");
       return
      fi;
      if y.terminated
      then
       return
      fi;
      if y.father =/= this proces
      then
       (* error *)
       writeln(" y is not your son!");
       return
      fi;
      (* O.K. *)
      nameofson := y;
      waiting := true;
      call stopp;

      (* here we shall return upon termination of son*)
      result := nameofson;
      waiting := false;
  end waitp;


  unit stoppar :procedure (z:semafor);
    begin
      call z.unlockp;
      call stopp
  end stoppar;

  unit waitn : function : proces;
    begin
      if nrofsons = 0
      then (*error*)
        writeln(" you wait for a son, but it does not exist ");
        return;
      else
        waiting:=true;
        nameofson:=none;
        call stopp;
        (* you return here *)
        result:=nameofson;
        waiting:= false;
      fi;
  end waitn;

  unit xqmulti : procedure;
    begin
      actualp:=active.amember;
      attach(actualp)
  end xqmulti;

  begin  (*prologue of process*)
     father:= actualp;
     if father =/= none
     then
       father.nrofsons:=father.nrofsons +1;
     fi;
     call suspended.insert (this proces);
     suspndd:=true;

     inner; (* here comes the body of your process *)

     (* process epilogue *)
     terminated :=true;
     call active.delete(actualp);
     if father =/= none
     then
       father.nrofsons:=father.nrofsons - 1;
       if father.waiting
       then
         if father.nameofson = none
         then
           father.nameofson := this proces
         fi;
         if father.nameofson = this proces
         then
           call resumep(father)
         fi
       fi;
       actualp:=active.amember;
       attach(actualp);
     else
       attach(main);
     fi;
   end proces;
   unit resumep : procedure(x : proces);
    begin
      if x.suspndd
      then
       call suspended.delete(x);
       call active.insert(x);
       x.suspndd := false;
      else
       if x.terminated
       then
        (* error *)
        writeln(" you are resuming a terminated process?!");
        return
       fi
      fi
   end resumep;

     unit Arbitrage : procedure;
       begin
         actualp:=active.amember;
         attach(actualp);
     end Arbitrage;





   (*****************************************************************************)
   (*             premiere famille de classes : les classes graphiques          *)
   (*****************************************************************************)
   Unit Ptr : Class;
   End Ptr;

   Unit Windows : Ptr Class(father :windows,x1,y1,x2,y2 : integer);
   Close hauteur,largeur;
   Var lborder,cfond,cborder : integer,
       lbande,cfbande,cbbande : integer,
      hauteur,largeur       : integer,
      xpos,ypos,xmax,ymax   : integer,
      xdeb,ydeb             : integer,
      num_id                : integer,
      ListM                 : Lclic,
      ListK                 : LKey,
      nombande              : arrayof char,
      barcde                : menu,
      save_map              : arrayof integer;

      Unit option : procedure (l1,l2,l3,l4,l5,l6 : integer,l7 : arrayof char);
      Begin
       cfond:=l1; lborder:=l2; cborder:=l3; lbande:=l4;
       cfbande:=l5; cbbande:=l6;
       nombande:=copy(l7);
       writeln("coucou2 l1=",l1);
      End option;

      Unit Affiche : procedure;
      Var i,j,k :integer;
      Begin
       call father.rectanglef(x1,y1,x2,y2,cfond);
       for i:=0 to lborder
        do
         call father.rectangle(x1+i,y1+i,x2-i,y2-i,cborder);
        od;
       i:=y1+lborder+1;
       call father.rectanglef(x1+lborder+1,i,x2-lborder-1,i+imax(14,lbande),cfbande);
       j:=(x2-x1-2*lborder-8*(upper(nombande)-lower(nombande)))/2;
       for i:=lower(nombande) to upper(nombande)
        do
         k:=x1+lborder+j+i*8;
         call father.outxyascii(k,y1+lborder+2,ord(nombande(i)),cbbande,cfbande);
        od;
        call affichesuite;
        if(barcde<>none)
        then call barcde.affichemenu;
        fi
      End Affiche;

      Unit virtual affichesuite :procedure;
      End affichesuite;

      Unit virtual rectangle : procedure(xx1,yy1,xx2,yy2,c :integer);
      End rectangle;

      Unit virtual rectanglef : procedure(xx1,yy1,xx2,yy2,c : integer);
      End rectanglef;

      Unit virtual outxyascii : procedure(x,y,car,cf,cb : integer);
      End outxyascii;

      Unit virtual outxytext : procedure(x,y:integer,chaine:string,c1,c2:integer);
      End outxytext;

   Begin
    hauteur:=y2-y1-2*lborder;
    largeur:=x2-x1-2*lborder;
   End Windows;

   Unit Bitmap : Windows Class;
   End Bitmap;

   Unit Son : Windows Class;
   End Son;

   Unit Maine : Windows Class;
   End Maine;

   Unit Dialogue : Son Class;
   End Dialogue;

   Unit Catalogue : Dialogue Class;
   End Catalogue;

   Unit Question : Dialogue Class;
   End Question;

   Unit Widgets : Ptr Class(father : windows);
   End Widgets;

   (**********************************************************************)
   Unit Menu : Widgets Class(x,y,col_e,col_f: integer);
   Var liste : ensemble;

    Unit item : element class(nom : string,key : integer,suite :Menu);
    End item;

    Unit insert : procedure(nom : string,key : integer,s : menu);
    var e : item;
    Begin
      e:=new item(nom,key,s);
      if(liste=none)
      then liste:=new ensemble;
      fi;
      call liste.insert(e);
    End insert;

    Unit virtual affichemenu : procedure;
    End affichemenu;

   End Menu;

   Unit Menu_V : Menu Class;

    Unit  virtual affichemenu : procedure;
    Var cour  : item,
        tlen  : arrayof char,
        len   : integer,
        xx,yy : integer;
    Begin
     call liste.initialise;
     xx:=x; yy:=y;
     if(liste.getelm(cour))
     then while(cour<>none)
           do
            call father.outxytext(xx,yy,cour.nom,col_e,col_f);
            tlen:=unpack(cour.nom);
            len:=upper(tlen)-lower(tlen)+1;
            kill(tlen);
            if(father.ListM=none)
            then father.ListM:=new LClic;
            fi;
            call father.ListM.insert(new elm_c(0 ,xx,yy,xx+len*8,yy+14));
                                           (* id *)
            yy:=yy+20;
            if not liste.getelm(cour)
            then exit
            fi
           od
     fi
    End affichemenu;

   End Menu_V;

   Unit Menu_H : Menu Class;
   End Menu_H;

   Unit Bottons : Widgets Class;
   End Bottons;

   Unit Racc : Bottons Class;
   End Racc;

   Unit Opt_list : Bottons Class;
   End Opt_list;

   Unit Oneline : Opt_list Class;
   End Oneline;

   Unit Multiline : Opt_list Class;
   End Multiline;

   Unit Botton : Bottons Class;
   End Botton;

   Unit Lift : Widgets Class;
   End Lift;

   Unit Lift_V : Lift Class;
   End Lift_V;

   Unit Lift_H : Lift Class;
   End Lift_H;

   (*****************************************************************************)
   (*          deuxieme famille de classes : les structures de donnees          *)
   (*****************************************************************************)
   Unit element : class;  (* general *)
   End element;

   Unit elm_c : element class(id,x1,y1,x2,y2 : integer); (* listclic *)
   End elm_c;

   Unit elm_a : element class(p : Applications);  (* liste application *)
   End elm_a;


   Unit Ensemble : CLass;
   Var root,last : node,
       courant   : node;

    Unit node : class(elm : element);
    Var next : node;
    End node;

    Unit virtual insert : procedure(e : element);
    Begin
     if not member(e)
     then if empty
          then root:=new node(e);
               last:=root;
          else last.next:=new node(e);
               last:=last.next;
          fi
     fi
    End insert;

    Unit virtual delete : procedure(e : element);
    Var flag : node;
    Begin
     if member(e)
     then flag:=courant.next;
          if flag=last
          then last:=courant;
               courant.next:=none;
               kill(flag);
          else if courant.next<>none
               then courant.next:=courant.next.next;
                    kill(flag);
               fi
          fi
     fi
    End delete;

    Unit virtual member : function (e : element) : boolean;
    Var  savecou : node,
         bl : boolean;
    Begin
     courant:=root;
     savecou:=courant;
     bl:=false;
     while(courant<>none)
      do
       if not egalite(courant.elm,e)
       then savecou:=courant;
            courant:=courant.next;
       else bl:=true;
            exit;
       fi
      od;
      courant:=savecou;
      result:=bl;
    End member;

    Unit virtual egalite : function (e1,e2 :element) :boolean;
    End egalite;

    Unit empty : function : boolean;
    Begin
     result:=(root=none);
    End empty;

    Unit initialise : procedure;
    Begin
     courant:=root;
    End initialise;

    Unit getelm : function(output e : element) :boolean;
    Begin
     if(courant<>none)
     then e:=courant.elm;
          result:=true;
          courant:=courant.next;
     else result:=false;
     fi
    End getelm;

   End Ensemble;

   Unit Queue : Ensemble Class;
   End Queue;

   Unit Ofpriority : Queue Class;
   End Ofpriority;

   Unit ListD : Ensemble Class;
   End ListD;

   Unit LClic : ListD Class;

    Unit virtual egalite : function (e1,e2 :element) :boolean;
    Begin
     if (e1 qua elm_c.x1=e2 qua elm_c.x1 and e1 qua elm_c.x2=e2 qua elm_c.x2
         and e1 qua elm_c.y1=e2 qua elm_c.y1 and e1 qua elm_c.y2=e2 qua elm_c.y2)
     then result:=TRUE;
     else result:=FALSE;
     fi
    End egalite;

    Unit appartient : function (x,y : integer) : boolean;
    Var e : elm_c,
        b : boolean;
    Begin
     call initialise;
     b:=false;
     while(getelm(e))
      do
       if (x>=e.x1 and x<=e.x2 and y>=e.y1 and y<=e.y2)
       then  b:=TRUE;
             exit;
       fi
      od;
     result:=b;
    End appartient;

   End LClic;

   Unit LBot : ListD Class;
   End LBot;

   Unit LAppli : ListD Class;
   End LAppli;

   Unit LKey : ListD Class;
   End LKey;

   Unit LWin : ListD Class;
   End LWin;

   Unit Stack : Ensemble Class;
   End Stack;


   (*****************************************************************************)
   (*                           Famille de process                              *)
   (*****************************************************************************)
   Unit Applications : proces class(x1,y1,x2,y2 : integer,father : Gest_Wind);
   Var w      : windows, (* maine *)
       Filles : windows, (* son *)
       i      : integer;

    Unit virtual gestionnaire : procedure(id : integer);
    Begin
    End gestionnaire;

   Begin
      writeln("coucou");
      w:=new windows(father.getw,x1,y1,x2,y2);
     return;
      writeln("toto");
      call w.option(Noir,3,VertClair,15,VertCLair,Noir,unpack("nom"));
      call w.affiche;

      do
         call Arbitrage;
      od;
   End Applications;

  (************************************************************************)
  (************************************************************************)
   Unit Gest_event : proces class(gest : gest_wind);

    Unit ready : procedure;
    Begin
       writeln("Gest_events READY");
    End ready;

    Unit souris: Mouse coroutine;
    begin
       call init(1,1);
       return;

(* ici on peut mettre la fermeture de la souris *)
    End souris;

    Var myszka: souris;

    Unit event : function(output v,h,p,l,r,c : integer) : boolean;
    Begin
     result:=myszka.getpress(v,h,p,l,r,c);
    End;

   Var i :integer,
       v,h,p,l,r,c : integer;
   Begin
      myszka := new souris;
      (* accept ready; *)
(*      call init(1,1);  *)
      call myszka.showcursor;
      return;
      do
       if event(v,h,p,l,r,c)
       then
         call gest.event(v,h,p,l,r,c);
       fi;
       call Arbitrage;
      od;
   End Gest_event;

  (***********************************************************************)
  (***********************************************************************)
   Unit Gest_wind :  proces class(x1,y1,x2,y2 : integer,gest:gest_event);
   Var i,k :integer,
       v,p,h,l,r,c : integer,
       ListK       : LKey,
       ListM       : LClic,
       ListA       : LAppli,
       w           : windows,
       j           : graph;


    Unit getinfo : procedure (g : gest_event);
    Begin
     gest:=g;
     disable getinfo;
     writeln("getinfo");
    End getinfo;

    Unit event : procedure (input lv,lh,lp,ll,lr,lc : integer);
    Begin
     v:=lv; h:=lh; p:=lp; l:=ll; r:=lr; c:=lc;
    End event;

    Unit traitement : procedure;
    Begin
     if((h=164 and l=27) or   c=3)
     then call fin;
     fi;

     (* recherche dans un arbre des fenetres filles si l'evenement *)
     (* appartient a qqn                                           *)



    End traitement;

    Unit fin : procedure;
    begin
(*     call groff;   *)
     attach (j.gr);         (* pour terminer iiuwgraph *)
     writeln("on ferme");
     call endrun;
    End fin;

  (***********************************************************************)
    Unit graph : windows class;
     
     unit graphi: iiuwgraph coroutine;
     begin
        call gron(0);  
        return;

     end graphi;

     var gr: graphi;

     Unit virtual rectangle : procedure (x1,y1,x2,y2,c : integer);
     Begin
      call gr.patern(x1,y1,x2,y2,c,0);
     End rectangle;

     Unit virtual rectanglef : procedure (x1,y1,x2,y2,c : integer);
     Begin
      writeln("coucou3 x1=",x1,"x2=",x2,"y1=",y1,"y2=",y2,"c=",c);
      if gr=none then writeln("NONE!") fi;
       call gr.patern(x1,y1,x2,y2,c,1);

     End rectanglef;

     Unit virtual ligne : procedure (x1,y1,x2,y2,c : integer);
     Begin
      call gr.color(c);
      call gr.move(x1,y1);
      call gr.draw(x2,y2);
     End ligne;

     Unit virtual outxyascii : procedure (x,y,car,cf,cb :integer);
     Begin
      call gr.move(x,y);
      call gr.color(cf);
      call gr.border(cb);
      call gr.hascii(car);
     End outxyascii;

     Unit virtual outxytext : procedure (x,y :integer, chaine :string,c1,c2 :integer);
     Begin
      call gr.outstring(x,y,chaine,c1,c2);
     End outxytext;

     Unit virtual affichesuite : procedure;
     Var x,y : integer;
     Begin
      x:=x1+100-lborder; y:=y1+lbande+lborder+1;
      call rectanglef(x,y,x+lborder,y2-lborder-1,cborder);
      x:=x+lborder; y:=y2-100-lborder;
      call rectanglef(x,y,x2-lborder,y+lborder,cborder);
      xdeb:=x1+100+10;
      ydeb:=y1+lborder+lbande+10;
     End affichesuite;
    begin
         gr := none;
 (*      gr := new graphi;   *)
    End graph;

    Unit initialisation1 : procedure;
    Var itermed1 : menu_v,
        i,j : integer;
    Begin
      i:=w.lborder+10+20; j:=y1+w.lborder+10+w.lbande+20*4;
      itermed1:=new menu_V(w.father,i,j,Blanc,GrisFonce);
      call itermed1.insert("Nouveau",319,none);
      call itermed1.insert("Ouvrir",320,none);
      call itermed1.insert("D‚placer",321,none);
      call itermed1.insert("Copier",322,none);
      call itermed1.insert("Supprimer",323,none);
      call itermed1.insert("Propri‚t‚",324,none);
      i:=w.lborder+10; j:=y1+w.lborder+10+w.lbande;
      w.barcde:=new menu_V(w.father,i,j,Blanc,GrisFonce);
      call w.barcde.insert("Fichier",315,itermed1);
      call w.barcde.insert("Options",316,none);
      call w.barcde.insert("Fenetre",317,none);
      call w.barcde.insert("Aide",318,none);
    End initialisation1;

    Unit initialisation2 : procedure;
    Begin
     ListA:=new LAppli;
    End initialisation2;

    Unit xdeb :  function : integer;
    Begin
     result:=w.xdeb;
    End xdeb;

    Unit ydeb : function : integer;
    Begin
     result:=w.ydeb;
    End ydeb;

    Unit getw : function : windows;
    Begin
     result:=w;
    End getw;


   Begin
      call gron(0 );  (* 3 = 1024x768x256 *)
      j:=new graph(none,x1,y1,x2,y2);
      w:=new windows(j,x1,y1,x2,y2);

      call w.option(Grisfonce,3,BleuClair,15,BleuCLair,Blanc,unpack("Gest_Wind"));
      call initialisation1;
      call w.affiche;

      call J.option(Grisfonce,3,BleuClair,15,BleuCLair,Blanc,unpack("Gest_Wind"));
      call j.affichesuite;
   (* accept getinfo;  *)
(*      enable xdeb,ydeb,getw;  *)
(*      call gest.ready;        *)
      call initialisation2;
      return;

      do
   (*  accept event;  *)
       call traitement;
       call Arbitrage;
      od;
  (*    call groff;  *)
      attach(j.gr);
   End Gest_wind;


(*****************************************************************************)
(*                   P r o g r a m  m e   P r i n c i p a l                  *)
(*****************************************************************************)
Var i  : integer,
    G1 : Gest_wind,
    Z1 : applications,
    G2 : Gest_event,
    x,y :integer;

Begin
   active:= new set;
   suspended :=new set;
   G1:=new Gest_wind(0,0,640,480,none);
   G2:=new Gest_event(G1);
   call resumep(G1);
   call resumep(G2);  
   call G1.getinfo(G2);

   x:=G1.w.xdeb;
   writeln("x=",x);
   y:=G1.w.ydeb;
   writeln("y=",y);
   Z1:=new applications(x+10,y+10,x+330,y+210,G1);


   call G1.ListA.insert(new elm_a(Z1));
   call resumep(Z1);
   call Arbitrage;
   writeln("Dobro doszli");
end
End.