Program BArbres;
(*****************************************************************************)
(*                                                                           *)
(*                PROJET LI1 Nø1              pour le 15/01/94               *)
(*                                                                           *)
(* PATAUD Frederic                                                           *)
(* PEYRAT Francois                                                           *)
(*                                                                           *)
(*                           Structure des Barbres                           *)
(*                                                                           *)
(*****************************************************************************)


(*****************************************************************************)
(*                         Structure d'une donnees                           *)
(*****************************************************************************)
Unit STData : class;
var data : integer;
End STData;



(*****************************************************************************)
(*                    Structure d'une page d'un B_Arbre                      *)
(*****************************************************************************)
Unit STPage : class (N : integer);
Var pere   : STPage;
var nbdata : integer;
var data   : arrayof STData;
var fils   : arrayof STPage;
Begin
 nbdata:=0;               (* A l'initialisation il n'y a pas de data         *)
 array data dim (1:2*N);  (* Il y a au plus 2n donnees dans une page         *)
 array fils dim (1:2*N+1);(* et au plus 2n+1 fils.                           *)
 pere:=none;              (* Aucun pere n'est definit … la creation.         *)
End STPage;



(*****************************************************************************)
(*                 retourne 1 si elmt1 > elmt2  sinon 0                      *)
(*****************************************************************************)
Unit Superieur : function (elmt1,elmt2 : STData) : boolean;
Begin
 if elmt1.data>elmt2.data
 then result:=true
 else result:=false
 fi
End Superieur;



(*****************************************************************************)
(*                 retourne 1 si elmt1 < elmt2  sinon 0                      *)
(*****************************************************************************)
Unit Inferieur : function (elmt1,elmt2 : STData) : boolean;
Begin
 if elmt1.data<elmt2.data
 then result:=true
 else result:=false
 fi
End Inferieur;



(*****************************************************************************)
(*                 retourne 1 si elmt1 = elmt2  sinon 0                      *)
(*****************************************************************************)
Unit Egalite : function (elmt1,elmt2 : STData) : boolean;
Begin
 if elmt1.data=elmt2.data
 then result:=true
 else result:=false
 fi
End Egalite;



(*****************************************************************************)
(*                                                                           *)
(*****************************************************************************)
Unit Barbre : class (N : integer);
Var root : STPage;


 (****************************************************************************)
 (*            Retourne un booleen indiquant si l'arbre est vide             *)
 (****************************************************************************)
 Unit Vide : function : boolean;
 Begin
  result:=root.nbdata=0;  (* Si la racine n'a pas d'element alors arbre vide *)
 End Vide;


 (****************************************************************************)
 (*                Retourne la valeur du minimun de l'arbre                  *)
 (****************************************************************************)
 Unit Minimum : function (output data : STData) : boolean;
 var page : STPage
 Begin
  call outgtext("Recherche minimum...");
  if not vide
  then page:=root;
       do
        if page.fils(1)=none        (* le minimum se trouve le plus en bas  *)
        then data:=page.data(1);  (* … gauche de l'arbre                  *)
             exit
        fi;
        page:=page.fils(1);
       od;
       result:=true;
  else call outgtext("L'arbre est vide !!!");          (* il y a une erreur  *)
       result:=false;
  fi
 End Minimum;


 (****************************************************************************)
 (*                 Retourne la valeur du maximum de l'arbre                 *)
 (****************************************************************************)
 Unit Maximum : function (output data : STData) : boolean;
 Var page : STPage;
 Begin
  call outgtext("Recherche maximum...");
  if not vide
  then page:=root;
       do
        if page.fils(page.nbdata)=none       (* le maximum est l'element le *)
        then data:=page.data(page.nbdata); (* plus … droite de l'arbre    *)
             exit
        fi;
        page:=page.fils(page.nbdata+1);
       od;
       result:=true;
  else call outgtext("L'arbre est vide !!!");
       result:=false;
  fi;
 End Maximum;


 (****************************************************************************)
 (*   Retourne vraie si l'element elmt est dans l'arbre ainsi que la page    *)
 (*     la recherche va se faire par dichotomie, ameliorant le nombre de     *)
 (*  comparaisons necessaire pour trouver :                                  *)
 (*                                    -soit l'element dans la page courante *)
 (*                                    -soit la page suivante a examiner     *)
 (****************************************************************************)
 Unit Membre : function (input elmt : STData; output page : STPage) : boolean;
 Var a,milieu,b : integer;
 Begin
  call outgtext("Recherche donn‚e...");
  result:=false;
  if not vide
  then page:=root;
       do
        a:=0;                            (* a=debut de l'intervalle         *)
        b:=page.nbdata+1;                (* b=fin de l'intervalle           *)
        do
         milieu:=(a+b) div 2;           (* milieu = milieu de l'intervalle *)
         if Superieur(page.data(milieu),elmt)
         then b:=milieu
         else a:=milieu
         fi;
         if Egalite(page.data(milieu),elmt)
         then result:=true;             (* on a trouve l'element           *)
              exit
         else if (b-a)=1                (* on sort sans avoir touver       *)
              then exit
              fi;
         fi
        od;
        if result
        then exit
        fi;
        if page.fils(1)=none             (*  si plus de page alors on sort  *)
        then exit
        fi;
        if Superieur(page.data(milieu),elmt)     (* sinon on change de page *)
        then page:=page.fils(milieu)
        else page:=page.fils(milieu+1)
        fi
       od
  else call outgtext("L'arbre est vide!!!");
  fi;
 End Membre;



 (****************************************************************************)
 (*                         Insertion d'un element                           *)
 (****************************************************************************)
 Unit Insertion : procedure (elmt : STData);
 Var a,milieu,b,i : integer;
 var aux_fils     : arrayof STPage;
 var aux_data     : arrayof STData;
 var pagenew,page : STPage;
 var sauv1,sauv2  : STPage;
 Begin
  page:=root;
  if vide                       (* on insert la premiere donnee dans l'arbre *)
  then page.data(1):=elmt;
       page.nbdata:=1;
       call outgtext("L'element a ete ajoute.")
  else if not membre(elmt,page)          (* l'element elmt n'existe pas deja *)
       then do
             if page <> none    (* s'il ne faut pas creer une nouvelle page *)
             then a:=0;
                  b:=page.nbdata+1;
                  do  (* recherche dichotomique de la position dans la page *)
                   milieu:=(a+b) div 2;
                   if Superieur(page.data(milieu),elmt)
                   then b:=milieu
                   else a:=milieu
                   fi;
                   if (b-a)=1
                   then exit
                   fi;
                  od;
                  if Inferieur(page.data(milieu),elmt)
                  then milieu:=milieu+1
                  fi;
                  if page.nbdata < 2*N (* si on n'a pas le maximum d'elments*)
                  then for i:=page.nbdata downto milieu
                       do               (* on decale pour inserer l'element *)
                        page.data(i+1):=page.data(i);
                        page.fils(i+2):=page.fils(i+1)
                       od;
                       page.data(milieu):=elmt;      (* on insert l'element *)
                       page.fils(milieu+1):=pagenew;
                       page.nbdata:=page.nbdata+1;
                       exit
                  else a:=1;
                       b:=page.nbdata+1;
                       array aux_data dim (a:b);
                       array aux_fils dim (a:b+1);
                       for i:=1 to milieu-1         (* on sauve les donnees *)
                       do
                        aux_data(i):=page.data(i);
                        aux_fils(i):=page.fils(i);
                       od;
                       aux_fils(i):=page.fils(i);
                       aux_data(milieu):=elmt;
                       aux_fils(milieu+1):=pagenew;
                       for i:=milieu to 2*N
                       do
                        aux_data(i+1):=page.data(i);
                        aux_fils(i+2):=page.fils(i);
                       od;
                       pagenew:= new STPage(N);
                       page.nbdata:=n;
                       pagenew.nbdata:=n;
                       for i:=1 to n                    (* on coupe en deux *)
                       do
                        pagenew.data(i):=aux_data(n+1+i);
                        page.data(i):=aux_data(i);
                        pagenew.fils(i):=aux_fils(n+1+i);
                        page.fils(i):=aux_fils(i);
                       od;
                       pagenew.fils(i):=aux_fils(n+1+i);
                       page.fils(i):=aux_fils(i);
                       elmt:=aux_data(n+1);
                       sauv1:=page;
                       if page.fils(1) <> none   (* on rechaine les parents *)
                       then for i:=1 to n+1
                            do
                             pagenew.fils(i).pere:=pagenew;
                            od
                       fi;
                       pagenew.pere:=page.pere;
                       page:=page.pere;
                       kill(aux_data);          (* on efface les            *)
                       kill(aux_fils);          (* variables intermediaires *)
                  fi
             else sauv2:=pagenew;
                  pagenew:= new STPage(N);  (* creation d'une nouvelle page *)
                  pagenew.nbdata:=1;
                  pagenew.data(1):=elmt;
                  pagenew.fils(1):=sauv1;
                  pagenew.fils(2):=sauv2;
                  sauv1.pere:=pagenew;
                  sauv2.pere:=pagenew;
                  root:=pagenew;             (* il y a changement de racine *)
                  exit
             fi
            od;
            call outgtext("L'‚l‚ment a ete ajoute.");
       else call outgtext("L'‚l‚ment existe deja!");(* l'element existe deja *)
       fi
  fi
 End Insertion;


 (****************************************************************************)
 (*                       Suppression d'un element                           *)
 (****************************************************************************)
 Unit Supprimer : procedure (elmt : STData);
 var a,milieu,b,i : integer;
 var aux_data     : arrayof STData;
 var aux_fils     : arrayof STPage;
 var page,avant   : STPage;
 var courant,pere : STPage;
 var pred,aux     : integer;

 Begin
  if vide                                             (* l'arbre est vide ?! *)
  then call outgtext("L'arbre est vide!!!")
  else page:=root;
       if not membre(elmt,page)       (* l'element n'est pas dans l'arbre ?! *)
       then call outgtext("Donn‚e pas ds l'arbre.");
       else courant:=page;
            a:=0;       (* on recherche par dichotomie la place de l'element *)
            b:=courant.nbdata+1;
            do
             milieu:=(a+b) div 2;
             if Superieur(page.data(milieu),elmt)
             then b:=milieu
             else a:=milieu
             fi;
             if Egalite(page.data(milieu),elmt)
             then exit
             fi
            od;                                             (* on a sa place *)
            if courant.fils(milieu) <> none
            then courant:=courant.fils(milieu)
            fi;
            while courant.fils(courant.nbdata+1) <> none
            do
             courant:=courant.fils(courant.nbdata+1)
            od;
            if page.fils(1) <> none
            then page.data(milieu):=courant.data(courant.nbdata)
            else for i:=milieu to courant.nbdata-1
                 do
                  page.data(i):=page.data(i+1)
                 od
            fi;
            courant.nbdata:=courant.nbdata-1;
            if courant.nbdata < N
            then if courant=root
                 then exit
                 fi;
                 do
                  pere:=courant.pere;
                  i:=1;
                  do
                   if pere.fils(i)=courant
                   then exit
                   fi;
                   i:=i+1
                  od;
                  pred:=i-1;
                  if pred <> 0
                  then avant:=pere.fils(pred)
                  else avant:=courant;
                       pred:=1;
                       courant:=pere.fils(2)
                  fi;
                  if avant.nbdata <= N
                  then if courant.nbdata > N
                       then array aux_data dim (1:3*N);
                            array aux_fils dim (1:3*N+1);
                            for i:=1 to avant.nbdata
                            do
                             aux_data(i):=courant.data(i-avant.nbdata-1);
                             aux_fils(i):=avant.fils(i)
                            od;
                            aux_fils(i):=avant.fils(i);
                            aux_data(i):=pere.data(pred);
                            for i:=avant.nbdata+2 to avant.nbdata+1+courant.nbdata
                            do
                             aux_data(i):=courant.data(i-avant.nbdata-1);
                             aux_fils(i):=courant.fils(i-avant.nbdata-1)
                            od;
                            aux_fils(i):=courant.fils(i-avant.nbdata-1);
                            aux:=avant.nbdata+1+courant.nbdata;
                            milieu:=aux div 2 +1;
                            for i:=1 to milieu-1
                            do
                             avant.data(i):=aux_data(i);
                             avant.fils(i):=aux_fils(i)
                            od;
                            avant.fils(i):=aux_fils(i);
                            avant.nbdata:=milieu-1;
                            pere.data(pred):=aux_data(milieu);
                            for i:=milieu+1 to aux
                            do
                             courant.data(i-milieu):=aux_data(i);
                             courant.fils(i-milieu):=aux_fils(i)
                            od;
                            courant.fils(i-milieu):=aux_fils(i);
                            courant.nbdata:=aux-avant.nbdata-1
                       else for i:=avant.nbdata+2 to avant.nbdata+1+courant.nbdata
                            do
                             avant.data(i):=courant.data(i-avant.nbdata-1);
                             avant.fils(i):=courant.fils(i-avant.nbdata-1);
                             if courant.fils(i-avant.nbdata-1) <> none
                             then courant.fils(i-avant.nbdata-1).pere:=avant
                             fi
                            od;
                            avant.fils(i):=courant.fils(i-avant.nbdata-1);
                            if courant.fils(i-avant.nbdata-1) <> none
                            then courant.fils(i-avant.nbdata-1).pere:=avant
                            fi;
                            avant.data(avant.nbdata+1):=pere.data(pred);
                            avant.nbdata:=avant.nbdata+1+courant.nbdata;
                            for i:=pred+1 to pere.nbdata
                            do
                             pere.data(i-1):=pere.data(i);
                             pere.fils(i):=pere.fils(i+1)
                            od;
                            pere.fils(pere.nbdata+1):=none;
                            pere.nbdata:=pere.nbdata-1;
                            if pere.nbdata=0
                            then root:=avant;
                                 root.pere:=none
                            fi
                       fi
                  else array aux_data dim (1:3*N);
                       array aux_fils dim (1:3*N+1);
                       for i:=1 to avant.nbdata
                       do
                        aux_data(i):=avant.data(i);
                        aux_fils(i):=avant.fils(i)
                       od;
                       aux_fils(i):=avant.fils(i);
                       aux_data(i):=pere.data(pred);
                       for i:=avant.nbdata+2 to avant.nbdata+1+courant.nbdata
                       do
                        aux_data(i):=courant.data(i-avant.nbdata-1);
                        aux_fils(i):=courant.fils(i-avant.nbdata-1)
                       od;
                       aux_fils(i):=courant.fils(i-avant.nbdata-1);
                       aux:=avant.nbdata+1+courant.nbdata;
                       milieu:=aux div 2 +1;
                       for i:=1 to milieu-1
                       do
                        avant.data(i):=aux_data(i);
                        avant.fils(i):=aux_fils(i)
                       od;
                       avant.fils(i):=aux_fils(i);
                       avant.nbdata:=milieu-1;
                       pere.data(pred):=aux_data(milieu);
                       for i:=milieu+1 to aux
                       do
                        courant.data(i-milieu):=aux_data(i);
                        courant.fils(i-milieu):=aux_fils(i)
                       od;
                       courant.fils(i-milieu):=aux_fils(i);
                       courant.nbdata:=aux-avant.nbdata-1
                  fi;
                  if avant <> root
                  then avant:=pere;
                       if avant <> root
                       then if avant.nbdata < N
                            then pere:=pere.pere;
                                 i:=1;
                                 do
                                  if pere.fils(i)=avant
                                  then exit
                                  fi;
                                  i:=i+1
                                 od;
                                 courant:=pere.fils(i+1);
                                 if courant=none
                                 then courant:=avant;
                                      avant:=pere.fils(i-1)
                                 fi
                            else exit
                            fi
                       else exit
                       fi
                  else exit
                  fi
                 od
            fi;
            call outgtext("El‚ment supprim‚.")
       fi
  fi
 End Supprimer;

Begin
 root:=new STPage(N);
End Barbre;

(****************************************************************************)
(*   dessine une ligne entre les points (x1,y1) et (x2,y2) de la couleur c  *)
(****************************************************************************)
unit line : procedure(x1,y1,x2,y2,c:integer);
begin
 pref iiuwgraph block
 begin
  call color(c);
  call move(x1,y1);
  call draw(x2,y2);
  call color(colore);
 end
end line;

(****************************************************************************)
(*   dessine une boite entre les points (x1,y1) et (x2,y2) de la couleur c  *)
(****************************************************************************)
unit rectanglef : procedure(x1,y1,x2,y2,c:integer);
var i : integer;
begin
 pref iiuwgraph block
 begin
  for i:=y1 to y2
  do
    call line(x1,i,x2,i,c);
  od;
  call color(colore);
 end
end rectanglef;

(****************************************************************************)
(* dessine un rectangle entre les points (x1,y1) et (x2,y2) de la couleur c *)
(****************************************************************************)
unit rectangle : procedure(x1,y1,x2,y2,c:integer);
begin
 pref iiuwgraph block
 begin
  call line(x1,y1,x2,y1,c);
  call line(x2,y1,x2,y2,c);
  call line(x2,y2,x1,y2,c);
  call line(x1,y2,x1,y1,c);
  call color(colore);
 end
end rectangle;

(****************************************************************************)
(*      dessine un rectangle en pointilles entre (x1,y1) et (x2,y2)         *)
(****************************************************************************)
unit rectpoint : procedure(x1,y1,x2,y2,c:integer);
var i : integer;
begin
 pref iiuwgraph block
 begin
  for i:=x1 step 4 to x2-2
  do
   call line(i,y1,i+2,y1,c);
   call line(i,y2,i+2,y2,c);
  od;
  for i:=y1 step 4 to y2-2
  do
   call line(x1,i,x1,i+2,c);
   call line(x2,i,x2,i+2,c);
  od
 end
end rectpoint;




(****************************************************************************)
(*       affiche le bandeau de commande en premiere ligne de l'ecran        *)
(****************************************************************************)
unit affiche : procedure;
var i : integer;
begin
 pref iiuwgraph block
 begin
  call rectanglef(0,0,640,9,colorf);
  call color(colore);
  call move(1,1);
  for i:=1 to nbitem
  do
    call move(10+espace*(i-1),1);
    call outstring(item(i));
  od;
  call rectangle(1,15,196,340,colorf);
  call rectangle(200,15,639,320,colorf);
  call rectangle(200,325,639,340,colorf);
  call move(202,330);
  call outstring(" BArbre d'ordre 3          Li1 : PATAUD F. - PEYRAT F.");
 end
end affiche;

(****************************************************************************)
(*      gere le menu, retourne le code action soit clavier soit souris      *)
(****************************************************************************)
unit mousegest : function : integer;
var l,r,c : boolean;
var x,y   : integer;
var rep   : integer;
begin
 pref iiuwgraph block
 begin
  pref mouse block
  begin
    do
     call getpress(0,x,y,nbbot,l,r,c);
     if l
     then if (y<=10 and y>=1)
          then result:=(x-10)/espace+1; exit;
          fi
     fi;
     rep:=inkey;
     if (rep>=-65  and rep<=-59)
     then result:=-rep-58;
          exit
     fi;
    od
  end
 end
end mousegest;

(****************************************************************************)
(*            initialise le menu et effectue l'action demand‚e              *)
(****************************************************************************)
unit maine : procedure;
var i      : integer;
var action : integer;
begin
 pref mouse block
 begin
  colorf:=9;
  colore:=10;
  espace:=90;
  nbitem:=7;
  array item dim (1:nbitem);
  item(1):=" Inserer ";
  item(2):=" Effacer ";
  item(3):=" Affiche ";
  item(4):=" Membre? ";
  item(5):=" Minimum ";
  item(6):=" Maximum ";
  item(7):=" Quitter ";
  call affiche;
  call showcursor;
  colore:=2;
  do
   action:=mousegest;
   case action
    when 1: call menu_ins;
    when 2: call menu_del;
    when 3: call menu_aff;
    when 4: call menu_mem;
    when 5: call menu_min;
    when 6: call menu_max;
    when 7: if menu_qui then exit fi;
   esac;
  od;
 end
end maine;

(****************************************************************************)
(* procedure d'affichage dans l'ecran de commandes, fait un scroll si besoin*)
(****************************************************************************)
unit outgtext : procedure(id : string);
var i,savx : integer;
var tmap1 : arrayof integer;
begin
 pref iiuwgraph block
 begin
  call color(colore);
  call move(10,posy);
  call outstring(id);
  posy:=posy+10;
  if (posy>=320)     (* on est en fin de page, on fait un scroll d'une ligne *)
  then savx:=inxpos;
(*       array tmap1 dim (1:300); *)
(*       for i:=1 step 10 to 281 *)
(*       do*)
(*        call move(1,36+i);*)
(*        tmap1:=getmap(196,46+i);*)
(*        call move(1,16+i);*)
(*        call putmap(tmap1);*)
(*       od;*)
(*       call rectanglef(2,317,195,337,0);*)
(*       posy:=310;              *)
(*       call move(savx,posy); *)
      call rectanglef(2,16,195,337,0);
      posy:=20;
  fi;
 end
end outgtext;

(****************************************************************************)
(*   lecture d'un entier en mode graphique, esc revient au debut de saisie  *)
(****************************************************************************)
unit gscanf : function : integer;
var valeur : integer;
var sauvx,sauvy : integer;
var flag : integer;
begin
 pref iiuwgraph block
 begin
  valeur:=0;
  sauvx:=inxpos;
  sauvy:=inypos;
  do
   do
    flag:=inkey;
    if (flag>=48 and flag<=57) orif (flag=13) orif (flag=27) then exit fi
   od;
   if (flag>=48 and flag<=57)
   then valeur:=valeur*10+flag-48;
        call move(inxpos,inypos);
        call hascii(flag);
   fi;
   if (flag=13) then exit fi;
   if (flag=27)                                   (* on a demand‚ annulation *)
   then valeur:=0;
        call rectanglef(sauvx-1,sauvy-3,inxpos,sauvy+7,0);
        call color(colore);
        call move(sauvx,sauvy);
   fi;
  od;
 end;
 result:=valeur;
end gscanf;

(****************************************************************************)
(*          affiche un entier en mode graphique, maximum 6 chiffres         *)
(****************************************************************************)
unit writint : procedure( valeur : integer);
var flag,i : integer;
var tbl    : arrayof integer;
begin
 pref iiuwgraph block
 begin
  array tbl dim (1:6);
  flag:=1;                                  (* on 'empile' en ordre reverse *)
  while valeur<>0
  do
   tbl(flag):=valeur mod 10;
   valeur:=valeur div 10;
   flag:=flag+1;
  od;
  for i:=flag-1 downto 1                    (* on affiche dans le bon ordre *)
  do
   call hascii(48+tbl(i));
  od;
 end
end writint;


(****************************************************************************)
(*                affiche ds l'ecran de droite la page courante             *)
(****************************************************************************)
unit affiche_page : procedure (page : STPage);
var i :integer;
begin
 pref iiuwgraph block
 begin
  if page<>arbr.root
  then call line(420,82,420,97,colorf);
       call cirb(420,77,5,0,0,colorf,0,1,1);
  fi;
  for i:=1 to 6
  do
   call rectpoint(339+(i-1)*27,97,339+i*27,117,colorf);
   if i<=page.nbdata
   then call move(339+(i-1)*27+3,105);
        call writint(page.data(i).data);
   fi;
  od;
 end
end affiche_page;

(****************************************************************************)
(*          affiche ds l'ecran de droite la page fille de gauche            *)
(****************************************************************************)
unit affiche_gche : procedure (page : STPage);
var i    : integer;
var savi : integer;
begin
 pref iiuwgraph block
 begin
  call line(312,220,312,240,colorf);
  for i:=1 to 6
  do
   call rectangle(204+i*27,240,204+(i+1)*27,260,colorf);
   if i<=page.nbdata
   then call move(204+i*27+3,248);
        call writint(page.data(i).data);
        savi:=i;
        if page.fils(i) <> none
        then if i=4
             then call line(204+i*27,260,204+i*27,275,colorf);
             else if i<4
                  then call line(204+i*27,260,204+i*27-5,275,colorf);
                  else call line(204+i*27,260,204+i*27+5,275,colorf);
                  fi
             fi
        fi
   fi;
  od;
  if page.fils(i) <> none
  then if savi<>3 (* comme on part gche->dte on a soit | soit \ *)
       then call line(204+(savi+1)*27,260,204+(savi+1)*27+5,275,colorf);
       else call line(204+(savi+1)*27,260,204+(savi+1)*27,275,colorf);
       fi;
  fi;
 end
end affiche_gche;

(****************************************************************************)
(*              affiche ds ecran de droite la page fille droite             *)
(****************************************************************************)
unit affiche_drte : procedure (page :STPage);
var i : integer;
begin
 pref iiuwgraph block
 begin
  call line(527,220,527,240,colorf);
  for i:=1 to 6
  do
   call rectangle(635-(i+1)*27,240,635-i*27,260,colorf);
   if (6-i+1)<=page.nbdata
   then call move(635-(i+1)*27+3,248);
        call writint(page.data(6-i+1).data);
        if page.fils(6-i+1) <> none
        then if (6-i+1)=4
             then call line(635-i*27,260,635-i*27,275,colorf);
             else if (6-i+1)>4
                  then call line(635-i*27,260,635-i*27+5,275,colorf);
                  else call line(635-i*27,260,635-i*27-5,275,colorf);
                  fi
             fi
        fi
   fi;
  od;
  if page.fils(1) <> none
  then call line(635-i*27,260,635-i*27-5,275,colorf);
  fi;
 end
end affiche_drte;



(****************************************************************************)
(*                    Lecture de la donn‚e de STData                        *)
(****************************************************************************)
unit lect_data : function : STData;
var d : STData;
begin
 d:=new STData;
 call outgtext("Entrez la donn‚e :");
 d.data:=gscanf;
 result:=d;
end lect_data;

(****************************************************************************)
(*                                menu insertion                            *)
(****************************************************************************)
unit menu_ins : procedure;
var d : STData;
begin
 d:=lect_data;
 call arbr.insertion(d);
 call outgtext("");
end menu_ins;


(****************************************************************************)
(*                                menu effacement                           *)
(****************************************************************************)
unit menu_del : procedure;
var d : STData;
begin
  d:=lect_data;
  call arbr.supprimer(d);
  call outgtext("");
end menu_del;

(****************************************************************************)
(*           menu de parcours de l'arbre dans la fenetre droite             *)
(****************************************************************************)
unit menu_aff : procedure;
var pos,spos: integer;
var rep,x,y : integer;
var l,r,c   : boolean;
var page    : STPage;
begin
 pref iiuwgraph block
 begin
  pref mouse block
  begin
   pos:=1;
   page:=arbr.root;
   call rectangle(210,25,245,36,colorf);
   call move(212,27);
   call outstring("Exit");
   do
    call hidecursor;
    call outgtext("MENU AFF");
    call rectanglef(201,37,638,319,0);
    call affiche_page(page);
    if page.fils(pos) <> none
    then  call affiche_gche(page.fils(pos));
    fi;
    if page.fils(pos+1) <> none
    then  call affiche_drte(page.fils(pos+1));
    fi;
    call rectangle(339+(pos-1)*27,97,339+pos*27,117,colorf);
    if page.fils(pos) <> none
    then call line(339+(pos-1)*27,117,339+(pos-1)*27-5,132,colorf);
    fi;
    if page.fils(pos+1) <> none
    then call line(339+pos*27,117,339+pos*27+5,132,colorf);
    fi;
    call showcursor;
    do
     call getpress(0,x,y,nbbot,l,r,c);
     if l
     then if (y<36 and y>25 and x>211 and x<245)    (* button exit *)
          then exit exit
          fi;
          if (x<501 and x>339 and y<117 and y>97)   (* ds pere chgt gch dte *)
          then spos:=((x-339) div 27)+1;
               if spos<=page.nbdata
               then pos:=spos
               fi;
               exit
          fi;
          if (x>231 and x<393 and y>240 and y<260) (* fils gche devient pere*)
          then page:=page.fils(pos);
               pos:=1;
               exit;
          fi;
          if (x>446 and x<608 and y>240 and y<260) (* fils dte devient pere *)
          then page:=page.fils(pos+1);
               pos:=1;
               exit;
          fi;
          if (page<>arbr.root) and (x>415 and x<425 and y>72 and y<82)
          then page:=page.pere;             (* on remonte d'un niveau *)
               pos:=1;
               exit
          fi;
     fi;
     rep:=inkey;
     if rep=27
     then exit exit
     else if (rep>=49 and rep<=54)
          then pos:=rep-48;
               exit
          fi;
     fi;
    od;
   od;
   call hidecursor;
   call rectanglef(201,24,638,319,0);
   call showcursor;
  end
 end
end menu_aff;

(****************************************************************************)
(*                                menu membre                               *)
(****************************************************************************)
unit menu_mem : procedure;
var d    : STData;
var page : STPage;
begin
 d:=lect_data;
 if arbr.Membre(d,page)
 then call outgtext("Donn‚e pr‚sente ds arbre");
 else call outgtext("Donn‚e absente ds arbre");
 fi;
 call outgtext("");
end menu_mem;

(****************************************************************************)
(*                                  menu minimum                            *)
(****************************************************************************)
unit menu_min : procedure;
var d : STData;
begin
 if arbr.Minimum(d)
 then call writint(d.data);
 fi;
 call outgtext("");
end menu_min;

(****************************************************************************)
(*                                   menu maximum                           *)
(****************************************************************************)
unit menu_max : procedure;
var d : STData;
begin
 if arbr.Maximum(d)
 then call writint(d.data);
 fi;
 call outgtext("");
end menu_max;

(****************************************************************************)
(*                                 menu quitte                              *)
(****************************************************************************)
unit menu_qui : function : boolean;
var rep : boolean;
var a : integer;
begin
 pref iiuwgraph block
 begin
  call outgtext("Voulez-vous quitter");
  call outgtext(" (o/n) ?");
  call move(inxpos+8,inypos);
  do
   a:=inkey;
   if (a=111 or a=79)
   then result:=true;
        call outgtext("o");
        exit
   fi;
   if (a=110 or a=78)
   then result:=false;
        call outgtext("n");
        exit
   fi;
  od;
  call outgtext("");
 end
end menu_qui;



(*****************************************************************************)
(*****************************************************************************)
(*                                                                           *)
(*                   P R O G R A M M E   P R I N C I P A L                   *)
(*                                                                           *)
(*****************************************************************************)
(*****************************************************************************)
var colorf,colore : integer;
var nbitem : integer;
var espace : integer;
var item   : arrayof string;
var nbbot  : integer;
var flag   : boolean;
var posy   : integer;
var arbr   : Barbre;

Begin
 pref iiuwgraph block
 begin
  pref mouse block
  begin
   arbr:=new Barbre(3);
   call gron(1);
   flag:=init(nbbot);
   call hpage(0,1,1);
   posy:=20;
   call maine;
   call hidecursor;
   call groff;
  end
 end
End BArbres.