9 unit noeud : class(x,y : integer);
\r
10 var gauche,droite : noeud;
\r
13 unit liste : class(x,y: integer);
\r
14 var suiv,pred : liste;
\r
17 unit insert : procedure(x,y : integer);
\r
25 if d then td:=x<t.x;
\r
28 if td then t:=t.gauche; else t:=t.droite; fi;
\r
31 if racine<>none then
\r
33 if td then tt.gauche:=t; else tt.droite:=t; fi;
\r
34 else racine:=new noeud(x,y);
\r
38 unit mb : function (x,y : integer) : boolean;
\r
46 if ((t.x=x) and (t.y=y)) then exit; fi;
\r
47 if d then td:=x<t.x;
\r
49 if td then t:=t.gauche; else t:=t.droite; fi;
\r
51 od; if (t<>none) then result:=true; else result:=false; fi;
\r
54 unit twodrange : procedure (t : noeud; x1,y1,x2,y2 : integer;
\r
55 d : boolean; inout l:liste);
\r
56 var t1,t2,tx1,tx2,ty1,ty2 : boolean;
\r
59 tx1:=x1<t.x; tx2:=t.x<x2;
\r
60 ty1:=y1<t.y; ty2:=t.y<y2;
\r
66 if t1 then call twodrange(t.gauche,x1,y1,x2,y2,(not d),l);fi;
\r
67 if (x1<t.x) and (t.x<x2) and (y1<t.y) and (t.y<y2) then
\r
69 l.suiv:=new liste(t.x,t.y);
\r
73 l:=new liste(t.x,t.y);
\r
77 if t2 then call twodrange (t.droite,x1,y1,x2,y2,(not d),l);fi;
\r
81 unit delete : procedure (x,y : integer);
\r
83 var t,tt,pb : noeud;
\r
86 unit sousmaxi : procedure(t : noeud;surx,click : boolean;
\r
87 inout dsort : boolean; inout n : noeud);
\r
91 if t.x>=n.x then n:=t;
\r
95 if t.y>=n.y then n:=t;
\r
99 call sousmaxi(t.gauche,surx,not(click),dsort,n);
\r
100 call sousmaxi(t.droite,surx,not(click),dsort,n);
\r
104 unit sousmini : procedure(t : noeud;surx,click : boolean;
\r
105 inout dsort : boolean;inout n : noeud);
\r
109 if t.x<=n.x then n:=t;
\r
113 if t.y<=n.y then n:=t;
\r
117 call sousmini(t.gauche,surx,not(click),dsort,n);
\r
118 call sousmini(t.droite,surx,not(click),dsort,n);
\r
122 unit delpartiel : procedure(t : noeud;surx : boolean);
\r
126 if (t.gauche=none) and (t.droite=none) then
\r
129 if t.gauche<>none then
\r
131 call sousmaxi(t.gauche,surx,not(surx),dn,n);
\r
132 t.x:=n.x; t.y:=n.y;
\r
133 call delpartiel(n,dn);
\r
136 call sousmini(t.droite,surx,not(surx),dn,n);
\r
137 t.x:=n.x; t.y:=n.y;
\r
138 call delpartiel(n,dn);
\r
149 if ((t.x=x) and (t.y=y)) then exit; fi;
\r
150 if d then td:=x<t.x;
\r
151 else td:=y<t.y; fi;
\r
152 if td then t:=t.gauche; else t:=t.droite; fi;
\r
158 call delpartiel(t,d);
\r
161 unit killall : procedure(inout t : noeud);
\r
164 call killall(t.gauche);
\r
165 call killall(t.droite);
\r
171 unit cadre : procedure( t : noeud;
\r
172 inout minx,maxx,miny,maxy : integer);
\r
176 if t.x<minx then minx:=t.x; fi;
\r
177 if t.x>maxx then maxx:=t.x; fi;
\r
178 if t.y>maxy then maxy:=t.y; fi;
\r
179 if t.y<miny then miny:=t.y; fi;
\r
184 call cadre(t.gauche,minx,maxx,miny,maxy);
\r
185 call cadre(t.droite,minx,maxx,miny,maxy);
\r
193 (****************************************************************************)
\r
194 (********* PROGRAMME PRINCIPAL ***********)
\r
200 var x,y,x1,y1,x2,y2,z,n,p : integer;
\r
202 var test : boolean;
\r
203 var ax,b,cx,d : real;
\r
204 var lespoints,ll : liste;
\r
211 unit SetCursor : procedure(column, row : integer);
\r
212 var c,d,e,f : char,
\r
219 i := column div 10;
\r
220 j := column mod 10;
\r
223 write( chr(27), "[", c, d, ";", e, f, "H")
\r
226 unit writexy : procedure(x,y : integer; chaine : string);
\r
228 call setcursor(x,y);
\r
233 unit outtextxy : procedure (val,x,y : integer);
\r
235 var compt : integer;
\r
237 var test : boolean;
\r
238 var negatif : boolean;
\r
251 aux:=entier(val/c);
\r
258 if aux<>0 or c<=1 then exit; fi;
\r
260 if negatif then compt:=compt+1; fi;
\r
261 call move(x+(4-compt)*8,y);
\r
262 if negatif then call hascii(45); fi;
\r
264 aux:=entier(val/c);
\r
265 call hascii(48+aux);
\r
268 if c<1 then exit; fi;
\r
272 unit imprimegraphe : procedure (t : noeud);
\r
273 unit chaine : class(x,y: integer);
\r
274 var last,next : chaine;
\r
277 var et,c : integer;
\r
278 var d,td,dd : boolean;
\r
279 var suite : boolean;
\r
286 unit boite : procedure(cx,cy:integer);
\r
288 call move(cx-34,cy-10);
\r
289 call draw(cx+42,cy-10);
\r
290 call draw(cx+42,cy+10);
\r
291 call draw(cx-34,cy+10);
\r
292 call draw(cx-34,cy-10);
\r
293 call move(cx+4,cy);
\r
294 call draw(cx+4,cy+10);
\r
297 unit imprimepartiel : procedure (t : noeud; cx,cy,px,py,c: integer;
\r
298 inout suite : boolean;d : boolean);
\r
302 if (c=3 and (t.gauche<>none or t.droite<>none))
\r
306 if c<>0 then call move(px+4,py+10);call draw(cx+4,cy-10);fi;
\r
307 call outtextxy(t.x,cx-32,cy);
\r
308 if d then call move(cx,cy-8);call hascii(72);
\r
309 else call move(cx,cy-8);call hascii(86); fi;
\r
310 call outtextxy(t.y,cx+8,cy);
\r
312 a:=entier(40*8/exp(ln(2)*(c+1)));
\r
313 call imprimepartiel(t.gauche,cx-a,cy+80,cx,cy,c+1,suite,not d);
\r
314 call imprimepartiel(t.droite,cx+a,cy+80,cx,cy,c+1,suite,not d);
\r
315 if suite then call move(200,300);
\r
316 call outstring("Appuyer sur une fleche pour la suite");
\r
321 end imprimepartiel;
\r
326 p:=new chaine(t.x,t.y);
\r
333 call imprimepartiel(r,314,10,-1,-1,et,suite,dd);
\r
336 ("<- ou 4:Branche gauche; -> ou 6:Branche droite;");
\r
337 call outstring("³ ou 8:Pere; <Ù:Menu;");
\r
338 call move(435,318);
\r
343 when 52 : c:=cleft;
\r
344 when 54 : c:=cright;
\r
348 when cleft : if r.gauche<>none then
\r
350 p.next:=new chaine(r.x,r.y);
\r
355 when cright : if r.droite<>none then
\r
357 p.next:=new chaine(r.x,r.y);
\r
362 when cup : if p.last<>none then
\r
371 if ((tt.x=x) and (tt.y=y)) then exit; fi;
\r
372 if d then td:=x<tt.x;
\r
373 else td:=y<tt.y; fi;
\r
374 if td then tt:=tt.gauche; else tt:=tt.droite; fi;
\r
384 writeln(" Arbre Vide ");
\r
389 unit dessine : procedure (t : noeud; inout lx,hx,ly,hy:integer;d:boolean);
\r
393 call line(lx,t.y,hx,t.y);
\r
395 call dessine(t.gauche,lx,hx,ly,t.y,not(d));
\r
396 call dessine(t.droite,lx,hx,t.y,hy,not(d));
\r
398 call line(t.x,ly,t.x,hy);
\r
400 call dessine(t.gauche,lx,t.x,ly,hy,not(d));
\r
401 call dessine(t.droite,t.x,hx,ly,hy,not(d));
\r
406 unit croix: procedure (t:noeud);
\r
408 call move((t.x*ax+b)-2,(t.y*cx+d)-2);
\r
409 call draw((t.x*ax+b)+2,(t.y*cx+d)+2);
\r
410 call move((t.x*ax+b)-2,(t.y*cx+d)+2);
\r
411 call draw((t.x*ax+b)+2,(t.y*cx+d)-2);
\r
414 unit line : procedure (x1,y1,x2,y2 : integer);
\r
416 call move(entier(x1*ax+b),entier(y1*cx+d));
\r
417 call draw(entier(x2*ax+b),entier(y2*cx+d));
\r
421 unit readkey : function : integer;
\r
426 if c<>0 then exit; fi;
\r
431 unit clrscr : procedure;
\r
433 write( chr(27), "[2J")
\r
436 unit normal:procedure;
\r
438 write(chr(27),"[0m");
\r
441 unit inverse:procedure;
\r
443 write(chr(27),"[7m");
\r
446 unit writeliste : procedure(l :liste);
\r
450 while lespoints<>none
\r
452 writeln(lespoints.x,",",lespoints.y);
\r
453 if lespoints.pred<>none then lespoints:=lespoints.pred;
\r
457 if (i mod 22)=0 then
\r
458 call writexy(30,24,"Appuyez sur une touche");
\r
464 unit lecture : procedure (inout x : integer);
\r
468 if x<=9999 and x>=-999 then exit; fi;
\r
469 writeln(" Mauvaise coordonn
\82e");
\r
473 unit afficheMenu:procedure(n : integer,inv : boolean);
\r
475 if inv then call inverse;fi;
\r
477 when 1 : call writexy(20,5,"Inserer un element ");
\r
478 when 2 : call writexy(20,6,"Inserer plusieurs elements");
\r
479 when 3 : call writexy(20,7,"Recherche d' un element ");
\r
480 when 4 : call writexy(20,8,"Range searching ");
\r
481 when 5 : call writexy(20,9,"Affiche tous les elements ");
\r
482 when 6 : call writexy(20,10,"Delete ");
\r
483 when 7 : call writexy(20,11,"Efface arbre ");
\r
484 when 8 : call writexy(20,12,"Affiche arbre ");
\r
485 when 9 : call writexy(20,13,"Dessine Plan ");
\r
486 when 10: call writexy(20,14,"Bye Bye ");
\r
488 if inv then call normal;fi;
\r
493 call arbre.insert(2,9);
\r
494 call arbre.insert(11,1);
\r
495 call arbre.insert(6,8);
\r
496 call arbre.insert(3,3);
\r
497 call arbre.insert(5,15);
\r
498 call arbre.insert(8,11);
\r
499 call arbre.insert(0,6);
\r
500 call arbre.insert(7,4);
\r
501 call arbre.insert(9,7);
\r
502 call arbre.insert(14,5);
\r
503 call arbre.insert(10,13);
\r
504 call arbre.insert(16,14);
\r
505 call arbre.insert(15,2);
\r
506 call arbre.insert(13,16);
\r
507 call arbre.insert(1,12);
\r
508 call arbre.insert(12,10);
\r
513 call writexy(19,1,"ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»");
\r
514 for n:=2 to 14 do call writexy(19,n,"º º");
\r
516 call writexy(19,15,"ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ");
\r
517 call writexy(31,2,"MENU");
\r
518 for n:=2 to 10 do call afficheMenu(n,false);
\r
521 call afficheMenu(n,true);
\r
524 if z=-80 or z=50 then p:=n;
\r
525 if n=10 then n:=1 else n:=n+1; fi;
\r
526 call afficheMenu(n,true);
\r
527 call afficheMenu(p,false);
\r
529 if z=-72 or z=56 then p:=n;
\r
530 if n=1 then n:=10 else n:=n-1; fi;
\r
531 call afficheMenu(n,true);
\r
532 call afficheMenu(p,false);
\r
538 when 1 : call clrscr;
\r
539 call writexy(10,2,"Inserer un element");
\r
540 write("x : "); call lecture(x);
\r
541 write("y : "); call lecture(y);
\r
542 call arbre.insert(x,y);
\r
543 when 2 : call clrscr;
\r
544 call writexy(10,2,"Inserer plusieurs elements");
\r
546 writeln("x : "); call lecture(x);
\r
547 writeln("y : "); call lecture(y);
\r
548 call arbre.insert(x,y);
\r
549 write("Encore ? (ENTER/n)");
\r
552 if z<>13 then exit;fi;
\r
554 when 3 : call clrscr;
\r
555 call writexy(10,2,"Recherche d'un element");
\r
556 write("x : "); call lecture(x);
\r
557 write("y : "); call lecture(y);
\r
558 if (arbre.mb(x,y)) then
\r
559 writeln("Cet element fait partie de l'arbre.");
\r
561 writeln("Cet element ne fait pas partie de l'arbre.");
\r
564 when 4 : call clrscr;
\r
565 call writexy(10,2,"Range searching");
\r
567 writeln(" ÚÄÄÄÄÄÄÄÄÄÄ¿ ");
\r
573 writeln(" ÀÄÄÄÄÄÄÄÄÄÄÙ ");
\r
575 write("x1 : "); call lecture(x1);
\r
576 write("y1 : "); call lecture(y1);
\r
577 write("x2 : "); call lecture(x2);
\r
578 write("y2 : "); call lecture(y2);
\r
579 if (x2<x1) then p:=x1;x1:=x2;x2:=p;fi;
\r
580 if (y2<y1) then p:=y1;y1:=y2;y2:=p;fi;
\r
582 call arbre.twodrange(arbre.racine,x1,y1,x2,y2,false,
\r
585 if lespoints<>none then
\r
586 call writeliste(lespoints);
\r
588 writeln(" Aucun points dans ce rectangle.");
\r
591 when 5 : call clrscr;
\r
592 call writexy(10,2,"Affiche tous les elements");
\r
593 call arbre.cadre(arbre.racine,x1,x2,y1,y2);
\r
594 x1:=x1-1; x2:=x2+1; y1:=y1-1; y2:=y2+1;
\r
596 call arbre.twodrange(arbre.racine,x1,y1,x2,y2,false,
\r
598 call writeliste(lespoints);
\r
600 when 6 : call clrscr;
\r
601 call writexy(10,2,"Suppression d'un element");
\r
602 write("x : "); call lecture(x);
\r
603 write("y : "); call lecture(y);
\r
604 if arbre.mb(x,y) then
\r
605 call arbre.delete(x,y);
\r
607 writeln("Element non trouve...");
\r
610 when 7 : call clrscr;
\r
611 call writexy(10,2,"Destruction de l'arbre");
\r
612 writeln("Etes vous sur de vouloir detruire l'arbre ? (o/n)");
\r
614 if choix='o' or choix='O' then
\r
615 call arbre.killall(arbre.racine);
\r
618 when 8 : call clrscr;
\r
619 call imprimegraphe(arbre.racine);
\r
620 when 9 : call gron(nocard);
\r
622 call arbre.cadre(arbre.racine,x1,x2,y1,y2);
\r
623 x1:=x1-1; x2:=x2+1; y1:=y1-1; y2:=y2+1;
\r
624 ax:=maxx/(x2-x1); b:=-x1*ax;
\r
625 cx:=maxy/(y2-y1); d:=-y1*cx;
\r
626 call dessine(arbre.racine,x1,x2,y1,y2,false);
\r
629 when 10 : call clrscr;
\r
635 end; (* end bst2 *)
\r
636 end; (* end iiuwgraph *)
\r