Forum |  HardWare.fr | News | Articles | PC | S'identifier | S'inscrire | Shop Recherche
593 connectés 

  FORUM HardWare.fr
  Programmation
  Ada

  Text défilant

 


 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

Text défilant

n°1839394
Profil sup​primé
Posté le 17-01-2009 à 13:48:38  answer
 

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;


 
 

mood
Publicité
Posté le 17-01-2009 à 13:48:38  profilanswer
 


Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  Ada

  Text défilant

 

Sujets relatifs
[RESOLU] Parsing de CSV avec Text::CSV_XC ou à l'arrache[resolu]caracteres accentué (variable TEXT d'une table Mysql)
[AS3] [RESOLU] Changer un TextField.text[Asp.net] Text d'une RadioButtonList
html sous text editAffichage d'une donnée dans un champ text
text combobox et textboxbouton radio + input text
modifier le contenu d'un "text" svgproblème balise input type text -->type File
Plus de sujets relatifs à : Text défilant


Copyright © 1997-2022 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR