1 Program systemefenetrage;
\r
3 (***************************************************************************)
\r
4 (* Programme de syst
\8ame de fenetrage avec boutons et gestion de la souris *)
\r
5 (* PATAUD Fr
\82d
\82ric & PEYRAT Fran
\87ois 1993/1994 *)
\r
6 (***************************************************************************)
\r
31 Const Touche_F1 =-59,
\r
48 COOR_X : integer, (*coordonn
\82e relative en X dans la fenetre maine*)
\r
49 COOR_Y : integer, (*coordonn
\82e relative en Y dans la fenetre maine*)
\r
56 (***************************************************************************)
\r
57 (* definition des procedures d'utilitaires graphiques *)
\r
58 (***************************************************************************)
\r
60 Unit Line : procedure (x1,y1,x2,y2,c : integer);
\r
67 Unit Rectangle : procedure (x1,y1,x2,y2,c : integer);
\r
77 Unit Rectanglef : procedure (x1,y1,x2,y2,c : integer);
\r
82 call Line(x1,i,x2,i,c);
\r
86 (***************************************************************************)
\r
87 (* definition des classes d'
\82l
\82ments des listes *)
\r
88 (***************************************************************************)
\r
90 Unit Elmt : class(id : integer);
\r
93 Unit elm : Elmt class(x1,y1,x2,y2 :integer);
\r
96 (***************************************************************************)
\r
97 (* definition de la classe Bottons *)
\r
98 (***************************************************************************)
\r
100 Unit Bottons : Elmt class(x1,y1,x2,y2 : integer);
\r
101 (* x2-x1 et y2-y1 doit au mini etre de 8*)
\r
102 (* x1,y1 : integer coordonn
\82es du point haut gauche *)
\r
103 (* x2,y2 : integer coordonn
\82es du point bas droit *)
\r
104 Var etat : boolean; (* true si bouton enable *)
\r
106 Unit affiche : procedure;
\r
108 call Line(x1,y1,x2,y1,Blanc); (* Lignes en blanc *)
\r
109 call Line(x1,y1+1,x2-1,y1+1,Blanc);
\r
110 call Line(x1,y1,x1,y2,Blanc);
\r
111 call Line(x1+1,y1+2,x1+1,y2-1,Blanc);
\r
112 call Line(x1+1,y2,x2,y2,GrisFonce); (* Lignes en gris fonce *)
\r
113 call Line(x1+2,y2-1,x2,y2-1,GrisFonce);
\r
114 call Line(x2,y2,x2,y1+1,GrisFonce);
\r
115 call Line(x2-1,y2-1,x2-1,y1+2,GrisFonce);
\r
116 call Rectanglef(x1+2,y1+2,x2-2,y2-2,GrisClair); (* centre en gris *)
\r
120 Unit virtual AfficheSuite : procedure;
\r
123 Unit virtual bot_enable : procedure;
\r
126 Unit virtual bot_disable : procedure;
\r
131 (***************************************************************************)
\r
132 (* definition de la classe Menu derivant de Bottons *)
\r
133 (***************************************************************************)
\r
135 Unit Menu : Bottons class;
\r
136 Var cnom : integer, (* couleur du nom du bouton *)
\r
137 nom : string; (* nom du bouton *)
\r
139 Unit affiche_nom : procedure;
\r
141 call move(x1+5,y1+(y2-y1)/4+1);
\r
143 call outstring(nom);
\r
146 Unit virtual bot_enable : procedure;
\r
150 e:=new elm(id,x1,y1,x2,y2);
\r
151 call clics.Insert(e);
\r
155 Unit virtual bot_disable : procedure;
\r
159 e:=new elm(id,x1,y1,x2,y2);
\r
160 call clics.Delete(e);
\r
164 Unit virtual AfficheSuite : procedure;
\r
167 then call bot_enable;
\r
168 else call bot_disable;
\r
174 (***************************************************************************)
\r
175 (* definition de la classe Racc derivant de Bottons *)
\r
176 (***************************************************************************)
\r
178 Unit Racc : Bottons class (procedure sprite(x1,y1,x2,y2 :integer));
\r
180 Unit virtual bot_enable : procedure;
\r
183 e:=new elm(id,x1,y1,x2,y2);
\r
184 call clics.Insert(e);
\r
185 call sprite(x1,y1,x2,y2);
\r
188 Unit virtual bot_disable : procedure;
\r
191 e:=new elm(id,x1,y1,x2,y2);
\r
192 call clics.Delete(e);
\r
193 call sprite(x1,y1,x2,y2);
\r
196 Unit virtual AfficheSuite : procedure;
\r
199 then call bot_enable;
\r
200 else call bot_disable;
\r
206 (***************************************************************************)
\r
207 (* definition de la classe Windows *)
\r
208 (***************************************************************************)
\r
210 Unit Windows : class(x1,y1,x2,y2 : integer);
\r
211 (* x2-x1 et y2-y1 doit au mini etre 33 *)
\r
212 Var numero : integer, (* numero d'identification de la fenetre *)
\r
213 cborder : integer; (* couleur du pourtour *)
\r
215 Unit affiche : procedure;
\r
217 call Line(x1,y1,x2,y1,cborder); (* lignes haut *)
\r
218 call Line(x1,y1+1,x2,y1+1,cborder);
\r
219 call Line(x1,y1,x1,y2,cborder); (* lignes gauche *)
\r
220 call Line(x1+1,y1,x1+1,y2,cborder);
\r
221 call Line(x2,y1,x2,y2,cborder); (* Lignes droite *)
\r
222 call Line(x2-1,y1,x2-1,y2,cborder);
\r
223 call Line(x1,y2,x2,y2,cborder); (* Lignes bas *)
\r
224 call Line(x1,y2-1,x2,y2-1,cborder);
\r
225 call Line(x1+16,y1,x1+16,y1+1,Noir); (* Lignes noires *)
\r
226 call Line(x2-16,y1,x2-16,y1+1,Noir);
\r
227 call Line(x1+16,y2,x1+16,y2-1,Noir);
\r
228 call Line(x2-16,y2,x2-16,y2-1,Noir);
\r
229 call Line(x1,y1+16,x1+1,y1+16,Noir);
\r
230 call Line(x1,y2-16,x1+1,y2-16,Noir);
\r
231 call Line(x2,y1+16,x2-1,y1+16,Noir);
\r
232 call Line(x2,y2-16,x2-1,y2-16,Noir);
\r
236 Unit virtual AffSuite : procedure;
\r
239 Unit gestionnaire : function : integer;
\r
240 Var l,r,c : boolean,
\r
246 call getpress(0,x,y,nbbot,l,r,c);
\r
248 then result:=clics.Appartient(x,y); exit;
\r
251 if (rep>=Touche_F5 and rep<=Touche_F1)
\r
252 then result:=-rep-58; exit;
\r
260 (***************************************************************************)
\r
261 (* definition de main d
\82rivant de la classe Windows *)
\r
262 (***************************************************************************)
\r
264 Unit Maine : Windows class;
\r
265 var cnom : integer, (* couleur du nom de la fenetre *)
\r
266 nom : string, (* nom de la fenetre *)
\r
267 cbande : integer, (* couleur de la bande du nom de la fenetre *)
\r
268 Bout : Listbot, (* liste des boutons rattach
\82s
\85 la fenetre *)
\r
269 Lwind : ListW, (* liste des fenetres filles *)
\r
270 Horiz : AccelerateH, (* accelerateur horizontal *)
\r
271 Verti : AccelerateV; (* accelerateur vertical *)
\r
275 Unit virtual AffSuite : procedure;
\r
277 call Rectanglef(x1+17,y1+2,x2-17,y1+15,cbande);
\r
278 call Rectanglef(x1+3,y1+17,x2-3,y1+33,cbande);
\r
279 call move(x1+(x2-x1)/3,y1+5);
\r
281 call outstring(nom);
\r
283 then call Horiz.affiche;
\r
286 then call Verti.affiche;
\r
288 Bout.Courant:=Bout.head;
\r
289 while(Bout.Courant<>none)
\r
291 call Bout.Courant.data qua Bottons.affiche;
\r
292 Bout.Courant:=Bout.Courant.next;
\r
297 Unit iconify : procedure;
\r
307 call rectangle(1,SIZEY-40,40,SIZEY,BleuClair);
\r
308 call rectangle(2,SIZEY-39,39,SIZEY-1,BleuClair);
\r
309 call move(5,SIZEY-20);
\r
310 call outstring("Root");
\r
313 call getpress(0,x,y,nboot,l,r,c);
\r
315 then if(x>=1 and x<=40 and y<=SIZEY and y>=SIZEY-40)
\r
320 if (rep=13) (* validation *)
\r
326 clics:=new cliquer;
\r
332 (***************************************************************************)
\r
333 (* definition de Accelerate d
\82rivant des classes Windows et Bottons *)
\r
334 (***************************************************************************)
\r
336 Unit Accelerate : Bottons class;
\r
337 Var Bs : arrayof Racc,
\r
342 Unit virtual AfficheSuite : procedure; (* descend de bottons *)
\r
345 Unit virtual bot_enable : procedure;
\r
347 call W.Bout.Insert(Bs(1));
\r
348 call W.Bout.Insert(Bs(2));
\r
349 Call W.Bout.Insert(Bs(3));
\r
353 Unit virtual bot_disable : procedure;
\r
355 call W.Bout.Delete(Bs(1));
\r
356 call W.Bout.Delete(Bs(2));
\r
357 call W.Bout.Delete(Bs(3));
\r
361 Unit virtual Deplace : procedure;
\r
369 (***************************************************************************)
\r
370 (* definition de AccelerateH d
\82rivant de Accelerate *)
\r
371 (***************************************************************************)
\r
373 Unit AccelerateH : Accelerate class;
\r
378 Unit virtual AfficheSuite : procedure; (* descend de bottons *)
\r
380 call Rectanglef(x1+18,y1+3,x2-18,y2-3,Noir);
\r
385 Unit virtual DeplacerLeft : procedure;
\r
388 call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);
\r
393 e:=new elm(Bs(1).id,Bs(1).x1,Bs(1).y1,Bs(1).x2,Bs(1).y2);
\r
394 call clics.Delete(e);
\r
397 if not (Bs(3).etat)
\r
398 then Bs(3).etat:=True;
\r
399 e:=new elm(Bs(3).id,Bs(3).x1,Bs(3).y1,Bs(3).x2,Bs(3).y2);
\r
400 call clics.Insert(e);
\r
402 Bs(2).x1:=PosX; Bs(2).y1:=PosY;
\r
403 Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;
\r
404 call Bs(2).affiche;
\r
407 Unit virtual DeplacerRight : procedure;
\r
410 call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);
\r
415 e:=new elm(Bs(3).id,Bs(3).x1,Bs(3).y1,Bs(3).x2,Bs(3).y2);
\r
416 call clics.Delete(e);
\r
419 if not (Bs(1).etat)
\r
420 then Bs(1).etat:=True;
\r
421 e:=new elm(Bs(1).id,Bs(1).x1,Bs(1).y1,Bs(1).x2,Bs(1).y2);
\r
422 call clics.Insert(e);
\r
424 Bs(2).x1:=PosX; Bs(2).y1:=PosY;
\r
425 Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;
\r
426 call Bs(2).affiche;
\r
430 array Bs dim (1:3);
\r
431 Bs(1):=new Racc(id+1,x1+2,y1+2,x1+15,y1+15,spr_right);
\r
438 Bs(2):=new Racc(id+2,PosX,PosY,PosX+LX,PosY+LY,spr_point);
\r
440 Bs(3):=new Racc(id+3,x2-15,y2-15,x2-2,y2-2,spr_left);
\r
444 (***************************************************************************)
\r
445 (* definition de AccelerateV d
\82rivant de Accelerate *)
\r
446 (***************************************************************************)
\r
448 Unit AccelerateV : Accelerate class;
\r
453 Unit virtual AfficheSuite : procedure; (* descend de bottons *)
\r
455 call Rectanglef(x1+3,y1+18,x2-3,y2-18,Noir);
\r
460 Unit virtual DeplacerUp : procedure;
\r
463 call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);
\r
468 e:=new elm(Bs(1).id,Bs(1).x1,Bs(1).y1,Bs(1).x2,Bs(1).y2);
\r
469 call clics.Delete(e);
\r
472 if not (Bs(3).etat)
\r
473 then Bs(3).etat:=True;
\r
474 e:=new elm(Bs(3).id,Bs(3).x1,Bs(3).y1,Bs(3).x2,Bs(3).y2);
\r
475 call clics.Insert(e);
\r
477 Bs(2).x1:=PosX; Bs(2).y1:=PosY;
\r
478 Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;
\r
479 call Bs(2).affiche;
\r
482 Unit virtual DeplacerDown : procedure;
\r
485 call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);
\r
490 e:=new elm(Bs(3).id,Bs(3).x1,Bs(3).y1,Bs(3).x2,Bs(3).y2);
\r
491 call clics.Delete(e);
\r
494 if not (Bs(1).etat)
\r
495 then Bs(1).etat:=True;
\r
496 e:=new elm(Bs(1).id,Bs(1).x1,Bs(1).y1,Bs(1).x2,Bs(1).y2);
\r
497 call clics.Insert(e);
\r
499 Bs(2).x1:=PosX; Bs(2).y1:=PosY;
\r
500 Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;
\r
501 call Bs(2).affiche;
\r
506 array Bs dim (1:3);
\r
507 Bs(1):=new Racc(id+1,x1+2,y1+2,x1+15,y1+15,spr_upper);
\r
514 Bs(2):=new Racc(id+2,PosX,PosY,PosX+LX,PosY+LY,spr_point);
\r
516 Bs(3):=new Racc(id+3,x2-15,y2-15,x2-2,y2-2,spr_lower);
\r
521 (***************************************************************************)
\r
522 (* definition de la classe Son d
\82rivant des classes Windows et elmt *)
\r
523 (***************************************************************************)
\r
525 Unit Son : Elmt coroutine;
\r
527 Horiz : AccelerateH, (* accelerateur horizontal *)
\r
528 Verti : AccelerateV; (* accelerateur vertical *)
\r
530 pref Windows(0,0,0,0) block
\r
540 (***************************************************************************)
\r
541 (* definition de la classe Ensemble (c'est une liste) *)
\r
542 (***************************************************************************)
\r
544 Unit Ensemble : class;
\r
549 Unit Node : class(data : elmt);
\r
553 Unit virtual egalite : function (x,y : elmt) :boolean;
\r
556 Unit Empty : function : boolean;
\r
560 else result:=False;
\r
564 Unit Member : function (n : elmt) : boolean;
\r
571 While (Courant<>none)
\r
573 if not egalite(Courant.data,n)
\r
574 then saveCou:=Courant; Courant:=Courant.next;
\r
575 else bl:=True; exit;
\r
582 Unit Insert : procedure (n : elmt);
\r
588 then Head:=new Node(n); Last:=Head;
\r
589 else Last.next:=new Node(n);
\r
595 Unit Delete : procedure (n : elmt);
\r
601 then flag:=Courant.next;
\r
603 then Last:=Courant; courant.next:=none; kill(flag);
\r
604 else courant.next:=Courant.next.next; kill(flag);
\r
611 (***************************************************************************)
\r
612 (* definition de la classe cliquer derivant de la classe ensemble *)
\r
613 (***************************************************************************)
\r
615 Unit cliquer : Ensemble class;
\r
617 Unit virtual egalite : function (x,y : elmt) : boolean;
\r
621 else result:=False;
\r
625 Unit Appartient : function(x,y : integer) : integer;
\r
630 while (Courant<>none)
\r
632 if(x<(Courant.data qua elm.x2) and x>(Courant.data qua elm.x1) and
\r
633 y<(Courant.data qua elm.y2) and y>(Courant.data qua elm.y1))
\r
634 then bl:=True; exit;
\r
635 else Courant:=Courant.next;
\r
639 then result:=Courant.data qua elm.id;
\r
646 (***************************************************************************)
\r
647 (* definition de la classe Listbot d
\82rivant de ensemble *)
\r
648 (***************************************************************************)
\r
650 Unit Listbot : Ensemble class;
\r
652 Unit virtual egalite : function (x,y : elmt) : boolean;
\r
656 else result:=False;
\r
662 (***************************************************************************)
\r
663 (* definition de la classe ListW d
\82rivant de ensemble *)
\r
664 (***************************************************************************)
\r
666 Unit ListW : Ensemble class;
\r
668 Unit virtual egalite : function (x,y : elmt) : boolean;
\r
670 if (x qua Son.aa qua Windows.numero)
\r
671 = (y qua Son.aa qua Windows.numero)
\r
673 else result:=False;
\r
679 (***************************************************************************)
\r
680 (* procedure d'affichage des sprites des boutons *)
\r
681 (***************************************************************************)
\r
683 (***************************************************************************)
\r
684 Unit spr_upper : procedure(x1,y1,x2,y2 : integer);
\r
685 var i,x,y : integer;
\r
691 call Line(x1+x-i/2,y1+y/2+i,x1+x+i/2,y1+y/2+i,Noir);
\r
695 (***************************************************************************)
\r
696 Unit spr_lower : procedure(x1,y1,x2,y2 : integer);
\r
697 var i,x,y : integer;
\r
703 call Line(x1+x-i/2,y2-y/2-i,x1+x+i/2,y2-y/2-i,Noir);
\r
707 (***************************************************************************)
\r
708 Unit spr_left : procedure(x1,y1,x2,y2 : integer);
\r
709 var i,x,y : integer;
\r
715 call Line(x2-x/2-i,y1+y-i/2,x2-x/2-i,y1+y+i/2,Noir);
\r
719 (***************************************************************************)
\r
720 Unit spr_right : procedure(x1,y1,x2,y2 : integer);
\r
721 var i,x,y : integer;
\r
727 call Line(x1+x/2+i,y1+y-i/2,x1+x/2+i,y1+y+i/2,Noir);
\r
731 (***************************************************************************)
\r
732 Unit spr_close : procedure(x1,y1,x2,y2 : integer);;
\r
736 call Rectanglef(x1+3,y1+y-1,x2-3,y1+y+1,Noir);
\r
739 (***************************************************************************)
\r
740 Unit spr_point : procedure(x1,y1,x2,y2 : integer);;
\r
745 call Rectanglef(x1+x-1,y1+y-1,x1+x+1,y1+y+1,Noir);
\r
748 (***************************************************************************)
\r
749 (* procedure de gestion des boutons *)
\r
750 (***************************************************************************)
\r
752 (***************************************************************************)
\r
753 Unit Bot_Load : procedure;
\r
762 fenet:=new Son(20); (* identite = 20 *)
\r
763 fenet.aa.x1:=x-Largeur/2;
\r
764 fenet.aa.y1:=y-Hauteur/2;
\r
765 fenet.aa.x2:=x+Largeur/2;
\r
766 fenet.aa.y2:=y+Hauteur/2;
\r
767 fenet.aa.numero:=10;
\r
768 savcli:=clics; (* on sauvegarde l'ensemble des zones de clics *)
\r
770 call fenet.aa.affiche;
\r
773 (***************************************************************************)
\r
774 Unit Bot_Quit : procedure;
\r
783 fenet:=new Son(30); (* identite = 30 *)
\r
784 fenet.aa.x1:=x-Largeur/2;
\r
785 fenet.aa.y1:=y-Hauteur/2;
\r
786 fenet.aa.x2:=x+Largeur/2;
\r
787 fenet.aa.y2:=y+Hauteur/2;
\r
788 fenet.aa.numero:=10;
\r
789 savcli:=clics; (* on sauvegarde l'ensemble des zones de clics *)
\r
791 call fenet.aa.affiche;
\r
794 (***************************************************************************)
\r
795 (* P R O G R A M M E P R I N C I P A L *)
\r
796 (***************************************************************************)
\r
800 clics:=new cliquer; (* ensemble des zones de clic possible *)
\r
802 W:=new Maine(1,1,SIZEX,SIZEY);
\r
804 W.cborder:=BleuClair;
\r
805 W.cbande:=GrisClair;
\r
807 W.nom:="Simulation de r
\82seau routier";
\r
809 W.Bout:=new ListBot;
\r
813 B(2):=new Racc(102,W.x2-16,W.y1+2,W.x2-3,W.y1+15,spr_upper);
\r
815 call W.Bout.Insert(B(2));
\r
817 B(1):=new Racc(101,B(2).x1-14,B(2).y1,B(2).x1-1,B(2).y2,spr_lower);
\r
819 call W.Bout.Insert(B(1));
\r
821 B(0):=new Racc(100,W.x1+3,B(1).y1,W.x1+16,B(1).y2,spr_close);
\r
823 call W.Bout.Insert(B(0));
\r
827 M(0):=new Menu(1,W.x1+8,W.y1+18,W.x1+50,W.y1+32);
\r
830 call W.Bout.Insert(M(0));
\r
832 M(1):=new Menu(2,W.x1+55,W.y1+18,W.x1+89,W.y1+32);
\r
835 call W.Bout.Insert(M(1));
\r
837 M(2):=new Menu(3,W.x1+94,W.y1+18,W.x1+136,W.y1+32);
\r
840 call W.Bout.Insert(M(2));
\r
842 M(3):=new Menu(4,W.x1+141,W.y1+18,W.x1+215,W.y1+32);
\r
843 M(3).nom:="Continue";
\r
845 call W.Bout.Insert(M(3));
\r
847 M(4):=new Menu(5,W.x1+220,W.y1+18,W.x1+262,W.y1+32);
\r
850 call W.Bout.Insert(M(4));
\r
852 W.Horiz:=new AccelerateH(50,W.x1+2,W.y2-18,W.x2-18,W.y2-2);
\r
854 W.Verti:=new AccelerateV(60,W.x2-18,W.y1+34,W.x2-2,W.y2-18);
\r
860 code:=W.Gestionnaire;
\r
863 when 1 : call Bot_Load; (* f1 : Load *)
\r
864 when 5 : exit; (* f5 : quit *)
\r
865 when 51 : call W.Horiz.DeplacerLeft;
\r
866 when 53 : call W.Horiz.DeplacerRight;
\r
867 when 61 : call W.Verti.DeplacerUp;
\r
868 when 63 : call W.verti.DeplacerDown;
\r
869 when 100 : exit; (* racc fin *)
\r
870 when 101 : call W.iconify;
\r