PROGRAM BICOLORE;

(* Projet LI1 : Operations sur les arbres bicolores . *)
(*              Realise par CHICHER Corinne et DOME Nadege - UPPA 1993/1994 - *)


  (* NewPage vide l'ecran en mode texte *)
  UNIT NewPage : PROCEDURE;
  BEGIN
    write( chr(27), "[2J")
  END NewPage;

  (* SetCursor positionne le curseur aux ligne et colonne indiquees *)
  UNIT SetCursor : PROCEDURE(ligne,colonne:integer);
  VAR c,d,e,f :char,
      i,j :integer;
  BEGIN
    i:=ligne div 10;
    j:=ligne mod 10;
    c:=chr(48+i);
    d:=chr(48+j);
    i:=colonne div 10;
    j:=colonne mod 10;
    e:=chr(48+i);
    f:=chr(48+j);
    write( chr(27), "[", c, d, ";", e, f, "H");
  END SetCursor;


  (* la classe bic definit la structure d'un noeud d'arbre bicolore *)
  UNIT bic : CLASS;
  VAR val:integer,       (* val:Valeur de l'element d'un noeud *)
      rouge : boolean,   (* rouge:couleur d'un noeud:si vrai alors rouge sinon blanc *)             
      fg,fd : bic;       (* fg,fd:fils gauche et droit d'un noeud *)
  END bic;


  (* inchar saisit un caractere en mode graphique *)
  UNIT inchar : iiuwgraph FUNCTION : integer;
  VAR i:integer;
  BEGIN
    DO 
      i:=INKEY;
      if i <> 0 then
	exit
      fi;
    OD;
    result:=i;
  END inchar;

  (* ReadInteger lit un entier positif a 3 chiffres avec echo a l'ecran *)
  UNIT ReadInteger : iiuwgraph FUNCTION : integer;
  VAR X,Y,i,OrdN : integer,
      Number : arrayof integer;
  BEGIN
    array Number dim( 1 : 4 );
    i:=0;
    X:=InXPos;
    Y:=InYPos;
    DO
      OrdN:=inchar;
      if i=8 or (OrdN < 48 and OrdN > 57) then
	exit
      fi;
      CASE OrdN
	when 48 : i:=i+1;
		  Number(i):=0;
	when 49 : i:=i+1;
		  Number(i):=1;
	when 50 : i:=i+1;
		  Number(i):=2;
	when 51 : i:=i+1;
		  Number(i):=3;
	when 52 : i:=i+1;
		  Number(i):=4;
	when 53 : i:=i+1;
		  Number(i):=5;
	when 54 : i:=i+1;
		  Number(i):=6;
	when 55 : i:=i+1;
		  Number(i):=7;
	when 56 : i:=i+1;
		  Number(i):=8;
	when 57 : i:=i+1;
		  Number(i):=9;
	when 8 : if i > 0 then
		   Number(i):=0;
		   i:=i-1;
                   call hascii(0);
		 fi;
	when 13 : if i > 0 then
		    exit
		  fi;
      ESAC;
      if i=1 then
	call Move(X,Y);
	call hascii(0);
	call hascii(48+Number(1));
      fi;
      if i=2 then
	call Move(X+8,Y);
	call hascii(0);
	call hascii(48+Number(2));
      fi; 
      if i=3 then
	call Move(X+16,Y);
	call hascii(0);
	call hascii(48+Number(3));
      fi;        
    OD;
    if (Number(1) = 0) or (Number(1) = 0 and Number(2) = 0) 
       or (Number(1) = 0 and Number(2) = 0 and Number(3) = 0) then
      call Move(X,Y);
      call hascii(0);
      call hascii(48);
      call hascii(0);
    fi;
    if i=1 then
      result:=Number(1);
    else
      if i=2 then
        result:=10 * Number(1) + Number(2);
      else
        result:=100 * Number(1) + 10 * Number(2) + Number(3);
      fi;
    fi;
    kill(Number);
  END ReadInteger;
  
  (* WriteInteger permet d'afficher un entier positif a 3 chiffres a l'ecran *)
  UNIT WriteInteger : iiuwgraph PROCEDURE(Number:integer);
  VAR i,j,k:integer;
  BEGIN
    if Number < 10 then
      call HASCII(0);
      call HASCII(Number+48);
      call HASCII(0);
    else
      if Number < 100 then
        i:=Number div 10;
        j:=Number - i * 10;
        call HASCII(0);
        call HASCII(i+48);
        call HASCII(0);
        call HASCII(j+48);
      else
        i:=Number div 100;
        j:=(Number - i * 100) div 10;
        k:=Number - i * 100 - j * 10;
        call HASCII(0);
        call HASCII(i+48);
        call HASCII(0);
        call HASCII(j+48);
        call HASCII(0);
        call HASCII(k+48);
      fi;
    fi;
  END WriteInteger;

  (* Mousepos gere la position de la souris a l'endroit ou le bouton gauche *)
  (* a ete presse *)
  UNIT MOUSEPOS : iiuwgraph PROCEDURE(x,y:integer;inout bonclic:boolean;output choix:integer);
  BEGIN
    if (x >= 24) and (x <= 544) then
      if (y >= 80) and (y <= 88) then
	choix:=1;
	bonclic:=true;
      fi;
      if (y >= 96) and (y <= 104) then
	choix:=2;
	bonclic:=true;
      fi;
      if (y >= 112) and (y <= 120) then
	choix:=3;
	bonclic:=true;
      fi;
      if (y >= 128) and (y <= 136) then
	choix:=4;
	bonclic:=true;
      fi;
      if (y >= 144) and (y <=152) then
	choix:=5;
	bonclic:=true;
      fi;
      if (y >= 160) and (y <= 168) then
	choix:=6;
	bonclic:=true;
      fi;
      if (y >= 176) and (y <= 184) then
	choix:=7;
	bonclic:=true;
      fi;
      if (y >= 192) and (y <= 200) then
	choix:=8;
	bonclic:=true;
      fi;
      if (y >= 208) and (y <= 216) then
	choix:=9;
	bonclic:=true;
      fi;
      if (y >= 224) and (y <= 232) then
	call CLS;
	(*call GROFF;*)
	choix:=0;
	bonclic:=true;
      fi;
    fi;
  END MOUSEPOS;

  (* cadre trace un rectangle autour des operations *)
  UNIT cadre : iiuwgraph PROCEDURE(xg,yg,xd,yd:integer);
  BEGIN
    call COLOR(7);
    call MOVE(xg,yg);
    call DRAW(xd,yg);
    call MOVE(xd,yg);
    call DRAW(xd,yd);
    call MOVE(xd,yd);
    call DRAW(xg,yd);
    call MOVE(xg,yd);
    call DRAW(xg,yg);
  END cadre;

  (* menu propose les traitements pouvant etre realises sur les arbres bicolores *)
  UNIT menu : iiuwgraph FUNCTION : integer;
  VAR i,b,h,v,numop:integer,
      g,d,c,driver,selection:boolean;
  BEGIN

    pref mouse block
    BEGIN
      call CLS;
      selection:=false;
      g:=false;
      d:=false;
      c:=false;
      call COLOR(7);
      call MOVE(184,24);
      call OUTSTRING("OPERATIONS SUR LES ARBRES BICOLORES");
      call COLOR(15);
      call cadre(24,56,544,240);
      call MOVE(64,80);
      call OUTSTRING("Creation d'un arbre bicolore");
      call MOVE(64,96);
      call OUTSTRING("Ajout d'un element");
      call MOVE(64,112);
      call OUTSTRING("Recherche d'un element dans un arbre");
      call MOVE(64,128);
      call OUTSTRING("Recherche du minimum dans un arbre");
      call MOVE(64,144);
      call OUTSTRING("Recherche du maximum dans un arbre");
      call MOVE(64,160);
      call OUTSTRING("Recherche de(s) successeur(s) d'un element de l'arbre");
      call MOVE(64,176);
      call OUTSTRING("Recherche du predecesseur d'un element de l'arbre");
      call MOVE(64,192);
      call OUTSTRING("Suppression de certains noeuds de l'arbre");
      call MOVE(64,208);
      call OUTSTRING("Affichage d'un arbre");
      call MOVE(64,224);
      call OUTSTRING("Quitter l'application");
      call MOVE(24,256);
      call OUTSTRING("Selectionnez l'operation avec le bouton gauche de la souris...");
    
      (* Gestion de la souris *)
      driver:=INIT(b);
      call SETPOSITION(0,0);
      call SHOWCURSOR;
      DO
	call GETPRESS(0,h,v,b,g,d,c);
	if g then
	  call MOUSEPOS(h,v,selection,numop);
	  if not selection then
	    g:=false;
	    repeat;
	  else
	    call HIDECURSOR;
	    exit
	  fi;
	fi;
      OD;
    result:=numop;
    END;
  END menu;

  (* ajout sert :                                                    *)
  (*    a creer un bicolore : inserer un element dans un arbre vide  *)
  (*    a ajouter un element dans un arbre deja cree                 *)

  (* ses parametres sont :                                           *)
  (*    en entree, l'element a inserer                               *)
  (*    en entree/sortie, la racine de l'arbre et 2 sentinelles      *)
  (*                      un booleen indiquant si au moins un ajout a ete realise *)

  UNIT ajout : PROCEDURE(x:integer;inout A,T,Z,Q:bic,adj:boolean);
  VAR P,GP,AGP : bic,  
      touche:integer;
      (* Pere,grand-pere et arriere grand-pere du pteur courant A *)
      (* Ces pointeurs servent au reequilibrage de l'arbre *)

  BEGIN
   pref IIUWGRAPH block
   BEGIN
      adj:=false;
      A:=new bic;           
      A:=T;      (* T:Tete de l'arbre ayant pour valeur 0, pour couleur blanc, *)
                 (* pour fils gauche Z et pour fils droit initial Z *) 
      Z.val:=x;  (* On affecte l'element a inserer au champ val de Z *)
      P:=new bic;
      P:=T;
      GP:=new bic;
      GP:=T;
      AGP:=new bic;

    DO
	AGP:=GP;
	GP:=P;
	P:=A;
	
	if x < A.val then   (* Descente dans l'arbre *)
	  A:=A.fg;
	else
	  A:=A.fd;
	fi;
			
	if (A.fg.rouge and A.fd.rouge) then
	  
	  if A = Z then  (* Ajout de l'element  dand une feuille *)
	    adj:=true;
	    A:=new bic;
	    A.val:=x;
	    A.fg:=Z;
	    A.fd:=Z;  
            A.rouge:=true; (* L'ajout d'un element s'effectue dans une feuille *)
                           (* qui devient un noeud rouge *) 
	    if x < P.val then
	      P.fg:=A;
	    else
	      P.fd:=A;
	    fi;
	  else
	    A.rouge:=true;     (* Inversion des couleurs *)
	    A.fg.rouge:=false;
	    A.fd.rouge:=false;
	  fi;
 
          call CLS;
            
	  if P.rouge then  (* Reequilibrage car 2 noeuds rouges consecutifs*)
	    call CLS;
            call BORDER(1);
	    call MOVE(88,16);
	    call OUTSTRING("RESULTAT INTERMEDIAIRE : "); 
	    Taff:=TT.fd; 
            call affpreordre(Taff,ZZ,0.5,1,0,0);
	    call MOVE(40,300);
	    call OUTSTRING("Tapez sur une touche pour continuer ...");
	    touche:=INCHAR;
 
            (* 8 types de rotation-raccrochage *)
	    if P.val > GP.val then   (* Rotation gauche ou droite-gauche *)
	      if A.val > P.val then
		call rg(GP);
	      else
		call rdg(GP);
	      fi;
	      if GP.val < AGP.val then
		AGP.fg:=GP;
	      else
		AGP.fd:=GP;
	      fi;
	    else
	      if A.val < P.val then  (* Rotation droite ou gauche-droite *)
		call rd(GP);
	      else
		call rgd(GP);
	      fi;
	      if GP.val < AGP.val then
		AGP.fg:=GP;
	      else
		AGP.fd:=GP;
	      fi;
	    fi;
            (* Retablissement des couleurs apres rotation *)
	    GP.rouge:=false;
	    GP.fg.rouge:=true;
	    GP.fd.rouge:=true;
            (* Retablissement de la hierarchie des ascendants *)
	    P:=GP;
	    GP:=AGP;
	    if x = P.val then
	      A:=P;  (* A renvoie l'adresse de l'element a inserer dans l'arbre *)
	    else
	      if x < P.val then
		A:=P.fg;
	      else
		A:=P.fd;
	      fi;
	    fi;
	  fi;
	fi; 
	
	if x <> A.val then  (* Poursuite de la descente car place *)
                            (* nouvel element non trouvee *)
	  repeat;
	else
	  exit;   (* L'ajout de l'element est termine *)
	fi;
    
    OD;
    T.fd.rouge:=false;  (* La racine de l'arbre est toujours blanche *)
   END;
  END ajout;

  (* recherche parcourt l'arbre et indique si l'element a rechercher *)
  (* est present ou absent de l'arbre                                *)
  (* ses parametres d'entree sont l'element a rechercher , la sentinelle Z1 *)
  (* Tr: noeud contenant l'element recherche et Pr:pere de Tr        *)
 
  UNIT recherche : FUNCTION (x:integer,Z1:bic;inout Tr,Pr:bic):boolean;
  BEGIN
    (* Parcours de l'arbre *)
    Tr:=Tr.fd;
    while Tr <> Z1 and not result
    do
      if x = Tr.val then  (* On a trouve l'element :recherche terminee positivement *)
	result:=true
      else (* On continue la recherche *)
	if x < Tr.val then    (* a gauche *)
	  Pr:=Tr;
	  Tr:=Tr.fg;
	else
	  if x > Tr.val then   (* a droite *)
	    Pr:=Tr;
	    Tr:=Tr.fd;
	  fi;
	fi;
      fi;
    od;
  END recherche;
  
  (* Suppression supprime un certain type de noeud de l'arbre *)
  (* Ses parametres d'entree sont l'element a supprimer, la sentinelle Z1 *)
  (* Tr: noeud contenant l'element a supprimer et Pr:pere de Tr           *)

  UNIT suppression :PROCEDURE(x:integer,Z1:bic;inout T,Tr,Pr:bic,adj:boolean);
  BEGIN
   pref IIUWGRAPH block
   BEGIN
    if Tr.fg = Z1 and Tr.fd = Z1 then   (*Si c'est un noeud sans fils *)
      if Tr = T.fd then  (* Si le noeud a supprimer est la racine *)
	kill(Tr);
	kill(T);
	adj:=false;      (* L'arbre devient donc vide *)
      else
	if Tr.val < Pr.val then
	  Pr.fg:=Z1;
	else
	  Pr.fd:=Z1;
	fi;
      fi;
    else
      if Tr.fg <> Z1 and Tr.fd=Z1 then (* Si c'est un noeud qui a un fils gauche *)
                                       (* Alors on remplace ce noeud par son fils*)
        if Tr=Pr.fd then  
          Pr.fd:=Tr.fg;
	  Pr.fd.rouge:=false;
	  kill(Tr);
        else
	  if Tr.val < Pr.val then
	    Pr.fg:=Tr.fg;
	    Pr.fg.rouge:=false;
	    kill(Tr);
	  else
	    Pr.fd:=Tr.fg;
	    Pr.fd.rouge:=false;
	    kill(Tr);
	  fi;
        fi;
      else                             (* Si c'est un noeud qui a un fils droit *)
                                       (* Alors on remplace ce noeud par son fils*)  
	if Tr.fg = Z1 and Tr.fd <> Z1 then
          if Tr=Pr.fd then
            Pr.fd:=Tr.fd;
	    Pr.fd.rouge:=false;
	    kill(Tr);
          else
	    if Tr.val < Pr.val then
	      Pr.fg:=Tr.fd;
	      Pr.fg.rouge:=false;
	      kill(Tr);
	    else
	      Pr.fd:=Tr.fd;
	      Pr.fd.rouge:=false;
	      kill(Tr);
            fi;
	  fi;
        else                           (* Si c'est un noeud qui a deux fils   *)
                                       (* Alors on remplace ce noeud par celui*)
                                       (* qui lui est inferieur               *)
          if (Tr.fg.fg=Z1 and Tr.fg.fd=Z1) and (Tr.fd.fg=Z1 and Tr.fd.fd=Z1) then
            if Tr.val > Pr.val then
            Pr.fd:=Tr.fg;
            else
              Pr.fg:=Tr.fg;
            fi;
            Pr.fd.rouge:=false;
            Pr.fd.fd:=Tr.fd;
            kill(Tr);
          else  (*Cas non traite: Le noeud a supprimer a des petits fils *)
            call MOVE (40,160);
            call OUTSTRING("Il est impossible de supprimer ce genre de noeuds...");
            call MOVE(40,300);
	    call OUTSTRING("Tapez sur une touche pour verification ...");
            touche:=INCHAR; 
            
          fi;
	fi;
      fi;
    fi;
   END;  
  END suppression;

  (* rd effectue une rotation a droite de l'arbre *)
  UNIT rd : PROCEDURE(inout GP:bic);
  VAR aux:bic;
  BEGIN
    aux:=new bic;
    aux:=GP.fg;
    GP.fg:=aux.fd;
    aux.fd:=GP;
    GP:=aux;
  END rd;

  (* rg effectue une rotation a gauche de l'arbre *)
  UNIT rg : PROCEDURE(inout GP:bic);
  VAR aux:bic;
  BEGIN
    aux:=new bic;
    aux:=GP.fd;
    GP.fd:=aux.fg;
    aux.fg:=GP;
    GP:=aux;
  END rg;

  (* rdg effectue une rotation droite-gauche de l'arbre *)
  UNIT rdg : PROCEDURE(inout GP:bic);
  BEGIN
    call rd(GP.fd);
    call rg(GP);
  END rdg;
  
  (* rgd effectue une rotation gauche-droite de l'arbre *)
  UNIT rgd : PROCEDURE(inout GP:bic);
  BEGIN
    call rg(GP.fg);
    call rd(GP);
  END rgd;

  (* minmax renvoie le minimum ou le maximum de l'arbre *)
  (* ses parametres d'entree sont l'arbre, la sentinelle, et le type de recherche *)
  UNIT minmax : FUNCTION(N,Z1:bic,choix:integer) : integer;
  VAR S:bic; (* Noeud contenant la valeur a renvoyer *)
  BEGIN
    (* Si on recherche le minimum (choix=0) on descend le plus a gauche possible *)
    (* Si on recherche le maximum (choix=1) on descend le plus a droite possible *)
    S:=new bic;
    N:=N.fd;
    if choix=0 then
      while N <> Z1
      do 
	S:=N;
	N:=N.fg;
      od;
    fi;
    if choix=1 then
      while N <> Z1
      do
	S:=N;
	N:=N.fd;
      od;
    fi;
    result:=S.val;
  END minmax;
  
  (* affpreordre affiche l'arbre dans un ordre prefixe *)
  UNIT affpreordre : PROCEDURE(N,Z1:bic,coefm,sup,inf:real,niveau:integer);
  VAR posx:real,posy,i,j:integer;
  BEGIN
    pref iiuwgraph BLOCK
    BEGIN
      if N <> Z1 then
	niveau:=niveau+1;
	posx:=(coefm * (sup - inf)) + inf;
	posy:= niveau * 35;
	if niveau <> 1 then
	  call DRAW(posx*640 , posy);
	fi;
        if N.rouge then
	  call COLOR(12);
        else
          call COLOR(15);
        fi;
	call MOVE(round(posx * 640),posy);
	call HASCII(0);
	call WriteInteger(N.val);
	call MOVE(INXPOS + 4,INYPOS);
	call COLOR(3);
	call MOVE(INXPOS-20,INYPOS);
	call affpreordre(N.fg,Z1,0.5,posx,inf,niveau);
	call MOVE(ROUND(posx * 640) + 8 , posy + 8);
	call affpreordre(N.fd,Z1,0.5,sup,posx,niveau);
	call MOVE(ROUND(posx * 640) + 8,posy + 8);
      fi;
    END;
  END affpreordre;

  (* menage:permet la destruction de l'objet passe en parametre *)
  UNIT menage : PROCEDURE(inout Z,N:bic);
  BEGIN
    if N.fg <> Z then
      call menage(Z,N.fg);
      kill(N.fg);
    fi;
    if N.fd <> Z then
      call menage(Z,N.fd);
      kill(N.fd);
    fi;
  END menage;
	
  (* PROGRAMME PRINCIPAL *)

  VAR rep,elt,interm:integer, (* rep:choix de l'operation a realiser *)
                              (* elt:Element entre par l'utilisateur *)
                              (* interm:reponse aux questions posees *)
      AA,ZZ,QQ,TT,Taff,Trech,Prech:bic,
                              (* AA:pointeur sur le noeud courant *)
                              (* ZZ:sentinelle sur laquelle on fait pointer tous *)
                              (* les liens qui sont a NONE *)
                              (* QQ:sentinelle pointee par ZZ et dont les liens  *)
                              (* sont a NONE *)
                              (* TT:Tete de l'arbre dont le fils droit va pointer*)
                              (* sur le premier noeud de l'arbre *)
      touche:integer,
      adjonc:boolean;
  
  BEGIN
    pref IIUWGRAPH block
    BEGIN

      call GRON(5);
      adjonc:=false;
      
      DO
        call COLOR(3);
        call BORDER(1);
	call CLS;
	rep:=menu;  (* Recuperation du choix de l'utilisateur *)
        call BORDER(3);
	CASE rep
	  
	  when 0: (* Pour quitter l'application *)
                  if adjonc then
		    call menage(ZZ,TT); (*Destruction de l'arbre*)
		    kill(TT);
		    kill(ZZ);
		    kill(QQ);
		  fi;
		  call GROFF;
		  call NewPage;
		  call Setcursor(5,20);
		  writeln("**********TERMINE**********");
		  call ENDRUN; (*Sortie de l'application*)

	  when 1: call CLS;    (* pour creer un arbre *)
		  if adjonc then
                    call COLOR(3);
		    call MOVE(40,40);
		    call OUTSTRING("ATTENTION ! : L'arbre precedemment cree va etre efface");
                    call COLOR(3);
		    call MOVE(40,56);
		    call OUTSTRING("Voulez-vous toujours creer un arbre ? Si oui, tapez 1 : ");        
		    interm:=ReadInteger;
		    if interm <> 1 then
		      repeat;
		    else
		      call menage(ZZ,TT); (*Destruction de l'arbre*)
		      kill(TT);
		      kill(ZZ);
		      kill(QQ);
		    fi;
		  fi;                                             
		  (* creation et initialisation du pointeur courant et des 2 sentinnelles *)

		  AA:=new bic;
		  ZZ:=new bic;
		  ZZ.rouge:=false;
		  ZZ.fg:=new bic;
		  ZZ.fd:=new bic;

		  QQ:=new bic;
		  QQ.rouge:=true;
		  QQ.fg:=new bic;
		  QQ.fd:=new bic;
		  QQ.fg:=NONE;
		  QQ.fd:=NONE;

		  ZZ.fg:=QQ;
		  ZZ.fd:=QQ;

		  (* creation et initialisation de la tete de l'arbre *)
		  TT:=new bic;
		  TT.rouge:=false;
		  TT.fg:=new bic;
		  TT.fd:=new bic;
		  TT.fg:=ZZ;
		  TT.fd:=ZZ;
		  
		  Trech:=new bic;
		  Prech:=new bic;
		  Taff:=new bic;
		  adjonc:=false;

                  call COLOR(3);
		  call MOVE(192,16);
		  call OUTSTRING("CREATION D'UN ARBRE BICOLORE");
		  call MOVE(40,88);
		  call OUTSTRING("Entrez le premier element de l'arbre :");
		  call MOVE(360,88);
		  elt:=ReadInteger;

                  (* On va inserer elt dans l'arbre *) 
		  call ajout(elt,AA,TT,ZZ,QQ,adjonc);
		  repeat;

	  when 2 : call CLS;   (* pour ajouter un element dans l'arbre *)
		   if adjonc then
                     call COLOR(3);
		     call MOVE(152,16);
		     call OUTSTRING("AJOUT D'UN ELEMENT DANS UN ARBRE BICOLORE");
		     call MOVE(40,88);
		     call OUTSTRING("Entrez l'element a inserer dans l'arbre :");
		     call MOVE(376,88);
		     elt:=ReadInteger;

                     (* Test de presence de l'element dans l'arbre *)
		     Trech:=TT;
		     if recherche(elt,ZZ,Trech,Prech) then 
                       call COLOR(3);
		       call MOVE(160,120);
		       call OUTSTRING("ATTENTION !   AJOUT IMPOSSIBLE !!!");
		       call MOVE(40,136);
		       call WriteInteger(elt);
		       call OUTSTRING(" est deja present dans l'arbre ! ");
		       call MOVE(40,152);
		       call OUTSTRING("Tapez sur une touche pour verification...");
		       touche:=INCHAR;
		       call CLS;
                       call BORDER(1);
		       call MOVE(88,16);
		       call OUTSTRING("VERIFICATION");
                       
                       (* Affichage de l'arbre *)
		       Taff:=TT.fd;
		       call affpreordre(Taff,ZZ,0.5,1,0,0);
		       call MOVE(40,300);
		       call OUTSTRING("Tapez sur une touche pour retourner au menu ...");
		       touche:=INCHAR;
		     else
		       call ajout(elt,AA,TT,ZZ,QQ,adjonc);
		       call CLS;
                       call BORDER(1);
		       call MOVE(88,16);
		       call OUTSTRING("RESULTAT : "); 
		       Taff:=TT.fd; 
		       call affpreordre(Taff,ZZ,0.5,1,0,0);
		       call MOVE(40,300);
		       call OUTSTRING("Tapez sur une touche pour retourner au menu ...");
		       touche:=INCHAR; 
		     fi;
		     repeat;
		   else
		     call MOVE(350,40);
		     call OUTSTRING("ATTENTION !");
		     call MOVE(40,64);
		     call OUTSTRING("Ajout impossible car arbre inexistant !");
		     call MOVE(40,80);
		     call OUTSTRING("Retour au menu pour creer un arbre ? Si oui, tapez 1 : ");
		     call MOVE(488,80);
		     interm:=ReadInteger;
		     if interm=1 then
		       repeat;
		     else
		       if adjonc then
			 call menage(ZZ,TT); (*Destruction de l'arbre*)
			 kill(TT);
			 kill(ZZ);
			 kill(QQ);
		       fi;
		       call MOVE(160,160);
		       call OUTSTRING("**********TERMINE**********");
		       CALL GROFF;
		       call ENDRUN;
		     fi;
		   fi;

	  when 3 : call CLS;   (* pour chercher un element dans l'arbre *)
		   if adjonc then
                     call COLOR(3);
		     call MOVE(128,16);
		     call OUTSTRING("RECHERCHE D'UN ELEMENT DANS UN ARBRE BICOLORE");
		     call MOVE(40,88);
		     call OUTSTRING("Entrez l'element a rechercher dans l'arbre :");
		     call MOVE(400,88);
		     elt:=ReadInteger;
		     Trech:=TT;
		     if not recherche(elt,ZZ,Trech,Prech) then
		       call CLS;
		       call MOVE(40,136);
		       call WriteInteger(elt);
		       call OUTSTRING(" est absent de l'arbre !!");
		       call MOVE(40,152);
		       call OUTSTRING("Tapez sur une touche pour verification...");
		       touche:=INCHAR;
		       call CLS;
                       call BORDER(1);
		       call MOVE(88,16);
		       call OUTSTRING("VERIFICATION");
		       Taff:=TT.fd;
		       call affpreordre(Taff,ZZ,0.5,1,0,0);
		       call MOVE(40,300);
		       call OUTSTRING("Tapez sur une touche pour retourner au menu ...");
		       touche:=INCHAR;
		     else
		       call MOVE(40,136);
		       call WriteInteger(elt);
		       call OUTSTRING(" est present dans l'arbre");
		       call MOVE(40,152);
		       call OUTSTRING("Tapez sur une touche pour verification...");
		       touche:=INCHAR;
		       call CLS;
                       call BORDER(1);
		       call MOVE(88,16);
		       call OUTSTRING("VERIFICATION : "); 
		       Taff:=TT.fd; 
		       call affpreordre(Taff,ZZ,0.5,1,0,0);
		       call MOVE(40,300);
		       call OUTSTRING("Tapez sur une touche pour retourner au menu ...");
		       touche:=INCHAR; 
		     fi;
		     repeat;
		   else
		     call MOVE(160,120);
		     call OUTSTRING("ATTENTION !");
		     call MOVE(40,136);
		     call OUTSTRING("Recherche impossible car arbre inexistant !");
		     call MOVE(40,152);
		     call OUTSTRING("Retour au menu pour creer un arbre ? Si oui, tapez 1 : ");
		     call MOVE(496,152);
		     interm:=ReadInteger;
		     if interm=1 then
		       repeat;
		     else
		       if adjonc then
			 call menage(ZZ,TT); (*Destruction de l'arbre*)
			 kill(TT);
			 kill(ZZ);
			 kill(QQ);
		       fi;
		       call MOVE(160,160);
		       call OUTSTRING("**********TERMINE**********");
		       call GROFF;
		       call ENDRUN;
		     fi;
		   fi;
		    
	  when 4 : call CLS;   (* pour trouver le minimum de l'arbre *)
		   if adjonc then
		     call MOVE(128,16);
		     call OUTSTRING("RECHERCHE DU MINIMUM DANS UN ARBRE BICOLORE");
		     call MOVE(40,136);
		     call OUTSTRING("Voici le minimum de l'arbre bicolore :");
		     call MOVE(360,136);
		     call WriteInteger(minmax(TT,ZZ,0));
                     call MOVE(40,300);
		     call OUTSTRING("Tapez sur une touche pour retourner au menu ...");
		     touche:=INCHAR;
		     repeat;
		   else
		     call MOVE(160,120);
		     call OUTSTRING("ATTENTION !");
		     call MOVE(40,144);
		     call OUTSTRING("Recherche du minimum impossible car arbre inexistant !");
		     call MOVE(40,160);
		     call OUTSTRING("Retour au menu pour creer un arbre ? Si oui, tapez 1 : ");
		     call MOVE(488,160);
		     interm:=ReadInteger;                    
		     if interm=1 then
		       repeat;
		     else
		       if adjonc then
			 call menage(ZZ,TT); (*Destruction de l'arbre*)
			 kill(TT);
			 kill(ZZ);
			 kill(QQ);
		       fi;
		       call MOVE(160,160);
		       call OUTSTRING("**********TERMINE**********");
		       call GROFF;
		       call ENDRUN;
		     fi;
		   fi;

	  when 5 : call CLS;   (* pour trouver le maximum de l'arbre *)
		   if adjonc then
		     call MOVE(128,16);
		     call OUTSTRING("RECHERCHE DU MAXIMUM DANS UN ARBRE BICOLORE");
		     call MOVE(40,136);
		     call OUTSTRING("Voici le maximum de l'arbre bicolore :");
		     call MOVE(360,136);
		     call WriteInteger(minmax(TT,ZZ,1));
		     call MOVE(40,300);
		     call OUTSTRING("Tapez sur une touche pour retourner au menu ...");
		     touche:=INCHAR;
		     repeat;
		   else
		     call MOVE(24,40);
		     call OUTSTRING("ATTENTION !");
		     call MOVE(40,40);
		     call OUTSTRING("Recherche du maximum impossible car arbre inexistant !");
		     call MOVE(56,40);
		     call OUTSTRING("Retour au menu pour creer un arbre ? Si oui, tapez 1 : ");
		     call MOVE(56,488);
		     interm:=ReadInteger;
		     if interm=1 then
		       repeat;
		     else
		       if adjonc then
			 call menage(ZZ,TT); (*Destruction de l'arbre*)
			 kill(TT);
			 kill(ZZ);
			 kill(QQ);
		       fi;
		       call MOVE(160,160);
		       call OUTSTRING("**********TERMINE**********");
		       call GROFF;
		       call ENDRUN;
		     fi;
		   fi;

	  when 6 : call CLS;   (* pour chercher le(s) successeur(s) d'un element*)
		   if adjonc then 
                     call COLOR(3);
		     call MOVE(136,16);
		     call OUTSTRING("RECHERCHE DE(S) SUCCESSEUR(S) D'UN ELEMENT");
		     call MOVE(40,88);
		     call OUTSTRING("Entrez l'element dont vous voulez le(s) successeur(s) :");
		     call MOVE(496,88);
		     elt:=ReadInteger;
		     Trech:=TT;
		     if not recherche(elt,ZZ,Trech,Prech) then
		       call CLS;
		       call MOVE(40,136);
		       call WriteInteger(elt);
		       call OUTSTRING(" est absent de l'arbre !!");
		       call MOVE(40,152);
		       call OUTSTRING("Tapez sur une touche pour verification...");
		       touche:=INCHAR;
		       call CLS;
                       call BORDER(1);
		       call MOVE(88,16);
		       call OUTSTRING("VERIFICATION : ");
		       Taff:=TT.fd;
		       call affpreordre(Taff,ZZ,0.5,1,0,0);
		       call MOVE(40,300);
		       call OUTSTRING("Tapez sur une touche pour retourner au menu ...");
		       touche:=INCHAR;
		     else
		       call CLS;
		       call MOVE(40,40);
		       if Trech.fg <> ZZ and Trech.fd <> ZZ then
			 call OUTSTRING("Le(s) successeurs de ");
			 call WriteInteger(elt);
			 call OUTSTRING(" sont : ");
			 call WriteInteger(Trech.fg.val);
			 call OUTSTRING(" et ");
			 call WriteInteger(Trech.fd.val);
		       else
			 if Trech.fg <> ZZ then
			   call OUTSTRING("Le successeur gauche de ");
			   call WriteInteger(elt);
			   call OUTSTRING(" est : ");
			   call WriteInteger(Trech.fg.val);
			 else
			   if Trech.fd <> ZZ then
			     call OUTSTRING("Le successeur droit de ");
			     call WriteInteger(elt);
			     call OUTSTRING("est : ");
			     call WriteInteger(Trech.fd.val);
			   else
			     call OUTSTRING("L'element ");
			     call WriteInteger(elt);
			     call OUTSTRING(" n'a aucun successeur !");
			   fi;
			 fi;
		       fi;
                       call BORDER(1);
		       call MOVE(40,152);
		       call OUTSTRING("Tapez sur une touche pour verification...");
		       touche:=INCHAR;
		       call CLS;
                       call BORDER(1);
		       call MOVE(112,16);
		       call OUTSTRING("VERIFICATION : "); 
		       Taff:=TT.fd; 
		       call affpreordre(Taff,ZZ,0.5,1,0,0);
		       call MOVE(40,300);
		       call OUTSTRING("Tapez sur une touche pour retourner au menu ...");
		       touche:=INCHAR; 
		     fi;
		     repeat;
		   else
                     call COLOR(3);
		     call MOVE(350,40);
		     call OUTSTRING("ATTENTION !");
		     call MOVE(40,64); 
		     call OUTSTRING("Recherche impossible car arbre inexistant !");
		     call MOVE(40,80);
		     call OUTSTRING("Retour au menu pour creer un arbre ? Si oui, tapez 1 : ");
		     call MOVE(488,80);
		     interm:=ReadInteger;
		     if interm=1 then
		       repeat;
		     else
		       if adjonc then
			 call menage(ZZ,TT); (*Destruction de l'arbre*)
			 kill(TT);
			 kill(ZZ);
			 kill(QQ);
		       fi;
		       call MOVE(160,160);
		       call OUTSTRING("**********TERMINE**********");
		       call GROFF;
		       call ENDRUN;
		     fi;
		   fi;
		    
	  
	  when 7 : call CLS;   (* pour chercher le predecesseur d'un element*)
		   if adjonc then
                     call COLOR(3);
		     call MOVE(136,16);
		     call OUTSTRING("RECHERCHE DU PREDECESSEUR D'UN ELEMENT");
		     call MOVE(40,88);
		     call OUTSTRING("Entrez l'element dont vous voulez le predecesseur :");
		     call MOVE(456,88);
		     elt:=ReadInteger;
		     Trech:=TT;
		     if not recherche(elt,ZZ,Trech,Prech) then
		       call CLS;
		       call MOVE(40,136);
		       call WriteInteger(elt);
		       call OUTSTRING(" est absent de l'arbre !!");
		       call MOVE(40,152);
		       call OUTSTRING("Tapez sur une touche pour verification...");
		       touche:=INCHAR;
		       call CLS;
                       call BORDER(1);
		       call MOVE(88,16);
		       call OUTSTRING("VERIFICATION : ");
		       Taff:=TT.fd;
		       call affpreordre(Taff,ZZ,0.5,1,0,0);
		       call MOVE(40,300);
		       call OUTSTRING("Tapez sur une touche pour retourner au menu ...");
		       touche:=INCHAR;
		       repeat;
		     else
		       call CLS;
		       call MOVE(40,40);
		       if Trech = TT.fd then
			 call OUTSTRING("L'element ");
			 call WriteInteger(elt);
			 call OUTSTRING(" n'a pas de predecesseur ! ");
		       else
			 call OUTSTRING("Le predecesseur de ");
			 call WriteInteger(elt);
			 call OUTSTRING(" est : ");
			 call WriteInteger(Prech.val);
		       fi;
		     fi;
                     call BORDER(1);
		     call MOVE(40,152);
		     call OUTSTRING("Tapez sur une touche pour verification...");
		     touche:=INCHAR;
		     call CLS;
		     call MOVE(88,16);
		     call OUTSTRING("VERIFICATION : "); 
		     Taff:=TT.fd; 
		     call affpreordre(Taff,ZZ,0.5,1,0,0);
		     call MOVE(40,300);
		     call OUTSTRING("Tapez sur une touche pour retourner au menu ...");
		     touche:=INCHAR; 
		     repeat;
		   
		   else
                     call COLOR(3);
		     call MOVE(350,40);
		     call OUTSTRING("ATTENTION !");
		     call MOVE(40,64);
		     call OUTSTRING("Recherche impossible car arbre inexistant !");
		     call MOVE(40,80);
		     call OUTSTRING("Retour au menu pour creer un arbre ? Si oui, tapez 1 : ");
		     call MOVE(488,80);
		     interm:=ReadInteger;
		     if interm=1 then
		       repeat;
		     else
		       if adjonc then
			 call menage(ZZ,TT); (*Destruction de l'arbre*)
			 kill(TT);
			 kill(ZZ);
			 kill(QQ);
		       fi;
		       call MOVE(160,160);
		       call OUTSTRING("**********TERMINE**********");
		       call GROFF;
		       call ENDRUN;
		     fi;
		   fi;
		    
	  when 8 : call CLS;   (* pour supprimer un element*)
		   if adjonc then
		     call MOVE(152,16);
		     call OUTSTRING("SUPPRESSION D'UN ELEMENT");
		     call MOVE(40,88);
		     call OUTSTRING("Entrez l'element a supprimer :");
		     call MOVE(280,88);
		     elt:=ReadInteger;
		     Trech:=TT;
                     Prech:=TT;
		     if not recherche(elt,ZZ,Trech,Prech) then
		       call CLS;
		       call MOVE(40,136);
		       call WriteInteger(elt);
		       call OUTSTRING(" est absent de l'arbre donc suppression impossible !!");
		       call MOVE(40,152);
		       call OUTSTRING("Tapez sur une touche pour verification...");
		       touche:=INCHAR;
		     else
		       call suppression(elt,ZZ,TT,Trech,Prech,adjonc);
		       if not adjonc then
			 kill(ZZ);
			 kill(QQ);
			 call CLS;
			 call MOVE(350,40);
			 call OUTSTRING("Arbre detruit !!!");
			 call MOVE(40,200);
			 call OUTSTRING("Tapez sur une touche pour retourner au menu ...");
			 touche:=INCHAR;
			 repeat;
		       fi;
		     fi;
                     call CLS;
                     call BORDER(1);
		     call MOVE(88,16);
		     call OUTSTRING("VERIFICATION "); 
		     Taff:=TT.fd; 
		     call affpreordre(Taff,ZZ,0.5,1,0,0);
		     call MOVE(40,300);
		     call OUTSTRING("Tapez sur une touche pour retourner au menu ...");
		     touche:=INCHAR; 
		     repeat;
		   else
		     call MOVE(350,40);
		     call OUTSTRING("ATTENTION !");
		     call MOVE(40,64);
		     call OUTSTRING("Suppression impossible car arbre inexistant !");
		     call MOVE(40,80);
		     call OUTSTRING("Retour au menu pour creer un arbre ? Si oui, tapez 1 : ");
		     call MOVE(488,80);
		     interm:=ReadInteger;
		     if interm=1 then
		       repeat;
		     else
		       if adjonc then
			 call menage(ZZ,TT); (*Destruction de l'arbre*)
			 kill(TT);
			 kill(ZZ);
			 kill(QQ);
		       fi;
		       call MOVE(160,160);
		       call OUTSTRING("**********TERMINE**********");
		       call GROFF;
		       call ENDRUN;
		     fi;
		   fi;
				   
	  when 9 : call CLS;   (* pour afficher le contenu de l'arbre *)
                   call BORDER(1);
                   call COLOR(3);
		   call MOVE(192,16);
		   if adjonc then
		     call OUTSTRING("AFFICHAGE DE L'ARBRE BICOLORE");
		     call MOVE(180,32);
		     Taff:=TT.fd; 
		     call affpreordre(Taff,ZZ,0.5,1,0,0);
		   else
		     call OUTSTRING("ARBRE VIDE !!!!");
		   fi;
		   call MOVE(40,300);
                   (*call COLOR(7);*)
		   call OUTSTRING("Tapez sur une touche pour retourner au menu ...");
		   touche:=INCHAR; 
		   repeat;

	  otherwise
		   call CLS;   (* gestion des operations inexistantes *)
		   call MOVE(350,40);
		   call OUTSTRING("Option inexistante !!");
		   call MOVE(40,152);
		   call OUTSTRING("Voulez-vous retourner au menu ? Si oui, tapez 1 : ");
		   call MOVE(440,152);
		   interm:=ReadInteger;
		   if interm=1 then
		     repeat;
		   else
		     if adjonc then
		       call menage(ZZ,TT); (*Destruction de l'arbre*)
		       kill(TT);
		       kill(ZZ);
		       kill(QQ);
		     fi;
		     call MOVE(160,1600);
		     call OUTSTRING("**********TERMINE**********");
		     call GROFF;
		     call ENDRUN;
		   fi;
	ESAC;                                                           
      OD;
    END;
END BICOLORE.