2 (*******************************************************************)
\r
3 (* OUTILS CONCERNANT L'AFFICHAGE DU TEXTE A L'ECRAN *)
\r
4 (*******************************************************************)
\r
5 UNIT gest_ecran:CLASS;
\r
7 (* Efface l'ecran et positionne le curseur en haut a gauche *)
\r
8 UNIT cls : PROCEDURE;
\r
10 WRITE( chr(27), "[2J");
\r
14 (* Affiche du texte en video inverse *)
\r
15 UNIT Reverse : PROCEDURE;
\r
17 WRITE( chr(27), "[7m");
\r
21 (* Affiche le texte de maniere normale *)
\r
22 UNIT Normal : PROCEDURE;
\r
24 WRITE( chr(27), "[0m")
\r
28 UNIT Setcursor : PROCEDURE (row,column : INTEGER);
\r
41 Write(chr(27), "[",c,d, ";",e,f, "H");
\r
44 (* unite qui sert a tracer un cadre *)
\r
46 UNIT cadre: PROCEDURE (x1,y1,x2,y2 : integer);
\r
47 var i , j : integer;
\r
49 for i := x1 to x2 do
\r
50 CALL setcursor(i,y1);
\r
53 for i := x1 to x2 do
\r
54 CALL setcursor(i,y2);
\r
57 for i := y1 to y2 do
\r
58 CALL setcursor(x1,i);
\r
61 for i := y1 to y2 do
\r
62 CALL setcursor(x2,i);
\r
69 (**************************** CADRE_T **********************************************)
\r
70 UNIT cadre_t:gest_ecran PROCEDURE;
\r
73 CALL cadre (1,1,22,80);
\r
74 CALL cadre (1,1,3,80);
\r
75 CALL setcursor (2,32);
\r
77 write (" GESTION DE BIBLIOTHEQUE ");
\r
82 (*************************** PRESENTS_1*********************************************)
\r
83 UNIT presents_1:gest_ecran PROCEDURE;
\r
86 CALL setcursor (10,32);
\r
88 write (" PROJET REALISE PAR : ");
\r
89 CALL setcursor (12,32);
\r
90 Write (" BOURGEAT - MANDONNAUD ");
\r
91 CALL setcursor(14,32);
\r
92 Write (" LICENCE INFORMATIQUE ");
\r
96 (****************************** chaine *****************)
\r
100 VAR ch : arrayof char;
\r
102 UNIT lit : PROCEDURE;
\r
108 WHILE i<=long AND car=/=chr(10)
\r
116 UNIT afi:PROCEDURE;
\r
127 UNIT inff:FUNCTION(c2:chaine):boolean;
\r
133 WHILE ch(i)=c2.ch(i)
\r
136 IF i=long THEN exit; FI;
\r
138 result:=ord(ch(i))<ord(c2.ch(i));
\r
140 WHILE ch(i)=c2.ch(i)
\r
143 IF i=c2.long THEN exit FI;
\r
145 IF ord(ch(i))<ord(c2.ch(i))
\r
146 THEN result:=i<c2.long
\r
147 ELSE result:=false
\r
152 UNIT eqq:FUNCTION(c2:chaine):boolean;
\r
158 WHILE ord(ch(i)) = ord(c2.ch(i))
\r
161 IF i=long THEN exit FI;
\r
163 result:=ch(i)=c2.ch(i);
\r
169 UNIT copyy : PROCEDURE(xx : chaine);
\r
182 ARRAY ch DIM (1:long);
\r
190 (********************************** ELEMENT *****************************************)
\r
191 UNIT element:CLASS;
\r
194 UNIT sup:FUNCTION(e2:element):boolean;
\r
196 result:=NOT (e.inff(e2.e)) AND NOT (e.eqq(e2.e));
\r
199 UNIT inf:FUNCTION(e2:element):boolean;
\r
201 result:=e.inff(e2.e);
\r
204 UNIT eq:FUNCTION(e2:element):boolean;
\r
206 result:=e.eqq(e2.e);
\r
209 UNIT lire : PROCEDURE;
\r
214 UNIT VIRTUAL affich : PROCEDURE;
\r
221 (************************ article ***************************)
\r
223 UNIT article:element CLASS;
\r
227 UNIT VIRTUAL affich:PROCEDURE;
\r
236 c(i) := new chaine;
\r
240 (******************* LISTE ***********************)
\r
242 UNIT liste : CLASS;
\r
245 UNIT noeud : CLASS;
\r
249 clen := new chaine;
\r
252 UNIT insert : PROCEDURE(cle : chaine);
\r
253 VAR nd,ndaux : noeud;
\r
256 call nd.clen.copyy(cle);
\r
263 debut.suivant:=ndaux;
\r
267 UNIT suppr : PROCEDURE(cle : chaine);
\r
268 VAR nd,ndaux:noeud;
\r
270 IF debut.clen.eqq(cle)
\r
272 debut:=debut.suivant;
\r
276 WHILE NOT(nd.clen.eqq(cle))
\r
280 IF nd=none THEN EXIT FI;
\r
282 IF nd<>none THEN ndaux:=nd.suivant FI;
\r
286 UNIT affi:PROCEDURE;
\r
294 write("reference :");write(i); write(" ");
\r
302 (********************************** index_elem **********************************)
\r
303 UNIT index_elem : element CLASS;
\r
305 UNIT sup:FUNCTION(e2:element):boolean;
\r
307 result:=NOT (e.inff(e2.e)) AND NOT (e.eqq(e2.e));
\r
310 UNIT inf:FUNCTION(e2:element):boolean;
\r
312 result:=e.inff(e2.e);
\r
315 UNIT eq:FUNCTION(e2:element):boolean;
\r
317 result:=e.eqq(e2.e);
\r
320 UNIT VIRTUAL affich : PROCEDURE ;
\r
329 (*********************** item ***************************************)
\r
339 (************************************** PAGE *****************************************)
\r
341 UNIT page : CLASS(n:integer);
\r
346 BEGIN (* creation de la page *)
\r
347 array e dim(1:n*2);
\r
348 for m:=1 to n*2 do e(m):=new item; od;
\r
353 (************************************** B_ARB ******************************************)
\r
354 UNIT Barb :gest_ecran CLASS(n : integer);
\r
358 UNIT Search : PROCEDURE(input x:element,a:page; inout h:boolean,v:item);
\r
363 UNIT insert : PROCEDURE;
\r
364 VAR i:integer, b:page;
\r
367 a.m:=a.m+1; h:=FALSE;
\r
368 for i:=a.m downto (r+2)
\r
379 for i:=n downto (r+2)
\r
394 b.e(i):=a.e(i+n+1);
\r
419 (* writeln(" "); *)
\r
420 IF NOT x.sup(a.e(k).key) THEN r:=k-1; FI;
\r
421 IF NOT x.inf(a.e(k).key) THEN l:=k+1; FI;
\r
422 IF r<l THEN exit; FI;
\r
424 IF l-r>1 THEN h:=FALSE;
\r
425 CALL setcursor(33,20);
\r
426 WRITE ("Element deja dans l'arbre!");
\r
428 IF r=0 THEN q:=a.p0 ELSE q:=a.e(r).ptr; FI;
\r
429 CALL Search(x,q,h,u);
\r
430 IF h THEN CALL insert; FI;
\r
436 UNIT Inserer : PROCEDURE (newe : element);
\r
442 CALL Search(newe,ROOT,h,u);
\r
446 ROOT.m:=1; ROOT.p0:=pgaux; ROOT.e(1):=u;
\r
454 UNIT delete :PROCEDURE(INPUT x:element, a:page; INOUT h:boolean);
\r
455 VAR i,k,l,r : INTEGER,
\r
458 UNIT underflow : PROCEDURE(INPUT c,a: page, s:integer; INOUT h:boolean);
\r
460 i,k,mb,mc: integer;
\r
463 IF s<mc THEN (* b <-- page qui se trouve a droite de a *)
\r
466 mb:=b.m; k:=(mb-n+1) DIV 2;
\r
467 (* k= Nombre d'elements disponibles sur la page b *)
\r
471 IF k>0 THEN (* Deplacer k elements de b vers a *)
\r
472 FOR i:=1 TO k-1 DO a.e(i+n):=b.e(i) OD; i:=i-1;
\r
477 FOR i:=1 TO mb DO b.e(i):=b.e(i+k) OD; i:=i-1;
\r
481 ELSE (* Il faut fusionner a et b *)
\r
482 FOR i:=1 TO n DO a.e(i+n):=b.e(i) OD; i:=i-1;
\r
483 FOR i:=s TO mc-1 DO c.e(i):=c.e(i+1) OD; i:=i-1;
\r
484 a.m:=2*n; c.m:=mc-1;
\r
485 h:=c.m<n; (*kill(b);*)
\r
487 ELSE (* b <-- page qui se trouve a gauche de a *)
\r
488 IF s=1 THEN b:=c.p0 ELSE b:=c.e(s-1).ptr FI;
\r
491 IF k>0 THEN (* Deplacer k elements de b vers a *)
\r
492 FOR i:=n-1 DOWNTO 1 DO a.e(i+k):=a.e(i) OD; i:=i+1;
\r
496 FOR i:=k-1 DOWNTO 1 DO a.e(i):=b.e(i+mb) OD; i:=i+1;
\r
500 b.m:=mb-1; a.m:=n-1+k; h:=FALSE;
\r
501 ELSE (* Il faut fusionner a et b *)
\r
504 FOR i:=1 TO n-1 DO b.e(i+mb):=a.e(i) OD; i:=i-1;
\r
505 b.m:=2*n; c.m:=mc-1; h:=(c.m<n);
\r
510 UNIT del : PROCEDURE(p:page; INOUT h:boolean);
\r
517 IF h THEN CALL underflow(p,q,p.m,h);FI;
\r
519 p.e(p.m).ptr:=a.e(k).ptr;
\r
528 WRITELN("L'element n'est pas dans l'arbre");
\r
532 DO (* recherche binaire dans la page a *)
\r
534 IF NOT x.sup(a.e(k).key) THEN r:=k-1; FI;
\r
535 IF NOT x.inf(a.e(k).key) THEN l:=k+1; FI;
\r
536 IF (l>r) THEN exit; FI;
\r
538 IF r=0 THEN q:=a.p0 ELSE q:=a.e(r).ptr FI;
\r
540 IF q=none THEN (* a est une feuille *)
\r
543 FOR i:=k TO a.m DO a.e(i):=a.e(i+1); OD; i:=i-1;
\r
546 IF h THEN CALL underflow(a,q,r,h); FI;
\r
549 CALL delete(x,q,h);
\r
550 IF h THEN CALL underflow(a,q,r,h); FI;
\r
556 UNIT supprimer : PROCEDURE(newe:element);
\r
560 CALL delete(newe,ROOT,h);
\r
563 pgaux:=root; root:=pgaux.p0; (* kill(pgaux); *)
\r
568 (*************************************** MEMBER ****************************************************)
\r
570 UNIT Member : FUNCTION(inout ele:element):boolean;
\r
571 VAR existe:boolean,
\r
575 UNIT Rech_page:FUNCTION(p:page) : integer;
\r
580 IF ele.eq(p.e(i).key) THEN exit; FI;
\r
581 IF ele.inf(p.e(i).key) THEN
\r
586 if i>p.m then i:=i-1; fi;
\r
594 IF (paux=none OR existe) THEN exit; FI;
\r
595 k:= Rech_page(paux);
\r
596 IF k=0 THEN paux:=paux.p0;
\r
598 IF paux.e(k).key.eq(ele) THEN
\r
600 ele:= paux.e(k).key;
\r
602 paux:=paux.e(k).ptr;
\r
610 (********************************************* MIN ****************************************************)
\r
612 UNIT Min : FUNCTION(p:page): element;
\r
617 result:=p.e(1).key; exit;
\r
625 (********************************************* MAX ****************************************************)
\r
626 UNIT Max : FUNCTION(p:page): element;
\r
630 IF p.e(p.m).ptr=none THEN
\r
631 result:=p.e(p.m).key; exit;
\r
639 (********************************************* LIST ****************************************************)
\r
640 UNIT List : PROCEDURE(p:page;inout ligne,colonne : integer);
\r
648 colonne := colonne + 10;
\r
652 IF (p.p0=none) THEN
\r
654 CALL setcursor(ligne,colonne);
\r
655 CALL p.e(1).key.Affich;
\r
656 ligne := ligne + 1;
\r
659 ligne := ligne + 1;
\r
660 CALL list(p.p0,ligne,colonne);
\r
661 CALL setcursor(ligne,colonne);
\r
662 CALL p.e(1).key.Affich;
\r
667 IF p.e(i).ptr=none THEN
\r
669 CALL setcursor(ligne,colonne);
\r
670 CALL p.e(i+1).key.Affich;
\r
674 ligne := ligne + 1;
\r
675 CALL List(p.e(i).ptr,ligne,colonne);
\r
677 CALL setcursor(ligne,colonne);
\r
678 CALL p.e(i+1).key.Affich;
\r
679 (* ligne := ligne + 1; *)
\r
686 (****************************************** ERASE ******************************************************)
\r
688 UNIT Erase : PROCEDURE(p:page);
\r
692 IF (p.p0=none) THEN
\r
693 IF (p.m>0) THEN Kill(p.e(1).key); fi;
\r
701 IF p.e(i).ptr=none THEN
\r
703 Kill(p.e(i+1).key);
\r
706 CALL Erase(p.e(i).ptr);
\r
709 Kill(p.e(i+1).key);
\r
718 BEGIN (* DEBUT BARB *)
\r
723 (**************************************************)
\r
724 (**************************************************)
\r
725 (**************************************************)
\r
730 UNIT finn :gest_ecran PROCEDURE;
\r
732 CALL setcursor(18,50);
\r
733 write("menu pr
\82c
\82dent taper RC : ");
\r
737 UNIT menu :gest_ecran PROCEDURE;
\r
746 CALL cadre(1,1,24,80);
\r
747 CALL setcursor(1,30);
\r
749 write("menu principal");
\r
750 CALL setcursor(10,30);
\r
751 write("1 : Inserer un livre");
\r
752 CALL SETCURSOR(12,30);
\r
753 WRITE("2 : supprimer un livre");
\r
754 CALL SETCURSOR(14,30);
\r
755 WRITE("3 : recherche");
\r
756 CALL SETCURSOR(16,30);
\r
757 WRITE("4 : liste");
\r
759 CALL SETCURSOR(18,30);
\r
763 CALL setcursor(18,50);
\r
766 when 1 : CALL insertlivre;
\r
767 when 2 : CALL supprilivre;
\r
768 when 3 : CALL recherche;
\r
769 when 4 : CALL llist;
\r
775 UNIT insertlivre :gest_ecran PROCEDURE;
\r
776 VAR x,xret : article,
\r
777 xmatiere,xm,xauteur,xa : index_elem;
\r
780 CALL cadre(1,1,22,80);
\r
781 CALL setcursor(1,30);
\r
783 write("inserer un livre");
\r
787 xmatiere := new index_elem;
\r
788 xauteur := new index_elem;
\r
790 CALL setcursor(10,15);
\r
791 write("titre : ..............................");
\r
792 CALL setcursor(10,27);
\r
794 CALL SETCURSOR(12,15);
\r
795 WRITE("auteur : ..............................");
\r
796 CALL setcursor(12,27);
\r
797 CALL xauteur.e.lit;
\r
798 CALL SETCURSOR(14,15);
\r
799 WRITE("matiere : ..............................");
\r
800 CALL setcursor(14,27);
\r
801 CALL xmatiere.e.lit;
\r
803 CALL x.c(1).copyy(xauteur.e);
\r
804 CALL x.c(2).copyy(xmatiere.e);
\r
806 IF bfiche.member(x)
\r
808 write("existe deja");
\r
810 IF bmatiere.member(xmatiere)
\r
812 CALL xmatiere.lis.insert(x.e);
\r
814 CALL bmatiere.inserer(xmatiere);
\r
815 CALL xmatiere.lis.insert(x.e);
\r
818 IF bauteur.member(xauteur)
\r
820 CALL xauteur.lis.insert(x.e);
\r
822 CALL xauteur.lis.insert(x.e);
\r
823 CALL bauteur.inserer(xauteur);
\r
825 CALL bfiche.inserer(x);
\r
833 UNIT supprilivre :gest_ecran PROCEDURE;
\r
835 xauteur,xa,xmatiere,xm:index_elem;
\r
838 CALL cadre(1,1,22,80);
\r
839 CALL setcursor(1,30);
\r
841 write("supprimer un livre");
\r
844 xmatiere:=new index_elem;
\r
845 xauteur:=new index_elem;
\r
847 CALL setcursor(10,15);
\r
848 write("titre : ..............................");
\r
849 CALL setcursor(10,27);
\r
851 CALL SETCURSOR(12,15);
\r
852 WRITE("auteur : ..............................");
\r
853 CALL setcursor(12,27);
\r
854 CALL xauteur.e.lit;
\r
855 CALL SETCURSOR(14,15);
\r
856 WRITE("matiere : ..............................");
\r
857 CALL setcursor(14,27);
\r
858 CALL xmatiere.e.lit;
\r
860 CALL bfiche.supprimer(x);
\r
862 IF bmatiere.member(xmatiere)
\r
864 CALL xmatiere.lis.suppr(x.e);
\r
865 IF xmatiere.lis.debut=none THEN CALL bmatiere.supprimer(xmatiere) FI;
\r
868 IF bauteur.member(xauteur)
\r
870 CALL xauteur.lis.suppr(x.e);
\r
871 IF xauteur.lis.debut=none THEN CALL bauteur.supprimer(xauteur) FI;
\r
874 CALL setcursor(18,50);
\r
878 UNIT recherche :gest_ecran PROCEDURE;
\r
888 xx := new index_elem;
\r
891 CALL setcursor(2,30);
\r
892 write("recherche");
\r
895 CALL setcursor(10,15);
\r
896 write("titre : 1");
\r
897 CALL SETCURSOR(12,15);
\r
898 WRITE("auteur : 2");
\r
899 CALL SETCURSOR(14,15);
\r
900 WRITE("matiere : 3");
\r
901 CALL SETCURSOR(16,15);
\r
902 WRITE("quel champ de recherche ");readln(i);
\r
903 CALL SETCURSOR(18,15);
\r
904 write("..............................");
\r
905 CALL SETCURSOR(18,15);
\r
910 reponse := bfiche.member(x);
\r
912 CALL setcursor(4,30);
\r
914 write(" RECHERCHE OUVRAGE ");
\r
918 CALL setcursor(10,15);
\r
920 CALL setcursor(10,30);
\r
922 CALL SETCURSOR(12,15);
\r
923 WRITE("auteur : ");
\r
924 CALL setcursor(12,30);
\r
926 CALL SETCURSOR(14,15);
\r
927 WRITE("matiere : ");
\r
928 CALL SETCURSOR(14,30);
\r
932 CALL setcursor(10,15);
\r
933 write("element inexistant");
\r
937 CALL setcursor(4,30);
\r
939 write(" RECHERCHE AUTEUR ");
\r
941 CALL xx.e.copyy(c);
\r
942 reponse := bauteur.member(xx);
\r
945 CALL setcursor(5,10);
\r
950 CALL setcursor(10,15);
\r
951 write("introuvable");
\r
955 CALL setcursor(4,30);
\r
957 write(" RECHERCHE MATIERE ");
\r
959 CALL xx.e.copyy(c);
\r
960 reponse := bmatiere.member(xx);
\r
962 CALL cadre(1,1,22,80);
\r
965 CALL setcursor(5,10);
\r
968 (* CALL setcursor(1,2); *)
\r
971 CALL setcursor(10,15);
\r
972 write("introuvable");
\r
980 UNIT llist :gest_ecran PROCEDURE;
\r
988 CALL setcursor(2,30);
\r
989 write("recherche");
\r
992 CALL setcursor(10,15);
\r
993 write("titre : 1");
\r
994 CALL SETCURSOR(12,15);
\r
995 WRITE("auteur : 2");
\r
996 CALL SETCURSOR(14,15);
\r
997 WRITE("matiere : 3");
\r
998 CALL SETCURSOR(16,15);
\r
999 WRITE("quel champ de liste ");readln(i);
\r
1003 CALL setcursor(2,30);
\r
1005 write(" liste des ouvrages ");
\r
1009 CALL bfiche.list(bfiche.root,lig,col);
\r
1010 CALL setcursor(18,50);
\r
1014 CALL setcursor(2,30);
\r
1016 write(" liste des auteurs ");
\r
1020 CALL bauteur.list(bauteur.root,lig,col);
\r
1024 CALL setcursor(4,30);
\r
1026 write(" liste des matiere ");
\r
1030 CALL bmatiere.list(bmatiere.root,lig,col);
\r
1038 bfiche,bmatiere,bauteur : barb;
\r
1043 bmatiere := new barb(2);
\r
1044 bauteur := new barb(2);
\r
1045 bfiche := new barb(2);
\r