examples/data_str/bicol3.log

   1 BLOCK\r
   2     const\r
   3         rouge=0,\r
   4         blanc=1;\r
   5 \r
   6     (* D\82finition classe Caract\8are *)\r
   7     unit caractere:class(x:char);\r
   8     end caractere;\r
   9 \r
  10     (* Function attendant qu'un caract\8are soit tap\82 au clavier *)\r
  11     (* et le renvoie *)\r
  12     unit saisie_car:function:integer;\r
  13     var a:integer;\r
  14     begin\r
  15         pref IIUWGRAPH block\r
  16         begin\r
  17         a:=0;\r
  18         while a=0 do\r
  19             a:=inkey;\r
  20         od;\r
  21         result:=a;\r
  22         end;\r
  23     end saisie_car;\r
  24 \r
  25     (* D\82finition de la classe arbre_bicolore *)\r
  26     (* Param\88tres : le type elem des \82l\82ments utilis\82s *)\r
  27     (*                 fonction inf renvoyant vrai si e1<e2 *)\r
  28     (*                 fonction sup renvoyant vrai si e1>e2 *)\r
  29     (*                 fonction eg  renvoyant vrai si e1=e2 *)\r
  30     (*                 proc\82dure aff affichant e *)\r
  31     unit arbre_bicolore:class(type elem;\r
  32                               function inf(e1,e2:elem):boolean;\r
  33                               function sup(e1,e2:elem):boolean;\r
  34                               function eg(e1,e2:elem):boolean;\r
  35                               procedure aff(e:elem));\r
  36 \r
  37         (* D\82finition d'une cellule ou noeud *)\r
  38         unit cellule:class;\r
  39         var e:elem;\r
  40         var p,left,right:cellule;\r
  41         var color:integer;\r
  42         end cellule;\r
  43 \r
  44         (* D\82claration de la racine *)\r
  45         Var T:cellule;\r
  46 \r
  47         (* Procedure affichant les information contenues dans *)\r
  48         (* s, x et s2 en faisant une pause *)\r
  49         unit info:procedure(s:string;x:elem;s2:string);\r
  50         var i:integer;\r
  51         begin\r
  52             pref IIUWGRAPH block\r
  53             begin\r
  54                 call color(15);\r
  55                 call move(10,200);\r
  56                 call outstring("                                                                   ");\r
  57                 call move(10,200);\r
  58                 call outstring(s);\r
  59                 call aff(x);\r
  60                 call outstring(s2);\r
  61                                 call move(10,220);\r
  62                 call outstring("<Enter>");\r
  63                                 i:=0;\r
  64                         while (i<>13) do\r
  65                 i:=inkey;\r
  66                         od;\r
  67                                 call move(10,220);\r
  68                     call outstring("       ");\r
  69                         end;\r
  70         end info;\r
  71 \r
  72         (* Fonction ajoutant un nouvel \82l\82ment dans l'arbre \85 la fa\87on *)\r
  73         (* d'un bst, elle renvoie la cellule qui a \82t\82 cr\82e et rajout\82e*)\r
  74         unit recursive_ajout:function(e:elem;inout r,p:cellule):cellule;\r
  75         var a:cellule;\r
  76         begin\r
  77             if r=none then\r
  78                 a:=new cellule;\r
  79                 a.e:=e;\r
  80                 a.p:=p;\r
  81                 r:=a;\r
  82                 result:=r;\r
  83             else\r
  84                 if inf(e,r.e) then\r
  85                     result:=recursive_ajout(e,r.left,r);\r
  86                 else if sup(e,r.e) then\r
  87                         result:=recursive_ajout(e,r.right,r);\r
  88                      fi\r
  89                 fi;\r
  90             fi;\r
  91         end recursive_ajout;\r
  92 \r
  93         (* Cette fonction apelle la proc\82dure r\82cursive "recursive_ajout"*)\r
  94         unit insere_bst:function(x:elem):cellule;\r
  95         var none_p:cellule;\r
  96         begin\r
  97             none_p:=none;\r
  98             result:=recursive_ajout(x,T,none_p);\r
  99         end insere_bst;\r
 100 \r
 101         (* Procedure effectuant une rotation \85 gauche sur la cellule c *)\r
 102         unit left_rotate:procedure(c:cellule);\r
 103         var y:cellule;\r
 104         begin\r
 105             y:=c.right;\r
 106             c.right:=y.left;\r
 107             if y.left<>none then\r
 108                 y.left.p:=c;\r
 109             fi;\r
 110             y.p:=c.p;\r
 111             if c.p=none then\r
 112                 T:=y;\r
 113             else\r
 114                 if c=c.p.left then\r
 115                     c.p.left:=y;\r
 116                 else\r
 117                     c.p.right:=y;\r
 118                 fi;\r
 119             fi;\r
 120             y.left:=c;\r
 121             c.p:=y;\r
 122         end left_rotate;\r
 123 \r
 124         (* Procedure effectuant une rotation \85 droite sur la cellule c *)\r
 125         unit right_rotate:procedure(c:cellule);\r
 126         var y:cellule;\r
 127         begin\r
 128             y:=c.left;\r
 129             c.left:=y.right;\r
 130             if y.right<>none then\r
 131                 y.right.p:=c;\r
 132             fi;\r
 133             y.p:=c.p;\r
 134             if c.p=none then\r
 135                 T:=y;\r
 136             else\r
 137                 if c=c.p.right then\r
 138                     c.p.right:=y;\r
 139                 else\r
 140                     c.p.left:=y;\r
 141                 fi;\r
 142             fi;\r
 143             y.right:=c;\r
 144             c.p:=y;\r
 145         end right_rotate;\r
 146 \r
 147         (* Proc\82dure ins\82rant un nouvel \82l\82ment x dans l'arbre bicolore *)\r
 148         unit insert:procedure(x:elem);\r
 149         var y,c:cellule,ok:boolean;\r
 150         var i:integer;\r
 151         var E:cellule;\r
 152         begin\r
 153             e:=new cellule;\r
 154             pref IIUWGRAPH block\r
 155             begin\r
 156             (* insersion dans l'arbre et affichage *)\r
 157             c:=insere_bst(x);\r
 158             if c<>none then c.color:=rouge;fi;\r
 159             call parcours;\r
 160             if c<>none then\r
 161                 call info("Ajout en rouge de l'\82l\82ment ",c.e," dans le BST-arbre ");\r
 162             fi;\r
 163 \r
 164             (* Retraitement de l'arbre si un nouvel \82l\82ment a \82t\82 cr\82\82 *)\r
 165             if c<>none then\r
 166                 if c=t then ok:=false\r
 167                 else ok:=c.p.color=rouge;\r
 168                 fi;\r
 169 \r
 170                 (* on teste les \82l\82ments de la feuille ajout\82e *)\r
 171                 (* Jusqu'\85 la racine *)\r
 172                 while (c<>T) and (ok)\r
 173                 do\r
 174                     if (c.p=c.p.p.left) then\r
 175                         y:=c.p.p.right;\r
 176                         (* Echange des couleurs si un noeud a deux fils rouges *)\r
 177                         if (y<>none) andif (y.color=rouge) then\r
 178                             c.p.color:=blanc;\r
 179                             y.color:=blanc;\r
 180                             c.p.p.color:=rouge;\r
 181                             c:=c.p.p;\r
 182                             call parcours;\r
 183                             if c<>none then\r
 184                                 call info("Echanges de couleurs entre ",c.e," et ses fils");\r
 185                             fi;\r
 186                         else\r
 187                             (* Rotation si un noeud rouge a un fils rouge *)\r
 188                             if (c=c.p.right) then\r
 189                                 c:=c.p;\r
 190                                 E.e:=c.e;\r
 191                                 call info("Rotation gauche sur ",e.e,". ");\r
 192                                 call left_rotate(c);\r
 193                                 call cls;\r
 194                                 call parcours;\r
 195                                 call info("Rotation gauche sur ",e.e,"effectu\82e. ");\r
 196                             fi;\r
 197                             c.p.color:=blanc;\r
 198                             c.p.p.color:=rouge;\r
 199                             e.e:=c.p.p.e;\r
 200                             call info("Rotation droite sur ",e.e,".");\r
 201                             call right_rotate(c.p.p);\r
 202                             call cls;\r
 203                             call parcours;\r
 204                             call info("Rotation droite sur ",e.e," effectu\82e.");\r
 205                         fi;\r
 206                     else\r
 207                         y:=c.p.p.left;\r
 208                         (* Echange des couleurs si un noeud a deux fils rouges *)\r
 209                         if (y<>none) andif (y.color=rouge) then\r
 210                             c.p.color:=blanc;\r
 211                             y.color:=blanc;\r
 212                             c.p.p.color:=rouge;\r
 213                             c:=c.p.p;\r
 214                             if c<>none then\r
 215                                 call info("Echange de couleurs entre ",c.e," et ses fils ");\r
 216                             fi;\r
 217                             call parcours;\r
 218                         else\r
 219                             (* Rotation si un noeud rouge a un fils rouge *)\r
 220                             if (c=c.p.left) then\r
 221                                 c:=c.p;\r
 222                                 e.e:=c.e;\r
 223                                 call info("Rotation droite sur ",e.e," .");\r
 224                                 call right_rotate(c);\r
 225                                 call cls;\r
 226                                 call parcours;\r
 227                                 call info("Rotation droite sur ",e.e," effectu\82e.");\r
 228                             fi;\r
 229                             c.p.color:=blanc;\r
 230                             c.p.p.color:=rouge;\r
 231                             e.e:=c.p.p.e;\r
 232                             call info("Rotation gauche sur ",e.e,".");\r
 233                             call left_rotate(c.p.p);\r
 234                             call cls;\r
 235                             call parcours;\r
 236                             call info("Rotation gauche sur ",e.e," effectu\82e.");\r
 237                         fi;\r
 238                     fi;\r
 239                     if c=t then ok:=false;\r
 240                     else ok:=c.p.color=rouge;\r
 241                     fi;\r
 242                 od;\r
 243             fi;\r
 244 \r
 245             (* La racine est toujours blanche *)\r
 246             T.color:=blanc;\r
 247             end;\r
 248             kill(e);\r
 249         end insert;\r
 250 \r
 251 \r
 252         (* Proc\82dure r\82cursive de parcours et d'affichage *)\r
 253         (* de l'arbre \85 l'\82cran *)\r
 254         (* param\8atres  r:cellule en cours de traitement *)\r
 255         (*             x2,y2 : coordonn\82es du pr\82c\82dent noeud *)\r
 256         (*             x,y   : coordonn\82es du nouveau noeud *)\r
 257         (*             dx : \82cartement actuel des branches *)\r
 258         unit rec_par:procedure(r:cellule;x2,y2,x,y,dx:integer);\r
 259         var coul:integer;\r
 260         begin\r
 261             pref IIUWGRAPH block\r
 262             begin\r
 263             if r.left<>none then\r
 264                 call rec_par(r.left,x-5,y,x-dx,y+30,dx div 2);\r
 265             fi;\r
 266 \r
 267             (* affichage de la branche *)\r
 268             call color(8);\r
 269             call move(x2,y2);\r
 270             call draw(x,y);\r
 271             if r.color=rouge then coul:=4;\r
 272             else coul:=15;\r
 273             fi;\r
 274 \r
 275             (* affichage du noeud *)\r
 276             call style(0);\r
 277             call cirb(x+3,y+3,10,0,0,coul,1,1,1);\r
 278             call style(1);\r
 279             call color(coul);\r
 280             call move(x,y);\r
 281             call aff(r.e);\r
 282             if r.right <>none then\r
 283                 call rec_par(r.right,x+11,y,x+dx,y+30,dx div 2);\r
 284             fi;\r
 285             end;\r
 286         end rec_par;\r
 287 \r
 288         (* Proc\82dure amor\87ant le parcours *)\r
 289         unit parcours:procedure;\r
 290         begin\r
 291             if T<>none then call rec_par(T,320,10,320,10,160);fi;\r
 292         end parcours;\r
 293 \r
 294         (* Function recherchant dans l'arbre l'\82l\82ment x *)\r
 295         (* a partir du noeud noeud et renvoyant la cellule correspondante *)\r
 296         unit recherche:procedure(x:elem;noeud:cellule;output c:cellule);\r
 297         begin\r
 298             if inf(x,noeud.e) andif (noeud.left<>none) then\r
 299                 call recherche(x,noeud.left,c)\r
 300             else\r
 301                 if sup(x,noeud.e) andif (noeud.right<>none) then\r
 302                     call recherche(x,noeud.right,c)\r
 303                 else\r
 304                     if eg(x,noeud.e) then c:=noeud;\r
 305                     fi;\r
 306                 fi;\r
 307             fi;\r
 308         end recherche;\r
 309 \r
 310         (* Proc\82dure mettant \85 jour l'arbre de fa\87on \85 ce que toutes les *)\r
 311         (* propri\82t\82s des arbres bicolores soient respect\82es apr\8as une *)\r
 312         (* suppression d'un \82l\82ment *)\r
 313         unit delete_fixup:procedure (x:cellule);\r
 314         var e,w:cellule;\r
 315         var ok,test1,test2,cree:boolean;\r
 316         var i:integer;\r
 317         begin\r
 318             pref IIUWGRAPH block\r
 319             begin\r
 320             e:=new cellule;\r
 321             if x=none then ok:=false;\r
 322             else ok:=x.color=blanc;\r
 323             fi;\r
 324 \r
 325             (* on part de la cellule supprim\82e jusqu'\85 la racine *)\r
 326             (* on teste s'il n'y a pas deux noeuds rouges \85 la suite *)\r
 327             (* sinon on fait des rotations ... *)\r
 328             while (x<>T) and (ok)\r
 329             do\r
 330                 if (x=x.p.left) then\r
 331                     w:=x.p.right;\r
 332                     if w=none then\r
 333                         cree:=true;\r
 334                         w:=new cellule;\r
 335                         w.color:=blanc;\r
 336                                                 w.p:=x.p;\r
 337                                                 x.p.right:=w;\r
 338                     else cree:=false;\r
 339                     fi;\r
 340         \r
 341                     if (w<>none) andif (w.color=rouge) then\r
 342                         w.color:=blanc;\r
 343                         x.p.color:=rouge;\r
 344                         e.e:=x.p.e;\r
 345                         call info("Rotation gauche sur ",e.e,".");\r
 346                         call left_rotate(x.p);\r
 347                         call cls;\r
 348                         call parcours;\r
 349                         call info("Rotation gauche sur ",e.e," effectu\82e.");\r
 350                         w:=x.p.right;\r
 351                     fi;\r
 352                     if (w.left=none) orif (w.left.color=blanc)\r
 353                         then test1:=true;\r
 354                     else test1:=false;\r
 355                     fi;\r
 356                     if (w.right=none) orif (w.right.color=blanc)\r
 357                         then test2:=true;\r
 358                     else test2:=false;\r
 359                     fi;\r
 360                     if (test1) and (test2) then\r
 361                         w.color:=rouge;\r
 362                         x:=x.p;\r
 363                     else\r
 364                         if (w.right=none) orif (w.right.color=blanc) then\r
 365                             w.left.color:=blanc;\r
 366                             w.color:=rouge;\r
 367                             e.e:=w.e;\r
 368                             call info("Rotation droite sur ",e.e,".");\r
 369                             call right_rotate(w);\r
 370                             call cls;\r
 371                             call parcours;\r
 372                             call info("Rotation droite sur ",e.e," effectu\82e.");\r
 373                             w:=x.p.right;\r
 374                         fi;\r
 375                         w.color:=x.p.color;\r
 376                         x.p.color:=blanc;\r
 377                         w.right.color:=blanc;\r
 378                         e.e:=x.p.e;\r
 379                         call info("Rotation gauche sur ",e.e,".");\r
 380                         call left_rotate(x.p);\r
 381                         call cls;\r
 382                         call parcours;\r
 383                         call info("Rotation gauche sur ",e.e," effectu\82e.");\r
 384                         x:=T;\r
 385                     fi;\r
 386                     if cree then\r
 387                         kill(w);\r
 388                     fi;\r
 389                 else\r
 390                     w:=x.p.left;\r
 391                     if w=none then\r
 392                         w:=new cellule;\r
 393                         w.color:=blanc;\r
 394                                                 w.p:=x.p;\r
 395                                                 x.p.left:=w;\r
 396                         cree:=true;\r
 397                     else cree:=false;\r
 398                     fi;\r
 399                                         call parcours;\r
 400                     if (w<>none) andif (w.color=rouge) then\r
 401                         w.color:=blanc;\r
 402                         x.p.color:=rouge;\r
 403                         e.e:=x.p.e;\r
 404                         call info("Rotation droite sur ",e.e,".");\r
 405                         call right_rotate(x.p);\r
 406                         call cls;\r
 407                         call parcours;\r
 408                         call info("Rotation droite sur ",e.e," effectu\82e.");\r
 409                         w:=x.p.left;\r
 410                     fi;\r
 411                     if (w.right=none) orif (w.right.color=blanc) then\r
 412                         test1:=true;\r
 413                     else test1:=false;\r
 414                     fi;\r
 415                     if (w.left=none) orif (w.left.color=blanc) then\r
 416                         test2:=true;\r
 417                     else test2:=false;\r
 418                     fi;\r
 419                     if (test1) and (test2) then\r
 420                         w.color:=rouge;\r
 421                         x:=x.p;\r
 422                     else\r
 423                         if (w.left=none) orif (w.left.color=blanc) then\r
 424                             w.right.color:=blanc;\r
 425                             w.color:=rouge;\r
 426                             e.e:=w.e;\r
 427                             call info("Rotation gauche sur ",e.e,".");\r
 428                             call left_rotate(w);\r
 429                             call cls;\r
 430                             call parcours;\r
 431                             call info("Rotation gauche sur ",e.e," effectu\82e.");\r
 432                             w:=x.p.left;\r
 433                         fi;\r
 434                         w.color:=x.p.color;\r
 435                         x.p.color:=blanc;\r
 436                         w.left.color:=blanc;\r
 437                         e.e:=x.p.e;\r
 438                         call info("Rotation droite sur ",e.e,".");\r
 439                         call right_rotate(x.p);\r
 440                         call cls;\r
 441                         call parcours;\r
 442                         call info("Rotation droite sur ",e.e," effectu\82e.");\r
 443                         x:=T;\r
 444                     fi;\r
 445                     if (cree) then\r
 446                         kill(w);\r
 447                     fi;\r
 448                 fi;\r
 449                 if x=none then ok:=false;\r
 450                 else ok:=x.color=blanc;\r
 451                 fi;\r
 452             od;\r
 453             if x<>none then\r
 454                 (* racine blanche *)\r
 455                 x.color:=blanc;\r
 456             fi;\r
 457             call parcours;\r
 458             call move(10,200);\r
 459             call color(15);\r
 460             call outstring("Mise \85 jour de l'arbre effectu\82e. ");\r
 461             for i:=1 to 4000 do;od;\r
 462             kill(e);\r
 463             end;\r
 464         end delete_fixup;\r
 465 \r
 466         (* Fonction renvoyant le succ\82sseur d'une cellule \85 supprimer *)\r
 467         (* c'est \85 dire, le plus grand \82l\82ment du sous-arbre gauche,  *)\r
 468         (* ou le plus petit \82l\82ment du sous-arbre droit *)\r
 469         unit tree_suc:function(c:cellule):cellule;\r
 470         var r:cellule;\r
 471         begin\r
 472             if (c.left<>none) then\r
 473                 r:=c.left;\r
 474                 while r.right<>none\r
 475                 do\r
 476                     r:=r.right;\r
 477                 od;\r
 478             else\r
 479                 if (c.right<>none) then\r
 480                     r:=c.right;\r
 481                     while r.left<>none\r
 482                     do\r
 483                         r:=r.left\r
 484                     od;\r
 485                 fi;\r
 486             fi;\r
 487             result:=r;\r
 488         end tree_suc;\r
 489 \r
 490         (* Proc\82dure supprimant un \82l\82ment dans l'arbre *)\r
 491         unit delete:procedure(e:elem);\r
 492         var c,x,y,k:cellule;\r
 493         var cree:integer;\r
 494         begin\r
 495             k:=new cellule;\r
 496             pref IIUWGRAPH block\r
 497             begin\r
 498             (* Recherche de l'\82l\82ment *)\r
 499             if T<>none then call recherche(e,T,c);fi;\r
 500             (* Recherche de l'\82l\82ment le rempla\87ant *)\r
 501             if c<>none then\r
 502                 if c.left=none or c.right=none then\r
 503                     y:=c;\r
 504                     kill(k);\r
 505                 else\r
 506                     y:=tree_suc(c);\r
 507                     k.e:=y.e;\r
 508                 fi;\r
 509 \r
 510                 (* Remplacement *)\r
 511                 call info("Suppression et remplacement de ",c.e,".");\r
 512                 if y.left<>none then\r
 513                     x:=y.left;\r
 514                 else\r
 515                     x:=y.right;\r
 516                     if x=none then\r
 517                         x:=new cellule;\r
 518                         y.right:=x;\r
 519                                                 x.color:=blanc;\r
 520                         cree:=1;\r
 521                     else\r
 522                         cree:=0;\r
 523                     fi;\r
 524                 fi;\r
 525                 x.p:=y.p;\r
 526 \r
 527                 if y.p=none then\r
 528                     T:=x;\r
 529                 else\r
 530                     if y=y.p.left then\r
 531                         y.p.left:=x;\r
 532                     else\r
 533                         y.p.right:=x;\r
 534                     fi;\r
 535                 fi;\r
 536                 if y<>c then\r
 537                     c.e:=y.e;\r
 538                 fi;\r
 539                 call cls;\r
 540                 call parcours;\r
 541                 if k<>none then\r
 542                     call info("Suppression et remplacement par ",k.e," effectu\82e.");\r
 543                     kill(k);\r
 544                 else\r
 545                     call info("Suppression de ",y.e," effectu\82e .");\r
 546                 fi;\r
 547                 (* mise \85 jour de l'arbre *)\r
 548                 if y.color=blanc then\r
 549                     call delete_fixup(x);\r
 550                 fi;\r
 551                 if (cree=1) then\r
 552                                         if (x.p<>none) andif (x=x.p.left) then\r
 553                                                 x.p.left:=none;\r
 554                                         else\r
 555                                                 if (x.p<>none) andif (x=x.p.right) then\r
 556                                                         x.p.right:=none;\r
 557                                                 else\r
 558                                                         if (x.p=none) then\r
 559                                                                 T:=none;\r
 560                             fi;\r
 561                                                 fi;\r
 562                                         fi;\r
 563                 fi;\r
 564             fi;\r
 565             end;\r
 566         end delete;\r
 567 \r
 568     end arbre_bicolore;\r
 569 \r
 570     (* Indique si x=y *)\r
 571     unit eg:function(x,y:caractere):boolean;\r
 572     begin\r
 573         result:=ord(x.x)=ord(y.x);\r
 574     end eg;\r
 575 \r
 576     (* Indique si x<y *)\r
 577     unit inf:function(x,y:caractere):boolean;\r
 578     begin\r
 579         result:=ord(x.x)<ord(y.x);\r
 580     end inf;\r
 581 \r
 582     (* Indique si x>y *)\r
 583     unit sup:function(x,y:caractere):boolean;\r
 584     begin\r
 585         result:=ord(x.x)>ord(y.x);\r
 586     end sup;\r
 587 \r
 588     (* affiche le caract\8are a *)\r
 589     unit aff:procedure(a:caractere);\r
 590     begin\r
 591         pref IIUWGRAPH block\r
 592         begin\r
 593             if a<>none then\r
 594                     Call HASCII(ord(a.x));\r
 595                         fi;\r
 596         end;\r
 597     end aff;\r
 598 \r
 599     (* d\82claration des variables *)\r
 600     var a_b:arbre_bicolore;\r
 601     var a:caractere;\r
 602     var e:char;\r
 603     var op:integer;\r
 604 begin\r
 605     pref IIUWGRAPH block\r
 606     begin\r
 607     (* initialisation graphique *)\r
 608     call gron(5);\r
 609 \r
 610     (* Cr\82ation d'un arbre *)\r
 611     a_b:=new arbre_bicolore(caractere,inf,sup,eg,aff);\r
 612 \r
 613     (* menu principal *)\r
 614     op:=0;\r
 615     while (op<>ord('q')) do\r
 616         call color(15);\r
 617         call move(10,270);\r
 618         call outstring("Ajouter un noeud .... A");\r
 619         call move(10,280);\r
 620         call outstring("Supprimer un noeud .. S");\r
 621         call move(10,290);\r
 622         call outstring("Quitter ............. Q");\r
 623         call move(10,300);\r
 624         call outstring("                                                               ");\r
 625 \r
 626         (* Saisie de l'op\82ration *)\r
 627         op:=0;\r
 628         while (op<>ord('q')) and (op<>ord('s')) and (op<>ord('a')) do\r
 629             op:=inkey;\r
 630             if (op<=ord('Z')) then op:=op+ord('a')-ord('A');fi;\r
 631         od;\r
 632 \r
 633         (* Saisie et ajout d'un \82l\82ment *)\r
 634         if (op=ord('a')) then\r
 635             call color(15);\r
 636             call move(10,300);\r
 637             call outstring("Tapez l'\82l\82ment \85 ajouter (Escape pour finir) :");\r
 638             e:=chr(saisie_car);\r
 639             while e<>chr(27) do\r
 640                 call move(400,300);\r
 641                 a:=new caractere(e);\r
 642                 call aff(a);\r
 643                 call a_b.insert(a);\r
 644                 call cls;\r
 645                 call a_b.parcours;\r
 646                 call color(15);\r
 647                 call move(10,300);\r
 648                 call outstring("Tapez l'\82l\82ment \85 ajouter (Escape pour finir) :");\r
 649                 e:=chr(saisie_car);\r
 650            od;\r
 651         else\r
 652             (* Saisie et Suppression d'un \82l\82ment *)\r
 653             if (op=ord('s')) then\r
 654             call color(15);\r
 655             call move(10,300);\r
 656             call outstring("Tapez l'\82l\82ment \85 supprimer (Escape pour finir) :");\r
 657             e:=chr(saisie_car);\r
 658             while e<>chr(27) do\r
 659                 a:=new caractere(e);\r
 660                 call a_b.delete(a);\r
 661                 call cls;\r
 662                 call a_b.parcours;\r
 663                 call color(15);\r
 664                 call move(10,300);\r
 665                 call outstring("Tapez l'\82l\82ment \85 supprimer (Escape pour finir) :");\r
 666                 e:=chr(saisie_car);\r
 667             od;\r
 668             fi;\r
 669         fi;\r
 670     od;\r
 671     call groff;\r
 672     end;\r
 673 end;\r
 674 \r
 675 \r
 676 \r
 677 \r
 678 \r