examples/database/sgbd.log

   1 PROGRAM BIBLIOTHEQUE;\r
   2 \r
   3 SIGNAL Del_Rec_Inexistant, Key_AlReady_In_Index,\r
   4         TreeHeight_Overflow, Signal11, Signal12, Signal14;\r
   5  \r
   6 (*-------------------------------------------------*)\r
   7 (* MODULE de GESTION des FICHIERS de l'application *)\r
   8 (*-------------------------------------------------*)\r
   9 UNIT FileSystem: CLASS;\r
  10  \r
  11   (*-----------------------------------------------------------*)\r
  12   (* CLASSE representant la FILE des FICHIERS de l'application *)\r
  13   (*-----------------------------------------------------------*)\r
  14   UNIT RFile: CLASS;\r
  15     VAR Name: ARRAYOF CHAR,\r
  16         Opened: BOOLEAN,\r
  17         RecLen, Position,\r
  18         Length: INTEGER,\r
  19         Fichier: file,\r
  20         Next, Prev: RFile\r
  21   END RFile;\r
  22  \r
  23   VAR System: RFile; (* FICHIER manipule lors des differentes operations *)\r
  24  \r
  25   (*-----------------------------------------------------------*)\r
  26   (* RECHERCHE d'un FICHIER dans les FICHIERS de l'APPLICATION *)\r
  27   (*-----------------------------------------------------------*)\r
  28   UNIT FindInSystem : FUNCTION(Name:ARRAYOF CHAR): RFile;\r
  29  \r
  30      (*-------------------------------------------*)\r
  31      (* COMPARAISON de deux CHAINES de caracteres *)\r
  32      (*-------------------------------------------*)\r
  33      UNIT EqualString: FUNCTION(chaine1, chaine2: ARRAYOF CHAR):BOOLEAN;\r
  34      VAR i1, i2, len, i: INTEGER;\r
  35      BEGIN\r
  36        IF (chaine1 = NONE) OR (chaine2 = NONE)\r
  37          THEN writeln("Un parametre est egal a NONE dans EqualString");\r
  38               CALL ENDRUN (* ARRET du programme *)\r
  39        FI;\r
  40        i1 := LOWER(chaine1); i2 := LOWER(chaine2);\r
  41        len := UPPER(chaine1) - i1 + 1;\r
  42        IF len =/= UPPER(chaine2) - i2 + 1\r
  43          THEN RETURN (* Chaines de longueurs differentes *)\r
  44        FI;\r
  45        FOR i := 1 TO len\r
  46        DO\r
  47          IF chaine1(i1)  =/= chaine2(i2)\r
  48            THEN RETURN (* Chaines differentes *)\r
  49          FI;\r
  50          i1 := i1 + 1; i2 := i2 + 1\r
  51        OD;\r
  52        (* Si on arrive la les chaines sont egales *)\r
  53        RESULT := TRUE\r
  54      END EqualString;\r
  55  \r
  56   VAR df :RFile;\r
  57  \r
  58   BEGIN\r
  59     System.Name := Name;\r
  60     df := System.Next;\r
  61     WHILE NOT EqualString(Name,df.Name)\r
  62     DO\r
  63       df := df.Next\r
  64     OD;\r
  65     IF (df = System)\r
  66       THEN RESULT := NONE\r
  67       ELSE RESULT := df\r
  68     FI;\r
  69   END FindInSystem;\r
  70  \r
  71   (*-------------------------------------------*)\r
  72   (* AJOUT d'un Fichier a la FILE des FICHIERS *)\r
  73   (*-------------------------------------------*)\r
  74   UNIT AddToSystem: FUNCTION(Name: ARRAYOF CHAR): RFile;\r
  75   BEGIN\r
  76     RESULT := NEW RFile;\r
  77     RESULT.Name := Name;\r
  78     RESULT.Next := System.Next;\r
  79     RESULT.Prev := System;\r
  80     System.Next.Prev := RESULT;\r
  81     System.Next := RESULT;\r
  82   END AddToSystem;\r
  83  \r
  84   (*----------------------------------------------*)\r
  85   (* SUPPRIMER un FICHIER de la FILE des FICHIERS *)\r
  86   (*----------------------------------------------*)\r
  87   UNIT DeleteFromSystem: PROCEDURE(df:RFile);\r
  88   BEGIN\r
  89     IF df = System\r
  90       THEN RETURN\r
  91     FI;\r
  92     df.Next.Prev := df.Prev;\r
  93     df.Prev.Next := df.Next\r
  94   END DeleteFromSystem;\r
  95  \r
  96   (*-------------------------------------------------------------------------*)\r
  97   (* CALCUL de la LONGUEUR d'un Fichier exprime en nombres d'enregistrements *)\r
  98   (*-------------------------------------------------------------------------*)\r
  99   UNIT FindFileLength: FUNCTION(df :file, RecLen :INTEGER) :INTEGER;\r
 100   VAR record: ARRAYOF INTEGER, i:INTEGER;\r
 101   BEGIN\r
 102     IF df = NONE\r
 103       THEN writeln("ERREUR FindFileLength : Fichier inexistant");\r
 104            RETURN;\r
 105     FI;\r
 106     RESULT := 1;\r
 107     CALL RESET(df);\r
 108     ARRAY record DIM (1:RecLen);\r
 109     i := RecLen*INTSIZE;\r
 110     DO\r
 111       GETREC(df,record,i);\r
 112       IF i =/= RecLen*INTSIZE\r
 113         THEN EXIT\r
 114       FI;\r
 115       RESULT := RESULT + 1;\r
 116     OD;\r
 117   END FindFileLength;\r
 118  \r
 119  \r
 120   (*-----------------------------------------------------------------------*)\r
 121   (* CREATION d'un nouveau FICHIER et insertion de ce Fichier dans la FILE *)\r
 122   (* le Fichier est ouvert est sa longueur est egal a 1                    *)\r
 123   (*-----------------------------------------------------------------------*)\r
 124   UNIT MakeFile: FUNCTION(Name: ARRAYOF CHAR, RecLen: INTEGER): RFile;\r
 125   BEGIN\r
 126     IF FindInSystem(Name) =/= NONE\r
 127       THEN writeln("ERREUR MakeFile : Fichier existant");\r
 128     FI;\r
 129     IF RecLen <= 0\r
 130       THEN writeln("ERREUR MakeFile : Longueur de Fichier doit etre positive");\r
 131     FI;\r
 132     RESULT := AddToSystem(Name);\r
 133     RESULT.Opened := TRUE;\r
 134     RESULT.RecLen := RecLen;\r
 135     RESULT.Position := 1;\r
 136     RESULT.Length := 1;\r
 137     OPEN(RESULT.Fichier, direct, Name);\r
 138     CALL REWRITE(RESULT.Fichier);\r
 139   END MakeFile;\r
 140  \r
 141   (*------------------------------------------------------------------*)\r
 142   (* OUVRIR un Fichier deja present dans la FILE des FICHIERS         *)\r
 143   (*  ou AJOUT de ce FICHIER a la FILE si il n'y est pas.             *)\r
 144   (*------------------------------------------------------------------*)\r
 145   UNIT OpenFile: FUNCTION(Name: ARRAYOF CHAR, RecLen: INTEGER): RFile;\r
 146   BEGIN\r
 147     IF RecLen <= 0\r
 148       THEN writeln("ERREUR OpenFile : La longueur d'enregistrement doit etre\r
 149                     positive");\r
 150     FI;\r
 151     RESULT := FindInSystem(Name);\r
 152     IF RESULT = NONE\r
 153       THEN RESULT := AddToSystem(Name)\r
 154     FI;\r
 155     RESULT.Opened := TRUE;\r
 156     RESULT.RecLen := RecLen;\r
 157     RESULT.Position := 1;\r
 158     OPEN(RESULT.Fichier,direct,Name);\r
 159     RESULT.Length := FindFileLength(RESULT.Fichier,RecLen);\r
 160     IF RESULT.Length = 1\r
 161       THEN CALL REWRITE(RESULT.Fichier) (* Le FICHIER est VIDE *)\r
 162       ELSE CALL RESET(RESULT.Fichier) FI; (* Le FICHIER n'est pas VIDE *)\r
 163   END OpenFile;\r
 164  \r
 165   (*--------------------------------------------*)\r
 166   (* FERMETURE d'un fichier ouvert par OpenFile *)\r
 167   (*--------------------------------------------*)\r
 168   UNIT CloseFile: PROCEDURE (df :RFile);\r
 169   BEGIN\r
 170     IF df = NONE\r
 171       THEN writeln("ERREUR CloseFile : Fichier inexistant");\r
 172     FI;\r
 173     IF NOT df.Opened\r
 174       THEN writeln("ERREUR CloseFile : Fermeture d'un fichier pas ouvert");\r
 175     FI;\r
 176     df. Opened := FALSE;\r
 177     KILL(df.fichier)\r
 178   END CloseFile;\r
 179  \r
 180   (*-------------------------------*)\r
 181   (* TEST si un FICHIER est OUVERT *)\r
 182   (*-------------------------------*)\r
 183   UNIT IsOpen: FUNCTION(df :RFile) :BOOLEAN;\r
 184   BEGIN\r
 185     IF df = NONE\r
 186       THEN writeln("ERREUR IsOpen : Fichier inexistant");\r
 187     FI;\r
 188     RESULT := df.Opened\r
 189   END IsOpen;\r
 190  \r
 191   (*----------------------------------------------------*)\r
 192   (* MISE a 1 de la POSITION de LECTURE dans le FICHIER *)\r
 193   (*----------------------------------------------------*)\r
 194   UNIT Frewind: PROCEDURE(df :RFile);\r
 195   BEGIN\r
 196     IF df = NONE\r
 197       THEN writeln("Frewind : Fichier inexistant");\r
 198     FI;\r
 199     IF NOT df.Opened\r
 200       THEN writeln("Frewind : Fichier pas ouvert");\r
 201     FI;\r
 202     df.Position := 1;\r
 203     CALL RESET(df.Fichier)\r
 204   END Frewind;\r
 205  \r
 206   (*----------------------------------*)\r
 207   (* TEST si on est en fin de FICHIER *)\r
 208   (*----------------------------------*)\r
 209   UNIT Feof: FUNCTION(df: RFile): BOOLEAN;\r
 210   BEGIN\r
 211     IF df = NONE\r
 212       THEN writeln("Feof : Fichier inexistant");\r
 213     FI;\r
 214     IF NOT df.Opened\r
 215       THEN writeln("Feof : Fichier pas ouvert");\r
 216     FI;\r
 217     RESULT := ( df.Position >= df.Length )\r
 218   END Feof;\r
 219  \r
 220   (*----------------------------------------------*)\r
 221   (* ECRITURE d'un enregistrement dans le fichier *)\r
 222   (*----------------------------------------------*)\r
 223   UNIT Fput: PROCEDURE(df :RFile, Record :ARRAYOF INTEGER);\r
 224   VAR nbint, i : INTEGER;\r
 225   BEGIN\r
 226     IF df = NONE\r
 227       THEN writeln("ERREUR Fput : Fichier inexistant");\r
 228            CALL ENDRUN; (* FIN du PROGRAMME *)\r
 229     FI;\r
 230     IF NOT df.Opened\r
 231        THEN writeln("ERREUR Fput : Fichier pas ouvert"); FI;\r
 232     IF df.Position > df.Length\r
 233       THEN writeln("ERREUR Fput : Tentative d'acces apres la fin de fichier");\r
 234     FI;\r
 235     IF Record = NONE\r
 236       THEN writeln("ERREUR Fput : Enregistrement inexistant");\r
 237     FI;\r
 238     nbint := UPPER(Record) - LOWER(Record) + 1;\r
 239     IF nbint =/= df.RecLen\r
 240       THEN writeln("ERREUR Fput : Taille enregistrement incorrect") FI;\r
 241     i := nbint * intsize;\r
 242     PUTREC(df.Fichier, Record, i);\r
 243     IF i =/= nbint * intsize\r
 244       THEN writeln("ERREUR Fput : ERREUR durant l'ecriture") FI;\r
 245     (* MODIFICATION de la POSITION de LECTURE du FICHIER et de la LONGUEUR\r
 246       eventuellement du FICHIER *)\r
 247     df.Position := df.Position + 1;\r
 248     IF df.Position > df.Length\r
 249       THEN df.Length := df.Position\r
 250     FI;\r
 251   END Fput;\r
 252  \r
 253   (*---------------------------------------------*)\r
 254   (* LECTURE d'un ENREGISTREMENT dans le FICHIER *)\r
 255   (*---------------------------------------------*)\r
 256   UNIT Fget: FUNCTION(df :RFile): ARRAYOF INTEGER;\r
 257   VAR Record: ARRAYOF INTEGER,\r
 258       nbint, i : INTEGER;\r
 259   BEGIN\r
 260     IF df = NONE\r
 261       THEN writeln("ERREUR Fget : Fichier inexistant"); FI;\r
 262     IF NOT df.Opened\r
 263       THEN writeln("ERREUR Fget : Fichier pas ouvert"); FI;\r
 264     IF df.Position >= df.Length\r
 265       THEN writeln("ERREUR Fget : Tentative lecture apres la fin de fichier");\r
 266     FI;\r
 267     nbint := df.RecLen;\r
 268     ARRAY Record dim (1:nbint);\r
 269     i := nbint * intsize;\r
 270     GETREC(df.Fichier, Record, i);\r
 271     IF i =/= nbint * intsize\r
 272       THEN writeln("ERREUR Fget : Erreur durant la lecture");\r
 273     FI;\r
 274     df.Position := df.Position + 1;\r
 275     RESULT := Record;\r
 276   END Fget;\r
 277  \r
 278   (*------------------------------------------------------------------------*)\r
 279   (* DEPLACEMENT dans le fichier a la Position du NUMRECieme ENREGISTREMENT *)\r
 280   (*------------------------------------------------------------------------*)\r
 281   UNIT Fseek: PROCEDURE(df :RFile, numrec :INTEGER);\r
 282   VAR offset: INTEGER;\r
 283   BEGIN\r
 284     IF df = NONE\r
 285       THEN writeln("ERREUR Fseek : Fichier inexistant");\r
 286     FI;\r
 287     IF NOT df.Opened\r
 288       THEN writeln("ERREUR Fseek : Fichier non ouvert");\r
 289     FI;\r
 290     IF numrec <= 0\r
 291       THEN writeln("ERREUR Fseek : Numero de record doit etre positif");\r
 292     FI;\r
 293    IF numrec > df.Length\r
 294       THEN writeln("ERREUR Fseek : Tentative d'acces apres la fin de fichier");\r
 295     FI;\r
 296     df.Position := numrec;\r
 297     offset := (numrec - 1) * df.RecLen * intsize;\r
 298     CALL seek(df.Fichier, offset, 0)\r
 299   END Fseek;\r
 300  \r
 301   (*-------------------------------------------------------*)\r
 302   (* INDIQUE la POSITION COURANTE dans le FICHIER specifie *)\r
 303   (*-------------------------------------------------------*)\r
 304   UNIT Position: FUNCTION(df :RFile) :INTEGER;\r
 305   BEGIN\r
 306     IF df = NONE\r
 307       THEN writeln("ERREUR Position : Fichier inexistant") FI;\r
 308     IF NOT df.Opened\r
 309       THEN writeln("ERREUR Position : Fichier pas ouvert") FI;\r
 310     RESULT := df.Position\r
 311   END Position;\r
 312  \r
 313   (*-----------------------------------------*)\r
 314   (* INDIQUE la LONGUEUR du FICHIER specifie *)\r
 315   (*-----------------------------------------*)\r
 316   UNIT FileLen: FUNCTION(df :RFile) :INTEGER;\r
 317   BEGIN\r
 318     IF df = NONE\r
 319       THEN writeln("ERREUR FileLen : Fichier inexistant") FI;\r
 320     IF NOT df.Opened\r
 321       THEN writeln("ERREUR FileLen : Fichier pas ouvert") FI;\r
 322     RESULT := df.Length\r
 323   END FileLen;\r
 324  \r
 325 BEGIN (* FileSystem *)\r
 326   System := NEW RFile;\r
 327   System.Next, System.Prev := System;\r
 328 END FileSystem;\r
 329  \r
 330 \r
 331 \r
 332 \r
 333 (*------------------------------------------------------*)\r
 334 (* MODULE contenant la declaration d'une BASE de DONNEE *)\r
 335 (* c.a.d. : RELATION, FICHIER DONNEES, FICHIER INDEX    *)\r
 336 (*------------------------------------------------------*)\r
 337 UNIT HandlerOfRelations:FileSystem CLASS(PageSize, TreeHeight,\r
 338                                          HalfPageSize : INTEGER);\r
 339  \r
 340   (*-----------------------------------------------------*)\r
 341   (* MODULE GENERIQUE d'un FICHIER de DONNEES de la BASE *)\r
 342   (*-----------------------------------------------------*)\r
 343   UNIT DataFile :CLASS;\r
 344   VAR df :RFile; (* DESCRIPTEUR du FICHIER *)\r
 345   VAR FreePlace:INTEGER; (* POSITION du dernier EMPLACEMENT LIBRE *)\r
 346  \r
 347     (*-----------------------------------------------------------*)\r
 348     (* DEPLACEMENT de la POSITION de LECTURE du fichier au DEBUT *)\r
 349     (*-----------------------------------------------------------*)\r
 350     UNIT Reset:PROCEDURE;\r
 351     BEGIN CALL Fseek(df,1) END Reset;\r
 352  \r
 353     (*-------------------------------------------------*)\r
 354     (* AJOUT au fichier de DONNEES d'un enregistrement *)\r
 355     (*-------------------------------------------------*)\r
 356     UNIT AddRec : PROCEDURE(Rec :ARRAYOF INTEGER;OUTPUT DataRef :INTEGER);\r
 357     VAR AuxRec: ARRAYOF INTEGER; (* Tableau auxiliaire pour lire la Position\r
 358                                     du nouvel emplacement libre *)\r
 359     BEGIN\r
 360       IF FreePlace=0\r
 361         THEN (* AJOUT en FIN de fFICHIER *)\r
 362              DataRef:=FileLen(df);\r
 363         ELSE (* AJOUT a l'EMPLACEMENT LIBRE *)\r
 364              DataRef:=FreePlace;\r
 365              CALL Fseek(df,DataRef);\r
 366              ARRAY AuxRec dim(LOWER(Rec):UPPER(Rec));\r
 367              AuxRec:=Fget(df);\r
 368              FreePlace:=AuxRec(1); (* NOUVEL EMPLACEMENT LIBRE *)\r
 369       FI;\r
 370       (* ECRITURE de l'enregistrement *)\r
 371       CALL Fseek(df,DataRef);\r
 372       CALL Fput(df,Rec)\r
 373     END AddRec;\r
 374  \r
 375     (*-------------------------------------------------------*)\r
 376     (* SUPPRESSION du fichier de DONNEES d'un enregistrement *)\r
 377     (*-------------------------------------------------------*)\r
 378     UNIT DelRec: PROCEDURE(DataRef :INTEGER);\r
 379     VAR AuxRec: ARRAYOF INTEGER;\r
 380     BEGIN\r
 381       CALL Fseek(df,DataRef);\r
 382       ARRAY AuxRec dim (1:df.RecLen);\r
 383       AuxRec(1):=FreePlace;\r
 384       CALL Fput(df,AuxRec);\r
 385       FreePlace:=DataRef (* NOUVEL EMPLACEMENT LIBRE *)\r
 386     END DelRec;\r
 387  \r
 388     (*--------------------------------------------------------------*)\r
 389     (* RECHERCHE d'un ENREGISTREMENT dans le FICHIER de DONNEES     *)\r
 390     (* renvoie sa Position dans le fichier ou -1 si il n'y est pas. *)\r
 391     (*--------------------------------------------------------------*)\r
 392     UNIT FindRec:PROCEDURE(Rec :ARRAYOF INTEGER;OUTPUT DataRef :INTEGER);\r
 393     VAR AuxRec: ARRAYOF INTEGER,\r
 394         i, Place: INTEGER,\r
 395         trouve : BOOLEAN;\r
 396     BEGIN\r
 397       ARRAY AuxRec DIM(LOWER(Rec):UPPER(Rec));\r
 398       CALL Reset;\r
 399       WHILE (NOT Feof(df) AND NOT trouve)\r
 400       DO\r
 401         DataRef := Position(df);\r
 402         AuxRec:= Fget(df);\r
 403         FOR i:=LOWER(AuxRec) TO UPPER(AuxRec)\r
 404         DO\r
 405           trouve := (AuxRec(i)=Rec(i));\r
 406           IF NOT trouve\r
 407             THEN EXIT\r
 408           FI\r
 409         OD;\r
 410         IF (trouve AND FreePlace <> 0)\r
 411           THEN (* RECHERCHE SI ce n'est pas un enregistrement EFFACE\r
 412                   qui correspond au tuple *)\r
 413                Place:=FreePlace;\r
 414                WHILE NOT Place=0 (* POUR CHAQUE emplacement LIBRE *)\r
 415                DO\r
 416                  IF DataRef = Place\r
 417                    THEN trouve := FALSE;\r
 418                         EXIT\r
 419                    ELSE CALL Fseek(df,Place);\r
 420                         AuxRec:=Fget(df);\r
 421                         Place:=AuxRec(1)\r
 422                  FI\r
 423                OD;\r
 424                (* REPOSITIONNEMENT TETE de LECTURE *)\r
 425                CALL Fseek(df,DataRef+df.RecLen)\r
 426         FI\r
 427       OD;\r
 428       IF NOT trouve\r
 429         THEN (* L'ENREGISTREMENT n'est pas dans le FICHIER *)\r
 430              DataRef:=-1\r
 431       FI;\r
 432     END FindRec;\r
 433  \r
 434   BEGIN\r
 435     FreePlace:=0 (* AUCUN EMPLACEMENT LIBRE a la creation *)\r
 436   END DataFile;\r
 437  \r
 438   (*-------------------------------------------------------*)\r
 439   (* MODULE GENERIQUE d'une relation de la BASE DE DONNEES *)\r
 440   (*-------------------------------------------------------*)\r
 441   UNIT Relation : DataFile CLASS ;\r
 442   VAR Indexs :ARRAYOF IndexFile; (* Tableau des INDEXs lies au fichier de\r
 443                                     donnees *)\r
 444     (*---------------------------------*)\r
 445     (* CLASSE generique d'une RELATION *)\r
 446     (*---------------------------------*)\r
 447     UNIT Tuple : CLASS;\r
 448     END Tuple;\r
 449  \r
 450     (*-------------------------------------------------------*)\r
 451     (* FONCTION GENERIQUE de conversion d'une relation en    *)\r
 452     (* TABLEAU d'ENTIERS pour la sauvegarde dans un fichier. *)\r
 453     (*-------------------------------------------------------*)\r
 454     UNIT VIRTUAL TupleToArray:FUNCTION(T: Tuple):ARRAYOF INTEGER;\r
 455     BEGIN\r
 456     END TupleToArray;\r
 457  \r
 458     (*---------------------------------------------------------*)\r
 459     (* FONCTION GENERIQUE de conversion d'un tableau d'entiers *)\r
 460     (* en objet de type TUPLE.                                 *)\r
 461     (*---------------------------------------------------------*)\r
 462     UNIT VIRTUAL ArrayToTuple : FUNCTION(A :ARRAYOF INTEGER):Tuple;\r
 463     END ArrayToTuple;\r
 464  \r
 465      (*--------------------------------------------*)\r
 466      (* INSERTION d'un TUPLE au FICHIER de DONNEES *)\r
 467      (*--------------------------------------------*)\r
 468      UNIT InsertTuple :PROCEDURE(T: Tuple);\r
 469      VAR AuxRec : ARRAYOF INTEGER,\r
 470          i,DataRef:INTEGER;\r
 471      BEGIN\r
 472        AuxRec := TupleToArray(T);\r
 473        (* AJOUT au FICHIER de DONNEES *)\r
 474        CALL AddRec(AuxRec,DataRef);\r
 475        IF Indexs <> NONE\r
 476          THEN (* Pour chaque INDEX lie a la RELATION *)\r
 477               (* MISE a JOUR                         *)\r
 478               FOR i:=1 TO UPPER(Indexs)\r
 479               DO\r
 480                 IF Indexs(i)<>NONE\r
 481                   THEN (* AJOUT d'une NOUVELLE CLE *)\r
 482                        CALL Indexs(i).AddKey(Indexs(i).KeyOf(T),DataRef)\r
 483                 FI\r
 484               OD\r
 485        FI;\r
 486      END InsertTuple;\r
 487  \r
 488      (*----------------------------------------------*)\r
 489      (* SUPPRESSION d'un TUPLE du FICHIER de DONNEES *)\r
 490      (*----------------------------------------------*)\r
 491      UNIT DeleteTuple :PROCEDURE(T: Tuple);\r
 492      VAR AuxRec :ARRAYOF INTEGER,\r
 493          i,DataRef :INTEGER;\r
 494      BEGIN\r
 495        (* RECHERCHE de la POSITION du tuple dans la BASE a partir *)\r
 496        (* de l'INDEX PRIMAIRE Indexs(1).                          *)\r
 497        DataRef := Indexs(1).FindKey(Indexs(1).KeyOf(T));\r
 498        CALL Indexs(1).DelKey(Indexs(1).KeyOf(T),DataRef);\r
 499        (* LECTURE du TUPLE dans la BASE *)\r
 500        CALL Fseek(df,DataRef);\r
 501        AuxRec := Fget(df);\r
 502        (* SUPRESSION du tuple de la BASE *)\r
 503        CALL DelRec(DataRef);\r
 504        (* SUPPRESSION des differentes CLES dans les autres indexs *)\r
 505        FOR i:=UPPER(Indexs) DOWNTO 2\r
 506        DO\r
 507          CALL Indexs(i).DelKey(Indexs(i).KeyOf(T),DataRef)\r
 508        OD\r
 509      END DeleteTuple;\r
 510  \r
 511      (*---------------------------------*)\r
 512      (* RECHERCHE d'un TUPLE de la BASE *)\r
 513      (*---------------------------------*)\r
 514      UNIT FindTuple :PROCEDURE(T: Tuple;OUTPUT Position : INTEGER);\r
 515      VAR AuxRec :ARRAYOF INTEGER,\r
 516          i,DataRef :INTEGER;\r
 517      BEGIN\r
 518        AuxRec := TupleToArray(T);\r
 519        CALL FindRec(AuxRec,DataRef);\r
 520        Position := DataRef;\r
 521      END FindTuple;\r
 522  \r
 523      (*-------------------------------------------------------------*)\r
 524      (* MODULE GENERIQUE d'un FICHIER d'INDEX de la BASE de DONNEES *)\r
 525      (* implemente sous forme de B ARBRE.                           *)\r
 526      (*-------------------------------------------------------------*)\r
 527      UNIT IndexFile:DataFile COROUTINE;\r
 528  \r
 529        (*---------------------------------------------------------------*)\r
 530        (* PAGE contenu dans le B ARBRE est qui est le type des ELEMENTS *)\r
 531        (* SAUVEGARDES sur le FICHIER.                                   *)\r
 532        (*---------------------------------------------------------------*)\r
 533        UNIT Page:CLASS;\r
 534        VAR ItemsOnPage, (* NOMBRES de PAGES FILLES *)\r
 535            LessPageRef :INTEGER,  (* POSITION dans le FICHIER de la PAGE des\r
 536                                      cles INFERIEURES a la PREMIERE cle de\r
 537                                      celui-ci. *)\r
 538            ItemsArray :ARRAYOF Item; (* TABLEAU des cles contenues dans cette\r
 539                                         PAGE *)\r
 540        BEGIN\r
 541          ARRAY ItemsArray dim (1:PageSize)\r
 542        END Page;\r
 543  \r
 544  \r
 545        (*-------------------------------------------------------------*)\r
 546        (* FONCTION de CONVERSION d'un enregistrement du FICHIER INDEX *)\r
 547        (* en page du B-arbre correspondant.                           *)\r
 548        (*-------------------------------------------------------------*)\r
 549        UNIT RecToPage:FUNCTION(A :ARRAYOF INTEGER) :Page;\r
 550        VAR P :Page,\r
 551            It :Item,\r
 552            i, j :INTEGER;\r
 553        BEGIN\r
 554          P:=NEW Page;\r
 555          P.ItemsOnPage,j := A(1);\r
 556          P.LessPageRef := A(2);\r
 557          ARRAY P.ItemsArray dim (1:PageSize);\r
 558          FOR i := 1 TO  j\r
 559          DO\r
 560            It := NEW Item;\r
 561            It.ky := RecToKey(A, 3+(i-1)*(KeySize+2) ) ;\r
 562            It.PageRef := A(i*(KeySize+2)+1);\r
 563            It.DataRef := A(i*(KeySize+2)+2);\r
 564            P.ItemsArray(i) := It;\r
 565          OD;\r
 566          RESULT :=P\r
 567        END RecToPage;\r
 568  \r
 569        (*----------------------------------------------------------------*)\r
 570        (* FONCTION de CONVERSION d'une PAGE du B-ARBRE en enregistrement *)\r
 571        (* du FICHIER INDEX correspondant.                                *)\r
 572        (*----------------------------------------------------------------*)\r
 573        UNIT PageToRec : FUNCTION (P: Page): ARRAYOF INTEGER;\r
 574        VAR AuxRec :  ARRAYOF INTEGER,\r
 575            It:  Item,\r
 576            i :  INTEGER;\r
 577        BEGIN\r
 578          ARRAY AuxRec dim(1:(PageSize*(KeySize+2)+2));\r
 579          AuxRec(1) := P.ItemsOnPage;\r
 580          AuxRec(2) := P.LessPageRef;\r
 581          FOR i := 1  TO P.ItemsOnPage\r
 582          DO\r
 583            It:=P.ItemsArray(i);\r
 584            CALL KeyToRec(It.ky,AuxRec, 3+(i-1)*(KeySize+2) );\r
 585            AuxRec(i*(KeySize+2)+1) := It.PageRef;\r
 586            AuxRec(i*(KeySize+2)+2) := It.DataRef;\r
 587          OD;\r
 588          RESULT := AuxRec\r
 589        END PageToRec;\r
 590  \r
 591        UNIT Item : CLASS ;\r
 592        VAR ky: key, (* CLE du tuple concerne *)\r
 593            PageRef, (* POSITION dans le FICHIER INDEX de la PAGE RACINE\r
 594                        contenant les CLES SUPERIEURES a ce tuple ci     *)\r
 595            DataRef :INTEGER; (* POSITION dans le FICHIER de DONNEES du tuple\r
 596                                 concerne *)\r
 597        END Item;\r
 598  \r
 599        (*------------------------------------------------------------------*)\r
 600        (* MODULE GENERIQUE de CLE de TUPLE defini ulterieurement dans les  *)\r
 601        (*  classes heritantes.                                             *)\r
 602        (*------------------------------------------------------------------*)\r
 603        UNIT Key : CLASS;\r
 604        END Key;\r
 605  \r
 606        VAR KeySize : INTEGER; (* Taille de la cle de Items *)\r
 607  \r
 608        (*--------------------------------------*)\r
 609        (* FONCTION GENERIQUE renvoyant pour un *)\r
 610        (* tuple donne la cle correspondante.   *)\r
 611        (*--------------------------------------*)\r
 612        UNIT VIRTUAL KeyOf:FUNCTION(t :Tuple) :key; END KeyOf;\r
 613  \r
 614        (*------------------------------------------------------*)\r
 615        (* TEST de COMPARAISON GENERIQUE de deux cles de tuples *)\r
 616        (*------------------------------------------------------*)\r
 617        UNIT VIRTUAL Leq:FUNCTION(key1, key2 :key) :Boolean; END Leq;\r
 618  \r
 619        (*------------------------------------------------------------*)\r
 620        (* FONCTION GENERIQUE de TRANSFORMATION d'une serie d'entiers *)\r
 621        (* en la CLE correspondante.                                  *)\r
 622        (*------------------------------------------------------------*)\r
 623        UNIT VIRTUAL RecToKey : FUNCTION(A :ARRAYOF INTEGER, j :INTEGER) :Key;\r
 624        BEGIN END RecToKey;\r
 625  \r
 626        (*---------------------------------------------------------*)\r
 627        (* FONCTION GENERIQUE de TRANSFORMATION d'une CLE de tuple *)\r
 628        (* en une serie d'entiers.                                 *)\r
 629        (*---------------------------------------------------------*)\r
 630     UNIT VIRTUAL KeyToRec:PROCEDURE(ky :Key, A :ARRAYOF INTEGER, j :INTEGER);\r
 631        BEGIN END KeyToRec;\r
 632  \r
 633        UNIT SearchStep: CLASS;\r
 634        VAR PageRef,RefOnPage : INTEGER,\r
 635            updated : BOOLEAN;\r
 636         END SearchStep;\r
 637  \r
 638        VAR StackOfPages: ARRAYOF Page, (* Pile de Pages *)\r
 639            Finger: INTEGER, (* Indice *)\r
 640            Path: ARRAYOF SearchStep,\r
 641            AuxRec  : ARRAYOF INTEGER,\r
 642            Ak    :  Key,\r
 643            PageRef : INTEGER;\r
 644  \r
 645        (*------------------------------------------------------------------*)\r
 646        (* INSERTION de la cle ky au FICHIER d'INDEX, DataRef correspondant *)\r
 647        (* a la Position du tuple dans le fichier de donnees.               *)\r
 648        (*------------------------------------------------------------------*)\r
 649        UNIT AddKey:PROCEDURE(INPUT ky:key,DataRef:INTEGER);\r
 650        VAR depth,\r
 651            PageRef,\r
 652            i : INTEGER,\r
 653            AddItem, AuxItem, itm2 : Item,\r
 654            IncreaseHeight : BOOLEAN,\r
 655            NewRoot : Page,\r
 656            AuxRec : ARRAYOF INTEGER;\r
 657  \r
 658            UNIT Search : PROCEDURE (INPUT itm1 : Item, PageRef:INTEGER;\r
 659                                     OUTPUT include : BOOLEAN, itm2 :Item);\r
 660              VAR NextPageRef,\r
 661                  ItemRef :  INTEGER,\r
 662                  inclde  :  BOOLEAN,\r
 663                  item2   :  Item,\r
 664                  AuxPage :  Page;\r
 665  \r
 666              UNIT Insert : PROCEDURE;\r
 667              VAR OldPage, RightPage : Page,\r
 668                  AuxRec : ARRAYOF INTEGER,\r
 669                  AuxItmArr, AuxItmArr2 : ARRAYOF Item,\r
 670                  RightPageRef, i : INTEGER;\r
 671              BEGIN\r
 672                OldPage := StackOfPages(Finger);\r
 673                IF OldPage.ItemsOnPage < PageSize\r
 674                  THEN CALL UpdatePage (item2, ItemRef, OldPage);\r
 675                       Path(Finger).RefOnPage := ItemRef + 1;\r
 676                       include := FALSE;\r
 677                  ELSE include := TRUE;\r
 678                       OldPage.ItemsOnPage := HalfPageSize;\r
 679                       Path(Finger).updated := TRUE;\r
 680                       RightPage := NEW Page;\r
 681                       RightPage.ItemsOnPage := HalfPageSize;\r
 682                       ARRAY RightPage.ItemsArray dim (1:PageSize);\r
 683                       AuxItmArr := OldPage.ItemsArray;\r
 684                       AuxItmArr2 := RightPage.ItemsArray;\r
 685                       IF ItemRef = HalfPageSize\r
 686                         THEN FOR i := 1  to  HalfPageSize\r
 687                              DO\r
 688                                AuxItmArr2(i):=AuxItmArr(i+HalfPageSize)\r
 689                              OD;\r
 690                              itm2:= item2;\r
 691                         ELSE IF ItemRef < HalfPageSize\r
 692                                THEN FOR i := 1  TO HalfPageSize\r
 693                                     DO\r
 694                                       AuxItmArr2(i) := AuxItmArr(i+HalfPageSize)\r
 695                                     OD;\r
 696                                     itm2 := AuxItmArr(HalfPageSize);\r
 697                                     FOR i := HalfPageSize-1 DOWNTO ItemRef+1\r
 698                                     DO\r
 699                                       AuxItmArr(i+1) := AuxItmArr(i)\r
 700                                     OD;\r
 701                                     AuxItmArr(ItemRef+1) := item2;\r
 702                                ELSE itm2 := AuxItmArr(HalfPageSize+1);\r
 703                                     FOR i := HalfPageSize+2  TO ItemRef\r
 704                                     DO\r
 705                                       AuxItmArr2(i-HalfPageSize-1) :=\r
 706                                                AuxItmArr(i)\r
 707                                     OD;\r
 708                                     AuxItmArr2(ItemRef-HalfPageSize) := item2;\r
 709                                     FOR i := ItemRef+1  TO PageSize\r
 710                                     DO\r
 711                                       AuxItmArr2(i-HalfPageSize) := AuxItmArr(i)\r
 712                                     OD;\r
 713                              FI;\r
 714                       FI;\r
 715                       (* StackOfPages(finger) := OldPage;  *)\r
 716                       CALL Fseek(df,Path(Finger).PageRef);\r
 717                       CALL Fput(df,PageToRec(StackOfPages(Finger)));\r
 718                       RightPage.LessPageRef := itm2.PageRef;\r
 719                       AuxRec :=PageToRec(RightPage);\r
 720                       CALL AddRec(AuxRec,RightPageRef);\r
 721                       itm2.PageRef :=RightPageRef;\r
 722                FI\r
 723              END Insert;\r
 724  \r
 725            BEGIN (* Search*)\r
 726              IF PageRef = -1\r
 727                THEN include := TRUE;\r
 728                     itm2 := itm1;\r
 729                     itm2.PageRef := -1;\r
 730                ELSE Finger, depth := Finger+1;\r
 731                     CALL GetPage (PageRef);\r
 732                     AuxPage := StackOfPages (Finger);\r
 733                     CALL SearchPage (AuxPage, itm1, NextPageRef, ItemRef);\r
 734                     CALL Search(itm1, NextPageRef, include, item2);\r
 735                     IF include\r
 736                       THEN CALL Insert;\r
 737                     FI;\r
 738                     Finger := Finger -1;\r
 739              FI;\r
 740            END Search;\r
 741  \r
 742        BEGIN (*AddKey*)\r
 743          Path(1).updated := TRUE;\r
 744          AuxItem := NEW Item;\r
 745          AuxItem.ky := ky;\r
 746          AuxItem.DataRef := DataRef;\r
 747          AuxItem.PageRef := -1;\r
 748          Finger := 0;\r
 749          CALL Search(AuxItem, Path(1).PageRef,\r
 750          IncreaseHeight, AddItem);\r
 751          IF IncreaseHeight\r
 752            THEN NewRoot := NEW Page;\r
 753                 NewRoot.ItemsOnPage := 1;\r
 754                 NewRoot.LessPageRef := Path(1).PageRef;\r
 755                 ARRAY NewRoot.ItemsArray dim (1:PageSize);\r
 756                 NewRoot.ItemsArray(1) := AddItem;\r
 757                 IF depth+1 > TreeHeight\r
 758                   THEN RAISE TreeHeight_Overflow\r
 759                 FI;\r
 760                 FOR i := 1 TO depth\r
 761                 DO\r
 762                   StackOfPages(i+1) := StackOfPages(i);\r
 763                   Path(i+1) := Path(i);\r
 764                 OD;\r
 765                 StackOfPages(1) := NewRoot;\r
 766                 Path(1) := NEW SearchStep;\r
 767                 Path(1).RefOnPage := 1;\r
 768                 Path(1).updated := TRUE;\r
 769                 AuxRec :=PageToRec(NewRoot);\r
 770                 CALL AddRec(AuxRec, PageRef);\r
 771                 Path(1).PageRef := PageRef;\r
 772                 Finger := depth+1\r
 773            ELSE Finger := depth\r
 774          FI (* IncreaseHeight *);\r
 775        END AddKey;\r
 776  \r
 777        (*-------------------------------------------------------------------*)\r
 778        (* RECHERCHE de la cle Ky IMMEDIATEMENT INFERIEURE a la CLE indique  *)\r
 779        (* par Path, DataRef correspond a la POSITION du TUPLE associe a la  *)\r
 780        (* CLE dans le fichier de donnees.                                   *)\r
 781        (*-------------------------------------------------------------------*)\r
 782        UNIT PrevKey : PROCEDURE (OUTPUT ky:key, DataRef:INTEGER);\r
 783        VAR AuxPage : Page, AuxRec : ARRAYOF INTEGER,\r
 784            PageRef, NextPageRef, RefOnPage : INTEGER;\r
 785        BEGIN\r
 786          RefOnPage := Path(Finger).RefOnPage;\r
 787          PageRef:=Path(Finger).PageRef;\r
 788          AuxPage:=StackOfPages(Finger);\r
 789          IF AuxPage.LessPageRef = -1\r
 790            THEN IF RefOnPage <> 1\r
 791                   THEN RefOnPage := RefOnPage -1;\r
 792                        Path(Finger).RefOnPage := RefOnPage\r
 793                   ELSE IF Finger = 1\r
 794                          THEN ky:=AuxPage.ItemsArray(RefOnPage).ky;\r
 795                               DataRef:=AuxPage.ItemsArray(RefOnPage).DataRef;\r
 796                               RAISE signal11;\r
 797                               RETURN;\r
 798                          ELSE RefOnPage := 0;\r
 799                               WHILE Finger <> 1 AND RefOnPage = 0\r
 800                               DO\r
 801                                 Finger := Finger-1;\r
 802                                 Auxpage := StackOfPages(Finger);\r
 803                                 RefOnPage := Path(Finger).RefOnPage\r
 804                               OD;\r
 805                               IF Finger = 1 AND RefOnPage = 0\r
 806                                 THEN ky:=AuxPage.ItemsArray(1).ky;\r
 807                                      DataRef:=AuxPage.ItemsArray(1).DataRef;\r
 808                                      RAISE signal11;\r
 809                                      RETURN;\r
 810                               FI;\r
 811                        FI;\r
 812                 FI (* RefOnPage <> 1 *);\r
 813            ELSE IF RefOnPage = 1\r
 814                   THEN NextPageRef := AuxPage.LessPageRef;\r
 815                        Path(Finger).RefOnPage := 0\r
 816                   ELSE RefOnPage := RefOnPage -1;\r
 817                        NextPageRef := AuxPage.ItemsArray(RefOnPage).PageRef;\r
 818                        Path(Finger).RefOnPage := RefOnPage\r
 819                 FI;\r
 820                 WHILE NextPageRef <> -1\r
 821                 DO\r
 822                   Finger := Finger +1;\r
 823                   PageRef := NextPageRef;\r
 824                   CALL GetPage(PageRef);\r
 825                   AuxPage := StackOfPages(Finger);\r
 826                   RefOnPage, Path(Finger).RefOnPage := Auxpage.ItemsOnPage;\r
 827                   NextPageRef := AuxPage.ItemsArray(RefOnPage).PageRef\r
 828                 OD;\r
 829          FI;\r
 830          ky:=AuxPage.ItemsArray(RefOnPage).ky;\r
 831          DataRef:=AuxPage.ItemsArray(RefOnPage).DataRef\r
 832        END PrevKey;\r
 833        (*-----------------------------------------------------*)\r
 834        (* RECHERCHE de la CLE la plus petite du fichier INDEX *)\r
 835        (*-----------------------------------------------------*)\r
 836        UNIT MinKey : PROCEDURE (OUTPUT k:Key, DataRef : INTEGER);\r
 837        VAR PageRef : INTEGER, AuxPage : Page, AuxItem : Item;\r
 838        BEGIN\r
 839          Finger :=1;\r
 840          DO\r
 841            AuxPage := StackOfPages(Finger);\r
 842            PageRef := AuxPage.LessPageRef;\r
 843            Path(Finger).RefOnPage := 0;\r
 844            IF PageRef = -1 THEN EXIT FI;\r
 845            Finger := Finger +1;\r
 846            CALL GetPage(PageRef);\r
 847          OD;\r
 848          AuxItem := AuxPage.ItemsArray(1);\r
 849          k := AuxItem.ky;\r
 850          DataRef := AuxItem.DataRef;\r
 851          Path(Finger).RefOnPage := 1\r
 852        END MinKey;\r
 853  \r
 854        UNIT MaxKey : PROCEDURE( OUTPUT k:Key, DataRef: INTEGER);\r
 855        VAR PageRef, n : INTEGER,\r
 856            AuxPage : Page;\r
 857        BEGIN\r
 858          Finger :=1;\r
 859          DO\r
 860            AuxPage := StackOfPages(Finger);\r
 861            Path(Finger).RefOnPage, n := AuxPage.ItemsOnPage;\r
 862            PageRef := AuxPage.ItemsArray(n).PageRef;\r
 863            IF PageRef = -1 THEN EXIT FI;\r
 864            Finger := Finger+1;\r
 865            CALL GetPage(PageRef)\r
 866          OD;\r
 867          k := AuxPage.ItemsArray(n).Ky;\r
 868          DataRef := AuxPage.ItemsArray(n).DataRef\r
 869        END MaxKey;\r
 870  \r
 871        (*-------------------------------------------------------------------*)\r
 872        (* RECHERCHE de la cle Ky IMMEDIATEMENT SUPERIEURE a la cle indique  *)\r
 873        (* par Path, DataRef correspond a la Position du tuple associe a la  *)\r
 874        (* cle dans le fichier de donnees.                                   *)\r
 875        (*-------------------------------------------------------------------*)\r
 876        UNIT NextKey: PROCEDURE (OUTPUT ky:key,DataRef:INTEGER);\r
 877        VAR AuxPage : Page,\r
 878            AuxItem : Item,\r
 879            PageRef,NextPageRef,\r
 880            RefOnPage : INTEGER;\r
 881        BEGIN\r
 882          RefOnPage := Path(Finger).RefOnPage;\r
 883          PageRef := Path(Finger).PageRef;\r
 884          AuxPage:=StackOfPages(Finger);\r
 885          IF AuxPage.LessPageRef = -1\r
 886            THEN WHILE Finger <> 1 AND RefOnPage = AuxPage.ItemsOnPage\r
 887                 DO\r
 888                   Finger := Finger - 1;\r
 889                   AuxPage := StackOfPages(Finger);\r
 890                   RefOnPage := Path(Finger).refOnPage\r
 891                 OD;\r
 892                 IF RefOnPage = AuxPage.ItemsOnPage\r
 893                   THEN AuxItem := AuxPage.ItemsArray(RefOnPage);\r
 894                        DataRef := AuxItem.DataRef;\r
 895                        ky := AuxItem.ky;\r
 896                        RAISE signal12;\r
 897                        RETURN;\r
 898                   ELSE RefOnPage := RefOnPage+1;\r
 899                        Path(Finger).RefOnPage := RefOnPage\r
 900                 FI;\r
 901            ELSE NextPageRef := AuxPage.ItemsArray(RefOnPage).PageRef;\r
 902                 WHILE NextPageRef <> -1\r
 903                 DO\r
 904                   Finger := Finger+1;\r
 905                   PageRef := NextPageRef;\r
 906                   CALL GetPage(PageRef);\r
 907                   AuxPage := StackOfPages(Finger);\r
 908                   Path(Finger).refOnPage := 0;\r
 909                   NextPageRef := AuxPage.LesspageRef\r
 910                 OD;\r
 911                 RefOnPage := 1;\r
 912                 Path(Finger).RefOnPage := 1\r
 913          FI;\r
 914          AuxItem := AuxPage.ItemsArray(RefOnPage);\r
 915          DataRef := AuxItem.DataRef;\r
 916          ky := AuxItem.ky\r
 917        END NextKey;\r
 918  \r
 919        (*--------------------------------------------------------------------*)\r
 920        (* SUPPRESSION de la cle ky au FICHIER d'INDEX, DataRef correspondant *)\r
 921        (* a la Position du tuple dans le fichier de donnees.                 *)\r
 922        (*--------------------------------------------------------------------*)\r
 923        UNIT DelKey : PROCEDURE (INPUT ky:key,DataRef:INTEGER);\r
 924        VAR DataRef1: INTEGER,\r
 925            k: key,\r
 926            underflw:BOOLEAN;\r
 927  \r
 928          UNIT remove : PROCEDURE(OUTPUT underflw:BOOLEAN);\r
 929          VAR AuxPage,AuxPage1 :Page,\r
 930              i,ItemsOnPage,RefOnPage,NextPageRef :INTEGER;\r
 931          BEGIN\r
 932            AuxPage:=StackOfPages(Finger);\r
 933            i:=Finger;\r
 934            Path(Finger).updated:=TRUE;\r
 935            RefOnPage := Path(Finger).RefOnPage;\r
 936  \r
 937            IF  AuxPage.LessPageRef <> -1\r
 938              THEN NextPageRef :=\r
 939                   AuxPage.ItemsArray(RefOnPage).PageRef;\r
 940                   WHILE NextPageRef <> -1\r
 941                   DO\r
 942                     Finger := Finger+1;\r
 943                     CALL GetPage(NextPageRef);\r
 944                     AuxPage1 := StackOfPages(Finger);\r
 945                     Path(Finger).RefOnPage := 0;\r
 946                     NextPageRef := AuxPage1.LessPageRef\r
 947                   OD;\r
 948                   Path(Finger).updated:=TRUE;\r
 949                   Path(Finger).RefOnPage := 1;\r
 950                   AuxPage.ItemsArray(RefOnPage).ky := AuxPage1.ItemsArray(1).ky;\r
 951                   AuxPage.ItemsArray(RefOnPage).DataRef:=\r
 952                                                AuxPage1.ItemsArray(1).DataRef;\r
 953                   StackOfPages(i):=AuxPage;\r
 954                   AuxPage:= AuxPage1;\r
 955                   RefOnPage:=1;\r
 956            FI;\r
 957            ItemsOnPage:= AuxPage.ItemsOnPage -1;\r
 958            FOR i:=RefOnPage TO ItemsOnPage\r
 959            DO\r
 960              AuxPage.ItemsArray(i):=AuxPage.ItemsArray(i+1)\r
 961            OD;\r
 962            AuxPage.ItemsOnPage:= ItemsOnPage;\r
 963            StackOfPages(Finger):=AuxPage;\r
 964            IF ItemsOnPage<HalfPageSize\r
 965              THEN underflw:=TRUE\r
 966            FI\r
 967          END remove;\r
 968  \r
 969          UNIT underflow: PROCEDURE(inout underflw:BOOLEAN);\r
 970          VAR Itm:Item,\r
 971              AuxPage,AuxPage1, AuxPage2:Page,\r
 972              i,k,n,pb,lb,PageRef,RefOnPage: INTEGER,\r
 973              AuxRec: ARRAYOF INTEGER;\r
 974          BEGIN\r
 975            writeln("underflow",Finger);\r
 976            underflw:=FALSE;\r
 977            IF Finger<>1\r
 978              THEN AuxPage:=StackOfPages(Finger);\r
 979                   Path(Finger).updated:=TRUE ;\r
 980                   Path(Finger-1).updated:=TRUE ;\r
 981                   AuxPage1:=StackOfPages(Finger-1);\r
 982                   RefOnPage:=Path(Finger-1).RefOnPage;\r
 983                   IF RefOnPage< AuxPage1.ItemsOnPage\r
 984                     THEN k:=RefOnPage+1;\r
 985                          Itm:=AuxPage1.ItemsArray(k);\r
 986                          PageRef:=Itm.PageRef;\r
 987                          CALL Fseek(df,PageRef);\r
 988                          AuxRec:=Fget(df);\r
 989                          AuxPage2:=RecToPage(AuxRec);\r
 990                          Itm.PageRef:=AuxPage2.LessPageRef;\r
 991                          AuxPage.ItemsArray(AuxPage.ItemsOnPage+1):=Itm;\r
 992                          n:=AuxPage2.ItemsOnPage-HalfPageSize;\r
 993                          IF  n>0\r
 994                            THEN n:=entier((n-1)/2);\r
 995                                 Itm:=AuxPage2.ItemsArray(n+1);\r
 996                                 Itm.PageRef:=PageRef;\r
 997                                  AuxPage1.ItemsArray(k):=Itm;\r
 998                                 FOR i:=1 TO n\r
 999                                 DO\r
1000                                   AuxPage.ItemsArray(HalfPageSize+i):=\r
1001                                                 AuxPage2.ItemsArray(i)\r
1002                                 OD;\r
1003                                 AuxPage.ItemsOnPage:=HalfPageSize+n;\r
1004                                 StackOfPages(Finger):=AuxPage;\r
1005                                 StackOfPages(Finger-1):=AuxPage1;\r
1006                                 k:=AuxPage2.ItemsOnPage-(n+1);\r
1007                                 FOR i:=1 TO k\r
1008                                 DO\r
1009                                   AuxPage2.ItemsArray(i):=\r
1010                                   AuxPage2.ItemsArray(n+1+i)\r
1011                                 OD;\r
1012                                 AuxPage2.ItemsOnPage:=k;\r
1013                                 AuxRec:=PageToRec(AuxPage2);\r
1014                                 CALL Fseek(df,PageRef);\r
1015                                 CALL Fput(df,AuxRec);\r
1016                            ELSE (*AuxPage2.ItemsOnPage=HalfPageSize tzn. n=0*)\r
1017                                 FOR i:=1 TO HalfPageSize\r
1018                                 DO\r
1019                                   AuxPage.ItemsArray(HalfPageSize+i):=\r
1020                                   AuxPage2.ItemsArray(i)\r
1021                                 OD;\r
1022                                 AuxPage.ItemsOnPage:=PageSize;\r
1023                                 FOR i:=RefOnPage+2 TO AuxPage1.ItemsOnPage\r
1024                                 DO\r
1025                                   AuxPage1.ItemsArray(i-1):=\r
1026                                                  AuxPage1.ItemsArray(i)\r
1027                                 OD;\r
1028                                 AuxPage1.ItemsOnPage:=AuxPage1.ItemsOnPage-1;\r
1029                                 StackOfPages(Finger-1):=AuxPage1;\r
1030                                 StackOfPages(Finger):=AuxPage;\r
1031                                 CALL DelRec(PageRef);\r
1032                                 IF AuxPage1.ItemsOnPage<HalfPageSize\r
1033                                   THEN Finger:=Finger-1;\r
1034                                        underflw:=TRUE;\r
1035                                 FI;\r
1036                          FI (*n>0*)\r
1037                     ELSE IF RefOnPage>1\r
1038                            THEN Itm:=AuxPage1.ItemsArray(RefOnPage-1);\r
1039                                 PageRef:=Itm.PageRef;\r
1040                            ELSE PageRef:=AuxPage1.LessPageRef;\r
1041                          FI;\r
1042                          CALL Fseek(df,PageRef);\r
1043                          AuxRec:=Fget(df);\r
1044                          AuxPage2:=RecToPage(AuxRec);\r
1045                          Itm:=AuxPage1.ItemsArray(RefOnPage);\r
1046                          Itm.PageRef:=AuxPage.LessPageRef;\r
1047                          n:=AuxPage2.ItemsOnPage-HalfPageSize;\r
1048                          IF n>0\r
1049                            THEN n:=entier((n-1)/2);\r
1050                                 k:=AuxPage.ItemsOnPage;\r
1051                                 FOR i:=1 TO n+1\r
1052                                 DO\r
1053                                   AuxPage.ItemsArray(k+n+2-i):=\r
1054                                   AuxPage.ItemsArray(k+1-i)\r
1055                                 OD;\r
1056                                 AuxPage.ItemsArray(n+1):=Itm;\r
1057                                 AuxPage.ItemsOnPage:=k+n+1;\r
1058                                 Itm:=AuxPage2.ItemsArray(HalfPageSize+n+1);\r
1059                                 Itm.PageRef:=PageRef;\r
1060                                 AuxPage1.ItemsArray(RefOnPage):=Itm;\r
1061                                 FOR i:=1 TO n\r
1062                                 DO\r
1063                                   AuxPage.ItemsArray(i):=\r
1064                                   AuxPage2.ItemsArray(HalfPageSize+1+i+n)\r
1065                                 OD;\r
1066                                 AuxPage.ItemsOnPage:=HalfPageSize+n;\r
1067                                 AuxPage2.ItemsOnPage:= HalfPageSize+n;\r
1068                                 StackOfPages(Finger-1):=AuxPage1;\r
1069                                 StackOfPages(Finger):=AuxPage;\r
1070                                 AuxRec:=PageToRec(AuxPage2);\r
1071                                 CALL Fseek(df,PageRef);\r
1072                                 CALL Fput(df,AuxRec);\r
1073                            ELSE AuxPage2.ItemsArray(HalfPageSize+1):=Itm;\r
1074                                 FOR i:=1 TO HalfPageSize-1\r
1075                                 DO AuxPage2.ItemsArray(HalfPageSize+1+i):=\r
1076                                                      AuxPage.ItemsArray(i)\r
1077                                 OD;\r
1078                                 AuxPage1.ItemsOnPage:=AuxPage1.ItemsOnPage-1;\r
1079                                 AuxPage2.ItemsOnPage:=PageSize;\r
1080                                 StackOfPages(Finger-1):=AuxPage1;\r
1081                                 StackOfPages(Finger):=AuxPage2;\r
1082                                 Path(Finger-1).RefOnPage:=RefOnPage-1;\r
1083                                 CALL DelRec(Path(Finger).PageRef);\r
1084                                 Path(Finger).PageRef:=PageRef;\r
1085                                 IF AuxPage1.ItemsOnPage<HalfPageSize\r
1086                                   THEN Finger:=Finger-1;\r
1087                                        underflw:=TRUE\r
1088                                 FI;\r
1089                          FI (*n>0*)\r
1090                   FI\r
1091              ELSE AuxPage:=StackOfPages(1);\r
1092                   IF AuxPage.ItemsOnPage=0\r
1093                     THEN CALL DelRec(Path(1).PageRef);\r
1094                          IF AuxPage.LessPageRef<>-1\r
1095                            THEN i:=2;\r
1096                                 WHILE Path(i)<>NONE\r
1097                                 DO\r
1098                                   Path(i-1):=Path(i);\r
1099                                   StackOfPages(i-1):=StackOfPages(i);\r
1100                                   i:=i+1\r
1101                                 OD\r
1102                            ELSE writeln("erreur1");\r
1103                          FI;\r
1104                   FI\r
1105            FI;\r
1106          END underflow;\r
1107  \r
1108        BEGIN (*DelKey*)\r
1109          k:=ky;\r
1110          DataRef1:=FindKey(k);\r
1111          DO\r
1112            IF k=ky AND DataRef=DataRef1\r
1113              THEN CALL remove(underflw);\r
1114                   WHILE underflw\r
1115                   DO\r
1116                     CALL underflow(underflw)\r
1117                    OD;\r
1118                   RETURN\r
1119             ELSE IF k<>ky or DataRef1= -1\r
1120                     THEN writeln("erreur2")\r
1121                     ELSE CALL NextKey(k,DataRef1)\r
1122                   FI\r
1123            FI\r
1124          OD\r
1125        END DelKey;\r
1126  \r
1127  \r
1128        UNIT FindKey:FUNCTION (k : key): INTEGER;\r
1129        VAR PageRef,\r
1130            i : INTEGER,\r
1131            AuxPage : Page,\r
1132             Itms : ARRAYOF Item,\r
1133           k1 : Key;\r
1134         BEGIN\r
1135         Finger := 1;\r
1136          PageRef := Path(Finger).PageRef;\r
1137           DO\r
1138            CALL GetPage( PageRef );\r
1139            AuxPage := StackOfPages(Finger);\r
1140            Itms := AuxPage.ItemsArray;\r
1141            FOR i := AuxPage.ItemsOnPage DOWNTO 1\r
1142            DO\r
1143              k1 := Itms(i).ky;\r
1144              IF leq(k1, k)\r
1145                THEN Path(Finger).RefOnPage := i;\r
1146                     IF leq(k, k1)\r
1147                       THEN RESULT := Itms(i).DataRef;\r
1148                            RETURN\r
1149                     FI;\r
1150                     PageRef := Itms(i).PageRef;\r
1151                     EXIT;\r
1152                ELSE IF i =1\r
1153                       THEN PageRef := AuxPage.LessPageRef;\r
1154                            Path(Finger).RefOnPage := 0;\r
1155                     FI;\r
1156              FI;\r
1157            OD;\r
1158            IF PageRef = -1\r
1159              THEN IF Path(Finger).RefOnPage = 0\r
1160                     THEN Path(Finger).RefOnPage :=1\r
1161                   FI;\r
1162                   RESULT := -1;\r
1163                   EXIT (*FindKey*)\r
1164              ELSE Finger := Finger+1\r
1165            FI;\r
1166          OD;\r
1167        END FindKey;\r
1168  \r
1169        UNIT SearchKey: PROCEDURE(INPUT k:key;OUTPUT DataRef : INTEGER);\r
1170        BEGIN\r
1171          DataRef := FindKey(k);\r
1172          IF DataRef = -1\r
1173            THEN CALL NextKey(k,DataRef)\r
1174          FI\r
1175        END SearchKey;\r
1176  \r
1177        UNIT GetPage  :  PROCEDURE(PageRef : INTEGER);\r
1178        VAR AuxRec : ARRAYOF INTEGER;\r
1179        BEGIN\r
1180          IF Path(Finger) = NONE\r
1181            THEN Path(Finger) := NEW SearchStep;\r
1182                 Path(Finger).Updated := FALSE;\r
1183                 Path(Finger).PageRef := PageRef-1;\r
1184          FI;\r
1185          IF Path(Finger).Updated\r
1186            THEN AuxRec := PageToRec(StackOfPages(Finger));\r
1187                 CALL Fseek(df, Path(Finger).PageRef);\r
1188                 CALL Fput(df,AuxRec);\r
1189          FI;\r
1190          CALL Fseek(df, PageRef);\r
1191          AuxRec := Fget(df);\r
1192          StackOfPages(Finger) := RecToPage(AuxRec);\r
1193          Path(Finger) := NEW SearchStep;\r
1194          Path(Finger).PageRef := PageRef;\r
1195          Path(Finger).updated := FALSE;\r
1196        END GetPage  ;\r
1197  \r
1198        UNIT UpdatePage : PROCEDURE (INPUT AuxItem : Item, ItemRef : INTEGER,\r
1199                                     AuxPage : Page);\r
1200        VAR  AuxItmArr : ARRAYOF Item,\r
1201             n,i: INTEGER;\r
1202        BEGIN\r
1203          AuxPage.ItemsOnPage, n := AuxPage.ItemsOnPage +1;\r
1204          FOR i := n  DOWNTO ItemRef +2\r
1205          DO\r
1206            AuxItmArr :=   AuxPage.ItemsArray;\r
1207            AuxItmArr(i) := AuxItmArr(i-1)\r
1208          OD;\r
1209          AuxPage.ItemsArray(ItemRef+1) := AuxItem;\r
1210          Path(Finger).Updated := TRUE;\r
1211        END UpdatePage  ;\r
1212  \r
1213        UNIT order : FUNCTION (i1, i2 : Item) : BOOLEAN;\r
1214        VAR k1,k2 :key,\r
1215            n : INTEGER;\r
1216        BEGIN\r
1217          k1 := i1.ky;\r
1218          k2 := i2.ky;\r
1219          IF Leq(k2,k1)\r
1220            THEN IF Leq(k1, k2)\r
1221                   THEN n := i1.DataRef - i2.DataRef;\r
1222                        IF n=0\r
1223                          THEN RAISE Signal14\r
1224                        FI;\r
1225                        RESULT := n<0;\r
1226                   ELSE RESULT := FALSE\r
1227                 FI\r
1228            ELSE IF NOT Leq(k1, k2)\r
1229                   THEN\r
1230                   ELSE RESULT := TRUE\r
1231                 FI\r
1232          FI\r
1233        END order;\r
1234  \r
1235        UNIT SearchPage  : PROCEDURE (INPUT P :Page, it :Item;\r
1236                                      OUTPUT NextPageRef, ItemRef :INTEGER);\r
1237        VAR Itms : ARRAYOF Item,\r
1238            it1 : Item;\r
1239        BEGIN\r
1240          Itms :=P.ItemsArray;\r
1241          FOR ItemRef  := P.ItemsOnPage  DOWNTO  1\r
1242          DO\r
1243            it1 := Itms(ItemRef);\r
1244            IF order(it1, it)\r
1245              THEN NextPageRef := it1.PageRef;\r
1246                   RETURN\r
1247            FI\r
1248          OD;\r
1249          ItemRef := 0;\r
1250          NextPageRef := P.LessPageRef;\r
1251        END SearchPage ;\r
1252  \r
1253      BEGIN (*IndexFile*)\r
1254        Finger :=1;\r
1255        ARRAY StackOfPages dim(1:TreeHeight);\r
1256        ARRAY Path dim (1:TreeHeight);\r
1257        StackOfPages(1) := NEW Page;\r
1258        StackOfPages(1).ItemsOnPage := 0;\r
1259        StackOfPages(1).LessPageRef := -1;\r
1260        ARRAY StackOfPages(1).ItemsArray dim (1: PageSize);\r
1261        Path(1):= NEW SearchStep;\r
1262        Path(1).PageRef := 1;\r
1263        Path(1).RefOnPage := 0;\r
1264      END IndexFile;\r
1265    END Relation;\r
1266 END HandlerOfRelations;\r
1267  \r
1268 BEGIN (* MAIN *)\r
1269  \r
1270 PREF HandlerOfRelations(4,8,2) BLOCK\r
1271  \r
1272 CONST (* couleur:  la definition de ces couleurs varie avec le mode \82cran *)\r
1273       (* il est possible celles ci ne corespondent pas \85 leurs d\82finition *)\r
1274       Noir = 0, Rouge = 1, Vert = 2, Jaune = 3, Bleu = 4, Magenta = 5,\r
1275       Cyan = 6, Blanc = 7, \r
1276       (* attribut carateres *)\r
1277       Normal = 0, Gras = 1, Clignotant = 5, Inverse = 7, Cache = 8,\r
1278       (* code retour clavier *)\r
1279       Fgauche = -75, Fdroite = -77,Fhaut = -72, Fbas = -80,\r
1280       ESC = 27, RETOUR = 13, BKSPACE = 8;\r
1281  \r
1282 (* definition des procedures \82cran et clavier *)\r
1283 \r
1284 (*detection d'une touche *)\r
1285 UNIT inchar : IIuwgraph FUNCTION : INTEGER;\r
1286 VAR i : INTEGER;\r
1287 BEGIN\r
1288   DO RESULT := inkey; IF RESULT =/= 0 THEN EXIT FI OD;\r
1289 END inchar;\r
1290  \r
1291 (*efface l'\82cran et place le curseur en position (1,1) *)\r
1292 UNIT cls : PROCEDURE;\r
1293 BEGIN\r
1294   write( CHR(27),"[2J");\r
1295   CALL GotoXY(1,1)\r
1296 END Cls;\r
1297  \r
1298 (* positionne le curseur en colonne x et ligne y *)\r
1299 UNIT  GotoXY : PROCEDURE(x, y: INTEGER);\r
1300 VAR a,b,c,d : CHAR, i,j : INTEGER;\r
1301 BEGIN\r
1302   i := y DIV 10; j := y MOD 10; a := CHR(48+i); b := CHR(48+j);\r
1303   i := x DIV 10; j := x mod 10; c := CHR(48+i); d := CHR(48+j);\r
1304   write(CHR(27),"[",a,b,";",c,d,"H")\r
1305 END GotoXY;\r
1306  \r
1307 (* definition des couleurs du caracteres et du fon *)\r
1308 UNIT SetColor : PROCEDURE(font,back : INTEGER);\r
1309 BEGIN \r
1310   write(CHR(27),"[","3",CHR(48+font),";4",CHR(48+back),"m");\r
1311 END SetColor;\r
1312  \r
1313 UNIT Text_attr : PROCEDURE(Plus, Attr : INTEGER);\r
1314 BEGIN\r
1315   IF (Plus = 0) THEN write(CHR(27),"[0m") FI;\r
1316   write(CHR(27),"[",CHR(48+Attr),"m");\r
1317 END Text_Attr;\r
1318 \r
1319 (***) \r
1320 \r
1321 \r
1322 (* classe de base d'affichage d'une fiche \85 l'\82cran *)\r
1323 \r
1324 UNIT Base_Fiche : CLASS;\r
1325 VAR Titre :STRING;\r
1326  \r
1327   UNIT VIRTUAL Touche_Aff : PROCEDURE;\r
1328   BEGIN\r
1329   END Touche_Aff;\r
1330  \r
1331   UNIT Affiche : PROCEDURE; (* procedure d'affichage de la base graphique *)\r
1332                             (* permetant la saisie comme la consultation  *)\r
1333   BEGIN\r
1334     CALL setcolor(cyan,bleu);\r
1335     CALL GotoXY(10,5);\r
1336     (* taille du titre: 20 caracteres *)\r
1337     write("                     ",titre,"                    ");\r
1338     CALL GotoXY(10,6);\r
1339     write("                                                             ");\r
1340     CALL setcolor(vert,bleu);\r
1341     CALL GotoXY(10,7);\r
1342     write(" Auteur :                                                    ");\r
1343     CALL GotoXY(10,8);\r
1344     write(" Titre  :                                                    ");\r
1345     CALL GotoXY(10,9);\r
1346     write(" Editeur:                                                    ");\r
1347     CALL GotoXY(10,10);\r
1348     write(" Annee  :                                                    ");\r
1349     CALL GotoXY(10,11);\r
1350     write(" Sujet  :                                                    ");\r
1351     CALL GotoXY(10,12);\r
1352     write(" NøInv  :                                                    ");\r
1353     CALL GotoXY(10,13);\r
1354     write("                                                             ");\r
1355     CALL GotoXY(10,14);\r
1356     CALL setcolor(rouge,bleu);\r
1357     CALL touche_aff;\r
1358     CALL GotoXY(10,15);\r
1359     write("                                                             ");\r
1360   END affiche;\r
1361 \r
1362 END Base_Fiche;\r
1363  \r
1364 \r
1365 \r
1366 UNIT Fiche_Cons : Base_Fiche CLASS;\r
1367  \r
1368   UNIT VIRTUAL Touche_Aff : PROCEDURE;\r
1369   BEGIN END Touche_Aff;\r
1370  \r
1371   UNIT Put_Champs :PROCEDURE;\r
1372   BEGIN\r
1373     IF (L.INV.Ak = NONE)\r
1374       THEN RETURN;\r
1375     FI;\r
1376     CALL Put_Chaine(20,7,L.INV.AutLeng,L.INV.Ak.Author);\r
1377     CALL Put_Chaine(20,8,L.INV.TitLeng,L.INV.Ak.Title);\r
1378     CALL Put_Chaine(20,9,L.INV.PubLeng,L.INV.Ak.Publisher);\r
1379     CALL Put_Entier(20,10,4,L.INV.Ak.Year);\r
1380     CALL Put_Chaine(20,11,L.INV.SubjLeng,L.INV.Ak.Subject);\r
1381     CALL Put_Entier(20,12,5,L.INV.Ak.NoInv);\r
1382   END Put_Champs;\r
1383  \r
1384 BEGIN        \r
1385   Titre := " CONSULTATION LIVRE ";\r
1386   CALL Affiche;\r
1387   CALL Put_Champs;\r
1388 END Fiche_Cons;\r
1389  \r
1390 UNIT Fiche_Saisie : Base_Fiche CLASS;\r
1391  \r
1392   UNIT VIRTUAL Touche_Aff : PROCEDURE;\r
1393   BEGIN\r
1394     write("  [\11ÄÙ]: Validation.      [Esc]: Abandon de la saisie.       ");\r
1395   END touche_aff;\r
1396  \r
1397   UNIT Read_Champs :FUNCTION : BOOLEAN;\r
1398   VAR Code_Saisie : INTEGER;\r
1399   BEGIN\r
1400     DO\r
1401       CALL say("Entrer le Nom de l'Auteur");\r
1402       DO\r
1403         Code_Saisie := Read_Chaine(20,7,L.INV.AutLeng,L.INV.Ak.Author);\r
1404         IF Code_Saisie = 1\r
1405           THEN EXIT EXIT;\r
1406           ELSE IF Code_Saisie = 2\r
1407                  THEN CALL say(\r
1408                            "Saisie Obligatoire du nom de l'auteur");\r
1409                            write(CHR(7),CHR(7));\r
1410                  ELSE EXIT;\r
1411                FI;\r
1412         FI;\r
1413       OD;\r
1414       CALL say("Entrer le Titre du livre");\r
1415       DO\r
1416         Code_Saisie := Read_Chaine(20,8,L.INV.TitLeng,L.INV.Ak.Title);\r
1417         IF Code_Saisie = 1\r
1418           THEN EXIT EXIT;\r
1419           ELSE IF Code_Saisie = 2\r
1420                  THEN CALL say(\r
1421                            "Saisie Obligatoire du titre de l'oeuvre");\r
1422                            write(CHR(7),CHR(7));\r
1423                  ELSE EXIT;\r
1424                FI;\r
1425         FI;\r
1426       OD;\r
1427       CALL say("Entrer le Nom de l'Editeur");\r
1428       DO\r
1429         Code_Saisie := Read_Chaine(20,9,L.INV.PubLeng,L.INV.Ak.Publisher);\r
1430         IF Code_Saisie = 1\r
1431           THEN EXIT EXIT;\r
1432           ELSE IF Code_Saisie = 2\r
1433                  THEN CALL say(\r
1434                            "Saisie Obligatoire du Nom de l'Editeur !");\r
1435                            write(CHR(7),CHR(7));\r
1436                  ELSE EXIT;\r
1437                FI;\r
1438         FI;\r
1439       OD;\r
1440       CALL say("Entrer l'Annee de Parution de l'Oeuvre");\r
1441       DO\r
1442         Code_Saisie := Read_Entier(20,10,4);\r
1443         IF Code_saisie = -1\r
1444           THEN EXIT EXIT;\r
1445           ELSE IF Code_Saisie = -2\r
1446                  THEN CALL say(\r
1447                       "Saisie Obligatoire de l'annee de parution !");\r
1448                       write(CHR(7),CHR(7));\r
1449                  ELSE L.INV.Ak.Year := Code_Saisie;\r
1450                       EXIT;            \r
1451                  FI;\r
1452         FI;\r
1453       OD;\r
1454       CALL say("Entrer le Theme de l'Oeuvre");\r
1455       DO\r
1456         Code_Saisie := Read_Chaine(20,11,L.INV.SubjLeng,L.INV.Ak.Subject);\r
1457         IF Code_saisie = 1\r
1458           THEN EXIT EXIT;\r
1459           ELSE IF Code_Saisie = 2\r
1460                  THEN CALL say(\r
1461                       "Saisie Obligatoire du Theme de l'oeuvre !");\r
1462                       write(CHR(7),CHR(7));\r
1463                  ELSE EXIT;\r
1464                FI;\r
1465         FI;\r
1466       OD;\r
1467       CALL say("Entrer le Numero d'inventaire du livre");\r
1468       DO\r
1469         Code_Saisie := Read_Entier(20,12,5);\r
1470         IF Code_saisie = -1\r
1471           THEN EXIT EXIT;\r
1472           ELSE IF Code_Saisie = -2\r
1473                  THEN CALL say(\r
1474                            "Saisie Obligatoire du Nø Inventaire !");\r
1475                       write(CHR(7),CHR(7));\r
1476                  ELSE L.INV.Ak.NoInv := Code_Saisie;\r
1477                       Code_Saisie := 0;\r
1478                       EXIT EXIT;\r
1479                FI;\r
1480         FI;\r
1481       OD;\r
1482     OD;\r
1483     IF Code_Saisie = 0 THEN RESULT := TRUE FI;\r
1484   END Read_Champs;\r
1485        \r
1486 BEGIN\r
1487   Titre := " FICHE SAISIE LIVRE ";\r
1488   CALL Affiche;\r
1489   ok := Read_Champs;\r
1490 END Fiche_Saisie;\r
1491  \r
1492 UNIT Read_Entier : FUNCTION(x,y,longueur : INTEGER) : INTEGER;\r
1493 VAR val : INTEGER;\r
1494 BEGIN\r
1495   CALL Text_Attr(0,Gras);\r
1496   CALL GotoXY(x,y);\r
1497   FOR i := 1 TO longueur \r
1498   DO\r
1499     write("Û");\r
1500   OD;\r
1501   i := 0;\r
1502   CALL Text_Attr(0,Inverse);\r
1503   CALL GotoXY(x,y);\r
1504   DO\r
1505     val := inchar;\r
1506     CALL GotoXY(x+i,y);\r
1507     CASE val\r
1508       WHEN ESC : RESULT := -1;\r
1509                  RETURN;\r
1510       WHEN RETOUR : IF i = 0\r
1511                       THEN RESULT := -2;\r
1512                     FI;\r
1513                     RETURN;\r
1514       WHEN BKSPACE,\r
1515            FGauche : IF (i = 0)\r
1516                        THEN write(CHR(7))\r
1517                        ELSE i := i-1;\r
1518                             CALL Text_Attr(0,Gras);\r
1519                             CALL GotoXY(x+i,y);\r
1520                             write("Û");\r
1521                             CALL Text_Attr(0,Inverse);\r
1522                             RESULT := ENTIER(RESULT / 10)\r
1523                      FI;\r
1524       OTHERWISE  IF (i = longueur)\r
1525                    THEN write(CHR(7))\r
1526                    ELSE IF (val > 47 AND val < 58)\r
1527                           THEN write(CHR(val));\r
1528                                i := i + 1;\r
1529                                RESULT := RESULT* 10 + (val - 48);\r
1530                           ELSE write(CHR(7));\r
1531                         FI;\r
1532                   FI;\r
1533     ESAC;\r
1534   OD;\r
1535 END Read_Entier;\r
1536  \r
1537 UNIT Put_Entier : PROCEDURE(x,y,longueur : INTEGER;val : INTEGER);\r
1538 VAR c: CHAR;\r
1539 BEGIN\r
1540   CALL Text_Attr(0,Gras); CALL GotoXY(x,y);\r
1541   FOR i := 1 TO longueur DO write("Û") OD;\r
1542   longueur := longueur - 1;\r
1543   CALL GotoXY(x+longueur,y);\r
1544   CALL Text_Attr(0,Inverse);\r
1545   DO\r
1546     c := CHR(48+(val MOD 10));\r
1547     write(c);\r
1548     longueur := longueur - 1;\r
1549     CALL GotoXY(x+longueur,y);\r
1550     val := val DIV 10;\r
1551     IF val = 0 THEN EXIT FI;\r
1552   OD;\r
1553 END Put_Entier;\r
1554  \r
1555 UNIT Read_Chaine : FUNCTION(x,y,longueur :INTEGER;\r
1556                             OUTPUT ch : ARRAYOF CHAR) : INTEGER;\r
1557 VAR val: INTEGER;\r
1558 BEGIN\r
1559   ARRAY ch DIM (1:longueur);\r
1560   CALL Text_Attr(0,Gras);\r
1561   CALL GotoXY(x,y);\r
1562   FOR i := 1 TO longueur DO\r
1563     write("Û");\r
1564   OD;                  \r
1565   i := 0;\r
1566   CALL Text_Attr(0,Inverse);\r
1567   CALL GotoXY(x,y);\r
1568   DO\r
1569     val := INCHAR;\r
1570     CALL GotoXY(x+i,y);\r
1571     CASE val\r
1572       WHEN ESC : RESULT := 1;\r
1573                  RETURN;\r
1574       WHEN RETOUR : IF i = 0\r
1575                       THEN RESULT := 2\r
1576                     FI;\r
1577                     RETURN;\r
1578       WHEN BKSPACE,\r
1579            FGauche : IF (i = 0)\r
1580                        THEN write(CHR(7))\r
1581                        ELSE i := i-1;\r
1582                             CALL Text_Attr(0,Gras);\r
1583                             CALL GotoXY(x+i,y);\r
1584                             write("Û");\r
1585                             CALL Text_Attr(0,Inverse)\r
1586                      FI;\r
1587       WHEN Fdroite : IF (i = longueur - 1)\r
1588                        THEN write(CHR(7))\r
1589                        ELSE write(CHR(32));\r
1590                             i := i + 1;\r
1591                             ch(i) := CHR(32)\r
1592                      FI;\r
1593       OTHERWISE  IF (i = longueur)\r
1594                    THEN write(CHR(7));\r
1595                    ELSE IF (val >=32 AND val <=125)\r
1596                           THEN write(CHR(val));\r
1597                                i := i + 1;\r
1598                                ch(i) := CHR(val)\r
1599                           ELSE write(CHR(7))\r
1600                         FI;\r
1601                  FI;\r
1602     ESAC;\r
1603   OD;\r
1604 END Read_chaine;\r
1605  \r
1606 UNIT Put_chaine : PROCEDURE(x,y,Longueur : INTEGER;ch : ARRAYOF CHAR);\r
1607 BEGIN\r
1608   CALL Text_Attr(0,Gras); CALL GotoXY(x,y);\r
1609   FOR i := 1 TO longueur - 1 DO write("Û") OD;\r
1610   CALL GotoXY(x,y);\r
1611   CALL Text_Attr(0,Inverse);\r
1612   i := 1;\r
1613   DO\r
1614     IF (i > UPPER(ch)) ORIF (ORD(ch(i)) = RETOUR) ORIF (i > Longueur - 1)\r
1615        THEN EXIT fi;\r
1616     write(ch(i));\r
1617     i := i+1;\r
1618   OD;\r
1619 END Put_chaine;\r
1620  \r
1621 \r
1622 UNIT say : PROCEDURE(phrase : string);\r
1623 BEGIN\r
1624     CALL SetColor(noir,cyan);\r
1625     CALL GotoXY(1,25);\r
1626     write(\r
1627 "                                                                               ");\r
1628     CALL GotoXY(2,25);\r
1629     write(phrase);\r
1630     CALL Text_Attr(0,normal);\r
1631 END say;\r
1632  \r
1633 \r
1634 VAR ok : BOOLEAN,\r
1635     L : Library,\r
1636     INFO : ARRAYOF INTEGER,\r
1637     infofile : RFile,\r
1638     extrem : BOOLEAN,\r
1639     i : INTEGER,\r
1640     f : Base_Fiche,\r
1641     menu : CoMenu,\r
1642     DataRef : INTEGER;\r
1643  \r
1644 UNIT Library: CLASS;\r
1645  \r
1646   VAR New_Base : BOOLEAN,\r
1647       INV : Inventory;\r
1648  \r
1649   UNIT Inventory : Relation CLASS;\r
1650   VAR AutLeng, TitLeng, Publeng, SubjLeng : INTEGER;\r
1651  \r
1652   VAR i : INTEGER;\r
1653  \r
1654     UNIT Fiche : Tuple CLASS;\r
1655       VAR Author,\r
1656           Title,\r
1657           Publisher,\r
1658           Subject : ARRAYOF CHAR,\r
1659           Year,\r
1660           NoInv : INTEGER;\r
1661     BEGIN\r
1662       ARRAY Author dim(1:AutLeng);\r
1663       Author(1) := CHR(13);\r
1664       ARRAY Title dim (1:TitLeng);\r
1665       Title(1) := CHR(13);\r
1666       ARRAY Publisher dim (1:Publeng);\r
1667       Publisher(1) := CHR(13);\r
1668       ARRAY Subject dim (1:SubjLeng);\r
1669       Subject(1) := CHR(13);\r
1670     END Fiche;\r
1671  \r
1672     UNIT VIRTUAL TupleToArray : FUNCTION(F : Fiche):ARRAYOF INTEGER;\r
1673     VAR AuxRec :ARRAYOF INTEGER,\r
1674         i,cpt :INTEGER;\r
1675     BEGIN\r
1676       ARRAY AuxRec DIM (1:137);\r
1677       FOR i := 1 TO AutLeng\r
1678       DO\r
1679         AuxRec(i) :=\r
1680         ORD(F.Author(i));\r
1681         IF ORD(F.Author(i)) = 13\r
1682           THEN EXIT\r
1683         FI\r
1684       OD;\r
1685       cpt := AutLeng;\r
1686       FOR i := 1 TO TitLeng\r
1687       DO\r
1688         AuxRec(cpt+i) := ORD(F.Title(i));\r
1689         IF ORD(F.Title(i)) = 13\r
1690           THEN EXIT\r
1691         FI\r
1692       OD;\r
1693       cpt := cpt + TitLeng;\r
1694       FOR i := 1 TO Publeng\r
1695       DO\r
1696         AuxRec(cpt+i) := ORD(F.Publisher(i));\r
1697         IF ORD(F.Publisher(i)) = 13\r
1698           THEN EXIT\r
1699         FI\r
1700       OD;\r
1701       cpt := cpt + Publeng;\r
1702       FOR i := 1 TO SubjLeng\r
1703       DO\r
1704         AuxRec(cpt+i) := ORD(F.Subject(i));\r
1705         IF ORD(F.Subject(i)) = 13\r
1706           THEN EXIT\r
1707         FI\r
1708       OD;\r
1709       cpt := cpt + SubjLeng;\r
1710       AuxRec(cpt+1) := F.Year;\r
1711       AuxRec(cpt+2) := F.NoInv;\r
1712       RESULT := AuxRec;\r
1713     END TupleToArray;\r
1714  \r
1715     UNIT VIRTUAL ArrayToTuple : FUNCTION (A :ARRAYOF INTEGER) :Fiche;\r
1716     VAR f: Fiche,\r
1717         i, cpt :INTEGER;\r
1718     BEGIN\r
1719       f := NEW Fiche;\r
1720       FOR i := 1 TO AutLeng\r
1721       DO\r
1722         f.Author(i) := CHR(A(i));\r
1723         IF A(i) = 13\r
1724           THEN EXIT\r
1725         FI\r
1726       OD;\r
1727       cpt := AutLeng;\r
1728       FOR i := 1 TO TitLeng\r
1729       DO\r
1730         f.Title(i) := CHR(A(cpt+i));\r
1731         IF ORD(f.Title(i)) = 13\r
1732           THEN EXIT\r
1733         FI\r
1734       OD;\r
1735       cpt := cpt + TitLeng;\r
1736       FOR i := 1 TO Publeng\r
1737       DO\r
1738         f.Publisher(i) := CHR(A(cpt+i));\r
1739         IF ORD(f.Publisher(i)) = 13\r
1740           THEN EXIT\r
1741         FI\r
1742       OD;\r
1743       cpt := cpt + Publeng;\r
1744       FOR i := 1 TO SubjLeng\r
1745       DO\r
1746         f.Subject(i) := CHR(A(cpt+i));\r
1747         IF ORD(f.Subject(i)) = 13\r
1748           THEN EXIT\r
1749         FI\r
1750       OD;\r
1751       cpt := cpt + SubjLeng;\r
1752       f.Year := A(cpt+1);\r
1753       f.NoInv := A(cpt+2);\r
1754       RESULT := f\r
1755     END ArrayToTuple;\r
1756  \r
1757     UNIT NoInvCatalogue : IndexFile COROUTINE;\r
1758  \r
1759       UNIT cleNo :Key CLASS;\r
1760       VAR NoInv : INTEGER;\r
1761       BEGIN END cleNo;\r
1762  \r
1763       UNIT VIRTUAL KeyOf:FUNCTION (f :Fiche) :cleNo;\r
1764       BEGIN\r
1765         RESULT := NEW cleNo;\r
1766         RESULT.NoInv := f.NoInv;\r
1767       END KeyOf;\r
1768  \r
1769       UNIT VIRTUAL Leq : FUNCTION (k1,k2 : cleNo) : BOOLEAN;\r
1770       BEGIN\r
1771         RESULT := TRUE;\r
1772         IF (k1.NoInv > k2.NoInv)\r
1773           THEN RESULT := FALSE\r
1774         FI\r
1775       END Leq;\r
1776  \r
1777       UNIT VIRTUAL KeyToRec :PROCEDURE(ky:cleNo, A :ARRAYOF INTEGER;\r
1778                                        j :INTEGER);\r
1779       BEGIN\r
1780         A(j) := ky.NoInv\r
1781       END KeyToRec;\r
1782  \r
1783       UNIT VIRTUAL RecToKey : FUNCTION(A: ARRAYOF INTEGER,j:INTEGER): cleNo;\r
1784       BEGIN\r
1785         RESULT := NEW cleNo;\r
1786         RESULT.NoInv := A(j);\r
1787       END RecToKey;\r
1788  \r
1789     VAR Akey_NoInv : cleNo;\r
1790  \r
1791     BEGIN (* NoInvCatalogue *)\r
1792       (* OUVERTURE du FICHIER INDEX *)\r
1793       KeySize := 1;\r
1794       Akey_NoInv := NEW cleNo;\r
1795       IF New_Base\r
1796         THEN df := MakeFile(UNPACK("NoInv.idx"),2+(PageSize*(KeySize+2)));\r
1797         ELSE df := OpenFile(UNPACK("NoInv.idx"),2+(PageSize*(KeySize+2)));\r
1798              Path(1).PageRef := INFO(1);\r
1799              Path(1).RefOnPage := 1;\r
1800              CALL Fseek(df,Path(1).PageRef);\r
1801              AuxRec := Fget(df);\r
1802              StackOfPages(1) := RecToPage(AuxRec);\r
1803              KILL(AuxRec);\r
1804       FI;\r
1805       RETURN;\r
1806       (* FERMETURE DU FICHIER INDEX *)\r
1807       FOR i := 1 TO TreeHeight\r
1808       DO\r
1809         IF Path(i) = NONE THEN EXIT FI;\r
1810         IF Path(i).updated\r
1811           THEN CALL Fseek(df,Path(i).PageRef);\r
1812                CALL Fput(df,PageToRec(StackOfPages(i)));\r
1813                Path(i).updated := FALSE\r
1814         FI\r
1815       OD;\r
1816       INFO(1) := Path(1).PageRef;\r
1817       CALL CloseFile(df)\r
1818     END NoInvCatalogue;\r
1819  \r
1820     UNIT AuthorsCatalogue : IndexFile COROUTINE;\r
1821  \r
1822       UNIT cleA :Key CLASS;\r
1823       VAR Author :ARRAYOF CHAR,\r
1824           NoInv : INTEGER;\r
1825       BEGIN\r
1826         ARRAY Author dim (1:AutLeng);\r
1827       END cleA;\r
1828  \r
1829       UNIT VIRTUAL KeyOf:FUNCTION (f :Fiche) :cleA;\r
1830       BEGIN\r
1831         RESULT := NEW cleA;\r
1832         RESULT.Author := COPY(f.Author);\r
1833         RESULT.NoInv := f.NoInv;\r
1834       END KeyOf;\r
1835  \r
1836       UNIT VIRTUAL Leq : FUNCTION (k1,k2 : cleA) : BOOLEAN;\r
1837       VAR i: INTEGER;\r
1838       BEGIN\r
1839         RESULT := TRUE;\r
1840         FOR i := 1 to AutLeng\r
1841         DO\r
1842           IF ORD(k1.Author(i)) =13\r
1843             THEN RETURN\r
1844             ELSE IF ORD(k2.Author(i)) = 13\r
1845                    THEN RESULT := FALSE;\r
1846                         RETURN\r
1847                  FI\r
1848           FI;\r
1849           IF ORD(k1.Author(i)) =/= ORD(k2.Author(i))\r
1850             THEN IF ORD(k1.Author(i)) > ORD(k2.Author(i))\r
1851                    THEN RESULT := FALSE\r
1852                  FI;\r
1853                  RETURN\r
1854           FI;\r
1855         OD;\r
1856         IF (k1.NoInv > k2.NoInv)\r
1857           THEN RESULT := FALSE\r
1858         FI\r
1859       END Leq;\r
1860  \r
1861       UNIT VIRTUAL KeyToRec :PROCEDURE(ky:cleA, A :ARRAYOF INTEGER;\r
1862                                        j :INTEGER);\r
1863       VAR i : INTEGER;\r
1864       BEGIN\r
1865         FOR i := 1 TO AutLeng\r
1866         DO\r
1867           A(j+i-1) := ORD(ky.Author(i))\r
1868         OD;\r
1869         A(j+AutLeng) := ky.NoInv\r
1870       END KeyToRec;\r
1871  \r
1872       UNIT VIRTUAL RecToKey : FUNCTION(A: ARRAYOF INTEGER,j:INTEGER): cleA;\r
1873       BEGIN\r
1874         RESULT := NEW cleA;\r
1875         FOR i := 1 TO AutLeng\r
1876         DO\r
1877           RESULT.Author(i) := CHR(A(j+i-1))\r
1878         OD;\r
1879         RESULT.NoInv := A(j+AutLeng);\r
1880       END RecToKey;\r
1881  \r
1882       VAR Akey_Author : cleA;\r
1883  \r
1884       BEGIN (* AuthorsCatalogue *)\r
1885          (* OUVERTURE du FICHIER INDEX *)\r
1886          KeySize := AutLeng + 1;\r
1887          Akey_Author := NEW cleA;\r
1888          IF New_Base\r
1889            THEN df := MakeFile(unpack("Authors.idx"),2+(PageSize*(KeySize+2)));\r
1890            ELSE df := OpenFile(unpack("Authors.idx"),2+(PageSize*(KeySize+2)));\r
1891                 Path(1).PageRef := INFO(2);\r
1892                 Path(1).RefOnPage := 1;\r
1893                 CALL Fseek(df,Path(1).PageRef);\r
1894                 AuxRec := Fget(df);\r
1895                 StackOfPages(1) := RecToPage(AuxRec);\r
1896                 KILL(AuxRec);\r
1897          FI;\r
1898          RETURN;\r
1899          (* FERMETURE DU FICHIER INDEX *)\r
1900          FOR i := 1 TO TreeHeight\r
1901          DO\r
1902            IF Path(i) = NONE THEN EXIT FI;\r
1903            IF Path(i).updated\r
1904              THEN CALL Fseek(df,Path(i).PageRef);\r
1905                   CALL Fput(df,PageToRec(StackOfPages(i)));\r
1906                   Path(i).updated := FALSE\r
1907            FI\r
1908          OD;\r
1909          INFO(2) := Path(1).PageRef;\r
1910          CALL CloseFile(df)\r
1911        END AuthorsCatalogue;\r
1912  \r
1913        VAR CA :AuthorsCatalogue,\r
1914            CInv : NoInvCatalogue,\r
1915            NBindexs : INTEGER,\r
1916            Ak : Fiche;\r
1917  \r
1918   BEGIN (* Inventory *)\r
1919     IF New_Base\r
1920       THEN df := MakeFile(UNPACK("LIBRARY.DAT"),137)\r
1921       ELSE df := OpenFile(UNPACK("LIBRARY.DAT"),137)\r
1922     FI;\r
1923     NBindexs := 2;\r
1924     ARRAY Indexs DIM (1:NBindexs);\r
1925     AutLeng := 25; TitLeng := 50; Publeng := 40; SubjLeng := 20;\r
1926     Ak := NEW Fiche;\r
1927     Indexs(1),CInv := NEW NoInvCatalogue;\r
1928     Indexs(2),CA := NEW AuthorsCatalogue;\r
1929   END Inventory;\r
1930  \r
1931   UNIT OpenLIB : PROCEDURE;\r
1932   BEGIN\r
1933     infofile := OpenFile(UNPACK("library.bas"),3);\r
1934     INFO := Fget(InfoFile);\r
1935     INV := NEW Inventory;\r
1936     INV.FreePlace := INFO(3);\r
1937   END OpenLIB;\r
1938  \r
1939   UNIT MakeLIB : PROCEDURE;\r
1940   BEGIN\r
1941     infofile := MakeFile(UNPACK("library.bas"),3);\r
1942     INV := NEW Inventory;\r
1943   END MakeLIB;\r
1944  \r
1945   UNIT CloseLIB : PROCEDURE;\r
1946   VAR i : INTEGER;\r
1947   BEGIN\r
1948     CALL cls;\r
1949     CALL Text_Attr(0,Gras);\r
1950     writeln("> FIN DU PROGRAMME BIBLIOTHEQUE.");\r
1951     CALL CloseFile(INV.df);\r
1952     FOR i := 1 TO INV.NBindexs DO\r
1953       ATTACH(INV.Indexs(i))\r
1954     OD;\r
1955     INFO(3) := INV.FreePlace;\r
1956     CALL Frewind(InfoFile);\r
1957     CALL Fput(InfoFile,INFO);\r
1958     CALL CloseFile(InfoFile);\r
1959     CALL ENDRUN;\r
1960   END CloseLIB;\r
1961  \r
1962 BEGIN (* Library *)\r
1963   ARRAY INFO dim (1:3);\r
1964   CALL cls;\r
1965   CALL setcolor(noir,vert);\r
1966   CALL GotoXY(2,1);\r
1967   write("ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» ");\r
1968   CALL GotoXY(2,2);\r
1969   write("º ABDILLAHI Ibrahim  º ");\r
1970   CALL GotoXY(2,3);\r
1971   write("º AMBAUD Richard     º ");\r
1972   CALL GotoXY(2,4);\r
1973   write("º AMIGO Patrick      º ");\r
1974   CALL GotoXY(2,5);\r
1975   write("º BRIGIDO Angel      º ");\r
1976   CALL GotoXY(2,6);\r
1977   write("º COSTES Francois    º ");\r
1978   CALL GotoXY(2,7);\r
1979   write("º COUDERC Christophe º ");\r
1980   CALL GotoXY(2,8);\r
1981   write("º CUESTA Mireille    º ");\r
1982   CALL GotoXY(2,9);\r
1983   write("º IBARBIDE Sandrine  º ");\r
1984   CALL GotoXY(2,10);\r
1985   write("ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼ ");\r
1986   CALL setcolor(blanc,rouge);\r
1987   CALL GotoXY(35,12);\r
1988   write(" GESTION ");\r
1989   CALL GotoXY(36,13);\r
1990   write(" D'UNE ");\r
1991   CALL GotoXY(33,14);\r
1992   write(" BIBLIOTHEQUE ");\r
1993   CALL setcolor(magenta,bleu);\r
1994   CALL GotoXY(8,23);\r
1995   write("ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿");\r
1996   CALL GotoXY(8,24);\r
1997   write("³ Voulez-vous utilisez une nouvelle base de donn\82es (O/N) ? :   ³");\r
1998   CALL GotoXY(8,25);\r
1999   write("ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ");\r
2000   CALL GotoXY(70,24);\r
2001   CALL setcolor(blanc,noir);\r
2002   DO\r
2003     i := INCHAR;\r
2004     CASE i\r
2005       WHEN ESC : CALL cls;\r
2006                  CALL GotoXY(1,1);\r
2007                  writeln("Sortie [ESCAPE], retour au systeme.");\r
2008                  CALL ENDRUN;\r
2009       WHEN 79,89,\r
2010            111,121 : (* OUI *)\r
2011                     write("O");\r
2012                     New_Base := TRUE;\r
2013                     CALL MakeLIB;\r
2014                     EXIT;\r
2015       WHEN 78,110 : (* NON *)\r
2016                     write("N");\r
2017                     New_Base := FALSE;\r
2018                     CALL OpenLIB;\r
2019                     EXIT;\r
2020       OTHERWISE write(CHR(7));\r
2021     ESAC;\r
2022   OD;\r
2023   CALL GotoXY(1,25);\r
2024   FOR i:=1 to 25 \r
2025   DO\r
2026     writeln;\r
2027   OD;\r
2028   CALL CLS;\r
2029 END Library;\r
2030  \r
2031 UNIT CoMenu : COROUTINE;\r
2032 CONST nbchoix = 4;\r
2033 VAR tchoix : ARRAYOF string,\r
2034     choix,i : INTEGER;\r
2035  \r
2036   UNIT mov_choix: PROCEDURE(No: INTEGER);\r
2037   BEGIN\r
2038     CALL setcolor(blanc,noir);\r
2039     CALL affchoix(34,choix+5,tchoix(choix));\r
2040     choix := choix+No;\r
2041     IF (choix > nbchoix)\r
2042       THEN choix := 1;\r
2043       ELSE IF (choix = 0)\r
2044              THEN choix := nbchoix;\r
2045            FI;\r
2046     FI;\r
2047     CALL text_attr(1,inverse);\r
2048     CALL affchoix(34,choix+5,tchoix(choix));\r
2049     CASE (choix)\r
2050       WHEN 1: CALL say(\r
2051               "Ajouter des livres \85 la librairie.");\r
2052       WHEN 2: CALL say(\r
2053               "Suprimer des livres de la librairie.");\r
2054       WHEN 3: CALL say(\r
2055               "Rechercher un livre \85 partir des catalogues (auteurs/sujets).");\r
2056       WHEN 4: CALL say(\r
2057               "Quitter ");\r
2058     ESAC;\r
2059   END mov_choix;\r
2060  \r
2061   UNIT affchoix : PROCEDURE(x,y : INTEGER;ch : string);\r
2062   VAR i : INTEGER;\r
2063   BEGIN\r
2064     CALL GotoXY(x,y);\r
2065     write(ch);\r
2066   END affchoix;\r
2067  \r
2068 \r
2069 BEGIN  (* CoMenu *)\r
2070   ARRAY tchoix DIM (1:nbchoix);\r
2071   tchoix(1) := "AJOUTER   ";\r
2072   tchoix(2) := "SUPPRIMER ";\r
2073   tchoix(3) := "RECHERCHER";\r
2074   tchoix(4) := "QUITTER   ";\r
2075   choix := 1;\r
2076   RETURN;\r
2077   DO\r
2078     CALL cls;\r
2079     CALL setcolor(jaune,noir);\r
2080     CALL GotoXY(1,5);\r
2081     writeln("                               ÚÄÄÄÄMenuÄÄÄÄ¿");\r
2082     writeln("                               ³            ³");\r
2083     writeln("                               ³            ³");\r
2084     writeln("                               ³            ³");\r
2085     writeln("                               ³            ³");\r
2086     writeln("                               ÀÄÄÄÄÄÄÄÄÄÄÄÄÙ");\r
2087     CALL GotoXY(1,5);\r
2088     CALL setcolor(blanc,noir);\r
2089     FOR i := 1 TO nbchoix \r
2090     DO\r
2091       CALL affchoix(34,i+5,tchoix(i));\r
2092     OD;\r
2093     CALL mov_choix(0);\r
2094     DO\r
2095       i := INCHAR;\r
2096       CASE i\r
2097         WHEN Fhaut  : CALL mov_choix(-1);\r
2098         WHEN Fbas   : CALL mov_choix(1);\r
2099         WHEN ESC    : CALL mov_choix(4-choix);\r
2100                       DETACH;\r
2101                       EXIT;\r
2102         WHEN RETOUR : DETACH;\r
2103                       EXIT;\r
2104         OTHERWISE REPEAT;\r
2105       ESAC;\r
2106     OD;\r
2107   OD;\r
2108 END CoMenu;\r
2109  \r
2110 HANDLERS\r
2111   WHEN Del_Rec_Inexistant:\r
2112        RETURN;\r
2113   WHEN Signal11 :\r
2114        extrem := TRUE;\r
2115        RETURN;\r
2116   WHEN Signal12 :\r
2117        extrem := TRUE;\r
2118        RETURN;\r
2119 END HANDLERS;\r
2120  \r
2121 (*******************************************************************)\r
2122 (******************** programme principal **************************)\r
2123 (*******************************************************************)\r
2124 \r
2125 BEGIN\r
2126   CALL Text_Attr(0,Normal);\r
2127   CALL cls;\r
2128   L := NEW Library;\r
2129   Menu := NEW CoMenu;\r
2130   DO\r
2131     ATTACH(menu);\r
2132     CASE Menu.choix\r
2133       WHEN 1: (* INSERTION de TUPLES dans la BASE *)\r
2134               CALL cls;\r
2135               DO\r
2136                 f := NEW Fiche_Saisie;\r
2137                 IF ok\r
2138                   THEN CALL L.INV.InsertTuple(L.INV.Ak);\r
2139                        CALL say(\r
2140                        "INSERTION REALISEE, Taper une touche pour continuer");\r
2141                        i := INCHAR;\r
2142                        KILL(f);\r
2143                   ELSE EXIT\r
2144                 FI;\r
2145               OD;\r
2146               KILL(f);\r
2147       WHEN 2: (* DESTRUCTION de TUPLES de la BASE *)\r
2148               DO\r
2149                 CALL say(\r
2150      "No inventaire du livre a supprimer ?:        [ESC] = Abandon");\r
2151                 L.INV.Ak.NoInv := Read_Entier(40,25,5);\r
2152                 IF (L.INV.Ak.NoInv =/= -1) AND (L.INV.Ak.NoInv =/= -2)\r
2153                   THEN L.INV.CInv.AKey_NoInv := L.INV.CInv.KeyOf(L.INV.Ak);\r
2154                        DataRef := L.INV.CInv.FindKey(L.INV.CInv.AKey_NoInv);\r
2155                        IF (DataRef = -1)\r
2156                          THEN write(chr(7));\r
2157                               CALL say(\r
2158            "SUPPRESSION DE LIVRE INEXISTANT !!!. taper une touche");\r
2159                               i := INCHAR;\r
2160                          ELSE writeln("DATAREF = ",dataref);\r
2161                               CALL L.INV.DeleteTuple(L.INV.Ak);\r
2162                               CALL say(\r
2163            "SUPPRESSION REALISEE !!!. taper une touche");\r
2164                               i := INCHAR;\r
2165  \r
2166                        FI;\r
2167                   ELSE EXIT;\r
2168                 FI\r
2169               OD;\r
2170       WHEN 3: (* RECHERCHE de TUPLES dans la BASE *)\r
2171  \r
2172       WHEN 4: (* CONFIRMATION DE LA SORTIE *)\r
2173               CALL setcolor(blanc,noir);\r
2174               CALL cls;\r
2175               write(chr(7));\r
2176               CALL setcolor(blanc,rouge);\r
2177               CALL Gotoxy(13,10);\r
2178               write("            CONFIRMER LA SORTIE DU PROGRAMME          ");\r
2179               CALL Gotoxy(13,11);\r
2180               write("                                                      ");\r
2181               CALL Gotoxy(13,12);\r
2182               write("                 SORTIR ( O / N ) ?                   ");\r
2183               CALL setcolor(blanc,noir);\r
2184               DO\r
2185                 i := INCHAR;\r
2186                 CASE i\r
2187                   WHEN 79,111 : (* OUI =  "O" ou "o"  *)\r
2188                                 CALL L.CloseLIB; \r
2189                   WHEN 78,110 : (* NON =  "N" ou "n"  *)\r
2190                                 CALL GotoXY(59,12); \r
2191                                 CALL cls;\r
2192                                 EXIT;\r
2193                   OTHERWISE write(CHR(7));\r
2194                             (*REPEAT*)\r
2195                 ESAC;\r
2196               OD;\r
2197     ESAC;\r
2198     CALL Menu.mov_choix(0);\r
2199   OD;\r
2200 END;\r
2201 \r
2202 \r
2203 END BIBLIOTHEQUE\r
2204 (****************************************************************************)\r