1 Program SystemedeFenetrage;
\r
3 Const Noir =0,Bleu =1,Vert =2,Cyan =3,
\r
4 Rouge =4,Magenta =5,Marron =6,GrisCLair =7,
\r
5 GrisFonce =8,BleuClair =9,VertClair =10,CyanClair =11,
\r
6 RougeClair =12,MagentaClair =13,Jaune =14,Blanc =15;
\r
10 (*****************************************************************************)
\r
11 (* premiere famille de classes : les classes graphiques *)
\r
12 (*****************************************************************************)
\r
16 Unit Windows : Ptr Class(father :windows,x1,y1,x2,y2 : integer);
\r
17 Close hauteur,largeur;
\r
18 Var lborder,cfond,cborder : integer,
\r
19 lbande,cfbande,cbbande : integer,
\r
20 hauteur,largeur : integer,
\r
21 xpos,ypos,xmax,ymax : integer,
\r
22 xdeb,ydeb : integer,
\r
26 nombande : arrayof char,
\r
28 save_map : arrayof integer;
\r
30 Unit option : procedure (l1,l2,l3,l4,l5,l6 : integer,l7 : arrayof char);
\r
32 cfond:=l1; lborder:=l2; cborder:=l3; lbande:=l4;
\r
33 cfbande:=l5; cbbande:=l6;
\r
37 Unit Affiche : procedure;
\r
40 call father.rectanglef(x1,y1,x2,y2,cfond);
\r
43 call father.rectangle(x1+i,y1+i,x2-i,y2-i,cborder);
\r
46 call father.rectanglef(x1+lborder+1,i,x2-lborder-1,i+imax(14,lbande),cfbande);
\r
47 j:=(x2-x1-2*lborder-8*(upper(nombande)-lower(nombande)))/2;
\r
48 for i:=lower(nombande) to upper(nombande)
\r
50 k:=x1+lborder+j+i*8;
\r
51 call father.outxyascii(k,y1+lborder+2,ord(nombande(i)),cbbande,cfbande);
\r
55 then call barcde.affichemenu;
\r
59 Unit virtual affichesuite :procedure;
\r
62 Unit virtual rectangle : procedure(xx1,yy1,xx2,yy2,c :integer);
\r
65 Unit virtual rectanglef : procedure(xx1,yy1,xx2,yy2,c : integer);
\r
68 Unit virtual outxyascii : procedure(x,y,car,cf,cb : integer);
\r
71 Unit virtual outxytext : procedure(x,y:integer,chaine:string,c1,c2:integer);
\r
75 hauteur:=y2-y1-2*lborder;
\r
76 largeur:=x2-x1-2*lborder;
\r
79 Unit Bitmap : Windows Class;
\r
82 Unit Son : Windows Class;
\r
85 Unit Maine : Windows Class;
\r
88 Unit Dialogue : Son Class;
\r
91 Unit Catalogue : Dialogue Class;
\r
94 Unit Question : Dialogue Class;
\r
97 Unit Widgets : Ptr Class(father : windows);
\r
100 (**********************************************************************)
\r
101 Unit Menu : Widgets Class(x,y,col_e,col_f: integer);
\r
102 Var liste : ensemble;
\r
104 Unit item : element class(nom : string,key : integer,suite :Menu);
\r
107 Unit insert : procedure(nom : string,key : integer,s : menu);
\r
110 e:=new item(nom,key,s);
\r
112 then liste:=new ensemble;
\r
114 call liste.insert(e);
\r
117 Unit virtual affichemenu : procedure;
\r
122 Unit Menu_V : Menu Class;
\r
124 Unit virtual affichemenu : procedure;
\r
126 tlen : arrayof char,
\r
130 call liste.initialise;
\r
132 if(liste.getelm(cour))
\r
133 then while(cour<>none)
\r
135 call father.outxytext(xx,yy,cour.nom,col_e,col_f);
\r
136 tlen:=unpack(cour.nom);
\r
137 len:=upper(tlen)-lower(tlen)+1;
\r
139 if(father.ListM=none)
\r
140 then father.ListM:=new LClic;
\r
142 call father.ListM.insert(new elm_c(0 ,xx,yy,xx+len*8,yy+14));
\r
145 if not liste.getelm(cour)
\r
154 Unit Menu_H : Menu Class;
\r
157 Unit Bottons : Widgets Class;
\r
160 Unit Racc : Bottons Class;
\r
163 Unit Opt_list : Bottons Class;
\r
166 Unit Oneline : Opt_list Class;
\r
169 Unit Multiline : Opt_list Class;
\r
172 Unit Botton : Bottons Class;
\r
175 Unit Lift : Widgets Class;
\r
178 Unit Lift_V : Lift Class;
\r
181 Unit Lift_H : Lift Class;
\r
184 (*****************************************************************************)
\r
185 (* deuxieme famille de classes : les structures de donnees *)
\r
186 (*****************************************************************************)
\r
187 Unit element : class; (* general *)
\r
190 Unit elm_c : element class(id,x1,y1,x2,y2 : integer); (* listclic *)
\r
193 Unit elm_a : element class(p : Applications); (* liste application *)
\r
197 Unit Ensemble : CLass;
\r
198 Var root,last : node,
\r
201 Unit node : class(elm : element);
\r
205 Unit virtual insert : procedure(e : element);
\r
209 then root:=new node(e);
\r
211 else last.next:=new node(e);
\r
217 Unit virtual delete : procedure(e : element);
\r
221 then flag:=courant.next;
\r
223 then last:=courant;
\r
224 courant.next:=none;
\r
226 else if courant.next<>none
\r
227 then courant.next:=courant.next.next;
\r
234 Unit virtual member : function (e : element) : boolean;
\r
235 Var savecou : node,
\r
241 while(courant<>none)
\r
243 if not egalite(courant.elm,e)
\r
244 then savecou:=courant;
\r
245 courant:=courant.next;
\r
254 Unit virtual egalite : function (e1,e2 :element) :boolean;
\r
257 Unit empty : function : boolean;
\r
259 result:=(root=none);
\r
262 Unit initialise : procedure;
\r
267 Unit getelm : function(output e : element) :boolean;
\r
270 then e:=courant.elm;
\r
272 courant:=courant.next;
\r
273 else result:=false;
\r
279 Unit Queue : Ensemble Class;
\r
282 Unit Ofpriority : Queue Class;
\r
285 Unit ListD : Ensemble Class;
\r
288 Unit LClic : ListD Class;
\r
290 Unit virtual egalite : function (e1,e2 :element) :boolean;
\r
292 if (e1 qua elm_c.x1=e2 qua elm_c.x1 and e1 qua elm_c.x2=e2 qua elm_c.x2
\r
293 and e1 qua elm_c.y1=e2 qua elm_c.y1 and e1 qua elm_c.y2=e2 qua elm_c.y2)
\r
295 else result:=FALSE;
\r
299 Unit appartient : function (x,y : integer) : boolean;
\r
307 if (x>=e.x1 and x<=e.x2 and y>=e.y1 and y<=e.y2)
\r
317 Unit LBot : ListD Class;
\r
320 Unit LAppli : ListD Class;
\r
323 Unit LKey : ListD Class;
\r
326 Unit LWin : ListD Class;
\r
329 Unit Stack : Ensemble Class;
\r
333 (*****************************************************************************)
\r
334 (* Famille de process *)
\r
335 (*****************************************************************************)
\r
336 Unit Applications : process (node,x1,y1,x2,y2 : integer,father : Gest_Wind);
\r
337 Var w : windows, (* maine *)
\r
338 Filles : windows, (* son *)
\r
341 Unit virtual gestionnaire : procedure(id : integer);
\r
347 w:=new windows(father.getw,x1,y1,x2,y2);
\r
350 call w.option(Noir,3,VertClair,15,VertCLair,Noir,unpack("nom"));
\r
356 (************************************************************************)
\r
357 (************************************************************************)
\r
358 Unit Gest_event : mouse process (node : integer,gest : gest_wind);
\r
360 Unit ready : procedure;
\r
363 Unit event : function(output v,h,p,l,r,c : integer) : boolean;
\r
365 result:=getpress(v,h,p,l,r,c);
\r
369 v,h,p,l,r,c : integer;
\r
376 if(event(v,h,p,l,r,c))
\r
377 then call gest.event(v,h,p,l,r,c);
\r
382 (***********************************************************************)
\r
383 (***********************************************************************)
\r
384 Unit Gest_wind : iiuwgraph process(node,x1,y1,x2,y2 : integer,gest:gest_event);
\r
386 v,p,h,l,r,c : integer,
\r
394 Unit getinfo : procedure (g : gest_event);
\r
398 writeln("getinfo");
\r
401 Unit event : procedure (input lv,lh,lp,ll,lr,lc : integer);
\r
403 v:=lv; h:=lh; p:=lp; l:=ll; r:=lr; c:=lc;
\r
406 Unit traitement : procedure;
\r
408 if((h=164 and l=27) or c=3)
\r
412 (* recherche dans un arbre des fenetres filles si l'evenement *)
\r
413 (* appartient a qqn *)
\r
419 Unit fin : procedure;
\r
422 writeln("on ferme");
\r
426 (***********************************************************************)
\r
427 Unit graph : windows class;
\r
429 Unit virtual rectangle : procedure (x1,y1,x2,y2,c : integer);
\r
431 call patern(x1,y1,x2,y2,c,0);
\r
434 Unit virtual rectanglef : procedure (x1,y1,x2,y2,c : integer);
\r
436 call patern(x1,y1,x2,y2,c,1);
\r
439 Unit virtual ligne : procedure (x1,y1,x2,y2,c : integer);
\r
446 Unit virtual outxyascii : procedure (x,y,car,cf,cb :integer);
\r
454 Unit virtual outxytext : procedure (x,y :integer, chaine :string,c1,c2 :integer);
\r
456 call outstring(x,y,chaine,c1,c2);
\r
459 Unit virtual affichesuite : procedure;
\r
462 x:=x1+100-lborder; y:=y1+lbande+lborder+1;
\r
463 call rectanglef(x,y,x+lborder,y2-lborder-1,cborder);
\r
464 x:=x+lborder; y:=y2-100-lborder;
\r
465 call rectanglef(x,y,x2-lborder,y+lborder,cborder);
\r
467 ydeb:=y1+lborder+lbande+10;
\r
472 Unit initialisation1 : procedure;
\r
473 Var itermed1 : menu_v,
\r
476 i:=w.lborder+10+20; j:=y1+w.lborder+10+w.lbande+20*4;
\r
477 itermed1:=new menu_V(w.father,i,j,Blanc,GrisFonce);
\r
478 call itermed1.insert("Nouveau",319,none);
\r
479 call itermed1.insert("Ouvrir",320,none);
\r
480 call itermed1.insert("D
\82placer",321,none);
\r
481 call itermed1.insert("Copier",322,none);
\r
482 call itermed1.insert("Supprimer",323,none);
\r
483 call itermed1.insert("Propri
\82t
\82",324,none);
\r
484 i:=w.lborder+10; j:=y1+w.lborder+10+w.lbande;
\r
485 w.barcde:=new menu_V(w.father,i,j,Blanc,GrisFonce);
\r
486 call w.barcde.insert("Fichier",315,itermed1);
\r
487 call w.barcde.insert("Options",316,none);
\r
488 call w.barcde.insert("Fenetre",317,none);
\r
489 call w.barcde.insert("Aide",318,none);
\r
490 End initialisation1;
\r
492 Unit initialisation2 : procedure;
\r
495 End initialisation2;
\r
497 Unit xdeb : function : integer;
\r
502 Unit ydeb : function : integer;
\r
507 Unit getw : function : windows;
\r
514 call gron(0 ); (* 3 = 1024x768x256 *)
\r
515 j:=new graph(none,x1,y1,x2,y2);
\r
516 w:=new windows(j,x1,y1,x2,y2);
\r
517 call w.option(Grisfonce,3,BleuClair,15,BleuCLair,Blanc,unpack("Gest_Wind"));
\r
518 call initialisation1;
\r
520 call J.option(Grisfonce,3,BleuClair,15,BleuCLair,Blanc,unpack("Gest_Wind"));
\r
521 call j.affichesuite;
\r
524 enable xdeb,ydeb,getw;
\r
526 call initialisation2;
\r
535 (*****************************************************************************)
\r
536 (* P r o g r a m m e P r i n c i p a l *)
\r
537 (*****************************************************************************)
\r
544 G1:=new Gest_wind(0,0,0,640,480,none);
\r
545 G2:=new Gest_event(0,G1);
\r
548 call G1.getinfo(G2);
\r
554 Z1:=new applications(0,x+10,y+10,x+330,y+210,G1);
\r
557 call G1.ListA.insert(new elm_a(Z1));
\r