examples/examples.old/texte.log

   1 program TYPETEXT;\r
   2 \r
   3 (****************************************************************************) \r
   4 (**********************  D\82claration de l'UNIT TYPETEXT *********************) \r
   5 (****************************************************************************) \r
   6  \r
   7  \r
   8  UNIT Typetext : class;\r
   9 \r
  10   VAR contenu  : arrayof char,  (* tableau contenant la valeur de la cha\8cne \r
  11                                    de caract\8ares *)\r
  12       position : integer;       (* entier indiquant la position courante dans\r
  13                                    le tableau pr\82c\82dent (indice d'un champ) *)\r
  14 \r
  15 \r
  16    (**********************************************************************)\r
  17    (******************** D\82claration de l'UNIT Ecrire ********************)\r
  18    (**********************************************************************)\r
  19    (********  On affiche la valeur du type contenu dans "contenu" ********)\r
  20    (**********************************************************************)\r
  21 \r
  22 \r
  23    UNIT Ecrire : procedure;\r
  24     \r
  25 (* si la variable contenu vaut none, cela signifie qu'elle n'a pas \82t\82 encore\r
  26    cr\82\82e, donc l'affichage est vierge : on sort de la proc\82dure.\r
  27    sinon du premier indice du tableau (1) jusqu'\85 la taille du tableau, on lit\r
  28    chaque caract\8are au fur et \85 mesure et on les affiche. *)\r
  29 \r
  30    VAR i:integer;\r
  31 \r
  32    BEGIN\r
  33       if (contenu=none) then exit fi;\r
  34       for i:=1 to upper(contenu) do write(contenu(i)) od;\r
  35       writeln;\r
  36    END ecrire;\r
  37 \r
  38    \r
  39    (**********************************************************************)\r
  40    (******************* D\82claration de l'UNIT Lecture *******************) \r
  41    (**********************************************************************)\r
  42    (******* On saisie les caract\8ares d\82finissant la valeur du type *******)\r
  43    (**********************************************************************)\r
  44 \r
  45 \r
  46    UNIT Lecture : procedure(l:integer);\r
  47 \r
  48 (* On ignore la taille de la cha\8cne de caract\8ares que va saisir l'utilisateur.\r
  49    Il est donc impossible de cr\82er le tableau contenu car on ne conna\8ct pas sa\r
  50    taille. Le principe retenu est le suivant : On cr\82e un tableau temporaire\r
  51    appel\82 temp ayant une taille al\82atoire mais d\82finie par le programmeur, c'-\r
  52    est la variable taille initialis\82e ici \85 10. Au fur et \85 mesure que l'utili- \r
  53    sateur saisi les caract\8ares composant sa cha\8cne, chacun de ces derniers est\r
  54    mis dans le tableau temp. Si ce tableau est plein, alors par r\82cursivit\82,\r
  55    on rapelle cette proc\82dure Lecture avec pour param\8atre le nombre de carac- \r
  56    t\8ares d\82j\85 saisi et ainsi de suite. Une fois la saisie finie (rep\82r\82e par\r
  57    13, le code de la touche ENTER ou RETOUR-CHARIOT), on cr\82e notre tableau\r
  58    contenu ayant pour taille la valeur de la variable l pass\82e en param\8atre.\r
  59    Pour chaque proc\82dure appel\82e, on part de la fin de leur tableau temp o\97\r
  60    on lit les caract\8ares que l'on va affecter dans le tableau contenu mais en\r
  61    partant aussi de la fin. *)\r
  62 \r
  63     CONST taille = 10;\r
  64     VAR   temp  : arrayof char,\r
  65           cpt,i : integer;\r
  66            \r
  67      BEGIN\r
  68       array temp dim(1:taille);   (* tableau interne *)\r
  69       cpt := 1;\r
  70 \r
  71       do\r
  72        i:=inchar;                 (* lecture d'une touche *)\r
  73        write(chr(i));\r
  74        \r
  75        if ( i = 13)               (* si enter ou retour-chariot *)\r
  76        then\r
  77         l := l + cpt -1 ;\r
  78         \r
  79         if (l=0)                  (* la cha\8cne saisie est vide *)\r
  80         then\r
  81          position := 0;           (* no elements have been read *) \r
  82          exit;\r
  83         fi;\r
  84         \r
  85         array contenu dim(1:l);   (* cr\82ation du tableau contenu *)\r
  86         for i:=(cpt-1) downto 1 do\r
  87          contenu(l) := temp(i);   (* remplissage du tableau contenu *)\r
  88          l := l -1;\r
  89         od;\r
  90         exit;                     (* fin du remplissage donc on peut sortir *)\r
  91        fi;\r
  92        \r
  93        temp(cpt) := chr(i);       (* affectation du caract\8are lu dans le \r
  94                                      tableau *)\r
  95        if (cpt=taille)            (* si le tableau est plein, alors on cr\82e *)\r
  96        then                       (* un autre tableau temporaire par r\82cur- *)\r
  97         l := l + cpt;             (* ssivit\82 pour pouvoir sauvegarder les   *)\r
  98         call Lecture(l);          (* autres caract\8ares composant la cha\8cne  *)\r
  99         \r
 100         for i:=taille downto 1 do \r
 101          contenu(l) := temp(i);\r
 102          l := l - 1;\r
 103         od;\r
 104         \r
 105         exit;\r
 106        fi;\r
 107        \r
 108        cpt := cpt +1;\r
 109       od;\r
 110       \r
 111       position := 1;\r
 112 \r
 113    END Lecture;\r
 114    \r
 115    \r
 116    (**********************************************************************)\r
 117    (******************** D\82claration de l'UNIT Concat ********************) \r
 118    (**********************************************************************)\r
 119    (******* On retourne une variable r\82sultant de la concat\82nation *******)\r
 120    (***************** de deux varibles de type Typetext ******************)\r
 121    (**********************************************************************)\r
 122 \r
 123    \r
 124    UNIT Concat : procedure(t:typetext) ;\r
 125     \r
 126 (* On concat\8ane la variable courante avec une variable t d\82finie par l'utili-    \r
 127    sateur. \r
 128     - si t est vide, la concat\82nation est inutile.\r
 129     - si la variable courante est vide, la concat\82nation repr\82sente alors la\r
 130       variable \85 concat\82ner.\r
 131     - sinon, on r\82cup\8are la valeur de la variable contenu du type courant \r
 132       dans un tableau temporaire. On recr\82e cette variable contenu mais avec\r
 133       une taille de longueur \82gale \85 la taille du tableau temporaire plus la\r
 134       taille du tableau contenu de la variable \85 concat\82ner (t).\r
 135        * On r\82\82crit le tableau temporaire dans le nouveau tableau contenu.\r
 136        * On d\82truit le tableau temporaire\r
 137        * On \82crit le tableau contenu de la variable t dans le nouveau tableau.\r
 138 *)    \r
 139 \r
 140     VAR i,j : integer,\r
 141         temp : arrayof char;\r
 142      \r
 143      BEGIN\r
 144 \r
 145       if (t=none) then exit fi; \r
 146   (* la concat\82nation avec une cha\8cne vide ne donne rien; on sort \r
 147      donc de la proc\82dure *)\r
 148       \r
 149       if (contenu=none)           (* si la variable \85 laquelle se fait la *) \r
 150       then                        (* concat\82nation est vide, alors son    *)\r
 151         contenu := t.contenu;     (* contenu est celle de la variable \85   *)\r
 152         exit;                     (* concat\82ner.                          *)\r
 153       fi;\r
 154       \r
 155       temp := copy(contenu);   \r
 156       kill(contenu);\r
 157       array contenu dim (1:upper(temp)+upper(t.contenu));\r
 158       (* Cr\82ation de la variable contenu avec sa nouvelle taille *)\r
 159 \r
 160       for i:=1 to upper(temp) do   (* recopie du tableau temporaire *)\r
 161        contenu(i) := temp(i)  \r
 162       od;\r
 163 \r
 164       kill(temp);\r
 165 \r
 166       for j:=1 to upper(t.contenu) do   (* recopie de la cha\8cne de caract\8a- *)\r
 167        contenu(j+i-1) := t.contenu(j);  (* res caract\82risant la variable t  *)\r
 168       od;\r
 169 \r
 170    END concat;\r
 171 \r
 172    \r
 173    (**********************************************************************)\r
 174    (********************* D\82claration de l'UNIT Copie ********************) \r
 175    (**********************************************************************)\r
 176    (**** Cette fonction renvoie une sous-cha\8cne de la variable contenu ***)\r
 177    (**********************************************************************)\r
 178 \r
 179 \r
 180    UNIT Copie : Function(number:integer) : typetext;\r
 181 \r
 182 (* A partir de la position courante dans le tableau, on recopie la cha\8cne de \r
 183    caract\8ares sur une longueur number.\r
 184    - Si la cha\8cne de caract\8ares dans laquelle se fait la recherche est vide\r
 185      ou si la longueur de recopie est nulle ou n\82gative, la proc\82dure ne\r
 186      donne rien, donc on sort.\r
 187    - Sinon, on cr\82e une nouvelle variable typetext dont sa variable contenu\r
 188      a pour longueur la variable number; cependant si longueur de recopie, \85\r
 189      partir de la position courante atteint la fin de la cha\8cne de caract\8ares,\r
 190      alors la longueur de la variable contenu a une longueur \82gale \85 la taille\r
 191      de la cha\8cne de carat\8ares moins la position courante plus 1.\r
 192      Ensuite on recopie les differents caract\8ares \85 partir de la position cou-\r
 193      rante dans le tableau contenu de la variable \85 retourner *)               \r
 194 \r
 195     VAR i : integer; \r
 196     \r
 197      BEGIN\r
 198       \r
 199       if ( (contenu=none) or (number<=0) )\r
 200       then exit\r
 201       fi;\r
 202       \r
 203       result := new typetext;\r
 204       \r
 205       if (position + number - 1 > upper(contenu))\r
 206       then number := upper(contenu) - position + 1\r
 207       fi;\r
 208       array result.contenu dim(1:number);\r
 209       for i:=1 to number do\r
 210        result.contenu(i) := contenu(position+i-1);\r
 211       od;\r
 212 \r
 213    END Copie;\r
 214 \r
 215    \r
 216    (**********************************************************************)\r
 217    (**********************************************************************)\r
 218    (******************** D\82claration de l'UNIT Insert ********************) \r
 219    (**********************************************************************)\r
 220    (********** On insere des caract\8ares dans le tableau contenu **********)\r
 221    (**********************************************************************)\r
 222 \r
 223 \r
 224    UNIT Insert : procedure(t:typetext);\r
 225    \r
 226 (* A partir de la position courante du type courant, on ins\8are la cha\8cne de\r
 227    caract\8ares repr\82sent\82e par t.\r
 228    Si la cha\8cne \85 ins\82rer est vide, on quitte la proc\82dure.\r
 229    Si la cha\8cne courante, c'est-\85-dire qui va recevoir la cha\8cne t, est vide\r
 230    alors le r\82sultat est cette cha\8cne t.\r
 231    Sinon\r
 232    -On cr\82e une tableau temporaire de longueur \82gale \85 la taille de la cha\8cne \r
 233    de caract\8ares \85 ins\82rer plus la taille de la cha\8cne de caract\8ares dans la-\r
 234    quelle va se faire l'insertion.\r
 235    -On recopie dans le tableau temporaire la cha\8cne, qui \88tre modifi\82e, de son \r
 236    d\82but jusqu'\85 sa position courante moins un.\r
 237    -On y recopie ensuite la cha\8cne t.\r
 238    -On y copie enfin le reste de la premi\8are cha\8cne, c'est-\85-dire de la posi-\r
 239    tion courante plus un jusqu'\85 sa fin. *)\r
 240 \r
 241    VAR temp:arrayof char,\r
 242         l,i,j : integer;\r
 243 \r
 244     BEGIN\r
 245 \r
 246       if (t=none) then exit fi;\r
 247       \r
 248       if (contenu=none)\r
 249       then \r
 250         contenu := t.contenu;\r
 251         exit;\r
 252       fi;\r
 253 \r
 254       l := upper(contenu)+upper(t.contenu);\r
 255       \r
 256       array temp dim (1:l);\r
 257 \r
 258       for i:=1 to (position-1) do temp(i) := contenu(i) od;\r
 259       \r
 260       for j:=1 to upper(t.contenu) do\r
 261        temp(i) := t.contenu(j);\r
 262        i := i + 1 ;\r
 263       od;\r
 264       \r
 265       for j:= position to upper(contenu) do\r
 266        temp(i) := contenu(j);\r
 267        i := i + 1 ;\r
 268       od;\r
 269    \r
 270       kill(contenu);\r
 271       contenu := copy(temp);\r
 272       kill(temp);\r
 273    \r
 274    END Insert;\r
 275 \r
 276 \r
 277    (**********************************************************************)\r
 278    (******************** D\82claration de l'UNIT Delete ********************) \r
 279    (**********************************************************************)\r
 280    (************* On efface des caract\8ares du tableau contenu ************)\r
 281    (**********************************************************************)\r
 282 \r
 283 \r
 284    UNIT Delete : procedure(number:integer);\r
 285     \r
 286     VAR i,j,l : integer;\r
 287     VAR temp : arrayof char;\r
 288 \r
 289      BEGIN\r
 290       \r
 291       if ( (contenu=none) or (number<=0) )      \r
 292              (* Cha\8cne vide ou longueur incorrect *)\r
 293       then exit;\r
 294       fi;\r
 295       \r
 296       if ( position + number - 1 > upper(contenu) )\r
 297       then l := position - 1\r
 298       else l := upper(contenu) - number;\r
 299       fi;\r
 300 \r
 301       array temp dim (1:l);\r
 302       \r
 303       for i:=1 to (position-1) do \r
 304        temp(i) := contenu(i);\r
 305       od;\r
 306       \r
 307       for j:=(position + number) to upper(contenu) do\r
 308        temp(i) := contenu(j);\r
 309        i := i + 1;\r
 310       od;\r
 311 \r
 312       kill(contenu);\r
 313       contenu := copy(temp);\r
 314       kill(temp);\r
 315 \r
 316 \r
 317    END Delete;\r
 318 \r
 319 \r
 320    (**********************************************************************)\r
 321    (************** D\82claration de l'UNIT Rechercher_Position *************) \r
 322    (**********************************************************************)\r
 323    (**** On recherche une suite de caract\8ares dans le tableau contenu ****)\r
 324    (**********************************************************************)\r
 325 \r
 326 \r
 327    UNIT Rechercher_Position : function (s:typetext) : integer;\r
 328 \r
 329 (* la recherche de la cha\8cne de caract\8ares s revient \85 comparer tous les\r
 330    \82l\82ments du tableau s.contenu avec ceux du tableau contenu de la variable\r
 331    courante mais \85 partir d'une position pr\82cise. \r
 332    On recherche le caract\8are correspondant \85 l'indice 1 de s.contenu dans le\r
 333    tableau contenu courant, c'est-\85-dire de 1 \85 un certain indice.\r
 334    A partir de cet indice, on compare les caract\8ares des indices suivants avec\r
 335    ceux du s.contenu variant donc de 2 jusqu'\85 trouver un caract\8are different\r
 336    ou la fin du tableau ce qui signifierait que la cha\8cne a \82t\82 trouv\82e, au-\r
 337    quel cas on retourne la valeur de l'entier correspondant \85 l'indice de \r
 338    commencement de recherche dans contenu. Si la cha\8cne n'est pas trouv\82e,\r
 339    on retourne 0. *)\r
 340 \r
 341     VAR i,j,temp : integer, \r
 342         fin,occurence : boolean;\r
 343      \r
 344      BEGIN\r
 345    \r
 346       if (contenu = none)\r
 347       then \r
 348         result := 0;\r
 349         exit;\r
 350       fi;\r
 351       \r
 352       i := 1;\r
 353       j := 1;\r
 354       temp := 0;\r
 355       fin := false;\r
 356       occurence := false;\r
 357 \r
 358       while( ( i <= upper(contenu) ) and not(fin) ) do\r
 359        if (contenu(i) = s.contenu(j))\r
 360        then j := j+1\r
 361        else j := 1\r
 362        fi;\r
 363 \r
 364        if (contenu(i) = s.contenu(1)) \r
 365        then \r
 366         if not(occurence)\r
 367         then \r
 368          temp := i;\r
 369          occurence := true;\r
 370         else \r
 371          if (j=1) \r
 372          then\r
 373           i := temp;\r
 374           occurence := false;\r
 375          fi;\r
 376         fi;\r
 377        fi;\r
 378 \r
 379        if (j>upper(s.contenu))\r
 380        then fin := true;\r
 381        else i := i + 1;\r
 382        fi;\r
 383 \r
 384       od;\r
 385 \r
 386        if fin\r
 387        then result := i - upper(s.contenu) + 1\r
 388        else result := 0\r
 389        fi;\r
 390 \r
 391    END Rechercher_Position;\r
 392 \r
 393 \r
 394    (**********************************************************************)\r
 395    (******************** D\82claration de l'UNIT Suivant *******************) \r
 396    (**********************************************************************)\r
 397    (*  On incr\82mente la variable position rep\82rant la position courante  *)\r
 398    (*********************    du tableau contenu      *********************)\r
 399    (**********************************************************************)\r
 400 \r
 401    \r
 402    UNIT Suivant : procedure ;\r
 403     \r
 404 (* On incr\82mente simplement la variable position, sauf si :\r
 405     - on est \85 la fin de la cha\8cne de caract\8ares\r
 406     - si cette cha\8cne est vide *)\r
 407 \r
 408    BEGIN\r
 409      if (contenu=none) then exit fi;\r
 410 \r
 411      if ( position < upper(contenu) ) then position := position +1 fi;\r
 412    END Suivant;\r
 413 \r
 414 \r
 415    (**********************************************************************)\r
 416    (******************* D\82claration de l'UNIT Precedent ******************) \r
 417    (**********************************************************************)\r
 418    (** On d\82cr\82mente la variable position rep\82rant la position courante **) \r
 419    (************************ du tableau contenu  *************************)\r
 420    (**********************************************************************)\r
 421    \r
 422    \r
 423    UNIT Precedent : procedure ;\r
 424 \r
 425 (* On d\82cr\82mente simplement la variable position, sauf si :\r
 426     - on est au d\82but de la cha\8cne de caract\8ares\r
 427     - si cette cha\8cne est vide *)\r
 428     \r
 429     BEGIN\r
 430      if (contenu=none)\r
 431      then exit\r
 432      fi;\r
 433      if ( position <> 1 )\r
 434      then position := position -1\r
 435      fi;\r
 436 \r
 437    END Precedent;\r
 438 \r
 439 \r
 440    (**********************************************************************)\r
 441    (******************* D\82claration de l'UNIT Majuscule ******************) \r
 442    (**********************************************************************)\r
 443    (* On transforme les lettres minuscules du tableau contenu en lettres *)\r
 444    (******** majuscules sur une longueur d\82finie par l'utilisateur *******)\r
 445    (**********************************************************************)\r
 446 \r
 447 (*****************************************************************************\r
 448    \r
 449    Si la cha\8cne de caract\8ares est vide, le traitement est inutile.    \r
 450    Sur une longueur l, on va transformer les lettres minuscules en majuscules \r
 451    pour la proc\82dure Majuscule, et les lettres majuscules en minuscules pour\r
 452    la proc\82dure Minuscules.\r
 453    Pour ces deux traitements l'algorithme est le m\88me sauf pour la conversion. \r
 454    Il repose sur la constatation suivante :\r
 455     \r
 456     - la conversion ne marche que pour les lettres alphab\82tiques \85 savoir :\r
 457       * de 'a'..'z' pour la proc\82dure Majuscule\r
 458       * de 'A'..'Z' pour la proc\82dure Minuscule \r
 459     \r
 460     - les caract\8ares ascii ont une valeur d\82cimale\r
 461       * de 65 --> 90  pour 'A' --> 'Z'\r
 462       * de 97 --> 122 pour 'a' --> 'z'\r
 463    \r
 464     - le passage, pour la valeur d\82cimale du code ascii, :\r
 465       * d'une lettre Majuscule \85 une lettre Minuscule est de +32 \r
 466       * d'une lettre Minuscule \85 une lettre Majuscule est de -32 \r
 467 \r
 468     - Deux fonctions sont disponibles en loglan, avec int un entier (INTEGER)\r
 469       et chr un caract\8are (CHAR)\r
 470       * chr(int) = car : retourne le caract\8are car du code ascii int.\r
 471       * ord(car) = int : retourne le code ascii int du caract\8ate car.\r
 472 \r
 473    Il suffit donc, suivant la proc\82dure appel\82, de v\82rifier si le caract\8are\r
 474    correspond bien \85 l'intervalle \85 traiter, puis de faire la conversion, \85\r
 475    savoir r\82cup\82rer le code ascii du caract\8are et de lui ajouter ou retancher\r
 476    32 et de reconvertir dans le caract\8are correspondant \85 cette nouvelle va-\r
 477    leur calcul\82e. \r
 478 \r
 479 *****************************************************************************)\r
 480 \r
 481 \r
 482    UNIT Majuscule : procedure(l:integer);\r
 483     \r
 484     VAR i,pos,value : integer;\r
 485 \r
 486     BEGIN\r
 487      \r
 488      if (contenu=none) then exit fi;\r
 489      \r
 490      pos := position;\r
 491      \r
 492      for i:=1 to l do\r
 493      if (pos>upper(contenu)) then exit fi;\r
 494       \r
 495      value := ord(contenu(pos));\r
 496      if ((value>=97) and (value<=122)) then contenu(pos) := chr(value-32) fi;\r
 497      pos := pos + 1;\r
 498      \r
 499      od;\r
 500 \r
 501    END Majuscule;\r
 502 \r
 503 \r
 504    (**********************************************************************)\r
 505    (******************* D\82claration de l'UNIT Minuscule ******************) \r
 506    (**********************************************************************)\r
 507    (* On transforme les lettres majuscules du tableau contenu en lettres *)\r
 508    (*******  minuscules sur une longueur d\82finie par l'utilisateur  ******)\r
 509    (**********************************************************************)\r
 510  \r
 511 \r
 512    UNIT Minuscule : procedure(l:integer);\r
 513     \r
 514              (* voir explication dans la unit Majuscule *)\r
 515 \r
 516    VAR i,pos,value : integer;\r
 517 \r
 518    BEGIN\r
 519      if (contenu=none) then exit fi;\r
 520 \r
 521      pos := position;\r
 522      for i:=1 to l do\r
 523       if (pos>upper(contenu)) then exit fi;\r
 524 \r
 525       value := ord(contenu(pos));\r
 526       if ((value>= 65) and (value<=90)) then contenu(pos) := chr(value+32) fi;\r
 527 \r
 528       pos := pos + 1;\r
 529      od;\r
 530    END Minuscule;\r
 531 \r
 532 \r
 533    (**********************************************************************)\r
 534    (*************** D\82claration de l'UNIT Position_courante **************) \r
 535    (**********************************************************************)\r
 536    (****** On transmet la position courante dans le tableau contenu ******)\r
 537    (**********************************************************************)\r
 538    \r
 539    \r
 540    UNIT Position_courante : function : integer;\r
 541     \r
 542 (* On retourne la valeur de la position courante du type concern\82. Il suffit     \r
 543    de donner la valeur de la variable position. Si la cha\8cne concern\82e est \r
 544    vide, on retourne 0 *)\r
 545 \r
 546     BEGIN\r
 547      if (contenu<>none)\r
 548      then result := position\r
 549      else result := 0\r
 550      fi;\r
 551    END Position_Courante;\r
 552 \r
 553 \r
 554    (**********************************************************************)\r
 555    (*************** D\82claration de l'UNIT Nouvelle_Position **************) \r
 556    (**********************************************************************)\r
 557    (******* On change la position courante dans le tableau contenu *******)\r
 558    (**********************************************************************)\r
 559 \r
 560 \r
 561    UNIT Nouvelle_Position : procedure(pos:integer);\r
 562     \r
 563 (* A partir d'une position, repr\82sent\82e par la variable pos donn\82e par l-utili\r
 564    sateur, on repositionne la position courante dans le tableau contenu sur  \r
 565    un autre \82l\82ment de celui-\87i. Cela revient donc \85 affecter \85 la variable\r
 566    position cette valeur pos. \r
 567    Cependant, \r
 568     - Si la cha\8cne est vide ou si la nouvelle position d\82sir\82e est inf\82rieure \r
 569       ou \82gale \85 0, on ne fait rien.\r
 570     - Si la nouvelle position est sup\82rieure \85 la taille de la cha\8cne de ca-\r
 571       ract\8ares, on se positionne sur le dernier \82l\82ment de cette cha\8cne. *)\r
 572 \r
 573    BEGIN\r
 574      if ( (pos <= 0) or (contenu=none) ) then exit fi;\r
 575 \r
 576      if (upper(contenu) < pos)\r
 577      then position := upper(contenu)\r
 578      else position := pos\r
 579      fi;\r
 580    END Nouvelle_Position;\r
 581 \r
 582 \r
 583    (**********************************************************************)\r
 584    (******************** D\82claration de l'UNIT Length ********************) \r
 585    (**********************************************************************)\r
 586    (********** On transmet la longueur dans le tableau contenu ***********)\r
 587    (**********************************************************************)\r
 588 \r
 589 \r
 590    UNIT Length : function : integer;\r
 591   \r
 592 (* On retourne la longueur de la cha\8cne de caract\8ares caract\82risant le type\r
 593    courant. Il suffit de donner la taille de la variable contenu le caract\82-\r
 594    risant, sauf si la cha\8cne est vide, dans quel cas on retourne 0.\r
 595 *)\r
 596 \r
 597    BEGIN\r
 598      if (contenu=none)\r
 599      then result := 0\r
 600      else result := upper(contenu);\r
 601      fi;\r
 602    END Length;\r
 603  \r
 604  \r
 605  END typetext;\r
 606 \r
 607 \r
 608 (****************************************************************************) \r
 609 (*****************  Fin de la D\82claration de l'UNIT TYPETEXT ****************) \r
 610 (****************************************************************************) \r
 611  \r
 612 \r
 613 \r
 614 (****************************************************************************) \r
 615 (************************  Proc\82dures et fonctions  *************************) \r
 616 (****************************************************************************) \r
 617  \r
 618 \r
 619  \r
 620 (***************************************************************************** \r
 621    Cette fonction retourne la valeur d\82cimale correspondant \85 la touche  \r
 622    s\82lectionn\82e                                                           \r
 623 *****************************************************************************) \r
 624  \r
 625 \r
 626  UNIT Inchar : IIUWgraph function : integer;\r
 627   \r
 628   VAR i:integer;\r
 629    \r
 630    BEGIN\r
 631     do\r
 632      i:=inkey;\r
 633      if (i<>0) then exit fi;\r
 634     od;\r
 635     result := i;\r
 636  \r
 637  END Inchar;\r
 638  \r
 639 \r
 640 (***************************************************************************** \r
 641                       Cette proc\82dure efface l'\82cran\r
 642 *****************************************************************************)\r
 643  \r
 644 \r
 645  UNIT clear : procedure ;\r
 646   BEGIN\r
 647    write(chr(27),"[2J"); \r
 648  END clear;\r
 649 \r
 650 \r
 651 (***************************************************************************** \r
 652      Cette proc\82dure positionne le curseur l'\82cran em mode texte (80 x 25)\r
 653 *****************************************************************************)\r
 654 \r
 655 \r
 656  UNIT SetCursor : procedure(row,column : integer);\r
 657   VAR c,d,e,f : char,\r
 658       i,j     : integer;  \r
 659    BEGIN   \r
 660       i := row div 10;\r
 661       j := row mod 10;\r
 662       c := chr(48+i);\r
 663       d := chr(48+j);\r
 664       i := column div 10;\r
 665       j := column mod 10; \r
 666       e := chr(48+i);\r
 667       f := chr(48+j);\r
 668       write(chr(27),"[",c,d,";",e,f,"H");\r
 669   END SetCursor;\r
 670 \r
 671 \r
 672 (***************************************************************************** \r
 673 \r
 674                 Cette proc\82dure initialise l'\82cran. Elle :  \r
 675                 - affiche le menu\r
 676                 - pr\82pare l'\82cran pour y \82crire les diff\82rents r\82sultats\r
 677 \r
 678 *****************************************************************************) \r
 679   \r
 680 \r
 681   UNIT initialisation : procedure ; \r
 682    \r
 683   VAR i,j : integer; \r
 684   \r
 685    BEGIN \r
 686    \r
 687     call clear;\r
 688    \r
 689     write("É");\r
 690     for i:=1 to 78 do write("Í") od;\r
 691     write("»");\r
 692     writeln("  1. Saisie du TEXTE1                2. Saisie du TEXTE2");\r
 693     writeln("  3. Longueur du TEXTE1              4. Concat\8ane le TEXTE1 avec le TEXTE2");\r
 694     writeln("  a. Position courante dans TEXTE1   n. Nouvelle position dans TEXTE1");\r
 695     writeln("  s. Position suivante dans TEXTE1   p. Position pr\82c\82dente dans TEXTE1");\r
 696     writeln("  c. Copie une cha\8cne du TEXTE1      d. Supression d'une cha\8cne dans TEXTE1");\r
 697     writeln("  i. Insertion d'une cha\8cne dans TEXTE1");\r
 698     writeln("  u. Conversion de majuscules en minuscules");     \r
 699     writeln("  m. Conversion de minuscules en majuscules                    ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍ");\r
 700     writeln("  r. Recherche la position d'une cha\8cne dans TEXTE1            º ESC. Quitter ");\r
 701     write("È");\r
 702     for i:=1 to 78 do write("Í") od;   \r
 703     write("¼");\r
 704     for j:=0 to 1 do\r
 705      for i:=0 to 8 do\r
 706       call setcursor(2+i,1+79*j);\r
 707       write("º");\r
 708      od;\r
 709     od;\r
 710                                 \r
 711     call setcursor(12,1);\r
 712     write("Question : ");\r
 713 \r
 714     call setcursor(15,1); \r
 715     write("R\82sultat : ");    \r
 716    \r
 717     call setcursor(17,1);\r
 718     writeln("TEXTE1");                     \r
 719     for i := 1 to 80 do write("Ä") od;  \r
 720     call setcursor(23,1);\r
 721     for i := 1 to 80 do write("Ä") od; \r
 722     \r
 723     call setcursor(24,32);            \r
 724     writeln("Votre choix : ");     (* attente d'un choix du menu *)\r
 725     call SetCursor(24,46);                 \r
 726     \r
 727   END initialisation;\r
 728 \r
 729 \r
 730 (*****************************************************************************  \r
 731 \r
 732         Cette proc\82dure affiche certains messages et r\82initialise l'\82cran \r
 733         pour pouvoir y afficher les prochains r\82sultats\r
 734 \r
 735 *****************************************************************************)  \r
 736   \r
 737   \r
 738   UNIT reinitialisation : procedure(inout choix:integer);\r
 739 \r
 740    VAR i : integer;\r
 741    \r
 742     BEGIN \r
 743    \r
 744      if ( (choix=49) or (choix=52) or (choix=100) or (choix=105) \r
 745            or (choix=109) or (choix=117) )\r
 746      then\r
 747       call setcursor(19,1);\r
 748       for i:=1 to 150 do write(" ") od;\r
 749       call setcursor(19,1);\r
 750       if (t1<>none) then call t1.ecrire fi;\r
 751       call SetCursor(15,12);\r
 752       write("Voir TEXTE1");\r
 753      fi;\r
 754      \r
 755      call SetCursor(24,46); \r
 756      writeln(" ");\r
 757      call SetCursor(24,46);\r
 758      choix := inchar;\r
 759      writeln(chr(choix));\r
 760     \r
 761      call setcursor(12,11);\r
 762      for i := 1 to 180 do write(" ") od;\r
 763      call setcursor(15,12);\r
 764      for i := 1 to 80 do write(" ") od;\r
 765 \r
 766   END reinitialisation;\r
 767 \r
 768  \r
 769 (**************************************************************************** \r
 770         \r
 771         Cette proc\82dure traite la demande de l'utilsateur et appelle donc\r
 772         les proc\82dures ou fonctions correspondantes.\r
 773         On travaille sur le code ascii des touches s\82lectionn\82es.\r
 774 \r
 775         27   ---> touche ESC\r
 776         49   ---> touche 1\r
 777         50   ---> touche 2\r
 778         51   ---> touche 3\r
 779         52   ---> touche 4\r
 780         97   ---> touche a\r
 781         99   ---> touche c\r
 782         100  ---> touche d\r
 783         105  ---> touche i\r
 784         109  ---> touche m\r
 785         110  ---> touche n\r
 786         112  ---> touche p\r
 787         114  ---> touche r\r
 788         115  ---> touche s\r
 789         117  ---> touche u\r
 790 \r
 791 *****************************************************************************)  \r
 792 \r
 793   \r
 794   UNIT traiter_choix : procedure ; \r
 795    \r
 796    VAR posit,num,choix : integer,\r
 797        s:string;\r
 798    \r
 799    BEGIN\r
 800 \r
 801    choix := inchar;\r
 802    write(chr(choix));\r
 803    \r
 804    do \r
 805     \r
 806     call setcursor(12,12);  \r
 807     \r
 808     case choix \r
 809      \r
 810      when 27  : call clear;\r
 811                 return;\r
 812 \r
 813      when 49  : writeln("Saisie de TEXTE1");\r
 814                 call setcursor(19,1);\r
 815                 t1 := new typetext;\r
 816                 call t1.Lecture(0);                 \r
 817 \r
 818      when 50  : writeln("Saisie de TEXTE2");\r
 819                 call SetCursor(15,12);\r
 820                 t2 := new typetext;\r
 821                 call t2.Lecture(0);\r
 822 \r
 823      when 51  : writeln("Longueur de TEXTE1");\r
 824                 call SetCursor(15,12);\r
 825                 if (t1=none) \r
 826                 then writeln('0')\r
 827                 else writeln(t1.length)\r
 828                 fi;\r
 829 \r
 830      when 52  : writeln("Concat\8ane TEXTE1 avec TEXTE2");\r
 831                 call setcursor(19,1);  \r
 832                 if (t1=none) then t1:=t2 \r
 833                 else call t1.concat(t2) fi;\r
 834      \r
 835      when 97  : writeln("Position courante dans TEXTE1");\r
 836                 call SetCursor(15,12);\r
 837                 if (t1=none)\r
 838                 then writeln("0")\r
 839                 else writeln(t1.Position_Courante)\r
 840                 fi;\r
 841 \r
 842      when 99  : Writeln("Copie une cha\8cne de TEXTE1");\r
 843                 Writeln("Donnez la longueur de la cha\8cne \85 retourner : ");\r
 844                 call Setcursor(13,47);\r
 845                 readln(num);\r
 846                 call SetCursor(15,12);\r
 847                 if (t1<>none)\r
 848                 then\r
 849                   t3 := t1.Copie(num);\r
 850                   if (t3<>none) \r
 851                   then call t3.ecrire \r
 852                   else writeln("Cha\8cne vide")\r
 853                   fi;\r
 854                 else writeln("Cha\8cne vide");\r
 855                 fi;\r
 856 \r
 857      when 100 : Writeln("Suppression d'une cha\8cne de TEXTE1");\r
 858                 Writeln("Donnez la longueur de la cha\8cne \85 supprimer : ");\r
 859                 call SetCursor(13,47);\r
 860                 readln(posit);\r
 861                 if (t1<>none) \r
 862                 then call t1.delete(posit); \r
 863                 fi;\r
 864      \r
 865      when 105 : Writeln("Ins\82rer une cha\8cne dans TEXTE1");\r
 866                 Writeln("Entrez la cha\8cne \85 ins\82rer : ");\r
 867                 call SetCursor(13,30);\r
 868                 t3 := new typetext;\r
 869                 call t3.Lecture(0);\r
 870                 call SetCursor(15,12);\r
 871                 if (t1<>none)\r
 872                 then call t1.Insert(t3)\r
 873                 else t1 := t3\r
 874                 fi;\r
 875 \r
 876      when 109 : Writeln("Conversion de lettres minuscules en majuscules");\r
 877                 Writeln("Donnez la longueur de la cha\8cne \85 modifier : ");\r
 878                 call SetCursor(13,46);\r
 879                 readln(num);\r
 880                 if (t1<>none) \r
 881                 then call t1.majuscule(num);\r
 882                 fi;\r
 883                              \r
 884      when 110 : writeln("Saisie de la nouvelle position dans TEXTE1");         \r
 885                 writeln("Donnez la nouvelle position : ");\r
 886                 call SetCursor(13,31);\r
 887                 if (t1<>none)\r
 888                 then\r
 889                  readln(posit);\r
 890                  call t1.Nouvelle_Position(posit); \r
 891                  call SetCursor(15,12);  \r
 892                  writeln(t1.position);\r
 893                 else writeln("Texte1 non d\82fini");\r
 894                 fi;\r
 895 \r
 896      when 112 : writeln("Position pr\82c\82dente \85 la position courante dans TEXTE1"); \r
 897                 call SetCursor(15,12);\r
 898                 if (t1<>none)\r
 899                 then\r
 900                   call t1.Precedent;\r
 901                   writeln(t1.position);\r
 902                 else\r
 903                   writeln("0");\r
 904                 fi;\r
 905      \r
 906      when 115 : writeln("Position suivante \85 la position courante dans TEXTE1");\r
 907                 call SetCursor(15,12); \r
 908                 if (t1<>none)\r
 909                 then\r
 910                   call t1.Suivant;\r
 911                   writeln(t1.position);  \r
 912                 else\r
 913                   writeln("0");\r
 914                 fi;\r
 915          \r
 916      when 114 : writeln("Recherche de la position d'une sous-cha\8cne dans TEXTE1");\r
 917                 writeln("Donnez la valeur de la sous-cha\8cne : ");\r
 918                 call SetCursor(13,38);\r
 919                 if (t1<>none) \r
 920                 then \r
 921                   t3 := new typetext;\r
 922                   call t3.Lecture(0);\r
 923                   num := t1.Rechercher_Position(t3);\r
 924                   call SetCursor(15,12);  \r
 925                   writeln(num);\r
 926                 else writeln("TEXTE1 non d\82fini");\r
 927                 fi;\r
 928 \r
 929      when 117 : writeln("Conversion de lettres majuscules en minuscules");\r
 930                 writeln("Donnez la longueur de la cha\8cne \85 modifier : "); \r
 931                 call SetCursor(13,46);\r
 932                 readln(num);\r
 933                 if (t1<>none) \r
 934                 then call t1.minuscule(num);\r
 935                 fi;\r
 936 \r
 937      otherwise  writeln("Mauvaise touche");;\r
 938 \r
 939     esac;\r
 940    \r
 941    call reinitialisation(choix);\r
 942 \r
 943    od;\r
 944   \r
 945   END traiter_choix;\r
 946 \r
 947 \r
 948 (****************************************************************************)  \r
 949 \r
 950 \r
 951 \r
 952 (****************************************************************************)  \r
 953 (*                            PROGRAMME PRINCIPAL                           *)\r
 954 (****************************************************************************)  \r
 955 \r
 956  \r
 957  VAR t1,t2,t3 : typetext;       \r
 958 \r
 959  BEGIN\r
 960    \r
 961    call initialisation;       (* affichage du menu *)\r
 962    call traiter_choix;        (* traitement de la demande de l'utilisateur *)\r
 963   \r
 964  END TYPETEXT;\r
 965 \r
 966 \r
 967 (****************************************************************************)  \r
 968 \r
 969    \r
 970   \r
 971   \r
 972 \r