examples/examples.old/projet.log

   1 PROGRAM projet;                       \r
   2 \r
   3 (* ------------------------------------------------------------------------ *)\r
   4 \r
   5  UNIT Entier_long : CLASS;\r
   6 \r
   7         UNIT elem : CLASS (valeur:INTEGER, suivant:elem);\r
   8         END elem;\r
   9 \r
  10 (* ------------------------------------------------------------------------ *)\r
  11 \r
  12         VAR sommet : elem;\r
  13 \r
  14 (* ------------------------------------------------------------------------ *)\r
  15         \r
  16         UNIT depiler : FUNCTION : INTEGER;\r
  17         (* Cette fonction permet d'extraire d'une pile un \82l\8ament. *)\r
  18 \r
  19         BEGIN\r
  20                 IF sommet =/= NONE \r
  21                 \r
  22                 THEN\r
  23                         RESULT := sommet.valeur; \r
  24                         sommet := sommet.suivant\r
  25                 \r
  26                 FI;\r
  27         \r
  28         END depiler;\r
  29 \r
  30 (* ------------------------------------------------------------------------ *)\r
  31         \r
  32         UNIT pile_vide : FUNCTION : BOOLEAN;\r
  33         (* Cette fonction bool\82en confirme si une pile est vide ou non. \r
  34            Si le sommet est faux null alors RESULT prend la valeur vraie\r
  35            sinon faux. *)\r
  36         \r
  37         BEGIN\r
  38                 IF sommet = NONE \r
  39                 \r
  40                 THEN\r
  41                         RESULT := TRUE\r
  42                 \r
  43                 ELSE\r
  44                         RESULT := FALSE;\r
  45                 \r
  46                 FI;\r
  47         \r
  48         END pile_vide;\r
  49 \r
  50 (* ------------------------------------------------------------------------ *)\r
  51 \r
  52         UNIT empiler : PROCEDURE (x : INTEGER);\r
  53         (* Cette proc\82dure permet d'empiler un \82l\8ament au sommet d'une pile. *)\r
  54         \r
  55         BEGIN\r
  56                 sommet := NEW elem (x,sommet);\r
  57         \r
  58         END empiler;\r
  59 \r
  60 (* ------------------------------------------------------------------------ *)\r
  61 \r
  62         UNIT addition : FUNCTION (p2 : Entier_long) : Entier_long; \r
  63         (* Cette fonction permet d'effectuer l'addition, elle retourne une \r
  64         Entier_long. \r
  65         On effectue l'addition au fur et \85 mesure que l'on d\82pile. *)\r
  66         \r
  67         VAR retenu, so : INTEGER;\r
  68         \r
  69         BEGIN\r
  70                 retenu := 0;\r
  71                 RESULT := NEW Entier_long;\r
  72 \r
  73                 WHILE (NOT pile_vide) OR (NOT p2.pile_vide) \r
  74                 DO\r
  75 \r
  76                   IF pile_vide \r
  77                 \r
  78                   THEN\r
  79                     (* Si p1 est vide alors le calcul se fait avec la d\82pile \r
  80                     de p2 et la gestion de la retenu. *)\r
  81                     so := p2.depiler + retenu\r
  82                 \r
  83                   ELSE\r
  84                         \r
  85                         IF p2.pile_vide \r
  86                     (* Si p2 est vide alors le calcul se fait avec la d\82pile \r
  87                     de p1 et la gestion de la retenu. *)\r
  88                         \r
  89                         THEN\r
  90                           so := depiler + retenu\r
  91                         \r
  92                         ELSE\r
  93                           so := depiler + p2.depiler + retenu\r
  94                     (* Dans les autres cas, on d\82pile les deux piles et on g\82re\r
  95                        la retenu. *)\r
  96                         FI;\r
  97                 \r
  98                   FI;\r
  99 \r
 100                   IF so > 9 \r
 101                 \r
 102                   THEN\r
 103                     (* On fait en quelque sorte un modulo 10. On enl\8ave 10 pour em-\r
 104                     piler le chiffre qui en est d\82duit et la retenue vaut\r
 105                     alors 1. *) \r
 106                     retenu := 1;\r
 107                     so := so - 10\r
 108                 \r
 109                   ELSE\r
 110                     (* Ici le calcul donne un chiffre alors la retenu est nulle. *)\r
 111                     retenu := 0;\r
 112                 \r
 113                   FI;\r
 114 \r
 115                   CALL RESULT.empiler (so); \r
 116                 \r
 117                 OD;\r
 118                   (* Gestion de la retenu. *)\r
 119                 IF retenu =/= 0 \r
 120                 \r
 121                 THEN \r
 122                         \r
 123                   CALL RESULT.empiler (retenu)\r
 124                 \r
 125                 FI;\r
 126 \r
 127         END addition;\r
 128 \r
 129 (* ------------------------------------------------------------------------ *)\r
 130 \r
 131         UNIT soustraction : FUNCTION (p2 : Entier_long) : Entier_long;\r
 132         (* Cette fonction permet d'effectuer la soustraction, elle retourne une \r
 133         entier long. \r
 134           On effectue la soustraction au fur et \85 mesure que l'on d\82pile. \r
 135           A la fin de la fonction on va tester la valeur de la retenu, si elle \r
 136           est \82gale \85 1 cela signifie que le r\82sultat est n\82gatif. *)      \r
 137         \r
 138         VAR retenu, di : INTEGER;\r
 139 \r
 140         BEGIN\r
 141 \r
 142         retenu := 0; \r
 143         RESULT := NEW Entier_long;\r
 144 \r
 145         WHILE (not pile_vide) OR (not p2.pile_vide) \r
 146         \r
 147         DO\r
 148         \r
 149           IF pile_vide THEN\r
 150                     (* Si p1 est vide alors le calcul se fait avec la d\82pile \r
 151                     de p2 et la gestion de la retenu. *)\r
 152             \r
 153             di := - p2.depiler - retenu\r
 154         \r
 155           ELSE\r
 156                 \r
 157             IF p2.pile_vide THEN\r
 158                     (* Si p2 est vide alors le calcul se fait avec la d\82pile \r
 159                     de p1 et la gestion de la retenu. *)\r
 160                       \r
 161               di := depiler - retenu\r
 162                 \r
 163             ELSE\r
 164                     (* Dans les autres cas, on d\82pile les deux piles et on g\82re\r
 165                        la retenu. *)\r
 166                \r
 167               di := depiler - p2.depiler - retenu\r
 168                 \r
 169             FI;\r
 170         \r
 171           FI;\r
 172         \r
 173           IF di < 0 THEN\r
 174                     (* Pour \82viter d'avoir une valeur n\82gative on ajoute 10 \r
 175                     \85 di pour empiler un chiffre positif et la retenu prend \r
 176                     la valeur vaut alors 1. *) \r
 177                 \r
 178             retenu := 1;\r
 179             di := di + 10\r
 180           ELSE\r
 181                     (* Ici le calcul donne un chiffre positif alors la retenu est nulle. *)\r
 182                 \r
 183             retenu := 0;\r
 184         \r
 185           FI;\r
 186 \r
 187            CALL RESULT.empiler(di);\r
 188                 \r
 189         OD;\r
 190 \r
 191         \r
 192         IF retenu =/= 0        (* Cette deuxi\8ame partie ne concerne que la \r
 193                                   division. Quand les piles sont vides \r
 194                                   si la retenu est diff\82rente de 0 c'est que \r
 195                                   la valeur de p1 est < \85 celle de p2. *)\r
 196         THEN\r
 197 \r
 198           b1 := FALSE;\r
 199 \r
 200         FI;\r
 201 \r
 202         END soustraction;\r
 203 \r
 204 (* ------------------------------------------------------------------------ *)\r
 205  \r
 206      UNIT multiplication : FUNCTION (p2 : Entier_long ; n : INTEGER) : Entier_long;\r
 207        (* Cette fonction permet d'effectuer la multiplication elle retourne un\r
 208         entier long. n repr\82sente le nombre d'\82l\8aments qu'il y a dans la plus \r
 209         grande pile. On d\82coupe les piles jusqu'\85 obtenir un type \82l\8ament. *)\r
 210         \r
 211         VAR  val : INTEGER , x1, x2, x3, x4 : INTEGER , pp1, p11, pp2, pt, \r
 212                    p22, pp3, p33, pp4, p44, mul1, mul2, mul3, mul4, \r
 213                    som1, som2 : Entier_long; \r
 214         \r
 215         \r
 216         BEGIN\r
 217                 \r
 218                 pp1 := NEW Entier_long; p11 := NEW Entier_long; \r
 219                 pp2 := NEW Entier_long; pp3 := NEW Entier_long;\r
 220                 p33 := NEW Entier_long; pp4 := NEW Entier_long;\r
 221                 p44 := NEW Entier_long; pt  := NEW Entier_long;\r
 222                 \r
 223                 mul1 := NEW Entier_long; mul2 := NEW Entier_long; \r
 224                 mul3 := NEW Entier_long; mul4 := NEW Entier_long; \r
 225                 som1 := NEW Entier_long; som2 := NEW Entier_long; \r
 226                 \r
 227                 RESULT := NEW Entier_long;   \r
 228                 \r
 229                 n := n DIV 2;\r
 230                           \r
 231         CALL position (17,60);                \r
 232         WRITE ("Calcul en cours...");\r
 233                                                \r
 234         WHILE NOT pile_vide  \r
 235         DO                         (* Transfert de la pile p1 vers la pile pt.*) \r
 236            CALL pt.empiler (depiler);\r
 237         OD;                  \r
 238    \r
 239         (* Le transfert vers 2 piles permet de sauvegarder les informations \r
 240            vers dans une autre pile parce qu'une fois les \82l\8aments utilis\82s\r
 241            la pile qui les contenaient est vide. Et pour les utiliser une \r
 242            autre fois il faut les avoir sauvegarder dans une autre. *)\r
 243 \r
 244         CALL transferer_2_piles (pt,p11,pp1);\r
 245 \r
 246         CALL transferer_2_piles (transferer_pile (p2),p22,pp2);\r
 247 \r
 248         IF n <= 2 \r
 249         \r
 250         THEN \r
 251 \r
 252            x3 := pp1.depiler ;  x4 := pp2.depiler ; x1 := pp1.depiler ; \r
 253               x2 := pp2.depiler ;\r
 254      \r
 255            val := x1 * x2 * 100 + (x1 * x4 + x3 * x2) * 10 + (x3 * x4);\r
 256           \r
 257            RESULT := conversion (val,n1); (* Ici n1 ne sert \85 rien puisse que \r
 258                                              son but dans la fuction est de compter   \r
 259                                              aussi le nombre d'\82l\8aments qui se trou-\r
 260                                              ve dans la pile. dans laquelle est mise \r
 261                                              les chiffres qui sont convertis.*) \r
 262 \r
 263         ELSE\r
 264 \r
 265           pp3 := transferer_pile (apparition(pp1,n));\r
 266      \r
 267           p33 := transferer_pile (apparition(p11,n));\r
 268      \r
 269           pp4 := transferer_pile (apparition(pp2,n));\r
 270      \r
 271           p44 := transferer_pile (apparition(p22,n));\r
 272                                   \r
 273           (* mul1, mul2, mul3, mul4 : sont 4 traitements r\82cursives au il \r
 274              ajouter pour certain cas un certain nombre de 0. *)\r
 275 \r
 276           mul1 := transferer_pile (pp1.multiplication (pp2,n));\r
 277           CALL mul1.ajouter_zero (n);    \r
 278      \r
 279           mul2 := transferer_pile (p11.multiplication (pp4,n));\r
 280           CALL mul2.ajouter_zero (n DIV 2);          \r
 281      \r
 282           mul3 := transferer_pile (p22.multiplication (pp3,n));\r
 283           CALL mul3.ajouter_zero (n DIV 2); \r
 284      \r
 285           mul4 := transferer_pile (p33.multiplication (p44,n));\r
 286      \r
 287           (* Addition des 4 mul trouv\82s qui forment le r\82sultat. *)\r
 288 \r
 289           som1 := transferer_pile (mul1.addition (mul2));\r
 290      \r
 291           som2 := transferer_pile (mul3.addition (mul4));\r
 292      \r
 293           RESULT := som1.addition (som2);\r
 294 \r
 295      FI;\r
 296 \r
 297         END multiplication;\r
 298 \r
 299 (* ------------------------------------------------------------------------ *)\r
 300  \r
 301        UNIT carre : FUNCTION (n : INTEGER) : Entier_long;\r
 302        (* Cette fonction permet d'effectuer le carre d'une multiplication. *)\r
 303         \r
 304        VAR p3, p4, pt : Entier_long;\r
 305 \r
 306        BEGIN\r
 307                 RESULT := NEW Entier_long;\r
 308                 p3 := NEW Entier_long;\r
 309                 p4 := NEW Entier_long;\r
 310                 pt := NEW Entier_long;\r
 311                                                \r
 312         WHILE NOT pile_vide  \r
 313         DO                         (* Transfert de la pile p1 vers la pile pt.*) \r
 314            CALL pt.empiler (depiler);\r
 315         OD;                  \r
 316        \r
 317        CALL transferer_2_piles (pt,p3,p4);\r
 318        RESULT := p4.multiplication (p3,n*2);\r
 319    \r
 320        CALL effacer_partie (1,19,16,58);\r
 321        \r
 322        END carre;\r
 323       \r
 324 (* ------------------------------------------------------------------------ *)\r
 325  \r
 326        UNIT division : FUNCTION (p2 : Entier_Long) : Entier_long;\r
 327        (* Cette fonction permet d'effectuer la division (enti\8are) avec un \r
 328           Entier_long. Elle retourne Entier_long. \r
 329           Un division est une soustraction du dividande avec le diviseur. *)\r
 330 \r
 331        VAR p3, p5, p6, pt : Entier_long;\r
 332        \r
 333        BEGIN\r
 334            \r
 335        b1 := TRUE;\r
 336        \r
 337        RESULT := NEW Entier_long;\r
 338        p3 := NEW Entier_long;\r
 339        p5 := NEW Entier_long;\r
 340        p6 := NEW Entier_long; \r
 341        pt := NEW Entier_long;\r
 342                                                \r
 343         WHILE NOT pile_vide  \r
 344         DO                         (* Transfert de la pile p1 vers la pile pt.*) \r
 345            CALL pt.empiler (depiler);\r
 346         OD;                  \r
 347         \r
 348        CALL RESULT.empiler(0);  (* R\82sult est initialis\82 \85 0. *)\r
 349        \r
 350        pt := transferer_pile (pt);\r
 351 \r
 352        WHILE b1  (* Correspond au bool\82en donn\82e par la soustraction. *)       \r
 353        \r
 354        DO\r
 355                           \r
 356          CALL position (17,60);                \r
 357          WRITE ("Calcul en cours...");\r
 358 \r
 359          CALL transferer_2_piles (p2,p5,p6); \r
 360          pt := transferer_pile (pt.soustraction(transferer_pile (p5)));\r
 361          p2 := transferer_pile (p6);  (* pour ne pas perdre l'information \r
 362                                          de base de p2 alors p6 redevient p2\r
 363                                          qui \85 son tour redevient p6.*)\r
 364          \r
 365          IF b1             (* Quand on sort de la fonction traiter_soustrac-\r
 366                               tion retenu n'est pas forc\82ment \82gale \85 0. *)\r
 367          THEN\r
 368 \r
 369            CALL p3.empiler (1);  (* A chaque soustraction on incr\82mente RESULT \r
 370                                     de 1. Ce 1 est alors empiler dans p3. *)\r
 371            \r
 372            RESULT := transferer_pile (RESULT.addition (p3));\r
 373          \r
 374          FI;\r
 375        \r
 376        OD;\r
 377            \r
 378            RESULT := transferer_pile (RESULT);\r
 379           \r
 380            CALL effacer_partie (1,19,16,58);\r
 381 \r
 382        END division;\r
 383 \r
 384 (* ------------------------------------------------------------------------ *)\r
 385 \r
 386        UNIT modulo : FUNCTION (p2 : Entier_long) : Entier_long;\r
 387        (* Cette fonction permet de calculer le reste d'une division avec un \r
 388        entier long. Elle retourne un Entier_long. Quand le r\82sultat de la sous-\r
 389        traction est vide est < \85 0 il faut avoir garder quelque part la valeur\r
 390        du pr\82c\82dent dividande. En fait tant que le reste est positif, on r\82ini\r
 391        tialise la RESULT. *)\r
 392 \r
 393        VAR p5, p6, pt : Entier_long; \r
 394        \r
 395        BEGIN\r
 396                      \r
 397        b1 := TRUE;\r
 398        p5 := NEW Entier_long;\r
 399        p6 := NEW Entier_long; \r
 400        pt := NEW Entier_long;\r
 401                                                \r
 402         WHILE NOT pile_vide  \r
 403         DO                         (* Transfert de la pile p1 vers la pile pt.*) \r
 404            CALL pt.empiler (depiler);\r
 405         OD;                  \r
 406         \r
 407        WHILE b1\r
 408        \r
 409        DO\r
 410                           \r
 411          CALL position (17,60);                \r
 412          WRITE ("Calcul en cours...");\r
 413          \r
 414          CALL transferer_2_piles (p2,p5,p6); (* p2 et p6 font faire former un \r
 415                                                cycle pourque l'information ne \r
 416                                                soit pas perdu. *)\r
 417          \r
 418          RESULT := NEW Entier_long;\r
 419 \r
 420           (* pt et RESULT contient le dernier reste de la division. Si b1 est faux\r
 421              ce qui signifie que la valeur que contient la pile pt est inf\82rieur \r
 422              \85 celle qui est incluse dans p5.\r
 423              Tant que la soustraction est positive (b1 est vrai) alors RESULT est \r
 424              reinitialis\82e. *)\r
 425 \r
 426          CALL transferer_2_piles (pt,pt,RESULT);\r
 427          \r
 428          RESULT := transferer_pile (RESULT);\r
 429 \r
 430          pt := transferer_pile(transferer_pile (pt.soustraction(transferer_pile (p5))));\r
 431          \r
 432          p2 := transferer_pile (p6);\r
 433          \r
 434        OD;\r
 435            \r
 436            CALL effacer_partie (1,19,16,58);          \r
 437        \r
 438        END modulo;\r
 439 \r
 440 (* ------------------------------------------------------------------------ *)\r
 441 \r
 442        UNIT pgcd : FUNCTION (p2 : Entier_Long) : Entier_long;\r
 443        (* Cette fonction permet de calculer le pgcd entre deux entiers longs. \r
 444           Elle retourne un Entier_long.\r
 445           Tq r =/=0 fr \r
 446           r <-- a MOD b ; a <-- b ; b <-- r\r
 447           Ftq\r
 448           Ici r repr\82sente p2 et b2 qui lui va prendre FAUX lors du transfert\r
 449           de p2 vers p2 si dans cette derni\8are pile il y la valeur 0. *)\r
 450 \r
 451        VAR p5, pt : Entier_long;\r
 452        \r
 453        BEGIN\r
 454            \r
 455        b2 := TRUE;\r
 456        p5 := NEW Entier_long;\r
 457        pt := NEW Entier_long;\r
 458                                                \r
 459         WHILE NOT pile_vide  \r
 460         DO                         (* Transfert de la pile p1 vers la pile pt.*) \r
 461            CALL pt.empiler (depiler);\r
 462         OD;                  \r
 463         \r
 464          pt := transferer_pile (pt); \r
 465 \r
 466      WHILE b2         \r
 467        \r
 468        DO\r
 469                         \r
 470          CALL transferer_2_piles (p2,p2,p5);\r
 471          \r
 472          p2 := (pt.modulo (transferer_pile (p2)));\r
 473           \r
 474          RESULT := NEW Entier_long;\r
 475 \r
 476          RESULT := transferer_pile (transferer_pile (p5));\r
 477          \r
 478          p2 := transferer_pile (p2);\r
 479 \r
 480          IF b2\r
 481          \r
 482          THEN\r
 483            \r
 484            pt := transferer_pile (RESULT);\r
 485          FI;\r
 486         \r
 487        OD;\r
 488            \r
 489        END pgcd;\r
 490 \r
 491 (* ------------------------------------------------------------------------ *)\r
 492  \r
 493        UNIT ppcm : FUNCTION (p2 : Entier_Long) : Entier_long;\r
 494        (* Cette fonction permet de calculer le ppcm entre deux entiers longs. \r
 495           Elle retourne un Entier_long. ppcm (a,b) = (a * b) / pgcd (a,b). *)\r
 496 \r
 497        VAR p3, p4, pt, pp : Entier_long;\r
 498        \r
 499        BEGIN\r
 500            \r
 501        p3 := NEW Entier_long;\r
 502        p4 := NEW Entier_long;\r
 503        pp := NEW Entier_long;\r
 504        pt := NEW Entier_long;\r
 505                                                \r
 506         WHILE NOT pile_vide  \r
 507         DO                         (* Transfert de la pile p1 vers la pile pt.*) \r
 508            CALL pt.empiler (depiler);\r
 509         OD;                  \r
 510         \r
 511 \r
 512        CALL transferer_2_piles (transferer_pile (p2),p2,p4);\r
 513        \r
 514        CALL transferer_2_piles (pt,pt,p3);\r
 515          \r
 516        (* pp prend la valeur de la multiplication de p2 et de pt. *)\r
 517        pp := transferer_pile (pt.multiplication (p2,partition (grand(n1,n2,n3)))); \r
 518        \r
 519        RESULT := pp.division (transferer_pile (p3.pgcd (p4))); \r
 520        \r
 521        END ppcm;\r
 522 \r
 523 (* ------------------------------------------------------------------------ *)\r
 524 \r
 525         UNIT conversion : FUNCTION (nbre : INTEGER ; \r
 526                                            OUTPUT n : INTEGER) : Entier_long ;\r
 527         (* Cette fonction d\82compose un entier en tout chiffre qui la compose.\r
 528            Elle retourne un type Entier_long et comme param\88tre le nombre de\r
 529            chiffres qui compose cette description ainsi ce dernier param\88tre \r
 530            donne une id\82e de la taille de la premi\8are pile. Pareil que la \r
 531            fonction saisie, on va \82viter d'empiler des 0 en d\82but de nombre\r
 532            inutile. *)\r
 533         \r
 534         VAR x : INTEGER, trouve : BOOLEAN;\r
 535 \r
 536         BEGIN\r
 537         \r
 538         RESULT := NEW Entier_long; \r
 539         trouve := FALSE;        \r
 540         \r
 541         n := 0;\r
 542         \r
 543         DO\r
 544               \r
 545               x := nbre MOD 10;\r
 546               IF (x =/= 0)\r
 547               \r
 548               THEN\r
 549                  \r
 550                  CALL RESULT.empiler (x);\r
 551                  trouve := TRUE;\r
 552                  nbre := nbre DIV 10;\r
 553                  n := n + 1\r
 554               ELSE\r
 555                     \r
 556                     IF trouve\r
 557 \r
 558                     THEN\r
 559                  \r
 560                       CALL RESULT.empiler (x);\r
 561                       nbre := nbre DIV 10;\r
 562                       n := n + 1;\r
 563                     FI;\r
 564 \r
 565                 FI;\r
 566               \r
 567               IF (nbre = 0) \r
 568               \r
 569               THEN \r
 570                 \r
 571                 EXIT;\r
 572               \r
 573               FI;\r
 574 \r
 575         OD;\r
 576         \r
 577         END conversion;\r
 578 \r
 579 (* ------------------------------------------------------------------------ *)\r
 580 \r
 581         UNIT transferer_pile : FUNCTION (p2 : Entier_long) : Entier_long;\r
 582         (* Cette  fonction permet de d\82piler une pile pour empiler dans une \r
 583           autre.*)\r
 584         \r
 585         VAR i : INTEGER;\r
 586 \r
 587         BEGIN\r
 588          \r
 589          b2 := FALSE;      (* b2 va tester si la valeur du\8a reste est \82gale \85 \r
 590                               z\82ro (ce qui est valable seulement pour \r
 591                                                  le PGCD) *)\r
 592 \r
 593          RESULT := NEW Entier_long;\r
 594 \r
 595                 WHILE NOT p2.pile_vide \r
 596                 DO\r
 597                    i := p2.depiler;     \r
 598 \r
 599                    IF i =/= 0\r
 600 \r
 601                    THEN\r
 602 \r
 603                      b2 := TRUE;\r
 604                    FI;\r
 605                    \r
 606                   CALL RESULT.empiler (i);\r
 607                 \r
 608                 OD;\r
 609 \r
 610         END transferer_pile;\r
 611 \r
 612 (* ------------------------------------------------------------------------ *)\r
 613 \r
 614         UNIT transferer_2_piles : PROCEDURE (p2 : Entier_long ; \r
 615                                                 OUTPUT p3,p4 : Entier_long);\r
 616         (* Cette proc\82dure permet de d\82piler une pile pour empiler dans deux \r
 617           autres. *)\r
 618 \r
 619         VAR x : INTEGER;\r
 620 \r
 621         BEGIN\r
 622                 \r
 623                 p3 := NEW Entier_long;     \r
 624                 p4 := NEW Entier_long;     \r
 625                 \r
 626                 WHILE NOT p2.pile_vide  \r
 627                 DO\r
 628                         x := p2.depiler;\r
 629                         CALL p3.empiler (x);\r
 630                         CALL p4.empiler (x);\r
 631                 OD;\r
 632 \r
 633         END transferer_2_piles;\r
 634 \r
 635 (* ------------------------------------------------------------------------ *)\r
 636 \r
 637         UNIT apparition : FUNCTION (p2 : Entier_long ; n : INTEGER) : Entier_long;\r
 638         (* Cette  fonction permet de faire appara\8ctre une nouvelle pile en\r
 639         divisant celle qui existe en deux. n : repr\82sente le nombre de \r
 640         chiffres contenu dans la pile. Cette fonction n'est valable pour la \r
 641         multiplication. *)\r
 642 \r
 643         BEGIN\r
 644 \r
 645          RESULT := NEW Entier_long;\r
 646 \r
 647          n := n DIV 2;\r
 648                 \r
 649                 WHILE n =/= 0 DO\r
 650                         CALL RESULT.empiler (p2.depiler);\r
 651                         n := n - 1;\r
 652                 OD;\r
 653 \r
 654         END apparition;\r
 655          \r
 656 (* ------------------------------------------------------------------------ *)\r
 657 \r
 658         UNIT max_de_2_piles : PROCEDURE (v1,v2 : INTEGER ; \r
 659                                INOUT p2 : Entier_long ; OUTPUT max : INTEGER);\r
 660         (* Cette proc\82dure d\82termine quel nombre des piles est plus grand.\r
 661         Puisse qu'au d\82part il y a s\82lection dans la saisie (les z\82ros qui pr\82c\8a-\r
 662         dent un chiffre autre qu'un z\82ro) ; on fait la comparaison avec v1, v2 (le \r
 663         nombre de chiffres compris dans la pile).\r
 664         Si v1 et v2 sont \82gaux (exemple 121 et 331) les valeurs sont ici 3 ; alors \r
 665         on compare deux \85 deux les chiffres pour d\82terminer la pile qui contient\r
 666         le nombre le plus grande.\r
 667         max resort 1 pour la pile1 et 2 pour la pile2.*)        \r
 668         \r
 669         VAR x1, x2 : INTEGER, b : BOOLEAN, p3,p4,p5,p6 : Entier_long;\r
 670 \r
 671         BEGIN\r
 672                 \r
 673         p3 := NEW Entier_long; p4 := NEW Entier_long;\r
 674         p5 := NEW Entier_long; p6 := NEW Entier_long;\r
 675 \r
 676         max := 0; b := TRUE;\r
 677                              (* 1ø partie : Comparaison des valeurs v1 et v2. *)\r
 678         IF v1 > v2 \r
 679         THEN\r
 680           max := 1\r
 681         ELSE\r
 682           \r
 683           IF v1 < v2 \r
 684           THEN\r
 685             max := 2\r
 686           ELSE                           (* Si dans les deux piles le nombre\r
 687                                             de chiffres est \82gale, on compare\r
 688                                             les chiffres entre eux pour con-\r
 689                                             na\8ctre enfin la plus grande. *)\r
 690 \r
 691                CALL transferer_2_piles (p1,p3,p5);\r
 692                CALL transferer_2_piles (p2,p4,p6);\r
 693                                          (* Au cours de la comparaison d\8as que \r
 694                                             l'on a trouv\82 une diff\82rence entre\r
 695                                             les deux piles, on arr\88te la recher-\r
 696                                             che. *)\r
 697 \r
 698                WHILE NOT (p3.pile_vide)  AND b\r
 699                DO\r
 700                 \r
 701                 x1 := p3.depiler;\r
 702                 x2 := p4.depiler;\r
 703 \r
 704                 IF (x1 > x2)\r
 705                 THEN\r
 706                  \r
 707                   max := 1;\r
 708                   b := FALSE\r
 709                 ELSE\r
 710                  \r
 711                   IF (x1 < x2)       \r
 712                   THEN\r
 713                   \r
 714                     max := 2;\r
 715                     b := FALSE;\r
 716                   FI;\r
 717                 \r
 718                 FI;\r
 719                \r
 720                OD;\r
 721               \r
 722               p1 := transferer_pile (p5);\r
 723               p2 := transferer_pile (p6);\r
 724           \r
 725           FI;\r
 726         \r
 727         FI;\r
 728 \r
 729         END max_de_2_piles;\r
 730          \r
 731 (* ------------------------------------------------------------------------ *)\r
 732 \r
 733         UNIT ajouter_zero : PROCEDURE (n : INTEGER);\r
 734         (* Cette  fonction permet d'ajouter des z\82ros \85 la suite d'une pile \r
 735          n : repr\82sente le nombre de 0 qui vont \88tre empiler. Cette proc\82dure \r
 736          est valable seulement pour la multiplication. *)\r
 737 \r
 738         VAR emp : INTEGER;\r
 739 \r
 740         BEGIN\r
 741                 \r
 742                 FOR emp := 1 to n \r
 743                 \r
 744                 DO\r
 745                     \r
 746                     CALL empiler (0);\r
 747                 OD;                    \r
 748         \r
 749         END ajouter_zero;\r
 750          \r
 751 (* ------------------------------------------------------------------------ *)\r
 752 \r
 753         UNIT saisir : FUNCTION (i, j : INTEGER ; OUTPUT n : INTEGER) : Entier_long;\r
 754         (* Cette fonction permet de saisir les chiffres pour les empiler. \r
 755            Par cette m\82thode de saisie, les z\82ros qui sont en d\82but de nom-\r
 756            bre ne sont pas saisies (ce qui permet d'avoir une id\82e rapide \r
 757            de la plus grande pile. \r
 758            i et j : deux variables qui repr\82sentent la position du curseur \85 l'\82cran.\r
 759            n : resort le nbre de chiffre empil\82s.*)\r
 760                 \r
 761         VAR nnbre : CHAR, nbre : INTEGER, trouve : BOOLEAN;\r
 762         \r
 763         BEGIN\r
 764         \r
 765         RESULT := NEW Entier_long;\r
 766 \r
 767         trouve := FALSE;\r
 768         n := 0;\r
 769       \r
 770         DO\r
 771           \r
 772           CALL position (i,j);     \r
 773           IF j = 80 \r
 774           \r
 775           THEN          (* Passage \85 la ligne pour des entiers tr\8as longs.*)\r
 776             \r
 777             i := i + 1;\r
 778             j := 1;\r
 779           FI;\r
 780 \r
 781           nnbre := chr (inchar);\r
 782           \r
 783           IF (ord (nnbre) < 48) OR (ord (nnbre) > 57) \r
 784           THEN\r
 785               EXIT;\r
 786           FI;\r
 787         \r
 788           nbre := entier (nnbre);\r
 789           \r
 790           CALL position (i,j);\r
 791           \r
 792           WRITELN (nnbre);\r
 793         \r
 794           IF (nbre =/= 0)  \r
 795           \r
 796           THEN \r
 797           \r
 798             CALL RESULT.empiler (nbre);\r
 799             trouve := TRUE;              (* On fait un barage aux premiers\r
 800                                             z\82ros saisie. *)\r
 801             n := n + 1\r
 802           ELSE\r
 803             \r
 804             IF trouve \r
 805                                         (* Une fois un nbre diff\82rent de 0 est  \r
 806                                            saisie 0 peut \88tre bien-s\96r saisie \r
 807                                            autant de fois que possible. *)\r
 808             THEN\r
 809                 \r
 810               CALL RESULT.empiler (nbre);\r
 811               n := n + 1;\r
 812             \r
 813             FI;\r
 814           \r
 815           FI;\r
 816                         \r
 817         j := j + 1;                    (* Mise \85 jour de la colonne de l'\82cran. *)\r
 818 \r
 819         OD;\r
 820 \r
 821         END saisir;\r
 822 \r
 823 (* ------------------------------------------------------------------------ *)\r
 824         \r
 825         UNIT afficher_resultat : PROCEDURE ;\r
 826         (* Cette proc\82dure permet d'afficher le r\82sultat du calcul effectu\82. \r
 827          Tant que la pile n'est pas vide, on d\82pile. On \82vite d'afficher les \r
 828          premiers 0 (Ce qui tr\8as important pour une soustraction). *)         \r
 829 \r
 830         VAR b : BOOLEAN , i : INTEGER ;\r
 831 \r
 832         BEGIN\r
 833                 b := FALSE;\r
 834                 i := depiler;\r
 835 \r
 836                 WHILE NOT pile_vide DO\r
 837                         \r
 838                         IF (i =/= 0) or (b) THEN\r
 839                                 b := TRUE;       (* Une fois que le premier\r
 840                                                     nombre est affich\82 et qu'il \r
 841                                                     est diff\82rent de 0, on peut afficher \r
 842                                                     autant de fois de 0. *)\r
 843                                 WRITE (i);\r
 844                         FI;        \r
 845                         \r
 846                         i := depiler; \r
 847                 OD;\r
 848 \r
 849                         WRITE (i);\r
 850 \r
 851 \r
 852         END afficher_resultat;\r
 853 \r
 854 \r
 855 \r
 856  END Entier_long;\r
 857 \r
 858 (* ------------------------------------------------------------------------ *)\r
 859  \r
 860         UNIT Inchar : IIUWgraph FUNCTION : INTEGER;\r
 861         (* Cette function permet de saisir une suite de caract\8ares sans avoir \r
 862            \85 valider chaque fois. *)\r
 863         \r
 864         VAR i:integer;\r
 865    \r
 866         BEGIN\r
 867         \r
 868         DO\r
 869         \r
 870         i := INKEY;\r
 871         IF (i<>0) \r
 872         \r
 873         THEN \r
 874                 EXIT;\r
 875         FI;\r
 876         \r
 877         OD;\r
 878         \r
 879         RESULT := i;\r
 880  \r
 881         END Inchar;\r
 882 \r
 883 (* ------------------------------------------------------------------------ *)\r
 884         \r
 885         UNIT entier : FUNCTION (c : CHAR) : INTEGER;\r
 886         (* Cette proc\82dure convertie un caract\8are en entier parce que la \r
 887         fonction inchar lit un entier qu'elle traduit en caract\8are. *)\r
 888 \r
 889         BEGIN\r
 890                 CASE c\r
 891                          \r
 892                          WHEN '0' : RESULT := 0;\r
 893                          \r
 894                          WHEN '1' : RESULT := 1;\r
 895                          \r
 896                          WHEN '2' : RESULT := 2;\r
 897                          \r
 898                          WHEN '3' : RESULT := 3;\r
 899                          \r
 900                          WHEN '4' : RESULT := 4;\r
 901                          \r
 902                          WHEN '5' : RESULT := 5;\r
 903 \r
 904                          WHEN '6' : RESULT := 6;\r
 905                          \r
 906                          WHEN '7' : RESULT := 7;\r
 907 \r
 908                          WHEN '8' : RESULT := 8;\r
 909 \r
 910                          WHEN '9' : RESULT := 9;\r
 911 \r
 912                 ESAC;\r
 913 \r
 914         END entier;\r
 915 \r
 916 (* ------------------------------------------------------------------------ *)\r
 917 \r
 918         UNIT partition : FUNCTION (n : INTEGER):INTEGER;\r
 919         (* Cette fonction renvoit la valeur pour laquelle il faut partitionner \r
 920          les deux piles. La plus grande de leur deux valeurs (multilplier par 2\r
 921          par la fonction grand) doit \88tre un multiple de deux. (ce qui est \r
 922          seulement utile pour la multiplication).*)\r
 923  \r
 924         VAR n1 : INTEGER;\r
 925 \r
 926         BEGIN\r
 927  \r
 928         n1 := 2;\r
 929 \r
 930         WHILE n1 < n \r
 931                                (* La partition de la multiplication se fait\r
 932                                   pour des valeurs qui correspondent \85 une  \r
 933                                   suite g\82om\82trique de premier terme 2 et de \r
 934                                   raison 2. *)\r
 935         DO\r
 936         n1 := n1 * 2;\r
 937  \r
 938         OD;\r
 939         \r
 940         RESULT := n1;\r
 941 \r
 942         END partition;\r
 943 \r
 944 (* ------------------------------------------------------------------------ *)\r
 945 \r
 946         UNIT grand : FUNCTION (d1, d2, d3 : INTEGER) : INTEGER;\r
 947         (* Cette fonction renvoit le nbre d'\82l\8ament qui a dans la plus grande \r
 948         pile. Le param\88tre d3 accepte le max des deux piles. \r
 949         on rappelle que s'il vaut 2 alors il s'agit de la deuxi\8ame pile qui a \r
 950         la grande valeur sinon la premi\8are et cette valeur est multiplier par 2\r
 951         pour mieux partionner la pile. *)\r
 952  \r
 953         BEGIN\r
 954  \r
 955         IF (d3 = 2)\r
 956         THEN\r
 957    \r
 958         d2 := d2 * 2;\r
 959         RESULT := d2\r
 960         ELSE\r
 961         \r
 962         d1 := d1 * 2;\r
 963    \r
 964         RESULT := d1;\r
 965 \r
 966         FI;\r
 967 \r
 968         END grand;\r
 969 \r
 970 (* ------------------------------------------------------------------------ *)\r
 971 \r
 972         UNIT position : PROCEDURE (lig, col : INTEGER);\r
 973         (* Cette proc\82dure permet de positionner sur l'\82cran qui devient une \r
 974         matrice. Les param\88tres lig et col correspondent respectivement \85 l'\r
 975         abcisse x (ligne) et \85 l'abcisse y (colonne). *)        \r
 976 \r
 977         VAR c, d, e, f : CHAR, i, j : INTEGER;\r
 978 \r
 979         BEGIN\r
 980 \r
 981         i := lig DIV 10; j := lig mod 10; c := chr (48+i);\r
 982         d := chr (48+j); i := col div 10; j := col mod 10;\r
 983         e := chr (48+i); f := chr (48+j); \r
 984         WRITE (chr (27), "[", c, d, ";", e, f, "H");\r
 985                 \r
 986         END position;\r
 987 \r
 988 (* ------------------------------------------------------------------------ *)\r
 989 \r
 990         UNIT tracer_ligne : PROCEDURE (lig1,col1,col : INTEGER);\r
 991         (* Cette proc\82dure permet de tracer les lignes du cadre. x, y repr\82-\r
 992            tentent les param\88tres de POSITION c'est \85 dire position ligne, colon\r
 993            ne, et col est la limite de la ligne. *)\r
 994 \r
 995         VAR i : INTEGER;                          \r
 996         \r
 997         BEGIN\r
 998 \r
 999           CALL POSITION (col1,lig1);                \r
1000 \r
1001           FOR i := 1 to col \r
1002           DO \r
1003             WRITE ('Ä');\r
1004           OD;\r
1005 \r
1006         END tracer_ligne;\r
1007 \r
1008 (*------------------------------------------------------------------------- *)\r
1009 \r
1010         UNIT tracer_colonne : PROCEDURE (lig,lig1, col : INTEGER);\r
1011         (* Cette proc\82dure permet de tracer les colonnes du cadre. \r
1012           lig repr\82sente : lig2 - lig1, et col : la colonne courante ou l'or-\r
1013           donn\82e de POSITON. *)\r
1014 \r
1015         VAR i : INTEGER;                          \r
1016 \r
1017         BEGIN\r
1018 \r
1019              FOR i := 1 to lig\r
1020               \r
1021               DO\r
1022                 \r
1023                 CALL POSITION (lig1+i,col);\r
1024 \r
1025                  WRITE ("³");\r
1026 \r
1027              OD;    \r
1028         \r
1029         END tracer_colonne;\r
1030 \r
1031 (* ------------------------------------------------------------------------ *)\r
1032 \r
1033         UNIT cadrer : PROCEDURE (lig1, lig2, col1,col2 : INTEGER);\r
1034         (* Cette proc\82dure dessine un cadre valable pour un \82cran. D'abord \r
1035          dessins : des lignes, ensuite des colonnes enfin des coins. Les para-\r
1036          m\88tres sont respectivement ligne du haut et du bas et colonne de droi-\r
1037          te et de gauche. *)\r
1038 \r
1039         BEGIN\r
1040 \r
1041           CALL tracer_ligne (col1,lig1,col2-col1);\r
1042           CALL tracer_ligne (col1,lig2,col2-col1);\r
1043           \r
1044           CALL tracer_colonne (lig2-lig1,lig1,col1);    \r
1045           CALL tracer_colonne (lig2-lig1,lig1,col2);\r
1046 \r
1047           CALL POSITION (lig1,col1);\r
1048           WRITE ("Ú");  \r
1049 \r
1050           CALL POSITION (lig2,col1);\r
1051           WRITE ("À");\r
1052 \r
1053           CALL POSITION (lig1,col2);\r
1054           WRITE ("¿");\r
1055 \r
1056           CALL POSITION (lig2,col2);\r
1057           WRITE ("Ù");\r
1058 \r
1059         END cadrer;\r
1060 \r
1061 (* ------------------------------------------------------------------------ *)\r
1062 \r
1063         UNIT effacer_partie : PROCEDURE (lig, col, lig1, col1 : INTEGER);\r
1064         (* Cette proc\82dure permet d'effacer une partie de l'\82cran (o\97 on \r
1065            \82crit un caract\8are blanc) les param\88tres lig, col, lig1, col1\r
1066            l'intervale de ligne, colonne et la position de la ligne1 et \r
1067            de la colonne1. *)\r
1068 \r
1069         VAR k,w : INTEGER;\r
1070         \r
1071         BEGIN   \r
1072                   FOR k := 1 to col \r
1073                 DO\r
1074                         FOR w := 1 to lig\r
1075                         DO\r
1076                                 \r
1077                                 CALL POSITION (lig1+w,col1+k);\r
1078                                 WRITE (" ");\r
1079                         OD;\r
1080                \r
1081                OD;  \r
1082 \r
1083         END effacer_partie;\r
1084 \r
1085 (* ------------------------------------------------------------------------ *)\r
1086 \r
1087         UNIT prompt : PROCEDURE (i,j : INTEGER);\r
1088         (* Cette proc\82dure affiche le programme principal. *)\r
1089         VAR choix : CHAR ; \r
1090         \r
1091         BEGIN\r
1092         \r
1093         DO\r
1094           \r
1095           WRITELN; (* Cette commande permet de vider le buffer *)\r
1096           \r
1097           IF ecr    (* Cette condition va permettre \85 cette fen\88tre de pas\r
1098                        ser du plein \82cran au petit menu du haut de l'\82cran. *)\r
1099           \r
1100           THEN\r
1101 \r
1102             CALL cadrer (8,16,2,80);\r
1103             ecr := FALSE\r
1104           ELSE\r
1105             i := 3 ; j := 6;\r
1106             CALL cadrer (2,4,2,80);\r
1107           FI;\r
1108 \r
1109           CALL position (i,j);\r
1110           \r
1111           WRITE ("1  :  Aide   -   2  :  Calcul   -   3  :  Quitter   ->   Le choix  :  ");\r
1112           \r
1113           WRITELN; (* Cette commande permet de vider le buffer *)\r
1114 \r
1115           choix := chr(inchar);\r
1116                          \r
1117           CALL position (3,77);\r
1118           WRITELN (choix);               \r
1119 \r
1120           WRITE (chr(27), "[2J");\r
1121           \r
1122           CASE choix\r
1123             \r
1124             WHEN '1' : CALL aide;\r
1125             \r
1126             WHEN '2' : CALL effacer_partie (3,80,1,1);   \r
1127                        CALL presentation;\r
1128                      \r
1129                        CALL cadrer (3,7,8,74);   \r
1130                        CALL fenetre_operation (4,14);\r
1131             \r
1132             WHEN '3' : EXIT;\r
1133 \r
1134           ESAC\r
1135         \r
1136         OD;\r
1137         \r
1138         END prompt;\r
1139 \r
1140 (* ------------------------------------------------------------------------ *)\r
1141 \r
1142         UNIT fenetre_operation : PROCEDURE (i,j : INTEGER);\r
1143         (* Cette proc\82dure affiche la liste des op\82rations possibles \85 \r
1144            r\82aliser et g\82re les signes des op\82rations saisies.\r
1145            Cf la documentation pour comprendre la gestion des signes. *)\r
1146         \r
1147         VAR choix : CHAR; \r
1148         \r
1149         BEGIN\r
1150           \r
1151           WRITELN; (* Cette commande permet de vider le buffer *)\r
1152         \r
1153           CALL position (i,j);\r
1154 \r
1155           WRITE ("1 :  +   ;  2 :   -   ;  3 :  *  ;  4 : ^2   ;   5 : DIV");\r
1156         \r
1157           CALL position (i+2,j);\r
1158         \r
1159           WRITE ("6 : MOD  ;  7 : PGCD  ;  8 : PPCM   ->    Le choix : ");\r
1160           \r
1161           WRITELN; (* Cette commande permet de vider le buffer *)\r
1162         \r
1163           choix := chr(inchar);\r
1164 \r
1165           CALL position (i+2,j+54);\r
1166           WRITELN (choix);\r
1167 \r
1168           CALL effacer_partie (5,78,2,1);  \r
1169 \r
1170           CALL position (i+4,50);\r
1171 (* Dans tous les cas signe1 et signe2 sont les valeurs des signes des piles \r
1172 1 et 2. *)      \r
1173           CASE choix\r
1174         \r
1175                 WHEN '1' : WRITE ("La s\82lection est : ");\r
1176                            WRITE ("+");\r
1177                           \r
1178                            CALL cadrer (10,14,22,50);\r
1179                            CALL fenetre_saisie (11,25);\r
1180                           \r
1181                            CALL cadrer (15,19,22,50);\r
1182                            CALL fenetre_saisie (16,25);\r
1183                           \r
1184                            CALL p1.max_de_2_piles (n1,n2,p2,n3);\r
1185                                \r
1186                            CASE signe1 \r
1187                           \r
1188                                 WHEN '-' : IF signe2 = '-' \r
1189                                            \r
1190                                            THEN\r
1191                                              \r
1192                                              p3 := p1.addition (p2);\r
1193                                              CALL position (19,15);\r
1194                                              WRITE ("-")\r
1195                                            ELSE\r
1196                                              \r
1197                                              IF (n3 = 1) (* cas o\97 la 1ø pile est \r
1198                                                            > \85 la 2ø pile.*)\r
1199                                              THEN         \r
1200                                                \r
1201                                                p3 := p1.soustraction (p2);\r
1202                                                CALL position (19,15);\r
1203                                                WRITE ("-")\r
1204                                              \r
1205                                              ELSE  (* cas o\97 la 1ø pile est <=\r
1206                                                       \85 la 2ø pile.*)\r
1207                                                p3 := p2.soustraction (p1);\r
1208                                              FI;\r
1209 \r
1210                                            FI;\r
1211 \r
1212                                 OTHERWISE  IF signe2 =/= '-'\r
1213                                              \r
1214                                            THEN   \r
1215                                                p3 := p1.addition (p2);\r
1216                                              \r
1217                                            ELSE\r
1218 \r
1219                                              IF (n3 = 1) (* cas o\97 la 1ø pile est \r
1220                                                            > \85 la 2ø pile.*)\r
1221                                              THEN         \r
1222                                                \r
1223                                                p3 := p1.soustraction (p2);\r
1224                                               \r
1225                                              ELSE  (* cas o\97 la 1ø pile est <=\r
1226                                                       \85 la 2ø pile.*)\r
1227                                                p3 := p2.soustraction (p1);\r
1228                                                \r
1229                                                IF (n3 =/= 0) \r
1230                                                \r
1231                                                THEN\r
1232                                                  \r
1233                                                  CALL position (19,15);\r
1234                                                  WRITE ("-")\r
1235                                                FI;\r
1236 \r
1237                                              FI;\r
1238 \r
1239                                            FI;\r
1240                           ESAC;\r
1241                                                     \r
1242                 WHEN '2': WRITE ("La s\82lection est : ");\r
1243                           WRITE ("-");\r
1244                           \r
1245                           CALL cadrer (10,14,22,50);\r
1246                           CALL fenetre_saisie (11,25);\r
1247 \r
1248                           CALL cadrer (15,19,22,50);\r
1249                           CALL fenetre_saisie (16,25);\r
1250                           \r
1251                           CALL p1.max_de_2_piles (n1,n2,p2,n3);\r
1252                                \r
1253                           CASE signe1 \r
1254                           \r
1255                                 WHEN '-' : IF signe2 =/= '-' \r
1256                                            \r
1257                                            THEN\r
1258                                              \r
1259                                              p3 := p1.addition (p2);\r
1260                                              CALL position (19,15);\r
1261                                              WRITE ("-")\r
1262                                            ELSE\r
1263                                              \r
1264                                              IF (n3 = 1) (* cas o\97 la 1ø pile est \r
1265                                                            > \85 la 2ø pile. *)\r
1266                                              THEN         \r
1267                                                \r
1268                                                p3 := p1.soustraction (p2);\r
1269                                                CALL position (19,15);\r
1270                                                WRITE ("-")\r
1271                                              \r
1272                                              ELSE  (* cas o\97 la 1ø pile est <=\r
1273                                                       \85 la 2ø pile. *)\r
1274                                                p3 := p2.soustraction (p1);\r
1275 \r
1276                                              FI;\r
1277 \r
1278                                            FI;\r
1279 \r
1280                                 OTHERWISE  IF signe2 = '-'\r
1281                                              \r
1282                                            THEN   \r
1283                                                p3 := p1.addition (p2);\r
1284                                              \r
1285                                            ELSE\r
1286 \r
1287                                              IF (n3 = 2) (* cas o\97 la 1ø pile est \r
1288                                                            > \85 la 2ø pile.*)\r
1289                                              THEN         \r
1290                                                \r
1291                                                p3 := p2.soustraction (p1);\r
1292                                                CALL position (19,15);\r
1293                                                WRITE ("-")\r
1294                                               \r
1295                                              ELSE  (* cas o\97 la 1ø pile est <=\r
1296                                                       \85 la 2ø pile. *)\r
1297                                                p3 := p1.soustraction (p2);\r
1298                                              FI;\r
1299 \r
1300                                            FI;\r
1301                           ESAC;\r
1302 \r
1303                 WHEN '3': WRITE ("La s\82lection est : ");\r
1304                           WRITE ("*");\r
1305                           \r
1306                           CALL cadrer (10,14,22,50);\r
1307                           CALL fenetre_saisie (11,25);\r
1308                           \r
1309                           CALL cadrer (15,19,22,50);\r
1310                           CALL fenetre_saisie (16,25);\r
1311                           \r
1312                           CALL p1.max_de_2_piles (n1,n2,p2,n3);\r
1313 \r
1314                        CASE signe1\r
1315 \r
1316                          WHEN '-' : IF signe2 =/= '-' \r
1317                                            \r
1318                                     THEN\r
1319                                       CALL position (19,15);\r
1320                                       WRITE ("-");\r
1321                                     FI;                                            \r
1322                                 \r
1323                          OTHERWISE IF signe2 = '-'\r
1324                                           \r
1325                                   THEN\r
1326                                     CALL position (19,15);\r
1327                                     WRITE ("-");\r
1328                                   FI;                                            \r
1329                              \r
1330                        ESAC ;\r
1331                 \r
1332                           p3 := p1.multiplication (p2,partition (grand(n1,n2,n3)));\r
1333           \r
1334                           CALL effacer_partie (1,19,16,58);\r
1335                           (* Permet d'effacer le message "Calcul en cours"*)\r
1336                 \r
1337                 WHEN '4': WRITE ("La s\82lection est : ");\r
1338                           WRITE ("^2");\r
1339                           \r
1340                           CALL effacer_partie (1,14,13,1);\r
1341                           \r
1342                           CALL cadrer (10,14,22,50);\r
1343                           CALL fenetre_saisie (11,25);\r
1344                 \r
1345                           p3 := p1.carre (partition (n1));\r
1346 \r
1347                 WHEN '5': WRITE ("La s\82lection est : ");\r
1348                           WRITE ("DIV");\r
1349                           \r
1350                           CALL cadrer (10,14,22,50);\r
1351                           CALL fenetre_saisie (11,25);\r
1352 \r
1353                           CALL cadrer (15,19,22,50);\r
1354                           CALL fenetre_saisie (16,25);\r
1355                                                    \r
1356                            IF p2.pile_vide      \r
1357                                                 (* Traitement de la division par\r
1358                                                    z\82ro.*)     \r
1359                            THEN\r
1360                           \r
1361                                 CALL position (17,45);                \r
1362                                 WRITELN ("IMPOSSIBLE... Division par Z\82ro");\r
1363                                 EXIT;\r
1364                            FI;\r
1365 \r
1366                            IF ( (signe2 = '-') AND (signe1 =/= '-') ) \r
1367                                  OR ( (signe2 =/= '-') AND (signe1 = '-') )\r
1368                                            \r
1369                            THEN\r
1370                                        CALL position (19,15);\r
1371                                        WRITE ("-");\r
1372                            FI;                                            \r
1373                           \r
1374                           p3 := p1.division (p2);\r
1375                                \r
1376                 WHEN '6': WRITE ("La s\82lection est : ");\r
1377                           WRITE ("MOD");\r
1378                           \r
1379                           CALL cadrer (10,14,22,50);\r
1380                           CALL fenetre_saisie (11,25);\r
1381 \r
1382                           CALL cadrer (15,19,22,50);\r
1383                           CALL fenetre_saisie (16,25);\r
1384                                                    \r
1385                            IF p2.pile_vide      \r
1386                                                 (* Traitement de la division par\r
1387                                                    z\82ro.*)     \r
1388                            THEN\r
1389                           \r
1390                                 CALL position (17,45);                \r
1391                                 WRITELN ("IMPOSSIBLE... Division par Z\82ro");\r
1392                                 EXIT;\r
1393                            FI;\r
1394                            \r
1395                            IF ( (signe2 = '-') AND (signe1 =/= '-') ) \r
1396                                  OR ( (signe2 =/= '-') AND (signe1 = '-') )\r
1397                                            \r
1398                            THEN\r
1399                                        CALL position (19,15);\r
1400                                        WRITE ("-");\r
1401                            FI;                                            \r
1402 \r
1403                           p3 := p1.modulo (p2);\r
1404 \r
1405 \r
1406                 WHEN '7': WRITE ("La s\82lection est : ");\r
1407                           WRITE ("PGCD");\r
1408                           \r
1409                           CALL cadrer (10,14,22,50);\r
1410                           CALL fenetre_saisie (11,25);\r
1411                           \r
1412                           CALL cadrer (15,19,22,50);\r
1413                           CALL fenetre_saisie (16,25);\r
1414                            \r
1415                            IF p2.pile_vide      \r
1416                                                 (* Traitement de la division par\r
1417                                                    z\82ro.*)     \r
1418                            THEN\r
1419                           \r
1420                                 CALL position (17,45);                \r
1421                                 WRITELN ("IMPOSSIBLE... Division par Z\82ro");\r
1422                                 EXIT;\r
1423                            FI;\r
1424 \r
1425                            IF ( (signe2 = '-') AND (signe1 =/= '-') ) \r
1426                                  OR ( (signe2 =/= '-') AND (signe1 = '-') )\r
1427                                            \r
1428                            THEN\r
1429                                        CALL position (19,15);\r
1430                                        WRITE ("-");\r
1431                            FI;                                            \r
1432                           \r
1433 \r
1434                               p3 := p1.pgcd (p2)\r
1435 \r
1436 \r
1437                  WHEN '8': WRITE ("La s\82lection est : ");\r
1438                            WRITE ("PPCM");\r
1439                            CALL cadrer (10,14,22,50);\r
1440                            CALL fenetre_saisie (11,25);\r
1441                           \r
1442                            CALL cadrer (15,19,22,50);\r
1443                            CALL fenetre_saisie (16,25);\r
1444                            \r
1445                            IF p2.pile_vide      \r
1446                                                 (* Traitement de la division par\r
1447                                                    z\82ro.*)     \r
1448                            THEN\r
1449                           \r
1450                                 CALL position (17,45);                \r
1451                                 WRITELN ("IMPOSSIBLE... Division par Z\82ro");\r
1452                                 EXIT;\r
1453                            FI;\r
1454 \r
1455                            IF ( (signe2 = '-') AND (signe1 =/= '-') ) \r
1456                                  OR ( (signe2 =/= '-') AND (signe1 = '-') )\r
1457                                            \r
1458                            THEN\r
1459                                        CALL position (19,15);\r
1460                                        WRITE ("-");\r
1461                            FI;                                            \r
1462                 \r
1463                            p3 := p1.ppcm (p2);\r
1464                           \r
1465                 OTHERWISE CALL effacer_partie (5,78,2,1);\r
1466                           CALL cadrer (3,7,2,79);\r
1467                           CALL fenetre_operation (i,j);  \r
1468           ESAC;\r
1469                           \r
1470                           CALL position (19,17);\r
1471                           \r
1472                           CALL p3.afficher_resultat;\r
1473                                 \r
1474         \r
1475         END fenetre_operation;\r
1476         \r
1477 (* ------------------------------------------------------------------------ *)\r
1478 \r
1479         UNIT fenetre_saisie : PROCEDURE (i,j : INTEGER);\r
1480         (* Cette proc\82dure permet de r\82aliser le choix entre la saisie d'un \r
1481         entier court et long. Et permet d'effectuer la saisie du signe qui  \r
1482         sera g\82rer dans la proc\82dure ci dessus. *)\r
1483 \r
1484         VAR choix : CHAR, nbre : INTEGER;\r
1485 \r
1486         BEGIN\r
1487           \r
1488           WRITELN; (* Cette commande permet de vider le buffer *)\r
1489         \r
1490           CALL position (i,j);\r
1491           \r
1492           WRITELN ("1 : Entier court");\r
1493           CALL position (i+1,j);\r
1494           WRITELN ("2 : Entier long");\r
1495           CALL position (i+2,j+2);\r
1496           WRITELN ("Entrer votre choix : ");\r
1497           \r
1498           WRITELN; (* Cette commande permet de vider le buffer *)\r
1499           \r
1500           choix := chr (inchar);\r
1501           \r
1502           CALL position (i+2,j+23);\r
1503           WRITELN (choix);\r
1504           \r
1505            WRITELN; (* Cette commande permet de vider le buffer *) \r
1506 \r
1507         (* La saisie d'un entier court n\82cessite une conversion et un empilement. \r
1508            Alors que la saisie d'un entier long se fait par empilement. *)\r
1509           \r
1510           CASE choix\r
1511         (* On g\8are le choix et le position de l'\82cran qui permet de savoir \r
1512            si on manipule p1 (pour i = 11) ou p2 (pour i = 22). *)\r
1513             \r
1514             WHEN '1' : IF i = 11 \r
1515                       THEN\r
1516                       \r
1517                         CALL effacer_partie (5,29,9,21);\r
1518                         WRITELN;  (* Cette commande permet de vider le buffer *)\r
1519                         CALL position (9,16);\r
1520                         WRITE ("' '");\r
1521                         CALL position (9,17);\r
1522                         WRITELN;  (* Cette commande permet de vider le buffer *)\r
1523                         signe1 := chr (inchar);\r
1524                         CALL position (9,17);\r
1525                         WRITE (signe1);\r
1526                         CALL position (9,20);\r
1527                         READ (nbre);\r
1528                         p1 := p1.transferer_pile (p1.conversion (nbre,n1) ) \r
1529                       ELSE\r
1530                         \r
1531                         CALL effacer_partie (5,29,14,21);\r
1532                         WRITELN;  (* Cette commande permet de vider le buffer *)\r
1533                         CALL position (14,16);\r
1534                         WRITE ("' '");\r
1535                         CALL position (14,17);\r
1536                         WRITELN;  (* Cette commande permet de vider le buffer *)\r
1537                         signe2 := chr (inchar);    \r
1538                         CALL position (14,17);\r
1539                         WRITE (signe2);\r
1540                         CALL position (14,20);\r
1541                         READ (nbre);\r
1542                         p2 := p2.transferer_pile (p2.conversion (nbre,n2) )  \r
1543 \r
1544                       FI;\r
1545                      \r
1546             WHEN '2' : IF i = 11 \r
1547                       THEN\r
1548                       \r
1549                         CALL effacer_partie (5,29,9,21);\r
1550                         WRITELN;  (* Cette commande permet de vider le buffer *)\r
1551                         CALL position (9,16);\r
1552                         WRITE ("' '");\r
1553                         CALL position (9,17);\r
1554                         WRITELN;  (* Cette commande permet de vider le buffer *)\r
1555                         signe1 := chr (inchar);\r
1556                         CALL position (9,17);\r
1557                         WRITE (signe1);\r
1558                         CALL position (9,20);\r
1559                         WRITELN;  (* Cette commande permet de vider le buffer *)        \r
1560                         p1 := p1.saisir (9,20,n1) \r
1561                       ELSE\r
1562                         \r
1563                         CALL effacer_partie (5,29,14,21);\r
1564                         WRITELN;  (* Cette commande permet de vider le buffer *)\r
1565                         CALL position (14,16);\r
1566                         WRITE ("' '");\r
1567                         CALL position (14,17);\r
1568                         WRITELN;  (* Cette commande permet de vider le buffer *)\r
1569                         signe2 := chr (inchar);\r
1570                         CALL position (14,17);\r
1571                         WRITE (signe2);\r
1572                         CALL position (14,20);\r
1573                         WRITELN;  (* Cette commande permet de vider le buffer *)                                \r
1574                         p2 := p2.saisir (14,20,n2);\r
1575 \r
1576                       FI;\r
1577                      \r
1578             OTHERWISE CALL fenetre_saisie (i,j);\r
1579         \r
1580           ESAC;\r
1581 \r
1582         END fenetre_saisie;\r
1583 \r
1584 (* ------------------------------------------------------------------------ *)\r
1585 \r
1586         UNIT presentation : PROCEDURE;\r
1587         (* Cette proc\82dure permet apr\8as le prompt d'afficher la maquette de \r
1588           saisie et de r\82sultat. *)\r
1589         \r
1590         BEGIN\r
1591                 \r
1592           CALL position (10,3);\r
1593           WRITE ("Valeur nø1 : ");\r
1594           CALL position (15,3);\r
1595           WRITE ("Valeur nø2 : ");\r
1596           CALL position (20,3);\r
1597           WRITE ("R\82sultat : ");\r
1598           CALL position (25,76);\r
1599           WRITE ("D. V.");\r
1600 \r
1601         END presentation;\r
1602 \r
1603 (* ------------------------------------------------------------------------ *)\r
1604 \r
1605         UNIT aide : PROCEDURE;\r
1606         (* Cette proc\82dure permet d'afficher le texte de l'aide. *)\r
1607         \r
1608         BEGIN\r
1609                 \r
1610           CALL position (5,3);\r
1611           WRITELN ("Le calcul consiste \85 :");\r
1612           WRITELN ("    - S\82lectionner l'op\82ration d\82sir\82e.");\r
1613           WRITELN ("    - Choisir entre un entier court ou long.");\r
1614           WRITELN ("    - Mettre le signe de l'op\82ration dans le ' '.");\r
1615           WRITELN ("                   - pour les valeur n\82gatives.");\r
1616           WRITELN ("                   + pour ou rien pour les valeurs positives.");\r
1617           WRITELN ("    - Valider la saisie des valeurs  ");\r
1618           WRITELN ;\r
1619           WRITELN ("  Pour le carre, il n'a pas de deuxi\8ame saisie.");\r
1620           WRITELN ;\r
1621           WRITELN ("  Si le r\82sultat obtenu n'est pas visible \85 l'\82cran \85 cause d'un");\r
1622           WRITELN ("trop grand nombre de chiffres, il faut quitter ce logiciel et"); \r
1623           WRITELN ("taper 'int projet > exemple' et reprendre l'application pr\82c\82dente.");\r
1624           WRITELN ;\r
1625           WRITELN ("  Ceci est tap\82 n'est pas visible \85 l'\82cran. Pour visualiser la saisie");\r
1626           WRITELN ("et le r\82sultat il faut taper 'type exemple | more' \85 partir du DOS.");\r
1627           WRITELN ;\r
1628           WRITELN ("Quitter : permet de revenir au Syt\8ame d'Exploitation");\r
1629 \r
1630         END aide;\r
1631 \r
1632 \r
1633 VAR p1,p2,p3 : Entier_long, (* p1, p2 sont deux piles de saisie et p3 : une \r
1634                               pile r\82sultat. *)\r
1635 \r
1636 n1, n2, n3 : INTEGER,       (* n1, n2 correspondent au nombres de chiffres \r
1637                               qui sont dans les piles n3 resort leur maximum ou \r
1638                               leur \82galit\82. *)\r
1639 \r
1640 b1, b2, ecr : BOOLEAN,      (* Les deux premeirs repr\82sentent respectivement \r
1641                                la l'obtention d'un r\82sultat n\82gatif pour la \r
1642                                soustraction et le test comme quoi la valeur \r
1643                                du reste est nulle pour le pgcd. \r
1644                                ecr va permetre au sommaire de passer de la \r
1645                                position de plein \82cran \85 celle de petit \82cran\r
1646                                sur les trois premi\8ares lignes.*)\r
1647 \r
1648 signe1, signe2 : CHAR;      (* Ils repr\82sentent respectivement les valeurs \r
1649                                des signe de la pile 1 et 2. *) \r
1650 \r
1651 \r
1652 BEGIN\r
1653 \r
1654 (* Intialisation des trois piles. *)\r
1655 p1 := new Entier_long;  \r
1656 p2 := new Entier_long;  \r
1657 p3 := new Entier_long;  \r
1658 \r
1659 WRITE (chr(27), "[2J");\r
1660 \r
1661 CALL position (4,19);\r
1662 WRITELN ("LA CALCULATRICE DES ENTIERS COURTS ET LONGS");\r
1663 CALL position (19,76);\r
1664 WRITELN ("D. V.");\r
1665 ecr := TRUE;\r
1666 \r
1667 CALL prompt (12,6) ;\r
1668 \r
1669 END projet;\r