Topspeed_JPI/JPI-1/mod/nanotex5.mod

MODULE nanotext;

FROM Storage  IMPORT ALLOCATE , DEALLOCATE;
IMPORT Lib,Str,IO,Window,FIO;

TYPE    t_ptr_t_element         =       POINTER TO t_element;
        t_element               =       CLASS

        ptr_suivant   : t_ptr_t_element;
        ptr_precedent : t_ptr_t_element;

        PROCEDURE affiche_element () ; VIRTUAL;
         BEGIN
          (* … impl‚menter par les objets fils *)
         END affiche_element;

        PROCEDURE detruit_element () ; VIRTUAL;
         BEGIN
          (* … impl‚menter par les objets fils *)
         END detruit_element;

                                        END;  (* CLASS t_element *)


 TYPE   t_liste         =       CLASS

        debut       : t_ptr_t_element;
        ptr_courant : t_ptr_t_element;

        PROCEDURE creer() ;

         BEGIN
          debut         := NIL;
          ptr_courant   := NIL;
         END creer;


        PROCEDURE premier () : t_ptr_t_element ;

         BEGIN
          RETURN  debut;
         END premier;

        PROCEDURE au_debut () ;
         (* d‚place le pointeur courant au d‚but de la liste *)
         BEGIN
          ptr_courant := debut;
         END au_debut;

        PROCEDURE suivant () : t_ptr_t_element;

         BEGIN
          RETURN ptr_courant^.ptr_suivant;
         END suivant;

        PROCEDURE a_la_fin ();
         (* d‚place le pointeur courant en queue de liste *)
         BEGIN
          WHILE suivant() <> NIL DO
           ptr_courant := ptr_courant^.ptr_suivant;
          END;
         END a_la_fin;

        PROCEDURE au_suivant ();
         (* d‚place le pointeur courant au paragraphe suivant si possible *)
         BEGIN
          IF suivant() <> NIL THEN
           ptr_courant := suivant();
          END;
         END au_suivant;

        PROCEDURE precedent () : t_ptr_t_element;

         BEGIN
          RETURN ptr_courant^.ptr_precedent;
         END precedent;

        PROCEDURE au_precedent ();
         (* d‚place le pointeur courant au paragraphe precedent si possible *)
         BEGIN
          IF precedent() <> NIL THEN
           ptr_courant := precedent();
          END;
         END au_precedent;

        PROCEDURE dernier   ():t_ptr_t_element;

         BEGIN
          au_debut();
          WHILE suivant() <> NIL DO
           au_suivant();
          END;
          RETURN ptr_courant;
         END dernier;


        PROCEDURE liste_vide():BOOLEAN ;

         BEGIN
          RETURN debut = NIL;
         END liste_vide;


        PROCEDURE ajouter ( VAR y : t_element);

         VAR l_ptr_element : t_ptr_t_element;

        (* on ajoute en fin de liste :
           2 cas : liste vide
                 : liste non vide
         *)

         BEGIN
          ALLOCATE(l_ptr_element,SIZE(y));
          Lib.Move(ADR(y),l_ptr_element,SIZE(y));
          IF liste_vide() THEN   (* cas du debut de liste vide *)
           debut := l_ptr_element;
           ptr_courant := l_ptr_element ;
           ptr_courant^.ptr_precedent := NIL;
           ptr_courant^.ptr_suivant := NIL;
          ELSE                    (* ajout en fin de liste *)
           l_ptr_element^.ptr_suivant := NIL;
           l_ptr_element^.ptr_precedent := ptr_courant;
           ptr_courant^.ptr_suivant := l_ptr_element;
           ptr_courant := l_ptr_element;
          END;
         END ajouter;



        PROCEDURE inserer   (VAR y : t_element);

        (* On insŠre AVANT le pointeur courant !!!!!!!!! *)
        (* 2 cas : insertion en d‚but de liste
                   insertion au milieu de liste

                                                         *)
         VAR l_ptr_element : t_ptr_t_element;

         BEGIN
          ALLOCATE(l_ptr_element,SIZE(y));
          Lib.Move(ADR(y),l_ptr_element,SIZE(y));
          IF ptr_courant^.ptr_precedent = NIL THEN    (* cas du d‚but de liste non vide *)
           debut := l_ptr_element;
           l_ptr_element^.ptr_precedent := NIL;
           l_ptr_element^.ptr_suivant := ptr_courant;
           ptr_courant^.ptr_precedent := l_ptr_element;
           ptr_courant := debut^.ptr_suivant;
          ELSE     (* cas du milieu de liste *)
           ptr_courant^.ptr_precedent^.ptr_suivant := l_ptr_element;
           l_ptr_element^.ptr_suivant := ptr_courant;
           l_ptr_element^.ptr_precedent := ptr_courant^.ptr_precedent;
           ptr_courant^.ptr_precedent := l_ptr_element;
           ptr_courant := l_ptr_element^.ptr_suivant;
          END; (* IF *)
         END inserer;

        PROCEDURE inserer_liste ( VAR x : t_liste);

         BEGIN
         END inserer_liste;


        PROCEDURE detruire  ();

        (* on detruit l'element du pointeur courant *)

         VAR l_ptr_element,ll_ptr_element : t_ptr_t_element;

         BEGIN
          ptr_courant^.detruit_element;
          IF ptr_courant^.ptr_precedent = NIL THEN
          (* cas du premier element de la liste **)
          (* 2 cas : liste compos‚e d'un element
                   : liste composee de plusieurs elements *)
            IF ptr_courant^.ptr_suivant = NIL THEN
             DEALLOCATE(ptr_courant,SIZE(ptr_courant^));
             debut := NIL;
             ptr_courant := NIL;
            ELSE
             ptr_courant := ptr_courant^.ptr_suivant;
             ptr_courant^.ptr_precedent := NIL;
             DEALLOCATE(debut,SIZE(debut^));
             debut := ptr_courant;
            END; (* IF *)
           ELSIF ptr_courant^.ptr_suivant = NIL THEN
           (* cas d'un ‚l‚ment en fin de liste *)
            ptr_courant := ptr_courant^.ptr_precedent;
            DEALLOCATE(ptr_courant^.ptr_suivant,SIZE(ptr_courant^.ptr_suivant^));
            ptr_courant^.ptr_suivant := NIL;
           ELSE
           (* cas g‚n‚ral d'un ‚l‚ment au milieu de liste *)
           l_ptr_element := ptr_courant^.ptr_suivant;
           l_ptr_element^.ptr_precedent := ptr_courant^.ptr_precedent;
           ptr_courant^.ptr_precedent^.ptr_suivant := l_ptr_element;
           DISPOSE(ptr_courant);
           ptr_courant := l_ptr_element;
          END ;   (* IF *)
         END detruire;

                           END; (* CLASS t_liste *)

 TYPE   t_ptr_t_paragraphe      =       POINTER TO t_paragraphe;
        t_paragraphe            =       CLASS (t_element)

          longueur      :       CARDINAL;
          ptr_chaine    :       ADDRESS;

          PROCEDURE initialise_element ( VAR x : ARRAY OF CHAR);VIRTUAL;

           BEGIN
            longueur := Str.Length(x);
            ALLOCATE(ptr_chaine,longueur);
            Lib.Move(ADR(x),ptr_chaine,longueur);
           END initialise_element;

          PROCEDURE affiche_element (); VIRTUAL;

            VAR l_tampon : ARRAY[0..1023] OF CHAR;

           BEGIN
            Lib.Move(ptr_chaine,ADR(l_tampon),longueur);
            l_tampon[longueur] := CHR(0);
            IO.WrStr(l_tampon);
            IO.WrLn;
           END affiche_element;

          PROCEDURE detruit_element () ; VIRTUAL;

            BEGIN
             DEALLOCATE(ptr_chaine,SIZE(ptr_chaine^));
            END detruit_element;

                                        END; (* CLASS t_paragraphe *)

     (* le tampon est notre zone de travail : c'est dans lui que seront
        faites toutes les insertions et destructions , recherches ;
        donc le test des touches frapp‚es au clavier vont provoquer
        le transfert dans le tampon de notre paragraphe, et toutes les
        modifications se feront dans celui-ci; ceci nous procure en
        plus une fonction UNDO facile car le texte original n'est pas
        modifi‚ tant que le transfert inverse n'est pas r‚alis‚.
        Nous pourons sauvegarder toutes nos modifications dans une
        liste que nous pourrons ‚diter ou sauvegarder … souhait *)



 TYPE  (*  t_ptr_t_tampon  =       POINTER TO t_tampon;*)
        t_tampon        =       CLASS (t_paragraphe)

         position               :       CARDINAL;
         sauve_ptr_suivant      :       t_ptr_t_element;
         suve_ptr_precedent     :       t_ptr_t_element;

         PROCEDURE initialise_element ( VAR x : ARRAY OF CHAR ) ; VIRTUAL ;
          BEGIN
           (* notre tampon est un paragraphe particulier d'une taille
              de 32 Kilo-octets *)
           longueur := Str.Length(x);
           ALLOCATE(ptr_chaine,32*1024-1);
           Lib.Fill(ptr_chaine,32*1024-1,0);
           Lib.Move(ADR(x),ptr_chaine,longueur);
          END initialise_element;

         PROCEDURE insere ( x : ARRAY OF CHAR );

          VAR adresse1,adresse2 : ADDRESS;

          BEGIN
           adresse1 := Lib.AddAddr(ptr_chaine,position-1);
           IF position <= longueur THEN
            adresse2 := Lib.AddAddr(adresse1,Str.Length(x));
            Lib.Move(adresse1,adresse2,longueur-position+1);
           INC(longueur,Str.Length(x));
            Lib.Move(ADR(x),adresse1,Str.Length(x));
           ELSE
            adresse2 := Lib.AddAddr(ptr_chaine,longueur);
            Lib.Move(ADR(x),adresse1,Str.Length(x));
            Lib.Fill(adresse2,position-longueur-1,020H);
            longueur := position + Str.Length(x);
           END;
          END insere;

        PROCEDURE remplace ( x : ARRAY OF CHAR );

         VAR adresse : ADDRESS;

         BEGIN
          adresse := Lib.AddAddr(ptr_chaine,position-1);
          Lib.Move(ADR(x),adresse,Str.Length(x));
         END remplace;


        PROCEDURE detruit ( x : CARDINAL );

          VAR adresse1,adresse2 : ADDRESS;

          BEGIN
           adresse1 := Lib.AddAddr(ptr_chaine,position + x - 1);
           adresse2 := Lib.AddAddr(ptr_chaine,position-1);
           Lib.Move(adresse1,adresse2,longueur-position);
           adresse1 := Lib.AddAddr(ptr_chaine,longueur);
           Lib.Fill(adresse1,x,0);
           DEC(longueur,x);
          END detruit;

                                END; (* CLASS t_tampon *)

TYPE    t_fenetre       =       RECORD
                                 x1,y1,x2,y2 : CARDINAL;
                                 posx,posy   : CARDINAL;
                                END;
        t_parametres    =       RECORD
                                 longueur_page          : CARDINAL;
                                 largeur_ligne          : CARDINAL;
                                 marge_haute            : CARDINAL;
                                 marge_basse            : CARDINAL;
                                 marge_droite           : CARDINAL;
                                 marge_gauche           : CARDINAL;
                                 largeur_tabulation     : CARDINAL;
                                 entete                 : BOOLEAN;
                                 bas_de_page            : BOOLEAN;
                                END;


 TYPE   t_ptr_t_paragraf=       POINTER TO t_paragraf;
        t_paragraf      =       CLASS (t_paragraphe)

        PROCEDURE affiche_element(); VIRTUAL ;

         (*le texte contenu dans notre paragraphe est d‚j… justifi‚ *)

         TYPE   l_ptr_tampon    =       POINTER TO l_t_tampon;
                l_t_tampon      =       ARRAY[0..32*1024-1] OF CHAR;

         VAR    l_tampon        :       l_ptr_tampon;
                l_chaine        :       ARRAY[0..255] OF CHAR;
                i               :       CARDINAL;

         BEGIN
          NEW(l_tampon);
          Lib.Move(ptr_chaine,l_tampon,longueur);
          l_tampon^[longueur] := CHR(0);
          i := 0;
          LOOP
           Str.Slice(l_chaine,l_tampon^,i,30);
           IO.WrStr(l_chaine);
           IO.WrLn;
           IF Str.Length(l_chaine)< 30 THEN EXIT
           END;
           INC(i,30);
          END;
          DISPOSE(l_tampon);
         END affiche_element;

                                 END; (* class t_paragraf *)


 TYPE   t_ptr_t_texte   =       POINTER TO t_texte;
        t_texte         =       CLASS (t_liste)

        tampon          :       t_tampon;
        fenetre         :       t_fenetre;
        parametres      :       t_parametres;

        PROCEDURE initialise_texte( VAR x : t_fenetre;
                                    VAR y : t_parametres);

         BEGIN
          creer;
         END initialise_texte;

        PROCEDURE affiche_element();VIRTUAL;
         BEGIN
         END affiche_element;

        PROCEDURE transfert_avant(); VIRTUAL;

         BEGIN
         END transfert_avant;

        PROCEDURE transfert_arriere(); VIRTUAL;

         BEGIN
         END transfert_arriere;

        PROCEDURE page_up(); VIRTUAL;

         BEGIN
         END page_up;

        PROCEDURE page_down(); VIRTUAL;

         BEGIN
         END page_down;

        PROCEDURE affiche_page(); VIRTUAL;

         BEGIN
         END affiche_page;

                                END; (* CLASS t_texte *)
 PROCEDURE attente;
  BEGIN
   REPEAT UNTIL IO.KeyPressed();
  END attente;


VAR ma_liste : t_liste;
    el       : t_paragraf;

 VAR    fichier         : FIO.File;
        buffer          : ARRAY[0..10000] OF CHAR;
        car             : CHAR;

 PROCEDURE affiche;

     VAR g : t_ptr_t_paragraphe;

  BEGIN
     ma_liste.au_debut();
     REPEAT
      ma_liste.ptr_courant^.affiche_element();
      ma_liste.au_suivant();
     UNTIL ma_liste.suivant() = NIL;
     ma_liste.ptr_courant^.affiche_element();
   END affiche;

 PROCEDURE message (x : ARRAY OF CHAR);

   BEGIN
    Lib.Delay(5000);
    Window.Clear;
    IO.WrStr(x);
    IO.WrLn;
   END message;

BEGIN           (* principal *)
 (************** CREATION DE LA LISTE ****************)
 ma_liste.creer();
 (************** on remplit la liste *****************)
 message(" ON REMPLIT LA LISTE ");
 fichier := FIO.Open("c:\mii\mod.mod\texte1.MOD");
 FIO.EOF := FALSE;
 FIO.RdStr(fichier,buffer);
 WHILE NOT FIO.EOF DO
  el.initialise_element(buffer);
  ma_liste.ajouter(el);
  FIO.RdStr(fichier,buffer);
 END;
 (************ on parcoure la liste en avant **********)
 message(" ON parcoure LA LISTE en avant");
 affiche;
 attente;
 message(" Fin du programme");
 FIO.Close(fichier);
END nanotext.