examples/examples.old/bicolore.log

   1 PROGRAM BICOLORE;\r
   2 \r
   3 (* Projet LI1 : Operations sur les arbres bicolores . *)\r
   4 (*              Realise par CHICHER Corinne et DOME Nadege - UPPA 1993/1994 - *)\r
   5 \r
   6 \r
   7   (* NewPage vide l'ecran en mode texte *)\r
   8   UNIT NewPage : PROCEDURE;\r
   9   BEGIN\r
  10     write( chr(27), "[2J")\r
  11   END NewPage;\r
  12 \r
  13   (* SetCursor positionne le curseur aux ligne et colonne indiquees *)\r
  14   UNIT SetCursor : PROCEDURE(ligne,colonne:integer);\r
  15   VAR c,d,e,f :char,\r
  16       i,j :integer;\r
  17   BEGIN\r
  18     i:=ligne div 10;\r
  19     j:=ligne mod 10;\r
  20     c:=chr(48+i);\r
  21     d:=chr(48+j);\r
  22     i:=colonne div 10;\r
  23     j:=colonne mod 10;\r
  24     e:=chr(48+i);\r
  25     f:=chr(48+j);\r
  26     write( chr(27), "[", c, d, ";", e, f, "H");\r
  27   END SetCursor;\r
  28 \r
  29 \r
  30   (* la classe bic definit la structure d'un noeud d'arbre bicolore *)\r
  31   UNIT bic : CLASS;\r
  32   VAR val:integer,       (* val:Valeur de l'element d'un noeud *)\r
  33       rouge : boolean,   (* rouge:couleur d'un noeud:si vrai alors rouge sinon blanc *)             \r
  34       fg,fd : bic;       (* fg,fd:fils gauche et droit d'un noeud *)\r
  35   END bic;\r
  36 \r
  37 \r
  38   (* inchar saisit un caractere en mode graphique *)\r
  39   UNIT inchar : iiuwgraph FUNCTION : integer;\r
  40   VAR i:integer;\r
  41   BEGIN\r
  42     DO \r
  43       i:=INKEY;\r
  44       if i <> 0 then\r
  45         exit\r
  46       fi;\r
  47     OD;\r
  48     result:=i;\r
  49   END inchar;\r
  50 \r
  51   (* ReadInteger lit un entier positif a 3 chiffres avec echo a l'ecran *)\r
  52   UNIT ReadInteger : iiuwgraph FUNCTION : integer;\r
  53   VAR X,Y,i,OrdN : integer,\r
  54       Number : arrayof integer;\r
  55   BEGIN\r
  56     array Number dim( 1 : 4 );\r
  57     i:=0;\r
  58     X:=InXPos;\r
  59     Y:=InYPos;\r
  60     DO\r
  61       OrdN:=inchar;\r
  62       if i=8 or (OrdN < 48 and OrdN > 57) then\r
  63         exit\r
  64       fi;\r
  65       CASE OrdN\r
  66         when 48 : i:=i+1;\r
  67                   Number(i):=0;\r
  68         when 49 : i:=i+1;\r
  69                   Number(i):=1;\r
  70         when 50 : i:=i+1;\r
  71                   Number(i):=2;\r
  72         when 51 : i:=i+1;\r
  73                   Number(i):=3;\r
  74         when 52 : i:=i+1;\r
  75                   Number(i):=4;\r
  76         when 53 : i:=i+1;\r
  77                   Number(i):=5;\r
  78         when 54 : i:=i+1;\r
  79                   Number(i):=6;\r
  80         when 55 : i:=i+1;\r
  81                   Number(i):=7;\r
  82         when 56 : i:=i+1;\r
  83                   Number(i):=8;\r
  84         when 57 : i:=i+1;\r
  85                   Number(i):=9;\r
  86         when 8 : if i > 0 then\r
  87                    Number(i):=0;\r
  88                    i:=i-1;\r
  89                    call hascii(0);\r
  90                  fi;\r
  91         when 13 : if i > 0 then\r
  92                     exit\r
  93                   fi;\r
  94       ESAC;\r
  95       if i=1 then\r
  96         call Move(X,Y);\r
  97         call hascii(0);\r
  98         call hascii(48+Number(1));\r
  99       fi;\r
 100       if i=2 then\r
 101         call Move(X+8,Y);\r
 102         call hascii(0);\r
 103         call hascii(48+Number(2));\r
 104       fi; \r
 105       if i=3 then\r
 106         call Move(X+16,Y);\r
 107         call hascii(0);\r
 108         call hascii(48+Number(3));\r
 109       fi;        \r
 110     OD;\r
 111     if (Number(1) = 0) or (Number(1) = 0 and Number(2) = 0) \r
 112        or (Number(1) = 0 and Number(2) = 0 and Number(3) = 0) then\r
 113       call Move(X,Y);\r
 114       call hascii(0);\r
 115       call hascii(48);\r
 116       call hascii(0);\r
 117     fi;\r
 118     if i=1 then\r
 119       result:=Number(1);\r
 120     else\r
 121       if i=2 then\r
 122         result:=10 * Number(1) + Number(2);\r
 123       else\r
 124         result:=100 * Number(1) + 10 * Number(2) + Number(3);\r
 125       fi;\r
 126     fi;\r
 127     kill(Number);\r
 128   END ReadInteger;\r
 129   \r
 130   (* WriteInteger permet d'afficher un entier positif a 3 chiffres a l'ecran *)\r
 131   UNIT WriteInteger : iiuwgraph PROCEDURE(Number:integer);\r
 132   VAR i,j,k:integer;\r
 133   BEGIN\r
 134     if Number < 10 then\r
 135       call HASCII(0);\r
 136       call HASCII(Number+48);\r
 137       call HASCII(0);\r
 138     else\r
 139       if Number < 100 then\r
 140         i:=Number div 10;\r
 141         j:=Number - i * 10;\r
 142         call HASCII(0);\r
 143         call HASCII(i+48);\r
 144         call HASCII(0);\r
 145         call HASCII(j+48);\r
 146       else\r
 147         i:=Number div 100;\r
 148         j:=(Number - i * 100) div 10;\r
 149         k:=Number - i * 100 - j * 10;\r
 150         call HASCII(0);\r
 151         call HASCII(i+48);\r
 152         call HASCII(0);\r
 153         call HASCII(j+48);\r
 154         call HASCII(0);\r
 155         call HASCII(k+48);\r
 156       fi;\r
 157     fi;\r
 158   END WriteInteger;\r
 159 \r
 160   (* Mousepos gere la position de la souris a l'endroit ou le bouton gauche *)\r
 161   (* a ete presse *)\r
 162   UNIT MOUSEPOS : iiuwgraph PROCEDURE(x,y:integer;inout bonclic:boolean;output choix:integer);\r
 163   BEGIN\r
 164     if (x >= 24) and (x <= 544) then\r
 165       if (y >= 80) and (y <= 88) then\r
 166         choix:=1;\r
 167         bonclic:=true;\r
 168       fi;\r
 169       if (y >= 96) and (y <= 104) then\r
 170         choix:=2;\r
 171         bonclic:=true;\r
 172       fi;\r
 173       if (y >= 112) and (y <= 120) then\r
 174         choix:=3;\r
 175         bonclic:=true;\r
 176       fi;\r
 177       if (y >= 128) and (y <= 136) then\r
 178         choix:=4;\r
 179         bonclic:=true;\r
 180       fi;\r
 181       if (y >= 144) and (y <=152) then\r
 182         choix:=5;\r
 183         bonclic:=true;\r
 184       fi;\r
 185       if (y >= 160) and (y <= 168) then\r
 186         choix:=6;\r
 187         bonclic:=true;\r
 188       fi;\r
 189       if (y >= 176) and (y <= 184) then\r
 190         choix:=7;\r
 191         bonclic:=true;\r
 192       fi;\r
 193       if (y >= 192) and (y <= 200) then\r
 194         choix:=8;\r
 195         bonclic:=true;\r
 196       fi;\r
 197       if (y >= 208) and (y <= 216) then\r
 198         choix:=9;\r
 199         bonclic:=true;\r
 200       fi;\r
 201       if (y >= 224) and (y <= 232) then\r
 202         call CLS;\r
 203         (*call GROFF;*)\r
 204         choix:=0;\r
 205         bonclic:=true;\r
 206       fi;\r
 207     fi;\r
 208   END MOUSEPOS;\r
 209 \r
 210   (* cadre trace un rectangle autour des operations *)\r
 211   UNIT cadre : iiuwgraph PROCEDURE(xg,yg,xd,yd:integer);\r
 212   BEGIN\r
 213     call COLOR(7);\r
 214     call MOVE(xg,yg);\r
 215     call DRAW(xd,yg);\r
 216     call MOVE(xd,yg);\r
 217     call DRAW(xd,yd);\r
 218     call MOVE(xd,yd);\r
 219     call DRAW(xg,yd);\r
 220     call MOVE(xg,yd);\r
 221     call DRAW(xg,yg);\r
 222   END cadre;\r
 223 \r
 224   (* menu propose les traitements pouvant etre realises sur les arbres bicolores *)\r
 225   UNIT menu : iiuwgraph FUNCTION : integer;\r
 226   VAR i,b,h,v,numop:integer,\r
 227       g,d,c,driver,selection:boolean;\r
 228   BEGIN\r
 229 \r
 230     pref mouse block\r
 231     BEGIN\r
 232       call CLS;\r
 233       selection:=false;\r
 234       g:=false;\r
 235       d:=false;\r
 236       c:=false;\r
 237       call COLOR(7);\r
 238       call MOVE(184,24);\r
 239       call OUTSTRING("OPERATIONS SUR LES ARBRES BICOLORES");\r
 240       call COLOR(15);\r
 241       call cadre(24,56,544,240);\r
 242       call MOVE(64,80);\r
 243       call OUTSTRING("Creation d'un arbre bicolore");\r
 244       call MOVE(64,96);\r
 245       call OUTSTRING("Ajout d'un element");\r
 246       call MOVE(64,112);\r
 247       call OUTSTRING("Recherche d'un element dans un arbre");\r
 248       call MOVE(64,128);\r
 249       call OUTSTRING("Recherche du minimum dans un arbre");\r
 250       call MOVE(64,144);\r
 251       call OUTSTRING("Recherche du maximum dans un arbre");\r
 252       call MOVE(64,160);\r
 253       call OUTSTRING("Recherche de(s) successeur(s) d'un element de l'arbre");\r
 254       call MOVE(64,176);\r
 255       call OUTSTRING("Recherche du predecesseur d'un element de l'arbre");\r
 256       call MOVE(64,192);\r
 257       call OUTSTRING("Suppression de certains noeuds de l'arbre");\r
 258       call MOVE(64,208);\r
 259       call OUTSTRING("Affichage d'un arbre");\r
 260       call MOVE(64,224);\r
 261       call OUTSTRING("Quitter l'application");\r
 262       call MOVE(24,256);\r
 263       call OUTSTRING("Selectionnez l'operation avec le bouton gauche de la souris...");\r
 264     \r
 265       (* Gestion de la souris *)\r
 266       driver:=INIT(b);\r
 267       call SETPOSITION(0,0);\r
 268       call SHOWCURSOR;\r
 269       DO\r
 270         call GETPRESS(0,h,v,b,g,d,c);\r
 271         if g then\r
 272           call MOUSEPOS(h,v,selection,numop);\r
 273           if not selection then\r
 274             g:=false;\r
 275             repeat;\r
 276           else\r
 277             call HIDECURSOR;\r
 278             exit\r
 279           fi;\r
 280         fi;\r
 281       OD;\r
 282     result:=numop;\r
 283     END;\r
 284   END menu;\r
 285 \r
 286   (* ajout sert :                                                    *)\r
 287   (*    a creer un bicolore : inserer un element dans un arbre vide  *)\r
 288   (*    a ajouter un element dans un arbre deja cree                 *)\r
 289 \r
 290   (* ses parametres sont :                                           *)\r
 291   (*    en entree, l'element a inserer                               *)\r
 292   (*    en entree/sortie, la racine de l'arbre et 2 sentinelles      *)\r
 293   (*                      un booleen indiquant si au moins un ajout a ete realise *)\r
 294 \r
 295   UNIT ajout : PROCEDURE(x:integer;inout A,T,Z,Q:bic,adj:boolean);\r
 296   VAR P,GP,AGP : bic,  \r
 297       touche:integer;\r
 298       (* Pere,grand-pere et arriere grand-pere du pteur courant A *)\r
 299       (* Ces pointeurs servent au reequilibrage de l'arbre *)\r
 300 \r
 301   BEGIN\r
 302    pref IIUWGRAPH block\r
 303    BEGIN\r
 304       adj:=false;\r
 305       A:=new bic;           \r
 306       A:=T;      (* T:Tete de l'arbre ayant pour valeur 0, pour couleur blanc, *)\r
 307                  (* pour fils gauche Z et pour fils droit initial Z *) \r
 308       Z.val:=x;  (* On affecte l'element a inserer au champ val de Z *)\r
 309       P:=new bic;\r
 310       P:=T;\r
 311       GP:=new bic;\r
 312       GP:=T;\r
 313       AGP:=new bic;\r
 314 \r
 315     DO\r
 316         AGP:=GP;\r
 317         GP:=P;\r
 318         P:=A;\r
 319         \r
 320         if x < A.val then   (* Descente dans l'arbre *)\r
 321           A:=A.fg;\r
 322         else\r
 323           A:=A.fd;\r
 324         fi;\r
 325                         \r
 326         if (A.fg.rouge and A.fd.rouge) then\r
 327           \r
 328           if A = Z then  (* Ajout de l'element  dand une feuille *)\r
 329             adj:=true;\r
 330             A:=new bic;\r
 331             A.val:=x;\r
 332             A.fg:=Z;\r
 333             A.fd:=Z;  \r
 334             A.rouge:=true; (* L'ajout d'un element s'effectue dans une feuille *)\r
 335                            (* qui devient un noeud rouge *) \r
 336             if x < P.val then\r
 337               P.fg:=A;\r
 338             else\r
 339               P.fd:=A;\r
 340             fi;\r
 341           else\r
 342             A.rouge:=true;     (* Inversion des couleurs *)\r
 343             A.fg.rouge:=false;\r
 344             A.fd.rouge:=false;\r
 345           fi;\r
 346  \r
 347           call CLS;\r
 348             \r
 349           if P.rouge then  (* Reequilibrage car 2 noeuds rouges consecutifs*)\r
 350             call CLS;\r
 351             call BORDER(1);\r
 352             call MOVE(88,16);\r
 353             call OUTSTRING("RESULTAT INTERMEDIAIRE : "); \r
 354             Taff:=TT.fd; \r
 355             call affpreordre(Taff,ZZ,0.5,1,0,0);\r
 356             call MOVE(40,300);\r
 357             call OUTSTRING("Tapez sur une touche pour continuer ...");\r
 358             touche:=INCHAR;\r
 359  \r
 360             (* 8 types de rotation-raccrochage *)\r
 361             if P.val > GP.val then   (* Rotation gauche ou droite-gauche *)\r
 362               if A.val > P.val then\r
 363                 call rg(GP);\r
 364               else\r
 365                 call rdg(GP);\r
 366               fi;\r
 367               if GP.val < AGP.val then\r
 368                 AGP.fg:=GP;\r
 369               else\r
 370                 AGP.fd:=GP;\r
 371               fi;\r
 372             else\r
 373               if A.val < P.val then  (* Rotation droite ou gauche-droite *)\r
 374                 call rd(GP);\r
 375               else\r
 376                 call rgd(GP);\r
 377               fi;\r
 378               if GP.val < AGP.val then\r
 379                 AGP.fg:=GP;\r
 380               else\r
 381                 AGP.fd:=GP;\r
 382               fi;\r
 383             fi;\r
 384             (* Retablissement des couleurs apres rotation *)\r
 385             GP.rouge:=false;\r
 386             GP.fg.rouge:=true;\r
 387             GP.fd.rouge:=true;\r
 388             (* Retablissement de la hierarchie des ascendants *)\r
 389             P:=GP;\r
 390             GP:=AGP;\r
 391             if x = P.val then\r
 392               A:=P;  (* A renvoie l'adresse de l'element a inserer dans l'arbre *)\r
 393             else\r
 394               if x < P.val then\r
 395                 A:=P.fg;\r
 396               else\r
 397                 A:=P.fd;\r
 398               fi;\r
 399             fi;\r
 400           fi;\r
 401         fi; \r
 402         \r
 403         if x <> A.val then  (* Poursuite de la descente car place *)\r
 404                             (* nouvel element non trouvee *)\r
 405           repeat;\r
 406         else\r
 407           exit;   (* L'ajout de l'element est termine *)\r
 408         fi;\r
 409     \r
 410     OD;\r
 411     T.fd.rouge:=false;  (* La racine de l'arbre est toujours blanche *)\r
 412    END;\r
 413   END ajout;\r
 414 \r
 415   (* recherche parcourt l'arbre et indique si l'element a rechercher *)\r
 416   (* est present ou absent de l'arbre                                *)\r
 417   (* ses parametres d'entree sont l'element a rechercher , la sentinelle Z1 *)\r
 418   (* Tr: noeud contenant l'element recherche et Pr:pere de Tr        *)\r
 419  \r
 420   UNIT recherche : FUNCTION (x:integer,Z1:bic;inout Tr,Pr:bic):boolean;\r
 421   BEGIN\r
 422     (* Parcours de l'arbre *)\r
 423     Tr:=Tr.fd;\r
 424     while Tr <> Z1 and not result\r
 425     do\r
 426       if x = Tr.val then  (* On a trouve l'element :recherche terminee positivement *)\r
 427         result:=true\r
 428       else (* On continue la recherche *)\r
 429         if x < Tr.val then    (* a gauche *)\r
 430           Pr:=Tr;\r
 431           Tr:=Tr.fg;\r
 432         else\r
 433           if x > Tr.val then   (* a droite *)\r
 434             Pr:=Tr;\r
 435             Tr:=Tr.fd;\r
 436           fi;\r
 437         fi;\r
 438       fi;\r
 439     od;\r
 440   END recherche;\r
 441   \r
 442   (* Suppression supprime un certain type de noeud de l'arbre *)\r
 443   (* Ses parametres d'entree sont l'element a supprimer, la sentinelle Z1 *)\r
 444   (* Tr: noeud contenant l'element a supprimer et Pr:pere de Tr           *)\r
 445 \r
 446   UNIT suppression :PROCEDURE(x:integer,Z1:bic;inout T,Tr,Pr:bic,adj:boolean);\r
 447   BEGIN\r
 448    pref IIUWGRAPH block\r
 449    BEGIN\r
 450     if Tr.fg = Z1 and Tr.fd = Z1 then   (*Si c'est un noeud sans fils *)\r
 451       if Tr = T.fd then  (* Si le noeud a supprimer est la racine *)\r
 452         kill(Tr);\r
 453         kill(T);\r
 454         adj:=false;      (* L'arbre devient donc vide *)\r
 455       else\r
 456         if Tr.val < Pr.val then\r
 457           Pr.fg:=Z1;\r
 458         else\r
 459           Pr.fd:=Z1;\r
 460         fi;\r
 461       fi;\r
 462     else\r
 463       if Tr.fg <> Z1 and Tr.fd=Z1 then (* Si c'est un noeud qui a un fils gauche *)\r
 464                                        (* Alors on remplace ce noeud par son fils*)\r
 465         if Tr=Pr.fd then  \r
 466           Pr.fd:=Tr.fg;\r
 467           Pr.fd.rouge:=false;\r
 468           kill(Tr);\r
 469         else\r
 470           if Tr.val < Pr.val then\r
 471             Pr.fg:=Tr.fg;\r
 472             Pr.fg.rouge:=false;\r
 473             kill(Tr);\r
 474           else\r
 475             Pr.fd:=Tr.fg;\r
 476             Pr.fd.rouge:=false;\r
 477             kill(Tr);\r
 478           fi;\r
 479         fi;\r
 480       else                             (* Si c'est un noeud qui a un fils droit *)\r
 481                                        (* Alors on remplace ce noeud par son fils*)  \r
 482         if Tr.fg = Z1 and Tr.fd <> Z1 then\r
 483           if Tr=Pr.fd then\r
 484             Pr.fd:=Tr.fd;\r
 485             Pr.fd.rouge:=false;\r
 486             kill(Tr);\r
 487           else\r
 488             if Tr.val < Pr.val then\r
 489               Pr.fg:=Tr.fd;\r
 490               Pr.fg.rouge:=false;\r
 491               kill(Tr);\r
 492             else\r
 493               Pr.fd:=Tr.fd;\r
 494               Pr.fd.rouge:=false;\r
 495               kill(Tr);\r
 496             fi;\r
 497           fi;\r
 498         else                           (* Si c'est un noeud qui a deux fils   *)\r
 499                                        (* Alors on remplace ce noeud par celui*)\r
 500                                        (* qui lui est inferieur               *)\r
 501           if (Tr.fg.fg=Z1 and Tr.fg.fd=Z1) and (Tr.fd.fg=Z1 and Tr.fd.fd=Z1) then\r
 502             if Tr.val > Pr.val then\r
 503             Pr.fd:=Tr.fg;\r
 504             else\r
 505               Pr.fg:=Tr.fg;\r
 506             fi;\r
 507             Pr.fd.rouge:=false;\r
 508             Pr.fd.fd:=Tr.fd;\r
 509             kill(Tr);\r
 510           else  (*Cas non traite: Le noeud a supprimer a des petits fils *)\r
 511             call MOVE (40,160);\r
 512             call OUTSTRING("Il est impossible de supprimer ce genre de noeuds...");\r
 513             call MOVE(40,300);\r
 514             call OUTSTRING("Tapez sur une touche pour verification ...");\r
 515             touche:=INCHAR; \r
 516             \r
 517           fi;\r
 518         fi;\r
 519       fi;\r
 520     fi;\r
 521    END;  \r
 522   END suppression;\r
 523 \r
 524   (* rd effectue une rotation a droite de l'arbre *)\r
 525   UNIT rd : PROCEDURE(inout GP:bic);\r
 526   VAR aux:bic;\r
 527   BEGIN\r
 528     aux:=new bic;\r
 529     aux:=GP.fg;\r
 530     GP.fg:=aux.fd;\r
 531     aux.fd:=GP;\r
 532     GP:=aux;\r
 533   END rd;\r
 534 \r
 535   (* rg effectue une rotation a gauche de l'arbre *)\r
 536   UNIT rg : PROCEDURE(inout GP:bic);\r
 537   VAR aux:bic;\r
 538   BEGIN\r
 539     aux:=new bic;\r
 540     aux:=GP.fd;\r
 541     GP.fd:=aux.fg;\r
 542     aux.fg:=GP;\r
 543     GP:=aux;\r
 544   END rg;\r
 545 \r
 546   (* rdg effectue une rotation droite-gauche de l'arbre *)\r
 547   UNIT rdg : PROCEDURE(inout GP:bic);\r
 548   BEGIN\r
 549     call rd(GP.fd);\r
 550     call rg(GP);\r
 551   END rdg;\r
 552   \r
 553   (* rgd effectue une rotation gauche-droite de l'arbre *)\r
 554   UNIT rgd : PROCEDURE(inout GP:bic);\r
 555   BEGIN\r
 556     call rg(GP.fg);\r
 557     call rd(GP);\r
 558   END rgd;\r
 559 \r
 560   (* minmax renvoie le minimum ou le maximum de l'arbre *)\r
 561   (* ses parametres d'entree sont l'arbre, la sentinelle, et le type de recherche *)\r
 562   UNIT minmax : FUNCTION(N,Z1:bic,choix:integer) : integer;\r
 563   VAR S:bic; (* Noeud contenant la valeur a renvoyer *)\r
 564   BEGIN\r
 565     (* Si on recherche le minimum (choix=0) on descend le plus a gauche possible *)\r
 566     (* Si on recherche le maximum (choix=1) on descend le plus a droite possible *)\r
 567     S:=new bic;\r
 568     N:=N.fd;\r
 569     if choix=0 then\r
 570       while N <> Z1\r
 571       do \r
 572         S:=N;\r
 573         N:=N.fg;\r
 574       od;\r
 575     fi;\r
 576     if choix=1 then\r
 577       while N <> Z1\r
 578       do\r
 579         S:=N;\r
 580         N:=N.fd;\r
 581       od;\r
 582     fi;\r
 583     result:=S.val;\r
 584   END minmax;\r
 585   \r
 586   (* affpreordre affiche l'arbre dans un ordre prefixe *)\r
 587   UNIT affpreordre : PROCEDURE(N,Z1:bic,coefm,sup,inf:real,niveau:integer);\r
 588   VAR posx:real,posy,i,j:integer;\r
 589   BEGIN\r
 590     pref iiuwgraph BLOCK\r
 591     BEGIN\r
 592       if N <> Z1 then\r
 593         niveau:=niveau+1;\r
 594         posx:=(coefm * (sup - inf)) + inf;\r
 595         posy:= niveau * 35;\r
 596         if niveau <> 1 then\r
 597           call DRAW(posx*640 , posy);\r
 598         fi;\r
 599         if N.rouge then\r
 600           call COLOR(12);\r
 601         else\r
 602           call COLOR(15);\r
 603         fi;\r
 604         call MOVE(round(posx * 640),posy);\r
 605         call HASCII(0);\r
 606         call WriteInteger(N.val);\r
 607         call MOVE(INXPOS + 4,INYPOS);\r
 608         call COLOR(3);\r
 609         call MOVE(INXPOS-20,INYPOS);\r
 610         call affpreordre(N.fg,Z1,0.5,posx,inf,niveau);\r
 611         call MOVE(ROUND(posx * 640) + 8 , posy + 8);\r
 612         call affpreordre(N.fd,Z1,0.5,sup,posx,niveau);\r
 613         call MOVE(ROUND(posx * 640) + 8,posy + 8);\r
 614       fi;\r
 615     END;\r
 616   END affpreordre;\r
 617 \r
 618   (* menage:permet la destruction de l'objet passe en parametre *)\r
 619   UNIT menage : PROCEDURE(inout Z,N:bic);\r
 620   BEGIN\r
 621     if N.fg <> Z then\r
 622       call menage(Z,N.fg);\r
 623       kill(N.fg);\r
 624     fi;\r
 625     if N.fd <> Z then\r
 626       call menage(Z,N.fd);\r
 627       kill(N.fd);\r
 628     fi;\r
 629   END menage;\r
 630         \r
 631   (* PROGRAMME PRINCIPAL *)\r
 632 \r
 633   VAR rep,elt,interm:integer, (* rep:choix de l'operation a realiser *)\r
 634                               (* elt:Element entre par l'utilisateur *)\r
 635                               (* interm:reponse aux questions posees *)\r
 636       AA,ZZ,QQ,TT,Taff,Trech,Prech:bic,\r
 637                               (* AA:pointeur sur le noeud courant *)\r
 638                               (* ZZ:sentinelle sur laquelle on fait pointer tous *)\r
 639                               (* les liens qui sont a NONE *)\r
 640                               (* QQ:sentinelle pointee par ZZ et dont les liens  *)\r
 641                               (* sont a NONE *)\r
 642                               (* TT:Tete de l'arbre dont le fils droit va pointer*)\r
 643                               (* sur le premier noeud de l'arbre *)\r
 644       touche:integer,\r
 645       adjonc:boolean;\r
 646   \r
 647   BEGIN\r
 648     pref IIUWGRAPH block\r
 649     BEGIN\r
 650 \r
 651       call GRON(5);\r
 652       adjonc:=false;\r
 653       \r
 654       DO\r
 655         call COLOR(3);\r
 656         call BORDER(1);\r
 657         call CLS;\r
 658         rep:=menu;  (* Recuperation du choix de l'utilisateur *)\r
 659         call BORDER(3);\r
 660         CASE rep\r
 661           \r
 662           when 0: (* Pour quitter l'application *)\r
 663                   if adjonc then\r
 664                     call menage(ZZ,TT); (*Destruction de l'arbre*)\r
 665                     kill(TT);\r
 666                     kill(ZZ);\r
 667                     kill(QQ);\r
 668                   fi;\r
 669                   call GROFF;\r
 670                   call NewPage;\r
 671                   call Setcursor(5,20);\r
 672                   writeln("**********TERMINE**********");\r
 673                   call ENDRUN; (*Sortie de l'application*)\r
 674 \r
 675           when 1: call CLS;    (* pour creer un arbre *)\r
 676                   if adjonc then\r
 677                     call COLOR(3);\r
 678                     call MOVE(40,40);\r
 679                     call OUTSTRING("ATTENTION ! : L'arbre precedemment cree va etre efface");\r
 680                     call COLOR(3);\r
 681                     call MOVE(40,56);\r
 682                     call OUTSTRING("Voulez-vous toujours creer un arbre ? Si oui, tapez 1 : ");        \r
 683                     interm:=ReadInteger;\r
 684                     if interm <> 1 then\r
 685                       repeat;\r
 686                     else\r
 687                       call menage(ZZ,TT); (*Destruction de l'arbre*)\r
 688                       kill(TT);\r
 689                       kill(ZZ);\r
 690                       kill(QQ);\r
 691                     fi;\r
 692                   fi;                                             \r
 693                   (* creation et initialisation du pointeur courant et des 2 sentinnelles *)\r
 694 \r
 695                   AA:=new bic;\r
 696                   ZZ:=new bic;\r
 697                   ZZ.rouge:=false;\r
 698                   ZZ.fg:=new bic;\r
 699                   ZZ.fd:=new bic;\r
 700 \r
 701                   QQ:=new bic;\r
 702                   QQ.rouge:=true;\r
 703                   QQ.fg:=new bic;\r
 704                   QQ.fd:=new bic;\r
 705                   QQ.fg:=NONE;\r
 706                   QQ.fd:=NONE;\r
 707 \r
 708                   ZZ.fg:=QQ;\r
 709                   ZZ.fd:=QQ;\r
 710 \r
 711                   (* creation et initialisation de la tete de l'arbre *)\r
 712                   TT:=new bic;\r
 713                   TT.rouge:=false;\r
 714                   TT.fg:=new bic;\r
 715                   TT.fd:=new bic;\r
 716                   TT.fg:=ZZ;\r
 717                   TT.fd:=ZZ;\r
 718                   \r
 719                   Trech:=new bic;\r
 720                   Prech:=new bic;\r
 721                   Taff:=new bic;\r
 722                   adjonc:=false;\r
 723 \r
 724                   call COLOR(3);\r
 725                   call MOVE(192,16);\r
 726                   call OUTSTRING("CREATION D'UN ARBRE BICOLORE");\r
 727                   call MOVE(40,88);\r
 728                   call OUTSTRING("Entrez le premier element de l'arbre :");\r
 729                   call MOVE(360,88);\r
 730                   elt:=ReadInteger;\r
 731 \r
 732                   (* On va inserer elt dans l'arbre *) \r
 733                   call ajout(elt,AA,TT,ZZ,QQ,adjonc);\r
 734                   repeat;\r
 735 \r
 736           when 2 : call CLS;   (* pour ajouter un element dans l'arbre *)\r
 737                    if adjonc then\r
 738                      call COLOR(3);\r
 739                      call MOVE(152,16);\r
 740                      call OUTSTRING("AJOUT D'UN ELEMENT DANS UN ARBRE BICOLORE");\r
 741                      call MOVE(40,88);\r
 742                      call OUTSTRING("Entrez l'element a inserer dans l'arbre :");\r
 743                      call MOVE(376,88);\r
 744                      elt:=ReadInteger;\r
 745 \r
 746                      (* Test de presence de l'element dans l'arbre *)\r
 747                      Trech:=TT;\r
 748                      if recherche(elt,ZZ,Trech,Prech) then \r
 749                        call COLOR(3);\r
 750                        call MOVE(160,120);\r
 751                        call OUTSTRING("ATTENTION !   AJOUT IMPOSSIBLE !!!");\r
 752                        call MOVE(40,136);\r
 753                        call WriteInteger(elt);\r
 754                        call OUTSTRING(" est deja present dans l'arbre ! ");\r
 755                        call MOVE(40,152);\r
 756                        call OUTSTRING("Tapez sur une touche pour verification...");\r
 757                        touche:=INCHAR;\r
 758                        call CLS;\r
 759                        call BORDER(1);\r
 760                        call MOVE(88,16);\r
 761                        call OUTSTRING("VERIFICATION");\r
 762                        \r
 763                        (* Affichage de l'arbre *)\r
 764                        Taff:=TT.fd;\r
 765                        call affpreordre(Taff,ZZ,0.5,1,0,0);\r
 766                        call MOVE(40,300);\r
 767                        call OUTSTRING("Tapez sur une touche pour retourner au menu ...");\r
 768                        touche:=INCHAR;\r
 769                      else\r
 770                        call ajout(elt,AA,TT,ZZ,QQ,adjonc);\r
 771                        call CLS;\r
 772                        call BORDER(1);\r
 773                        call MOVE(88,16);\r
 774                        call OUTSTRING("RESULTAT : "); \r
 775                        Taff:=TT.fd; \r
 776                        call affpreordre(Taff,ZZ,0.5,1,0,0);\r
 777                        call MOVE(40,300);\r
 778                        call OUTSTRING("Tapez sur une touche pour retourner au menu ...");\r
 779                        touche:=INCHAR; \r
 780                      fi;\r
 781                      repeat;\r
 782                    else\r
 783                      call MOVE(350,40);\r
 784                      call OUTSTRING("ATTENTION !");\r
 785                      call MOVE(40,64);\r
 786                      call OUTSTRING("Ajout impossible car arbre inexistant !");\r
 787                      call MOVE(40,80);\r
 788                      call OUTSTRING("Retour au menu pour creer un arbre ? Si oui, tapez 1 : ");\r
 789                      call MOVE(488,80);\r
 790                      interm:=ReadInteger;\r
 791                      if interm=1 then\r
 792                        repeat;\r
 793                      else\r
 794                        if adjonc then\r
 795                          call menage(ZZ,TT); (*Destruction de l'arbre*)\r
 796                          kill(TT);\r
 797                          kill(ZZ);\r
 798                          kill(QQ);\r
 799                        fi;\r
 800                        call MOVE(160,160);\r
 801                        call OUTSTRING("**********TERMINE**********");\r
 802                        CALL GROFF;\r
 803                        call ENDRUN;\r
 804                      fi;\r
 805                    fi;\r
 806 \r
 807           when 3 : call CLS;   (* pour chercher un element dans l'arbre *)\r
 808                    if adjonc then\r
 809                      call COLOR(3);\r
 810                      call MOVE(128,16);\r
 811                      call OUTSTRING("RECHERCHE D'UN ELEMENT DANS UN ARBRE BICOLORE");\r
 812                      call MOVE(40,88);\r
 813                      call OUTSTRING("Entrez l'element a rechercher dans l'arbre :");\r
 814                      call MOVE(400,88);\r
 815                      elt:=ReadInteger;\r
 816                      Trech:=TT;\r
 817                      if not recherche(elt,ZZ,Trech,Prech) then\r
 818                        call CLS;\r
 819                        call MOVE(40,136);\r
 820                        call WriteInteger(elt);\r
 821                        call OUTSTRING(" est absent de l'arbre !!");\r
 822                        call MOVE(40,152);\r
 823                        call OUTSTRING("Tapez sur une touche pour verification...");\r
 824                        touche:=INCHAR;\r
 825                        call CLS;\r
 826                        call BORDER(1);\r
 827                        call MOVE(88,16);\r
 828                        call OUTSTRING("VERIFICATION");\r
 829                        Taff:=TT.fd;\r
 830                        call affpreordre(Taff,ZZ,0.5,1,0,0);\r
 831                        call MOVE(40,300);\r
 832                        call OUTSTRING("Tapez sur une touche pour retourner au menu ...");\r
 833                        touche:=INCHAR;\r
 834                      else\r
 835                        call MOVE(40,136);\r
 836                        call WriteInteger(elt);\r
 837                        call OUTSTRING(" est present dans l'arbre");\r
 838                        call MOVE(40,152);\r
 839                        call OUTSTRING("Tapez sur une touche pour verification...");\r
 840                        touche:=INCHAR;\r
 841                        call CLS;\r
 842                        call BORDER(1);\r
 843                        call MOVE(88,16);\r
 844                        call OUTSTRING("VERIFICATION : "); \r
 845                        Taff:=TT.fd; \r
 846                        call affpreordre(Taff,ZZ,0.5,1,0,0);\r
 847                        call MOVE(40,300);\r
 848                        call OUTSTRING("Tapez sur une touche pour retourner au menu ...");\r
 849                        touche:=INCHAR; \r
 850                      fi;\r
 851                      repeat;\r
 852                    else\r
 853                      call MOVE(160,120);\r
 854                      call OUTSTRING("ATTENTION !");\r
 855                      call MOVE(40,136);\r
 856                      call OUTSTRING("Recherche impossible car arbre inexistant !");\r
 857                      call MOVE(40,152);\r
 858                      call OUTSTRING("Retour au menu pour creer un arbre ? Si oui, tapez 1 : ");\r
 859                      call MOVE(496,152);\r
 860                      interm:=ReadInteger;\r
 861                      if interm=1 then\r
 862                        repeat;\r
 863                      else\r
 864                        if adjonc then\r
 865                          call menage(ZZ,TT); (*Destruction de l'arbre*)\r
 866                          kill(TT);\r
 867                          kill(ZZ);\r
 868                          kill(QQ);\r
 869                        fi;\r
 870                        call MOVE(160,160);\r
 871                        call OUTSTRING("**********TERMINE**********");\r
 872                        call GROFF;\r
 873                        call ENDRUN;\r
 874                      fi;\r
 875                    fi;\r
 876                     \r
 877           when 4 : call CLS;   (* pour trouver le minimum de l'arbre *)\r
 878                    if adjonc then\r
 879                      call MOVE(128,16);\r
 880                      call OUTSTRING("RECHERCHE DU MINIMUM DANS UN ARBRE BICOLORE");\r
 881                      call MOVE(40,136);\r
 882                      call OUTSTRING("Voici le minimum de l'arbre bicolore :");\r
 883                      call MOVE(360,136);\r
 884                      call WriteInteger(minmax(TT,ZZ,0));\r
 885                      call MOVE(40,300);\r
 886                      call OUTSTRING("Tapez sur une touche pour retourner au menu ...");\r
 887                      touche:=INCHAR;\r
 888                      repeat;\r
 889                    else\r
 890                      call MOVE(160,120);\r
 891                      call OUTSTRING("ATTENTION !");\r
 892                      call MOVE(40,144);\r
 893                      call OUTSTRING("Recherche du minimum impossible car arbre inexistant !");\r
 894                      call MOVE(40,160);\r
 895                      call OUTSTRING("Retour au menu pour creer un arbre ? Si oui, tapez 1 : ");\r
 896                      call MOVE(488,160);\r
 897                      interm:=ReadInteger;                    \r
 898                      if interm=1 then\r
 899                        repeat;\r
 900                      else\r
 901                        if adjonc then\r
 902                          call menage(ZZ,TT); (*Destruction de l'arbre*)\r
 903                          kill(TT);\r
 904                          kill(ZZ);\r
 905                          kill(QQ);\r
 906                        fi;\r
 907                        call MOVE(160,160);\r
 908                        call OUTSTRING("**********TERMINE**********");\r
 909                        call GROFF;\r
 910                        call ENDRUN;\r
 911                      fi;\r
 912                    fi;\r
 913 \r
 914           when 5 : call CLS;   (* pour trouver le maximum de l'arbre *)\r
 915                    if adjonc then\r
 916                      call MOVE(128,16);\r
 917                      call OUTSTRING("RECHERCHE DU MAXIMUM DANS UN ARBRE BICOLORE");\r
 918                      call MOVE(40,136);\r
 919                      call OUTSTRING("Voici le maximum de l'arbre bicolore :");\r
 920                      call MOVE(360,136);\r
 921                      call WriteInteger(minmax(TT,ZZ,1));\r
 922                      call MOVE(40,300);\r
 923                      call OUTSTRING("Tapez sur une touche pour retourner au menu ...");\r
 924                      touche:=INCHAR;\r
 925                      repeat;\r
 926                    else\r
 927                      call MOVE(24,40);\r
 928                      call OUTSTRING("ATTENTION !");\r
 929                      call MOVE(40,40);\r
 930                      call OUTSTRING("Recherche du maximum impossible car arbre inexistant !");\r
 931                      call MOVE(56,40);\r
 932                      call OUTSTRING("Retour au menu pour creer un arbre ? Si oui, tapez 1 : ");\r
 933                      call MOVE(56,488);\r
 934                      interm:=ReadInteger;\r
 935                      if interm=1 then\r
 936                        repeat;\r
 937                      else\r
 938                        if adjonc then\r
 939                          call menage(ZZ,TT); (*Destruction de l'arbre*)\r
 940                          kill(TT);\r
 941                          kill(ZZ);\r
 942                          kill(QQ);\r
 943                        fi;\r
 944                        call MOVE(160,160);\r
 945                        call OUTSTRING("**********TERMINE**********");\r
 946                        call GROFF;\r
 947                        call ENDRUN;\r
 948                      fi;\r
 949                    fi;\r
 950 \r
 951           when 6 : call CLS;   (* pour chercher le(s) successeur(s) d'un element*)\r
 952                    if adjonc then \r
 953                      call COLOR(3);\r
 954                      call MOVE(136,16);\r
 955                      call OUTSTRING("RECHERCHE DE(S) SUCCESSEUR(S) D'UN ELEMENT");\r
 956                      call MOVE(40,88);\r
 957                      call OUTSTRING("Entrez l'element dont vous voulez le(s) successeur(s) :");\r
 958                      call MOVE(496,88);\r
 959                      elt:=ReadInteger;\r
 960                      Trech:=TT;\r
 961                      if not recherche(elt,ZZ,Trech,Prech) then\r
 962                        call CLS;\r
 963                        call MOVE(40,136);\r
 964                        call WriteInteger(elt);\r
 965                        call OUTSTRING(" est absent de l'arbre !!");\r
 966                        call MOVE(40,152);\r
 967                        call OUTSTRING("Tapez sur une touche pour verification...");\r
 968                        touche:=INCHAR;\r
 969                        call CLS;\r
 970                        call BORDER(1);\r
 971                        call MOVE(88,16);\r
 972                        call OUTSTRING("VERIFICATION : ");\r
 973                        Taff:=TT.fd;\r
 974                        call affpreordre(Taff,ZZ,0.5,1,0,0);\r
 975                        call MOVE(40,300);\r
 976                        call OUTSTRING("Tapez sur une touche pour retourner au menu ...");\r
 977                        touche:=INCHAR;\r
 978                      else\r
 979                        call CLS;\r
 980                        call MOVE(40,40);\r
 981                        if Trech.fg <> ZZ and Trech.fd <> ZZ then\r
 982                          call OUTSTRING("Le(s) successeurs de ");\r
 983                          call WriteInteger(elt);\r
 984                          call OUTSTRING(" sont : ");\r
 985                          call WriteInteger(Trech.fg.val);\r
 986                          call OUTSTRING(" et ");\r
 987                          call WriteInteger(Trech.fd.val);\r
 988                        else\r
 989                          if Trech.fg <> ZZ then\r
 990                            call OUTSTRING("Le successeur gauche de ");\r
 991                            call WriteInteger(elt);\r
 992                            call OUTSTRING(" est : ");\r
 993                            call WriteInteger(Trech.fg.val);\r
 994                          else\r
 995                            if Trech.fd <> ZZ then\r
 996                              call OUTSTRING("Le successeur droit de ");\r
 997                              call WriteInteger(elt);\r
 998                              call OUTSTRING("est : ");\r
 999                              call WriteInteger(Trech.fd.val);\r
1000                            else\r
1001                              call OUTSTRING("L'element ");\r
1002                              call WriteInteger(elt);\r
1003                              call OUTSTRING(" n'a aucun successeur !");\r
1004                            fi;\r
1005                          fi;\r
1006                        fi;\r
1007                        call BORDER(1);\r
1008                        call MOVE(40,152);\r
1009                        call OUTSTRING("Tapez sur une touche pour verification...");\r
1010                        touche:=INCHAR;\r
1011                        call CLS;\r
1012                        call BORDER(1);\r
1013                        call MOVE(112,16);\r
1014                        call OUTSTRING("VERIFICATION : "); \r
1015                        Taff:=TT.fd; \r
1016                        call affpreordre(Taff,ZZ,0.5,1,0,0);\r
1017                        call MOVE(40,300);\r
1018                        call OUTSTRING("Tapez sur une touche pour retourner au menu ...");\r
1019                        touche:=INCHAR; \r
1020                      fi;\r
1021                      repeat;\r
1022                    else\r
1023                      call COLOR(3);\r
1024                      call MOVE(350,40);\r
1025                      call OUTSTRING("ATTENTION !");\r
1026                      call MOVE(40,64); \r
1027                      call OUTSTRING("Recherche impossible car arbre inexistant !");\r
1028                      call MOVE(40,80);\r
1029                      call OUTSTRING("Retour au menu pour creer un arbre ? Si oui, tapez 1 : ");\r
1030                      call MOVE(488,80);\r
1031                      interm:=ReadInteger;\r
1032                      if interm=1 then\r
1033                        repeat;\r
1034                      else\r
1035                        if adjonc then\r
1036                          call menage(ZZ,TT); (*Destruction de l'arbre*)\r
1037                          kill(TT);\r
1038                          kill(ZZ);\r
1039                          kill(QQ);\r
1040                        fi;\r
1041                        call MOVE(160,160);\r
1042                        call OUTSTRING("**********TERMINE**********");\r
1043                        call GROFF;\r
1044                        call ENDRUN;\r
1045                      fi;\r
1046                    fi;\r
1047                     \r
1048           \r
1049           when 7 : call CLS;   (* pour chercher le predecesseur d'un element*)\r
1050                    if adjonc then\r
1051                      call COLOR(3);\r
1052                      call MOVE(136,16);\r
1053                      call OUTSTRING("RECHERCHE DU PREDECESSEUR D'UN ELEMENT");\r
1054                      call MOVE(40,88);\r
1055                      call OUTSTRING("Entrez l'element dont vous voulez le predecesseur :");\r
1056                      call MOVE(456,88);\r
1057                      elt:=ReadInteger;\r
1058                      Trech:=TT;\r
1059                      if not recherche(elt,ZZ,Trech,Prech) then\r
1060                        call CLS;\r
1061                        call MOVE(40,136);\r
1062                        call WriteInteger(elt);\r
1063                        call OUTSTRING(" est absent de l'arbre !!");\r
1064                        call MOVE(40,152);\r
1065                        call OUTSTRING("Tapez sur une touche pour verification...");\r
1066                        touche:=INCHAR;\r
1067                        call CLS;\r
1068                        call BORDER(1);\r
1069                        call MOVE(88,16);\r
1070                        call OUTSTRING("VERIFICATION : ");\r
1071                        Taff:=TT.fd;\r
1072                        call affpreordre(Taff,ZZ,0.5,1,0,0);\r
1073                        call MOVE(40,300);\r
1074                        call OUTSTRING("Tapez sur une touche pour retourner au menu ...");\r
1075                        touche:=INCHAR;\r
1076                        repeat;\r
1077                      else\r
1078                        call CLS;\r
1079                        call MOVE(40,40);\r
1080                        if Trech = TT.fd then\r
1081                          call OUTSTRING("L'element ");\r
1082                          call WriteInteger(elt);\r
1083                          call OUTSTRING(" n'a pas de predecesseur ! ");\r
1084                        else\r
1085                          call OUTSTRING("Le predecesseur de ");\r
1086                          call WriteInteger(elt);\r
1087                          call OUTSTRING(" est : ");\r
1088                          call WriteInteger(Prech.val);\r
1089                        fi;\r
1090                      fi;\r
1091                      call BORDER(1);\r
1092                      call MOVE(40,152);\r
1093                      call OUTSTRING("Tapez sur une touche pour verification...");\r
1094                      touche:=INCHAR;\r
1095                      call CLS;\r
1096                      call MOVE(88,16);\r
1097                      call OUTSTRING("VERIFICATION : "); \r
1098                      Taff:=TT.fd; \r
1099                      call affpreordre(Taff,ZZ,0.5,1,0,0);\r
1100                      call MOVE(40,300);\r
1101                      call OUTSTRING("Tapez sur une touche pour retourner au menu ...");\r
1102                      touche:=INCHAR; \r
1103                      repeat;\r
1104                    \r
1105                    else\r
1106                      call COLOR(3);\r
1107                      call MOVE(350,40);\r
1108                      call OUTSTRING("ATTENTION !");\r
1109                      call MOVE(40,64);\r
1110                      call OUTSTRING("Recherche impossible car arbre inexistant !");\r
1111                      call MOVE(40,80);\r
1112                      call OUTSTRING("Retour au menu pour creer un arbre ? Si oui, tapez 1 : ");\r
1113                      call MOVE(488,80);\r
1114                      interm:=ReadInteger;\r
1115                      if interm=1 then\r
1116                        repeat;\r
1117                      else\r
1118                        if adjonc then\r
1119                          call menage(ZZ,TT); (*Destruction de l'arbre*)\r
1120                          kill(TT);\r
1121                          kill(ZZ);\r
1122                          kill(QQ);\r
1123                        fi;\r
1124                        call MOVE(160,160);\r
1125                        call OUTSTRING("**********TERMINE**********");\r
1126                        call GROFF;\r
1127                        call ENDRUN;\r
1128                      fi;\r
1129                    fi;\r
1130                     \r
1131           when 8 : call CLS;   (* pour supprimer un element*)\r
1132                    if adjonc then\r
1133                      call MOVE(152,16);\r
1134                      call OUTSTRING("SUPPRESSION D'UN ELEMENT");\r
1135                      call MOVE(40,88);\r
1136                      call OUTSTRING("Entrez l'element a supprimer :");\r
1137                      call MOVE(280,88);\r
1138                      elt:=ReadInteger;\r
1139                      Trech:=TT;\r
1140                      Prech:=TT;\r
1141                      if not recherche(elt,ZZ,Trech,Prech) then\r
1142                        call CLS;\r
1143                        call MOVE(40,136);\r
1144                        call WriteInteger(elt);\r
1145                        call OUTSTRING(" est absent de l'arbre donc suppression impossible !!");\r
1146                        call MOVE(40,152);\r
1147                        call OUTSTRING("Tapez sur une touche pour verification...");\r
1148                        touche:=INCHAR;\r
1149                      else\r
1150                        call suppression(elt,ZZ,TT,Trech,Prech,adjonc);\r
1151                        if not adjonc then\r
1152                          kill(ZZ);\r
1153                          kill(QQ);\r
1154                          call CLS;\r
1155                          call MOVE(350,40);\r
1156                          call OUTSTRING("Arbre detruit !!!");\r
1157                          call MOVE(40,200);\r
1158                          call OUTSTRING("Tapez sur une touche pour retourner au menu ...");\r
1159                          touche:=INCHAR;\r
1160                          repeat;\r
1161                        fi;\r
1162                      fi;\r
1163                      call CLS;\r
1164                      call BORDER(1);\r
1165                      call MOVE(88,16);\r
1166                      call OUTSTRING("VERIFICATION "); \r
1167                      Taff:=TT.fd; \r
1168                      call affpreordre(Taff,ZZ,0.5,1,0,0);\r
1169                      call MOVE(40,300);\r
1170                      call OUTSTRING("Tapez sur une touche pour retourner au menu ...");\r
1171                      touche:=INCHAR; \r
1172                      repeat;\r
1173                    else\r
1174                      call MOVE(350,40);\r
1175                      call OUTSTRING("ATTENTION !");\r
1176                      call MOVE(40,64);\r
1177                      call OUTSTRING("Suppression impossible car arbre inexistant !");\r
1178                      call MOVE(40,80);\r
1179                      call OUTSTRING("Retour au menu pour creer un arbre ? Si oui, tapez 1 : ");\r
1180                      call MOVE(488,80);\r
1181                      interm:=ReadInteger;\r
1182                      if interm=1 then\r
1183                        repeat;\r
1184                      else\r
1185                        if adjonc then\r
1186                          call menage(ZZ,TT); (*Destruction de l'arbre*)\r
1187                          kill(TT);\r
1188                          kill(ZZ);\r
1189                          kill(QQ);\r
1190                        fi;\r
1191                        call MOVE(160,160);\r
1192                        call OUTSTRING("**********TERMINE**********");\r
1193                        call GROFF;\r
1194                        call ENDRUN;\r
1195                      fi;\r
1196                    fi;\r
1197                                    \r
1198           when 9 : call CLS;   (* pour afficher le contenu de l'arbre *)\r
1199                    call BORDER(1);\r
1200                    call COLOR(3);\r
1201                    call MOVE(192,16);\r
1202                    if adjonc then\r
1203                      call OUTSTRING("AFFICHAGE DE L'ARBRE BICOLORE");\r
1204                      call MOVE(180,32);\r
1205                      Taff:=TT.fd; \r
1206                      call affpreordre(Taff,ZZ,0.5,1,0,0);\r
1207                    else\r
1208                      call OUTSTRING("ARBRE VIDE !!!!");\r
1209                    fi;\r
1210                    call MOVE(40,300);\r
1211                    (*call COLOR(7);*)\r
1212                    call OUTSTRING("Tapez sur une touche pour retourner au menu ...");\r
1213                    touche:=INCHAR; \r
1214                    repeat;\r
1215 \r
1216           otherwise\r
1217                    call CLS;   (* gestion des operations inexistantes *)\r
1218                    call MOVE(350,40);\r
1219                    call OUTSTRING("Option inexistante !!");\r
1220                    call MOVE(40,152);\r
1221                    call OUTSTRING("Voulez-vous retourner au menu ? Si oui, tapez 1 : ");\r
1222                    call MOVE(440,152);\r
1223                    interm:=ReadInteger;\r
1224                    if interm=1 then\r
1225                      repeat;\r
1226                    else\r
1227                      if adjonc then\r
1228                        call menage(ZZ,TT); (*Destruction de l'arbre*)\r
1229                        kill(TT);\r
1230                        kill(ZZ);\r
1231                        kill(QQ);\r
1232                      fi;\r
1233                      call MOVE(160,1600);\r
1234                      call OUTSTRING("**********TERMINE**********");\r
1235                      call GROFF;\r
1236                      call ENDRUN;\r
1237                    fi;\r
1238         ESAC;                                                           \r
1239       OD;\r
1240     END;\r
1241 END BICOLORE.                      \r
1242         \r
1243 \r
1244 \r
1245 \r
1246                 \r