Topspeed_JPI/JPI-1/mod/ed.mod

MODULE ED;


(* petit ‚diteur de texte sur une page pour les enfants *)


IMPORT IO,Window,Lib,SYSTEM,FIO,AsmLib,Str;


  VAR i : CARDINAL;
      car :CHAR;
      texte : ARRAY[1..23] OF ARRAY[0..39] OF CHAR;
      la_page:BYTE;
      x_texte,y_texte : CARDINAL;



 PROCEDURE MODE(x:BYTE);

   VAR r : SYSTEM.Registers;

  BEGIN
   r.AH := 0;
   r.AL := x;
   Lib.Intr(r,10H);
  END MODE;

 PROCEDURE page(x:BYTE);

    VAR r : SYSTEM.Registers;


 BEGIN
  la_page := x;
  r.AH := 5H;
  r.AL := x;
  Lib.Intr(r,10H);
 END page;


 PROCEDURE XGotoXY(x,y:CARDINAL);

  BEGIN
   IF ODD(y) THEN
              y :=( y DIV 2 ) + 1
             ELSE
              x := x + 40;
              y := y DIV 2;
   END;
   Window.GotoXY(x,y);
  END XGotoXY;

 PROCEDURE GotoXY(x,y:BYTE);

   VAR r : SYSTEM.Registers;

  BEGIN
      WITH r DO
        AH := 2;
        BH := la_page;
        DL := x;
        DH := y;
      END;
   Lib.Intr(r,10H);
  END GotoXY;

 PROCEDURE WrChar(a:CHAR;couleur:BYTE);

   VAR r : SYSTEM.Registers;

  BEGIN
    WITH r DO
     AL := BYTE(a);
     BH := la_page;
     BL := couleur;
     AH := 0EH;
     Lib.Intr(r,10H);
    END;
   END WrChar;

 PROCEDURE WrStr(x : ARRAY OF CHAR;couleur:BYTE);

        VAR i : CARDINAL;

  BEGIN
   i := 0;
   REPEAT
    WrChar(x[i],couleur);
    INC(i);
   UNTIL ( i = Str.Length(x) ) OR ( x[i] = CHR(0) )
  END WrStr;

 PROCEDURE WrCharRep(x : CHAR; nombre:CARDINAL;couleur:BYTE);

  VAR i : CARDINAL;

  BEGIN
   FOR  i := 1 TO nombre DO
    WrChar(x,couleur);
   END;
  END WrCharRep;

 PROCEDURE RdChar():CHAR;

  VAR r : SYSTEM.Registers;

  BEGIN
   WITH r DO
    AH :=1;
    Lib.Intr(r,21H);
    RETURN CHAR(AL);
   END;
  END RdChar;

 PROCEDURE RdKey():CHAR;

  VAR r : SYSTEM.Registers;

  BEGIN
   WITH r DO
    AH :=7;
    Lib.Intr(r,21H);
    RETURN CHAR(AL);
   END;
  END RdKey;


 VAR fichier:FIO.File;


VAR INSERT : BOOLEAN;

 PROCEDURE ouvre;


  BEGIN
   FIO.IOcheck := FALSE;
   fichier := FIO.Open('fichier.txt');
   IF FIO.IOresult()<>0 THEN fichier := FIO.Create('fichier.txt');
   END;
  END ouvre;


 PROCEDURE debut;

 BEGIN
  Window.Clear;
  GotoXY(5,5);
  WrStr("Bonjour ",1);
  GotoXY(5,7);
  WrStr("Voici un petit ‚diteur !!!!!",1);
  GotoXY(2,20);
  WrStr("Tape une touche pour continuer",1);
  car := RdKey();
 END debut;


PROCEDURE Clear(x:BYTE);

 BEGIN
  AsmLib.Fill([0B800H:0000H],2048,20H);
 END Clear;

PROCEDURE menu;

 VAR l_page : BYTE;
     car    : CHAR;

 BEGIN
  l_page := la_page;
  page(3);
  GotoXY(5,2);
  WrStr(" M e n u    P r i n c i p a l ",1);
  GotoXY(0,7);
  WrCharRep( CHR(205),40,100);
  GotoXY(3,8);
  WrStr(" Fichier      Bloc     Impression  ",1);
  GotoXY(0,9);
  WrCharRep( CHR(205),40,1);
  REPEAT
   car := RdKey();
  UNTIL car = CHR(27);
  page(l_page);
 END menu;

VAR choix : CHAR;
    Ligne,Colonne : ARRAY[0..1] OF CHAR;
    ok : BOOLEAN;

PROCEDURE bip;

 BEGIN
  WrChar(7C,0);
 END bip;

PROCEDURE ligne;

 BEGIN
  GotoXY(0,VAL(BYTE,y_texte));
  WrStr(texte[y_texte],1);
 END ligne;

PROCEDURE xy;

 BEGIN
  GotoXY(VAL(BYTE,x_texte),VAL(BYTE,y_texte));
 END xy;

PROCEDURE bout;

 BEGIN
  IF x_texte > Str.Length(texte[y_texte]) THEN
   x_texte := Str.Length(texte[y_texte]);
  END;
 END bout;

PROCEDURE insere_car;

 VAR l_chaine : ARRAY[0..39] OF CHAR;

 BEGIN
   IF INSERT THEN
      IF Str.Length(texte[y_texte]) < 39 THEN
       Str.Insert(texte[y_texte],car,x_texte);
       INC(x_texte);
       GotoXY(VAL(BYTE,x_texte-1),VAL(BYTE,y_texte));
       Str.Slice(l_chaine,texte[y_texte],x_texte-1,Str.Length(texte[y_texte]));
       WrStr(l_chaine,1);
       xy;
      ELSE bip
      END;
    ELSE
    texte[y_texte][x_texte] := car;
    GotoXY(VAL(BYTE,x_texte),VAL(BYTE,y_texte));
    Str.Slice(l_chaine,texte[y_texte],x_texte,Str.Length(texte[y_texte]));
    WrStr(l_chaine,1);
    xy;
   END;
 END insere_car;

PROCEDURE sud;

 BEGIN
  IF y_texte < 23 THEN
      INC(y_texte);
      bout;
      GotoXY(VAL(BYTE,x_texte),VAL(BYTE,y_texte));
  END;
 END sud;

PROCEDURE nord;

 BEGIN
  IF y_texte > 2 THEN
   DEC(y_texte);
   bout;
   xy;
  END;
 END nord;

PROCEDURE est;

 BEGIN
  IF (x_texte < 39) AND ( x_texte < Str.Length(texte[y_texte]) ) THEN
   INC(x_texte);
   xy;
  END;
 END est;

PROCEDURE ouest;

 BEGIN
  IF x_texte > 0 THEN
   DEC(x_texte);
   xy;
  END;
 END ouest;

PROCEDURE RC;

 BEGIN
  IF y_texte < 23 THEN
   sud;
   xy;
  END;
 END RC;

PROCEDURE affiche_coordonnees;

 BEGIN
   GotoXY(27,0);
   Str.CardToStr(VAL(LONGCARD,y_texte-1),Ligne,10,ok);
   WrStr( Ligne,1);
   Str.CardToStr(VAL(LONGCARD,x_texte+1),Colonne,10,ok);
   GotoXY(38,0);
   WrStr(Colonne,1);
   xy;
 END affiche_coordonnees;


PROCEDURE debut_ligne;

 BEGIN
  x_texte := 0;
  xy;
 END debut_ligne;

PROCEDURE fin_ligne;

 BEGIN
  x_texte := Str.Length(texte[y_texte]);
  xy;
 END fin_ligne;


PROCEDURE backspace;

 VAR l_chaine : ARRAY[0..39] OF CHAR;

 BEGIN
  IF x_texte > 0 THEN
   Str.Delete(texte[y_texte],x_texte-1,1);
   GotoXY(VAL(BYTE,x_texte-1),VAL(BYTE,y_texte));
   Str.Slice(l_chaine,texte[y_texte],x_texte-1,Str.Length(texte[y_texte]));
   WrStr(l_chaine,1);
   WrChar(" ",1);
   DEC(x_texte);
   xy;
  ELSE bip
  END;
 END backspace;

PROCEDURE DEL;

  VAR l_chaine : ARRAY[0..39] OF CHAR;

 BEGIN
  Str.Delete(texte[y_texte],x_texte,1);
   IF x_texte > 0 THEN
     GotoXY(VAL(BYTE,x_texte-1),VAL(BYTE,y_texte));
     Str.Slice(l_chaine,texte[y_texte],x_texte-1,Str.Length(texte[y_texte]));
     WrStr(l_chaine,0);
     WrChar(" ",1);
   ELSE
    WrStr(texte[y_texte],1);
    WrChar(" ",1);
   END;
   xy;
   bout;
 END DEL;



PROCEDURE insertion;

 BEGIN
  INSERT := NOT INSERT;
 END insertion;



BEGIN
 MODE(1);
 page(5);
 debut;
 page(0);
 Clear(0);
 GotoXY(0,0);
 WrStr("F10:MENU Fich:       Ligne:   Colonne:  ",1);
 GotoXY(0,1);
 WrCharRep( CHR(205),40,100);
 x_texte := 0;
 y_texte := 2;
 INSERT := TRUE;
 ligne;
 REPEAT
 affiche_coordonnees;
  car := RdKey();
  CASE car OF
    | 0C  : choix := RdKey();
           CASE choix OF
            | CHR(77) : est;
            | CHR(75) : ouest;
            | CHR(72) : nord;
            | CHR(80) : sud;
            | 104C    : menu;         (* menu *)
        (*    | CHR(59)    : F1 ;         (* aide *)
            | CHR(60)    : F2 ;         (* sauvegarde *)
            | CHR(61)    : F3 ;  *)     (* chargement *)
            | CHR(83)    : DEL;  (*
            | CHR(73)    : PGUP;
            | CHR(81)    : PGDN;
            | CHR(71)    : HOME;  (* debut fichier *)
            | CHR(79)    : end;*) (* fin fichier *)
            | CHR(82)    : insertion;
           END;
     | CHR(1)             : debut_ligne;
     | CHR(2)             : fin_ligne;
     | CHR(8)             : backspace;
     | ' ' .. '}'         : insere_car;
     | 15C : RC;
   END;
 UNTIL car = CHR(27);
 MODE(3);
END ED.