examples/data_str/new.log

   1 Program BArbres;\r
   2 (*****************************************************************************)\r
   3 (*                                                                           *)\r
   4 (*                PROJET LI1 Nø1              pour le 15/01/94               *)\r
   5 (*                                                                           *)\r
   6 (* PATAUD Frederic                                                           *)\r
   7 (* PEYRAT Francois                                                           *)\r
   8 (*                                                                           *)\r
   9 (*                           Structure des Barbres                           *)\r
  10 (*                                                                           *)\r
  11 (*****************************************************************************)\r
  12 \r
  13 \r
  14 (*****************************************************************************)\r
  15 (*                         Structure d'une donnees                           *)\r
  16 (*****************************************************************************)\r
  17 Unit STData : class;\r
  18 var data : integer;\r
  19 End STData;\r
  20 \r
  21 \r
  22 \r
  23 (*****************************************************************************)\r
  24 (*                    Structure d'une page d'un B_Arbre                      *)\r
  25 (*****************************************************************************)\r
  26 Unit STPage : class (N : integer);\r
  27 Var pere   : STPage;\r
  28 var nbdata : integer;\r
  29 var data   : arrayof STData;\r
  30 var fils   : arrayof STPage;\r
  31 Begin\r
  32  nbdata:=0;               (* A l'initialisation il n'y a pas de data         *)\r
  33  array data dim (1:2*N);  (* Il y a au plus 2n donnees dans une page         *)\r
  34  array fils dim (1:2*N+1);(* et au plus 2n+1 fils.                           *)\r
  35  pere:=none;              (* Aucun pere n'est definit \85 la creation.         *)\r
  36 End STPage;\r
  37 \r
  38 \r
  39 \r
  40 (*****************************************************************************)\r
  41 (*                 retourne 1 si elmt1 > elmt2  sinon 0                      *)\r
  42 (*****************************************************************************)\r
  43 Unit Superieur : function (elmt1,elmt2 : STData) : boolean;\r
  44 Begin\r
  45  if elmt1.data>elmt2.data\r
  46  then result:=true\r
  47  else result:=false\r
  48  fi\r
  49 End Superieur;\r
  50 \r
  51 \r
  52 \r
  53 (*****************************************************************************)\r
  54 (*                 retourne 1 si elmt1 < elmt2  sinon 0                      *)\r
  55 (*****************************************************************************)\r
  56 Unit Inferieur : function (elmt1,elmt2 : STData) : boolean;\r
  57 Begin\r
  58  if elmt1.data<elmt2.data\r
  59  then result:=true\r
  60  else result:=false\r
  61  fi\r
  62 End Inferieur;\r
  63 \r
  64 \r
  65 \r
  66 (*****************************************************************************)\r
  67 (*                 retourne 1 si elmt1 = elmt2  sinon 0                      *)\r
  68 (*****************************************************************************)\r
  69 Unit Egalite : function (elmt1,elmt2 : STData) : boolean;\r
  70 Begin\r
  71  if elmt1.data=elmt2.data\r
  72  then result:=true\r
  73  else result:=false\r
  74  fi\r
  75 End Egalite;\r
  76 \r
  77 \r
  78 \r
  79 (*****************************************************************************)\r
  80 (*                                                                           *)\r
  81 (*****************************************************************************)\r
  82 Unit Barbre : class (N : integer);\r
  83 Var root : STPage;\r
  84 \r
  85 \r
  86  (****************************************************************************)\r
  87  (*            Retourne un booleen indiquant si l'arbre est vide             *)\r
  88  (****************************************************************************)\r
  89  Unit Vide : function : boolean;\r
  90  Begin\r
  91   result:=root.nbdata=0;  (* Si la racine n'a pas d'element alors arbre vide *)\r
  92  End Vide;\r
  93 \r
  94 \r
  95  (****************************************************************************)\r
  96  (*                Retourne la valeur du minimun de l'arbre                  *)\r
  97  (****************************************************************************)\r
  98  Unit Minimum : function (output data : STData) : boolean;\r
  99  var page : STPage\r
 100  Begin\r
 101   call outgtext("Recherche minimum...");\r
 102   if not vide\r
 103   then page:=root;\r
 104        do\r
 105         if page.fils(1)=none        (* le minimum se trouve le plus en bas  *)\r
 106         then data:=page.data(1);  (* \85 gauche de l'arbre                  *)\r
 107              exit\r
 108         fi;\r
 109         page:=page.fils(1);\r
 110        od;\r
 111        result:=true;\r
 112   else call outgtext("L'arbre est vide !!!");          (* il y a une erreur  *)\r
 113        result:=false;\r
 114   fi\r
 115  End Minimum;\r
 116 \r
 117 \r
 118  (****************************************************************************)\r
 119  (*                 Retourne la valeur du maximum de l'arbre                 *)\r
 120  (****************************************************************************)\r
 121  Unit Maximum : function (output data : STData) : boolean;\r
 122  Var page : STPage;\r
 123  Begin\r
 124   call outgtext("Recherche maximum...");\r
 125   if not vide\r
 126   then page:=root;\r
 127        do\r
 128         if page.fils(page.nbdata)=none       (* le maximum est l'element le *)\r
 129         then data:=page.data(page.nbdata); (* plus \85 droite de l'arbre    *)\r
 130              exit\r
 131         fi;\r
 132         page:=page.fils(page.nbdata+1);\r
 133        od;\r
 134        result:=true;\r
 135   else call outgtext("L'arbre est vide !!!");\r
 136        result:=false;\r
 137   fi;\r
 138  End Maximum;\r
 139 \r
 140 \r
 141  (****************************************************************************)\r
 142  (*   Retourne vraie si l'element elmt est dans l'arbre ainsi que la page    *)\r
 143  (*     la recherche va se faire par dichotomie, ameliorant le nombre de     *)\r
 144  (*  comparaisons necessaire pour trouver :                                  *)\r
 145  (*                                    -soit l'element dans la page courante *)\r
 146  (*                                    -soit la page suivante a examiner     *)\r
 147  (****************************************************************************)\r
 148  Unit Membre : function (input elmt : STData; output page : STPage) : boolean;\r
 149  Var a,milieu,b : integer;\r
 150  Begin\r
 151   call outgtext("Recherche donn\82e...");\r
 152   result:=false;\r
 153   if not vide\r
 154   then page:=root;\r
 155        do\r
 156         a:=0;                            (* a=debut de l'intervalle         *)\r
 157         b:=page.nbdata+1;                (* b=fin de l'intervalle           *)\r
 158         do\r
 159          milieu:=(a+b) div 2;           (* milieu = milieu de l'intervalle *)\r
 160          if Superieur(page.data(milieu),elmt)\r
 161          then b:=milieu\r
 162          else a:=milieu\r
 163          fi;\r
 164          if Egalite(page.data(milieu),elmt)\r
 165          then result:=true;             (* on a trouve l'element           *)\r
 166               exit\r
 167          else if (b-a)=1                (* on sort sans avoir touver       *)\r
 168               then exit\r
 169               fi;\r
 170          fi\r
 171         od;\r
 172         if result\r
 173         then exit\r
 174         fi;\r
 175         if page.fils(1)=none             (*  si plus de page alors on sort  *)\r
 176         then exit\r
 177         fi;\r
 178         if Superieur(page.data(milieu),elmt)     (* sinon on change de page *)\r
 179         then page:=page.fils(milieu)\r
 180         else page:=page.fils(milieu+1)\r
 181         fi\r
 182        od\r
 183   else call outgtext("L'arbre est vide!!!");\r
 184   fi;\r
 185  End Membre;\r
 186 \r
 187 \r
 188 \r
 189  (****************************************************************************)\r
 190  (*                         Insertion d'un element                           *)\r
 191  (****************************************************************************)\r
 192  Unit Insertion : procedure (elmt : STData);\r
 193  Var a,milieu,b,i : integer;\r
 194  var aux_fils     : arrayof STPage;\r
 195  var aux_data     : arrayof STData;\r
 196  var pagenew,page : STPage;\r
 197  var sauv1,sauv2  : STPage;\r
 198  Begin\r
 199   page:=root;\r
 200   if vide                       (* on insert la premiere donnee dans l'arbre *)\r
 201   then page.data(1):=elmt;\r
 202        page.nbdata:=1;\r
 203        call outgtext("L'element a ete ajoute.")\r
 204   else if not membre(elmt,page)          (* l'element elmt n'existe pas deja *)\r
 205        then do\r
 206              if page <> none    (* s'il ne faut pas creer une nouvelle page *)\r
 207              then a:=0;\r
 208                   b:=page.nbdata+1;\r
 209                   do  (* recherche dichotomique de la position dans la page *)\r
 210                    milieu:=(a+b) div 2;\r
 211                    if Superieur(page.data(milieu),elmt)\r
 212                    then b:=milieu\r
 213                    else a:=milieu\r
 214                    fi;\r
 215                    if (b-a)=1\r
 216                    then exit\r
 217                    fi;\r
 218                   od;\r
 219                   if Inferieur(page.data(milieu),elmt)\r
 220                   then milieu:=milieu+1\r
 221                   fi;\r
 222                   if page.nbdata < 2*N (* si on n'a pas le maximum d'elments*)\r
 223                   then for i:=page.nbdata downto milieu\r
 224                        do               (* on decale pour inserer l'element *)\r
 225                         page.data(i+1):=page.data(i);\r
 226                         page.fils(i+2):=page.fils(i+1)\r
 227                        od;\r
 228                        page.data(milieu):=elmt;      (* on insert l'element *)\r
 229                        page.fils(milieu+1):=pagenew;\r
 230                        page.nbdata:=page.nbdata+1;\r
 231                        exit\r
 232                   else a:=1;\r
 233                        b:=page.nbdata+1;\r
 234                        array aux_data dim (a:b);\r
 235                        array aux_fils dim (a:b+1);\r
 236                        for i:=1 to milieu-1         (* on sauve les donnees *)\r
 237                        do\r
 238                         aux_data(i):=page.data(i);\r
 239                         aux_fils(i):=page.fils(i);\r
 240                        od;\r
 241                        aux_fils(i):=page.fils(i);\r
 242                        aux_data(milieu):=elmt;\r
 243                        aux_fils(milieu+1):=pagenew;\r
 244                        for i:=milieu to 2*N\r
 245                        do\r
 246                         aux_data(i+1):=page.data(i);\r
 247                         aux_fils(i+2):=page.fils(i);\r
 248                        od;\r
 249                        pagenew:= new STPage(N);\r
 250                        page.nbdata:=n;\r
 251                        pagenew.nbdata:=n;\r
 252                        for i:=1 to n                    (* on coupe en deux *)\r
 253                        do\r
 254                         pagenew.data(i):=aux_data(n+1+i);\r
 255                         page.data(i):=aux_data(i);\r
 256                         pagenew.fils(i):=aux_fils(n+1+i);\r
 257                         page.fils(i):=aux_fils(i);\r
 258                        od;\r
 259                        pagenew.fils(i):=aux_fils(n+1+i);\r
 260                        page.fils(i):=aux_fils(i);\r
 261                        elmt:=aux_data(n+1);\r
 262                        sauv1:=page;\r
 263                        if page.fils(1) <> none   (* on rechaine les parents *)\r
 264                        then for i:=1 to n+1\r
 265                             do\r
 266                              pagenew.fils(i).pere:=pagenew;\r
 267                             od\r
 268                        fi;\r
 269                        pagenew.pere:=page.pere;\r
 270                        page:=page.pere;\r
 271                        kill(aux_data);          (* on efface les            *)\r
 272                        kill(aux_fils);          (* variables intermediaires *)\r
 273                   fi\r
 274              else sauv2:=pagenew;\r
 275                   pagenew:= new STPage(N);  (* creation d'une nouvelle page *)\r
 276                   pagenew.nbdata:=1;\r
 277                   pagenew.data(1):=elmt;\r
 278                   pagenew.fils(1):=sauv1;\r
 279                   pagenew.fils(2):=sauv2;\r
 280                   sauv1.pere:=pagenew;\r
 281                   sauv2.pere:=pagenew;\r
 282                   root:=pagenew;             (* il y a changement de racine *)\r
 283                   exit\r
 284              fi\r
 285             od;\r
 286             call outgtext("L'\82l\82ment a ete ajoute.");\r
 287        else call outgtext("L'\82l\82ment existe deja!");(* l'element existe deja *)\r
 288        fi\r
 289   fi\r
 290  End Insertion;\r
 291 \r
 292 \r
 293  (****************************************************************************)\r
 294  (*                       Suppression d'un element                           *)\r
 295  (****************************************************************************)\r
 296  Unit Supprimer : procedure (elmt : STData);\r
 297  var a,milieu,b,i : integer;\r
 298  var aux_data     : arrayof STData;\r
 299  var aux_fils     : arrayof STPage;\r
 300  var page,avant   : STPage;\r
 301  var courant,pere : STPage;\r
 302  var pred,aux     : integer;\r
 303 \r
 304  Begin\r
 305   if vide                                             (* l'arbre est vide ?! *)\r
 306   then call outgtext("L'arbre est vide!!!")\r
 307   else page:=root;\r
 308        if not membre(elmt,page)       (* l'element n'est pas dans l'arbre ?! *)\r
 309        then call outgtext("Donn\82e pas ds l'arbre.");\r
 310        else courant:=page;\r
 311             a:=0;       (* on recherche par dichotomie la place de l'element *)\r
 312             b:=courant.nbdata+1;\r
 313             do\r
 314              milieu:=(a+b) div 2;\r
 315              if Superieur(page.data(milieu),elmt)\r
 316              then b:=milieu\r
 317              else a:=milieu\r
 318              fi;\r
 319              if Egalite(page.data(milieu),elmt)\r
 320              then exit\r
 321              fi\r
 322             od;                                             (* on a sa place *)\r
 323             if courant.fils(milieu) <> none\r
 324             then courant:=courant.fils(milieu)\r
 325             fi;\r
 326             while courant.fils(courant.nbdata+1) <> none\r
 327             do\r
 328              courant:=courant.fils(courant.nbdata+1)\r
 329             od;\r
 330             if page.fils(1) <> none\r
 331             then page.data(milieu):=courant.data(courant.nbdata)\r
 332             else for i:=milieu to courant.nbdata-1\r
 333                  do\r
 334                   page.data(i):=page.data(i+1)\r
 335                  od\r
 336             fi;\r
 337             courant.nbdata:=courant.nbdata-1;\r
 338             if courant.nbdata < N\r
 339             then if courant=root\r
 340                  then exit\r
 341                  fi;\r
 342                  do\r
 343                   pere:=courant.pere;\r
 344                   i:=1;\r
 345                   do\r
 346                    if pere.fils(i)=courant\r
 347                    then exit\r
 348                    fi;\r
 349                    i:=i+1\r
 350                   od;\r
 351                   pred:=i-1;\r
 352                   if pred <> 0\r
 353                   then avant:=pere.fils(pred)\r
 354                   else avant:=courant;\r
 355                        pred:=1;\r
 356                        courant:=pere.fils(2)\r
 357                   fi;\r
 358                   if avant.nbdata <= N\r
 359                   then if courant.nbdata > N\r
 360                        then array aux_data dim (1:3*N);\r
 361                             array aux_fils dim (1:3*N+1);\r
 362                             for i:=1 to avant.nbdata\r
 363                             do\r
 364                              aux_data(i):=courant.data(i-avant.nbdata-1);\r
 365                              aux_fils(i):=avant.fils(i)\r
 366                             od;\r
 367                             aux_fils(i):=avant.fils(i);\r
 368                             aux_data(i):=pere.data(pred);\r
 369                             for i:=avant.nbdata+2 to avant.nbdata+1+courant.nbdata\r
 370                             do\r
 371                              aux_data(i):=courant.data(i-avant.nbdata-1);\r
 372                              aux_fils(i):=courant.fils(i-avant.nbdata-1)\r
 373                             od;\r
 374                             aux_fils(i):=courant.fils(i-avant.nbdata-1);\r
 375                             aux:=avant.nbdata+1+courant.nbdata;\r
 376                             milieu:=aux div 2 +1;\r
 377                             for i:=1 to milieu-1\r
 378                             do\r
 379                              avant.data(i):=aux_data(i);\r
 380                              avant.fils(i):=aux_fils(i)\r
 381                             od;\r
 382                             avant.fils(i):=aux_fils(i);\r
 383                             avant.nbdata:=milieu-1;\r
 384                             pere.data(pred):=aux_data(milieu);\r
 385                             for i:=milieu+1 to aux\r
 386                             do\r
 387                              courant.data(i-milieu):=aux_data(i);\r
 388                              courant.fils(i-milieu):=aux_fils(i)\r
 389                             od;\r
 390                             courant.fils(i-milieu):=aux_fils(i);\r
 391                             courant.nbdata:=aux-avant.nbdata-1\r
 392                        else for i:=avant.nbdata+2 to avant.nbdata+1+courant.nbdata\r
 393                             do\r
 394                              avant.data(i):=courant.data(i-avant.nbdata-1);\r
 395                              avant.fils(i):=courant.fils(i-avant.nbdata-1);\r
 396                              if courant.fils(i-avant.nbdata-1) <> none\r
 397                              then courant.fils(i-avant.nbdata-1).pere:=avant\r
 398                              fi\r
 399                             od;\r
 400                             avant.fils(i):=courant.fils(i-avant.nbdata-1);\r
 401                             if courant.fils(i-avant.nbdata-1) <> none\r
 402                             then courant.fils(i-avant.nbdata-1).pere:=avant\r
 403                             fi;\r
 404                             avant.data(avant.nbdata+1):=pere.data(pred);\r
 405                             avant.nbdata:=avant.nbdata+1+courant.nbdata;\r
 406                             for i:=pred+1 to pere.nbdata\r
 407                             do\r
 408                              pere.data(i-1):=pere.data(i);\r
 409                              pere.fils(i):=pere.fils(i+1)\r
 410                             od;\r
 411                             pere.fils(pere.nbdata+1):=none;\r
 412                             pere.nbdata:=pere.nbdata-1;\r
 413                             if pere.nbdata=0\r
 414                             then root:=avant;\r
 415                                  root.pere:=none\r
 416                             fi\r
 417                        fi\r
 418                   else array aux_data dim (1:3*N);\r
 419                        array aux_fils dim (1:3*N+1);\r
 420                        for i:=1 to avant.nbdata\r
 421                        do\r
 422                         aux_data(i):=avant.data(i);\r
 423                         aux_fils(i):=avant.fils(i)\r
 424                        od;\r
 425                        aux_fils(i):=avant.fils(i);\r
 426                        aux_data(i):=pere.data(pred);\r
 427                        for i:=avant.nbdata+2 to avant.nbdata+1+courant.nbdata\r
 428                        do\r
 429                         aux_data(i):=courant.data(i-avant.nbdata-1);\r
 430                         aux_fils(i):=courant.fils(i-avant.nbdata-1)\r
 431                        od;\r
 432                        aux_fils(i):=courant.fils(i-avant.nbdata-1);\r
 433                        aux:=avant.nbdata+1+courant.nbdata;\r
 434                        milieu:=aux div 2 +1;\r
 435                        for i:=1 to milieu-1\r
 436                        do\r
 437                         avant.data(i):=aux_data(i);\r
 438                         avant.fils(i):=aux_fils(i)\r
 439                        od;\r
 440                        avant.fils(i):=aux_fils(i);\r
 441                        avant.nbdata:=milieu-1;\r
 442                        pere.data(pred):=aux_data(milieu);\r
 443                        for i:=milieu+1 to aux\r
 444                        do\r
 445                         courant.data(i-milieu):=aux_data(i);\r
 446                         courant.fils(i-milieu):=aux_fils(i)\r
 447                        od;\r
 448                        courant.fils(i-milieu):=aux_fils(i);\r
 449                        courant.nbdata:=aux-avant.nbdata-1\r
 450                   fi;\r
 451                   if avant <> root\r
 452                   then avant:=pere;\r
 453                        if avant <> root\r
 454                        then if avant.nbdata < N\r
 455                             then pere:=pere.pere;\r
 456                                  i:=1;\r
 457                                  do\r
 458                                   if pere.fils(i)=avant\r
 459                                   then exit\r
 460                                   fi;\r
 461                                   i:=i+1\r
 462                                  od;\r
 463                                  courant:=pere.fils(i+1);\r
 464                                  if courant=none\r
 465                                  then courant:=avant;\r
 466                                       avant:=pere.fils(i-1)\r
 467                                  fi\r
 468                             else exit\r
 469                             fi\r
 470                        else exit\r
 471                        fi\r
 472                   else exit\r
 473                   fi\r
 474                  od\r
 475             fi;\r
 476             call outgtext("El\82ment supprim\82.")\r
 477        fi\r
 478   fi\r
 479  End Supprimer;\r
 480 \r
 481 Begin\r
 482  root:=new STPage(N);\r
 483 End Barbre;\r
 484 \r
 485 (****************************************************************************)\r
 486 (*   dessine une ligne entre les points (x1,y1) et (x2,y2) de la couleur c  *)\r
 487 (****************************************************************************)\r
 488 unit line : procedure(x1,y1,x2,y2,c:integer);\r
 489 begin\r
 490  pref iiuwgraph block\r
 491  begin\r
 492   call color(c);\r
 493   call move(x1,y1);\r
 494   call draw(x2,y2);\r
 495   call color(colore);\r
 496  end\r
 497 end line;\r
 498 \r
 499 (****************************************************************************)\r
 500 (*   dessine une boite entre les points (x1,y1) et (x2,y2) de la couleur c  *)\r
 501 (****************************************************************************)\r
 502 unit rectanglef : procedure(x1,y1,x2,y2,c:integer);\r
 503 var i : integer;\r
 504 begin\r
 505  pref iiuwgraph block\r
 506  begin\r
 507   for i:=y1 to y2\r
 508   do\r
 509     call line(x1,i,x2,i,c);\r
 510   od;\r
 511   call color(colore);\r
 512  end\r
 513 end rectanglef;\r
 514 \r
 515 (****************************************************************************)\r
 516 (* dessine un rectangle entre les points (x1,y1) et (x2,y2) de la couleur c *)\r
 517 (****************************************************************************)\r
 518 unit rectangle : procedure(x1,y1,x2,y2,c:integer);\r
 519 begin\r
 520  pref iiuwgraph block\r
 521  begin\r
 522   call line(x1,y1,x2,y1,c);\r
 523   call line(x2,y1,x2,y2,c);\r
 524   call line(x2,y2,x1,y2,c);\r
 525   call line(x1,y2,x1,y1,c);\r
 526   call color(colore);\r
 527  end\r
 528 end rectangle;\r
 529 \r
 530 (****************************************************************************)\r
 531 (*      dessine un rectangle en pointilles entre (x1,y1) et (x2,y2)         *)\r
 532 (****************************************************************************)\r
 533 unit rectpoint : procedure(x1,y1,x2,y2,c:integer);\r
 534 var i : integer;\r
 535 begin\r
 536  pref iiuwgraph block\r
 537  begin\r
 538   for i:=x1 step 4 to x2-2\r
 539   do\r
 540    call line(i,y1,i+2,y1,c);\r
 541    call line(i,y2,i+2,y2,c);\r
 542   od;\r
 543   for i:=y1 step 4 to y2-2\r
 544   do\r
 545    call line(x1,i,x1,i+2,c);\r
 546    call line(x2,i,x2,i+2,c);\r
 547   od\r
 548  end\r
 549 end rectpoint;\r
 550 \r
 551 \r
 552 \r
 553 \r
 554 (****************************************************************************)\r
 555 (*       affiche le bandeau de commande en premiere ligne de l'ecran        *)\r
 556 (****************************************************************************)\r
 557 unit affiche : procedure;\r
 558 var i : integer;\r
 559 begin\r
 560  pref iiuwgraph block\r
 561  begin\r
 562   call rectanglef(0,0,640,9,colorf);\r
 563   call color(colore);\r
 564   call move(1,1);\r
 565   for i:=1 to nbitem\r
 566   do\r
 567     call move(10+espace*(i-1),1);\r
 568     call outstring(item(i));\r
 569   od;\r
 570   call rectangle(1,15,196,340,colorf);\r
 571   call rectangle(200,15,639,320,colorf);\r
 572   call rectangle(200,325,639,340,colorf);\r
 573   call move(202,330);\r
 574   call outstring(" BArbre d'ordre 3          Li1 : PATAUD F. - PEYRAT F.");\r
 575  end\r
 576 end affiche;\r
 577 \r
 578 (****************************************************************************)\r
 579 (*      gere le menu, retourne le code action soit clavier soit souris      *)\r
 580 (****************************************************************************)\r
 581 unit mousegest : function : integer;\r
 582 var l,r,c : boolean;\r
 583 var x,y   : integer;\r
 584 var rep   : integer;\r
 585 begin\r
 586  pref iiuwgraph block\r
 587  begin\r
 588   pref mouse block\r
 589   begin\r
 590     do\r
 591      call getpress(0,x,y,nbbot,l,r,c);\r
 592      if l\r
 593      then if (y<=10 and y>=1)\r
 594           then result:=(x-10)/espace+1; exit;\r
 595           fi\r
 596      fi;\r
 597      rep:=inkey;\r
 598      if (rep>=-65  and rep<=-59)\r
 599      then result:=-rep-58;\r
 600           exit\r
 601      fi;\r
 602     od\r
 603   end\r
 604  end\r
 605 end mousegest;\r
 606 \r
 607 (****************************************************************************)\r
 608 (*            initialise le menu et effectue l'action demand\82e              *)\r
 609 (****************************************************************************)\r
 610 unit maine : procedure;\r
 611 var i      : integer;\r
 612 var action : integer;\r
 613 begin\r
 614  pref mouse block\r
 615  begin\r
 616   colorf:=9;\r
 617   colore:=10;\r
 618   espace:=90;\r
 619   nbitem:=7;\r
 620   array item dim (1:nbitem);\r
 621   item(1):=" Inserer ";\r
 622   item(2):=" Effacer ";\r
 623   item(3):=" Affiche ";\r
 624   item(4):=" Membre? ";\r
 625   item(5):=" Minimum ";\r
 626   item(6):=" Maximum ";\r
 627   item(7):=" Quitter ";\r
 628   call affiche;\r
 629   call showcursor;\r
 630   colore:=2;\r
 631   do\r
 632    action:=mousegest;\r
 633    case action\r
 634     when 1: call menu_ins;\r
 635     when 2: call menu_del;\r
 636     when 3: call menu_aff;\r
 637     when 4: call menu_mem;\r
 638     when 5: call menu_min;\r
 639     when 6: call menu_max;\r
 640     when 7: if menu_qui then exit fi;\r
 641    esac;\r
 642   od;\r
 643  end\r
 644 end maine;\r
 645 \r
 646 (****************************************************************************)\r
 647 (* procedure d'affichage dans l'ecran de commandes, fait un scroll si besoin*)\r
 648 (****************************************************************************)\r
 649 unit outgtext : procedure(id : string);\r
 650 var i,savx : integer;\r
 651 var tmap1 : arrayof integer;\r
 652 begin\r
 653  pref iiuwgraph block\r
 654  begin\r
 655   call color(colore);\r
 656   call move(10,posy);\r
 657   call outstring(id);\r
 658   posy:=posy+10;\r
 659   if (posy>=320)     (* on est en fin de page, on fait un scroll d'une ligne *)\r
 660   then savx:=inxpos;\r
 661 (*       array tmap1 dim (1:300); *)\r
 662 (*       for i:=1 step 10 to 281 *)\r
 663 (*       do*)\r
 664 (*        call move(1,36+i);*)\r
 665 (*        tmap1:=getmap(196,46+i);*)\r
 666 (*        call move(1,16+i);*)\r
 667 (*        call putmap(tmap1);*)\r
 668 (*       od;*)\r
 669 (*       call rectanglef(2,317,195,337,0);*)\r
 670 (*       posy:=310;              *)\r
 671 (*       call move(savx,posy); *)\r
 672       call rectanglef(2,16,195,337,0);\r
 673       posy:=20;\r
 674   fi;\r
 675  end\r
 676 end outgtext;\r
 677 \r
 678 (****************************************************************************)\r
 679 (*   lecture d'un entier en mode graphique, esc revient au debut de saisie  *)\r
 680 (****************************************************************************)\r
 681 unit gscanf : function : integer;\r
 682 var valeur : integer;\r
 683 var sauvx,sauvy : integer;\r
 684 var flag : integer;\r
 685 begin\r
 686  pref iiuwgraph block\r
 687  begin\r
 688   valeur:=0;\r
 689   sauvx:=inxpos;\r
 690   sauvy:=inypos;\r
 691   do\r
 692    do\r
 693     flag:=inkey;\r
 694     if (flag>=48 and flag<=57) orif (flag=13) orif (flag=27) then exit fi\r
 695    od;\r
 696    if (flag>=48 and flag<=57)\r
 697    then valeur:=valeur*10+flag-48;\r
 698         call move(inxpos,inypos);\r
 699         call hascii(flag);\r
 700    fi;\r
 701    if (flag=13) then exit fi;\r
 702    if (flag=27)                                   (* on a demand\82 annulation *)\r
 703    then valeur:=0;\r
 704         call rectanglef(sauvx-1,sauvy-3,inxpos,sauvy+7,0);\r
 705         call color(colore);\r
 706         call move(sauvx,sauvy);\r
 707    fi;\r
 708   od;\r
 709  end;\r
 710  result:=valeur;\r
 711 end gscanf;\r
 712 \r
 713 (****************************************************************************)\r
 714 (*          affiche un entier en mode graphique, maximum 6 chiffres         *)\r
 715 (****************************************************************************)\r
 716 unit writint : procedure( valeur : integer);\r
 717 var flag,i : integer;\r
 718 var tbl    : arrayof integer;\r
 719 begin\r
 720  pref iiuwgraph block\r
 721  begin\r
 722   array tbl dim (1:6);\r
 723   flag:=1;                                  (* on 'empile' en ordre reverse *)\r
 724   while valeur<>0\r
 725   do\r
 726    tbl(flag):=valeur mod 10;\r
 727    valeur:=valeur div 10;\r
 728    flag:=flag+1;\r
 729   od;\r
 730   for i:=flag-1 downto 1                    (* on affiche dans le bon ordre *)\r
 731   do\r
 732    call hascii(48+tbl(i));\r
 733   od;\r
 734  end\r
 735 end writint;\r
 736 \r
 737 \r
 738 (****************************************************************************)\r
 739 (*                affiche ds l'ecran de droite la page courante             *)\r
 740 (****************************************************************************)\r
 741 unit affiche_page : procedure (page : STPage);\r
 742 var i :integer;\r
 743 begin\r
 744  pref iiuwgraph block\r
 745  begin\r
 746   if page<>arbr.root\r
 747   then call line(420,82,420,97,colorf);\r
 748        call cirb(420,77,5,0,0,colorf,0,1,1);\r
 749   fi;\r
 750   for i:=1 to 6\r
 751   do\r
 752    call rectpoint(339+(i-1)*27,97,339+i*27,117,colorf);\r
 753    if i<=page.nbdata\r
 754    then call move(339+(i-1)*27+3,105);\r
 755         call writint(page.data(i).data);\r
 756    fi;\r
 757   od;\r
 758  end\r
 759 end affiche_page;\r
 760 \r
 761 (****************************************************************************)\r
 762 (*          affiche ds l'ecran de droite la page fille de gauche            *)\r
 763 (****************************************************************************)\r
 764 unit affiche_gche : procedure (page : STPage);\r
 765 var i    : integer;\r
 766 var savi : integer;\r
 767 begin\r
 768  pref iiuwgraph block\r
 769  begin\r
 770   call line(312,220,312,240,colorf);\r
 771   for i:=1 to 6\r
 772   do\r
 773    call rectangle(204+i*27,240,204+(i+1)*27,260,colorf);\r
 774    if i<=page.nbdata\r
 775    then call move(204+i*27+3,248);\r
 776         call writint(page.data(i).data);\r
 777         savi:=i;\r
 778         if page.fils(i) <> none\r
 779         then if i=4\r
 780              then call line(204+i*27,260,204+i*27,275,colorf);\r
 781              else if i<4\r
 782                   then call line(204+i*27,260,204+i*27-5,275,colorf);\r
 783                   else call line(204+i*27,260,204+i*27+5,275,colorf);\r
 784                   fi\r
 785              fi\r
 786         fi\r
 787    fi;\r
 788   od;\r
 789   if page.fils(i) <> none\r
 790   then if savi<>3 (* comme on part gche->dte on a soit | soit \ *)\r
 791        then call line(204+(savi+1)*27,260,204+(savi+1)*27+5,275,colorf);\r
 792        else call line(204+(savi+1)*27,260,204+(savi+1)*27,275,colorf);\r
 793        fi;\r
 794   fi;\r
 795  end\r
 796 end affiche_gche;\r
 797 \r
 798 (****************************************************************************)\r
 799 (*              affiche ds ecran de droite la page fille droite             *)\r
 800 (****************************************************************************)\r
 801 unit affiche_drte : procedure (page :STPage);\r
 802 var i : integer;\r
 803 begin\r
 804  pref iiuwgraph block\r
 805  begin\r
 806   call line(527,220,527,240,colorf);\r
 807   for i:=1 to 6\r
 808   do\r
 809    call rectangle(635-(i+1)*27,240,635-i*27,260,colorf);\r
 810    if (6-i+1)<=page.nbdata\r
 811    then call move(635-(i+1)*27+3,248);\r
 812         call writint(page.data(6-i+1).data);\r
 813         if page.fils(6-i+1) <> none\r
 814         then if (6-i+1)=4\r
 815              then call line(635-i*27,260,635-i*27,275,colorf);\r
 816              else if (6-i+1)>4\r
 817                   then call line(635-i*27,260,635-i*27+5,275,colorf);\r
 818                   else call line(635-i*27,260,635-i*27-5,275,colorf);\r
 819                   fi\r
 820              fi\r
 821         fi\r
 822    fi;\r
 823   od;\r
 824   if page.fils(1) <> none\r
 825   then call line(635-i*27,260,635-i*27-5,275,colorf);\r
 826   fi;\r
 827  end\r
 828 end affiche_drte;\r
 829 \r
 830 \r
 831 \r
 832 (****************************************************************************)\r
 833 (*                    Lecture de la donn\82e de STData                        *)\r
 834 (****************************************************************************)\r
 835 unit lect_data : function : STData;\r
 836 var d : STData;\r
 837 begin\r
 838  d:=new STData;\r
 839  call outgtext("Entrez la donn\82e :");\r
 840  d.data:=gscanf;\r
 841  result:=d;\r
 842 end lect_data;\r
 843 \r
 844 (****************************************************************************)\r
 845 (*                                menu insertion                            *)\r
 846 (****************************************************************************)\r
 847 unit menu_ins : procedure;\r
 848 var d : STData;\r
 849 begin\r
 850  d:=lect_data;\r
 851  call arbr.insertion(d);\r
 852  call outgtext("");\r
 853 end menu_ins;\r
 854 \r
 855 \r
 856 (****************************************************************************)\r
 857 (*                                menu effacement                           *)\r
 858 (****************************************************************************)\r
 859 unit menu_del : procedure;\r
 860 var d : STData;\r
 861 begin\r
 862   d:=lect_data;\r
 863   call arbr.supprimer(d);\r
 864   call outgtext("");\r
 865 end menu_del;\r
 866 \r
 867 (****************************************************************************)\r
 868 (*           menu de parcours de l'arbre dans la fenetre droite             *)\r
 869 (****************************************************************************)\r
 870 unit menu_aff : procedure;\r
 871 var pos,spos: integer;\r
 872 var rep,x,y : integer;\r
 873 var l,r,c   : boolean;\r
 874 var page    : STPage;\r
 875 begin\r
 876  pref iiuwgraph block\r
 877  begin\r
 878   pref mouse block\r
 879   begin\r
 880    pos:=1;\r
 881    page:=arbr.root;\r
 882    call rectangle(210,25,245,36,colorf);\r
 883    call move(212,27);\r
 884    call outstring("Exit");\r
 885    do\r
 886     call hidecursor;\r
 887     call outgtext("MENU AFF");\r
 888     call rectanglef(201,37,638,319,0);\r
 889     call affiche_page(page);\r
 890     if page.fils(pos) <> none\r
 891     then  call affiche_gche(page.fils(pos));\r
 892     fi;\r
 893     if page.fils(pos+1) <> none\r
 894     then  call affiche_drte(page.fils(pos+1));\r
 895     fi;\r
 896     call rectangle(339+(pos-1)*27,97,339+pos*27,117,colorf);\r
 897     if page.fils(pos) <> none\r
 898     then call line(339+(pos-1)*27,117,339+(pos-1)*27-5,132,colorf);\r
 899     fi;\r
 900     if page.fils(pos+1) <> none\r
 901     then call line(339+pos*27,117,339+pos*27+5,132,colorf);\r
 902     fi;\r
 903     call showcursor;\r
 904     do\r
 905      call getpress(0,x,y,nbbot,l,r,c);\r
 906      if l\r
 907      then if (y<36 and y>25 and x>211 and x<245)    (* button exit *)\r
 908           then exit exit\r
 909           fi;\r
 910           if (x<501 and x>339 and y<117 and y>97)   (* ds pere chgt gch dte *)\r
 911           then spos:=((x-339) div 27)+1;\r
 912                if spos<=page.nbdata\r
 913                then pos:=spos\r
 914                fi;\r
 915                exit\r
 916           fi;\r
 917           if (x>231 and x<393 and y>240 and y<260) (* fils gche devient pere*)\r
 918           then page:=page.fils(pos);\r
 919                pos:=1;\r
 920                exit;\r
 921           fi;\r
 922           if (x>446 and x<608 and y>240 and y<260) (* fils dte devient pere *)\r
 923           then page:=page.fils(pos+1);\r
 924                pos:=1;\r
 925                exit;\r
 926           fi;\r
 927           if (page<>arbr.root) and (x>415 and x<425 and y>72 and y<82)\r
 928           then page:=page.pere;             (* on remonte d'un niveau *)\r
 929                pos:=1;\r
 930                exit\r
 931           fi;\r
 932      fi;\r
 933      rep:=inkey;\r
 934      if rep=27\r
 935      then exit exit\r
 936      else if (rep>=49 and rep<=54)\r
 937           then pos:=rep-48;\r
 938                exit\r
 939           fi;\r
 940      fi;\r
 941     od;\r
 942    od;\r
 943    call hidecursor;\r
 944    call rectanglef(201,24,638,319,0);\r
 945    call showcursor;\r
 946   end\r
 947  end\r
 948 end menu_aff;\r
 949 \r
 950 (****************************************************************************)\r
 951 (*                                menu membre                               *)\r
 952 (****************************************************************************)\r
 953 unit menu_mem : procedure;\r
 954 var d    : STData;\r
 955 var page : STPage;\r
 956 begin\r
 957  d:=lect_data;\r
 958  if arbr.Membre(d,page)\r
 959  then call outgtext("Donn\82e pr\82sente ds arbre");\r
 960  else call outgtext("Donn\82e absente ds arbre");\r
 961  fi;\r
 962  call outgtext("");\r
 963 end menu_mem;\r
 964 \r
 965 (****************************************************************************)\r
 966 (*                                  menu minimum                            *)\r
 967 (****************************************************************************)\r
 968 unit menu_min : procedure;\r
 969 var d : STData;\r
 970 begin\r
 971  if arbr.Minimum(d)\r
 972  then call writint(d.data);\r
 973  fi;\r
 974  call outgtext("");\r
 975 end menu_min;\r
 976 \r
 977 (****************************************************************************)\r
 978 (*                                   menu maximum                           *)\r
 979 (****************************************************************************)\r
 980 unit menu_max : procedure;\r
 981 var d : STData;\r
 982 begin\r
 983  if arbr.Maximum(d)\r
 984  then call writint(d.data);\r
 985  fi;\r
 986  call outgtext("");\r
 987 end menu_max;\r
 988 \r
 989 (****************************************************************************)\r
 990 (*                                 menu quitte                              *)\r
 991 (****************************************************************************)\r
 992 unit menu_qui : function : boolean;\r
 993 var rep : boolean;\r
 994 var a : integer;\r
 995 begin\r
 996  pref iiuwgraph block\r
 997  begin\r
 998   call outgtext("Voulez-vous quitter");\r
 999   call outgtext(" (o/n) ?");\r
1000   call move(inxpos+8,inypos);\r
1001   do\r
1002    a:=inkey;\r
1003    if (a=111 or a=79)\r
1004    then result:=true;\r
1005         call outgtext("o");\r
1006         exit\r
1007    fi;\r
1008    if (a=110 or a=78)\r
1009    then result:=false;\r
1010         call outgtext("n");\r
1011         exit\r
1012    fi;\r
1013   od;\r
1014   call outgtext("");\r
1015  end\r
1016 end menu_qui;\r
1017 \r
1018 \r
1019 \r
1020 (*****************************************************************************)\r
1021 (*****************************************************************************)\r
1022 (*                                                                           *)\r
1023 (*                   P R O G R A M M E   P R I N C I P A L                   *)\r
1024 (*                                                                           *)\r
1025 (*****************************************************************************)\r
1026 (*****************************************************************************)\r
1027 var colorf,colore : integer;\r
1028 var nbitem : integer;\r
1029 var espace : integer;\r
1030 var item   : arrayof string;\r
1031 var nbbot  : integer;\r
1032 var flag   : boolean;\r
1033 var posy   : integer;\r
1034 var arbr   : Barbre;\r
1035 \r
1036 Begin\r
1037  pref iiuwgraph block\r
1038  begin\r
1039   pref mouse block\r
1040   begin\r
1041    arbr:=new Barbre(3);\r
1042    call gron(1);\r
1043    flag:=init(nbbot);\r
1044    call hpage(0,1,1);\r
1045    posy:=20;\r
1046    call maine;\r
1047    call hidecursor;\r
1048    call groff;\r
1049   end\r
1050  end\r
1051 End BArbres.\r