4 (**** GESTION DES CARACTERES SAISIES POUR L'AFFICHAGE EN MODE GRAPHIQUE ***)
\r
6 UNIT inchar : IIUWgraph function(a:integer): integer;
\r
11 call color(grisfonce);
\r
14 call outstring(" <ESC>: menu principal");
\r
16 call outstring("<RC>: nouvelle saisie <ESC>: menu principal");
\r
25 if i=27 or i=13 then exit fi;
\r
29 call outstring(" ");
\r
33 UNIT SAISIE:IIUWGRAPH function(e,x,y:integer):arrayof char;
\r
43 call color(grisclair);
\r
47 while c<>13 and c<>27 and i<=e do
\r
48 if c-48>=0 and c-48<=9 then
\r
57 if t(1)<>'a' then exit; fi;
\r
62 UNIT ConvEnt:function(t:arrayof char):integer;
\r
66 for i:=1 to upper(t) do
\r
68 n:=n*10+(ord(t(i))-48);
\r
75 UNIT ConvASC:function(i:integer):arrayof char;
\r
76 var t: arrayof char,
\r
87 t(n):=chr((i mod 10) +48);
\r
94 array result dim(1:(n-1));
\r
95 for r:=1 to (n-1) do
\r
96 result(r):=t(((n-1)-r)+1);
\r
101 UNIT drawmenu: IIUWGRAPH procedure;
\r
103 call color(grisclair);
\r
105 call draw(620,200);
\r
106 call move(620,202);
\r
108 call move(240,208);
\r
110 call outstring("GESTION DES ARBRES 23");
\r
111 call color(grisclair);
\r
113 call draw(620,220);
\r
115 call outstring(" 1-inserer des elements 3-element minimum 5-detruire un arbre");
\r
117 call outstring(" 2-supprimer un element 4-element de l'arbre 6-afficher une fouffe");
\r
119 call outstring(" 0-quitter le programme");
\r
122 call draw(620,260);
\r
124 call draw(620,277);
\r
125 call move(620,200);
\r
126 call draw(620,330);
\r
131 UNIT SelectMenu: IIUWGRAPH function:integer;
\r
136 call outstring(" ");
\r
138 call outstring("Votre choix :");
\r
141 choix:=convent(saisie(1,110,265));
\r
142 if choix>=0 and choix<=6 then exit;fi;
\r
145 call outstring(" ");
\r
147 call outstring(" ");
\r
149 call outstring(" ");
\r
152 (*** FIN DE LA GESTION DE L'AFFICHAGE... ***)
\r
156 (**** DECLARATION DU TYPE: OBJET... *****)
\r
157 UNIT CObjet: CLASS;
\r
158 UNIT objet:IIUWGRAPH class;
\r
159 unit virtual show: procedure(x,y:integer);
\r
161 unit virtual getvalue:function:integer;
\r
163 unit virtual length:function:integer;
\r
167 UNIT elem:objet class(val:integer);
\r
168 unit virtual getvalue: function:integer;
\r
173 unit virtual length:function:integer;
\r
174 var t:arrayof char;
\r
180 unit virtual show: procedure(x,y:integer);
\r
186 f:=(longueur*8-(upper(tab)*8+(upper(tab)-1)*2))div 2;
\r
188 for i:=1 to upper(tab) do
\r
191 call hascii(ord(c));
\r
200 (**** fin de la declaration de OBJET ****)
\r
209 UNIT arbre23: CObjet class;
\r
211 VAR racine:arbre,aux:arbre,eq:boolean;
\r
213 (**** STRUCTURE DE L'ARBRE 23 ****)
\r
215 (**** hierarchie: arbre -|-- noeud *******)
\r
220 UNIT Arbre: IIUWGRAPH class; (** ABSTRACT CLASS **)
\r
221 unit virtual display: procedure(inout h,l:integer);
\r
223 unit virtual getinfo:function(quoi:integer):objet;
\r
227 UNIT Noeud: Arbre CLASS (inf,sup:objet);
\r
229 VAR arbG,arbM,arbD:arbre;
\r
231 unit virtual getinfo:function(quoi:integer):objet;
\r
234 when 1:result:=inf;
\r
235 when 2:result:=sup;
\r
239 unit enfants:function:integer;
\r
243 if arbG<>none then i:=i+1; fi;
\r
244 if arbM<>none then i:=i+1; fi;
\r
245 if arbD<>none then i:=i+1; fi;
\r
248 UNIT integre:function:boolean;
\r
250 result:= (arbD=none);
\r
253 UNIT virtual display: procedure(inout h,l:integer);
\r
256 x1:=h - (((8*longueur+(longueur-1)*2)*2+4) div 2);
\r
257 x2:=h - (((8*longueur+(longueur-1)*2)*2+4)div 2);;
\r
259 call color(grisclair);
\r
260 call inf.show(x2,l);
\r
261 x2:=x1+(8*longueur+(longueur-1)*2);
\r
262 call color(grisfonce);
\r
264 call draw(x2,l+10);
\r
268 call color(grisclair);
\r
269 call sup.show(x2,l);
\r
270 call color(grisfonce);
\r
273 x2:=x2+(8*longueur+(longueur-1)*2);
\r
274 call move(x1-2,l-5);
\r
275 call draw(x2+2,l-5);
\r
276 call draw(x2+2,l+10);
\r
277 call draw(x1-2,l+10);
\r
278 call draw(x1-2,l-5);
\r
284 UNIT Feuille: arbre CLASS(e:objet);
\r
286 unit virtual display: procedure(inout h,l:integer);
\r
289 x1:=h - ((8*longueur+(longueur-1)*2+4) div 2);
\r
292 call color(grisfonce);
\r
293 x2:=x1+(8*longueur+(longueur-1)*2);
\r
294 call move(x1-2,l-5);
\r
295 call draw(x2+2,l-5);
\r
296 call draw(x2+2,l+10);
\r
297 call draw(x1-2,l+10);
\r
298 call draw(x1-2,l-5);
\r
300 unit virtual getinfo:function(quoi:integer):objet;
\r
308 UNIT SousArbre: function(a:arbre;element:objet):arbre;
\r
309 var linf,lesup:objet;
\r
311 linf:=a.getinfo(inf);
\r
312 lesup:=a.getinfo(sup);
\r
313 if element.getvalue<=linf.getvalue then
\r
314 result:=a qua noeud.arbG;
\r
316 if lesup.getvalue=-1 then
\r
317 result:=a qua noeud.arbG;
\r
320 if element.getvalue<=lesup.getvalue then
\r
321 result:=a qua noeud.arbM;
\r
324 if a qua noeud.arbD=none then
\r
325 result:=a qua noeud.arbM;
\r
327 result:=a qua noeud.arbD;
\r
336 UNIT affichage:IIUWGRAPH procedure(r:arbre);
\r
337 var x,y,t,i:integer;
\r
344 call afficheArbre23(r,y,x,i);
\r
347 call outstring("les elements de l'arbre sont des nombres inferieurs a 100");
\r
348 call move(110,310);
\r
349 call outstring(" !!! JUSQU'A 24 ELEMENTS PEUVENT ETRE AFFICHES !!!");
\r
351 Unit affichearbre23: IIUWGRAPH procedure
\r
352 (r:arbre;inout y:integer;x:integer;inout i:integer);
\r
359 if r is feuille then call r.display(y,x);
\r
362 if r qua noeud.arbG is feuille then
\r
363 if r qua noeud.enfants=2 then
\r
367 call affichearbre23(r qua noeud.arbG,y,x+40,i);
\r
372 call affichearbre23(r qua noeud.arbM,y,x+40,i);
\r
376 call r.display(yD,x);
\r
377 call color(grisfonce);
\r
378 call move(t1,(x+40)-5);
\r
379 call draw(yD,x+10);
\r
380 call move(t2,(x+40)-5);
\r
381 call draw(yD,x+10);
\r
387 call affichearbre23(r qua noeud.arbG,y,x+40,i);
\r
390 call affichearbre23(r qua noeud.arbM,y,x+40,i);
\r
393 call affichearbre23(r qua noeud.arbD,y,x+40,i);
\r
397 call color(grisfonce);
\r
398 call move(t1,(x+40)-5);
\r
400 call move(t2,(x+40)-5);
\r
402 call move(t3,(x+40)-5);
\r
406 call r.display(yd,x);
\r
411 call affichearbre23(r qua noeud.arbG,y,x+40,i);
\r
413 call affichearbre23(r qua noeud.arbM,y,x+40,i);
\r
415 call affichearbre23(r qua noeud.arbD,y,x+40,i);
\r
417 call color(grisfonce);
\r
418 if r qua noeud.enfants=2 then
\r
419 yd:=t1+((t2-t1)/2);
\r
420 call move(t1,x+35);
\r
422 call move(t2,x+35);
\r
425 yd:=t1+((t3-t1)/2);
\r
426 call move(t1,x+35);
\r
429 call move(t2,x+35);
\r
431 call move(t3,x+35);
\r
436 call r.display(yd,x);
\r
444 end affichearbre23;
\r
448 unit suppression:function(d:arbre,num:objet):boolean;
\r
449 var delete:boolean,cousin:arbre;
\r
452 (**** INITIALISATION ****)
\r
456 if member(d,num) then
\r
457 call supprime(d,num,delete,cousin);
\r
459 else result:=false;
\r
461 else result:=false;
\r
464 UNIT supprime: procedure(p:arbre,n:objet;inout deleted:boolean,aux:arbre);
\r
465 var linf,lesup:objet,
\r
468 linf:=p.getinfo(1);
\r
469 lesup:=p.getinfo(2);
\r
471 if p is feuille then (** le pere est une feuille **)
\r
476 fils:=sousarbre(p,n);
\r
478 if fils is feuille then (* fils est une feuille **)
\r
479 deleted:=true; (* on le supprime*)
\r
480 if p qua noeud.enfants=2 then (* l'arbre n'est plus un arbre 23 *)
\r
481 if n.getvalue=linf.getvalue then
\r
482 aux:=p qua noeud.arbM;
\r
483 else aux:=p qua noeud.arbG;
\r
490 (* on supprime le noeud car il a qu'un fils...*)
\r
496 ELSE (* fils est un noeud..*)
\r
498 call supprime(fils,n,deleted,aux);
\r
501 if p qua noeud.enfants=1 then
\r
502 if p qua noeud.arbg=none then
\r
503 p qua noeud.arbG:=p qua noeud.arbM;
\r
504 p qua noeud.arbM:=none;
\r
505 p qua noeud.inf:=supI(p qua noeud.arbG);
\r
506 p qua noeud.sup:=new elem(-1);
\r
507 else p qua noeud.sup:=new elem(-1);
\r
509 else call decale(p);
\r
511 fils:=sousarbre(p,aux.getinfo(inf));
\r
512 if fils qua noeud.enfants=3 then
\r
513 aux:=ordre(aux.getinfo(inf),fils,aux);
\r
514 call ordonne(aux.getinfo(inf),p,aux);
\r
517 call ordonne(aux.getinfo(inf),fils,aux);
\r
518 p qua noeud.inf:=supI(p qua noeud.arbG);
\r
519 p qua noeud.sup:=supI(p qua noeud.arbM);
\r
524 if p qua noeud.enfants=1 then
\r
533 p qua noeud.inf:=supI(p qua noeud.arbG);
\r
534 p qua noeud.sup:=supI(p qua noeud.arbM);
\r
542 Unit root:function:arbre;
\r
547 UNIT reset:procedure(r:arbre);
\r
550 if r is feuille then
\r
551 kill(r qua feuille.e);
\r
554 call reset(r qua noeud.arbG);
\r
556 call reset(r qua noeud.arbM);
\r
557 call reset(r qua noeud.arbD);
\r
558 kill(r qua noeud.inf);
\r
559 kill(r qua noeud.sup);
\r
564 UNIT minimum:function(r:arbre):elem;
\r
567 if r is feuille then
\r
568 result:=r.getinfo(1);
\r
570 result:=minimum(r qua noeud.arbG);
\r
576 UNIT member: function(per:arbre,value:objet):boolean;
\r
581 if per is noeud then
\r
582 fil:=SousArbre(per,value);
\r
583 else (* l'arbre est constitu
\82 d'une seule feuille *)
\r
592 if fil is noeud then
\r
593 result:=member(fil,value);
\r
595 cettevaleur:=fil.getinfo(leave);
\r
596 result:=(cettevaleur.getvalue=value.getvalue);
\r
603 (**** procedures utilis
\82es dans les procedures INSERTION,SUPPRESSION,MEMBER... *******)
\r
605 Unit ordonne:procedure(valeur:objet,nd,obj:arbre);
\r
606 (* ordonne le noeud "ND" apr
\82s insertion du nouvel objet *)
\r
607 (* le noeud comporte alors 3 fils...*)
\r
608 var Lesup,Linf:objet;
\r
610 Linf:=nd.getinfo(inf);
\r
611 lesup:=nd.getinfo(sup);
\r
612 if valeur.getvalue<Linf.getvalue then
\r
613 nd qua noeud.arbD:=nd qua noeud.arbM;
\r
614 nd qua noeud.arbM:=nd qua noeud.arbG;
\r
615 nd qua noeud.arbG:=obj;
\r
616 else if lesup.getvalue=-1 then
\r
617 nd qua noeud.arbM:=obj;
\r
619 if valeur.getvalue<Lesup.getvalue then
\r
620 nd qua noeud.arbD:=nd qua noeud.arbM;
\r
621 nd qua noeud.arbM:=obj;
\r
623 nd qua noeud.arbD:=obj;
\r
627 nd qua noeud.sup:=supI(nd qua noeud.arbM);
\r
628 nd qua noeud.inf:=supI(nd qua noeud.arbG);
\r
633 UNIT decalle:procedure(n:arbre);
\r
635 n qua noeud.arbG:=n qua noeud.arbM;
\r
636 n qua noeud.arbM:=n qua noeud.arbD;
\r
637 n qua noeud.arbD:=none;
\r
638 n qua noeud.inf:=supI(n qua noeud.arbG);
\r
639 n qua noeud.sup:=supI(n qua noeud.arbM);
\r
642 UNIT decale:procedure(n:arbre);
\r
644 if n qua noeud.arbG=none then
\r
645 n qua noeud.arbG:=n qua noeud.arbM;
\r
646 n qua noeud.arbM:=n qua noeud.arbD;
\r
647 n qua noeud.arbD:=none;
\r
648 else if n qua noeud.arbM=none then
\r
649 n qua noeud.arbM:=n qua noeud.arbD;
\r
650 n qua noeud.arbD:=none;
\r
654 n qua noeud.inf:=supI(n qua noeud.arbG);
\r
655 n qua noeud.sup:=supI(n qua noeud.arbM);
\r
659 Unit ordre:function(valeur:objet,nd,obj:arbre):arbre;
\r
663 linf:=nd.getinfo(inf);
\r
664 lesup:=nd.getinfo(sup);
\r
665 if valeur.getvalue<linf.getvalue then
\r
666 aux1:=new noeud(supI(obj),supI(nd qua noeud.arbG));
\r
667 aux1 qua noeud.arbG:=obj;
\r
668 aux1 qua noeud.arbM:=nd qua noeud.arbG;
\r
672 if valeur.getvalue<lesup.getvalue then
\r
673 aux1:=new noeud(supI(nd qua noeud.arbG),supI(obj));
\r
674 aux1 qua noeud.arbM:=obj;
\r
675 aux1 qua noeud.arbG:=nd qua noeud.arbG;
\r
678 if nd qua noeud.arbD.getinfo(2).getvalue<valeur.getvalue then
\r
679 aux1:=new noeud(supI(nd qua noeud.arbD),valeur);
\r
680 aux1 qua noeud.arbM:=obj;
\r
681 aux1 qua noeud.arbG:=nd qua noeud.arbD;
\r
682 nd qua noeud.arbD:=none;
\r
684 aux1:=new noeud(valeur,supI(nd qua noeud.arbD));
\r
685 aux1 qua noeud.arbM:=nd qua noeud.arbD;
\r
686 aux1 qua noeud.arbG:=obj;
\r
687 nd qua noeud.arbD:=none;
\r
694 Unit supI:function(r:arbre):objet;
\r
695 var theleave:objet;
\r
699 if r is feuille then
\r
700 theleave:=r.getinfo(leave);
\r
703 if r qua noeud.arbD=none then
\r
704 result:=supI(r qua noeud.arbM);
\r
706 result:=supI(r qua noeud.arbD);
\r
714 (************************************************************************************)
\r
716 Unit inserer: IIUWGRAPH procedure;
\r
722 components,i:integer;
\r
727 call color(grisfonce);
\r
728 call outstring("Element a inserer :");
\r
730 rt:= new elem (ConvEnt(SAISIE(longueur,160,290)));
\r
733 exist:=member(d,rt);
\r
735 call insertion(d,rt);
\r
739 call move(200,290);
\r
740 call outstring(" ... element existe deja! ...");
\r
749 call outstring("===>");
\r
751 call rt.show(i,300); i:=i+22; fi;
\r
754 call outstring(" ");
\r
757 call outstring(" ");
\r
759 call outstring(" ");
\r
762 UNIT insertion:procedure(pere:arbre,v:objet);
\r
765 linf,lesupdupere,lesupduaux:objet;
\r
772 if pere is noeud then
\r
773 fils:=SousArbre(pere,v);
\r
774 else (* l'arbre est constitu
\82 d'une seule feuille *)
\r
779 linf:=fils.getinfo(inf);
\r
780 if fils is feuille then
\r
783 racine:=new noeud(v,v);
\r
785 if linf.getvalue<v.getvalue then
\r
786 racine qua noeud.arbG:=fils;
\r
787 racine qua noeud.arbM:=new feuille(v);
\r
789 racine qua noeud.arbM:=fils;
\r
790 racine qua noeud.arbG:=new feuille(v);
\r
793 racine qua noeud.inf:=supI(racine qua noeud.arbG);
\r
794 racine qua noeud.sup:=supI(racine qua noeud.arbM);
\r
797 if pere qua noeud.integre then
\r
799 call ordonne(v,pere,p);
\r
801 else (* le noeud comportera plus de trois elements ...*)
\r
802 eq:=true; (* il faut donc le rendre "23"*)
\r
803 aux:=ordre(v,pere,new feuille(v));
\r
804 if pere=racine then
\r
805 racine:=new noeud(v,v);
\r
806 lesupdupere:=pere.getinfo(sup);
\r
807 lesupduaux:=aux.getinfo(sup);
\r
808 if lesupduPERE.getvalue<lesupduAUX.getvalue then
\r
809 racine qua noeud.arbG:=pere;
\r
810 racine qua noeud.arbM:=aux;
\r
812 racine qua noeud.arbM:=pere;
\r
813 racine qua noeud.arbG:=aux;
\r
816 racine qua noeud.inf:=supI(racine qua noeud.arbG);
\r
817 racine qua noeud.sup:=supI(racine qua noeud.arbM);
\r
825 call insertion(fils,v);
\r
829 if pere=racine then
\r
830 if pere qua noeud.integre then
\r
831 call ordonne(aux qua noeud.sup,pere,aux);
\r
833 p:=ordre(aux qua noeud.sup,pere,aux);
\r
834 lesupduPERE:=pere.getinfo(sup);
\r
835 lesupduAUX:=p.getinfo(sup);
\r
836 if LesupduAUX.getvalue>LesupduPERE.getvalue then
\r
837 racine:=new noeud(pere qua noeud.sup,p qua noeud.sup);
\r
838 racine qua noeud.arbG:=pere;
\r
839 racine qua noeud.arbM:=p;
\r
842 racine:=new noeud(p qua noeud.sup,pere qua noeud.sup);
\r
843 racine qua noeud.arbM:=pere;
\r
844 racine qua noeud.arbG:=p;
\r
852 if pere qua noeud.integre then
\r
853 call ordonne(aux qua noeud.sup,pere,aux);
\r
856 aux:=ordre(aux qua noeud.sup,pere,aux);
\r
859 else (* mise a jour des noeud uniquement*)
\r
860 pere qua noeud.inf:= supI(pere qua noeud.arbG);
\r
861 pere qua noeud.sup:= supI(pere qua noeud.arbM);
\r
867 racine:=new feuille(v);
\r
886 (************************* PROGRAMME PRINCIPAL ******************************)
\r
909 pref iiuwgraph block
\r
918 call affichage(racine);
\r
926 call outstring(" Insertion d'un ou plusieurs elements dans l'arbre");
\r
930 call outstring(" Suppression d'un element dans l'arbre");
\r
933 call outstring("element a supprimer:");
\r
934 rt:=new elem(convent(saisie(2,200,280)));
\r
935 call color(grisclair);
\r
936 call move(130,300);
\r
937 if suppression(racine,rt) then
\r
938 call outstring("L'ELEMENT A ETE SUPPRIME !");
\r
940 call outstring("L'ELEMENT A SUPPRIMER N'APPARTIENT PAS A L'ARBRE !");
\r
945 call outstring(" Recherche de l'element minimum appartenant a l'arbre");
\r
947 call color(grisclair);
\r
948 call outstring("l'element minimum est -->");
\r
949 rt:=minimum(racine);
\r
952 call rt.show(250,300);
\r
956 call outstring(" Interrogation sur l'appartenance d'un element...");
\r
958 call color(grisfonce);
\r
959 call outstring("element :");
\r
960 rt:=new elem(convent(saisie(2,200,280)));
\r
961 call move(100,300);
\r
962 call color(grisclair);
\r
963 if member(racine,rt) then
\r
964 call outstring("L'ELEMENT APPARTIENT A L'ARBRE !");
\r
965 else call outstring("L'ELEMENT N'APPARTIENT PAS A L'ARBRE !");
\r
969 when 5: call reset(racine);
\r
973 call reset(racine);
\r
977 end; (* block arbre23 *)
\r
978 end; (* block IIUWGRAPH *)
\r