with Ada.Text_Io, Ada.Strings, Ada.Strings.fixed;
use Ada.Text_Io, Ada.Strings, Ada.Strings.fixed;
with Ada.Characters.Handling;
use Ada.Characters.Handling;
with Interfaces.C; use Interfaces.C;
with Ada.Unchecked_Deallocation;
package body P_Term is
procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation(String, String_Access);
procedure Free (Expression : in out String_Access) is
begin
Unchecked_Deallocation(expression);
end Free;
function System (Cmd : Interfaces.C.Char_Array) return Interfaces.C.int;
pragma Import (C, System, "system" );
task Screen is
entry print(Expression : in String);
entry Stop;
entry Lock;
end Screen;
procedure Finalize is
begin
Screen.Stop;
end Finalize;
task body Screen is
Motif : String_Access;
Window : String(1..54) := (others => Character'Val(32));
Low : Positive;
High : Natural;
First, Last : Positive;
Ret_System : Interfaces.C.Int;
End_Of_Task : Boolean := False;
Locker : Boolean := True;
begin
while not End_Of_Task loop
select
accept print(Expression : in String) do
Free(Motif);
Motif := new String ' (Expression);
First := 1;
Last := 1;
Low := 54;
High := 55;
Window := (others => Character'Val(32));
Replace_Slice(Window, Low, high, Motif(first..last), Error, right, Space);
Locker := False;
end Print;
or
accept Stop do
End_Of_Task := True;
end Stop;
or
accept Lock do
Locker := True;
end Lock;
or
delay 0.1;
if not Locker then
Ret_System := System (To_C("clear" ));
Put_Line(" This program is writed with Ada. " );
New_Line(12);
Put(10 * Character'Val(32));
Put_line(60 * Character'Val(45));
if Motif /= null then
Put(" -- " );
Put(Window);
Put_line(" --" );
if first = Motif'Length then
Low := 54;
First := 1;
Last := 1;
Window := (others => Character'Val(32));
Replace_Slice(Window, Low, high, Motif(first..last), Error, right, Space);
else
if Last < Motif'Length then
Last := Last + 1;
end if;
if low > 1 then
low := low - 1;
else
First := First + 1;
end if;
Replace_Slice(Window, Low, high, Motif(first..last), Error, left, Space);
end if;
else
Put(10 * Character'Val(32));
Put(2 * Character'Val(45));
Put(56 * Character'Val(32));
Put_line(2 * Character'Val(45));
end if;
Put(10 * Character'Val(32));
Put_line(60 * Character'Val(45));
New_Line(13);
Ada.Text_Io.Put(" ** Copyrigth (C) 2009 Manuel De Girardi ; All rigths reserved. ** " );
end if;
end select;
end loop;
end Screen;
procedure Get_Banner(Expression : out String_Access) is
Line : String(1..2000) := (others => Character'Val(32));
Char : Character;
Window : String(1..54) := (others => Character'Val(32));
Low : Positive := 1;
High : Natural := 55;
First : Positive := 1;
Length : Natural := 0;
Ret_System : Interfaces.C.Int;
begin
Screen.Lock;
Ret_System := System (To_C("clear" ));
New_Line(13);
Put(10 * Character'Val(32));
Put_line(60 * Character'Val(45));
Put(10 * Character'Val(32));
Put(2 * Character'Val(45));
Put(56 * Character'Val(32));
Put_line(2 * Character'Val(45));
Put(10 * Character'Val(32));
Put_line(60 * Character'Val(45));
New_Line(12);
Ada.Text_Io.Put(" ** Copyrigth (C) 2009 Manuel De Girardi ; All rigths reserved. ** " );
Main_Loop :
loop
Get_Immediate(Char);
if Is_Graphic(Char) then
Length := Length + 1;
Line(Length) := Char;
elsif Is_Control(Char) then
case Char is
when Character'Val(127) =>
if Length > 0 then
Line(Length) := Character'Val(32);
Length := Length - 1;
else
Put(Character'Val(7));
end if;
when Character'Val(10) =>
exit Main_loop;
when others => null;
end case;
end if;
Ret_System := System (To_C("clear" ));
New_Line(13);
Put(10 * Character'Val(32));
Put_line(60 * Character'Val(45));
if length /= 0 then
if Length > 54 then
First := First + 1;
end if;
Replace_Slice(Window, Low, high, line(first..length), Error, left, Space);
Put(" -- " );
Put(window);
Put_line(" --" );
else
Put(10 * Character'Val(32));
Put(2 * Character'Val(45));
Put(56 * Character'Val(32));
Put_line(2 * Character'Val(45));
end if;
Put(10 * Character'Val(32));
Put_line(60 * Character'Val(45));
New_Line(12);
Ada.Text_Io.Put(" ** Copyrigth (C) 2009 Manuel De Girardi ; All rigths reserved. ** " );
end loop Main_loop;
if Length /= 0 then
Expression := new String ' (Line(1..Length));
end if;
end Get_Banner;
procedure Put_Banner(Expression : in String) is
begin
Screen.Print(Expression);
end Put_Banner;
end P_Term;