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;

Const MODE   = 0;
Const XMAX   = 640, YMAX= 480;

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

   Unit Windows : process (node : integer,father :windows,x1,y1,x2,y2 : integer);
   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,
      Bout                  : arrayof bottons,
      nombande              : arrayof char,
      barcde                : menu,
      save_map              : arrayof integer;


      Unit option : procedure (l1,l2,l3,l4,l5,l6 : integer,l7 : string);
      Begin
       cfond:=l1; lborder:=l2; cborder:=l3; lbande:=l4;
       cfbande:=l5; cbbande:=l6;
       nombande:=unpack(l7);
       xdeb:=x1+lborder+3;
       ydeb:=y1+lborder+lbande+3;
       bout(1):=new racc(this windows,x1+lborder+1,y1+lborder+1,x1+lborder+1+
		      lbande,y1+lborder+1+lbande,spr_close);
       bout(2):=new racc(this windows,x2-lborder-2-lbande*2,y1+lborder+1,
			 x2-lborder-2-lbande,y1+lborder+1+lbande,spr_lower);
       bout(3):=new racc(this windows,x2-lborder-1-lbande,y1+lborder+1,
			 x2-lborder-1,y1+lborder+1+lbande,spr_upper);
      End option;

      Unit Affiche : procedure;
      Var i,j,k :integer;
      Begin
       call father.moveto(x1,y1);
       save_map:=father.getmape(x2,y2);
       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;
	call bout(1).affiche;
	call bout(2).affiche;
	call bout(3).affiche;
	call affichesuite;
      End Affiche;

      Unit virtual affichesuite :procedure;
      End affichesuite;

      Unit virtual moveto : procedure(x1,y1 : integer);
      Begin
       call father.moveto(x1,y1);
      End moveto;

      Unit virtual getmape : function(x2,y2 : integer) : arrayof integer;
      Begin
       result:=father.getmape(x2,y2);
      End getmape;

      Unit virtual putmape : procedure(a : arrayof integer);
      Begin
       call father.putmape(a);
      End putmape;

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

      Unit virtual ligne : procedure (xx1,yy1,xx2,yy2,c : integer);
      Begin
       call father.ligne(xx1,yy1,xx2,yy2,c);
      End ligne;

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

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

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

      Unit virtual outxyint : procedure(x,y,val,cf,ce :integer);
      Begin
       call father.outxyint(x,y,val,cf,ce);
      End outxyint;

     unit ydebut: function: integer;
     begin
	   result := ydeb
     end ydebut;
     
     unit xdebut: function: integer;
     begin
	   result := xdeb
     end xdebut;

     Unit EndWindow : procedure;
     Begin
       call father.moveto(x1,y1);
       call putmape(save_map);
     End EndWindow;

   Begin
    hauteur:=y2-y1-2*lborder;
    largeur:=x2-x1-2*lborder;
    array bout dim (1:3);
    return;

    enable outxytext, outxyascii, rectanglef, rectangle, affichesuite,
	   affiche, option, xdebut, ydebut, outxyint, ligne, moveto ,
	   getmape, putmape, Endwindow;
    do
      accept
    od
   End Windows;

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

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

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

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

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

     Unit virtual outxyint : iiuwgraph procedure (x,y,val,cf,ce :integer);
     Begin
      call track(x,y,val,cf,ce);
     End outxyint;

     Unit virtual moveto : iiuwgraph procedure (x1,y1 : integer);
     Begin
      call move(x1,y1); 
     End moveto;

     Unit virtual getmape : iiuwgraph function (x2,y2 : integer) : arrayof integer;
     Begin
      result:=getmap(x2,y2);
     End getmape;

     Unit virtual putmape : iiuwgraph procedure (a : arrayof integer);
     Begin
      call putmap(a);
     End putmape;

     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
     return;

     enable affichesuite,affiche, option, xdebut, ydebut,
	    enablegraph,disablegraph;
     do
       accept
     od
    End graph;


   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 : 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
     (* ... *)
    End affichemenu;

   End Menu_V;

   Unit Menu_H : Menu Class;
   
    Unit  virtual affichemenu : procedure;
    Var cour  : item,
	tlen  : arrayof char,
	len   : integer,
	xx,yy : integer;
    Begin
     (* ... *)
    End affichemenu;
   
   End Menu_H;

  (***********************************************************************)
   Unit Bottons : Widgets Class(x1,y1,x2,y2 : integer);
    Unit affiche : procedure;
    Begin
     call father.rectanglef(x1,y1,x2,y2,GrisClair);
     call father.ligne(x1,y1,x2,y1,blanc);
     call father.ligne(x1,y1+1,x2-1,y1+1,blanc);
     call father.ligne(x1,y1,x1,y2,blanc);
     call father.ligne(x1+1,y1+2,x1+1,y2-1,blanc);
     call father.ligne(x1+1,y2,x2,y2,GrisFonce);
     call father.ligne(x1+2,y2-1,x2-1,y2-1,GrisFonce);
     call father.ligne(x2,y2,x2,y1+1,GrisFonce);
     call father.ligne(x2-1,y2-1,x2-1,y1+2,GrisFonce);
     call affichesuite;
    End affiche;

    Unit virtual affichesuite : procedure;
    End affichesuite;

   End Bottons;

   Unit Racc : Bottons Class(procedure sprite(x1,y1,x2,y2,c : integer,
						father :windows));
    Unit virtual affichesuite : procedure;
    Begin
     call sprite(x1,y1,x2,y2,Noir,father);
    End affichesuite;
   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;




(***************************************************************************)
(*             procedure d'affichage des sprites des boutons               *)
(***************************************************************************)

(***************************************************************************)
   Unit spr_upper : procedure(x1,y1,x2,y2,couleur : integer,father:windows);
   var i,x,y : integer;
   Begin
    x:=(x2-x1)/2;
    y:=(y2-y1)/2;
    for i:=1 to y
    do
     call father.Ligne(x1+x-i/2,y1+y/2+i,x1+x+i/2,y1+y/2+i,couleur);
    od
   End spr_upper;

(***************************************************************************)
   Unit spr_lower : procedure(x1,y1,x2,y2,couleur : integer,father:windows);
   var i,x,y : integer;
   Begin
    x:=(x2-x1)/2;
    y:=(y2-y1)/2;
    for i:=1 to y
    do
     call father.Ligne(x1+x-i/2,y2-y/2-i,x1+x+i/2,y2-y/2-i,couleur);
    od
   End spr_lower;

(***************************************************************************)
   Unit spr_left : procedure(x1,y1,x2,y2,couleur : integer,father:windows);
   var i,x,y : integer;
   Begin
    x:=(x2-x1)/2;
    y:=(y2-y1)/2;
    for i:=1 to x
    do
     call father.Ligne(x2-x/2-i,y1+y-i/2,x2-x/2-i,y1+y+i/2,couleur);
    od
   End spr_left;

(***************************************************************************)
   Unit spr_right : procedure(x1,y1,x2,y2,couleur : integer,father:windows);
   var i,x,y : integer;
   Begin
    x:=(x2-x1)/2;
    y:=(y2-y1)/2;
    for i:=1 to x
    do
     call father.Ligne(x1+x/2+i,y1+y-i/2,x1+x/2+i,y1+y+i/2,couleur);
    od
   End spr_right;

(***************************************************************************)
   Unit spr_close : procedure(x1,y1,x2,y2,couleur : integer,father:windows);
   var y : integer;
   Begin
    y:=(y2-y1)/2;
    call father.Rectanglef(x1+3,y1+y-1,x2-3,y1+y+1,couleur);
   End spr_close;

(***************************************************************************)
   Unit spr_point : procedure(x1,y1,x2,y2,couleur : integer,father:windows);
   var x,y : integer;
   Begin
    y:=(y2-y1)/2;
    x:=(x2-x1)/2;
    call father.Rectanglef(x1+x-1,y1+y-1,x1+x+1,y1+y+1,couleur);
   End spr_point;



   (*****************************************************************************)
   (*          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;
    Unit egalite : function (e1,e2 :elm_a) :boolean;
    Begin
     if (e1 qua elm_a.p = e2 qua elm_a.p)
     then result:=TRUE;
     else result:=FALSE;
     fi;
    End egalite;
   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 *)
       j      : graph,
       Filles : windows, (* son *)
       i      : integer,
       nom    : string;

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

    Unit affecte : procedure ( nm : string);
    Begin
     nom:=nm;
    End affecte;

   Begin
      w:=new windows(0,father.getw,x1,y1,x2,y2);
      resume(w);
      return;
      accept affecte;
      call w.option(Noir,3,Bleu,15,Bleu,Blanc,nom);
      call w.affiche;
   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,px,py :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;
    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;
     call traitement;
    End event;


    Unit traitement : procedure;
  
      Unit fin : procedure;
      begin
	call groff;
	call endrun;
      End fin;
  
    Begin
     if((p=164 and l=27) or   c=3)
     then call fin;
     fi;
     (* recherche dans un arbre des fenetres filles si l'evenement *)
     (* appartient a qqn                                           *)
     (* ici c'est a refaire, c'est juste pour tester *)
     if(c=1)
     then if(v>110 and v<400 and h>50 and h<250)
	  then writeln("coucou");
	  fi;
     fi;
    End traitement;



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

    Unit xdeb :  function : integer;
    Begin
     result:=j.xdebut;
    End xdeb;

    Unit ydeb : function : integer;
    Begin
     result:=j.ydebut;
    End ydeb;

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

    
    Unit insertA : procedure(e : applications);
    Begin
     call ListA.insert(new elm_a(e));
    end; 
    


   Begin
      call gron(MODE);  (* 5 = 1024x768x256 *)
      j:=new graph(0,none,x1,y1,x2,y2);
      resume(j);
      w:=new windows(0,j,x1,y1,x2,y2);
      resume(w);
      call w.option(Grisfonce,3,BleuClair,15,BleuCLair,Blanc,"Gest_Wind");
      call w.affiche;
      call J.option(Grisfonce,3,BleuClair,15,BleuCLair,Blanc,"Gst_Windows");
      call j.affichesuite;
      return;

      accept getinfo;
      enable xdeb,ydeb,getw,insertA;
      call gest.ready;
      call initialisation2;           
      enable event;
      px:=w.xdebut; py:=w.ydebut;
      i:=1;
      do
       call w.outxyint(px,py,i,Bleu,Blanc);
       i:=i+1;
      od;
      call groff;
   End Gest_wind;


   Unit Appli : Applications class;
   Var px,py : integer;
   Begin   
     px:=w.xdebut; py:=w.ydebut;
     call w.outxytext(px,py,"coucou",Vert,Noir);
     i:=1;
     do
      call w.outxyint(px,py+20,i,Bleu,Blanc);
      i:=i+1;
     od
   End Appli;


(*****************************************************************************)
(*                   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,Z2 : appli,
    G2 : Gest_event,
    x,y :integer;

Begin
   G1:=new Gest_wind(0,0,0,XMAX,YMAX,none);
   G2:=new Gest_event(0,G1);
   resume(G1);
   resume(G2);
   call G1.getinfo(G2);

   x:=G1.xdeb;
   y:=G1.ydeb;
   
   Z1:=new appli(0,x+10,y+10,x+330,y+210,G1);
   resume(Z1);
   call G1.insertA(Z1);
   call Z1.affecte("Application - 1 -");
   
   Z2:=new appli(0,x+250,y+80,x+520,y+250,G1);
   resume(Z2);
   call G1.insertA(Z2);
   call Z2.affecte("Application - 2 -");


End.