program projet1;

begin
pref iiuwgraph block

unit bst2 : class;
  var racine : noeud;

  unit noeud : class(x,y : integer);
    var gauche,droite : noeud;
  end noeud;

  unit liste : class(x,y: integer);
    var suiv,pred : liste;
  end liste;

  unit insert : procedure(x,y : integer);
  var d,td : boolean;
  var t,tt : noeud;
  begin
    d:=false;
    tt,t:=racine;
    while (t<>none)
    do
      if d then td:=x<t.x;
        else td:=y<t.y; fi;
      tt:=t;
      if td then t:=t.gauche; else t:=t.droite; fi;
      d:=not d;
    od;
    if racine<>none then
      t:=new noeud(x,y);
      if td then tt.gauche:=t; else tt.droite:=t; fi;
    else racine:=new noeud(x,y);
    fi;
  end insert;

  unit mb : function (x,y : integer) : boolean;
  var d,td : boolean;
  var t    : noeud;
  begin
    d:=false;
    t:=racine;
    while (t<>none)
    do
      if ((t.x=x) and (t.y=y)) then exit; fi;
      if d then td:=x<t.x;
        else td:=y<t.y; fi;
      if td then t:=t.gauche; else t:=t.droite; fi;
      d:=not d;
    od;    if (t<>none) then result:=true; else result:=false; fi;
  end mb;

  unit twodrange : procedure (t : noeud; x1,y1,x2,y2 : integer;
                              d : boolean; inout l:liste);
  var t1,t2,tx1,tx2,ty1,ty2 : boolean;
  begin
    if t<>none then
      tx1:=x1<t.x;  tx2:=t.x<x2;
      ty1:=y1<t.y;  ty2:=t.y<y2;
      if d then
        t1:=tx1; t2:=tx2;
      else
        t1:=ty1; t2:=ty2;
      fi;
      if t1 then call twodrange(t.gauche,x1,y1,x2,y2,(not d),l);fi;
      if (x1<t.x) and (t.x<x2) and (y1<t.y) and (t.y<y2) then
         if l<>none then
           l.suiv:=new liste(t.x,t.y);
           l.suiv.pred:=l;
           l:=l.suiv;
         else
           l:=new liste(t.x,t.y);
         fi;
      else ;
      fi;
      if t2 then call twodrange (t.droite,x1,y1,x2,y2,(not d),l);fi;
    fi;
  end twodrange;

  unit delete : procedure (x,y : integer);
  var d,td : boolean;
  var t,tt,pb : noeud;
  var test : boolean;

  unit sousmaxi : procedure(t : noeud;surx,click : boolean;
                            inout dsort : boolean; inout n : noeud);
  begin
    if t<>none then
      if surx then
        if t.x>=n.x then n:=t;
                         dsort:=click;
        fi;
      else
        if t.y>=n.y then n:=t;
                         dsort:=click;
        fi;
      fi;
      call sousmaxi(t.gauche,surx,not(click),dsort,n);
      call sousmaxi(t.droite,surx,not(click),dsort,n);
    fi;
  end sousmaxi;

  unit sousmini : procedure(t : noeud;surx,click : boolean;
                            inout dsort : boolean;inout n : noeud);
  begin
    if t<>none then
      if surx then
        if t.x<=n.x then n:=t;
                         dsort:=click;
        fi;
      else
        if t.y<=n.y then n:=t;
                         dsort:=click;
        fi;
      fi;
      call sousmini(t.gauche,surx,not(click),dsort,n);
      call sousmini(t.droite,surx,not(click),dsort,n);
    fi;
  end sousmini;

  unit delpartiel : procedure(t : noeud;surx : boolean);
  var n  : noeud;
  var dn : boolean;
  begin
    if (t.gauche=none) and (t.droite=none) then
      kill(t);
    else
      if t.gauche<>none then
        n:=t.gauche;
        call sousmaxi(t.gauche,surx,not(surx),dn,n);
        t.x:=n.x; t.y:=n.y;
        call delpartiel(n,dn);
      else
        n:=t.droite;
        call sousmini(t.droite,surx,not(surx),dn,n);
        t.x:=n.x; t.y:=n.y;
        call delpartiel(n,dn);
      fi;
    fi;
  end delpartiel;


  begin
    d:=false;
    t:=racine;
    while (t<>none)
    do
      if ((t.x=x) and (t.y=y)) then exit; fi;
      if d then td:=x<t.x;
        else td:=y<t.y; fi;
      if td then t:=t.gauche; else t:=t.droite; fi;
      d:=not d;
    od;
    if t=none then
      exit;
    fi;
    call delpartiel(t,d);
  end delete;

  unit killall : procedure(inout t : noeud);
  begin
    if t<>none then
      call killall(t.gauche);
      call killall(t.droite);
      kill(t);
    fi;
  end killall;


  unit cadre : procedure( t : noeud;
                          inout minx,maxx,miny,maxy : integer);
  begin
    if t<>none then
      if t<>racine then
        if t.x<minx then minx:=t.x; fi;
        if t.x>maxx then maxx:=t.x; fi;
        if t.y>maxy then maxy:=t.y; fi;
        if t.y<miny then miny:=t.y; fi;
      else
        minx,maxx:=t.x;
        miny,maxy:=t.y;
      fi;
      call cadre(t.gauche,minx,maxx,miny,maxy);
      call cadre(t.droite,minx,maxx,miny,maxy);
    fi;
  end cadre;

  

end bst2;

(****************************************************************************)
(*********           PROGRAMME PRINCIPAL                          ***********)
begin
pref bst2 block


var arbre      : bst2;
var x,y,x1,y1,x2,y2,z,n,p   : integer;
var choix      : char;
var test       : boolean;
var ax,b,cx,d  : real;
var lespoints,ll  : liste;

const maxx=639;
const maxy=349;
const bordure=10;


unit  SetCursor : procedure(column, row : integer);
    var c,d,e,f  : char,
        i,j : integer;
  begin
    i := row div 10;
    j := row mod 10;
    c := chr(48+i);
    d := chr(48+j);
    i := column div 10;
    j := column mod 10;
    e := chr(48+i);
    f := chr(48+j);
    write( chr(27), "[", c, d, ";", e, f, "H")
  end SetCursor;

unit writexy : procedure(x,y : integer; chaine : string);
begin
  call setcursor(x,y);
  writeln(chaine);
end;


unit outtextxy : procedure (val,x,y : integer);
  var c       : integer;
  var compt   : integer;
  var aux     : integer;
  var test    : boolean;
  var negatif : boolean;
begin
  
  c:=1000;
  compt:=4;
  if (val<0) then
    negatif:=true;
    val:=-val;
  else
    negatif:=false;
  fi;

  do
    aux:=entier(val/c);
    if aux=0 then
      compt:=compt-1;
      c:=c/10;
    else
      exit;
    fi;
    if aux<>0 or c<=1 then exit; fi;
  od;
  if negatif then compt:=compt+1; fi;
  call move(x+(4-compt)*8,y);
  if negatif then call hascii(45); fi;
  do
    aux:=entier(val/c);
    call hascii(48+aux);
    val:=val-aux*c;
    c:=c/10;
    if c<1 then exit; fi;
  od;
end outtextxy;

unit imprimegraphe : procedure (t : noeud);
  unit chaine : class(x,y: integer);
    var last,next : chaine;
  end chaine;
var  r      : noeud;
var  et,c   : integer;
var d,td,dd : boolean;
var suite   : boolean;
var tt      : noeud;
var p       : chaine;
const cleft  =-75;
const cright =-77;
const cup    =-72;

  unit boite : procedure(cx,cy:integer);
  begin
    call move(cx-34,cy-10);
    call draw(cx+42,cy-10);
    call draw(cx+42,cy+10);
    call draw(cx-34,cy+10);
    call draw(cx-34,cy-10);
    call move(cx+4,cy);
    call draw(cx+4,cy+10);
  end boite;

  unit imprimepartiel : procedure (t : noeud; cx,cy,px,py,c: integer;
                                 inout suite : boolean;d : boolean);
  var a : integer;
  begin
    if t<>none then
      if (c=3 and (t.gauche<>none or t.droite<>none))
          then suite:=true;
      fi;
      call boite(cx,cy);
      if c<>0 then call move(px+4,py+10);call draw(cx+4,cy-10);fi;
      call outtextxy(t.x,cx-32,cy);
      if d then call move(cx,cy-8);call hascii(72);
      else call move(cx,cy-8);call hascii(86); fi;
      call outtextxy(t.y,cx+8,cy);
      if c<3 then
        a:=entier(40*8/exp(ln(2)*(c+1)));
        call imprimepartiel(t.gauche,cx-a,cy+80,cx,cy,c+1,suite,not d);
        call imprimepartiel(t.droite,cx+a,cy+80,cx,cy,c+1,suite,not d);
        if suite then call move(200,300);
                      call outstring("Appuyer sur une fleche pour la suite");
        fi;
      fi;

    fi;
  end imprimepartiel;

  Begin
  if t<>none then
    r:=t;
    p:=new chaine(t.x,t.y);
    kill(p.last);
    call gron(nocard);
    dd:=false;
    do
      et:=0;
      suite:=false;
      call imprimepartiel(r,314,10,-1,-1,et,suite,dd);
      call move(60,320);
      call outstring
           ("<- ou 4:Branche gauche; -> ou 6:Branche droite;");
      call outstring("³ ou 8:Pere; <Ù:Menu;");
      call move(435,318);
      call hascii(94);
      c:=readkey;
      call  cls;
      case c
        when  52 : c:=cleft;
        when  54 : c:=cright;
        when  56 : c:=cup;
      esac;
      case c
        when cleft  : if r.gauche<>none then
                        r:=r.gauche;
                        p.next:=new chaine(r.x,r.y);
                        p.next.last:=p;
                        p:=p.next;
                        dd:=not dd;
                      fi;
        when cright : if r.droite<>none then
                        r:=r.droite;
                        p.next:=new chaine(r.x,r.y);
                        p.next.last:=p;
                        p:=p.next;
                        dd:=not dd;
                      fi;
        when cup    : if p.last<>none then
                         dd:=not dd;
                         x:=p.last.x;
                         y:=p.last.y;
                         p:=p.last;
                         d:=false;
                         tt:=t;
                         while (tt<>none)
                         do
                           if ((tt.x=x) and (tt.y=y)) then exit; fi;
                           if d then td:=x<tt.x;
                             else td:=y<tt.y; fi;
                           if td then tt:=tt.gauche; else tt:=tt.droite; fi;
                           d:=not d;
                         od;
                         r:=tt;
                       fi;
        when 13     : exit;
      esac;
    od;
    call groff;
  else
    writeln(" Arbre Vide ");
    z:=readkey;
  fi;
end imprimegraphe;

unit dessine : procedure (t : noeud; inout lx,hx,ly,hy:integer;d:boolean);
begin
  if t<>none then
    if not(d) then
      call line(lx,t.y,hx,t.y);
      call croix(t);
      call dessine(t.gauche,lx,hx,ly,t.y,not(d));
      call dessine(t.droite,lx,hx,t.y,hy,not(d));
    else
      call line(t.x,ly,t.x,hy);
      call croix(t);
      call dessine(t.gauche,lx,t.x,ly,hy,not(d));
      call dessine(t.droite,t.x,hx,ly,hy,not(d));
    fi;
  fi;
end dessine;

unit croix: procedure (t:noeud);
begin
  call move((t.x*ax+b)-2,(t.y*cx+d)-2);
  call draw((t.x*ax+b)+2,(t.y*cx+d)+2);
  call move((t.x*ax+b)-2,(t.y*cx+d)+2);
  call draw((t.x*ax+b)+2,(t.y*cx+d)-2);
end croix;

unit line : procedure (x1,y1,x2,y2 : integer);
begin
  call move(entier(x1*ax+b),entier(y1*cx+d));
  call draw(entier(x2*ax+b),entier(y2*cx+d));
end line;


unit readkey : function : integer;
  var c : integer;
begin
  do
    c:=inkey;
    if c<>0 then exit; fi;
  od;
  result:=c;
end readkey;

unit clrscr : procedure;
begin
  write( chr(27), "[2J")
end clrscr;

unit normal:procedure;
begin
  write(chr(27),"[0m");
end normal;

unit inverse:procedure;
begin
  write(chr(27),"[7m");
end inverse;

unit writeliste : procedure(l :liste);
var i,c : integer;
begin
  i:=0;
  while lespoints<>none
  do
    writeln(lespoints.x,",",lespoints.y);
    if lespoints.pred<>none then lespoints:=lespoints.pred;
      else exit;
    fi;
    i:=i+1;
    if (i mod 22)=0 then
      call writexy(30,24,"Appuyez sur une touche");
      c:=readkey;
    fi;
  od;
end writeliste;

unit lecture : procedure (inout x : integer);
begin
  do
     readln(x);
     if x<=9999 and x>=-999 then exit; fi;
     writeln("  Mauvaise coordonn‚e");
  od;
end lecture;

unit afficheMenu:procedure(n : integer,inv : boolean);
begin
  if inv then call inverse;fi;
  case n
    when 1 : call writexy(20,5,"Inserer un element        ");
    when 2 : call writexy(20,6,"Inserer plusieurs elements");
    when 3 : call writexy(20,7,"Recherche d' un element   ");
    when 4 : call writexy(20,8,"Range searching           ");
    when 5 : call writexy(20,9,"Affiche tous les elements ");
    when 6 : call writexy(20,10,"Delete                    ");
    when 7 : call writexy(20,11,"Efface arbre              ");
    when 8 : call writexy(20,12,"Affiche arbre             ");
    when 9 : call writexy(20,13,"Dessine Plan              ");
    when 10: call writexy(20,14,"Bye Bye                   ");
  esac;
  if inv then call normal;fi;
end afficheMenu;

begin
  arbre:= new bst2;
  call arbre.insert(2,9);
  call arbre.insert(11,1);
  call arbre.insert(6,8);
  call arbre.insert(3,3);
  call arbre.insert(5,15);
  call arbre.insert(8,11);
  call arbre.insert(0,6);
  call arbre.insert(7,4);
  call arbre.insert(9,7);
  call arbre.insert(14,5);
  call arbre.insert(10,13);
  call arbre.insert(16,14);
  call arbre.insert(15,2);
  call arbre.insert(13,16);
  call arbre.insert(1,12);
  call arbre.insert(12,10);


  do
    call clrscr;
    call writexy(19,1,"ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»");
    for n:=2 to 14 do call writexy(19,n,"º                           º");
                   od;
    call writexy(19,15,"ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ");
    call writexy(31,2,"MENU");
    for n:=2 to 10 do call afficheMenu(n,false);
                   od;
    n:=1;
    call afficheMenu(n,true);
    do
      z:=readkey;
      if z=-80 or z=50 then p:=n;
                    if n=10 then n:=1 else n:=n+1; fi;
                    call afficheMenu(n,true);
                    call afficheMenu(p,false);
      fi;
      if z=-72 or z=56 then p:=n;
                    if n=1 then n:=10 else n:=n-1; fi;
                    call afficheMenu(n,true);
                    call afficheMenu(p,false);
      fi;
      if z=13 then exit;
      fi;
    od;
    case n
      when 1 : call clrscr;
               call writexy(10,2,"Inserer un element");
               write("x : ");  call lecture(x);
               write("y : ");  call lecture(y);
               call arbre.insert(x,y);
      when 2 : call clrscr;
               call writexy(10,2,"Inserer plusieurs elements");
               do
                 writeln("x : ");  call lecture(x);
                 writeln("y : ");  call lecture(y);
                 call arbre.insert(x,y);
                 write("Encore ? (ENTER/n)");
                 writeln;
                 z:=readkey;
                 if z<>13 then exit;fi;
               od;
      when 3 : call clrscr;
               call writexy(10,2,"Recherche d'un element");
               write("x : ");  call lecture(x);
               write("y : ");  call lecture(y);
               if (arbre.mb(x,y)) then
                 writeln("Cet element fait partie de l'arbre.");
               else
                 writeln("Cet element ne fait pas partie de l'arbre.");
               fi;
               z:=readkey;
      when 4 : call clrscr;
               call writexy(10,2,"Range searching");
               writeln("x1,y1");
               writeln("  ÚÄÄÄÄÄÄÄÄÄÄ¿ ");
               writeln("  ³          ³ ");
               writeln("  ³          ³ ");
               writeln("  ³          ³ ");
               writeln("  ³          ³ ");
               writeln("  ³          ³ ");
               writeln("  ÀÄÄÄÄÄÄÄÄÄÄÙ ");
               writeln("           x2,y2");
               write("x1 : ");  call lecture(x1);
               write("y1 : ");  call lecture(y1);
               write("x2 : ");  call lecture(x2);
               write("y2 : ");  call lecture(y2);
               if (x2<x1) then p:=x1;x1:=x2;x2:=p;fi;
               if (y2<y1) then p:=y1;y1:=y2;y2:=p;fi;
               kill(lespoints);
               call arbre.twodrange(arbre.racine,x1,y1,x2,y2,false,
                                    lespoints);
               call clrscr;
               if lespoints<>none then
                 call writeliste(lespoints);
               else
                 writeln(" Aucun points dans ce rectangle.");
               fi;
               z:=readkey;
      when 5 : call clrscr;
               call writexy(10,2,"Affiche tous les elements");
               call arbre.cadre(arbre.racine,x1,x2,y1,y2);
               x1:=x1-1; x2:=x2+1; y1:=y1-1; y2:=y2+1;
               kill(lespoints);
               call arbre.twodrange(arbre.racine,x1,y1,x2,y2,false,
                                    lespoints);
               call writeliste(lespoints);
               z:=readkey;
      when 6 : call clrscr;
               call writexy(10,2,"Suppression d'un element");
               write("x : ");  call lecture(x);
               write("y : ");  call lecture(y);
               if arbre.mb(x,y) then
                 call arbre.delete(x,y);
               else
                 writeln("Element non trouve...");
                 z:=readkey;
               fi;
      when 7 : call clrscr;
               call writexy(10,2,"Destruction de l'arbre");
               writeln("Etes vous sur de vouloir detruire l'arbre ? (o/n)");
               readln(choix);
               if choix='o' or choix='O' then
                 call arbre.killall(arbre.racine);
                 arbre:=new bst2;
               fi;
      when 8 : call clrscr;
               call imprimegraphe(arbre.racine);
      when 9 : call gron(nocard);
               call cls;
               call arbre.cadre(arbre.racine,x1,x2,y1,y2);
               x1:=x1-1; x2:=x2+1; y1:=y1-1; y2:=y2+1;
               ax:=maxx/(x2-x1); b:=-x1*ax;
               cx:=maxy/(y2-y1); d:=-y1*cx;
               call dessine(arbre.racine,x1,x2,y1,y2,false);
               z:=readkey;
               call groff;
      when 10 : call clrscr;
                exit;exit;

    esac;
  od;
end;
end; (* end bst2      *)
end; (* end iiuwgraph *)