2 (*****************************************************************************)
\r
4 (* PROJET LI1 Nø1 pour le 15/01/94 *)
\r
6 (* PATAUD Frederic *)
\r
7 (* PEYRAT Francois *)
\r
9 (* Structure des Barbres *)
\r
11 (*****************************************************************************)
\r
14 (*****************************************************************************)
\r
15 (* Structure d'une donnees *)
\r
16 (*****************************************************************************)
\r
17 Unit STData : class;
\r
23 (*****************************************************************************)
\r
24 (* Structure d'une page d'un B_Arbre *)
\r
25 (*****************************************************************************)
\r
26 Unit STPage : class (N : integer);
\r
28 var nbdata : integer;
\r
29 var data : arrayof STData;
\r
30 var fils : arrayof STPage;
\r
32 nbdata:=0; (* A l'initialisation il n'y a pas de data *)
\r
33 array data dim (1:2*N); (* Il y a au plus 2n donnees dans une page *)
\r
34 array fils dim (1:2*N+1);(* et au plus 2n+1 fils. *)
\r
35 pere:=none; (* Aucun pere n'est definit
\85 la creation. *)
\r
40 (*****************************************************************************)
\r
41 (* retourne 1 si elmt1 > elmt2 sinon 0 *)
\r
42 (*****************************************************************************)
\r
43 Unit Superieur : function (elmt1,elmt2 : STData) : boolean;
\r
45 if elmt1.data>elmt2.data
\r
53 (*****************************************************************************)
\r
54 (* retourne 1 si elmt1 < elmt2 sinon 0 *)
\r
55 (*****************************************************************************)
\r
56 Unit Inferieur : function (elmt1,elmt2 : STData) : boolean;
\r
58 if elmt1.data<elmt2.data
\r
66 (*****************************************************************************)
\r
67 (* retourne 1 si elmt1 = elmt2 sinon 0 *)
\r
68 (*****************************************************************************)
\r
69 Unit Egalite : function (elmt1,elmt2 : STData) : boolean;
\r
71 if elmt1.data=elmt2.data
\r
79 (*****************************************************************************)
\r
81 (*****************************************************************************)
\r
82 Unit Barbre : class (N : integer);
\r
86 (****************************************************************************)
\r
87 (* Retourne un booleen indiquant si l'arbre est vide *)
\r
88 (****************************************************************************)
\r
89 Unit Vide : function : boolean;
\r
91 result:=root.nbdata=0; (* Si la racine n'a pas d'element alors arbre vide *)
\r
95 (****************************************************************************)
\r
96 (* Retourne la valeur du minimun de l'arbre *)
\r
97 (****************************************************************************)
\r
98 Unit Minimum : function (output data : STData) : boolean;
\r
101 call outgtext("Recherche minimum...");
\r
105 if page.fils(1)=none (* le minimum se trouve le plus en bas *)
\r
106 then data:=page.data(1); (*
\85 gauche de l'arbre *)
\r
109 page:=page.fils(1);
\r
112 else call outgtext("L'arbre est vide !!!"); (* il y a une erreur *)
\r
118 (****************************************************************************)
\r
119 (* Retourne la valeur du maximum de l'arbre *)
\r
120 (****************************************************************************)
\r
121 Unit Maximum : function (output data : STData) : boolean;
\r
124 call outgtext("Recherche maximum...");
\r
128 if page.fils(page.nbdata)=none (* le maximum est l'element le *)
\r
129 then data:=page.data(page.nbdata); (* plus
\85 droite de l'arbre *)
\r
132 page:=page.fils(page.nbdata+1);
\r
135 else call outgtext("L'arbre est vide !!!");
\r
141 (****************************************************************************)
\r
142 (* Retourne vraie si l'element elmt est dans l'arbre ainsi que la page *)
\r
143 (* la recherche va se faire par dichotomie, ameliorant le nombre de *)
\r
144 (* comparaisons necessaire pour trouver : *)
\r
145 (* -soit l'element dans la page courante *)
\r
146 (* -soit la page suivante a examiner *)
\r
147 (****************************************************************************)
\r
148 Unit Membre : function (input elmt : STData; output page : STPage) : boolean;
\r
149 Var a,milieu,b : integer;
\r
151 call outgtext("Recherche donn
\82e...");
\r
156 a:=0; (* a=debut de l'intervalle *)
\r
157 b:=page.nbdata+1; (* b=fin de l'intervalle *)
\r
159 milieu:=(a+b) div 2; (* milieu = milieu de l'intervalle *)
\r
160 if Superieur(page.data(milieu),elmt)
\r
164 if Egalite(page.data(milieu),elmt)
\r
165 then result:=true; (* on a trouve l'element *)
\r
167 else if (b-a)=1 (* on sort sans avoir touver *)
\r
175 if page.fils(1)=none (* si plus de page alors on sort *)
\r
178 if Superieur(page.data(milieu),elmt) (* sinon on change de page *)
\r
179 then page:=page.fils(milieu)
\r
180 else page:=page.fils(milieu+1)
\r
183 else call outgtext("L'arbre est vide!!!");
\r
189 (****************************************************************************)
\r
190 (* Insertion d'un element *)
\r
191 (****************************************************************************)
\r
192 Unit Insertion : procedure (elmt : STData);
\r
193 Var a,milieu,b,i : integer;
\r
194 var aux_fils : arrayof STPage;
\r
195 var aux_data : arrayof STData;
\r
196 var pagenew,page : STPage;
\r
197 var sauv1,sauv2 : STPage;
\r
200 if vide (* on insert la premiere donnee dans l'arbre *)
\r
201 then page.data(1):=elmt;
\r
203 call outgtext("L'element a ete ajoute.")
\r
204 else if not membre(elmt,page) (* l'element elmt n'existe pas deja *)
\r
206 if page <> none (* s'il ne faut pas creer une nouvelle page *)
\r
209 do (* recherche dichotomique de la position dans la page *)
\r
210 milieu:=(a+b) div 2;
\r
211 if Superieur(page.data(milieu),elmt)
\r
219 if Inferieur(page.data(milieu),elmt)
\r
220 then milieu:=milieu+1
\r
222 if page.nbdata < 2*N (* si on n'a pas le maximum d'elments*)
\r
223 then for i:=page.nbdata downto milieu
\r
224 do (* on decale pour inserer l'element *)
\r
225 page.data(i+1):=page.data(i);
\r
226 page.fils(i+2):=page.fils(i+1)
\r
228 page.data(milieu):=elmt; (* on insert l'element *)
\r
229 page.fils(milieu+1):=pagenew;
\r
230 page.nbdata:=page.nbdata+1;
\r
234 array aux_data dim (a:b);
\r
235 array aux_fils dim (a:b+1);
\r
236 for i:=1 to milieu-1 (* on sauve les donnees *)
\r
238 aux_data(i):=page.data(i);
\r
239 aux_fils(i):=page.fils(i);
\r
241 aux_fils(i):=page.fils(i);
\r
242 aux_data(milieu):=elmt;
\r
243 aux_fils(milieu+1):=pagenew;
\r
244 for i:=milieu to 2*N
\r
246 aux_data(i+1):=page.data(i);
\r
247 aux_fils(i+2):=page.fils(i);
\r
249 pagenew:= new STPage(N);
\r
252 for i:=1 to n (* on coupe en deux *)
\r
254 pagenew.data(i):=aux_data(n+1+i);
\r
255 page.data(i):=aux_data(i);
\r
256 pagenew.fils(i):=aux_fils(n+1+i);
\r
257 page.fils(i):=aux_fils(i);
\r
259 pagenew.fils(i):=aux_fils(n+1+i);
\r
260 page.fils(i):=aux_fils(i);
\r
261 elmt:=aux_data(n+1);
\r
263 if page.fils(1) <> none (* on rechaine les parents *)
\r
264 then for i:=1 to n+1
\r
266 pagenew.fils(i).pere:=pagenew;
\r
269 pagenew.pere:=page.pere;
\r
271 kill(aux_data); (* on efface les *)
\r
272 kill(aux_fils); (* variables intermediaires *)
\r
274 else sauv2:=pagenew;
\r
275 pagenew:= new STPage(N); (* creation d'une nouvelle page *)
\r
277 pagenew.data(1):=elmt;
\r
278 pagenew.fils(1):=sauv1;
\r
279 pagenew.fils(2):=sauv2;
\r
280 sauv1.pere:=pagenew;
\r
281 sauv2.pere:=pagenew;
\r
282 root:=pagenew; (* il y a changement de racine *)
\r
286 call outgtext("L'
\82l
\82ment a ete ajoute.");
\r
287 else call outgtext("L'
\82l
\82ment existe deja!");(* l'element existe deja *)
\r
293 (****************************************************************************)
\r
294 (* Suppression d'un element *)
\r
295 (****************************************************************************)
\r
296 Unit Supprimer : procedure (elmt : STData);
\r
297 var a,milieu,b,i : integer;
\r
298 var aux_data : arrayof STData;
\r
299 var aux_fils : arrayof STPage;
\r
300 var page,avant : STPage;
\r
301 var courant,pere : STPage;
\r
302 var pred,aux : integer;
\r
305 if vide (* l'arbre est vide ?! *)
\r
306 then call outgtext("L'arbre est vide!!!")
\r
308 if not membre(elmt,page) (* l'element n'est pas dans l'arbre ?! *)
\r
309 then call outgtext("Donn
\82e pas ds l'arbre.");
\r
310 else courant:=page;
\r
311 a:=0; (* on recherche par dichotomie la place de l'element *)
\r
312 b:=courant.nbdata+1;
\r
314 milieu:=(a+b) div 2;
\r
315 if Superieur(page.data(milieu),elmt)
\r
319 if Egalite(page.data(milieu),elmt)
\r
322 od; (* on a sa place *)
\r
323 if courant.fils(milieu) <> none
\r
324 then courant:=courant.fils(milieu)
\r
326 while courant.fils(courant.nbdata+1) <> none
\r
328 courant:=courant.fils(courant.nbdata+1)
\r
330 if page.fils(1) <> none
\r
331 then page.data(milieu):=courant.data(courant.nbdata)
\r
332 else for i:=milieu to courant.nbdata-1
\r
334 page.data(i):=page.data(i+1)
\r
337 courant.nbdata:=courant.nbdata-1;
\r
338 if courant.nbdata < N
\r
339 then if courant=root
\r
343 pere:=courant.pere;
\r
346 if pere.fils(i)=courant
\r
353 then avant:=pere.fils(pred)
\r
354 else avant:=courant;
\r
356 courant:=pere.fils(2)
\r
358 if avant.nbdata <= N
\r
359 then if courant.nbdata > N
\r
360 then array aux_data dim (1:3*N);
\r
361 array aux_fils dim (1:3*N+1);
\r
362 for i:=1 to avant.nbdata
\r
364 aux_data(i):=courant.data(i-avant.nbdata-1);
\r
365 aux_fils(i):=avant.fils(i)
\r
367 aux_fils(i):=avant.fils(i);
\r
368 aux_data(i):=pere.data(pred);
\r
369 for i:=avant.nbdata+2 to avant.nbdata+1+courant.nbdata
\r
371 aux_data(i):=courant.data(i-avant.nbdata-1);
\r
372 aux_fils(i):=courant.fils(i-avant.nbdata-1)
\r
374 aux_fils(i):=courant.fils(i-avant.nbdata-1);
\r
375 aux:=avant.nbdata+1+courant.nbdata;
\r
376 milieu:=aux div 2 +1;
\r
377 for i:=1 to milieu-1
\r
379 avant.data(i):=aux_data(i);
\r
380 avant.fils(i):=aux_fils(i)
\r
382 avant.fils(i):=aux_fils(i);
\r
383 avant.nbdata:=milieu-1;
\r
384 pere.data(pred):=aux_data(milieu);
\r
385 for i:=milieu+1 to aux
\r
387 courant.data(i-milieu):=aux_data(i);
\r
388 courant.fils(i-milieu):=aux_fils(i)
\r
390 courant.fils(i-milieu):=aux_fils(i);
\r
391 courant.nbdata:=aux-avant.nbdata-1
\r
392 else for i:=avant.nbdata+2 to avant.nbdata+1+courant.nbdata
\r
394 avant.data(i):=courant.data(i-avant.nbdata-1);
\r
395 avant.fils(i):=courant.fils(i-avant.nbdata-1);
\r
396 if courant.fils(i-avant.nbdata-1) <> none
\r
397 then courant.fils(i-avant.nbdata-1).pere:=avant
\r
400 avant.fils(i):=courant.fils(i-avant.nbdata-1);
\r
401 if courant.fils(i-avant.nbdata-1) <> none
\r
402 then courant.fils(i-avant.nbdata-1).pere:=avant
\r
404 avant.data(avant.nbdata+1):=pere.data(pred);
\r
405 avant.nbdata:=avant.nbdata+1+courant.nbdata;
\r
406 for i:=pred+1 to pere.nbdata
\r
408 pere.data(i-1):=pere.data(i);
\r
409 pere.fils(i):=pere.fils(i+1)
\r
411 pere.fils(pere.nbdata+1):=none;
\r
412 pere.nbdata:=pere.nbdata-1;
\r
418 else array aux_data dim (1:3*N);
\r
419 array aux_fils dim (1:3*N+1);
\r
420 for i:=1 to avant.nbdata
\r
422 aux_data(i):=avant.data(i);
\r
423 aux_fils(i):=avant.fils(i)
\r
425 aux_fils(i):=avant.fils(i);
\r
426 aux_data(i):=pere.data(pred);
\r
427 for i:=avant.nbdata+2 to avant.nbdata+1+courant.nbdata
\r
429 aux_data(i):=courant.data(i-avant.nbdata-1);
\r
430 aux_fils(i):=courant.fils(i-avant.nbdata-1)
\r
432 aux_fils(i):=courant.fils(i-avant.nbdata-1);
\r
433 aux:=avant.nbdata+1+courant.nbdata;
\r
434 milieu:=aux div 2 +1;
\r
435 for i:=1 to milieu-1
\r
437 avant.data(i):=aux_data(i);
\r
438 avant.fils(i):=aux_fils(i)
\r
440 avant.fils(i):=aux_fils(i);
\r
441 avant.nbdata:=milieu-1;
\r
442 pere.data(pred):=aux_data(milieu);
\r
443 for i:=milieu+1 to aux
\r
445 courant.data(i-milieu):=aux_data(i);
\r
446 courant.fils(i-milieu):=aux_fils(i)
\r
448 courant.fils(i-milieu):=aux_fils(i);
\r
449 courant.nbdata:=aux-avant.nbdata-1
\r
454 then if avant.nbdata < N
\r
455 then pere:=pere.pere;
\r
458 if pere.fils(i)=avant
\r
463 courant:=pere.fils(i+1);
\r
465 then courant:=avant;
\r
466 avant:=pere.fils(i-1)
\r
476 call outgtext("El
\82ment supprim
\82.")
\r
482 root:=new STPage(N);
\r
485 (****************************************************************************)
\r
486 (* dessine une ligne entre les points (x1,y1) et (x2,y2) de la couleur c *)
\r
487 (****************************************************************************)
\r
488 unit line : procedure(x1,y1,x2,y2,c:integer);
\r
490 pref iiuwgraph block
\r
495 call color(colore);
\r
499 (****************************************************************************)
\r
500 (* dessine une boite entre les points (x1,y1) et (x2,y2) de la couleur c *)
\r
501 (****************************************************************************)
\r
502 unit rectanglef : procedure(x1,y1,x2,y2,c:integer);
\r
505 pref iiuwgraph block
\r
509 call line(x1,i,x2,i,c);
\r
511 call color(colore);
\r
515 (****************************************************************************)
\r
516 (* dessine un rectangle entre les points (x1,y1) et (x2,y2) de la couleur c *)
\r
517 (****************************************************************************)
\r
518 unit rectangle : procedure(x1,y1,x2,y2,c:integer);
\r
520 pref iiuwgraph block
\r
522 call line(x1,y1,x2,y1,c);
\r
523 call line(x2,y1,x2,y2,c);
\r
524 call line(x2,y2,x1,y2,c);
\r
525 call line(x1,y2,x1,y1,c);
\r
526 call color(colore);
\r
530 (****************************************************************************)
\r
531 (* dessine un rectangle en pointilles entre (x1,y1) et (x2,y2) *)
\r
532 (****************************************************************************)
\r
533 unit rectpoint : procedure(x1,y1,x2,y2,c:integer);
\r
536 pref iiuwgraph block
\r
538 for i:=x1 step 4 to x2-2
\r
540 call line(i,y1,i+2,y1,c);
\r
541 call line(i,y2,i+2,y2,c);
\r
543 for i:=y1 step 4 to y2-2
\r
545 call line(x1,i,x1,i+2,c);
\r
546 call line(x2,i,x2,i+2,c);
\r
554 (****************************************************************************)
\r
555 (* affiche le bandeau de commande en premiere ligne de l'ecran *)
\r
556 (****************************************************************************)
\r
557 unit affiche : procedure;
\r
560 pref iiuwgraph block
\r
562 call rectanglef(0,0,640,9,colorf);
\r
563 call color(colore);
\r
567 call move(10+espace*(i-1),1);
\r
568 call outstring(item(i));
\r
570 call rectangle(1,15,196,340,colorf);
\r
571 call rectangle(200,15,639,320,colorf);
\r
572 call rectangle(200,325,639,340,colorf);
\r
573 call move(202,330);
\r
574 call outstring(" BArbre d'ordre 3 Li1 : PATAUD F. - PEYRAT F.");
\r
578 (****************************************************************************)
\r
579 (* gere le menu, retourne le code action soit clavier soit souris *)
\r
580 (****************************************************************************)
\r
581 unit mousegest : function : integer;
\r
582 var l,r,c : boolean;
\r
586 pref iiuwgraph block
\r
591 call getpress(0,x,y,nbbot,l,r,c);
\r
593 then if (y<=10 and y>=1)
\r
594 then result:=(x-10)/espace+1; exit;
\r
598 if (rep>=-65 and rep<=-59)
\r
599 then result:=-rep-58;
\r
607 (****************************************************************************)
\r
608 (* initialise le menu et effectue l'action demand
\82e *)
\r
609 (****************************************************************************)
\r
610 unit maine : procedure;
\r
612 var action : integer;
\r
620 array item dim (1:nbitem);
\r
621 item(1):=" Inserer ";
\r
622 item(2):=" Effacer ";
\r
623 item(3):=" Affiche ";
\r
624 item(4):=" Membre? ";
\r
625 item(5):=" Minimum ";
\r
626 item(6):=" Maximum ";
\r
627 item(7):=" Quitter ";
\r
634 when 1: call menu_ins;
\r
635 when 2: call menu_del;
\r
636 when 3: call menu_aff;
\r
637 when 4: call menu_mem;
\r
638 when 5: call menu_min;
\r
639 when 6: call menu_max;
\r
640 when 7: if menu_qui then exit fi;
\r
646 (****************************************************************************)
\r
647 (* procedure d'affichage dans l'ecran de commandes, fait un scroll si besoin*)
\r
648 (****************************************************************************)
\r
649 unit outgtext : procedure(id : string);
\r
650 var i,savx : integer;
\r
651 var tmap1 : arrayof integer;
\r
653 pref iiuwgraph block
\r
655 call color(colore);
\r
656 call move(10,posy);
\r
657 call outstring(id);
\r
659 if (posy>=320) (* on est en fin de page, on fait un scroll d'une ligne *)
\r
661 (* array tmap1 dim (1:300); *)
\r
662 (* for i:=1 step 10 to 281 *)
\r
664 (* call move(1,36+i);*)
\r
665 (* tmap1:=getmap(196,46+i);*)
\r
666 (* call move(1,16+i);*)
\r
667 (* call putmap(tmap1);*)
\r
669 (* call rectanglef(2,317,195,337,0);*)
\r
671 (* call move(savx,posy); *)
\r
672 call rectanglef(2,16,195,337,0);
\r
678 (****************************************************************************)
\r
679 (* lecture d'un entier en mode graphique, esc revient au debut de saisie *)
\r
680 (****************************************************************************)
\r
681 unit gscanf : function : integer;
\r
682 var valeur : integer;
\r
683 var sauvx,sauvy : integer;
\r
684 var flag : integer;
\r
686 pref iiuwgraph block
\r
694 if (flag>=48 and flag<=57) orif (flag=13) orif (flag=27) then exit fi
\r
696 if (flag>=48 and flag<=57)
\r
697 then valeur:=valeur*10+flag-48;
\r
698 call move(inxpos,inypos);
\r
701 if (flag=13) then exit fi;
\r
702 if (flag=27) (* on a demand
\82 annulation *)
\r
704 call rectanglef(sauvx-1,sauvy-3,inxpos,sauvy+7,0);
\r
705 call color(colore);
\r
706 call move(sauvx,sauvy);
\r
713 (****************************************************************************)
\r
714 (* affiche un entier en mode graphique, maximum 6 chiffres *)
\r
715 (****************************************************************************)
\r
716 unit writint : procedure( valeur : integer);
\r
717 var flag,i : integer;
\r
718 var tbl : arrayof integer;
\r
720 pref iiuwgraph block
\r
722 array tbl dim (1:6);
\r
723 flag:=1; (* on 'empile' en ordre reverse *)
\r
726 tbl(flag):=valeur mod 10;
\r
727 valeur:=valeur div 10;
\r
730 for i:=flag-1 downto 1 (* on affiche dans le bon ordre *)
\r
732 call hascii(48+tbl(i));
\r
738 (****************************************************************************)
\r
739 (* affiche ds l'ecran de droite la page courante *)
\r
740 (****************************************************************************)
\r
741 unit affiche_page : procedure (page : STPage);
\r
744 pref iiuwgraph block
\r
747 then call line(420,82,420,97,colorf);
\r
748 call cirb(420,77,5,0,0,colorf,0,1,1);
\r
752 call rectpoint(339+(i-1)*27,97,339+i*27,117,colorf);
\r
754 then call move(339+(i-1)*27+3,105);
\r
755 call writint(page.data(i).data);
\r
761 (****************************************************************************)
\r
762 (* affiche ds l'ecran de droite la page fille de gauche *)
\r
763 (****************************************************************************)
\r
764 unit affiche_gche : procedure (page : STPage);
\r
766 var savi : integer;
\r
768 pref iiuwgraph block
\r
770 call line(312,220,312,240,colorf);
\r
773 call rectangle(204+i*27,240,204+(i+1)*27,260,colorf);
\r
775 then call move(204+i*27+3,248);
\r
776 call writint(page.data(i).data);
\r
778 if page.fils(i) <> none
\r
780 then call line(204+i*27,260,204+i*27,275,colorf);
\r
782 then call line(204+i*27,260,204+i*27-5,275,colorf);
\r
783 else call line(204+i*27,260,204+i*27+5,275,colorf);
\r
789 if page.fils(i) <> none
\r
790 then if savi<>3 (* comme on part gche->dte on a soit | soit \ *)
\r
791 then call line(204+(savi+1)*27,260,204+(savi+1)*27+5,275,colorf);
\r
792 else call line(204+(savi+1)*27,260,204+(savi+1)*27,275,colorf);
\r
798 (****************************************************************************)
\r
799 (* affiche ds ecran de droite la page fille droite *)
\r
800 (****************************************************************************)
\r
801 unit affiche_drte : procedure (page :STPage);
\r
804 pref iiuwgraph block
\r
806 call line(527,220,527,240,colorf);
\r
809 call rectangle(635-(i+1)*27,240,635-i*27,260,colorf);
\r
810 if (6-i+1)<=page.nbdata
\r
811 then call move(635-(i+1)*27+3,248);
\r
812 call writint(page.data(6-i+1).data);
\r
813 if page.fils(6-i+1) <> none
\r
815 then call line(635-i*27,260,635-i*27,275,colorf);
\r
817 then call line(635-i*27,260,635-i*27+5,275,colorf);
\r
818 else call line(635-i*27,260,635-i*27-5,275,colorf);
\r
824 if page.fils(1) <> none
\r
825 then call line(635-i*27,260,635-i*27-5,275,colorf);
\r
832 (****************************************************************************)
\r
833 (* Lecture de la donn
\82e de STData *)
\r
834 (****************************************************************************)
\r
835 unit lect_data : function : STData;
\r
839 call outgtext("Entrez la donn
\82e :");
\r
844 (****************************************************************************)
\r
845 (* menu insertion *)
\r
846 (****************************************************************************)
\r
847 unit menu_ins : procedure;
\r
851 call arbr.insertion(d);
\r
856 (****************************************************************************)
\r
857 (* menu effacement *)
\r
858 (****************************************************************************)
\r
859 unit menu_del : procedure;
\r
863 call arbr.supprimer(d);
\r
867 (****************************************************************************)
\r
868 (* menu de parcours de l'arbre dans la fenetre droite *)
\r
869 (****************************************************************************)
\r
870 unit menu_aff : procedure;
\r
871 var pos,spos: integer;
\r
872 var rep,x,y : integer;
\r
873 var l,r,c : boolean;
\r
876 pref iiuwgraph block
\r
882 call rectangle(210,25,245,36,colorf);
\r
884 call outstring("Exit");
\r
887 call outgtext("MENU AFF");
\r
888 call rectanglef(201,37,638,319,0);
\r
889 call affiche_page(page);
\r
890 if page.fils(pos) <> none
\r
891 then call affiche_gche(page.fils(pos));
\r
893 if page.fils(pos+1) <> none
\r
894 then call affiche_drte(page.fils(pos+1));
\r
896 call rectangle(339+(pos-1)*27,97,339+pos*27,117,colorf);
\r
897 if page.fils(pos) <> none
\r
898 then call line(339+(pos-1)*27,117,339+(pos-1)*27-5,132,colorf);
\r
900 if page.fils(pos+1) <> none
\r
901 then call line(339+pos*27,117,339+pos*27+5,132,colorf);
\r
905 call getpress(0,x,y,nbbot,l,r,c);
\r
907 then if (y<36 and y>25 and x>211 and x<245) (* button exit *)
\r
910 if (x<501 and x>339 and y<117 and y>97) (* ds pere chgt gch dte *)
\r
911 then spos:=((x-339) div 27)+1;
\r
912 if spos<=page.nbdata
\r
917 if (x>231 and x<393 and y>240 and y<260) (* fils gche devient pere*)
\r
918 then page:=page.fils(pos);
\r
922 if (x>446 and x<608 and y>240 and y<260) (* fils dte devient pere *)
\r
923 then page:=page.fils(pos+1);
\r
927 if (page<>arbr.root) and (x>415 and x<425 and y>72 and y<82)
\r
928 then page:=page.pere; (* on remonte d'un niveau *)
\r
936 else if (rep>=49 and rep<=54)
\r
944 call rectanglef(201,24,638,319,0);
\r
950 (****************************************************************************)
\r
952 (****************************************************************************)
\r
953 unit menu_mem : procedure;
\r
958 if arbr.Membre(d,page)
\r
959 then call outgtext("Donn
\82e pr
\82sente ds arbre");
\r
960 else call outgtext("Donn
\82e absente ds arbre");
\r
965 (****************************************************************************)
\r
967 (****************************************************************************)
\r
968 unit menu_min : procedure;
\r
972 then call writint(d.data);
\r
977 (****************************************************************************)
\r
979 (****************************************************************************)
\r
980 unit menu_max : procedure;
\r
984 then call writint(d.data);
\r
989 (****************************************************************************)
\r
991 (****************************************************************************)
\r
992 unit menu_qui : function : boolean;
\r
996 pref iiuwgraph block
\r
998 call outgtext("Voulez-vous quitter");
\r
999 call outgtext(" (o/n) ?");
\r
1000 call move(inxpos+8,inypos);
\r
1003 if (a=111 or a=79)
\r
1004 then result:=true;
\r
1005 call outgtext("o");
\r
1008 if (a=110 or a=78)
\r
1009 then result:=false;
\r
1010 call outgtext("n");
\r
1014 call outgtext("");
\r
1020 (*****************************************************************************)
\r
1021 (*****************************************************************************)
\r
1023 (* P R O G R A M M E P R I N C I P A L *)
\r
1025 (*****************************************************************************)
\r
1026 (*****************************************************************************)
\r
1027 var colorf,colore : integer;
\r
1028 var nbitem : integer;
\r
1029 var espace : integer;
\r
1030 var item : arrayof string;
\r
1031 var nbbot : integer;
\r
1032 var flag : boolean;
\r
1033 var posy : integer;
\r
1034 var arbr : Barbre;
\r
1037 pref iiuwgraph block
\r
1041 arbr:=new Barbre(3);
\r
1043 flag:=init(nbbot);
\r
1044 call hpage(0,1,1);
\r