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
9 Const XMAX = 640, YMAX= 480;
\r
11 (*****************************************************************************)
\r
12 (* premiere famille de classes : les classes graphiques *)
\r
13 (*****************************************************************************)
\r
17 Unit Windows : process (node : integer,father :windows,x1,y1,x2,y2 : integer);
\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 Bout : arrayof bottons,
\r
27 nombande : arrayof char,
\r
29 save_map : arrayof integer;
\r
32 Unit option : procedure (l1,l2,l3,l4,l5,l6 : integer,l7 : string);
\r
34 cfond:=l1; lborder:=l2; cborder:=l3; lbande:=l4;
\r
35 cfbande:=l5; cbbande:=l6;
\r
36 nombande:=unpack(l7);
\r
38 ydeb:=y1+lborder+lbande+3;
\r
39 bout(1):=new racc(this windows,x1+lborder+1,y1+lborder+1,x1+lborder+1+
\r
40 lbande,y1+lborder+1+lbande,spr_close);
\r
41 bout(2):=new racc(this windows,x2-lborder-2-lbande*2,y1+lborder+1,
\r
42 x2-lborder-2-lbande,y1+lborder+1+lbande,spr_lower);
\r
43 bout(3):=new racc(this windows,x2-lborder-1-lbande,y1+lborder+1,
\r
44 x2-lborder-1,y1+lborder+1+lbande,spr_upper);
\r
47 Unit Affiche : procedure;
\r
50 call father.moveto(x1,y1);
\r
51 save_map:=father.getmape(x2,y2);
\r
52 call father.rectanglef(x1,y1,x2,y2,cfond);
\r
55 call father.rectangle(x1+i,y1+i,x2-i,y2-i,cborder);
\r
58 call father.rectanglef(x1+lborder+1,i,x2-lborder-1,i+imax(14,lbande),cfbande);
\r
59 j:=(x2-x1-2*lborder-8*(upper(nombande)-lower(nombande)))/2;
\r
60 for i:=lower(nombande) to upper(nombande)
\r
62 k:=x1+lborder+j+i*8;
\r
63 call father.outxyascii(k,y1+lborder+2,ord(nombande(i)),cbbande,cfbande);
\r
67 then call barcde.affichemenu;
\r
69 call bout(1).affiche;
\r
70 call bout(2).affiche;
\r
71 call bout(3).affiche;
\r
75 Unit virtual affichesuite :procedure;
\r
78 Unit virtual moveto : procedure(x1,y1 : integer);
\r
80 call father.moveto(x1,y1);
\r
83 Unit virtual getmape : function(x2,y2 : integer) : arrayof integer;
\r
85 result:=father.getmape(x2,y2);
\r
88 Unit virtual putmape : procedure(a : arrayof integer);
\r
90 call father.putmape(a);
\r
93 Unit virtual rectangle : procedure(xx1,yy1,xx2,yy2,c :integer);
\r
95 call father.rectangle(xx1,yy1,xx2,yy2,c);
\r
98 Unit virtual ligne : procedure (xx1,yy1,xx2,yy2,c : integer);
\r
100 call father.ligne(xx1,yy1,xx2,yy2,c);
\r
103 Unit virtual rectanglef : procedure(xx1,yy1,xx2,yy2,c : integer);
\r
105 call father.rectanglef(xx1,yy1,xx2,yy2,c);
\r
108 Unit virtual outxyascii : procedure(x,y,car,cf,cb : integer);
\r
110 call father.outxyascii(x,y,car,cf,cb);
\r
113 Unit virtual outxytext : procedure(x,y:integer,chaine:string,c1,c2:integer);
\r
115 call father.outxytext(x,y,chaine,c1,c2);
\r
118 Unit virtual outxyint : procedure(x,y,val,cf,ce :integer);
\r
120 call father.outxyint(x,y,val,cf,ce);
\r
123 unit ydebut: function: integer;
\r
128 unit xdebut: function: integer;
\r
133 Unit EndWindow : procedure;
\r
135 call father.moveto(x1,y1);
\r
136 call putmape(save_map);
\r
140 hauteur:=y2-y1-2*lborder;
\r
141 largeur:=x2-x1-2*lborder;
\r
142 array bout dim (1:3);
\r
145 enable outxytext, outxyascii, rectanglef, rectangle, affichesuite,
\r
146 affiche, option, xdebut, ydebut, outxyint, ligne, moveto ,
\r
147 getmape, putmape, Endwindow;
\r
153 (***********************************************************************)
\r
154 Unit graph : windows class;
\r
156 Unit enablegraph : procedure;
\r
160 Unit disablegraph : procedure;
\r
164 Unit virtual rectangle : iiuwgraph procedure (x1,y1,x2,y2,c : integer);
\r
166 call patern(x1,y1,x2,y2,c,0);
\r
169 Unit virtual rectanglef : iiuwgraph procedure (x1,y1,x2,y2,c : integer);
\r
171 call patern(x1,y1,x2,y2,c,1);
\r
174 Unit virtual ligne : iiuwgraph procedure (x1,y1,x2,y2,c : integer);
\r
181 Unit virtual outxyascii : iiuwgraph procedure (x,y,car,cf,cb :integer);
\r
189 Unit virtual outxytext : iiuwgraph procedure (x,y :integer,
\r
190 chaine :string,c1,c2 :integer);
\r
192 call outstring(x,y,chaine,c1,c2);
\r
195 Unit virtual outxyint : iiuwgraph procedure (x,y,val,cf,ce :integer);
\r
197 call track(x,y,val,cf,ce);
\r
200 Unit virtual moveto : iiuwgraph procedure (x1,y1 : integer);
\r
205 Unit virtual getmape : iiuwgraph function (x2,y2 : integer) : arrayof integer;
\r
207 result:=getmap(x2,y2);
\r
210 Unit virtual putmape : iiuwgraph procedure (a : arrayof integer);
\r
215 Unit virtual affichesuite : procedure;
\r
218 x:=x1+100-lborder; y:=y1+lbande+lborder+1;
\r
219 call rectanglef(x,y,x+lborder,y2-lborder-1,cborder);
\r
220 x:=x+lborder; y:=y2-100-lborder;
\r
221 call rectanglef(x,y,x2-lborder,y+lborder,cborder);
\r
223 ydeb:=y1+lborder+lbande+10;
\r
229 enable affichesuite,affiche, option, xdebut, ydebut,
\r
230 enablegraph,disablegraph;
\r
237 Unit Bitmap : Windows Class;
\r
240 Unit Son : Windows Class;
\r
243 Unit Maine : Windows Class;
\r
246 Unit Dialogue : Son Class;
\r
249 Unit Catalogue : Dialogue Class;
\r
252 Unit Question : Dialogue Class;
\r
255 Unit Widgets : class(father : windows);
\r
258 (**********************************************************************)
\r
259 Unit Menu : Widgets Class(x,y,col_e,col_f: integer);
\r
260 Var liste : ensemble;
\r
262 Unit item : element class(nom : string,key : integer,suite :Menu);
\r
265 Unit insert : procedure(nom : string,key : integer,s : menu);
\r
268 e:=new item(nom,key,s);
\r
270 then liste:=new ensemble;
\r
272 call liste.insert(e);
\r
275 Unit virtual affichemenu : procedure;
\r
280 Unit Menu_V : Menu Class;
\r
282 Unit virtual affichemenu : procedure;
\r
284 tlen : arrayof char,
\r
293 Unit Menu_H : Menu Class;
\r
295 Unit virtual affichemenu : procedure;
\r
297 tlen : arrayof char,
\r
306 (***********************************************************************)
\r
307 Unit Bottons : Widgets Class(x1,y1,x2,y2 : integer);
\r
308 Unit affiche : procedure;
\r
310 call father.rectanglef(x1,y1,x2,y2,GrisClair);
\r
311 call father.ligne(x1,y1,x2,y1,blanc);
\r
312 call father.ligne(x1,y1+1,x2-1,y1+1,blanc);
\r
313 call father.ligne(x1,y1,x1,y2,blanc);
\r
314 call father.ligne(x1+1,y1+2,x1+1,y2-1,blanc);
\r
315 call father.ligne(x1+1,y2,x2,y2,GrisFonce);
\r
316 call father.ligne(x1+2,y2-1,x2-1,y2-1,GrisFonce);
\r
317 call father.ligne(x2,y2,x2,y1+1,GrisFonce);
\r
318 call father.ligne(x2-1,y2-1,x2-1,y1+2,GrisFonce);
\r
322 Unit virtual affichesuite : procedure;
\r
327 Unit Racc : Bottons Class(procedure sprite(x1,y1,x2,y2,c : integer,
\r
329 Unit virtual affichesuite : procedure;
\r
331 call sprite(x1,y1,x2,y2,Noir,father);
\r
335 Unit Opt_list : Bottons Class;
\r
338 Unit Oneline : Opt_list Class;
\r
341 Unit Multiline : Opt_list Class;
\r
344 Unit Botton : Bottons Class;
\r
347 Unit Lift : Widgets Class;
\r
350 Unit Lift_V : Lift Class;
\r
353 Unit Lift_H : Lift Class;
\r
359 (***************************************************************************)
\r
360 (* procedure d'affichage des sprites des boutons *)
\r
361 (***************************************************************************)
\r
363 (***************************************************************************)
\r
364 Unit spr_upper : procedure(x1,y1,x2,y2,couleur : integer,father:windows);
\r
365 var i,x,y : integer;
\r
371 call father.Ligne(x1+x-i/2,y1+y/2+i,x1+x+i/2,y1+y/2+i,couleur);
\r
375 (***************************************************************************)
\r
376 Unit spr_lower : procedure(x1,y1,x2,y2,couleur : integer,father:windows);
\r
377 var i,x,y : integer;
\r
383 call father.Ligne(x1+x-i/2,y2-y/2-i,x1+x+i/2,y2-y/2-i,couleur);
\r
387 (***************************************************************************)
\r
388 Unit spr_left : procedure(x1,y1,x2,y2,couleur : integer,father:windows);
\r
389 var i,x,y : integer;
\r
395 call father.Ligne(x2-x/2-i,y1+y-i/2,x2-x/2-i,y1+y+i/2,couleur);
\r
399 (***************************************************************************)
\r
400 Unit spr_right : procedure(x1,y1,x2,y2,couleur : integer,father:windows);
\r
401 var i,x,y : integer;
\r
407 call father.Ligne(x1+x/2+i,y1+y-i/2,x1+x/2+i,y1+y+i/2,couleur);
\r
411 (***************************************************************************)
\r
412 Unit spr_close : procedure(x1,y1,x2,y2,couleur : integer,father:windows);
\r
416 call father.Rectanglef(x1+3,y1+y-1,x2-3,y1+y+1,couleur);
\r
419 (***************************************************************************)
\r
420 Unit spr_point : procedure(x1,y1,x2,y2,couleur : integer,father:windows);
\r
425 call father.Rectanglef(x1+x-1,y1+y-1,x1+x+1,y1+y+1,couleur);
\r
430 (*****************************************************************************)
\r
431 (* deuxieme famille de classes : les structures de donnees *)
\r
432 (*****************************************************************************)
\r
433 Unit element : class; (* general *)
\r
436 Unit elm_c : element class(id,x1,y1,x2,y2 : integer); (* listclic *)
\r
439 Unit elm_a : element class(p : Applications); (* liste application *)
\r
443 Unit Ensemble : CLass;
\r
444 Var root,last : node,
\r
447 Unit node : class(elm : element);
\r
451 Unit virtual insert : procedure(e : element);
\r
455 then root:=new node(e);
\r
457 else last.next:=new node(e);
\r
463 Unit virtual delete : procedure(e : element);
\r
467 then flag:=courant.next;
\r
469 then last:=courant;
\r
470 courant.next:=none;
\r
472 else if courant.next<>none
\r
473 then courant.next:=courant.next.next;
\r
480 Unit virtual member : function (e : element) : boolean;
\r
481 Var savecou : node,
\r
487 while(courant<>none)
\r
489 if not egalite(courant.elm,e)
\r
490 then savecou:=courant;
\r
491 courant:=courant.next;
\r
500 Unit virtual egalite : function (e1,e2 :element) :boolean;
\r
503 Unit empty : function : boolean;
\r
505 result:=(root=none);
\r
508 Unit initialise : procedure;
\r
513 Unit getelm : function(output e : element) :boolean;
\r
516 then e:=courant.elm;
\r
518 courant:=courant.next;
\r
519 else result:=false;
\r
525 Unit Queue : Ensemble Class;
\r
528 Unit Ofpriority : Queue Class;
\r
531 Unit ListD : Ensemble Class;
\r
534 Unit LClic : ListD Class;
\r
536 Unit virtual egalite : function (e1,e2 :element) :boolean;
\r
538 if (e1 qua elm_c.x1=e2 qua elm_c.x1 and e1 qua elm_c.x2=e2 qua elm_c.x2
\r
539 and e1 qua elm_c.y1=e2 qua elm_c.y1 and e1 qua elm_c.y2=e2 qua elm_c.y2)
\r
541 else result:=FALSE;
\r
545 Unit appartient : function (x,y : integer) : boolean;
\r
553 if (x>=e.x1 and x<=e.x2 and y>=e.y1 and y<=e.y2)
\r
563 Unit LBot : ListD Class;
\r
566 Unit LAppli : ListD Class;
\r
567 Unit egalite : function (e1,e2 :elm_a) :boolean;
\r
569 if (e1 qua elm_a.p = e2 qua elm_a.p)
\r
571 else result:=FALSE;
\r
576 Unit LKey : ListD Class;
\r
579 Unit LWin : ListD Class;
\r
582 Unit Stack : Ensemble Class;
\r
587 (*****************************************************************************)
\r
588 (* Famille de process *)
\r
589 (*****************************************************************************)
\r
590 Unit Applications : process (node,x1,y1,x2,y2: integer,father: Gest_Wind);
\r
591 Var w : windows, (* maine *)
\r
593 Filles : windows, (* son *)
\r
597 Unit virtual gestionnaire : procedure(id : integer);
\r
601 Unit affecte : procedure ( nm : string);
\r
607 w:=new windows(0,father.getw,x1,y1,x2,y2);
\r
611 call w.option(Noir,3,Bleu,15,Bleu,Blanc,nom);
\r
615 (************************************************************************)
\r
616 (************************************************************************)
\r
617 Unit Gest_event : mouse process (node : integer,gest : gest_wind);
\r
619 Unit ready : procedure;
\r
622 Unit event : function(output v,h,p,l,r,c : integer) : boolean;
\r
624 result:=getpress(v,h,p,l,r,c);
\r
628 v,h,p,l,r,c : integer;
\r
635 if(event(v,h,p,l,r,c))
\r
636 then call gest.event(v,h,p,l,r,c);
\r
641 (***********************************************************************)
\r
642 (***********************************************************************)
\r
643 Unit Gest_wind : iiuwgraph process(node,x1,y1,x2,y2 : integer,
\r
646 Var i,k,px,py :integer,
\r
647 v,p,h,l,r,c : integer,
\r
655 Unit getinfo : procedure (g : gest_event);
\r
661 Unit event : procedure (input lv,lh,lp,ll,lr,lc : integer);
\r
663 v:=lv; h:=lh; p:=lp; l:=ll; r:=lr; c:=lc;
\r
668 Unit traitement : procedure;
\r
670 Unit fin : procedure;
\r
677 if((p=164 and l=27) or c=3)
\r
680 (* recherche dans un arbre des fenetres filles si l'evenement *)
\r
681 (* appartient a qqn *)
\r
682 (* ici c'est a refaire, c'est juste pour tester *)
\r
684 then if(v>110 and v<400 and h>50 and h<250)
\r
685 then writeln("coucou");
\r
692 Unit initialisation2 : procedure;
\r
695 End initialisation2;
\r
697 Unit xdeb : function : integer;
\r
702 Unit ydeb : function : integer;
\r
707 Unit getw : function : windows;
\r
713 Unit insertA : procedure(e : applications);
\r
715 call ListA.insert(new elm_a(e));
\r
721 call gron(MODE); (* 5 = 1024x768x256 *)
\r
722 j:=new graph(0,none,x1,y1,x2,y2);
\r
724 w:=new windows(0,j,x1,y1,x2,y2);
\r
726 call w.option(Grisfonce,3,BleuClair,15,BleuCLair,Blanc,"Gest_Wind");
\r
728 call J.option(Grisfonce,3,BleuClair,15,BleuCLair,Blanc,"Gst_Windows");
\r
729 call j.affichesuite;
\r
733 enable xdeb,ydeb,getw,insertA;
\r
735 call initialisation2;
\r
737 px:=w.xdebut; py:=w.ydebut;
\r
740 call w.outxyint(px,py,i,Bleu,Blanc);
\r
747 Unit Appli : Applications class;
\r
748 Var px,py : integer;
\r
750 px:=w.xdebut; py:=w.ydebut;
\r
751 call w.outxytext(px,py,"coucou",Vert,Noir);
\r
754 call w.outxyint(px,py+20,i,Bleu,Blanc);
\r
760 (*****************************************************************************)
\r
761 (* P r o g r a m m e P r i n c i p a l *)
\r
762 (*****************************************************************************)
\r
770 G1:=new Gest_wind(0,0,0,XMAX,YMAX,none);
\r
771 G2:=new Gest_event(0,G1);
\r
774 call G1.getinfo(G2);
\r
779 Z1:=new appli(0,x+10,y+10,x+330,y+210,G1);
\r
781 call G1.insertA(Z1);
\r
782 call Z1.affecte("Application - 1 -");
\r
784 Z2:=new appli(0,x+250,y+80,x+520,y+250,G1);
\r
786 call G1.insertA(Z2);
\r
787 call Z2.affecte("Application - 2 -");
\r