Text défilant

Text défilant - Ada - Programmation

Marsh Posté le 17-01-2009 à 13:48:38    

Bonjour
 
Je viens vous proposer un petit code pour le fun. Un programme qui permet de faire défiler un texte sur une ligne. Les lignes les plus intérressantes sont celle numéroté de 77 à 98 dans le corps du paquetage.
 
Vos commentaire sont les bienvenus.
 
main.adb:

Code :
  1. with P_Term;
  2. with Text_Io;
  3. use Text_Io;
  4. procedure Main is
  5.   Char : Character;
  6. begin
  7.   Main_Loop :
  8.       loop
  9.          P_Term.Put_Banner( "Ce que l'homme ne peut faire, Ada s'en chargera." );
  10.          loop
  11.             Get_Immediate(Char);
  12.             if Char = Character'Val(32) then
  13.                P_Term.Free(P_Term.Expression);
  14.                P_Term.Get_Banner(P_Term.Expression);
  15.                if P_Term."/="(P_Term.Expression, null) then
  16.                   P_Term.Put_Banner(P_Term.Expression.all);
  17.                else
  18.                   exit;
  19.                end if;
  20.             elsif Char = Character'Val(101) then
  21.                exit;
  22.             elsif Char = Character'Val(69) then
  23.                exit Main_Loop;
  24.             end if;
  25.          end loop;
  26.       end loop Main_loop;
  27.       P_Term.Finalize;
  28.  
  29. end Main;


 
p_term.ads

Code :
  1. package P_Term is
  2.  
  3.   type String_Access is access all String;
  4.  
  5.   procedure Free (Expression : in out String_Access);
  6.  
  7.   Expression : String_Access;
  8.  
  9.   procedure get_Banner(Expression : out String_Access);
  10.  
  11.   procedure put_Banner(Expression : in String);
  12.  
  13.   procedure Finalize;
  14.  
  15. end P_Term;


p_term.adb:

Code :
  1. with Ada.Text_Io, Ada.Strings, Ada.Strings.fixed;
  2. use Ada.Text_Io, Ada.Strings, Ada.Strings.fixed;
  3. with Ada.Characters.Handling;
  4. use Ada.Characters.Handling;
  5. with Interfaces.C; use Interfaces.C;
  6. with Ada.Unchecked_Deallocation;
  7. package body P_Term is
  8.  
  9.  
  10.   procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation(String, String_Access);
  11.  
  12.   procedure Free (Expression : in out String_Access) is
  13.   begin
  14.      Unchecked_Deallocation(expression);
  15.   end Free;
  16.  
  17.   function System (Cmd : Interfaces.C.Char_Array) return Interfaces.C.int;
  18.   pragma Import (C, System, "system" );
  19.  
  20.   task Screen is
  21.      entry print(Expression : in String);
  22.      entry Stop;
  23.      entry Lock;
  24.   end Screen;
  25.  
  26.   procedure Finalize is
  27.   begin
  28.      Screen.Stop;
  29.   end Finalize;
  30.  
  31.   task body Screen is
  32.  
  33.      Motif : String_Access;
  34.  
  35.      Window : String(1..54) := (others => Character'Val(32));
  36.      Low : Positive;
  37.      High : Natural;
  38.      First, Last : Positive;
  39.      Ret_System : Interfaces.C.Int;
  40.      End_Of_Task : Boolean := False;
  41.      Locker : Boolean := True;
  42.   begin
  43.      while not End_Of_Task loop
  44.         select
  45.            accept print(Expression : in String) do
  46.               Free(Motif);
  47.               Motif := new String ' (Expression);
  48.               First := 1;
  49.               Last := 1;
  50.               Low := 54;
  51.               High := 55;
  52.               Window := (others => Character'Val(32));
  53.               Replace_Slice(Window, Low, high, Motif(first..last), Error, right, Space);
  54.               Locker := False;
  55.            end Print;
  56.         or
  57.            accept Stop do
  58.               End_Of_Task := True;
  59.            end Stop;
  60.         or
  61.            accept Lock do
  62.               Locker := True;
  63.            end Lock;
  64.         or
  65.            delay 0.1;
  66.            if not Locker then
  67.               Ret_System := System (To_C("clear" ));
  68.               Put_Line("                        This program is writed with Ada.                        " );
  69.               New_Line(12);
  70.               Put(10 * Character'Val(32));
  71.               Put_line(60 * Character'Val(45));
  72.  
  73.               if Motif /= null then
  74.                  Put("          -- " );
  75.                  Put(Window);
  76.                  Put_line(" --" );
  77.  
  78.                  if first = Motif'Length then
  79.                     Low := 54;
  80.                     First := 1;
  81.                     Last := 1;
  82.                     Window := (others => Character'Val(32));
  83.                     Replace_Slice(Window, Low, high, Motif(first..last), Error, right, Space);
  84.                  else
  85.  
  86.                     if Last < Motif'Length then
  87.                        Last := Last + 1;
  88.                     end if;
  89.                     if low > 1 then
  90.                        low := low - 1;
  91.  
  92.                     else
  93.                        First := First + 1;
  94.  
  95.                     end if;
  96.                     Replace_Slice(Window, Low, high, Motif(first..last), Error, left, Space);
  97.                  end if;
  98.  
  99.               else
  100.                  Put(10 * Character'Val(32));
  101.                  Put(2 * Character'Val(45));
  102.                  Put(56 * Character'Val(32));
  103.                  Put_line(2 * Character'Val(45));
  104.               end if;
  105.               Put(10 * Character'Val(32));
  106.               Put_line(60 * Character'Val(45));
  107.               New_Line(13);
  108.               Ada.Text_Io.Put("       ** Copyrigth (C) 2009 Manuel De Girardi ; All rigths reserved. **       " );
  109.            end if;
  110.         end select;
  111.      end loop;
  112.   end Screen;
  113.  
  114.  
  115.  
  116.  
  117.   procedure Get_Banner(Expression : out String_Access) is
  118.  
  119.  
  120.      Line : String(1..2000) := (others => Character'Val(32));
  121.      Char : Character;
  122.  
  123.      Window : String(1..54) := (others => Character'Val(32));
  124.      Low : Positive := 1;
  125.      High : Natural := 55;
  126.      First : Positive := 1;
  127.      Length : Natural := 0;
  128.      Ret_System : Interfaces.C.Int;
  129.   begin
  130.      Screen.Lock;
  131.      Ret_System := System (To_C("clear" ));
  132.      New_Line(13);
  133.      Put(10 * Character'Val(32));
  134.      Put_line(60 * Character'Val(45));
  135.      Put(10 * Character'Val(32));
  136.      Put(2 * Character'Val(45));
  137.      Put(56 * Character'Val(32));
  138.      Put_line(2 * Character'Val(45));
  139.      Put(10 * Character'Val(32));
  140.      Put_line(60 * Character'Val(45));
  141.      New_Line(12);
  142.      Ada.Text_Io.Put("       ** Copyrigth (C) 2009 Manuel De Girardi ; All rigths reserved. **       " );
  143.  Main_Loop :
  144.      loop
  145.         Get_Immediate(Char);
  146.         if Is_Graphic(Char) then
  147.            Length := Length + 1;
  148.            Line(Length) := Char;
  149.         elsif Is_Control(Char) then
  150.            case Char is
  151.               when Character'Val(127) =>
  152.                  if Length > 0 then
  153.                     Line(Length) := Character'Val(32);
  154.                     Length := Length - 1;
  155.                  else
  156.                     Put(Character'Val(7));
  157.                  end if;
  158.               when Character'Val(10) =>
  159.                  exit Main_loop;
  160.               when others => null;
  161.            end case;
  162.         end if;
  163.  
  164.         Ret_System := System (To_C("clear" ));
  165.         New_Line(13);
  166.         Put(10 * Character'Val(32));
  167.         Put_line(60 * Character'Val(45));
  168.         if length /= 0 then
  169.  
  170.            if Length > 54 then
  171.               First := First + 1;
  172.            end if;
  173.  
  174.            Replace_Slice(Window, Low, high, line(first..length), Error, left, Space);
  175.            Put("          -- " );
  176.            Put(window);
  177.            Put_line(" --" );
  178.         else
  179.            Put(10 * Character'Val(32));
  180.            Put(2 * Character'Val(45));
  181.            Put(56 * Character'Val(32));
  182.            Put_line(2 * Character'Val(45));
  183.         end if;
  184.         Put(10 * Character'Val(32));
  185.         Put_line(60 * Character'Val(45));
  186.         New_Line(12);
  187.         Ada.Text_Io.Put("       ** Copyrigth (C) 2009 Manuel De Girardi ; All rigths reserved. **       " );
  188.  
  189.      end loop Main_loop;
  190.      if Length /= 0 then
  191.         Expression := new String ' (Line(1..Length));
  192.      end if;
  193.      end Get_Banner;
  194.  
  195.      procedure Put_Banner(Expression : in String) is
  196.  
  197.      begin
  198.         Screen.Print(Expression);
  199.      end Put_Banner;
  200.  
  201.  
  202. end P_Term;


 
 

Reply

Marsh Posté le 17-01-2009 à 13:48:38   

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed