examples/apply/deriv.log

   1 PROGRAM DERIVATION;\r
   2 \r
   3 (**********************************************************)\r
   4 (*    permet de saisir caract\8are par caract\8are            *)\r
   5 \r
   6   UNIT readkey : IIUWgraph function : integer;\r
   7   begin\r
   8     do\r
   9       result := inkey;\r
  10       if result > 0 then exit fi\r
  11     od\r
  12  end readkey;\r
  13 \r
  14  unit  gotoxy : procedure(lig, col : integer);\r
  15     var c,d,e,f : char,\r
  16         i,j     : integer;\r
  17   begin\r
  18     i := lig div 10; j := lig mod 10;\r
  19     c := chr(48+i);  d := chr(48+j);\r
  20     i := col div 10; j := col mod 10;\r
  21     e := chr(48+i);  f := chr(48+j);\r
  22     write( chr(27), "[", c, d, ";", e, f, "H")\r
  23   end gotoxy;\r
  24 \r
  25   Unit mesg : procedure (message1, message2 : string);\r
  26   begin\r
  27      call gotoxy(23,1);\r
  28      write(message1);\r
  29      call gotoxy(24,1);\r
  30      write(message2);\r
  31      return;\r
  32   end mesg;\r
  33 \r
  34   Unit charint : function (c : char) : integer;\r
  35   begin\r
  36     result := ord(c) - 48 ;\r
  37  end charint;\r
  38 \r
  39 (**********************************************************)\r
  40 (*  UNITE IMPLANTATION DES PILES POUR EMPILER LES OPERANDES *)\r
  41 \r
  42   UNIT pile1 : class;\r
  43   const max = 100;\r
  44   var premier : integer,\r
  45       stack : arrayof expr;\r
  46 \r
  47      UNIT empiler : procedure (car : expr);\r
  48      BEGIN\r
  49            premier := premier + 1;\r
  50            stack(premier) := car;\r
  51            call display("stak = ",stack(premier));\r
  52      END empiler;\r
  53 \r
  54      UNIT empty : function : boolean;\r
  55      BEGIN\r
  56        result := premier = 0;\r
  57      END EMPTY;\r
  58 \r
  59      UNIT sommet : function: expr;\r
  60      BEGIN\r
  61        IF not empty then result := stack(premier);\r
  62                      (* else call error (raise pile-vide) *)\r
  63        FI;\r
  64      END sommet;\r
  65 \r
  66      UNIT depiler : procedure;\r
  67      BEGIN\r
  68        IF not empty then premier := premier - 1;\r
  69        writeln(premier);\r
  70        FI;\r
  71      END depiler;\r
  72 \r
  73 BEGIN\r
  74      premier := 0;\r
  75      array stack dim (1 : max);\r
  76 END pile1;\r
  77 \r
  78 (**********************************************************)\r
  79 (*  UNITE IMPLANTATION DES PILES POUR LES OPERATEURS      *)\r
  80 \r
  81   UNIT pile2 : class;\r
  82     const max = 100;\r
  83     var premier : integer,\r
  84         stack : arrayof char;\r
  85   \r
  86 \r
  87      UNIT empiler : procedure (car : char);\r
  88      BEGIN\r
  89            premier := premier + 1;\r
  90            stack(premier) := car;\r
  91      END empiler;\r
  92 \r
  93      UNIT empty : function : boolean;\r
  94      BEGIN\r
  95        result := premier = 0;\r
  96      END EMPTY;\r
  97 \r
  98      UNIT sommet : function: char;\r
  99      BEGIN\r
 100        IF not empty then result := stack(premier);\r
 101                      (* else call error (raise pile-vide) *)\r
 102        FI;\r
 103      END sommet;\r
 104 \r
 105      UNIT depiler : procedure;\r
 106      BEGIN\r
 107        IF not empty then premier := premier - 1;\r
 108        writeln(premier);\r
 109        FI;\r
 110      END depiler;\r
 111 BEGIN\r
 112      premier := 0;\r
 113      array stack dim (1 : max);\r
 114 END pile2;\r
 115 \r
 116  \r
 117 UNIT EXPR:CLASS; (* OUR FUNCTIONS WILL BE EXPRESSIONS *)\r
 118      UNIT VIRTUAL DERIV:FUNCTION(X:VARIABLE):EXPR;\r
 119                                END DERIV;\r
 120 END EXPR;\r
 121 \r
 122        UNIT VARIABLE:EXPR CLASS(ID:char);\r
 123            (* DIFFERENTIATED EXPRESSION WILL OBVIOUSLY CONSIST OF VARIABLES*)\r
 124             UNIT VIRTUAL DERIV:FUNCTION(X:VARIABLE):EXPR;\r
 125                                BEGIN\r
 126                                  writeln("je suis dans variable");\r
 127                                  IF X.ID=ID THEN\r
 128                                     RESULT:=ONE\r
 129                                  ELSE\r
 130                                     RESULT:=ZERO\r
 131                                     (*THIS IS THE DERIVATIVE OF A VARIABLE\r
 132                                      OTHER THEN X WITH RESPECT TO X       *)\r
 133                                  FI\r
 134                                END DERIV;\r
 135                  END VARIABLE;\r
 136 \r
 137      (* DIFFERENTIATION OF A FUNCTION OF A VARIABLE X *)\r
 138 \r
 139  \r
 140        UNIT CONSTANT:EXPR CLASS(K:REAL);\r
 141            (* DIFFERENTIATED EXPRESSION WILL CONSIST OF CONSTANT *)\r
 142             UNIT VIRTUAL DERIV:FUNCTION(X:VARIABLE):EXPR;\r
 143                                BEGIN\r
 144                                  writeln("je suis dans constant ");\r
 145                                  RESULT:=ZERO;\r
 146                                END DERIV;\r
 147        END CONSTANT;\r
 148 \r
 149        UNIT PAIRE:EXPR CLASS(L,R:EXPR);\r
 150            (* WE WILL ALSO COMPUTE DERIVATIVES OF EXPRESSIONS WITH TWO\r
 151               ARGUMENT OPERATORS                                        *)\r
 152            UNIT VIRTUAL DERIV: FUNCTION(X:VARIABLE):EXPR;\r
 153            END;\r
 154        END PAIRE;\r
 155  \r
 156  \r
 157        UNIT SOMME : PAIRE CLASS;\r
 158            (* WE DIFFERENTIATE THE SUM OF TWO EXPRESSIONS *)\r
 159             UNIT VIRTUAL DERIV:FUNCTION(X:VARIABLE):EXPR;\r
 160                                VAR LPRIM,RPRIM:EXPR;\r
 161                                BEGIN\r
 162                                 writeln("je suis sum");\r
 163                                  LPRIM:=L.DERIV(X);\r
 164                                  RPRIM:=R.DERIV(X);\r
 165                                  (*WE DELETE 0 AS THE NEUTRAL ELEMENT OF\r
 166                                    ADDITION                             *)\r
 167                                  IF LPRIM=ZERO THEN\r
 168                                     RESULT:=RPRIM\r
 169                                  ELSE\r
 170                                  IF RPRIM=ZERO THEN\r
 171                                     RESULT:=LPRIM\r
 172                                  ELSE\r
 173                                     RESULT:=NEW SOMME(LPRIM,RPRIM)\r
 174                                  FI\r
 175                                  FI;\r
 176                                END DERIV;\r
 177                 END SOMME;\r
 178  \r
 179  \r
 180         UNIT DIFF:PAIRE CLASS;\r
 181             (* WE DIFFERENTIATE THE DIFFERECE OF TWO EXPRESSIONS *)\r
 182              UNIT VIRTUAL DERIV:FUNCTION(X:VARIABLE):EXPR;\r
 183                                 VAR LPRIM,RPRIM: EXPR;\r
 184                                 BEGIN\r
 185                                   LPRIM:=L.DERIV(X);\r
 186                                   RPRIM:=R.DERIV(X);\r
 187                                   (* WE DELETE THE SUBTRACTED ZERO *)\r
 188                                   IF RPRIM=ZERO THEN\r
 189                                      RESULT:=LPRIM\r
 190                                   ELSE\r
 191                                      RESULT:=NEW DIFF(LPRIM,RPRIM)\r
 192                                   FI\r
 193                                 END DERIV;\r
 194                  END DIFF;\r
 195 \r
 196         UNIT PRODUIT : paire class;\r
 197             UNIT VIRTUAL deriv : function (X : variable) : expr;\r
 198             VAR UPRIMV, UVPRIM : expr;\r
 199             BEGIN\r
 200               UPRIMV := new produit(L.deriv(X), R);\r
 201               UVPRIM := new produit(L, R.deriv(x));\r
 202               result := new somme (UPRIMV, UVPRIM);\r
 203             END DERIV;\r
 204         END PRODUIT;\r
 205 \r
 206         UNIT DIVISE : PAIRE class;\r
 207            UNIT virtual deriv : function (X : variable): expr;\r
 208            VAR UPRIMV, UVPRIM, VCARRE, NUMERA : EXPR;\r
 209            BEGIN\r
 210              UPRIMV := new produit (L.deriv(X), R);\r
 211              UVPRIM := new produit (L, R.deriv(X));\r
 212              NUMERA := new diff (UPRIMV, UVPRIM);\r
 213              VCARRE := new produit (R, R);\r
 214              result := new divise (NUMERA, VCARRE);\r
 215           END DERIV;\r
 216        END DIVISE;\r
 217 \r
 218        UNIT SINUS : EXPR class (L : EXPR);\r
 219           UNIT virtual deriv : function (X:variable) : expr;\r
 220           VAR LPRIM : EXPR;\r
 221           BEGIN\r
 222             LPRIM := new cosinus (L);\r
 223             result := new produit (L.deriv(X), LPRIM);\r
 224          END deriv;\r
 225       END sinus;\r
 226 \r
 227       UNIT cosinus : expr class (L:expr);\r
 228         UNIT virtual deriv : function (X:variable) : expr;\r
 229         VAR LPRIM : expr;\r
 230         BEGIN\r
 231           LPRIM := new produit (new constant(-1), new sinus (L));\r
 232           result := new produit (L.deriv(X) , LPRIM);\r
 233         END deriv;\r
 234      END cosinus;\r
 235 \r
 236      UNIT LOGN : expr class (L : expr);\r
 237        UNIT virtual deriv : function (X:variable): expr;\r
 238        BEGIN\r
 239          result := new divise (L.DERIV(X), L);\r
 240       END DERIV;\r
 241     END logn;\r
 242 \r
 243     UNIT expon : expr class (L:expr);\r
 244       UNIT virtual deriv : function(X : variable) : expr;\r
 245       BEGIN\r
 246         result := new produit (L.deriv(X), L);\r
 247       END deriv;\r
 248    END expon;\r
 249 \r
 250    UNIT racine : expr class (L:expr);\r
 251      UNIT virtual deriv : function (X : variable) : expr;\r
 252      VAR prod, rac : expr;\r
 253      BEGIN\r
 254         RAC := new racine(L);\r
 255         prod := new produit (new constant (2), rac);\r
 256         result := new diff(L.deriv(X), prod);\r
 257      END deriv;\r
 258   END racine;\r
 259 \r
 260 \r
 261         UNIT DISPLAY:PROCEDURE(T:STRING,E:EXPR);\r
 262            (* DISPLAY THE EXPRESSION TREE IN A READABLE FORM *)\r
 263  \r
 264                   UNIT SCAN:PROCEDURE(E:EXPR);\r
 265                   BEGIN\r
 266                      IF E IS SOMME THEN\r
 267                                  WRITE(" ("); CALL SCAN(E QUA PAIRE.L);\r
 268                                  WRITE("+");\r
 269                                  CALL SCAN(E QUA PAIRE.R);\r
 270                                  WRITE(" )");\r
 271                     ELSE\r
 272                       IF E IS DIFF THEN\r
 273                                  WRITE(" (");\r
 274                                  CALL SCAN(E QUA PAIRE.L);WRITE("-");\r
 275                                  CALL SCAN(E QUA PAIRE.R);\r
 276                                  WRITE(" )")\r
 277                       ELSE\r
 278                         IF E is PRODUIT then\r
 279                                  write(" (");\r
 280                                  call scan (E QUA PAIRE.L);\r
 281                                  write("*");\r
 282                                  call scan (E QUA PAIRE.R);\r
 283                                  write(" )");\r
 284                         ELSE\r
 285                           IF E IS DIVISE then\r
 286                                  write(" (");\r
 287                                  call scan (E QUA PAIRE.L);\r
 288                                  write("/");\r
 289                                  call scan (E QUA PAIRE.R);\r
 290                                  write(" )");\r
 291                           ELSE\r
 292                           IF E IS SINUS then\r
 293                              write(" ( sin(");\r
 294                              call scan (E QUA SINUS.L);\r
 295                              write(" )");\r
 296                           ELSE\r
 297                               IF E IS COSINUS then\r
 298                               write(" ( cos(");\r
 299                               call scan (E QUA COSINUS.L);\r
 300                               write(" )");\r
 301                            ELSE\r
 302                              IF E IS LOGN then\r
 303                              write(" ( LN(");\r
 304                              call scan (E QUA LOGN.L);\r
 305                              write(" )");\r
 306                              ELSE\r
 307                                IF E IS EXPON then\r
 308                                write(" ( EXP(");\r
 309                                call scan (E QUA EXPON.L);\r
 310                                write(" )");\r
 311                                ELSE\r
 312                                  IF E IS RACINE then\r
 313                                  write(" ( û (");\r
 314                                  call scan (E QUA RACINE.L);\r
 315                                  write(" )");\r
 316                                 ELSE\r
 317                                  IF E IS CONSTANT THEN\r
 318                                    WRITE(E QUA CONSTANT.K:6:2)\r
 319                                   ELSE\r
 320                                   IF E IS VARIABLE THEN\r
 321                                      WRITE(E QUA VARIABLE.ID);\r
 322                    FI FI FI FI FI FI FI FI FI FI FI;\r
 323                       END SCAN;\r
 324  \r
 325                           BEGIN\r
 326                               WRITE(T);\r
 327                               CALL SCAN(E);\r
 328                               WRITELN;\r
 329          END DISPLAY;\r
 330  \r
 331 \r
 332 (*********************************************************)\r
 333 (*******         calcul de la d\82riv\82e             **********)\r
 334 (*******      les op\82rateurs vont dans P2               ****)\r
 335 (*******      et les op\82randes vont dans P1             ****)\r
 336 \r
 337 UNIT expderivee : procedure (express : arrayof char,\r
 338                               taille : integer);\r
 339   CONST max = 100;\r
 340   VAR   opaux , c: char,\r
 341         P1 : pile1,\r
 342         P2 : pile2,\r
 343         const1, auxreel : real,\r
 344         decim, saisie : boolean,\r
 345         X, Y, Z, T , arg1, arg2, consta, E,U,V, F : expr,\r
 346         compt, j, cptcons : integer;\r
 347 \r
 348   BEGIN\r
 349      compt := 0;\r
 350      P1 := new pile1;\r
 351      P2 := new pile2;\r
 352      decim, saisie := false;\r
 353      FOR j := 1 to taille\r
 354      do\r
 355         write(express(j));\r
 356      od;\r
 357      j := 1;\r
 358      DO\r
 359        if  j = taille + 1 then exit fi;\r
 360        case express(j)\r
 361        when '(' : j := j + 1;\r
 362 \r
 363        when 'X','x': X := new variable('X');\r
 364                      call P1.empiler(X);\r
 365                      j := j + 1;\r
 366 \r
 367        when 'Y','y': E := new variable('Y');\r
 368                      call P1.empiler(E);\r
 369                      j := j + 1;\r
 370 \r
 371        when 'Z','z': E := new variable('Z');\r
 372                      call P1.empiler(E);\r
 373                      j := j + 1;\r
 374 \r
 375       when 'T','t': E := new variable('T');\r
 376                     call P1.empiler(E);\r
 377                     j := j + 1;\r
 378 \r
 379       when '0','1','2','3','4','5','6','7','8','9','.' :\r
 380                      cptcons := 100;\r
 381                      auxreel := charint(express(j));\r
 382                      const1 :=  auxreel * cptcons;\r
 383                      j := j + 1;\r
 384                      writeln("j = ",j);\r
 385                      writeln("avant test");\r
 386                      while not saisie do\r
 387                        writeln("dans test");\r
 388                        c := express(j);\r
 389                        IF (c = '0' or c = '1' or c = '2' or c='3'\r
 390                           or c='4' or c='5' or c= '6' or c = '7' or\r
 391                           c = '8' or c='9')\r
 392                        THEN\r
 393                          writeln("test0");\r
 394                          cptcons := cptcons div 10;\r
 395                          auxreel := charint(express(j));\r
 396                          const1 := const1 + (auxreel * cptcons);\r
 397                          j := j + 1;\r
 398                        ELSE\r
 399                          IF ( c ='.' )\r
 400                          THEN writeln("test1");\r
 401                               const1 := const1 / cptcons;\r
 402                               cptcons := 1;\r
 403                               j := j + 1;\r
 404                               decim := true;\r
 405                          ELSE\r
 406                            writeln("test2");\r
 407                            IF not decim then const1 := const1 / cptcons;FI;\r
 408                            E := new constant (const1);\r
 409                            writeln("avant empile");\r
 410                            call p1.empiler(E);\r
 411                            writeln("apres empile");\r
 412                            saisie := true;\r
 413                            writeln("j = ",j);\r
 414                          FI;\r
 415                        FI;\r
 416                      OD;\r
 417 \r
 418       when ' ' : j := j + 1;\r
 419 \r
 420       when 'C', 'S','E','R','L','c','s','e','r','l','+','-',\r
 421            '*','/' : writeln(express(j));\r
 422                      call P2.empiler(express(j));\r
 423                      j := j + 1;\r
 424 \r
 425       when ')' : opaux := P2.sommet ;\r
 426                  call P2.depiler;\r
 427                  case opaux\r
 428                  when '+','-','*','/' :\r
 429                        arg2 := P1.sommet;\r
 430                        call display("arg2 = ",arg2);\r
 431                        call P1.depiler;\r
 432                        arg1 :=P1.sommet;\r
 433                        call display("arg1 = ",arg1);\r
 434                        call P1.depiler;\r
 435                        case opaux\r
 436                          when  '+' : E := new somme(arg1, arg2);\r
 437                                      call display("E = ",E);\r
 438                         when  '-' :  E := new diff (arg1, arg2);\r
 439                                      call display("E = ",E);\r
 440                         when '*': E := new produit (arg1,arg2);\r
 441                         when '/': E := new divise (arg1, arg2);\r
 442                       esac;\r
 443                      call P1.empiler (E);\r
 444 \r
 445                 when 'C','c','e','E','s','S','r','R','l','L' :\r
 446                       arg2 := P1.sommet;\r
 447                       call display("arg2 = ",arg2);\r
 448                       call P1.depiler;\r
 449 \r
 450 \r
 451                  esac;\r
 452                  j := j + 1;\r
 453 \r
 454      esac;\r
 455    od;\r
 456    call display ("fonction = ", E);\r
 457    F := E.deriv(X);\r
 458    call display("Derivee = ", F);\r
 459    readln;\r
 460 END expderivee;\r
 461 \r
 462 \r
 463 (**********************************************************)\r
 464 (***********   Saisie de la fonction \85 d\82river   **********)\r
 465 \r
 466 UNIT expsaisie : procedure (output express : arrayof char,\r
 467                             taille : integer);\r
 468 VAR expression : arrayof char,\r
 469     car : char,\r
 470     opbool, cstbool, varbool, decibool : boolean,\r
 471     i, touche, opcpt, ligne, pouvcpt, pfermcpt : integer;\r
 472 \r
 473 BEGIN\r
 474   array expression dim (1:maxi);\r
 475   ligne := 5;\r
 476   writeln("Saisissez votre expression en parenth\82sant convenablement");\r
 477   i := 1;\r
 478   call gotoxy(ligne,1);\r
 479   DO\r
 480    touche := readkey;\r
 481    car := chr (touche);\r
 482    case car\r
 483        when 'v','V': (* l'utilisateur veut valider l'expression *)\r
 484                    IF (pouvcpt =/= pfermcpt)\r
 485                    then\r
 486                      mes1 := "Expression incorrecte, il manque des parenth\8ases.";\r
 487                      mes2 := "Expression ignor\82e.";\r
 488                    ELSE\r
 489                      IF pouvcpt =/= opcpt\r
 490                      THEN mes1 := "Expression incorrecte. Il manque des parenth\8ases ou des op\82rateurs.";\r
 491                           mes2 := "Expression ignor\82e.";\r
 492                      ELSE\r
 493                        sais := true;\r
 494                        taille := i - 1;\r
 495                        express := expression;\r
 496                        mes1 := "Expression valid\82e.";\r
 497                        mes2 := blanc;\r
 498                      FI;\r
 499                    FI;\r
 500                    call mesg(mes1, mes2);\r
 501                    call gotoxy(25,1);\r
 502                    write(" <Appuyer sur une touche pour continuer>");\r
 503                    readln;\r
 504                    exit;\r
 505 \r
 506      when 'i','I': mes1 := "Expression ignor\82e";\r
 507                    call mesg(mes1, blanc);\r
 508                    call gotoxy(25,1);\r
 509                    write(" <Appuyer sur une touche pour continuer>");\r
 510                    readln;\r
 511                    exit;\r
 512 \r
 513       when ' ': (*rien*)\r
 514                 IF decibool\r
 515                 THEN mes1 := "Erreur : il manque la partie d\82cimale.";\r
 516                      call mesg(mes1, blanc);\r
 517                      call gotoxy(ligne, i);\r
 518                 FI;\r
 519 \r
 520       when '(': write(car);\r
 521                 IF decibool\r
 522                 THEN mes1 := "Erreur : il manque la partie d\82cimale.";\r
 523                      call mesg(mes1, blanc);\r
 524                      call gotoxy(ligne, i);\r
 525                 ELSE\r
 526                   pouvcpt := pouvcpt + 1;\r
 527                   opbool := false;\r
 528                   cstbool := false;\r
 529                   varbool := false;\r
 530                   expression(i) := car;\r
 531                   i := i + 1;\r
 532                   call gotoxy(ligne,i);\r
 533                 FI;\r
 534 \r
 535       when ')' : IF decibool\r
 536                  THEN mes1 := "Erreur : il manque la partie d\82cimale.";\r
 537                      call mesg(mes1, blanc);\r
 538                      call gotoxy(ligne, i);\r
 539                  ELSE\r
 540                    pfermcpt := pfermcpt +1;\r
 541                    opbool := false;\r
 542                    cstbool := false;\r
 543                    varbool := false;\r
 544                    write(car);\r
 545                    expression(i) := car;\r
 546                    i := i + 1;\r
 547                    call gotoxy(ligne,i);\r
 548                  FI;\r
 549 \r
 550       when '+', '-', '*', '/', 'C', 'c','E','e','L','l','R','r','S','s' :\r
 551                  write(car);\r
 552                  IF opbool\r
 553                  then mes1 := "2 op\82rateurs ne peuvent pas \88tre cons\82cutifs.";\r
 554                       mes2 := "Resaisissez le caract\8are.";\r
 555                       call mesg (mes1,mes2);\r
 556                       call gotoxy(ligne,i);\r
 557                  ELSE\r
 558                    IF decibool\r
 559                    THEN mes1 := "Erreur : il manque la partie d\82cimale.";\r
 560                      call mesg(mes1, blanc);\r
 561                      call gotoxy(ligne, i);\r
 562                    ELSE\r
 563                      opbool := true;\r
 564                      varbool := false;\r
 565                      cstbool := false;\r
 566                      expression (i) := car;\r
 567                      i := i + 1;\r
 568                      opcpt := opcpt + 1;\r
 569                      call mesg(blanc,blanc);\r
 570                      call gotoxy(ligne,i);\r
 571                    FI;\r
 572                  FI;\r
 573 \r
 574       when '0','1','2', '3','4','5','6','7','8','9' :\r
 575                 write(car);\r
 576                 IF varbool\r
 577                 then mes1 := "Il manque un op\82rateur ou une parenth\8ase";\r
 578                      mes2 := "Resaisissez le caract\8are.";\r
 579                      call mesg(mes1, mes2);\r
 580                      call gotoxy(ligne, i);\r
 581                 ELSE\r
 582                   decibool := false;\r
 583                   cstbool := true;\r
 584                   varbool := false;\r
 585                   opbool := false;\r
 586                   expression(i) := car;\r
 587                   i := i + 1;\r
 588                   call mesg (blanc, blanc);\r
 589                   call gotoxy(ligne,i);\r
 590                FI;\r
 591 \r
 592       when '.' : IF decibool\r
 593                  THEN mes1 := "Erreur : il manque la partie d\82cimale.";\r
 594                        call mesg(mes1, blanc);\r
 595                        call gotoxy(ligne, i);\r
 596                  ELSE\r
 597                    IF (varbool or opbool or not cstbool)\r
 598                    THEN\r
 599                      mes1 := "Expression incorrecte.";\r
 600                      mes2 := "Resaisissez le caract\8are.";\r
 601                      call mesg(mes1, mes2);\r
 602                      call gotoxy(ligne,i);\r
 603                    ELSE\r
 604                      (*  cstbool   est \85 vraie *)\r
 605                        decibool := true;\r
 606                        cstbool := false;\r
 607                        expression(i) := car;\r
 608                        i := i + 1;\r
 609                        call mesg(blanc, blanc);\r
 610                        call gotoxy(ligne, i);\r
 611                    FI;\r
 612                 FI;\r
 613 \r
 614       when 'x','y','z','t','X','Y','Z','T':\r
 615              write(car);\r
 616              IF varbool\r
 617              then mes1 := "On ne peut pas avoir 2 variables cons\82cutives.";\r
 618                   mes2 := "Il manque un op\82rateur ou une parenth\8ase.";\r
 619                   call mesg (mes1, mes2);\r
 620                   call gotoxy(ligne, i);\r
 621              ELSE\r
 622                 IF cstbool\r
 623                 then mes1 := "Il manque un op\82rateur ou une parenth\8ase.";\r
 624                      mes2 := "Resaisissez le caract\8are." ;\r
 625                      call mesg(mes1, mes2);\r
 626                      call gotoxy(ligne,i);\r
 627                 ELSE\r
 628                   IF decibool\r
 629                   THEN mes1 := "Erreur : il manque la partie d\82cimale.";\r
 630                        call mesg(mes1, blanc);\r
 631                        call gotoxy(ligne, i);\r
 632                   ELSE\r
 633                     cstbool := false;\r
 634                     opbool := false;\r
 635                     varbool := true;\r
 636                     expression(i) := car;\r
 637                     i := i + 1;\r
 638                     call mesg(blanc, blanc);\r
 639                     call gotoxy(ligne,i);\r
 640                   FI;\r
 641                 FI;\r
 642               FI;\r
 643 \r
 644       otherwise write(car);\r
 645                 mes1 := "Caract\8are invalide. Corrigez le.";\r
 646                 call mesg(mes1,blanc);\r
 647                 call gotoxy(ligne,i);\r
 648     esac;\r
 649   OD;\r
 650 END expsaisie;\r
 651 \r
 652 \r
 653 (**********************************************************)\r
 654 (*****    GUIDE UTILISATION                           *****)\r
 655 Unit guideutil : procedure;\r
 656 BEGIN\r
 657 END guideutil;\r
 658 \r
 659 \r
 660 (*********************************************************************)\r
 661 (***************** EFFACEMENT DE L'ECRAN *****************************)\r
 662 UNIT Newpage : procedure;\r
 663 begin\r
 664   write(chr(27), "[2J")\r
 665 end newpage;\r
 666 \r
 667 \r
 668 (**********************************************************)\r
 669 (******                MENU                          ******)\r
 670 UNIT MENU : PROCEDURE;\r
 671 VAR choix, k : integer;\r
 672          \r
 673 BEGIN\r
 674 DO\r
 675   call newpage; \r
 676   Write  ("     Ú");\r
 677   For k:= 3 to 61 DO\r
 678   Write("Ä");\r
 679   OD;\r
 680   writeln("¿");\r
 681   Writeln("     ³                                                            ³");\r
 682   Writeln("     ³ ****     CE PROGRAMME DONNE L'EXPRESSION DE LA        **** ³");\r
 683   WRITELN("     ³ ****     DERIVEE CORRESPONDANT A UNE FONCTION         **** ³");\r
 684   Writeln("     ³ ****                 DONNEE                           **** ³");\r
 685   writeln("     ³                                                            ³");\r
 686   writeln("     ³                                                            ³");\r
 687   writeln("     ³        1 : Saisir une fonction                             ³");\r
 688   Writeln("     ³        2 : Calculer la d\82riv\82e d'une fonction              ³");\r
 689   Writeln("     ³        3 : Visualiser le guide d'utilisation               ³");\r
 690   Writeln("     ³        4 : Quitter                                         ³");\r
 691   writeln("     ³                                                            ³");\r
 692   Write  ("     À");\r
 693   For k := 2 to 60 DO\r
 694     write ("Ä");\r
 695   OD;\r
 696   writeln("Ù");\r
 697   writeln;\r
 698   write("       votre choix :");\r
 699   readln (choix);\r
 700   call newpage;\r
 701   CASE choix\r
 702     When 1 : taille := 0;\r
 703              call expsaisie (express,taille);\r
 704 \r
 705     WHEN 2 : IF not sais\r
 706              then  write("coucou");\r
 707                    mes1 := "Aucune expression correcte n'a \82t\82 saisie";\r
 708                    mes2 := blanc;\r
 709                    call mesg (mes1, mes2);\r
 710                    write("<Appuyer sur une touche pour continuer>");\r
 711                    readln;\r
 712                    call menu;\r
 713              ELSE call expderivee(express, taille);\r
 714              FI;\r
 715 \r
 716     WHEN 3 : call guideutil;\r
 717 \r
 718     WHEN 4 : exit ;\r
 719     OTHERWISE  mes1 :="le choix demand\82 est incorrect ";\r
 720               call mesg(mes1, blanc);\r
 721               write("<Appuyer sur une touche pour continuer>");\r
 722               readln;\r
 723   ESAC;\r
 724 OD;\r
 725 END MENU;\r
 726 \r
 727 \r
 728 (**********************************************************)\r
 729 (*****        PROGRAMME PRINCIPAL                     *****)\r
 730 (**********************************************************)\r
 731 CONST MAXI = 80,\r
 732       MAX  = 50,\r
 733       BLANC = "                                                                      ";\r
 734 \r
 735 VAR sais : boolean,\r
 736     express : arrayof char,\r
 737     mes1, mes2 : string,\r
 738     taille : integer,\r
 739      ZERO,ONE:CONSTANT;\r
 740        \r
 741 \r
 742 BEGIN\r
 743      ZERO:=NEW CONSTANT(0);\r
 744      ONE:=NEW CONSTANT(1);\r
 745      sais := false;\r
 746      call menu;\r
 747 END;\r