PROGRAM BD;
	(*******************************************************************)
	(*      OUTILS CONCERNANT L'AFFICHAGE DU TEXTE A L'ECRAN           *)
	(*******************************************************************)
      UNIT gest_ecran:CLASS;

	 (*  Efface l'ecran et positionne le curseur en haut a gauche       *)
	UNIT cls : PROCEDURE;
	BEGIN
		WRITE( chr(27), "[2J");
	END CLS;


	 (*  Affiche du texte en video inverse                          *)
	UNIT Reverse : PROCEDURE;
	BEGIN
		WRITE( chr(27), "[7m");
	END Reverse;


	(*  Affiche le texte de maniere normale                            *)
	UNIT Normal : PROCEDURE;
	BEGIN
		WRITE( chr(27), "[0m")
	END Normal;


	UNIT Setcursor : PROCEDURE (row,column : 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;

   (*  unite qui sert a tracer un cadre *)

       UNIT cadre: PROCEDURE (x1,y1,x2,y2 : integer);
       var i , j : integer;
       BEGIN
	   for i := x1 to x2 do
	       CALL setcursor(i,y1);
	       write("*");
	   od;
	   for i := x1 to x2 do
	      CALL setcursor(i,y2);
	      write ("*");
	   od;
	   for i := y1 to y2 do
	      CALL setcursor(x1,i);
	      write ("*");
	   od;
	  for i := y1 to y2 do
	      CALL setcursor(x2,i);
	      write ("*");
	  od;
       END cadre;

     END gest_ecran;

  (**************************** CADRE_T **********************************************)
  UNIT cadre_t:gest_ecran PROCEDURE;
  BEGIN
	CALL cls;
	CALL cadre (1,1,22,80);
	CALL cadre (1,1,3,80);
	CALL setcursor (2,32);
	CALL reverse;
	write (" GESTION DE BIBLIOTHEQUE ");
	CALL normal;
  END cadre_t;


  (*************************** PRESENTS_1*********************************************)
  UNIT presents_1:gest_ecran PROCEDURE;
  BEGIN
	CALL cadre_t;
	CALL setcursor (10,32);
	CALL reverse;
	write (" PROJET REALISE PAR : ");
	CALL setcursor (12,32);
	Write (" BOURGEAT - MANDONNAUD ");
	CALL setcursor(14,32);
	Write (" LICENCE INFORMATIQUE ");
	CALL normal;
  END presents_1;
  
  (****************************** chaine *****************)

  UNIT chaine:CLASS;
  VAR long:integer;
  VAR ch : arrayof char;

    UNIT lit : PROCEDURE;
    VAR i:integer,
	 car:char;
    BEGIN
      i:=1;
      read(car);
      WHILE i<=long AND car=/=chr(10)
      DO
	ch(i):=car;
	read(car);
	i:=i+1;
      OD;
    END lit;

    UNIT afi:PROCEDURE;
    VAR i:integer;
    BEGIN
      i:=1;
      FOR i:=1 TO long
      DO
	write(ch(i));
      OD;
      writeln;
    END afi;

    UNIT inff:FUNCTION(c2:chaine):boolean;
    VAR i:integer;
    BEGIN
      i:=1;
      IF long<=c2.long
      THEN
	WHILE ch(i)=c2.ch(i)
	DO
	  i:=i+1;
	  IF i=long THEN exit; FI;
	OD;
	result:=ord(ch(i))<ord(c2.ch(i));
      ELSE
	WHILE ch(i)=c2.ch(i)
	DO 
	  i:=i+1;
	  IF i=c2.long THEN exit FI;
	OD;
	IF ord(ch(i))<ord(c2.ch(i)) 
	THEN result:=i<c2.long 
	ELSE result:=false 
	FI;
      FI;
    END inff;

    UNIT eqq:FUNCTION(c2:chaine):boolean;
    VAR  i:integer;
    BEGIN
      i := 1;
      IF long=c2.long
      THEN
	WHILE ord(ch(i)) = ord(c2.ch(i))
	DO
	  i := i + 1;
	  IF i=long THEN exit FI;
	OD;
	result:=ch(i)=c2.ch(i);
      ELSE
	result:=FALSE;
      FI;
    END eqq;

    UNIT copyy : PROCEDURE(xx : chaine);
    VAR i:integer;
    BEGIN
      i:=1;
      WHILE i<long
      DO
	ch(i):= xx.ch(i);
	i:=i+1;
      OD;
    END copyy;

  BEGIN
    long:=30;
    ARRAY ch DIM (1:long);
  END chaine;






(********************************** ELEMENT *****************************************)
  UNIT element:CLASS;
  VAR e:chaine;

    UNIT sup:FUNCTION(e2:element):boolean;
    BEGIN
      result:=NOT (e.inff(e2.e)) AND NOT (e.eqq(e2.e));
    END sup;

    UNIT inf:FUNCTION(e2:element):boolean;
    BEGIN
      result:=e.inff(e2.e);
    END inf;

    UNIT eq:FUNCTION(e2:element):boolean;
    BEGIN
      result:=e.eqq(e2.e);
    END eq;

    UNIT lire : PROCEDURE;
    BEGIN
      CALL e.lit;
    END lire;

    UNIT VIRTUAL affich : PROCEDURE;
    END affich;

  BEGIN
    e:=new chaine;
  END element;

 (************************ article ***************************)

  UNIT article:element CLASS;
  VAR i:integer,
      c:arrayof chaine;

    UNIT VIRTUAL affich:PROCEDURE;
    BEGIN
      CALL  e.afi;
    END affich;

  BEGIN
    ARRAY c DIM (1:2);
    for i := 1 to 2
    do
      c(i) := new chaine;
    od;
  END article;

 (******************* LISTE ***********************)

  UNIT liste : CLASS;
  VAR debut: noeud;

    UNIT noeud : CLASS;
    VAR clen   : chaine,
	suivant: noeud;
    BEGIN
      clen := new chaine;
    END noeud;

    UNIT insert : PROCEDURE(cle : chaine);
    VAR nd,ndaux : noeud;
    BEGIN
      nd:=new noeud;
      call nd.clen.copyy(cle);
      IF debut=none
      THEN
	debut:=nd;
      ELSE
	ndaux:=debut;
	debut:=nd;
	debut.suivant:=ndaux;
      FI;
    END insert;

    UNIT suppr : PROCEDURE(cle : chaine);
    VAR nd,ndaux:noeud;
    BEGIN
      IF debut.clen.eqq(cle)
      THEN
	debut:=debut.suivant;
      ELSE
	ndaux:=debut;
	nd:=ndaux.suivant;
	WHILE NOT(nd.clen.eqq(cle))
	DO
	  ndaux:=nd;
	  nd:=nd.suivant;
	  IF nd=none THEN EXIT FI;
	OD;
	IF nd<>none THEN ndaux:=nd.suivant FI;
      FI;  
     END suppr;

    UNIT affi:PROCEDURE;
    VAR i:integer,
	nd:noeud;
    BEGIN
      nd:=debut;
      i:=1;
      WHILE nd =/= none
      DO
	write("reference :");write(i); write(" ");
	CALL nd.clen.afi;
	i := i + 1;
	nd:=nd.suivant;
      OD;
    END affi;
  END liste;

 (********************************** index_elem **********************************)
  UNIT index_elem : element CLASS;
  VAR lis : liste;
    UNIT sup:FUNCTION(e2:element):boolean;
    BEGIN
      result:=NOT (e.inff(e2.e)) AND NOT (e.eqq(e2.e));
    END sup;

    UNIT inf:FUNCTION(e2:element):boolean;
    BEGIN
      result:=e.inff(e2.e);
    END inf;

    UNIT eq:FUNCTION(e2:element):boolean;
    BEGIN
      result:=e.eqq(e2.e);
    END eq;

    UNIT VIRTUAL affich : PROCEDURE ;
    BEGIN
      CALL e.afi;
    END affich;

  BEGIN
      lis := new liste;
  END index_elem;

  (*********************** item ***************************************)

  UNIT item : CLASS;
  VAR key:element,
      ptr:page;
  BEGIN
    key:=new element;
  END item;


(************************************** PAGE *****************************************)

  UNIT page : CLASS(n:integer);
  VAR m :  integer,
      p0:  page,
      e :  arrayof item;

  BEGIN   (* creation de la page *)
    array e dim(1:n*2);
    for m:=1 to n*2 do e(m):=new item; od;
  END page;



(************************************** B_ARB ******************************************)
UNIT Barb :gest_ecran CLASS(n : integer);

VAR ROOT:page;

	UNIT Search : PROCEDURE(input x:element,a:page; inout h:boolean,v:item);
		VAR k,l,r:integer,
			 q:page,
			 u:item;

		UNIT insert : PROCEDURE;
		VAR i:integer, b:page;
		BEGIN
			IF a.m<(n*2) THEN
			  a.m:=a.m+1; h:=FALSE;
			  for i:=a.m downto (r+2)
			  do
				  a.e(i):=a.e(i-1);
			  od;
			  a.e(r+1):=u;
			ELSE
			  b:=new page(n);
			  IF r<=n THEN
				  IF r=n THEN v:=u;
				  ELSE
					  v:=a.e(n);
					  for i:=n downto (r+2)
					  do
						  a.e(i):=a.e(i-1);
					  od;
					  a.e(r+1):=u;
				  FI;
				  for i:=1 to n
				  do
					  b.e(i):=a.e(i+n);
				  od;
			  ELSE
				  r:=r-n;
				  v:=a.e(n+1);
				  for i:=1 to (r-1)
				  do
					  b.e(i):=a.e(i+n+1);
				  od;
				  b.e(r):=u;
				  for i:=r+1 to n
				  do
					  b.e(i):=a.e(i+n);
				  od;
			  FI;
			  a.m:=n;
			  b.m:=n;
			  b.p0:=v.ptr;
			  v.ptr:=b;
			FI;
		END insert;

	BEGIN (* Search *)
		u:=new item;
	 IF a=none THEN
		h:=TRUE;
		v.key:=x;
		v.ptr:=none;
	 ELSE
		l:=1; r:=a.m;
		DO
			k:=(l+r) div 2;
			(* writeln(" "); *)
			IF NOT x.sup(a.e(k).key) THEN r:=k-1; FI;
			IF NOT x.inf(a.e(k).key) THEN l:=k+1; FI;
			IF r<l THEN exit; FI;
		OD;
		IF l-r>1 THEN h:=FALSE;
			  CALL setcursor(33,20);
			  WRITE ("Element deja dans l'arbre!");
		ELSE
			IF r=0 THEN q:=a.p0 ELSE q:=a.e(r).ptr; FI;
			CALL Search(x,q,h,u);
			IF h THEN CALL insert; FI;
		FI;
	 FI;
	END Search;


	UNIT Inserer : PROCEDURE (newe : element);
	VAR h:boolean,
			pgaux:page,
			u:item;
	BEGIN
	  u:=new item;
	  CALL Search(newe,ROOT,h,u);
	  IF h THEN
		  pgaux:=ROOT;
		  ROOT:=new page(n);
		  ROOT.m:=1; ROOT.p0:=pgaux; ROOT.e(1):=u;
	  FI;
	END Inserer;





	UNIT delete :PROCEDURE(INPUT x:element, a:page; INOUT h:boolean);
	 VAR i,k,l,r : INTEGER,
		  q:page;

	 UNIT underflow : PROCEDURE(INPUT c,a: page, s:integer;  INOUT h:boolean);
	 VAR  b: page,
			i,k,mb,mc: integer;
	 BEGIN
		 mc:=c.m;
		 IF s<mc THEN   (* b <-- page qui se trouve a droite de a *)
			 s:=s+1;
			 b:=c.e(s).ptr;
			 mb:=b.m; k:=(mb-n+1) DIV 2;
				(* k= Nombre d'elements disponibles sur la page b *)
			 a.e(n):=c.e(s);
			 a.e(n).ptr:=b.p0;

			 IF k>0 THEN  (* Deplacer k elements de b vers a *)
				 FOR i:=1 TO k-1 DO a.e(i+n):=b.e(i) OD; i:=i-1;
				 c.e(s):=b.e(k);
				 b.p0:=b.e(k).ptr;
				 c.e(s).ptr:=b;
				 mb:=mb-k;
				 FOR i:=1 TO mb DO b.e(i):=b.e(i+k) OD;  i:=i-1;
				 b.m:=mb;
				 a.m:=n-1+k;
				 h:=FALSE;
			 ELSE   (* Il faut fusionner a et b *)
				 FOR i:=1 TO n DO a.e(i+n):=b.e(i) OD;  i:=i-1;
				 FOR i:=s TO mc-1 DO c.e(i):=c.e(i+1) OD;   i:=i-1;
				 a.m:=2*n; c.m:=mc-1;
				 h:=c.m<n; (*kill(b);*)
			 FI;
		 ELSE           (* b <-- page qui se trouve a gauche de a *)
			 IF s=1 THEN b:=c.p0 ELSE b:=c.e(s-1).ptr FI;
			 mb:=b.m+1;
			 k:=(mb-n) DIV 2;
			 IF k>0 THEN   (* Deplacer k elements de b vers a *)
				 FOR i:=n-1 DOWNTO 1 DO a.e(i+k):=a.e(i) OD; i:=i+1;
				 a.e(k):=c.e(s);
				 a.e(k).ptr:=a.p0;
				 mb:=mb-k;
				 FOR i:=k-1 DOWNTO 1 DO a.e(i):=b.e(i+mb) OD; i:=i+1;
				 a.p0:=b.e(mb).ptr;
				 c.e(s):=b.e(mb);
				 c.e(s).ptr:=a;
				 b.m:=mb-1; a.m:=n-1+k; h:=FALSE;
			 ELSE   (* Il faut fusionner a et b *)
				 b.e(mb):=c.e(s);
				 b.e(mb).ptr:=a.p0;
				 FOR i:=1 TO n-1 DO b.e(i+mb):=a.e(i) OD; i:=i-1;
				 b.m:=2*n; c.m:=mc-1; h:=(c.m<n);
			 FI;
		 FI;
	 END underflow;

	 UNIT del : PROCEDURE(p:page; INOUT h:boolean);
		 VAR q:page;
	 BEGIN
		 q:=p.e(p.m).ptr;
		 IF q<>none THEN
			 CALL del(q,h);

			 IF h THEN CALL underflow(p,q,p.m,h);FI;
		 ELSE
			 p.e(p.m).ptr:=a.e(k).ptr;
			 a.e(k):=p.e(p.m);
			 p.m:=p.m-1;
			 h:=(p.m<n);
		 FI;
	 END del;

 BEGIN
	 IF a=none THEN
		 WRITELN("L'element n'est pas dans l'arbre");
		 h:=FALSE;
	 ELSE
		 l:=1; r:=a.m;
		 DO   (* recherche binaire dans la page a *)
			 k:=(l+r) div 2;
			 IF NOT x.sup(a.e(k).key) THEN r:=k-1; FI;
			 IF NOT x.inf(a.e(k).key) THEN l:=k+1; FI;
			 IF (l>r) THEN exit; FI;
		 OD;
		 IF r=0 THEN q:=a.p0 ELSE q:=a.e(r).ptr FI;
		 IF l-r >1 THEN
			 IF q=none THEN  (* a est une feuille *)
				 a.m:=a.m-1;
				 h:=(a.m<n);
				 FOR i:=k TO a.m DO a.e(i):=a.e(i+1); OD; i:=i-1;
			 ELSE
				 CALL del (q,h);
				 IF h THEN CALL underflow(a,q,r,h); FI;
			 FI;
		 ELSE
			 CALL delete(x,q,h);
			 IF h THEN CALL underflow(a,q,r,h); FI;
		 FI;
	 FI;
 END delete;


 UNIT supprimer : PROCEDURE(newe:element);
 VAR h:boolean,
	  pgaux:page;
 BEGIN
	 CALL delete(newe,ROOT,h);
	 IF h THEN
		 IF root.m=0 THEN
			 pgaux:=root; root:=pgaux.p0; (* kill(pgaux); *)
		 FI;
	 FI;
 END supprimer;

(*************************************** MEMBER ****************************************************)

 UNIT Member : FUNCTION(inout ele:element):boolean;
	VAR existe:boolean,
		 k:integer,
		 paux:page;

	UNIT Rech_page:FUNCTION(p:page) : integer;
		VAR i:integer;
	BEGIN
		FOR i:=1 TO p.m
		DO
			IF ele.eq(p.e(i).key) THEN exit; FI;
			IF ele.inf(p.e(i).key) THEN
				i:=i-1;
				exit;
			FI;
		OD;
		if i>p.m then i:=i-1; fi;
		result:=i;
	END Rech_page;

 BEGIN
	existe:=FALSE;
	paux:=root;
	DO
		IF (paux=none OR existe) THEN exit; FI;
		k:= Rech_page(paux);
		IF k=0 THEN paux:=paux.p0;
		ELSE
			IF paux.e(k).key.eq(ele) THEN
				existe:=TRUE;
				ele:= paux.e(k).key;
			ELSE
				paux:=paux.e(k).ptr;
			FI;
		FI;
	OD;
	result:=existe;
 END Member;


(********************************************* MIN ****************************************************)

 UNIT Min : FUNCTION(p:page): element;
 BEGIN
	IF p<>none THEN
	 DO
		IF p.p0=none THEN
			result:=p.e(1).key; exit;
		ELSE
			p:=p.p0;
		FI;
	 OD;
   FI;
 END Min;

(********************************************* MAX ****************************************************)
 UNIT Max : FUNCTION(p:page): element;
 BEGIN
	IF p<>none THEN
	 DO
		IF p.e(p.m).ptr=none THEN
			result:=p.e(p.m).key; exit;
		ELSE
			p:=p.e(p.m).ptr;
		FI;
	 OD;
	FI;
 END Max;

(********************************************* LIST ****************************************************)
 UNIT List : PROCEDURE(p:page;inout ligne,colonne : integer);
 var
      i   :  integer;

 BEGIN

 IF ligne = 24  THEN
    ligne := 8;
    colonne := colonne + 10;
 FI;

 IF P<>none THEN
	 IF (p.p0=none) THEN
		IF (p.m>0) THEN
		  CALL setcursor(ligne,colonne);
		  CALL p.e(1).key.Affich;
		  ligne := ligne + 1;
		fi;
	 ELSE
		ligne := ligne + 1;
		CALL list(p.p0,ligne,colonne);
		CALL setcursor(ligne,colonne);
		CALL p.e(1).key.Affich;

	 FI;
		FOR i:=1 TO p.m
		DO
		  IF p.e(i).ptr=none THEN
			 IF i<p.m THEN
			  CALL setcursor(ligne,colonne);
			  CALL p.e(i+1).key.Affich;
			  ligne := ligne +1;
			 FI;
		  ELSE
			  ligne := ligne + 1;
			  CALL List(p.e(i).ptr,ligne,colonne);
			  IF i<p.m THEN
				CALL setcursor(ligne,colonne);
				CALL p.e(i+1).key.Affich;
				(* ligne := ligne + 1; *)
			  FI;
		  FI;
		OD;
  FI;
 END List;

(****************************************** ERASE ******************************************************)

UNIT Erase : PROCEDURE(p:page);
	 var i:integer;
 BEGIN
 IF P<>none THEN
	 IF (p.p0=none) THEN
		IF (p.m>0) THEN Kill(p.e(1).key); fi;
	 ELSE
		CALL Erase(p.p0);
		Kill(p.p0);
		Kill(p.e(1).key);
	 FI;
		FOR i:=1 TO p.m
		DO
		  IF p.e(i).ptr=none THEN
			 IF i<p.m THEN
			  Kill(p.e(i+1).key);
			 FI;
		  ELSE
			  CALL Erase(p.e(i).ptr);
			  Kill(p.e(i).ptr);
			  IF i<p.m THEN
				Kill(p.e(i+1).key);
			  FI;
		  FI;
		  Kill(p.e(i));
		OD;
  FI;
 END Erase;


BEGIN (* DEBUT BARB *)
	 ROOT:=none;
END Barb;


(**************************************************)
(**************************************************)
(**************************************************)




    UNIT finn :gest_ecran PROCEDURE;
    BEGIN
	 CALL setcursor(18,50);
	 write("menu pr‚c‚dent taper RC : ");
	 readln;
    END finn;

    UNIT menu :gest_ecran PROCEDURE;

    var
       ii : integer;
    BEGIN
      CALL presents_1;
      CALL finn;
      do
	 CALL cls;
	 CALL cadre(1,1,24,80);
	 CALL setcursor(1,30);
	 CALL reverse;
	 write("menu principal");
	 CALL setcursor(10,30);
	 write("1   :  Inserer un livre");
	 CALL SETCURSOR(12,30);
	 WRITE("2   :  supprimer un livre");
	 CALL SETCURSOR(14,30);
	 WRITE("3   :  recherche");
	 CALL SETCURSOR(16,30);
	 WRITE("4   :  liste");

	 CALL SETCURSOR(18,30);
	 WRITE("10  :  fin");

	 CALL normal;
	 CALL setcursor(18,50);
	 readln(ii);
	 case ii
	      when 1 : CALL insertlivre;
	      when 2 : CALL supprilivre;
	      when 3 : CALL recherche;
	      when 4 : CALL llist;
	      when 10 : exit;
	 esac;
      od;
    END menu;

    UNIT insertlivre :gest_ecran PROCEDURE;
    VAR x,xret : article,
	xmatiere,xm,xauteur,xa : index_elem;
    BEGIN
      CALL cls;
      CALL cadre(1,1,22,80);
      CALL setcursor(1,30);
      CALL reverse;
      write("inserer un livre");
      CALL normal;

      x := new article;
      xmatiere := new index_elem;
      xauteur := new index_elem;

      CALL setcursor(10,15);
      write("titre     : ..............................");
      CALL setcursor(10,27);
      CALL x.e.lit;
      CALL SETCURSOR(12,15);
      WRITE("auteur    : ..............................");
      CALL setcursor(12,27);
      CALL xauteur.e.lit;
      CALL SETCURSOR(14,15);
      WRITE("matiere   : ..............................");
      CALL setcursor(14,27);
      CALL xmatiere.e.lit;

      CALL x.c(1).copyy(xauteur.e);
      CALL x.c(2).copyy(xmatiere.e);

      IF bfiche.member(x)
      THEN
	write("existe deja");
      ELSE
	IF bmatiere.member(xmatiere)
	THEN
	  CALL xmatiere.lis.insert(x.e);
	ELSE
	  CALL bmatiere.inserer(xmatiere);
	  CALL xmatiere.lis.insert(x.e);
	FI;
	  
	IF bauteur.member(xauteur) 
	THEN
	  CALL xauteur.lis.insert(x.e);
	ELSE
	  CALL xauteur.lis.insert(x.e);
	  CALL bauteur.inserer(xauteur);
	FI;
	CALL bfiche.inserer(x);
      
      FI;
      CALL finn;

    END insertlivre;


    UNIT supprilivre :gest_ecran PROCEDURE;
    VAR x : article,
	xauteur,xa,xmatiere,xm:index_elem;
    BEGIN
      CALL cls;
      CALL cadre(1,1,22,80);
      CALL setcursor(1,30);
      CALL reverse;
      write("supprimer un livre");
      CALL normal;
      x:=new article;
      xmatiere:=new index_elem;
      xauteur:=new index_elem;

      CALL setcursor(10,15);
      write("titre     : ..............................");
      CALL setcursor(10,27);
      CALL x.e.lit;
      CALL SETCURSOR(12,15);
      WRITE("auteur    : ..............................");
      CALL setcursor(12,27);
      CALL xauteur.e.lit;
      CALL SETCURSOR(14,15);
      WRITE("matiere   : ..............................");
      CALL setcursor(14,27);
      CALL xmatiere.e.lit;

      CALL bfiche.supprimer(x);

      IF bmatiere.member(xmatiere)
      THEN
	CALL xmatiere.lis.suppr(x.e);
	IF xmatiere.lis.debut=none THEN CALL bmatiere.supprimer(xmatiere) FI;
      FI;

      IF bauteur.member(xauteur)
      THEN
	CALL xauteur.lis.suppr(x.e);
	IF xauteur.lis.debut=none THEN CALL bauteur.supprimer(xauteur) FI;
      FI;

      CALL setcursor(18,50);
      CALL finn;
    END supprilivre;

    UNIT recherche :gest_ecran PROCEDURE;
    var
       i : integer,
       x : article,
       xx : index_elem,
       reponse : boolean,
       c : chaine;
    BEGIN
	 c := new chaine;
	 x := new article;
	 xx := new index_elem;
	 CALL cadre_t;
	 CALL reverse;
	 CALL setcursor(2,30);
	 write("recherche");
	 CALL normal;

	 CALL setcursor(10,15);
	 write("titre     : 1");
	 CALL SETCURSOR(12,15);
	 WRITE("auteur    : 2");
	 CALL SETCURSOR(14,15);
	 WRITE("matiere   : 3");
	 CALL SETCURSOR(16,15);
	 WRITE("quel champ de recherche  ");readln(i);
	 CALL SETCURSOR(18,15);
	 write("..............................");
	 CALL SETCURSOR(18,15);
	 CALL c.lit;
	 case i
	      when 1 :
		   CALL x.e.copyy(c);
		   reponse := bfiche.member(x);
		   CALL cadre_t;
		   CALL setcursor(4,30);
		   CALL reverse;
		   write("     RECHERCHE OUVRAGE       ");
		   IF reponse 
		   THEN
		     CALL normal;
		     CALL setcursor(10,15);
		     write("titre   : ");
		     CALL setcursor(10,30);
		     CALL x.e.afi;
		     CALL SETCURSOR(12,15);
		     WRITE("auteur  : ");
		     CALL setcursor(12,30);
		     CALL x.c(1).afi;
		     CALL SETCURSOR(14,15);
		     WRITE("matiere : ");
		     CALL SETCURSOR(14,30);
		     CALL x.c(2).afi;
		   ELSE
		     CALL normal;
		     CALL setcursor(10,15);
		     write("element inexistant");
		   FI;
	      when 2 :
		   CALL cadre_t;
		   CALL setcursor(4,30);
		   CALL reverse;
		   write("     RECHERCHE AUTEUR      ");
		   CALL normal;
		   CALL xx.e.copyy(c);
		   reponse := bauteur.member(xx);
		   if reponse then
		      CALL reverse;
		      CALL setcursor(5,10);
		      CALL xx.e.afi;
		      CALL normal;
		      CALL xx.lis.affi;
		   else
		     CALL setcursor(10,15);
		     write("introuvable");
		   fi;
	      when 3 :
		   CALL cadre_t;
		   CALL setcursor(4,30);
		   CALL reverse;
		   write("     RECHERCHE MATIERE    ");
		   CALL normal;
		   CALL xx.e.copyy(c);
		   reponse := bmatiere.member(xx);
		   CALL cls;
		   CALL cadre(1,1,22,80);
		   if reponse then
		      CALL reverse;
		      CALL setcursor(5,10);
		      CALL xx.e.afi;
		      CALL normal;
		     (* CALL setcursor(1,2); *)
		      CALL xx.lis.affi;
		    else
		      CALL setcursor(10,15);
			write("introuvable");
		    fi;
	      esac;
	 CALL finn;

    END recherche;


    UNIT llist :gest_ecran PROCEDURE;
    var
       i,fin : integer,
       lig,col : integer;
    BEGIN

	 CALL cadre_t;
	 CALL reverse;
	 CALL setcursor(2,30);
	 write("recherche");
	 CALL normal;

	 CALL setcursor(10,15);
	 write("titre     : 1");
	 CALL SETCURSOR(12,15);
	 WRITE("auteur    : 2");
	 CALL SETCURSOR(14,15);
	 WRITE("matiere   : 3");
	 CALL SETCURSOR(16,15);
	 WRITE("quel champ de liste ");readln(i);
	 case i
	      when 1 :
		CALL cadre_t;
		CALL setcursor(2,30);
		CALL reverse;
		write("          liste des ouvrages          ");
		CALL normal;
		lig := 4;
		col := 2;
		CALL bfiche.list(bfiche.root,lig,col);
		CALL setcursor(18,50);
		CALL finn;
	      when 2:
		CALL cadre_t;
		CALL setcursor(2,30);
		CALL reverse;
		write("             liste des auteurs             ");
		CALL normal;
		lig := 4;
		col := 2;
		CALL bauteur.list(bauteur.root,lig,col);
		CALL finn;
	     when 3 :
		CALL cadre_t;
		CALL setcursor(4,30);
		CALL reverse;
		write("              liste des matiere          ");
		CALL normal;
		lig := 4;
		col := 2;
		CALL bmatiere.list(bmatiere.root,lig,col);
		CALL finn;
	     esac;
    END llist;


var

   bfiche,bmatiere,bauteur : barb;



BEGIN
    bmatiere := new barb(2);
    bauteur := new barb(2);
    bfiche := new barb(2);
    CALL menu;

END;