Program SystemedeFenetrage;

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;



   (*****************************************************************************)
   (*             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);
      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 : process (node,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
      od;
   End Applications;

  (************************************************************************)
  (************************************************************************)
   Unit Gest_event : mouse process (node : integer,gest : gest_wind);

    Unit ready : procedure;
    End ready;

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

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

  (***********************************************************************)
  (***********************************************************************)
   Unit Gest_wind : iiuwgraph process(node,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;
     writeln("on ferme");
     call endrun;
    End fin;

  (***********************************************************************)
    Unit graph : windows class;

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

     Unit virtual rectanglef : procedure (x1,y1,x2,y2,c : integer);
     Begin
      call patern(x1,y1,x2,y2,c,1);
     End rectanglef;

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

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

     Unit virtual outxytext : procedure (x,y :integer, chaine :string,c1,c2 :integer);
     Begin
      call 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;

    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;
      return;
      accept getinfo;
      enable xdeb,ydeb,getw;
      call gest.ready;
      call initialisation2;
      do
       accept event;
       call traitement;
      od;
      call groff;
   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
   G1:=new Gest_wind(0,0,0,640,480,none);
   G2:=new Gest_event(0,G1);
   resume(G1);
   resume(G2);
   call G1.getinfo(G2);

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


   call G1.ListA.insert(new elm_a(Z1));
   resume(Z1);
End.