-- main is main file of main project written with Ada. -- Main is Copyright (C) 2025 Manuel De Girardi ;  -- -- This program is free software; you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation; either version 2 of the License, or -- (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA -- -- Date := 2026-10-21 06:23:14 ;  -- Version := 0.64.2a ;  with Lib.Shared ; use Lib.Shared ; with Gnat.Command_Line; with Gnat.Directory_Operations ; with Gnat.Directory_Operations.Iteration; use Gnat.Directory_Operations ; use Gnat.Directory_Operations.Iteration; with Ada.Directories; use Ada; with M.Shared; with M.Balance; with M.Accountant; with Ada.Wide_Text_Io; with Text_Io; use Text_Io; with PragmARC.Ansi_Tty_Control; use PragmARC; with Ada.Characters.Handling; use Ada.Characters; with Ada.Strings.Fixed; use Ada.Strings.Fixed; with Ada.Containers.Vectors; use Ada.Containers; with Ada.Strings.Wide_Fixed; use Ada.Strings; with M.Versions.Version_Io; use M.Versions; use M.Versions.Version_Io; ---------------------------------------------------------- -- Mode none with M.Tools; with M.Shell; with M.Attributes; with Ada.Calendar.Formatting; use Ada.Calendar; with Ada.Wide_Characters.Handling; use Ada.Wide_Characters.Handling; with Gnat.Directory_Operations; with Gnat.Semaphores; use Gnat.Semaphores; ---------------------------------------------------------- -- Organizer with Ada.Tags; use Ada.Tags; with M.Strings; use M.Strings; ----------------------------------------------------------- -- Mode manager use Ada.Containers; with Gnos; with Gnos.Parameters; use Gnos.Parameters; with Gnos.Projects; with Gnos.Results; --use Gnos.Results; with Gnos.Versions; with Gnos.Versions.Editting; use Gnos.Versions.Editting; with Gnos.Versions.Environment; with Gnos.Gnose; use Ada; ---------------------------------------------------------- -- Activity with M.Accountant; use M.Accountant; with M.Balance; use M.Balance; with Sky.Stock; with Sky.Stocks_Manager; use Sky.Stock; use Sky.Stocks_Manager; with M.Errors; with M.Project; use M.Project; with M.WOPR; use M.WOPR; with Sai; with Sai.Editting; use Sai; use Sai.Editting; with Ansi_Console; with M.Ansi.Console; use M.Ansi; with Adam; use Adam; with Adam.Results; with Adam.Interfaces; use Adam.Interfaces; with Adam.Textual; use Adam.Textual; --with Adam.Web; --use Adam.Web; with Adam.Operating_system; --use Adam.Operating_system; with Adam.Values; --with Adam.Terminal; --use Adam.Terminal; --with Adam.Terminal.Ansi_Consoles; with Ada.Strings.Wide_Unbounded; with Ada.Strings.Unbounded; use Ada.Strings; with Ada.Strings; use Ada; with Aws.Client; with Gnat.Sockets; with Gnat.Regexp; with Ada.Numerics.Discrete_Random; use Gnat; with Ada.Strings.UTF_Encoding.Strings; with Ada.Strings.UTF_Encoding.Wide_Strings; with Ada.Text_Io; with Ada.Strings.Unbounded; use Ada.Strings; with Ada.Task_Identification; use Ada.Task_Identification; with PragmARC.Rem_NN_Wrapper; use PragmARC.Rem_NN_Wrapper; -------------------------------- -- Workstation -- -------------------------------- with Work ; use Work; -- with Work.Station ;  -- with Work.Station.Main; with Work.Console ; with Work.Machine ; with Work.Program ; with Work.Manager ; with Work.Virtual ; with Work.Classes ; with Work.Attribu ; use Work.Attribu; with Work.Classes.Profile_class; with Work.Classes.Content_class; with Work.Classes.Event_class; with Work.Classes.Planning_class; with Work.Classes.Job_class; with Work.Classes.Account_Class; with Work.Classes.Account_Line_class; with Work.Classes.Note_class; with Work.Classes.Car_class; with Work.Classes.Contact_class; with Work.Classes.Machine_class; with Work.Classes.Activity_class; with Work.Classes.Universe_class; with Work.Classes.house_class; with Work.Classes.Compta_line_class; with Work.Classes.Component_class; with Work.Wargame; with Work.Wargame.Search; with Work.Types; use Work.Types; with Ada.Strings.Fixed; use Ada.Strings.Fixed; with Ansi_Console; use Ansi_Console; with Windows_Console; with Ada.Integer_Text_Io; use Ada.Integer_Text_Io; with Ansi_Console; use Ansi_Console; with Ada.Calendar.Formatting; use Ada.Calendar; with Ada.Containers; with PragmARC.Ansi_Tty_Control; use PragmARC.Ansi_Tty_Control; with Ada.Numerics.Float_Random; use Ada.Numerics.Float_Random; with Ada.Unchecked_Deallocation; with Ada.Characters.Handling; use Ada.Characters.Handling; with Ada.Strings.Wide_Fixed; use Ada.Strings; with Ada.Numerics.Discrete_Random; use Ada.Numerics; with PragmARC.Wrapping; with Sai.Shared; use Sai.Shared; with El.Strings; with System.Os_Constants; use System; with M.Results; use M.Results; with M.Web; package body M.Agence is package My_Classes is new Work.Classes (Windows); package My_Profile is new My_Classes.Profile_Class; package My_Content is new My_Classes.Content_Class; package My_Event is new My_Classes.Event_Class; package My_Planning is new My_Classes.Planning_Class; package My_Job is new My_Classes.Job_Class; package My_Universe is new My_Classes.Universe_Class; package My_Note is new My_Classes.Note_Class; package My_Car is new My_Classes.Car_Class; package My_Contact is new My_Classes.Contact_Class; package My_Machine is new My_Classes.Machine_Class; package My_Activity is new My_Classes.Activity_Class; package My_House is new My_Classes.house_Class; package My_Account is new My_Classes.Account_Class; package My_Account_Line is new My_Classes.Account_Line_Class; package My_Compta_Line is new My_Classes.Compta_Line_Class; package My_Component is new My_Classes.Component_Class; use My_Classes; use My_Profile; use My_Content; use My_Event; use My_Planning; use My_Job; use My_Universe; use My_Note; use My_Car; use My_Contact; use My_Machine; use My_Activity; use My_House; use My_Content; use My_account; use My_Account_Line; use My_Component; package Object_Rand is function Random return Object_Access; end Object_Rand; package body Object_Rand is package Name_Rand is new Discrete_Random(Obj_Enum); function Random return Object_Access is Gen : Name_Rand.Generator; begin Name_Rand.Reset(Gen); case Name_Rand.Random(Gen) is when Universe => return new My_Universe.Universe_Obj; when Profile => return new My_Profile.Profile_Obj; when Planning => return new My_Planning.Planning_Obj; when Job => return new My_Job.Job_Obj; when Event => return new My_Event.Event_Obj; when Machine => return new My_Machine.Machine_Obj; when Acc => return new My_Account.Account_Obj; when Account_Line => return new My_Account_Line.Account_Line_Obj; when Activity => return new My_Activity.Activity_Obj; when Compta_Line => return new My_Compta_Line.Compta_Line_Obj; when Note => return new My_Note.Note_Obj; when Component => return new My_Component.Component_Obj; when Contact => return new My_Contact.Contact_Obj; when Content => return new My_Content.Content_Obj; when House => return new My_House.House_Obj; when Car => return new My_Car.Car_Obj; end case; end Random; end Object_Rand; ---------------------------------------------------- -- -- --use Ansi_Windows; use Windows.Ansi_Windows; use M.Ansi.Console; use Object_Vectors; procedure Load_File (Filename : in String; Class : in Class_Enum; Vector : in out Object_Vectors.Vector) is File : Text_Io.File_Type; begin Text_Io.Open(File, Text_Io.In_File, Filename); while not Text_Io.End_Of_File(File) loop case Class is when Job => declare O : Object_Access := new My_Job.Job_Obj; begin Read(O.all, File); Append(Vector, O); end; when Content => declare O : Object_Access := new My_Content.Content_Obj; begin Read(O.all, File); Append(Vector, O); end; when Event => declare O : Object_Access := new My_Event.Event_Obj; begin Read(O.all, File); Append(Vector, O); end; when others => null; end case; end loop; Text_Io.Close(File); --Text_Io.Put_Line("Readed."); end Load_File; type Text_Access is access all String; procedure Text_Free is new Ada.Unchecked_Deallocation (String, Text_Access); type Text_List is array (Positive range <>) of Text_Access; D : Float := 0.0; Choice : Natural := 0; Stock : constant Text_List := ( -- Les jour important new String ' ("0"), new String ' ("1"), new String ' ("2"), new String ' ("3"), new String ' ("4"), new String ' ("5"), new String ' ("6"), new String ' ("7"), new String ' ("8"), new String ' ("9"), new String ' ("10"), new String ' ("11"), new String ' ("12"), new String ' ("13"), new String ' ("14"), new String ' ("15"), new String ' ("16"), new String ' ("17"), new String ' ("18"), new String ' ("19"), new String ' ("20"), new String ' ("21"), new String ' ("22"), new String ' ("23"), new String ' ("24"), new String ' ("25"), new String ' ("26"), new String ' ("27"), new String ' ("28"), new String ' ("janv"), new String ' ("fev"), new String ' ("mars"), new String ' ("avril"), new String ' ("mai"), new String ' ("juin"), new String ' ("juillet"), new String ' ("aout"), new String ' ("sept"), new String ' ("oct"), new String ' ("nov"), new String ' ("dec") ); Ten_Choices : Text_List(1..10);-- dix point pour etablir un context. G : Generator; -- End Workstation -- ---------------------------------------------------- function System(Line : in String) return Integer; pragma Import (C, System, "system"); Char : Character; Stopped : Boolean := False; Gnose_Params : Gnose_Parameters_Type; Projects_Params : Projects_Parameters_Type; package Gnos_Projects is new Gnos.Projects(Projects_Params); package Agnose is new Gnos.Gnose(Gnose_Params); use Agnose; use Agnose.Neural; use Agnose.Neural.Objects_System; use Agnose.Neural.Objects_System.Objects_system; use Agnose.Neural.Objects_System.Objects_System.Language; use Agnose.Neural.Objects_System.Objects_System.Language.Agnose_Projects; package Environment is new Gnos.Versions.Environment(Agnose.Neural.Objects_System.Objects_System.Language.Agnose_Projects); use Environment; use M.Errors; use M.Balance; use M.Accountant; use Ansi_Tty_Control; use Windows.Ansi_Windows; use M.Ansi.Console ; use M.Shared; use Gnat.Directory_Operations; use Text_Io; use Ada.Strings.Fixed; use Ada.Characters; --use M.Tools; use M.Shell; use M.Attributes; use Sky; use Ada.Strings; package W_Io renames Ada.Wide_Text_Io; package Internal is function "=" (Left, Right : in OS_Lib.String_Access) return Boolean; function "<" (Left, Right : in OS_Lib.String_Access) return Boolean; package Wstr_Vectors is new Vectors (Positive, OS_Lib.String_Access, "="); package Sorting is new Wstr_Vectors.Generic_Sorting("<"); use Ada.Text_Io; white : constant String := Character'Val(27) & "[01;37m"; Magenta : constant String := Character'Val(27) & "[01;35m"; Cyan : constant String := Character'Val(27) & "[01;36m"; Blue : constant String := Character'Val(27) & "[01;34m"; Red : constant String := Character'Val(27) & "[01;31m"; Green : constant String := Character'Val(27) & "[01;32m"; Yellow : constant String := Character'Val(27) & "[01;33m"; Black : constant String := Character'Val(27) & "[01;30m"; Normal : constant String := Character'Val(27) & "[00m"; type File_Set is array (Positive range <>) of Os_Lib.String_Access; type File_Table is array (Positive range <>, Positive range <>) of Os_Lib.String_Access; procedure Xls (Cmd_Line : in String;Win : in Window_Record;Line_index : in Natural; Count : out Natural;For_Ansi : in Boolean := False); end Internal; procedure Internal_Help (Line : in Wide_string; Result : in out Spawn_Result_Record); package body Internal is use Wstr_Vectors; use Sorting; function "=" (Left, Right : in OS_Lib.String_Access) return Boolean is begin return Left.all = Right.all; end "="; function "<" (Left, Right : in OS_Lib.String_Access) return Boolean is begin return Left.all < Right.all; end "<"; procedure Xls (Cmd_Line : in String;Win : Window_Record;Line_index : in Natural; Count : out Natural;For_Ansi : in Boolean := False) is Target : Wstr_Vectors.Vector; Dir_List : Wstr_Vectors.Vector; File_Index : Natural := 0; procedure Add_Name (Name : in String; Num : in Positive; Verax : in out Boolean); procedure Iterator is new Wildcard_Iterator (Add_Name); procedure Add_Name (Name : in String; Num : in Positive; Verax : in out Boolean) is begin Target := Target & new String ' (Name); File_Index := File_Index + 1; end Add_Name; L_Index : Natural := 0; C_Index : Natural := 0; File_Counter : Natural := 0; Command : Gnat.Command_Line.Command_Line; Arguments : Wstr_Vectors.Vector; Set : File_Set(1..4096); Buffer_args, Arguments_List : Os_Lib.Argument_List_Access; Char_Count, Line_By_Column, Col, Top_Col : Positive := 1; Line : Natural := 1; Long_Option : Boolean := False; Date : Time := Clock; Size : Long_integer := 0; Dir_Match : Directories.Search_Type; Dir_Path : Directories.Directory_Entry_Type; Column_By_Page : Positive := 1; Width : Natural := 0; Hiegh : Natural := 0; begin if For_Ansi then Draw_Window(Win); end if; Gnat.Command_Line.Set_Command_Line(Command, Cmd_Line); Gnat.Command_Line.Build(Command, Arguments_List, False); begin if OS_Lib."/="(Arguments_List, null) and then Arguments_List'Length > 1 then for Arg in 2..Arguments_List'last loop if Arguments_List(Arg).all = "-l" then Long_Option := True; elsif Arguments_List(Arg)(1) = '-' then if For_Ansi then Draw_Text(Win, Lib.Shared.Line_Cur+1, 1, Ansi.Console.White, "invalid option"); else Put_Line("invalid option"); end if; else declare S : constant String := Arguments_List(Arg).all; begin exit when S'Length = 0; Arguments := Arguments & new String ' (S); end; end if; end loop; end if; end; if not Is_Empty(Arguments) then for Arg in 1..Length(Arguments) loop declare E : String := Element(Arguments, Integer(Arg)).all; begin if E = ".." then iterator("../*"); elsif E = "." or E = "./" then iterator("./*"); elsif E = "*" or E = "./*" then iterator(Directories.base_Name(E & "/*")); elsif E = "../*" then iterator(Directories.base_Name(E & "/*")); elsif not Os_Lib.Is_Directory (E) then iterator(E); elsif Os_Lib.Is_Directory (E) then iterator(E & "/*"); else iterator(Directories.base_Name(E & "/*")); end if; end; end loop; Sort(Target); File_Index := 0; if not Is_Empty(Target) then for Name in 1..Length(Target) loop declare File_Name : OS_Lib.String_Access := Element(Target, Integer(Name)); begin if Os_Lib.Is_Directory(File_Name.all) then Set(File_Index+1) := new String ' (Blue & Directories.Simple_Name(File_Name.all) & '/') ; File_Index := File_Index + 1; elsif Os_Lib.Is_Executable_File(File_Name.all) then Set(File_Index+1) := new String ' (Green & Directories.simple_Name(File_Name.all )); File_Index := File_Index + 1; elsif Directories.Extension(File_Name.all) = "tgz" or Directories.Extension(File_Name.all) = "tar" or Directories.Extension(File_Name.all) = "gz" or Directories.Extension(File_Name.all) = "tar.gz" or Directories.Extension(File_Name.all) = "zip" then Set(File_Index+1) := new String ' (Red & Directories.base_Name(File_Name.all) & '.' & Directories.Extension(File_Name.all)); File_Index := File_Index + 1; elsif Directories.Extension(File_Name.all) = "png" or Directories.Extension(File_Name.all) = "jpg" or Directories.Extension(File_Name.all) = "jpeg" then Set(File_Index+1) := new String ' (magenta & Directories.base_Name(File_Name.all) & '.' & Directories.Extension(File_Name.all)); File_Index := File_Index + 1; elsif Directories.Extension(File_Name.all) = "iso" then Set(File_Index+1) := new String ' (yellow & Directories.base_Name(File_Name.all) & '.' & Directories.Extension(File_Name.all)); File_Index := File_Index + 1; elsif Directories.Extension(File_Name.all) = "txt" then Set(File_Index+1) := new String ' (black & Directories.base_Name(File_Name.all) & '.' & Directories.Extension(File_Name.all)); File_Index := File_Index + 1; elsif Os_Lib.Is_Regular_File(File_Name.all) then Set(File_Index+1) := new String ' (white & Directories.simple_Name(File_Name.all)); File_Index := File_Index + 1; elsif Os_Lib.Is_Symbolic_Link(File_Name.all) then if Os_Lib.Normalize_Pathname(File_Name.all, Directories.Containing_Directory(File_Name.all))'Length = 0 then Set(File_Index+1) := new String ' (Red & Directories.base_Name(File_Name.all)); File_Index := File_Index + 1; else Set(File_Index+1) := new String ' (yellow & Directories.base_Name(File_Name.all)); File_Index := File_Index + 1; end if; else Set(File_Index+1) := new String ' (Yellow & Directories.simple_Name(File_Name.all)); File_Index := File_Index + 1; end if; end; end loop; end if; -- -- -- if File_Index /= 0 then if Long_Option then if not For_Ansi then for I in Lib.Shared.Line_Cur + 1 .. lines loop W_Io.Put(Handling.To_Wide_String(Position(I, 1)) & Ada.Strings.Wide_Fixed."*"(Columns, Wide_Character'Val(32))); end loop; end if; for I in Natural'Min(Line_Index, File_Index-1)+1..File_Index loop if Os_Lib.Is_Directory (Element(Target, Integer(I)).all) then declare Dir : String := Element(Target, integer(I)).all; begin if Dir /= "." and Dir /= ".." then Directories.Start_Search(Dir_Match, Dir, Dir); Directories.Get_Next_Entry(Dir_Match, Dir_Path); Date := Ada.Directories.Modification_time(Dir_Path); Size := Long_Integer(Ada.Directories.Size(Dir_Path)); end if; exception when others => null; end; else declare Dir : String := Element(Target, integer(I)).all; begin if Dir /= "." and Dir /= ".." then Date := Ada.Directories.Modification_time(Directories.Full_Name(Dir)); Size := Long_Integer(Ada.Directories.Size(Directories.Full_Name(Dir))); end if; end; end if; if For_Ansi then Line := Line + 1; Draw_Text(Win, Line, 1, Ansi.Console.White, Handling.To_Wide_String(Formatting.Image(Date))); Draw_Text(Win, Line, 20, Ansi.Console.White, Handling.To_Wide_String(Long_Integer'Image(Long_Integer(Size)))); Draw_Text(Win, Line, 35, Ansi.Console.White, Handling.To_Wide_String(Set(I).all & Normal)); else if Lib.Shared.Line_Cur + Line > Lines - 1 then New_Line; Put(Position(Lines, 1) & Formatting.Image(Date)); Put(Position(Lines, 20) & Long_Integer'Image(Long_Integer(Size))); Put(Position(Lines, 35) & Set(I).all & Normal); Line := Line + 1; else Put(Position(Lib.Shared.Line_Cur + Line, 1) & Formatting.Image(Date)); Put(Position(Lib.Shared.Line_Cur + Line, 20) & Long_Integer'Image(Long_Integer(Size))); Put(Position(Lib.Shared.Line_Cur + Line, 35) & Set(I).all & Normal); Line := Line + 1; end if; end if; Size := 0; if not For_Ansi then --exit when Lib.Shared.Line_Cur + Line >= Lines; null; else exit when Line >= Win.H-2; end if; end loop; if not For_Ansi and Lib.Shared.Line_Cur + Line < lines then Lib.Shared.Line_Cur := Integer'Max(Lib.Shared.Line_Cur + Line, Lines); Put(Position(Lib.Shared.Line_Cur, 1) & Normal); Count := Line; elsif not For_Ansi then Lib.Shared.Line_Cur := Integer'Max(Lib.Shared.Line_Cur + Line, Lines); New_Line; Put(Position(Lib.Shared.Line_Cur, 1) & Normal); Count := Line; end if; else for Iter in 1..File_Index loop if Set(Iter)'Length > Top_Col then Top_Col := Set(Iter)'Length; end if; Char_Count := Char_Count + Set(Iter)'Length; end loop; if For_Ansi then Line_By_Column := File_index/((Win.W)/(Top_Col+7))+1; else Line_By_Column := File_index/((Columns)/(Top_Col+7)+1)+1; end if; Column_By_Page := (File_Index / Line_By_Column)+1; declare Table : File_Table(1..Line_By_Column, 1..Column_By_Page); begin for column in Table'Range(2) loop for Line in Table'range(1) loop Table(Line, Column) := Set(File_Counter+1); File_Counter := File_Counter+1; end loop; end loop; File_Counter := 0; if For_Ansi then Line := Line + 1; end if; if not For_Ansi then for I in Lib.Shared.Line_Cur + 1.. lines loop W_Io.Put(Handling.To_Wide_String(Position(I, 1)) & Ada.Strings.Wide_Fixed."*"(Columns, Wide_Character'Val(32))); end loop; end if; Main1 : for Iter_L in Natural'Min(Line_Index, Table'Last(1)-1)+1..Table'Last(1) loop for Iter_C in Table'Range(2) loop if not Os_Lib."="(Table(Iter_L, Iter_C), null) then if For_Ansi then Draw_Text(Win, Line, Col, Ansi.Console.White, Handling.To_Wide_String(Table(Iter_L, Iter_C).all)); else Put(Position(Lib.Shared.Line_Cur + Line, Col) & Table(Iter_L, Iter_C).all); end if; Col := Col + Top_Col; File_Counter := File_Counter+1; end if; exit Main1 when File_Counter = File_Index; end loop; if not For_Ansi then if Line_Cur + Line >= Lines then New_Line; else Line := Line + 1; end if; else if Line >= Win.H-2 then exit; else Line := Line + 1; end if; end if; Col := 1; end loop main1; Count := Count + Line_By_Column; end; if not For_Ansi and Lib.Shared.Line_Cur + Line < lines then Lib.Shared.Line_Cur := Lib.Shared.Line_Cur + Line_By_Column+1; Put(Position(Lib.Shared.Line_Cur, 1) & Normal); Count := Line; elsif not For_Ansi then Lib.Shared.Line_Cur := Lib.Shared.Line_Cur + Line_By_Column+1; New_Line; Put(Position(Lib.Shared.Line_Cur, 1) & Normal); Count := Line; end if; Col := 1; Top_Col := 1; Line := 1; end if; end if; else Iterator(Directories.Current_Directory & "/*"); Sort(Target); File_Index := 0; if not Is_Empty(Target) then for Name in 1..Length(Target) loop declare File_Name : OS_Lib.String_Access := Element(Target, Integer(Name)); begin if Os_Lib.Is_Directory(File_Name.all) then Set(File_Index+1) := new String ' (Blue & Directories.Simple_Name(File_Name.all) & '/') ; File_Index := File_Index + 1; elsif Os_Lib.Is_Executable_File(File_Name.all) then Set(File_Index+1) := new String ' (Green & Directories.simple_Name(File_Name.all )); File_Index := File_Index + 1; elsif Directories.Extension(File_Name.all) = "tgz" or Directories.Extension(File_Name.all) = "tar" or Directories.Extension(File_Name.all) = "gz" or Directories.Extension(File_Name.all) = "tar.gz" or Directories.Extension(File_Name.all) = "zip" then Set(File_Index+1) := new String ' (Red & Directories.base_Name(File_Name.all) & '.' & Directories.Extension(File_Name.all)); File_Index := File_Index + 1; elsif Directories.Extension(File_Name.all) = "png" or Directories.Extension(File_Name.all) = "jpg" or Directories.Extension(File_Name.all) = "jpeg" then Set(File_Index+1) := new String ' (magenta & Directories.base_Name(File_Name.all) & '.' & Directories.Extension(File_Name.all)); File_Index := File_Index + 1; elsif Directories.Extension(File_Name.all) = "iso" then Set(File_Index+1) := new String ' (yellow & Directories.base_Name(File_Name.all) & '.' & Directories.Extension(File_Name.all)); File_Index := File_Index + 1; elsif Directories.Extension(File_Name.all) = "txt" then Set(File_Index+1) := new String ' (black & Directories.base_Name(File_Name.all) & '.' & Directories.Extension(File_Name.all)); File_Index := File_Index + 1; elsif Os_Lib.Is_Regular_File(File_Name.all) then Set(File_Index+1) := new String ' (white & Directories.simple_Name(File_Name.all)); File_Index := File_Index + 1; elsif Os_Lib.Is_Symbolic_Link(File_Name.all) then if Os_Lib.Normalize_Pathname(File_Name.all, Directories.Containing_Directory(File_Name.all))'Length = 0 then Set(File_Index+1) := new String ' (Red & Directories.base_Name(File_Name.all)); File_Index := File_Index + 1; else Set(File_Index+1) := new String ' (Cyan & Directories.base_Name(File_Name.all)); File_Index := File_Index + 1; end if; else Set(File_Index+1) := new String ' (Yellow & Directories.simple_Name(File_Name.all)); File_Index := File_Index + 1; end if; end; end loop; end if; -- -- -- -- -- -- if File_Index /= 0 then if Long_Option then if not For_Ansi then for I in Lib.Shared.Line_Cur + 1 .. Lines loop W_Io.Put(Handling.To_Wide_String(Position(I, 1)) & Ada.Strings.Wide_Fixed."*"(Columns,Wide_Character'Val(32))); end loop; end if; for I in Natural'Min(Line_Index, File_Index-1)+1..File_Index loop if Os_Lib.Is_Directory (Element(Target, Integer(I)).all) then declare Dir : String := Element(Target, integer(I)).all; begin if Dir /= "." and Dir /= ".." then Directories.Start_Search(Dir_Match, Dir, dir); Directories.Get_Next_Entry(Dir_Match, Dir_Path); Date := Ada.Directories.Modification_time(Dir_Path); Size := Long_Integer(Ada.Directories.Size(Dir_Path)); end if; exception when others => null; end; else declare Dir : String := Element(Target, integer(I)).all; begin if Dir /= "." and Dir /= ".." then Date := Ada.Directories.Modification_time(Directories.Full_Name(dir)); Size := Long_Integer(Ada.Directories.Size(Directories.Full_Name(dir))); end if; end; end if; if For_Ansi then Line := Line + 1; Draw_Text(Win, Line, 1, Ansi.Console.White, Handling.To_Wide_String(Formatting.Image(Date))); Draw_Text(Win, Line, 20, Ansi.Console.White, Handling.To_Wide_String(Long_Integer'Image(Long_Integer(Size)))); Draw_Text(Win, Line, 35, Ansi.Console.White, Handling.To_Wide_String(Set(I).all & Normal)); else if Lib.Shared.Line_Cur + Line > Lines - 1 then New_Line; Put(Position(Lines, 1) & Formatting.Image(Date)); Put(Position(Lines, 20) & Long_Integer'Image(Long_Integer(Size))); Put(Position(Lines, 35) & Set(I).all & Normal); Line := Line + 1; else Put(Position(Lib.Shared.Line_Cur + Line, 1) & Formatting.Image(Date)); Put(Position(Lib.Shared.Line_Cur + Line, 20) & Long_Integer'Image(Long_Integer(Size))); Put(Position(Lib.Shared.Line_Cur + Line, 35) & Set(I).all & Normal); Line := Line + 1; end if; end if; Size := 0; if not For_Ansi then --exit when Lib.Shared.Line_Cur + Line >= Lines; null; else exit when Line >= Win.H-2; end if; end loop; if not For_Ansi and Lib.Shared.Line_Cur + Line < lines then Lib.Shared.Line_Cur := Integer'Max(Lib.Shared.Line_Cur + Line, Lines); Put(Position(Lib.Shared.Line_Cur, 1) & Normal); Count := Line; elsif not For_Ansi then Lib.Shared.Line_Cur := Integer'Max(Lib.Shared.Line_Cur + Line, Lines); New_Line; Put(Position(Lib.Shared.Line_Cur, 1) & Normal); Count := Line; end if; else for Iter in 1..File_Index loop if Set(Iter)'Length > Top_Col then Top_Col := Set(Iter)'Length; end if; Char_Count := Char_Count + Set(Iter)'Length; end loop; if not For_Ansi then Line_By_Column := File_index/((Columns)/(Top_Col+7))+1; else Line_By_Column := File_index/((Win.W)/(Top_Col+7)+1)+1; end if; Column_By_Page := (File_Index / Line_By_Column)+1; declare Table : File_Table(1..Line_By_Column, 1..Column_By_Page); begin for column in Table'Range(2) loop for Line in Table'range(1) loop Table(Line, Column) := Set(File_Counter+1); File_Counter := File_Counter+1; end loop; end loop; File_Counter := 0; if For_Ansi then Line := Line + 1; end if; if not For_Ansi then for I in Lib.Shared.Line_Cur + 1 .. Lines loop W_Io.Put(Handling.To_Wide_String(Position(I, 1)) & Ada.Strings.Wide_Fixed."*"(Columns, Wide_Character'Val(32))); end loop; end if; Main2 : for Iter_L in Natural'Min(Line_Index, Table'Last(1)-1)+1..Table'Last(1) loop for Iter_C in Table'Range(2) loop if not Gnat.Os_Lib."="(Table(Iter_L, Iter_C), null) then if For_Ansi then Draw_Text(Win, Line, Col, Ansi.Console.White, Handling.To_Wide_String(Table(Iter_L, Iter_C).all)); else Put(Position(Lib.Shared.Line_Cur + Line, Col) & Table(Iter_L, Iter_C).all); end if; Col := Col + Top_Col; File_Counter := File_Counter+1; end if; exit Main2 when File_Counter = File_Index; end loop; if not For_Ansi then if Line_Cur + Line >= Lines then New_Line; else Line := Line + 1; end if; else if Line >= Win.H-2 then exit; else Line := Line + 1; end if; end if; Col := 1; end loop Main2; Count := Count + Line_By_Column; end; if not For_Ansi and Lib.Shared.Line_Cur + Line < lines then Lib.Shared.Line_Cur := Lib.Shared.Line_Cur + Line_By_Column+1; Put(Position(Lib.Shared.Line_Cur, 1) & Normal); Count := Line; elsif not For_Ansi then Lib.Shared.Line_Cur := Lib.Shared.Line_Cur + Line_By_Column+1; New_Line; Put(Position(Lib.Shared.Line_Cur, 1) & Normal); Count := Line; end if; Col := 1; Top_Col := 1; Line := 1; end if; end if; end if; end Xls; end Internal; function Print_Set (Set : in Wide_Result_Access; Into : in Window_Record; Top : in Line_Index_Range; Total_Lines: out Natural) return Boolean; function Print_Set (Set : in Wide_Set; Into : in Window_Record; Top : in Line_Index_Range; Total_Lines: out Natural) return Boolean is Line_Index : Natural := 0; Result_Max_Lines : Positive := Into.H-2; height : constant Positive := Into.Win.H-2; Width : constant Positive := Into.Win.W-2; Line_Count : Natural := 0; begin Total_Lines := 0; if Set.Line_Last = 0 then return True; end if; Print_Loop: for I in Top+1..Positive'min(Top+((Result_Max_Lines-1)), set.lines'Length) loop if set.Lines(I) /= null then declare tmp : constant Wide_String := (set.Lines(I).all); Line : constant Wide_String := Tmp(Tmp'First..Wide_Fixed.Index_Non_Blank((Tmp), Backward)); Chars_Max : constant Positive := Width; Lines_Max : constant Positive := (Result_Max_Lines-5); Pro_Index : Natural := Wide_Fixed.Index(Line, "true"); Against : Natural := Wide_Fixed.Index(Line, "false"); Next : Natural := 0; begin if Real_Length(Line) > 0 and Real_Length(Line) < (Chars_Max * Lines_Max) then for Line_Window in Line_Index..Integer'min(Real_Length(Line)/Chars_Max, Lines_Max) loop declare B_Inf : constant Positive := Line_Window*Chars_Max + 1; B_Sup : constant Positive := Integer'min((Line_Window + 1)*Chars_Max, Real_Length(Line)); begin if Real_length(Line) < Chars_max then if Pro_Index /= 0 then if Line'Length >= Pro_Index + 4 then Next := Pro_Index + 4; end if; elsif Against /= 0 then if Line'Length >= against + 4 then Next := Against + 4; end if; end if; if Next /= 0 then if Pro_Index /= 0 then Draw_Text(Into, Line_Count+1, 1, White, Line(Line'First..Pro_Index-1)); Draw_Text(Into, Line_Count+1, Pro_Index, Cyan, Line(Pro_Index..Next) & Handling.To_Wide_String(Normal_mode)); if Line'Length > Next then Draw_Text(Into, Line_Count+1, Pro_Index+5, White, Line(Next+1..Line'Last)); end if; else Draw_Text(Into, Line_Count+1, 1, White, Line(Line'First..Against-1)); Draw_Text(Into, Line_Count+1, Against, Red, Line(Against..Next) & Handling.To_Wide_String(Normal_mode)); if Line'Length > Next then Draw_Text(Into, Line_Count+1, Against+5, White, Line(Next+1..Line'Last)); end if; end if; else Draw_Text(Into, Line_Count+1, 1, White, Line); end if; else if Next /= 0 then if Pro_Index /= 0 then if Pro_Index < B_Sup and Pro_Index > B_Inf and Next < B_Sup then Draw_Text(Into, Line_Count+1, 1, White, Line(B_Inf..Pro_Index-1)); Draw_Text(Into, Line_Count+1, Pro_Index, Cyan, Line(Pro_Index..Next) & Handling.To_Wide_String(Normal_mode)); Draw_Text(Into, Line_Count+1, 1, White, Line(Next+1..B_Sup)); else Draw_Text(Into, Line_Count+1, 1, White, Line(B_Inf..B_Sup)); end if; elsif Against /= 0 then if Against < B_Sup and Against > B_Inf and Next < B_Sup then Draw_Text(Into, Line_Count+1, 1, White, Line(B_Inf..Against-1)); Draw_Text(Into, Line_Count+1, Against, Cyan, Line(Against..Next) & Handling.To_Wide_String(Normal_mode)); Draw_Text(Into, Line_Count+1, Against+5, White, Line(Next+1..B_Sup)); else Draw_Text(Into, Line_Count+1, 1, White, Line(B_Inf..B_Sup)); end if; end if; else Draw_Text(Into, Line_Count+1, 1, White, Line(B_Inf..B_Sup)); end if; end if; end; Line_Count := Line_Count + 1; exit Print_Loop When Line_Count > (Result_Max_Lines-1); end loop; else Line_Count := Line_Count + 1; end if; end; end if; exit Print_Loop when Line_Count > (Result_Max_Lines-1); end loop Print_Loop; Total_Lines := Line_Count; return True; exception when others => return False; end Print_Set; -- function Print_Set (Set : in Wide_Set; -- Into : in Window_Record; -- Top : in Line_Index_Range;  -- Total_Lines: out Natural) return Boolean is -- height : constant Positive := Into.Win.H-2; -- Width : constant Positive := Into.Win.W-2; -- Line_Count : Natural := 0;  -- begin -- Total_Lines := 0; -- if Set.Line_Last = 0 then -- return True; -- end if; -- Print_Loop: -- for I in Top+1 .. Positive'min(Top+Height, Set.Line_Last) loop -- declare -- tmp : constant Wide_String := Set.Lines(I).all; -- Line : constant Wide_String := Tmp(Tmp'First..Wide_Fixed.Index_Non_Blank((Tmp), Backward)); -- Chars_Max : constant Positive := Width-1; -- Lines_Max : constant Positive := Height; -- B_Inf : Positive := 1; -- B_Sup : Positive := Chars_Max; -- Bot : Natural := 0; -- begin -- if Real_Length(Line) > 0 and Real_Length(Line) < (Chars_Max * Lines_Max) then -- for Line_Window in 0 .. Integer'min(Real_Length(Line)/Chars_Max, Lines_Max) loop -- B_Inf := Line_Window*Chars_Max + 1; -- B_Sup := Integer'min((Line_Window + 1)*Chars_Max, Real_Length(Line)); -- begin -- if Real_length(Line) <= Chars_max then -- Draw_Text(Into, Line_Count + 1, 1, White, Line); -- else -- Draw_Text(Into, Line_Count + 1, 1, White, Line(B_Inf..B_Sup));  -- end if;  -- end; -- Line_Count := Line_Count + 1; -- if Line_Count = height then  -- exit Print_Loop; -- end if; -- end loop; -- else -- Line_Count := Line_Count + 1; -- end if;  -- end; -- if Line_Count = height then  -- exit Print_Loop; -- end if;  -- end loop Print_Loop; -- Total_Lines := Line_Count; -- return True; -- exception -- when others => -- return False; -- end Print_Set; function Word_Count (Line : in Wide_String; Max_Word : in Line_Index_Range) return Word_Range; function Word_Count (Line : in Wide_String; Max_Word : in Line_Index_Range) return Word_range is Number_Of_Word : Word_range:= 0; Set : Wide_Set(Max_Word); Set_Index : Natural := 0; Top : Natural := 0; Bot : Natural := 0; begin if Line'Length = 0 then return 0; end if; if Wide_Fixed.Index_Non_Blank(Line) = 0 then return 0; end if; Top := 1; for Wchar in Line'Range loop if Is_Letter (Line(Wchar)) then Bot := Bot + 1; else if Bot > Top then Number_Of_Word := Number_Of_Word + 1; end if; Number_Of_Word := Number_Of_Word + 1; Top := Wchar+1; Bot := Positive'Min(Top, Line'Last); end if; end loop; return Number_Of_Word; end Word_Count; procedure Replace_description (Var_Name : in String; Value : in String; Node : in String); procedure Replace_Description (Var_Name : in String; Value : in String; Node : in String) is Filename : constant String := Node; Source : Text_Io.File_Type; Target : Text_Io.File_Type; Tmp_Filename : constant String := Filename & ".tmp"; Done : Boolean := False; begin Text_Io.Put_Line("Change value of " & Var_Name & " to " & Value & " in " & Node & " ; "); Text_Io.Put_Line("with filename : " & Filename); if Os_Lib.Is_Regular_File(Filename) then Text_Io.Create(Target, Text_Io.Out_File, Tmp_Filename); Text_Io.Open(Source, Text_Io.In_File, Filename); while not Text_Io.End_Of_File(Source) loop declare Line : constant String := Text_Io.Get_Line(Source); begin if not Done then if Fixed.Index(Line, Var_Name) /= 0 then Text_Io.Put_Line(Line); Text_Io.Put_Line(Target, Line(Line'First..Fixed.Index(Line, "=")+1) & Value & " ; "); Done := True; else Text_Io.Put_Line(Target, Line); end if; else Text_Io.Put_Line(Target, Line); end if; end; end loop; Text_Io.Close(Target); Text_Io.delete(Source); directories.Rename(Tmp_Filename, Filename); end if; end Replace_Description; function Version_Update(Version : in M.Versions.Version_Type) return M.Versions.Version_Type is The_Version : M.Versions.Version_Type := version; begin if Versions.New_Action and (not Versions.New_Description) then if The_Version.Revision_Version + 1 < Revision_Version_Type'Last then The_Version.Revision_Version := The_Version.Revision_Version + 1; elsif The_Version.Major_Version + 1 < Major_Version_Type'Last then The_Version.Major_Version := The_Version.Major_Version + 1; The_Version.Minor_Version := 0; The_Version.Revision_Version := 0; else raise Impl_Limit; end if; elsif Versions.New_Description and Versions.New_Action then if The_Version.Minor_Version + 1 < Minor_Version_Type'Last then The_Version.Minor_Version := The_Version.Minor_Version + 1; The_Version.Revision_Version := 0; elsif The_Version.Revision_Version + 1 < Revision_Version_Type'Last then The_Version.Revision_Version := The_Version.Revision_Version + 1; elsif The_Version.Major_Version + 1 < Major_Version_Type'Last then The_Version.Major_Version := The_Version.Major_Version + 1; The_Version.Minor_Version := 0; The_Version.Revision_Version := 0; else raise Impl_Limit; end if; elsif Versions.New_Description then The_Version.Release_Version := 'a'; if The_Version.Minor_Version + 1 < Minor_Version_Type'Last then The_Version.Minor_Version := The_Version.Minor_Version + 1; The_Version.Revision_Version := 0; elsif The_Version.Revision_Version + 1 < Revision_Version_Type'Last then The_Version.Revision_Version := The_Version.Revision_Version + 1; elsif The_Version.Major_Version + 1 < Major_Version_Type'Last then The_Version.Major_Version := The_Version.Major_Version + 1; The_Version.Minor_Version := 0; The_Version.Revision_Version := 0; else raise Impl_Limit; end if; elsif The_Version.Release_Version = 'a' then The_Version.Release_Version := 'b'; if The_Version.Minor_Version + 1 < Minor_Version_Type'Last then The_Version.Minor_Version := The_Version.Minor_Version + 1; The_Version.Revision_Version := 0; elsif The_Version.Revision_Version + 1 < Revision_Version_Type'Last then The_Version.Revision_Version := The_Version.Revision_Version + 1; elsif The_Version.Major_Version + 1 < Major_Version_Type'Last then The_Version.Major_Version := The_Version.Major_Version + 1; The_Version.Minor_Version := 0; The_Version.Revision_Version := 0; else raise Impl_Limit; end if; else The_Version.Release_Version := 'r'; if The_Version.Revision_Version + 1 < Revision_Version_Type'Last then The_Version.Revision_Version := The_Version.Revision_Version + 1; elsif The_Version.Minor_Version + 1 < Minor_Version_Type'Last then The_Version.Minor_Version := The_Version.Minor_Version + 1; The_Version.Revision_Version := 0; elsif The_Version.Major_Version + 1 < Major_Version_Type'Last then The_Version.Major_Version := The_Version.Major_Version + 1; The_Version.Minor_Version := 0; The_Version.Revision_Version := 0; else raise Impl_Limit; end if; end if; return The_Version; end Version_Update; procedure Users_Read (Users : in out User_Set; filename : in string) is File : W_Io.File_Type; Iter : Natural := 0; begin W_Io.Open(File, W_Io.In_File, filename, Form => "WCEM=8"); while not W_Io.End_Of_File(File) loop --Player_Type := Player_Enum'Value(Handling.To_String(W_Io.Get_Line(File))); declare user : User_Record; begin User.Logname := new String ' (Handling.To_String(W_Io.Get_Line(File))); User.Password := new String '(Handling.To_String(W_Io.Get_Line(File))); User.Identity.Full_Name := new Wide_String ' (W_Io.Get_Line(File)); User.Identity.address := new Wide_String ' (W_Io.Get_Line(File)); User.Identity.City_Code := new Wide_String ' (W_Io.Get_Line(File)); User.Identity.City_Name := new Wide_String ' (W_Io.Get_Line(File)); User.Identity.email := new Wide_String ' (W_Io.Get_Line(File)); User.Identity.Web_Addr := new Wide_String ' (W_Io.Get_Line(File)); Users.set(Iter + 1) := new User_Record ' (User); Iter := Iter + 1; end; end loop; Users.User_Last := Iter; W_Io.Close(File); end Users_Read; procedure Users_Write (Users : in out User_Set; filename: in String) is File : W_Io.File_Type; begin W_Io.Create(File, W_Io.Out_File, filename, Form => "WCEM=8"); for Iter in 1..Users.User_Last loop declare User : constant User_Record := Users.Set(Iter).all; begin if User.Logname /= null then W_Io.Put_Line(File, Handling.To_Wide_String(User.Logname.all)); W_Io.Put_Line(File, Handling.To_Wide_String(User.Password.all)); W_Io.Put_Line(File, User.Identity.Full_Name.all); W_Io.Put_Line(File, User.Identity.Address.all); W_Io.Put_Line(File, User.Identity.City_Code.all); W_Io.Put_Line(File, User.Identity.City_Name.all); W_Io.Put_Line(File, User.Identity.Email.all); if User.Identity.Web_Addr /= null then W_Io.Put_Line(File, User.Identity.Web_Addr.all); else W_Io.Put_Line(File, ""); end if; else exit; end if; end; end loop; W_Io.Close(File); end Users_write; function New_Wide_String (Title : in Wide_String; Label : in Wide_String; Length : in Positive; Line, Col : in Positive; Print : in Boolean) return Wide_String; function New_Auth return Logon_Record is Auth : Logon_Record; Logname : access String; begin Logname := Os_Lib.Getenv("LOGNAME"); if Logname /= null then Auth.Logname := new String ' (Logname.all); else Auth.Logname := new String ' (Handling.To_String(New_Wide_String("Authentification", "Logname : ", 24, Lines/2-3, Columns/2-19, True))); end if; Auth.password := Sha1.Digest (Handling.To_String (New_Wide_String ("Authentification", "Password : ", 25, Lines/2-3, Columns/2-20, false))); return Auth; end New_Auth; task body Auth_Process is Denied_Access : Window_Type := (Lines/2-3, Columns/2-10, 5, 20, Single_Line_Frame, cyan, White); Id_Win : Window_Type := (1, (Columns/4)*2+1, 8, Columns/2-1, Single_Line_Frame, Yellow, Green); Correct : Wide_Access; User : User_Record; begin Main_Loop: loop loop select accept Receive (Wchar : in Wide_Character); or accept Halt do null; --W_Io.Put_Line("Halting Author..."); end Halt; exit Main_loop; or accept Wake_Up(Top : in Natural) do --W_Io.Put_Line("Auth");null; null; end Wake_Up; or accept Suspend; exit; or accept Refresh; or accept Page_Down; or accept Page_Up; or accept Up_Arrow do null; end up_arrow; or accept Down_Arrow do null; end Down_Arrow; or accept Left_Arrow; or accept Right_Arrow; or accept Del; or accept Begin_Of; or accept End_Of; or accept Overwrite; end select; end loop; loop select accept Halt; exit Main_Loop; or accept Suspend; or accept Auth do Ansi.Console.Clear_Screen; declare Identity : Identity_Record; Done : Boolean := False; begin while not Done loop loop begin App.User_Auth := New_Auth; exit; exception when others => Ansi.Console.Clear_Screen; Draw_Window(Denied_Access); Draw(Denied_Access, 2, 3, Red, "Access denied"); delay 2.0; Ansi.Console.Clear_Screen; end; end loop; --Ansi.Console.Clear_Screen; case Os_Constants.Target_Os is when Os_Constants.Windows => App.User_path := Getenv("HOMEPATH"); when others => App.User_path := Getenv("HOME"); end case; if Os_Lib.Is_Regular_File(App.User_Path.all & Dir_separator & "users.txt") then Users_Read(App.Visitors, App.User_Path.all & Dir_separator & "users.txt"); --if App.Visitors /= null and then if App.Visitors.User_Last /= 0 then for Iter in 1..App.Visitors.User_Last loop declare User : User_Access := App.Visitors.Set(Iter); begin if User.Logname /= null then if User.Logname.all = App.User_Auth.Logname.all and then User.Password.all = App.User_Auth.password then Identity := User.Identity; App.User := User; App.User_Ready := True; Done := True; App.Full_Shell_Filename := new String ' (App.User_Path.all & Dir_separator & Shell_file); exit; end if; else exit; end if; end; end loop; end if; end if; if not Done then while not Done loop begin Ansi.Console.Clear_Screen; if App.User_Auth.Password = Sha1.Digest (Handling.To_String (New_Wide_String("Verify password", "Password : ", 25, Lines/2-3, Columns/2-20, false))) then user.Logname := new String ' (App.User_Auth.Logname.all); User.password := new String ' (App.User_Auth.Password); loop begin Ansi.Console.Clear_Screen; Identity.Full_Name := new Wide_String ' (New_Wide_String("Identification", "Full name : ", 25, Lines/2-3, Columns/2-19, True)); Ansi.Console.Clear_Screen; Identity.Address := new Wide_String ' (New_Wide_String("Identification", "Address : ", 48, Lines/2-3, Columns/2-30, True)); Ansi.Console.Clear_Screen; Identity.City_Code := new Wide_String ' (New_Wide_String ("Identification", "City code : ", 10, Lines/2-3, Columns/2-11, True)); Ansi.Console.Clear_Screen; Identity.City_Name := new Wide_String ' (New_Wide_String("Identification", "City : ", 25, Lines/2-3, Columns/2-16, True)); Ansi.Console.Clear_Screen; Identity.email := new Wide_String ' (New_Wide_String("Identification", "Email address : ", 49, Lines/2-3, Columns/2-37, True)); exception when W_Io.End_Error => raise; end; Ansi.Console.Clear_Screen; Draw_Window(Id_Win); Draw(Id_Win, 1, Id_Win.w/2-5, Magenta, "Informations"); Draw(Id_Win, 2, 2, White, "Logname : " & Handling.To_Wide_String(User.Logname.all)); Draw(Id_Win, 3, 2, White, "Full name : " & Identity.Full_Name.all); Draw(Id_Win, 4, 2, White, "Address : " & Identity.Address.all); Draw(Id_Win, 5, 2, White, "Code & City : " & Identity.City_name.all & ' ' & Identity.City_Code.all); Draw(Id_Win, 6, 2, White, "Email : " & Identity.Email.all); Correct := new Wide_String ' (New_Wide_String ("Verification", "This informations are correct (y/o or n) : ", 3, Lines/2-3, Columns/2-25, True)); if Correct /= null and then Correct'Length = 1 then case Correct(1) is when 'y' | 'o' => User.Identity := Identity; User.Logname := new String ' (App.User_Auth.Logname.all); User.Password := new String '(App.User_Auth.Password); -- if App.Visitors = null then -- App.Visitors := new User_Set(4); -- end if; App.Visitors.Set(App.Visitors.User_Last + 1) := new User_Record ' (User); App.Visitors.User_Last := App.Visitors.User_Last + 1; App.User := App.Visitors.Set(App.Visitors.User_Last); App.User_Ready := True; Done := True; when others => null; end case; if Done then Correct := new Wide_String ' (New_Wide_String ("Restering", "Do you want registerring this informations (y/o or n) : ", 3, Lines/2-3, Columns/2-25, True)); if Correct /= null and then Correct'Length = 1 then case Correct(1) is when 'y' | 'o' => --if App.Visitors = null then -- raise Spec_Error; --end if; Users_Write (App.Visitors, App.User_Path.all & Dir_Separator & "users.txt"); when others => null; end case; end if; end if; if Done then exit; end if; end if; end loop; else Ansi.Console.Clear_Screen; Draw_Window(Denied_Access); Draw(Denied_Access, 2, 3, Red, "Access denied"); delay 2.0; Ansi.Console.Clear_Screen; exit; end if; exception when W_Io.End_Error => Ansi.Console.Clear_Screen; exit; end; end loop; end if; end loop; end; Put(Normal_Mode); end Auth; or accept Wake_Up(Top : in Natural) do --W_Io.Put_Line("Auth"); --Text_Io.Put_Line("Greetings " & Getenv("USER").all & "!"); null; end Wake_Up; exit; end select; end loop; end loop Main_Loop; --W_Io.Put_Line("Author halted"); end Auth_Process; task body Console_Process is Errno : Integer := 0; End_Of_This_Task : Boolean := False; The_Wchar : Wide_Character := Wide_Character'Val(32); begin loop select accept Initialize do App.Desktop := (1 => Functions(0), 2 => Functions(12)); for Mode in Functions'Range loop if Functions(Mode) /= null then case Functions(Mode).Name is when None => None_Record(Functions(Mode).all).Proc.Suspend; when Log => Logs_Record(Functions(Mode).all).Proc.Suspend; when MoneyBox => Moneybox_Record(Functions(Mode).all).Proc.Suspend; when Activity => Activity_Record(Functions(Mode).all).Proc.Suspend; when Stocks => Stocks_Record(Functions(Mode).all).Proc.Suspend; when Bank => bank_Record(Functions(Mode).all).Proc.Suspend; when Planning => planning_Record(Functions(Mode).all).Proc.Suspend; when Library => Library_Record(Functions(Mode).all).Proc.Suspend; when Manager => Manager_Record(Functions(Mode).all).Proc.Suspend; when Contacts => Contacts_Record(Functions(Mode).all).Proc.Suspend; when Menu => Menu_Record(Functions(Mode).all).Proc.Suspend; when Organizer => Organizer_Record(Functions(Mode).all).Proc.Suspend; when Dialog=> Vbrain_Record(Functions(Mode).all).Proc.Suspend; when Navigation => Master_Record(Functions(Mode).all).Proc.Suspend; when Engineer => Engine_Record(Functions(Mode).all).Proc.Suspend; when Devel => Devel_Record(Functions(Mode).all).Proc.Suspend; when Admin=> WOPR_Record(Functions(Mode).all).Proc.Suspend; when Terminator => Workstation_Record(Functions(Mode).all).Proc.Suspend; when Joshua => Space_Fighter_Record(Functions(Mode).all).Proc.Suspend; when Entreprise => Person_Record(Functions(Mode).all).Proc.Suspend; when Process => World_Record(Functions(Mode).all).Proc.Suspend; when Auth => Auth_Record(Functions(Mode).all).Proc.Suspend; when Gate => Gate_Record(Functions(Mode).all).Proc.Suspend; when Shell_interface => Shell_Record(Functions(Mode).all).Proc.Suspend; when Self_Development => Self_Development_Record(Functions(Mode).all).Proc.Suspend; when Audit => Audits_Record(Functions(Mode).all).Proc.Suspend; when All_Manuals => All_Manuals_Record(Functions(Mode).all).Proc.Suspend; when others => null; end case; end if; end loop; end Initialize; or accept Receive(Wchar : in Wide_Character) do The_Wchar := Wchar; end Receive; case App.Desktop(1).Name is when None => None_Record(App.Desktop(1).all).Proc.Receive(The_Wchar); when Organizer => Organizer_Record(App.Desktop(1).all).Proc.Receive(The_Wchar); when Dialog => Vbrain_Record(App.Desktop(1).all).Proc.Receive(The_Wchar); when Planning => Planning_Record(App.Desktop(1).all).Proc.Receive(The_Wchar); when Manager => Manager_Record(App.Desktop(1).all).Proc.Receive(The_Wchar); when Moneybox => Moneybox_Record(App.Desktop(1).all).Proc.Receive(The_Wchar); when Activity => Activity_Record(App.Desktop(1).all).Proc.Receive(The_Wchar); when Stocks => Stocks_Record(App.Desktop(1).all).Proc.Receive(The_Wchar); when Bank => Bank_Record(App.Desktop(1).all).Proc.Receive(The_Wchar); when Log => Logs_Record(App.Desktop(1).all).Proc.Receive(The_Wchar); when Menu => Menu_Record(App.Desktop(1).all).Proc.Receive(The_Wchar); when Contacts => Contacts_Record(App.Desktop(1).all).Proc.Receive(The_Wchar); when Library => Library_Record(App.Desktop(1).all).Proc.Receive(The_Wchar); when Navigation => Master_Record(App.Desktop(1).all).Proc.Receive(The_Wchar); when Engineer => Engine_Record(App.Desktop(1).all).Proc.Receive(The_Wchar); when Devel => Devel_Record(App.Desktop(1).all).Proc.Receive(The_Wchar); when Admin=> WOPR_Record(App.Desktop(1).all).Proc.Receive(The_Wchar); when Terminator => Workstation_Record(App.Desktop(1).all).Proc.Receive(The_Wchar); when Joshua => Space_Fighter_Record(App.Desktop(1).all).Proc.Receive(The_Wchar); when Entreprise => Person_Record(App.Desktop(1).all).Proc.Receive(The_Wchar); when Process => World_Record(App.Desktop(1).all).Proc.Receive(The_Wchar); when Auth => Auth_Record(App.Desktop(1).all).Proc.Receive(The_Wchar); when Gate => Gate_Record(App.Desktop(1).all).Proc.Receive(The_Wchar); when Self_Development => Self_Development_Record(App.Desktop(1).all).Proc.Receive(The_Wchar); when Shell_interface => Shell_Record(App.Desktop(1).all).Proc.Receive(The_Wchar); when Audit => Audits_Record(App.Desktop(1).all).Proc.Receive(The_Wchar); when All_manuals => All_manuals_Record(App.Desktop(1).all).Proc.Receive(The_Wchar); when others => null; end case; or accept Halt do for Log in Log_Enum'Range loop Close(App.Sessions(Log)); end loop; Statistic(App.Sessions, App.Logs); for Mode in Functions'Range loop if Functions(Mode) /= null then case Functions(Mode).Name is when None => None_Record(Functions(Mode).all).Proc.Halt; when Log => Logs_Record(Functions(Mode).all).Proc.Halt; when MoneyBox => Moneybox_Record(Functions(Mode).all).Proc.Halt; when Activity => Activity_Record(Functions(Mode).all).Proc.Halt; when Stocks => Stocks_Record(Functions(Mode).all).Proc.Halt; when Bank => bank_Record(Functions(Mode).all).Proc.Halt; when Planning => planning_Record(Functions(Mode).all).Proc.Halt; when Library => Library_Record(Functions(Mode).all).Proc.Halt; when Manager => Manager_Record(Functions(Mode).all).Proc.Halt; when Contacts => Contacts_Record(Functions(Mode).all).Proc.Halt; when Menu => Menu_Record(Functions(Mode).all).Proc.Halt; when Organizer => organizer_Record(Functions(Mode).all).Proc.Halt; when Dialog=> Vbrain_Record(Functions(Mode).all).Proc.Halt; when Navigation => Master_Record(Functions(Mode).all).Proc.Halt; when Engineer => Engine_Record(Functions(Mode).all).Proc.Halt; when Devel => Devel_Record(Functions(Mode).all).Proc.Halt; when Admin=> WOPR_Record(Functions(Mode).all).Proc.Halt; when Terminator => Workstation_Record(Functions(Mode).all).Proc.Halt; when Joshua => Space_Fighter_Record(Functions(Mode).all).Proc.Halt; when Entreprise => Person_Record(Functions(Mode).all).Proc.Halt; when Process => World_Record(Functions(Mode).all).Proc.Halt; when Auth => Auth_Record(Functions(Mode).all).Proc.Halt; when Gate => Gate_Record(Functions(Mode).all).Proc.Halt; when Shell_interface => Shell_Record(Functions(Mode).all).Proc.Halt; when Self_Development => Self_Development_Record(Functions(Mode).all).Proc.Halt; when Audit => Audits_Record(Functions(Mode).all).Proc.Halt; when All_manuals => All_manuals_Record(Functions(Mode).all).Proc.Halt; when others => null; end case; end if; end loop; end Halt; --W_Io.Put_Line("Halting system."); exit; or accept Mode (Mode : out Mode_Enum) do if App.Mode /= Quit then Mode := App.Desktop(1).Name; else Mode := Quit; end if; end Mode; or accept Reset do Put(Ansi_Tty_Control.Clear_Screen); for Log in Log_Enum'Range loop Close(App.Sessions(Log)); end loop; Statistic(App.Sessions, App.Logs); if App.Desktop(1) /= null then case App.Desktop(1).Name is when None => None_Record(App.Desktop(1).all).Proc.Suspend; when Log => Logs_Record(App.Desktop(1).all).Proc.Suspend; when MoneyBox => Moneybox_Record(App.Desktop(1).all).Proc.Suspend; when Activity => Activity_Record(App.Desktop(1).all).Proc.Suspend; when Stocks => Stocks_Record(App.Desktop(1).all).Proc.Suspend; when Bank => bank_Record(App.Desktop(1).all).Proc.Suspend; when Planning => planning_Record(App.Desktop(1).all).Proc.Suspend; when Library => Library_Record(App.Desktop(1).all).Proc.Suspend; when Manager => Manager_Record(App.Desktop(1).all).Proc.Suspend; when Contacts => Contacts_Record(App.Desktop(1).all).Proc.Suspend; when Menu => Menu_Record(App.Desktop(1).all).Proc.Suspend; when Organizer => Organizer_Record(App.Desktop(1).all).Proc.Suspend; when Dialog=> Vbrain_Record(App.Desktop(1).all).Proc.Suspend; when Navigation => Master_Record(App.Desktop(1).all).Proc.Suspend; when Engineer => Engine_Record(App.Desktop(1).all).Proc.Suspend; when Devel => Devel_Record(App.Desktop(1).all).Proc.Suspend; when Admin=> WOPR_Record(App.Desktop(1).all).Proc.Suspend; when Terminator => Workstation_Record(App.Desktop(1).all).Proc.Suspend; when Joshua => Space_Fighter_Record(App.Desktop(1).all).Proc.Suspend; when Entreprise => Person_Record(App.Desktop(1).all).Proc.Suspend; when Process => World_Record(App.Desktop(1).all).Proc.Suspend; when Auth => Auth_Record(App.Desktop(1).all).Proc.Suspend; when Gate => Gate_Record(App.Desktop(1).all).Proc.Suspend; when Shell_interface => Shell_Record(App.Desktop(1).all).Proc.Suspend; when Self_Development => Self_Development_Record(App.Desktop(1).all).Proc.Suspend; when Audit => Audits_Record(App.Desktop(1).all).Proc.Suspend; when All_manuals => All_manuals_Record(App.Desktop(1).all).Proc.Suspend; when others => null; end case; end if; if App.Desktop(1).Name = None then null; elsif App.Desktop(1).Name = Entreprise then null; elsif App.Desktop(1).Name = planning then App.Desktop(2) := Functions(5); App.Desktop(1) := Functions(4); elsif App.Desktop(1).Name = Dialog then App.Desktop(2) := Functions(4); App.Desktop(1) := Functions(3); elsif App.Desktop(1).Name = Log then App.Desktop(2) := Functions(12); App.Desktop(1) := Functions(10); elsif App.Desktop(1).Name = Menu then App.Desktop(1) := Functions(0); App.Desktop(2) := Functions(10); elsif App.Desktop(1).Name = Moneybox and App.Desktop(2).Name = Activity then App.Desktop(1) := Functions(4); App.Desktop(2) := Functions(1); elsif App.Desktop(1).Name = Manager and App.Desktop(2).Name = organizer then App.Desktop(1) := Functions(1); App.Desktop(2) := Functions(4); elsif App.Desktop(1).name in Organizer .. moneybox then App.Desktop(2) := App.desktop(1); App.Desktop(1) := Functions(Mode_Enum'Pos(Mode_Enum'Succ(App.Desktop(1).Name))); elsif App.Desktop(1).Name = Activity then App.Desktop(1) := Functions(5); App.Desktop(2) := Functions(6); elsif App.Desktop(1).Name = Stocks then App.Desktop(1) := Functions(6); App.Desktop(2) := Functions(7); elsif App.Desktop(1).Name = Log then App.Desktop(1) := App.Desktop(2); App.Desktop(2) := Functions(9); end if; case App.Desktop(1).Name is when None => None_Record(App.Desktop(1).all).Proc.Suspend; when Log => Logs_Record(App.Desktop(1).all).Proc.Suspend; when MoneyBox => Moneybox_Record(App.Desktop(1).all).Proc.Suspend; when Activity => Activity_Record(App.Desktop(1).all).Proc.Suspend; when Stocks => Stocks_Record(App.Desktop(1).all).Proc.Suspend; when Bank => bank_Record(App.Desktop(1).all).Proc.Suspend; when Planning => planning_Record(App.Desktop(1).all).Proc.Suspend; when Library => Library_Record(App.Desktop(1).all).Proc.Suspend; when Manager => Manager_Record(App.Desktop(1).all).Proc.Suspend; when Contacts => Contacts_Record(App.Desktop(1).all).Proc.Suspend; when Menu => Menu_Record(App.Desktop(1).all).Proc.Suspend; when Organizer => organizer_Record(App.Desktop(1).all).Proc.Suspend; when Dialog=> Vbrain_Record(App.Desktop(1).all).Proc.Suspend; when Navigation => Master_Record(App.Desktop(1).all).Proc.Suspend; when Engineer => Engine_Record(App.Desktop(1).all).Proc.Suspend; when Devel => Devel_Record(App.Desktop(1).all).Proc.Suspend; when Admin=> WOPR_Record(App.Desktop(1).all).Proc.Suspend; when Terminator=> Workstation_Record(App.Desktop(1).all).Proc.Suspend; when Joshua => Space_Fighter_Record(App.Desktop(1).all).Proc.Suspend; when Entreprise => null; when Process => null; when Auth => Auth_Record(App.Desktop(1).all).Proc.Suspend; when Gate => Gate_Record(App.Desktop(1).all).Proc.Suspend; when Shell_interface => Shell_Record(App.Desktop(1).all).Proc.Suspend; when Self_Development => Self_Development_Record(App.Desktop(1).all).Proc.Suspend; when Audit => Audits_Record(App.Desktop(1).all).Proc.Suspend; when All_manuals => All_manuals_Record(App.Desktop(1).all).Proc.Suspend; when others => null; end case; if App.Desktop(2) /= null then case App.Desktop(2).Name is when None => None_Record(App.Desktop(2).all).Proc.Suspend; when Log => Logs_Record(App.Desktop(2).all).Proc.Suspend; when MoneyBox => Moneybox_Record(App.Desktop(2).all).Proc.Suspend; when Activity => Activity_Record(App.Desktop(2).all).Proc.Suspend; when Stocks => Stocks_Record(App.Desktop(2).all).Proc.Suspend; when Bank => bank_Record(App.Desktop(2).all).Proc.Suspend; when Planning => planning_Record(App.Desktop(2).all).Proc.Suspend; when Library => Library_Record(App.Desktop(2).all).Proc.Suspend; when Manager => Manager_Record(App.Desktop(2).all).Proc.Suspend; when Contacts => Contacts_Record(App.Desktop(2).all).Proc.Suspend; when Menu => Menu_Record(App.Desktop(2).all).Proc.Suspend; when Organizer => organizer_Record(App.Desktop(2).all).Proc.Suspend; when Dialog=> Vbrain_Record(App.Desktop(2).all).Proc.Suspend; when Navigation => Master_Record(App.Desktop(2).all).Proc.Suspend; when Engineer => Engine_Record(App.Desktop(2).all).Proc.Suspend; when Devel => Devel_Record(App.Desktop(2).all).Proc.Suspend; when Admin=> WOPR_Record(App.Desktop(2).all).Proc.Suspend; when Terminator=> Workstation_Record(App.Desktop(2).all).Proc.Suspend; when Joshua => Space_Fighter_Record(App.Desktop(2).all).Proc.Suspend; when Entreprise => null; when Process => null; when Gate => Gate_Record(App.Desktop(2).all).Proc.Suspend; when Shell_interface => Shell_Record(App.Desktop(2).all).Proc.Suspend; when Self_Development => Self_Development_Record(App.Desktop(2).all).Proc.Suspend; when Audit => Audits_Record(App.Desktop(2).all).Proc.Suspend; when All_manuals => All_manuals_Record(App.Desktop(2).all).Proc.Suspend; when others => null; end case; case App.Desktop(2).Name is when None => null; when Log => Logs_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when MoneyBox => Moneybox_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when Activity => Activity_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when Stocks => Stocks_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when Bank => bank_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when Planning => planning_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when Library => Library_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when Manager => Manager_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when Contacts => Contacts_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when Menu => null; when Organizer => organizer_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when Dialog=> null; when Entreprise => null; when Process => null; when Audit => Audits_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when All_manuals => All_manuals_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when others => null; end case; end if; delay 0.25; if App.Desktop(1) /= null then case App.Desktop(1).Name is when None => Open(App.Sessions(None)); None_Record(App.Desktop(1).all).Proc.Wake_Up(0); when Log => Logs_Record(App.Desktop(1).all).Proc.Wake_up(0); when MoneyBox => Open(App.Sessions(Moneybox)); Moneybox_Record(App.Desktop(1).all).Proc.Wake_up(0); when Activity => Open(App.Sessions(Activity)); Activity_Record(App.Desktop(1).all).Proc.Wake_up(0); when Stocks => Open(App.Sessions(Stocks)); Stocks_Record(App.Desktop(1).all).Proc.Wake_up(0); when Bank => Open(App.Sessions(Bank)); bank_Record(App.Desktop(1).all).Proc.Wake_up(0); when Planning => Open(App.Sessions(Planning)); Planning_Record(App.Desktop(1).all).Proc.Wake_up(0); when Library => Library_Record(App.Desktop(1).all).Proc.Wake_up(0); when Manager => Manager_Record(App.Desktop(1).all).Proc.Wake_up(0); when Contacts => Contacts_Record(App.Desktop(1).all).Proc.Wake_up(0); when Menu => --Errno := System("clear" & Character'Val(0)); Menu_Record(App.Desktop(1).all).Proc.Wake_up(0); when Organizer => Open(App.Sessions(Organizer)); Organizer_Record(App.Desktop(1).all).Proc.Wake_up(0); when Dialog=> Open(App.Sessions(Computer)); Vbrain_Record(App.Desktop(1).all).Proc.Wake_up(0); when Navigation => Master_Record(App.Desktop(1).all).Proc.Wake_up(0); when Engineer => --Errno := System("clear" & Character'Val(0)); Engine_Record(App.Desktop(1).all).Proc.Wake_up(0); when Devel => Devel_Record(App.Desktop(1).all).Proc.Wake_up(0); when Admin => WOPR_Record(App.Desktop(1).all).Proc.Wake_up(0); when Terminator => Workstation_Record(App.Desktop(1).all).Proc.Wake_Up(0); when Joshua => Space_Fighter_Record(App.Desktop(1).all).Proc.Wake_Up(0); when Entreprise => Person_Record(App.Desktop(1).all).Proc.Wake_Up(0); when Process => World_Record(App.Desktop(1).all).Proc.Wake_Up(0); when Gate => Gate_Record(App.Desktop(1).all).Proc.Wake_Up(0); when Shell_interface => Shell_Record(App.Desktop(1).all).Proc.Wake_Up(0); when Self_Development => Self_Development_Record(App.Desktop(1).all).Proc.Wake_Up(0); when audit => audits_Record(App.Desktop(1).all).Proc.Wake_Up(0); when All_manuals => All_manuals_Record(App.Desktop(1).all).Proc.Wake_Up(0); when others => null; end case; end if; end Reset; or accept Switch (Mode : in Mode_Enum) do for Log in Log_Enum'Range loop Close(App.Sessions(Log)); end loop; Statistic(App.Sessions, App.Logs); --if Mode /= App.Mode then App.Desktop(2) := App.Desktop(1); Put(Ansi_Tty_Control.Clear_Screen); if App.Desktop(1) /= null then case App.Desktop(1).Name is when None => None_Record(App.Desktop(1).all).Proc.Suspend; when Log => Logs_Record(App.Desktop(1).all).Proc.Suspend; when MoneyBox => Moneybox_Record(App.Desktop(1).all).Proc.Suspend; when Activity => Activity_Record(App.Desktop(1).all).Proc.Suspend; when Stocks => Stocks_Record(App.Desktop(1).all).Proc.Suspend; when Bank => bank_Record(App.Desktop(1).all).Proc.Suspend; when Planning => planning_Record(App.Desktop(1).all).Proc.Suspend; when Library => Library_Record(App.Desktop(1).all).Proc.Suspend; when Manager => Manager_Record(App.Desktop(1).all).Proc.Suspend; when Contacts => Contacts_Record(App.Desktop(1).all).Proc.Suspend; when Menu => Menu_Record(App.Desktop(1).all).Proc.Suspend; when Organizer => Organizer_Record(App.Desktop(1).all).Proc.Suspend; when Dialog=> Vbrain_Record(App.Desktop(1).all).Proc.Suspend; when Navigation => Master_Record(App.Desktop(1).all).Proc.Suspend; when Engineer => Engine_Record(App.Desktop(1).all).Proc.Suspend; when Devel => Devel_Record(App.Desktop(1).all).Proc.Suspend; when Admin=> WOPR_Record(App.Desktop(1).all).Proc.Suspend; when Terminator => Workstation_Record(App.Desktop(1).all).Proc.Suspend; when Joshua => Space_Fighter_Record(App.Desktop(1).all).Proc.Suspend; when Entreprise => Person_Record(App.Desktop(1).all).Proc.Suspend; when Process => World_Record(App.Desktop(1).all).Proc.Suspend; when Audit => Audits_Record(App.Desktop(1).all).Proc.Suspend; when All_manuals => All_manuals_Record(App.Desktop(1).all).Proc.Suspend; when others => null; end case; end if; if App.Desktop(2) /= null then case App.Desktop(2).Name is when None => None_Record(App.Desktop(2).all).Proc.Suspend; when Log => Logs_Record(App.Desktop(2).all).Proc.Suspend; when MoneyBox => Moneybox_Record(App.Desktop(2).all).Proc.Suspend; when Activity => Activity_Record(App.Desktop(2).all).Proc.Suspend; when Stocks => Stocks_Record(App.Desktop(2).all).Proc.Suspend; when Bank => bank_Record(App.Desktop(2).all).Proc.Suspend; when Planning => planning_Record(App.Desktop(2).all).Proc.Suspend; when Library => Library_Record(App.Desktop(2).all).Proc.Suspend; when Manager => Manager_Record(App.Desktop(2).all).Proc.Suspend; when Contacts => Contacts_Record(App.Desktop(2).all).Proc.Suspend; when Menu => Menu_Record(App.Desktop(2).all).Proc.Suspend; when Organizer => Organizer_Record(App.Desktop(2).all).Proc.Suspend; when Dialog=> Vbrain_Record(App.Desktop(2).all).Proc.Suspend; when Navigation => Master_Record(App.Desktop(2).all).Proc.Suspend; when Engineer => Engine_Record(App.Desktop(2).all).Proc.Suspend; when Devel => Devel_Record(App.Desktop(2).all).Proc.Suspend; when Admin => WOPR_Record(App.Desktop(2).all).Proc.Suspend; when Terminator => Workstation_Record(App.Desktop(2).all).Proc.Suspend; when Entreprise => Person_Record(App.Desktop(2).all).Proc.Suspend; when Process => World_Record(App.Desktop(2).all).Proc.Suspend; when Audit => Audits_Record(App.Desktop(2).all).Proc.Suspend; when All_manuals => All_manuals_Record(App.Desktop(2).all).Proc.Suspend; when others => null; end case; end if; if Mode /= Quit then if App.Desktop(1).Name /= Dialog and App.Desktop(1).Name /= Entreprise then null; else App.Desktop(2) := Functions(9); end if; App.Desktop(1) := Functions(Mode_Enum'Pos(Mode)); case App.desktop(2).Name is when None => null; when Log => Logs_Record(App.Desktop(2).all).Proc.Wake_up(App.Columns/2); when MoneyBox => Moneybox_Record(App.Desktop(2).all).Proc.Wake_up(App.Columns/2); when Activity => Activity_Record(App.Desktop(2).all).Proc.Wake_up(App.Columns/2); when Stocks => Stocks_Record(App.Desktop(2).all).Proc.Wake_up(App.Columns/2); when Bank => bank_Record(App.Desktop(2).all).Proc.Wake_up(App.Columns/2); when Planning => Planning_Record(App.Desktop(2).all).Proc.Wake_up(App.Columns/2); when Library => Library_Record(App.Desktop(2).all).Proc.Wake_up(App.Columns/2); when Manager => Manager_Record(App.Desktop(2).all).Proc.Wake_up(App.Columns/2); when Contacts => Contacts_Record(App.Desktop(2).all).Proc.Wake_up(App.Columns/2); when Devel => Devel_Record(App.Desktop(2).all).Proc.Wake_up(App.Columns/2); when Menu => null; when Organizer => Organizer_Record(App.Desktop(2).all).Proc.Wake_up(App.Columns/2); when Dialog=> null; when Terminator => null; when Entreprise => null; when Process => null; when Audit => Audits_Record(App.Desktop(2).all).Proc.Wake_up(App.Columns/2); when All_manuals => All_manuals_Record(App.Desktop(2).all).Proc.Wake_up(App.Columns/2); when others => null; end case; delay 0.25; case App.desktop(1).Name is when None => None_Record(App.Desktop(1).all).Proc.Wake_Up(0); when Log => Logs_Record(App.Desktop(1).all).Proc.Wake_up(0); when MoneyBox => Moneybox_Record(App.Desktop(1).all).Proc.Wake_up(0); when Activity => Activity_Record(App.Desktop(1).all).Proc.Wake_up(0); when Stocks => Stocks_Record(App.Desktop(1).all).Proc.Wake_up(0); when Bank => bank_Record(App.Desktop(1).all).Proc.Wake_up(0); when Planning => Planning_Record(App.Desktop(1).all).Proc.Wake_up(0); when Library => Library_Record(App.Desktop(1).all).Proc.Wake_up(0); when Manager => Manager_Record(App.Desktop(1).all).Proc.Wake_up(0); when Contacts => Contacts_Record(App.Desktop(1).all).Proc.Wake_up(0); when Menu => --Errno := System("clear" & Character'Val(0)); Menu_Record(App.Desktop(1).all).Proc.Wake_up(0); when Organizer => Organizer_Record(App.Desktop(1).all).Proc.Wake_up(0); when Dialog=> Vbrain_Record(App.Desktop(1).all).Proc.Wake_up(0); when Navigation => Master_Record(App.Desktop(1).all).Proc.Wake_up(0); when Engineer => Engine_Record(App.Desktop(1).all).Proc.Wake_up(0); when Devel => Devel_Record(App.Desktop(1).all).Proc.Wake_up(0); when Admin=> WOPR_Record(App.Desktop(1).all).Proc.Wake_up(0); when Terminator => Workstation_Record(App.Desktop(1).all).Proc.Wake_up(0); when Joshua => Space_Fighter_Record(App.Desktop(1).all).Proc.Wake_up(0); when Entreprise => Person_Record(App.Desktop(1).all).Proc.Wake_up(0); when Process => World_Record(App.Desktop(1).all).Proc.Wake_up(0); when Audit => Audits_Record(App.Desktop(1).all).Proc.Wake_up(0); when All_manuals => All_manuals_Record(App.Desktop(1).all).Proc.Wake_up(0); when others => null; end case; end if; App.Mode := Mode; -- end if; end Switch; case App.Mode is when Quit => if End_Of_This_Task then accept Halt; for Mode in Functions'Range loop if Functions(Mode) /= null then case Functions(Mode).Name is when None => None_Record(Functions(Mode).all).Proc.Halt; when Log => Logs_Record(Functions(Mode).all).Proc.Halt; when MoneyBox => Moneybox_Record(Functions(Mode).all).Proc.Halt; when Activity => Activity_Record(Functions(Mode).all).Proc.Halt; when Stocks => Stocks_Record(Functions(Mode).all).Proc.Halt; when Bank => bank_Record(Functions(Mode).all).Proc.Halt; when Planning => planning_Record(Functions(Mode).all).Proc.Halt; when Library => Library_Record(Functions(Mode).all).Proc.Halt; when Manager => Manager_Record(Functions(Mode).all).Proc.Halt; when Contacts => Contacts_Record(Functions(Mode).all).Proc.Halt; when Menu => Menu_Record(Functions(Mode).all).Proc.Halt; when Organizer => organizer_Record(Functions(Mode).all).Proc.Halt; when Dialog=> Vbrain_Record(Functions(Mode).all).Proc.Halt; when Navigation => Master_Record(Functions(Mode).all).Proc.Halt; when Engineer => Engine_Record(Functions(Mode).all).Proc.Halt; when Devel => Devel_Record(Functions(Mode).all).Proc.Halt; when Admin=> WOPR_Record(Functions(Mode).all).Proc.Halt; when Terminator => Workstation_Record(Functions(Mode).all).Proc.Halt; when Joshua => Space_Fighter_Record(Functions(Mode).all).Proc.Halt; when Entreprise => Person_Record(Functions(Mode).all).Proc.Halt; when Process => World_Record(Functions(Mode).all).Proc.Halt; when Gate => Gate_Record(Functions(Mode).all).Proc.Halt; when Shell_interface => Shell_Record(Functions(Mode).all).Proc.Halt; when Self_Development => Self_Development_Record(Functions(Mode).all).Proc.Halt; when Audit => Audits_Record(Functions(Mode).all).Proc.Halt; when All_manuals => All_manuals_Record(Functions(Mode).all).Proc.Halt; when others => null; end case; end if; end loop; exit; else Gate_Record(Functions(36).all).Proc.Suspend; W_Io.Put("Realy quit ?"); App.Desktop(1) := Functions(0); App.Desktop(2) := null; end if; End_Of_This_Task := True; when None => Open(App.Sessions(None)); End_Of_This_Task := False; when Organizer..Admin => if App.Desktop(1) /= null then case App.Desktop(1).Name is when None => None_Record(App.Desktop(1).all).Proc.Wake_Up(0); when Log => Logs_Record(App.Desktop(1).all).Proc.Wake_up(0); when MoneyBox => Open(App.Sessions(Moneybox)); Moneybox_Record(App.Desktop(1).all).Proc.Wake_up(0); when Activity => Open(App.Sessions(Activity)); Activity_Record(App.Desktop(1).all).Proc.Wake_up(0); when Stocks => Open(App.Sessions(stocks)); Stocks_Record(App.Desktop(1).all).Proc.Wake_up(0); when Bank => Open(App.Sessions(bank)); bank_Record(App.Desktop(1).all).Proc.Wake_up(0); when Planning => Open(App.Sessions(planning)); Planning_Record(App.Desktop(1).all).Proc.Wake_up(0); when Library => Library_Record(App.Desktop(1).all).Proc.Wake_up(0); when Manager => Manager_Record(App.Desktop(1).all).Proc.Wake_up(0); when Contacts => Contacts_Record(App.Desktop(1).all).Proc.Wake_up(0); when Menu => --Errno := System("clear" & Character'Val(0)); Menu_Record(App.Desktop(1).all).Proc.Wake_up(0); when Organizer => Open(App.Sessions(Organizer)); Organizer_Record(App.Desktop(1).all).Proc.Wake_up(0); when Dialog=> Open(App.Sessions(computer)); Vbrain_Record(App.Desktop(1).all).Proc.Wake_up(0); when Navigation => Master_Record(App.Desktop(1).all).Proc.Wake_up(0); when Engineer => Engine_Record(App.Desktop(1).all).Proc.Wake_up(0); when Devel => Devel_Record(App.Desktop(1).all).Proc.Wake_up(0); when Admin=> WOPR_Record(App.Desktop(1).all).Proc.Wake_up(0); when Terminator => Workstation_Record(App.Desktop(1).all).Proc.Wake_up(0); when Joshua => Space_Fighter_Record(App.Desktop(1).all).Proc.Wake_up(0); when Entreprise => Person_Record(App.Desktop(1).all).Proc.Wake_up(0); when Process => World_Record(App.Desktop(1).all).Proc.Wake_up(0); when Audit => Audits_Record(App.Desktop(1).all).Proc.Wake_up(0); when All_manuals => All_manuals_Record(App.Desktop(1).all).Proc.Wake_up(0); when others => null; end case; end if; when Gate => Gate_Record(App.Desktop(1).all).Proc.Wake_up(0); when Auth => Auth_Record(functions(Mode_Enum'Pos(Auth)).all).Proc.Auth; when Self_Development => Gate_Record(Functions(36).all).Proc.Suspend; Self_Development_Record(App.Desktop(1).all).Proc.Wake_up(0); when Shell_interface => Gate_Record(Functions(36).all).Proc.Suspend; shell_Record(App.Desktop(1).all).Proc.Wake_up(0); when Audit => Gate_Record(Functions(36).all).Proc.Suspend; Audits_Record(App.Desktop(1).all).Proc.Wake_up(0); when All_manuals => Gate_Record(Functions(36).all).Proc.Suspend; All_manuals_Record(App.Desktop(1).all).Proc.Wake_up(0); when others => null; end case; or accept Set_On_Esc(Is_Escape : in Boolean) do App.On_Esc := Is_Escape; end Set_On_Esc; or accept Page_Down do if App.Desktop(1) /= null then case App.Desktop(1).Name is when None => None_Record(App.Desktop(1).all).Proc.Page_Down; when Log => Logs_Record(App.Desktop(1).all).Proc.Page_Down; when MoneyBox => Moneybox_Record(App.Desktop(1).all).Proc.Page_Down; when Activity => Activity_Record(App.Desktop(1).all).Proc.Page_Down; when Stocks => Stocks_Record(App.Desktop(1).all).Proc.Page_Down; when Bank => bank_Record(App.Desktop(1).all).Proc.Page_Down; when Planning => Planning_Record(App.Desktop(1).all).Proc.Page_Down; when Library => Library_Record(App.Desktop(1).all).Proc.Page_Down; when Manager => Manager_Record(App.Desktop(1).all).Proc.Page_Down; when Contacts => Contacts_Record(App.Desktop(1).all).Proc.Page_Down; when Menu => Menu_Record(App.Desktop(1).all).Proc.Page_Down; when Organizer => Organizer_Record(App.Desktop(1).all).Proc.Page_Down; when Dialog=> Vbrain_Record(App.Desktop(1).all).Proc.Page_Down; when Navigation => Master_Record(App.Desktop(1).all).Proc.Page_Down; when Engineer => Engine_Record(App.Desktop(1).all).Proc.Page_Down; when Devel => Devel_Record(App.Desktop(1).all).Proc.Page_Down; when Admin=> WOPR_Record(App.Desktop(1).all).Proc.Page_Down; when Terminator => Workstation_Record(App.Desktop(1).all).Proc.Page_Down; when Joshua => Space_Fighter_Record(App.Desktop(1).all).Proc.Page_Down; when Entreprise => Person_Record(App.Desktop(1).all).Proc.Page_Down; when Process => World_Record(App.Desktop(1).all).Proc.Page_Down; when Shell_Interface => Shell_Record(App.Desktop(1).all).Proc.Page_Down; when All_manuals => All_manuals_Record(App.Desktop(1).all).Proc.Page_Down; when others => null; end case; end if; end Page_Down; or accept Page_Up do if App.Desktop(1) /= null then case App.Desktop(1).Name is when None => None_Record(App.Desktop(1).all).Proc.Page_Up; when Log => Logs_Record(App.Desktop(1).all).Proc.Page_Up; when MoneyBox => Moneybox_Record(App.Desktop(1).all).Proc.Page_Up; when Activity => Activity_Record(App.Desktop(1).all).Proc.Page_Up; when Stocks => Stocks_Record(App.Desktop(1).all).Proc.Page_Up; when Bank => bank_Record(App.Desktop(1).all).Proc.Page_Up; when Planning => Planning_Record(App.Desktop(1).all).Proc.Page_Up; when Library => Library_Record(App.Desktop(1).all).Proc.Page_Up; when Manager => Manager_Record(App.Desktop(1).all).Proc.Page_Up; when Contacts => Contacts_Record(App.Desktop(1).all).Proc.Page_Up; when Menu => Menu_Record(App.Desktop(1).all).Proc.Page_Up; when Organizer => Organizer_Record(App.Desktop(1).all).Proc.Page_Up; when Dialog=> Vbrain_Record(App.Desktop(1).all).Proc.Page_Up; when Navigation => Master_Record(App.Desktop(1).all).Proc.Page_Up; when Engineer => Engine_Record(App.Desktop(1).all).Proc.Page_Up; when Devel => Devel_Record(App.Desktop(1).all).Proc.Page_Up; when Admin=> WOPR_Record(App.Desktop(1).all).Proc.Page_Up; when Terminator => Workstation_Record(App.Desktop(1).all).Proc.Page_Up; when Joshua => Space_Fighter_Record(App.Desktop(1).all).Proc.Page_Up; when Entreprise => Person_Record(App.Desktop(1).all).Proc.Page_Up; when Process => World_Record(App.Desktop(1).all).Proc.Page_Up; when Shell_Interface => Shell_Record(App.Desktop(1).all).Proc.Page_Up; when All_manuals => All_manuals_Record(App.Desktop(1).all).Proc.Page_Up; when others => null; end case; end if; end Page_Up; or accept Up_Arrow do if App.Desktop(1) /= null then case App.Desktop(1).Name is when None => None_Record(App.Desktop(1).all).Proc.Up_Arrow; when Log => Logs_Record(App.Desktop(1).all).Proc.Up_Arrow; when MoneyBox => Moneybox_Record(App.Desktop(1).all).Proc.Up_Arrow; when Activity => Activity_Record(App.Desktop(1).all).Proc.Up_Arrow; when Stocks => Stocks_Record(App.Desktop(1).all).Proc.Up_Arrow; when Bank => bank_Record(App.Desktop(1).all).Proc.Up_Arrow; when Planning => Planning_Record(App.Desktop(1).all).Proc.Up_Arrow; when Library => Library_Record(App.Desktop(1).all).Proc.Up_Arrow; when Manager => Manager_Record(App.Desktop(1).all).Proc.Up_Arrow; when Contacts => Contacts_Record(App.Desktop(1).all).Proc.Up_Arrow; when Menu => Menu_Record(App.Desktop(1).all).Proc.Up_Arrow; when Organizer => Organizer_Record(App.Desktop(1).all).Proc.Up_Arrow; when Dialog=> Vbrain_Record(App.Desktop(1).all).Proc.Up_Arrow; when Navigation => Master_Record(App.Desktop(1).all).Proc.Up_Arrow; when Engineer => Engine_Record(App.Desktop(1).all).Proc.Up_Arrow; when Devel => Devel_Record(App.Desktop(1).all).Proc.Up_Arrow; when Admin=> WOPR_Record(App.Desktop(1).all).Proc.Up_Arrow; when Terminator => Workstation_Record(App.Desktop(1).all).Proc.Up_Arrow; when Joshua => Space_Fighter_Record(App.Desktop(1).all).Proc.Up_Arrow; when Entreprise => Person_Record(App.Desktop(1).all).Proc.Up_Arrow; when Process => World_Record(App.Desktop(1).all).Proc.Up_Arrow; when Gate => Gate_Record(App.Desktop(1).all).Proc.Up_Arrow; when Shell_interface => Shell_Record(App.Desktop(1).all).Proc.Up_Arrow; when All_manuals => All_manuals_Record(App.Desktop(1).all).Proc.Up_Arrow; when others => null; end case; end if; end up_arrow; or accept Down_Arrow do if App.Desktop(1) /= null then case App.Desktop(1).Name is when None => None_Record(App.Desktop(1).all).Proc.Down_Arrow; when Log => Logs_Record(App.Desktop(1).all).Proc.Down_Arrow; when MoneyBox => Moneybox_Record(App.Desktop(1).all).Proc.Down_Arrow; when Activity => Activity_Record(App.Desktop(1).all).Proc.Down_Arrow; when Stocks => Stocks_Record(App.Desktop(1).all).Proc.Down_Arrow; when Bank => bank_Record(App.Desktop(1).all).Proc.Down_Arrow; when Planning => Planning_Record(App.Desktop(1).all).Proc.Down_Arrow; when Library => Library_Record(App.Desktop(1).all).Proc.Down_Arrow; when Manager => Manager_Record(App.Desktop(1).all).Proc.Down_Arrow; when Contacts => Contacts_Record(App.Desktop(1).all).Proc.Down_Arrow; when Menu => Menu_Record(App.Desktop(1).all).Proc.Down_Arrow; when Organizer => Organizer_Record(App.Desktop(1).all).Proc.Down_Arrow; when Dialog=> Vbrain_Record(App.Desktop(1).all).Proc.Down_Arrow; when Navigation => Master_Record(App.Desktop(1).all).Proc.Down_Arrow; when Engineer => Engine_Record(App.Desktop(1).all).Proc.Down_Arrow; when Devel => Devel_Record(App.Desktop(1).all).Proc.Down_Arrow; when Admin=> WOPR_Record(App.Desktop(1).all).Proc.Down_Arrow; when Terminator => Workstation_Record(App.Desktop(1).all).Proc.Down_Arrow; when Joshua => Space_Fighter_Record(App.Desktop(1).all).Proc.Down_Arrow; when Entreprise => Person_Record(App.Desktop(1).all).Proc.Down_Arrow; when Process => World_Record(App.Desktop(1).all).Proc.Down_Arrow; when Gate => Gate_Record(App.Desktop(1).all).Proc.Down_Arrow; when Shell_Interface => Shell_Record(App.Desktop(1).all).Proc.Down_Arrow; when All_manuals => All_manuals_Record(App.Desktop(1).all).Proc.Down_Arrow; when others => null; end case; end if; end Down_Arrow; or accept Left_Arrow do if App.Desktop(1) /= null then case App.Desktop(1).Name is when None => None_Record(App.Desktop(1).all).Proc.Left_Arrow; when Log => Logs_Record(App.Desktop(1).all).Proc.Left_Arrow; when MoneyBox => Moneybox_Record(App.Desktop(1).all).Proc.Left_Arrow; when Activity => Activity_Record(App.Desktop(1).all).Proc.Left_Arrow; when Stocks => Stocks_Record(App.Desktop(1).all).Proc.Left_Arrow; when Bank => bank_Record(App.Desktop(1).all).Proc.Left_Arrow; when Planning => Planning_Record(App.Desktop(1).all).Proc.Left_Arrow; when Library => Library_Record(App.Desktop(1).all).Proc.Left_Arrow; when Manager => Manager_Record(App.Desktop(1).all).Proc.Left_Arrow; when Contacts => Contacts_Record(App.Desktop(1).all).Proc.Left_Arrow; when Menu => Menu_Record(App.Desktop(1).all).Proc.Left_Arrow; when Organizer => Organizer_Record(App.Desktop(1).all).Proc.Left_Arrow; when Dialog=> Vbrain_Record(App.Desktop(1).all).Proc.Left_Arrow; when Navigation => Master_Record(App.Desktop(1).all).Proc.Left_Arrow; when Engineer => Engine_Record(App.Desktop(1).all).Proc.Left_Arrow; when Devel => Devel_Record(App.Desktop(1).all).Proc.Left_Arrow; when Admin=> WOPR_Record(App.Desktop(1).all).Proc.Left_Arrow; when Terminator => Workstation_Record(App.Desktop(1).all).Proc.Left_Arrow; when Joshua => Space_Fighter_Record(App.Desktop(1).all).Proc.Left_Arrow; when Entreprise => Person_Record(App.Desktop(1).all).Proc.Left_Arrow; when Process => World_Record(App.Desktop(1).all).Proc.Left_Arrow; when others => null; end case; end if; end Left_Arrow; or accept Right_Arrow do if App.Desktop(1) /= null then case App.Desktop(1).Name is when None => None_Record(App.Desktop(1).all).Proc.Right_Arrow; when Log => Logs_Record(App.Desktop(1).all).Proc.Right_Arrow; when MoneyBox => Moneybox_Record(App.Desktop(1).all).Proc.Right_Arrow; when Activity => Activity_Record(App.Desktop(1).all).Proc.Right_Arrow; when Stocks => Stocks_Record(App.Desktop(1).all).Proc.Right_Arrow; when Bank => bank_Record(App.Desktop(1).all).Proc.Right_Arrow; when Planning => Planning_Record(App.Desktop(1).all).Proc.Right_Arrow; when Library => Library_Record(App.Desktop(1).all).Proc.Right_Arrow; when Manager => Manager_Record(App.Desktop(1).all).Proc.Right_Arrow; when Contacts => Contacts_Record(App.Desktop(1).all).Proc.Right_Arrow; when Menu => Menu_Record(App.Desktop(1).all).Proc.Right_Arrow; when Organizer => Organizer_Record(App.Desktop(1).all).Proc.Right_Arrow; when Dialog=> Vbrain_Record(App.Desktop(1).all).Proc.Right_Arrow; when Navigation => Master_Record(App.Desktop(1).all).Proc.Right_Arrow; when Engineer => Engine_Record(App.Desktop(1).all).Proc.Right_Arrow; when Devel => Devel_Record(App.Desktop(1).all).Proc.Right_Arrow; when Admin=> WOPR_Record(App.Desktop(1).all).Proc.Right_Arrow; when Terminator => Workstation_Record(App.Desktop(1).all).Proc.Right_Arrow; when Joshua => Space_Fighter_Record(App.Desktop(1).all).Proc.Right_Arrow; when Entreprise => Person_Record(App.Desktop(1).all).Proc.Right_Arrow; when Process => World_Record(App.Desktop(1).all).Proc.Right_Arrow; when others => null; end case; end if; end Right_Arrow; or accept Del do if App.Desktop(1) /= null then if App.Desktop(1).all in Devel_Record then Devel_Record(App.Desktop(1).all).Proc.Del; end if; end if; end Del; or accept Begin_Of do if App.Desktop(1) /= null then case App.Desktop(1).Name is when None => None_Record(App.Desktop(1).all).Proc.Begin_Of; when Log => Logs_Record(App.Desktop(1).all).Proc.Begin_Of; when MoneyBox => Moneybox_Record(App.Desktop(1).all).Proc.Begin_Of; when Activity => Activity_Record(App.Desktop(1).all).Proc.Begin_Of; when Stocks => Stocks_Record(App.Desktop(1).all).Proc.Begin_Of; when Bank => bank_Record(App.Desktop(1).all).Proc.Begin_Of; when Planning => Planning_Record(App.Desktop(1).all).Proc.Begin_Of; when Library => Library_Record(App.Desktop(1).all).Proc.Begin_Of; when Manager => Manager_Record(App.Desktop(1).all).Proc.Begin_Of; when Contacts => Contacts_Record(App.Desktop(1).all).Proc.Begin_Of; when Menu => Menu_Record(App.Desktop(1).all).Proc.Begin_Of; when Organizer => Organizer_Record(App.Desktop(1).all).Proc.Begin_Of; when Dialog=> Vbrain_Record(App.Desktop(1).all).Proc.Begin_Of; when Navigation => Master_Record(App.Desktop(1).all).Proc.Begin_Of; when Engineer => Engine_Record(App.Desktop(1).all).Proc.Begin_Of; when Devel => Devel_Record(App.Desktop(1).all).Proc.Begin_Of; when Admin=> WOPR_Record(App.Desktop(1).all).Proc.Begin_Of; when Terminator => Workstation_Record(App.Desktop(1).all).Proc.Begin_Of; when Joshua => Space_Fighter_Record(App.Desktop(1).all).Proc.Begin_Of; when Entreprise => Person_Record(App.Desktop(1).all).Proc.Begin_Of; when Process => World_Record(App.Desktop(1).all).Proc.Begin_Of; when All_manuals => All_manuals_Record(App.Desktop(1).all).Proc.Begin_Of; when others => null; end case; end if; end Begin_Of; or accept End_Of do if App.Desktop(1) /= null then case App.Desktop(1).Name is when None => None_Record(App.Desktop(1).all).Proc.End_Of; when Log => Logs_Record(App.Desktop(1).all).Proc.End_Of; when MoneyBox => Moneybox_Record(App.Desktop(1).all).Proc.End_Of; when Activity => Activity_Record(App.Desktop(1).all).Proc.End_Of; when Stocks => Stocks_Record(App.Desktop(1).all).Proc.End_Of; when Bank => bank_Record(App.Desktop(1).all).Proc.End_Of; when Planning => Planning_Record(App.Desktop(1).all).Proc.End_Of; when Library => Library_Record(App.Desktop(1).all).Proc.End_Of; when Manager => Manager_Record(App.Desktop(1).all).Proc.End_Of; when Contacts => Contacts_Record(App.Desktop(1).all).Proc.End_Of; when Menu => Menu_Record(App.Desktop(1).all).Proc.End_Of; when Organizer => Organizer_Record(App.Desktop(1).all).Proc.End_Of; when Dialog=> Vbrain_Record(App.Desktop(1).all).Proc.End_Of; when Navigation => Master_Record(App.Desktop(1).all).Proc.End_Of; when Engineer => Engine_Record(App.Desktop(1).all).Proc.End_Of; when Devel => Devel_Record(App.Desktop(1).all).Proc.End_Of; when Admin=> WOPR_Record(App.Desktop(1).all).Proc.End_Of; when Terminator => Workstation_Record(App.Desktop(1).all).Proc.End_Of; when Joshua => Space_Fighter_Record(App.Desktop(1).all).Proc.End_Of; when Entreprise => Person_Record(App.Desktop(1).all).Proc.End_Of; when Process => World_Record(App.Desktop(1).all).Proc.End_Of; when All_manuals => All_manuals_Record(App.Desktop(1).all).Proc.End_Of; when others => null; end case; end if; end End_Of; or accept Full_Screen do if App.Desktop(1) /= null then if App.Desktop(1).all in Devel_Record then Devel_Record(App.Desktop(1).all).Proc.Full_screen; end if; end if; end Full_Screen; or accept Overwrite do if App.Desktop(1) /= null then if App.Desktop(1).all in Devel_Record then Devel_Record(App.Desktop(1).all).Proc.Overwrite; end if; end if; end Overwrite; end select; end loop; --W_Io.Put_Line("System halted."); end Console_Process; procedure Print_Logs (Logs : in Log_Array; Win : in Window_Record; Top : in Natural) is Total : Rate_Type := 0.0; begin Enlight_Window(Win); Text_Io.Put(Normal_Mode); for Log in Log_Enum'range loop Draw_Text(Win, Log_Enum'Pos(Log) + 3, 2, Yellow, Handling.To_Wide_String(Log_Enum'Image(Log))); Draw_Text(Win, Log_Enum'Pos(Log) + 3, 15, white, " : " & Handling.To_Wide_String(Rate_Type'Image(Logs(Log).Rate))); Total := Total + Logs(Log).Rate; end loop; Draw_Text(Win, Log_Enum'Pos(Log_Enum'Last) + 4, 2, white, Handling.To_Wide_String((22 * '-'))); Draw_Text(Win, Log_Enum'Pos(Log_Enum'Last) + 5, 2, white, "Total "); Draw_Text(Win, Log_Enum'Pos(Log_Enum'Last) + 5, 15, green, Handling.To_Wide_String(Rate_Type'Image(Total))); end Print_Logs; The_Window : Window_Type; task body Logs_Process is Log_Win : Window_Record := (1, 1, App.Lines, App.Columns/2, Blue, The_Window); begin Main_Loop: Loop loop select accept Receive (Wchar : in Wide_Character); or accept Halt; exit Main_loop; or accept Wake_Up(Top : in Natural) do Initialize(Log_Win, 1, Top+1, App.Lines, App.Columns/2, Blue, White); Print_Logs(App.Logs, Log_Win, Top); end Wake_Up; or accept Suspend; exit; or accept Page_Down; or accept Page_Up; or accept Up_Arrow do null; end Up_Arrow; or accept Down_Arrow do null; end Down_Arrow; or accept Left_Arrow; or accept Right_Arrow; or accept Begin_Of; or accept End_Of; or accept Del; or accept Overwrite; end select; end loop; loop select accept Halt do null; end Halt; exit Main_Loop; or accept Suspend; or accept Wake_Up(Top : in Natural) do Initialize(Log_Win, 1, Top+1, App.Lines, App.Columns/2, Blue, White); Print_Logs(App.Logs, Log_Win, Top); end Wake_Up; exit; end select; end loop; end loop Main_loop; --W_Io.Put_Line("log process halted"); end Logs_Process; function Col_Count (Line : in Wide_String;To : in Natural;Txt : Boolean) return Natural is Count : Natural := 0; begin if To = 0 then return To; end if; for Wchar in Line'First..To loop case Line(Wchar) is when Wide_Character'Val(9) => if Txt then Count := Count + 3; else Count := Count + 1; end if; when others => Count := Count + 1; end case; end loop; return Count; end Col_Count; function Line_Count (Filename : in String) return Natural is File : Text_Io.File_Type; Line_Count : Natural := 0; Dot : Natural := Fixed.Index(Filename, ".", Backward); Txt : Boolean := False; begin if Dot /= 0 and then Filename(Dot..Filename'Last) = "txt" then Txt := True; end if; Text_Io.Open(File, Text_Io.In_File, Filename); while not Text_Io.End_Of_File(File) loop declare Line : constant String := Text_Io.Get_Line(File); begin --Line_Count := Line_Count + Col_Count(Handling.To_Wide_String(Line), Line'Last, Txt) / (columns-1) + 1; Line_Count := Line_Count + 1; end; end loop; Text_Io.Close(File); return Line_Count; exception when others => Text_Io.Put_Line("Exception"); raise; end Line_Count; task body CPU_Process is Cpu_Cmd : constant String := "sh -c """ & Home_Dir & "/bin/main_cpu > " & Home_Dir & "/.cpu_usage.txt""" & Character'Val(0); Cpu_File : Text_Io.File_Type; Cpu_Error : Integer := 0; Cpu : Cpu_String := (others => ' '); Success : Boolean := False; begin loop select accept Initialize do Cpu_Error := System(Cpu_Cmd); if Is_Regular_File(Home_Dir & "/.cpu_usage.txt") then Cpu := (others => ' '); Text_Io.Open(Cpu_File, Text_Io.In_File, Home_Dir & "/.cpu_usage.txt"); declare Line : constant String := Get_Line(Cpu_File); Pos : Natural := Line'Length + ((Cpu_String'Length-1) - Line'Length) ; begin for I in reverse Line'Range loop Cpu(Pos) := Line(I); Pos := Pos - 1; end loop; Cpu(Cpu'Length) := '%'; end; Text_Io.Close(Cpu_File); Delete_File(Home_Dir & "/.cpu_usage.txt", Success); end if; end Initialize; or accept Cpu_Get(CPU_Usage : out CPU_String) do CPU_Usage := Cpu; end Cpu_Get; or accept Halt; exit; end select; end loop; end CPU_Process; task body Self_Development_Process is begin Main_Loop: loop loop select accept Receive (Wchar : in Wide_Character); or accept Halt; exit Main_loop; or accept Wake_Up(Top : in Natural) do W_Io.Put_Line("Self_Development"); end Wake_Up; or accept Suspend; exit; or accept Refresh; or accept Page_Down; or accept Page_Up; or accept Up_Arrow do null; end up_arrow; or accept Down_Arrow do null; end Down_Arrow; or accept Left_Arrow; or accept Right_Arrow; or accept Del; or accept Begin_Of; or accept End_Of; or accept Overwrite; or accept Full_Screen; end select; end loop; loop select accept Halt; exit Main_Loop; or accept Suspend; or accept Wake_Up(Top : in Natural) do W_Io.Put_Line("Self_Development"); Text_Io.Put_Line("Greetings " & Getenv("USER").all & "!"); end Wake_Up; exit; end select; end loop; end loop Main_Loop; --W_Io.Put_Line("Self_Development process halted"); end Self_Development_Process; function Parse_Man_Command (Man : in String) return String is Man_Line : access String; begin if Fixed.Index(Man(Fixed.Index_Non_Blank(Man)..Man'Last), " ") /= 0 and then Fixed.Index_Non_Blank(Man, Backward) /= Fixed.Index(Man(Fixed.Index_Non_Blank(Man)..Man'Last), " ") then begin declare Line : constant String := Man(Fixed.Index (Man(Fixed.Index_Non_Blank (Man)..Man'Last), " ")+1..Fixed.Index_Non_Blank(Man, Backward)); begin if Fixed.Index(Line(Fixed.Index_Non_Blank(Line)..Line'Last), " ") /= 0 and then Fixed.Index_Non_Blank(Line, Backward) /= Fixed.Index(Line(Fixed.Index_Non_Blank(Line)..Line'Last), " ") then begin declare Section : constant String := Line(Line'First..Line'First); Manual : constant String := "/usr/share/man/man" & Section & '/' & line(Fixed.Index (Line, " ", Backward)+1..Fixed.Index_Non_Blank(line, Backward)) & '.' & Section & ".gz"; begin Man_Line := New String ' ("man -Pcat " & Manual); end; end; else return ""; end if; end; end; else return ""; end if; return Man_Line.all; end Parse_Man_Command; procedure Man_Info (Window : in Ansi_Windows.Window_Type) is begin Ansi_Windows.Draw (Window, 1, 3, White, "1 General Commands ; 2 System Calls ;"); Ansi_Windows.Draw (Window, 2, 3, White, "3 Library functions, covering in particular the C standard Library ;"); Ansi_Windows.Draw (Window, 3, 3, White, "4 Special files (usually devices, those found in /dev) and Drivers ;"); Ansi_Windows.Draw (Window, 4, 3, White, "5 File formats and Conventions ; 6 Games and Screensavers ;"); Ansi_Windows.Draw (Window, 5, 3, White, "7 Miscellanea ; 8 System administration commands and Daemons."); end Man_Info; procedure System (Window : in Ansi_Windows.Window_Type; Shell_Interface : in Main_Interface_Access; Pattern : in Wide_String; Errno : out Integer) is begin -- Messages pour que l'utilisateur(rice) ne se sente pas perdu(e). Ansi_Windows.Draw_Window (Window); Ansi_windows.Draw (Window, 1, 1, White, "waitting process..."); Ansi_windows.Move_Cursor_To(Window, 1, 3); if Wide_Fixed.Index(Pattern, " ") /= 0 and then Wide_Fixed.Index(Pattern, " ") < Pattern'last then declare Expanded_Line : constant Wide_String := To_Wide_String(Tools.Expand_Filename(UTF_Encoding.Wide_Strings.Encode(Pattern(Wide_Fixed.Index(Pattern, " ")+1..Pattern'Last)))); begin W_Io.Put_Line("Expanded line : " & Expanded_Line); declare Command_Line : constant Wide_String := Pattern(Pattern'First..Wide_Fixed.Index(Pattern, " ")-1) & ' ' & Expanded_Line; begin --Put_Line("Ok !"); Shell_Interface.Spawn_Result := Operating_System.Spawn(UTF_Encoding.Wide_Strings.Encode(Command_Line)); --Put_Line("Ok !"); end; end; else Shell_Interface.Spawn_Result := Operating_System.Spawn(UTF_Encoding.Wide_Strings.Encode(Pattern)); end if; Errno := Shell_Interface.Spawn_Result.Return_Code; end System; -- procedure Draw_Buffer (Spawn_Result : in Result_Record; Win : in Ansi_Windows.Window_Type; File_Index : in Natural) is -- Line_Index : Natural := 0; -- Result_Max_Lines : Positive := Win.H-2; -- Line_Count : Natural := 0;  -- Term_Width : constant Natural := Win.W-2; -- begin -- Print_Loop: -- for I in File_Index+1..Positive'min(File_Index+((Result_Max_Lines-1)),  -- Spawn_Result.Wlines'Length) loop -- declare -- tmp : constant Wide_String :=  -- (-(Spawn_Result.Wlines(I))); -- Line : constant Wide_String := Tmp(Tmp'First..Wide_Fixed.Index_Non_Blank((Tmp), Backward)); -- Chars_Max : constant Positive := Term_Width; -- Lines_Max : constant Positive := (Result_Max_Lines-5); -- Pro_Index : Natural := Wide_Fixed.Index(Line, "true"); -- Against : Natural := Wide_Fixed.Index(Line, "false"); -- Next : Natural := 0; -- begin  -- if Real_Length(Line) > 0 and Real_Length(Line) < (Chars_Max * Lines_Max) then -- for Line_Window in Line_Index..Integer'min(Real_Length(Line)/Chars_Max, Lines_Max) loop -- declare -- B_Inf : constant Positive := Line_Window*Chars_Max + 1; -- B_Sup : constant Positive := Integer'min((Line_Window + 1)*Chars_Max, Real_Length(Line)); -- begin -- if Real_length(Line) < Chars_max then -- if Pro_Index /= 0 then -- if Line'Length >= Pro_Index + 4 then -- Next := Pro_Index + 4; -- end if; -- elsif Against /= 0 then -- if Line'Length >= against + 4 then -- Next := Against + 4; -- end if; -- end if; -- if Next /= 0 then -- if Pro_Index /= 0 then -- Ansi_Windows.Draw(Win, Line_Count+1, 1, White, Line(Line'First..Pro_Index-1)); -- Ansi_Windows.Draw(Win, Line_Count+1, Pro_Index, Cyan, Line(Pro_Index..Next) & Handling.To_Wide_String(Normal_mode)); -- if Line'Length > Next then -- Ansi_Windows.Draw(Win, Line_Count+1, Pro_Index+5, White, Line(Next+1..Line'Last)); -- end if; -- else -- Ansi_Windows.Draw(Win, Line_Count+1, 1, White, Line(Line'First..Against-1)); -- Ansi_Windows.Draw(Win, Line_Count+1, Against, Red, Line(Against..Next) & Handling.To_Wide_String(Normal_mode)); -- if Line'Length > Next then -- Ansi_Windows.Draw(Win, Line_Count+1, Against+5, White, Line(Next+1..Line'Last)); -- end if; -- end if; -- else -- Ansi_Windows.Draw(Win, Line_Count+1, 1, White, Line); -- end if; -- else -- if Next /= 0 then -- if Pro_Index /= 0 then -- if Pro_Index < B_Sup and Pro_Index > B_Inf and Next < B_Sup then -- Ansi_Windows.Draw(Win, Line_Count+1, 1, White, Line(B_Inf..Pro_Index-1)); -- Ansi_Windows.Draw(Win, Line_Count+1, Pro_Index, Cyan, Line(Pro_Index..Next) & Handling.To_Wide_String(Normal_mode)); -- Ansi_Windows.Draw(Win, Line_Count+1, 1, White, Line(Next+1..B_Sup)); -- else -- Ansi_Windows.Draw(Win, Line_Count+1, 1, White, Line(B_Inf..B_Sup)); -- end if; -- elsif Against /= 0 then -- if Against < B_Sup and Against > B_Inf and Next < B_Sup then -- Ansi_Windows.Draw(Win, Line_Count+1, 1, White, Line(B_Inf..Against-1)); -- Ansi_Windows.Draw(Win, Line_Count+1, Against, Cyan, Line(Against..Next) & Handling.To_Wide_String(Normal_mode)); -- Ansi_Windows.Draw(Win, Line_Count+1, Against+5, White, Line(Next+1..B_Sup)); -- else -- Ansi_Windows.Draw(Win, Line_Count+1, 1, White, Line(B_Inf..B_Sup)); -- end if; -- end if; -- else -- Ansi_Windows.Draw(Win, Line_Count+1, 1, White, Line(B_Inf..B_Sup)); -- end if; -- end if; -- end; -- Line_Count := Line_Count + 1; -- exit Print_Loop When Line_Count > (Result_Max_Lines-1); -- end loop; -- else -- Line_Count := Line_Count + 1; -- end if;  -- end; -- exit Print_Loop when Line_Count > (Result_Max_Lines-1); -- end loop Print_Loop; -- end Draw_Buffer; procedure Draw_Buffer (Spawn_Result : in Adam.Results.Spawn_Result_Type; Win : in Ansi_Windows.Window_Type; File_Index : in Natural) is Line_Index : Natural := 0; Result_Max_Lines : Positive := Win.H-2; Line_Count : Natural := 0; Term_Width : constant Natural := Win.W-2; begin Print_Loop: for I in File_Index+1..Positive'min(File_Index+((Result_Max_Lines-1)), Spawn_Result.File_content'Length) loop declare tmp : constant Wide_String := (-(Spawn_Result.File_content(I))); Line : constant Wide_String := Tmp(Tmp'First..Wide_Fixed.Index_Non_Blank((Tmp), Backward)); Chars_Max : constant Positive := Term_Width; Lines_Max : constant Positive := (Result_Max_Lines-5); Pro_Index : Natural := Wide_Fixed.Index(Line, "true"); Against : Natural := Wide_Fixed.Index(Line, "false"); Next : Natural := 0; begin if Real_Length(Line) > 0 and Real_Length(Line) < (Chars_Max * Lines_Max) then for Line_Window in Line_Index..Integer'min(Real_Length(Line)/Chars_Max, Lines_Max) loop declare B_Inf : constant Positive := Line_Window*Chars_Max + 1; B_Sup : constant Positive := Integer'min((Line_Window + 1)*Chars_Max, Real_Length(Line)); begin if Real_length(Line) < Chars_max then if Pro_Index /= 0 then if Line'Length >= Pro_Index + 4 then Next := Pro_Index + 4; end if; elsif Against /= 0 then if Line'Length >= against + 4 then Next := Against + 4; end if; end if; if Next /= 0 then if Pro_Index /= 0 then Ansi_Windows.Draw(Win, Line_Count+1, 1, White, Line(Line'First..Pro_Index-1)); Ansi_Windows.Draw(Win, Line_Count+1, Pro_Index, Cyan, Line(Pro_Index..Next) & Handling.To_Wide_String(Normal_mode)); if Line'Length > Next then Ansi_Windows.Draw(Win, Line_Count+1, Pro_Index+5, White, Line(Next+1..Line'Last)); end if; else Ansi_Windows.Draw(Win, Line_Count+1, 1, White, Line(Line'First..Against-1)); Ansi_Windows.Draw(Win, Line_Count+1, Against, Red, Line(Against..Next) & Handling.To_Wide_String(Normal_mode)); if Line'Length > Next then Ansi_Windows.Draw(Win, Line_Count+1, Against+5, White, Line(Next+1..Line'Last)); end if; end if; else Ansi_Windows.Draw(Win, Line_Count+1, 1, White, Line); end if; else if Next /= 0 then if Pro_Index /= 0 then if Pro_Index < B_Sup and Pro_Index > B_Inf and Next < B_Sup then Ansi_Windows.Draw(Win, Line_Count+1, 1, White, Line(B_Inf..Pro_Index-1)); Ansi_Windows.Draw(Win, Line_Count+1, Pro_Index, Cyan, Line(Pro_Index..Next) & Handling.To_Wide_String(Normal_mode)); Ansi_Windows.Draw(Win, Line_Count+1, 1, White, Line(Next+1..B_Sup)); else Ansi_Windows.Draw(Win, Line_Count+1, 1, White, Line(B_Inf..B_Sup)); end if; elsif Against /= 0 then if Against < B_Sup and Against > B_Inf and Next < B_Sup then Ansi_Windows.Draw(Win, Line_Count+1, 1, White, Line(B_Inf..Against-1)); Ansi_Windows.Draw(Win, Line_Count+1, Against, Cyan, Line(Against..Next) & Handling.To_Wide_String(Normal_mode)); Ansi_Windows.Draw(Win, Line_Count+1, Against+5, White, Line(Next+1..B_Sup)); else Ansi_Windows.Draw(Win, Line_Count+1, 1, White, Line(B_Inf..B_Sup)); end if; end if; else Ansi_Windows.Draw(Win, Line_Count+1, 1, White, Line(B_Inf..B_Sup)); end if; end if; end; Line_Count := Line_Count + 1; exit Print_Loop When Line_Count > (Result_Max_Lines-1); end loop; else Line_Count := Line_Count + 1; end if; end; exit Print_Loop when Line_Count > (Result_Max_Lines-1); end loop Print_Loop; end Draw_Buffer; W3 : constant Ansi_Windows.Window_Type := ( -- Quit (exit program) window information. L => Lines-5, C => 1, H => 3, W => Columns, Frame_Type => Ansi_Windows.Single_Line_Frame, Frame_Color => M.Ansi.Console.Yellow, Close_Box_Color => M.Ansi.Console.Red); W4 : constant Ansi_Windows.Window_Type := ( -- Status message Window. L => 4, C => 1, H => 7, W => Columns, Frame_Type => Ansi_Windows.Single_Line_Frame, Frame_Color => Yellow, Close_Box_Color => Red); W5 : constant Ansi_Windows.Window_Type := ( -- Quit (exit program) window information. L => 12, C => 1, H => Lines-16, W => Columns, Frame_Type => Ansi_Windows.Single_Line_Frame, Frame_Color => M.Ansi.Console.Yellow, Close_Box_Color => M.Ansi.Console.white); Shell_Interface : Main_Interface_Access := New_Interface; task body All_Manuals_Process is Buffer : Wide_Access; Line : Wide_Access := new Wide_String ' (""); Errno : Integer := 0; File_Index : Natural := 0; begin Main_Loop: loop loop select accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(10) => declare Man_Line : constant Wide_String := To_Wide_String(Parse_Man_Command(To_String(Line.all))); begin --Ansi_Console.Clear_screen; if Man_Line'Length > 0 then Adam.Results.Free(Shell_Interface.Spawn_Result.File_Content); System(W3, Shell_Interface, Man_Line, errno); --Ansi_windows.Clear_screen; if Errno = 0 then if Shell_Interface.Spawn_Result.Args /= null then for Arg in Shell_Interface.Spawn_Result.Args'Range loop Free(Shell_Interface.Spawn_Result.Args(Arg)); end loop; end if; end if; Ansi_Windows.Draw_Window(W5); Draw_Buffer(Shell_Interface.Spawn_Result, W5, File_Index); Ansi_Windows.Draw_Window(W3); Ansi_Windows.Draw(W3, 1, 1, White, "# "); end if; end; when Wide_Character'Val(127) => if Line'Length > 0 then Buffer := new Wide_String ' (Line(Line'First..Line'Last-1)); Wide_Free(Line); Line := new Wide_String ' (buffer.all); Wide_Free(Buffer); Ansi_Windows.Draw_Window(W3); Ansi_Windows.Draw(W3, 1, 1, White, "# " & Line.all); end if; when others => null; end case; else Buffer := new Wide_String ' (Line.all & Wchar); Wide_Free(Line); Line := new Wide_String ' (Buffer.all); Wide_Free(Buffer); if Line /= null then Ansi_Windows.Draw(W3, 1, 1, White, "# " & Line.all); end if; end if; end Receive; or accept Halt; exit Main_loop; or accept Wake_Up(Top : in Natural) do --W_Io.Put_Line("All_Manuals"); Man_Info(W4); if Line /= null then Ansi_Windows.Draw(W3, 1, 1, White, "# " & Line.all); else Ansi_Windows.Draw(W3, 1, 1, White, "# "); end if; end Wake_Up; or accept Suspend; exit; or accept Refresh; or accept Page_Down do Ansi_Windows.Draw_Window(W5); File_Index := Integer'Min(Shell_Interface.Spawn_Result.File_Content'Length, File_Index + (W5.H - 3)); Draw_Buffer(Shell_Interface.Spawn_Result, W5, File_Index); Ansi_Windows.Draw_Window(W3); end Page_Down; or accept Page_Up do Ansi_Windows.Draw_Window(W5); File_Index := Integer'max(0, File_Index - (W5.H - 3)); Draw_Buffer(Shell_Interface.Spawn_Result, W5, File_Index); Ansi_Windows.Draw_Window(W3); end Page_Up; or accept Up_Arrow do Ansi_Windows.Draw_Window(W5); File_Index := Integer'max(0, File_Index - 1); Draw_Buffer(Shell_Interface.Spawn_Result, W5, File_Index); Ansi_Windows.Draw_Window(W3); end up_arrow; or accept Down_Arrow do Ansi_Windows.Draw_Window(W5); File_Index := Integer'Min(Shell_Interface.Spawn_Result.File_Content'Length, File_Index + 1); Draw_Buffer(Shell_Interface.Spawn_Result, W5, File_Index); Ansi_Windows.Draw_Window(W3); end Down_Arrow; or accept Left_Arrow; or accept Right_Arrow; or accept Del; or accept Begin_Of do Ansi_Windows.Draw_Window(W5); File_Index := 0; Draw_Buffer(Shell_Interface.Spawn_Result, W5, File_Index); Ansi_Windows.Draw_Window(W3); end Begin_Of; or accept End_Of do Ansi_Windows.Draw_Window(W5); File_Index := Integer'max(0, Shell_Interface.Spawn_Result.File_Content'Length - (W5.H-2)); Draw_Buffer(Shell_Interface.Spawn_Result, W5, File_Index); Ansi_Windows.Draw_Window(W3); end End_Of; or accept Overwrite; or accept Full_Screen; end select; end loop; loop select accept Halt; exit Main_Loop; or accept Suspend; or accept Wake_Up(Top : in Natural) do --W_Io.Put_Line("All_Manuals"); --Text_Io.Put_Line("Greetings " & Getenv("USER").all & "!"); Man_Info(W4); if Line /= null then Ansi_Windows.Draw(W3, 1, 1, White, "# " & Line.all); else Ansi_Windows.Draw(W3, 1, 1, White, "# "); end if; end Wake_Up; exit; end select; end loop; end loop Main_Loop; --W_Io.Put_Line("All_Manuals process halted"); end All_Manuals_Process; -- task body Computer_Process is -- begin -- Main_Loop: -- loop -- loop -- select -- accept Receive (Wchar : in Wide_Character); -- or -- accept Halt; -- exit Main_loop; -- or -- accept Wake_Up(Top : in Natural) do -- W_Io.Put_Line("Computer"); -- end Wake_Up; -- or -- accept Suspend; -- exit; -- or -- accept Refresh; -- or -- accept Page_Down; -- or -- accept Page_Up; -- or -- accept Up_Arrow do -- null; -- end up_arrow; -- or -- accept Down_Arrow do -- null; -- end Down_Arrow; -- or -- accept Left_Arrow; -- or -- accept Right_Arrow; -- or -- accept Del; -- or -- accept Begin_Of; -- or -- accept End_Of; -- or -- accept Overwrite; -- or -- accept Full_Screen; -- end select; -- end loop; -- loop -- select -- accept Halt; -- exit Main_Loop; -- or -- accept Suspend; -- or -- accept Wake_Up(Top : in Natural) do -- W_Io.Put_Line("Computer"); -- Text_Io.Put_Line("Greetings " & Getenv("USER").all & "!"); -- end Wake_Up; -- exit; -- end select; -- end loop; -- end loop Main_Loop; -- --W_Io.Put_Line("Computer process halted"); -- end Computer_Process; procedure Read(File : W_Io.File_Type;E : out Types.Audit_Type) is begin E.Logname := new Wide_String ' (W_Io.Get_Line(File)); E.Pgr_Name := new String ' (To_String(W_Io.Get_Line(File))); E.installation := new String ' (To_String(W_Io.Get_Line(File))); E.utilisation := new String ' (To_String(W_Io.Get_Line(File))); E.ergonomy := new String ' (To_String(W_Io.Get_Line(File))); E.Rank := Integer'Value(To_String(W_Io.Get_Line(File))); end Read; type Stat_Array is array (Positive range <>) of access Types.Audits_Stat_Type; type Stats_Access is access all Stat_Array; function Stats_Load return Stats_Access is File : W_Io.File_Type; Counters : array (1..256) of access Types.Audits_Counter_Type; Stat_Table : Stat_Array(1..256); begin if Os_Lib.Is_Regular_File(Os_Lib.Getenv("HOME").all & "/audits.txt") then W_Io.Open(File, W_Io.In_File, Os_Lib.Getenv("HOME").all & "/audits.txt", Form => "WCEM=8"); while not W_Io.End_Of_File(File) loop declare E : Types.Audit_Type; Done : Boolean := False; begin Read(File, E); for I in Counters'Range loop if Counters(I) /= null then if Counters(I).Pgr_Name.all = E.Pgr_Name.all then if E.Installation.all = "beginner" then Counters(I).beginner := Counters(I).Simple + 1; elsif E.Installation.all = "advanced" then Counters(I).advanced := Counters(I).advanced + 1; elsif E.Installation.all = "expert" then Counters(I).expert := Counters(I).expert + 1; end if; if E.Utilisation.all = "easy" then Counters(I).easy := Counters(I).easy + 1; elsif E.utilisation.all = "difficult" then Counters(I).difficult := Counters(I).difficult + 1; end if; if E.ergonomy.all = "simple" then Counters(I).Simple := Counters(I).Simple + 1; elsif E.ergonomy.all = "detailed" then Counters(I).detailed := Counters(I).detailed + 1; elsif E.ergonomy.all = "complex" then Counters(I).complex := Counters(I).complex + 1; end if; Counters(I).Rank := Counters(I).Rank + E.Rank; Counters(I).Count := Counters(I).Count + 1; Done := True; exit; end if; end if; end loop; if not Done then for I in Counters'Range loop if Counters(I) = null then Counters(I) := new Types.Audits_Counter_Type; Counters(I).Pgr_Name := new String ' (E.Pgr_Name.all); if E.Installation.all = "beginner" then Counters(I).beginner := Counters(I).Simple + 1; elsif E.Installation.all = "advanced" then Counters(I).advanced := Counters(I).advanced + 1; elsif E.Installation.all = "expert" then Counters(I).expert := Counters(I).expert + 1; end if; if E.Utilisation.all = "easy" then Counters(I).easy := Counters(I).easy + 1; elsif E.utilisation.all = "difficult" then Counters(I).difficult := Counters(I).difficult + 1; end if; if E.ergonomy.all = "simple" then Counters(I).Simple := Counters(I).Simple + 1; elsif E.ergonomy.all = "detailed" then Counters(I).detailed := Counters(I).detailed + 1; elsif E.ergonomy.all = "complex" then Counters(I).complex := Counters(I).complex + 1; end if; Counters(I).Rank := Counters(I).Rank + E.Rank; Counters(I).Count := Counters(I).Count + 1; exit; end if; end loop; end if; Done := False; end; end loop; W_Io.Close(File); for I in Counters'Range loop if Counters(I) /= null then Stat_Table(I) := new Types.Audits_Stat_Type; Stat_Table(I).Pgr_Name := new String ' (Counters(I).Pgr_Name.all); Stat_Table(I).beginner := Types.Rate_Type((Float(Counters(I).Beginner) * 100.0) / (Float(Counters(I).Count) * 100.0)) * 100.0; Stat_Table(I).advanced := Types.Rate_Type((Float(Counters(I).Advanced) * 100.0) / (Float(Counters(I).Count) * 100.0)) * 100.0; Stat_Table(I).expert := Types.Rate_Type((Float(Counters(I).Expert) * 100.0) / (Float(Counters(I).Count) * 100.0)) * 100.0; Stat_Table(I).easy := Types.Rate_Type((Float(Counters(I).Easy) * 100.0) / (Float(Counters(I).Count) * 100.0)) * 100.0; Stat_Table(I).Difficult := Types.Rate_Type((Float(Counters(I).Difficult) * 100.0) / (Float(Counters(I).Count) * 100.0)) * 100.0; Stat_Table(I).Simple := Types.Rate_Type((Float(Counters(I).Simple) * 100.0) / (Float(Counters(I).Count) * 100.0)) * 100.0; Stat_Table(I).Detailed := Types.Rate_Type((Float(Counters(I).Detailed) * 100.0) / (Float(Counters(I).Count) * 100.0)) * 100.0; Stat_Table(I).Complex := Types.Rate_Type((Float(Counters(I).Complex) * 100.0) / (Float(Counters(I).Count) * 100.0)) * 100.0; Stat_Table(I).Rank := Float(Counters(I).Rank) / Float(Counters(I).Count); else return new Stat_Array ' (Stat_Table(1..I-1)); end if; end loop; end if; return null; end Stats_Load; task body Audits_Process is Main_Win : Window_Record := (1, 1, App.lines, App.Columns/2, Blue, The_Window); Stats : Stats_Access; T_Beginner, T_Advanced, T_Expert, T_Easy, T_Difficult, T_Simple, T_Detailed, T_Complex : Float := 0.0; Beginner, Advanced, Expert, Easy, Difficult, Simple, Detailed, Complex : Rate_Type := 0.0; begin Main_Loop: loop loop select accept Receive (Wchar : in Wide_Character); or accept Halt; exit Main_loop; or accept Wake_Up(Top : in Natural) do W_Io.Put_Line("Audits"); Main_Win := (1, Top+1, App.lines, App.Columns/2, Blue, The_Window); Initialize(Main_Win, 1, Top+1, App.lines, App.Columns/2, Blue, white); Draw_Window(Main_Win.Win); Spir_Lock.Seize; Stats := Stats_Load; Spir_Lock.Release; Draw_Text(Main_Win, 1, 1, Yellow, "Program"); Draw_Text(Main_Win, 1, 36, cyan, " Beginner"); Draw_Text(Main_Win, 1, 44, cyan, " Advanced"); Draw_Text(Main_Win, 1, 52, cyan, " Expert"); Draw_Text(Main_Win, 1, 60, green, " Easy"); Draw_Text(Main_Win, 1, 68, green, " Difficult"); Draw_Text(Main_Win, 1, 76, white, " Simple"); Draw_Text(Main_Win, 1, 84, white, " Detailed"); Draw_Text(Main_Win, 1, 92, white, " Complex"); Draw_Text(Main_Win, 1, 100, magenta, " Rank"); T_Beginner := 0.0; T_Advanced := 0.0; T_Expert := 0.0; T_Easy := 0.0; T_Difficult := 0.0; T_Simple := 0.0; T_Detailed := 0.0; T_Complex := 0.0; if Stats /= null and then Stats'Length /= 0 then for I in Stats'Range loop Draw_Text(Main_Win, I+1, 1, Yellow, To_Wide_String(Stats(I).Pgr_Name.all)); Draw_Text(Main_Win, I+1, 36, cyan, To_Wide_String(Types.Rate_Type'Image(Stats(I).Beginner))); Draw_Text(Main_Win, I+1, 44, cyan, To_Wide_String(Types.Rate_Type'Image(Stats(I).Advanced))); Draw_Text(Main_Win, I+1, 52, cyan, To_Wide_String(Types.Rate_Type'Image(Stats(I).Expert))); Draw_Text(Main_Win, I+1, 60, green, To_Wide_String(Types.Rate_Type'Image(Stats(I).Easy))); Draw_Text(Main_Win, I+1, 68, green, To_Wide_String(Types.Rate_Type'Image(Stats(I).Difficult))); Draw_Text(Main_Win, I+1, 76, white, To_Wide_String(Types.Rate_Type'Image(Stats(I).Simple))); Draw_Text(Main_Win, I+1, 84, white, To_Wide_String(Types.Rate_Type'Image(Stats(I).Detailed))); Draw_Text(Main_Win, I+1, 92, white, To_Wide_String(Types.Rate_Type'Image(Stats(I).Complex))); Draw_Text(Main_Win, I+1, 100, Magenta, To_Wide_String(Float'Image(Stats(I).Rank))); T_Beginner := T_Beginner + Float(Stats(I).Beginner); T_Advanced := T_Advanced + Float(Stats(I).Advanced); T_Expert := T_Expert + Float(Stats(I).Expert); T_Easy := T_Easy + Float(Stats(I).Easy); T_Difficult := T_Difficult + Float(Stats(I).Difficult); T_Simple := T_Simple + Float(Stats(I).Simple); T_Detailed := T_Detailed + Float(Stats(I).Detailed); T_Complex := T_Complex + Float(Stats(I).Complex); end loop; Beginner := Rate_Type(T_Beginner / Float(Stats'Length)); Advanced := Rate_Type(T_Advanced / Float(Stats'Length)); Expert := Rate_Type(T_Expert / Float(Stats'Length)); Easy := Rate_Type(T_Easy / Float(Stats'Length)); Difficult := Rate_Type(T_Difficult / Float(Stats'Length)); Simple := Rate_Type(T_Simple / Float(Stats'Length)); Detailed := Rate_Type(T_Detailed / Float(Stats'Length)); Complex := Rate_Type(T_Complex / Float(Stats'Length)); Draw_Text(Main_Win, Stats'length + 2, 1, white, Wide_Fixed."*"((Columns/2-2), '-')); Draw_Text(Main_Win, Stats'length + 3, 1, Yellow, "Totals : "); Draw_Text(Main_Win, Stats'length + 3, 36, cyan, To_Wide_String(Rate_Type'Image(Beginner))); Draw_Text(Main_Win, Stats'length + 3, 44, cyan, To_Wide_String(Rate_Type'Image(Advanced))); Draw_Text(Main_Win, Stats'length + 3, 52, cyan, To_Wide_String(Rate_Type'Image(Expert))); Draw_Text(Main_Win, Stats'length + 3, 60, green, To_Wide_String(Rate_Type'Image(Easy))); Draw_Text(Main_Win, Stats'length + 3, 68, green, To_Wide_String(Rate_Type'Image(Difficult))); Draw_Text(Main_Win, Stats'length + 3, 76, white, To_Wide_String(Rate_Type'Image(Simple))); Draw_Text(Main_Win, Stats'length + 3, 84, white, To_Wide_String(Rate_Type'Image(Detailed))); Draw_Text(Main_Win, Stats'length + 3, 92, white, To_Wide_String(Rate_Type'Image(Complex))); end if; end Wake_Up; or accept Suspend; exit; or accept Refresh; or accept Page_Down; or accept Page_Up; or accept Up_Arrow do null; end up_arrow; or accept Down_Arrow do null; end Down_Arrow; or accept Left_Arrow; or accept Right_Arrow; or accept Del; or accept Begin_Of; or accept End_Of; or accept Overwrite; or accept Full_Screen; end select; end loop; loop select accept Halt; exit Main_Loop; or accept Suspend; or accept Wake_Up(Top : in Natural) do W_Io.Put_Line("Audits"); Text_Io.Put_Line("Greetings " & Getenv("USER").all & "!"); Main_Win := (1, Top+1, App.lines, App.Columns/2, Blue, The_Window); Initialize(Main_Win, 1, Top+1, App.lines, App.Columns/2, Blue, white); Draw_Window(Main_Win.Win); Spir_Lock.Seize; Stats := Stats_Load; Spir_Lock.Release; Draw_Text(Main_Win, 1, 1, Yellow, "Program"); Draw_Text(Main_Win, 1, 36, cyan, " Beginner"); Draw_Text(Main_Win, 1, 44, cyan, " Advanced"); Draw_Text(Main_Win, 1, 52, cyan, " Expert"); Draw_Text(Main_Win, 1, 60, green, " Easy"); Draw_Text(Main_Win, 1, 68, green, " Difficult"); Draw_Text(Main_Win, 1, 76, white, " Simple"); Draw_Text(Main_Win, 1, 84, white, " Detailed"); Draw_Text(Main_Win, 1, 92, white, "Complex"); Draw_Text(Main_Win, 1, 100, magenta, " Rank"); T_Beginner := 0.0; T_Advanced := 0.0; T_Expert := 0.0; T_Easy := 0.0; T_Difficult := 0.0; T_Simple := 0.0; T_Detailed := 0.0; T_Complex := 0.0; if Stats /= null and then Stats'Length /= 0 then for I in Stats'Range loop Draw_Text(Main_Win, I+1, 1, Yellow, To_Wide_String(Stats(I).Pgr_Name.all)); Draw_Text(Main_Win, I+1, 36, cyan, To_Wide_String(Types.Rate_Type'Image(Stats(I).Beginner))); Draw_Text(Main_Win, I+1, 44, cyan, To_Wide_String(Types.Rate_Type'Image(Stats(I).Advanced))); Draw_Text(Main_Win, I+1, 52, cyan, To_Wide_String(Types.Rate_Type'Image(Stats(I).Expert))); Draw_Text(Main_Win, I+1, 60, green, To_Wide_String(Types.Rate_Type'Image(Stats(I).Easy))); Draw_Text(Main_Win, I+1, 68, green, To_Wide_String(Types.Rate_Type'Image(Stats(I).Difficult))); Draw_Text(Main_Win, I+1, 76, white, To_Wide_String(Types.Rate_Type'Image(Stats(I).Simple))); Draw_Text(Main_Win, I+1, 84, white, To_Wide_String(Types.Rate_Type'Image(Stats(I).Detailed))); Draw_Text(Main_Win, I+1, 92, white, To_Wide_String(Types.Rate_Type'Image(Stats(I).Complex))); Draw_Text(Main_Win, I+1, 100, Magenta, To_Wide_String(Float'Image(Stats(I).Rank))); T_Beginner := T_Beginner + Float(Stats(I).Beginner); T_Advanced := T_Advanced + Float(Stats(I).Advanced); T_Expert := T_Expert + Float(Stats(I).Expert); T_Easy := T_Easy + Float(Stats(I).Easy); T_Difficult := T_Difficult + Float(Stats(I).Difficult); T_Simple := T_Simple + Float(Stats(I).Simple); T_Detailed := T_Detailed + Float(Stats(I).Detailed); T_Complex := T_Complex + Float(Stats(I).Complex); end loop; Beginner := Rate_Type(T_Beginner / Float(Stats'Length)); Advanced := Rate_Type(T_Advanced / Float(Stats'Length)); Expert := Rate_Type(T_Expert / Float(Stats'Length)); Easy := Rate_Type(T_Easy / Float(Stats'Length)); Difficult := Rate_Type(T_Difficult / Float(Stats'Length)); Simple := Rate_Type(T_Simple / Float(Stats'Length)); Detailed := Rate_Type(T_Detailed / Float(Stats'Length)); Complex := Rate_Type(T_Complex / Float(Stats'Length)); Draw_Text(Main_Win, Stats'length + 2, 1, white, Wide_Fixed."*"((Columns/2-2), '-')); Draw_Text(Main_Win, Stats'length + 3, 1, Yellow, "Totals : "); Draw_Text(Main_Win, Stats'length + 3, 36, cyan, To_Wide_String(Rate_Type'Image(Beginner))); Draw_Text(Main_Win, Stats'length + 3, 44, cyan, To_Wide_String(Rate_Type'Image(Advanced))); Draw_Text(Main_Win, Stats'length + 3, 52, cyan, To_Wide_String(Rate_Type'Image(Expert))); Draw_Text(Main_Win, Stats'length + 3, 60, green, To_Wide_String(Rate_Type'Image(Easy))); Draw_Text(Main_Win, Stats'length + 3, 68, green, To_Wide_String(Rate_Type'Image(Difficult))); Draw_Text(Main_Win, Stats'length + 3, 76, white, To_Wide_String(Rate_Type'Image(Simple))); Draw_Text(Main_Win, Stats'length + 3, 84, white, To_Wide_String(Rate_Type'Image(Detailed))); Draw_Text(Main_Win, Stats'length + 3, 92, white, To_Wide_String(Rate_Type'Image(Complex))); end if; end Wake_Up; exit; end select; end loop; end loop Main_Loop; W_Io.Put_Line("Audits process halted"); end Audits_Process; function Count (Set : in Wide_Set; Doc_Index : in Natural; Line_index : in Natural; Wchar_Index : in Natural; Line_Cur : in Line_Range; Col_Cur : in Column_Range; Height : in Line_Range; Width : in Column_Range) return Natural is Total_Lines : Natural := 0; begin Line_Count : for I in Doc_Index+1..Line_Index loop declare tmp : constant Wide_String := (Set.lines(I).all); Line : constant Wide_String := Tmp(Tmp'First..Wide_Fixed.Index_Non_Blank((Tmp), Backward)); Chars_Max : constant Positive := Width; Lines_Max : constant Positive := Height; begin exit when (Total_Lines >= Height); if Real_Length(Line) > 0 and Real_Length(Line) < (Chars_Max * Lines_Max) then for Line_Window in 0..Integer'min(Real_Length(Line)/Chars_Max, Lines_Max) loop Total_lines := Total_Lines + 1; exit when (Total_Lines >= Height); end loop; else Total_lines := Total_Lines + 1; end if; end; exit when (Total_Lines >= Height); end loop Line_Count; return Total_Lines; end Count; procedure Up_Arrow (Set : in Wide_Set; Doc_Index : in out Natural; Line_index : in out Natural; Wchar_Index : in out Natural; Line_Cur : in out Line_Range; Col_Cur : in out Column_Range; Height : in Line_Range; Width : in Column_Range) is Total_Lines : Natural := 0; begin Total_Lines := Count(Set, Doc_Index, Line_Index, Wchar_Index, Line_Cur, Col_Cur, Height, Width); if Line_Cur <= 1 and Doc_Index >= 1 then Doc_Index := Doc_Index - 1; Line_Index := Line_Index - 1; Line_Cur := 1; Col_Cur := 1; Wchar_Index := 0; elsif Line_Cur > 1 then if Wchar_Index - Width >= 1 then Wchar_Index := (Wchar_Index - Width); Line_Cur := Line_Cur - 1; if Wchar_Index >= Width then Col_Cur := (Wchar_Index rem Width); elsif Wchar_Index >= 0 then Col_Cur := Wchar_Index; else Col_Cur := 1; end if; else Line_Index := Line_Index - 1; Line_Cur := Line_Cur - 1; Col_Cur := 1; Wchar_Index := 0; end if; else W_Io.Put(Wide_Character'Val(7)); end if; end Up_Arrow; procedure Down_Arrow (Set : in Wide_Set; Doc_Index : in out Natural; Line_index : in out Natural; Wchar_Index : in out natural; Line_Cur : in out Line_Range; Col_Cur : in out Column_Range; Height : in Line_Range; Width : in Column_Range) is Total_Lines : Natural := 0; Cur : Line_Range := Line_Cur; begin if (Line_Cur >= (Height-2)) and ((Line_Index) < Set.Line_Last) then Line_Index := Line_Index + 1; Wchar_Index := 0; Doc_Index := Doc_Index + 1; Col_Cur := 1; Total_Lines := Count(Set, Doc_Index, Line_Index, Wchar_Index, Line_Cur, Col_Cur, Height, Width); Line_Cur := Cur; elsif Line_Index + 1 <= Set.Line_Last then Line_Index := Line_Index + 1; Line_Cur := Line_Cur + 1; Wchar_Index := 0; Col_Cur := 1; elsif Real_Length(Set.Lines(Line_Index).all) >= (Width) then if (Wchar_Index + Width) <= Real_Length(Set.Lines(Line_Index).all) then Line_Cur := Line_Cur + 1; Wchar_Index := Wchar_Index + Width; Col_Cur := (Wchar_Index rem Width); elsif Real_Length(Set.Lines(Line_Index).all) > width then Line_Cur := Line_Cur + 1; Wchar_Index := Real_Length(Set.Lines(Line_Index).all); Col_Cur := (Wchar_Index rem Width); else Wchar_Index := 0; Col_Cur := 1; end if; else Text_Io.Put(Character'Val(7)); end if; end Down_Arrow; procedure At_Begin (Set : in Wide_Set; Doc_Index : in out Natural; Line_index : in out Natural; Wchar_Index : in out Natural; Line_Cur : in out Line_Range; Col_Cur : in out Column_Range; Height : in Line_Range; Width : in Column_Range) is Total_Lines : Natural := 0; begin Wchar_Index := 0; Col_Cur := 1; Total_Lines := Count(Set, Doc_Index, Line_Index, Wchar_Index, Line_Cur, Col_Cur, Height, Width); Line_Cur := Total_Lines; end At_Begin; procedure At_End (Set : in Wide_Set; Doc_Index : in out Natural; Line_index : in out Natural; Wchar_Index : in out Natural; Line_Cur : in out Line_Range; Col_Cur : in out Column_Range; Height : in Line_Range; Width : in Column_Range) is Total_Lines : Natural := 0; begin Wchar_Index := Set.Lines(Line_Index)'length; Total_Lines := Count(Set, Doc_Index, Line_Index, Wchar_Index, Line_Cur, Col_Cur, Height, Width); Col_Cur := Natural'Max(Wchar_Index mod Width, Wchar_Index) + 1; Line_Cur := Total_Lines; end At_End; procedure Right_Arrow (Set : in Wide_Set; Doc_Index : in out Natural; Line_index : in out Natural; Wchar_Index : in out Natural; Line_Cur : in out Line_Range; Col_Cur : in out Column_Range; Height : in Line_Range; Width : in Column_Range) is Done : Boolean := False; Total_Lines : Natural := 0; begin if Wchar_index + 1 > Real_Length(Set.Lines(Line_Index).all) then if Line_Index + 1 > Set.Line_Last then Text_Io.Put(Character'Val(7)); elsif Line_Cur = Height then loop Total_Lines := Count(Set, Doc_Index, Line_Index + 1, Wchar_Index, Line_Cur, Col_Cur, Height, Width); if Total_Lines > height then Doc_Index := Doc_Index + 1; end if; exit when Total_Lines <= Height; end loop; Line_Index := Line_Index + 1; Total_Lines := Count(Set, Doc_Index, Line_Index - 1, Wchar_Index, Line_Cur, Col_Cur, Height, Width); Col_Cur := 1; Line_Cur := Total_Lines + 1; else loop Total_Lines := Count(Set, Doc_Index, Line_Index + 1, Wchar_Index, Line_Cur, Col_Cur, Height, Width); if Total_Lines > height then Doc_Index := Doc_Index + 1; end if; exit when Total_Lines <= Height; end loop; Line_Index := Line_Index + 1; Total_Lines := Count(Set, Doc_Index, Line_Index - 1, Wchar_Index, Line_Cur, Col_Cur, Height, Width); Line_Cur := Total_Lines + 1; Wchar_Index := 0; Col_Cur := 1; end if; elsif Wchar_Index < Set.Lines(Line_Index)'Length and (Wchar_Index + 1 = Width) then Col_Cur := 1; Line_Cur := Line_Cur + 1; Wchar_Index := Wchar_Index + 1; elsif Wchar_Index < Set.Lines(Line_Index)'Length and (Wchar_Index + 1 > Width) then Wchar_Index := Wchar_Index + 1; if (Wchar_Index mod Width) = 0 then Line_Cur := Line_Cur + 1; Col_Cur := 1; else Col_Cur := (Wchar_Index mod Width) + 1; end if; elsif Wchar_Index < Set.Lines(Line_Index)'Length then Wchar_Index := Wchar_Index + 1; Col_Cur := Col_Cur + 1; end if; end Right_Arrow; procedure Left_Arrow (Set : in Wide_Set; Doc_Index : in out Natural; Line_index : in out Natural; Wchar_Index : in out Natural; Line_Cur : in out Line_Range; Col_Cur : in out Column_Range; Height : in Line_Range; Width : in Column_Range) is Total_Lines : Natural := 0; begin if (Col_Cur = 1) and Line_Cur = 1 then if Doc_Index - 1 >= 0 then Line_Index := Line_Index - 1; Doc_Index := Doc_Index - 1; Wchar_Index := Real_Length(Set.Lines(Line_Index).all); Total_Lines := Count(Set, Doc_Index, Line_Index, Wchar_Index, Line_Cur, Col_Cur, Height, Width); Line_Cur := Total_Lines; if (Wchar_Index mod Width) /= 0 then Col_Cur := (Wchar_Index mod Width) + 1; else Col_Cur := 1; end if; else W_Io.Put(Wide_Character'Val(7)); end if; elsif (Col_Cur = 1) and (Wchar_Index >= Width) then Wchar_index := Wchar_Index - 1; Line_Cur := Line_Cur - 1; if (Wchar_Index mod Width) /= 0 then Col_Cur := (Wchar_Index mod Width) + 1; else Col_Cur := 1; end if; elsif Col_Cur = 1 then loop Total_Lines := Count(Set, Doc_Index, Line_Index-1, Wchar_Index, Line_Cur, Col_Cur, Height, Width); if Total_Lines > height then Doc_Index := Doc_Index + 1; end if; exit when Total_Lines <= Height; end loop; Line_Index := Line_Index - 1; Total_Lines := Count(Set, Doc_Index, Line_Index, Wchar_Index, Line_Cur, Col_Cur, Height, Width); Line_Cur := Natural'Max(Line_Cur - 1, Total_Lines); Wchar_Index := Real_Length(Set.Lines(Line_Index).all); if (Wchar_Index mod Width) /= 0 then Col_Cur := (Wchar_Index mod Width) + 1; else Col_Cur := 1; end if; elsif Wchar_index >= 1 then Wchar_Index := Wchar_Index - 1; if (Wchar_Index mod Width) /= 0 then Col_Cur := (Wchar_Index mod Width) + 1; else Col_Cur := 1; end if; else W_Io.Put(Wide_Character'Val(7)); end if; end Left_Arrow; function Add_Line (Ptr : in U_Array_Access; Line : in Wide_String) return U_Array_Access is Buffer : U_Array_Access; begin if not M.Results."=" (Ptr,null) then Buffer := new U_Array(1..(Ptr'Length)+1); Buffer(Buffer'First..Buffer'Last-1) := Ptr.all; Buffer(Buffer'Last) := (+(Line)); else Buffer := new U_Array(1..1); Buffer(Buffer'Last) := (+(Line)); end if; return Buffer; end Add_Line; procedure Open_Document (Doc_Name : in Wide_String; Table : in out Wide_Set; Line_Last : out natural) is File : W_Io.File_Type; begin Set_Free(Table); W_Io.Open(File, W_Io.In_File, Handling.To_String(Doc_Name), Form => "WCEM=8"); while not W_Io.End_Of_File(File) loop declare Wline : constant Wide_String := W_Io.Get_Line(File); begin Table.Lines(Line_Last + 1) := new Wide_String ' (Wline); Line_Last := Line_Last + 1; end; end loop; W_Io.Close(File); Table.Line_Last := Line_Last; end Open_Document; procedure Doc_Init (Center : in Agence_Record; Lines_Table : in out Wide_Set); procedure Docume_Free (Docume : in out Docume_Access) is begin if Docume /= null then Free(Docume.Title); Free(Docume.Filename); Free(Docume.Fullpath); Free(Docume.Unit); Free(Docume.Owner); end if; end Docume_Free; procedure New_Doc (Center : in Agence_Record; Lines_Table : in out Wide_Set; Docume : out Docume_Access; Filename : in String; Version : in Wide_String; License : in Boolean; Description : in Wide_string); procedure Open_Doc (Lines_Table : in out Wide_Set; Docume : out Docume_Access; Filename : in String); procedure Edit_Draw_Main_Win (Center : access Agence_Record); procedure Devel_Draw_Main_Win (Center : access Agence_Record); procedure Devel_Draw_Docume (Docume : in Docume_Access; Win : in Window_Record; Initialized : in Boolean); function Troncate (Line : in Wide_String; Num_Char : in positive) return Wide_String is Head_Min : constant Natural := Positive'Min(Line'Length, Num_Char/2-8); Tail_Min : Constant Natural := Integer'min(Head_Min+1, Num_Char/2-8); begin if Line'length < Num_Char-5 then return Line; else return Wide_Fixed.Head(Line, Head_Min) & "..." & Wide_Fixed.Trim(Wide_Fixed.Tail(Line(Tail_Min+5..Line'Last), Num_Char-5), Left); end if; end Troncate; procedure Devel_Draw_Docume (Docume : in Docume_Access; Win : in Window_Record; Initialized : in Boolean) is begin Draw_Text(Win, 1, 1, Yellow, "Title : "); if Docume /= null and then Docume.Title /= null then Draw_Text(Win, 1, 9, White, Troncate(Handling.To_Wide_String(Docume.Title.all), Columns/2-20)); end if; Draw_Text(Win, 1, 5+Columns/4+2, Yellow, "Unit : "); if Docume /= null and then Docume.Unit /= null then Draw_Text(Win, 1, 10+Columns/4+9, white, Handling.To_Wide_String(Docume.Unit.all)); end if; Draw_Text(Win, 1, 10+Columns/4+15, Yellow, "Created : "); if Docume /= null then Draw_Text(Win, 1, 10+Columns/4+26, White, Handling.To_Wide_String(Formatting.Image(Docume.Creation_Date))); end if; Draw_Text(Win, 2, 1, Yellow, "Name : "); if Docume /= null and then Docume.Filename /= null then Draw_Text(Win, 2, 9, White, Troncate(Handling.To_Wide_String(Docume.filename.all), Columns/4-10)); end if; Draw_Text(Win, 2, 5+Columns/4+2, Yellow, "Openned : " ); if Docume /= null and then Docume.Filename /= null then Draw_Text(Win, 2, 5+Columns/4+10,white, Handling.To_Wide_String(Boolean'Image(Docume.Openned))); end if; Draw_Text(Win, 2, 10+Columns/4+15, Yellow, "Modified : "); if Docume /= null then Draw_Text(Win, 2, 10+Columns/4+26, White, Handling.To_Wide_String(Formatting.Image(Docume.Last_Edition))); end if; Draw_Text(Win, 3, 1, Yellow, "Size : "); if Docume /= null then Draw_Text(Win, 3, 9, white, Handling.To_Wide_String(Natural'Image(Docume.Size)) & " without end_of_line."); end if; Draw_Text(Win, 3, 2+Columns/4+5, Yellow, "Owner : "); if Docume /= null and then Docume.Owner /= null then Draw_Text(Win, 3, 2+Columns/4+13, White, Handling.To_Wide_String(Docume.Owner.all)); end if; end Devel_Draw_Docume; procedure Devel_Win_Init (Center : access Agence_Record; Top : in Natural;Full : in boolean); procedure Edit_Win_Init (Center : access Agence_Record;Top : in Natural;Full : in boolean); procedure Edit_Win_Init (Center : access Agence_Record;Top : in Natural;Full : in boolean) is Doc_Height : Positive := ((Lines - 13)); begin if not full then Initialize(Center.Left_view.Win, 1, Top+1, Lines, Columns/2, Blue, White); Initialize(Center.Doc_States.Win, 3, Top+2, 5, Columns/2-2, Blue, cyan); Initialize(Center.Document.Win, 8, Top+2, Doc_Height, Columns/2-2, White, Red); else Initialize(Center.Left_view.Win, 1, Top+1, Lines, Columns, Blue, White); Initialize(Center.Doc_States.Win, 3, Top+2, 5, Columns-2, Blue, cyan); Initialize(Center.Document.Win, 8, Top+2, Doc_Height, Columns-2, White, Red); end if; end Edit_Win_Init; procedure Devel_Win_Init (Center : access Agence_Record;Top : in Natural;Full : in boolean) is Doc_Height : Positive := ((Lines - 19)/ 8) * 5; Result_Height : Positive := Lines - (Doc_Height + 19); begin if not full then Initialize(Center.Left_view.Win, 1, Top+1, Lines, Columns/2, Blue, White); Initialize(Center.Doc_States.Win, 3, Top+2, 5, Columns/2-2, Blue, cyan); Initialize(Center.Document.Win, 8, Top+2, Doc_Height, Columns/2-2, White, Red); Initialize(Center.Cmd.Win, Doc_Height+8, Top+2, 3, Columns/2-2, White, Red); Initialize(Center.Err.Win, Doc_Height+11, Top+2, 3, Columns/2-2, White, Red); Initialize(Center.Cmd_Result.Win, Doc_Height+14, Top+2, Result_Height, Columns/2-2, White, Red); else Initialize(Center.Left_view.Win, 1, Top+1, Lines, Columns, Blue, White); Initialize(Center.Doc_States.Win, 3, Top+2, 5, Columns-2, Blue, cyan); Initialize(Center.Document.Win, 8, Top+2, Doc_Height, Columns-2, White, Red); Initialize(Center.Cmd.Win, Doc_Height+8, Top+2, 3, Columns/2-2, White, Red); Initialize(Center.Err.Win, Doc_Height+11, Top+2, 3, Columns/2-2, White, Red); Initialize(Center.Cmd_Result.Win, Doc_Height+14, Top+2, Result_Height, Columns/2-2, White, Red); end if; end Devel_Win_Init; procedure Save_Buffer(Docume : in Docume_Access; Lines_Table : in Wide_Set) is begin -- save buffer. declare File : W_Io.File_Type; begin W_Io.Create(File, W_Io.Out_File, Docume.Filename.all, Form => "WCEM=8"); for Line_Iter in 1..Lines_Table.Line_Last loop if Lines_Table.Lines(Line_Iter) /= null then begin declare Line : constant Wide_String := Lines_Table.Lines(Line_Iter).all; begin W_Io.Put_Line(File, Line); end; end; end if; end loop; W_Io.Close(File); end; end Save_Buffer; procedure Highlight (Docume : in Docume_Access; Lines : out Wide_Set) is Result_Highlight : Wide_Result_Access; Deleted : Boolean := False; File : W_Io.File_Type; begin Set_Free(Lines); Result_Highlight := new Result_Record ' (M.Tools.Spawn("sh -c ""source-highlight -f esc256 -i " & Docume.Filename.all & " -o .highlighted""", ".Out_File.txt")); if not "="(Result_Highlight, null) and then not "="(Result_Highlight.Wlines, null) then if Wide_Fixed.Index_Non_Blank (-(Result_Highlight.Wlines(1))) = 0 then if Os_Lib.Is_Regular_File(".highlighted") then W_Io.Open(File, W_Io.In_File, ".highlighted", Form => "WCEM=8"); while not W_Io.End_Of_File(File) loop Lines.Lines(Lines.Line_Last + 1) := new Wide_String ' (W_Io.Get_Line(File)); Lines.Line_Last := Lines.Line_Last + 1; end loop; W_Io.Close(File); end if; end if; end if; Os_Lib.Delete_file(".highlighted", deleted); U_Array_Free(Result_Highlight.Wlines); end Highlight; function Set_Size (Lines_Table : in Wide_Set) return Natural is Count : Natural := 0; begin for Wline in 1..Lines_Table.Line_Last loop Count := Count + Lines_Table.Lines(Wline)'Length; end loop; return Count; end Set_Size; procedure New_Doc (Center : in Agence_Record; Lines_Table : in out Wide_Set; Docume : out Docume_Access; Filename : in String; Version : in Wide_String; License : in Boolean; Description : in Wide_string) is Dot_Index : Natural := Fixed.Index(Filename, ".", Backward); begin for Line in 1..Lines_Table.Line_Last+1 loop Wide_Free(Lines_Table.Lines(Line)); end loop; Lines_Table.Line_Last := 0; Docume := new Docume_Record; Docume.Title := new String ' (Base_Name(Filename, Filename(Dot_Index..Filename'Last))); Docume.Filename := new String ' (Filename); Docume.Creation_Date := Clock; Docume.Last_Edition := Clock; Dot_Index := Fixed.Index(Filename, "."); Docume.Unit := new String ' (Filename(Dot_Index+1..Filename'Last)); Docume.Openned := True; if License then Lines_Table.Lines(1) := new Wide_String ' ("--" & (Wide_fixed."*"((80 - 27),' ')) & Handling.To_Wide_String(Formatting.Image(Clock))); Lines_Table.Lines(2) := new Wide_String ' (("-- " & Description & ' ' & (Wide_fixed."*"((((Columns/3-2) - 8) - (Description'length + 2)),' ')) & "--")); Lines_Table.Lines(3) := new Wide_String ' ("-- " & Handling.To_Wide_String(Docume.Title.all) & ' ' & "Copyright (C)" & Handling.To_Wide_String(Calendar.Year_Number'Image(Year(Clock))) & ' ' & Handling.To_Wide_String(Center.User_Auth.Logname.all)); Lines_Table.Lines(4) := new Wide_String ' (Wide_fixed."*"((80-3),'-')); Lines_Table.Lines(5) := new Wide_String ' ("-- This program is free software; you can redistribute it and/or modify"); Lines_Table.Lines(6) := new Wide_String ' ("-- it under the terms of the GNU General Public License as published by"); Lines_Table.Lines(7) := new Wide_String ' ("-- the Free Software Foundation; either version 2 of the License, or"); Lines_Table.Lines(8) := new Wide_String ' ("-- (at your option) any later version."); Lines_Table.Lines(9) := new Wide_String ' ("--"); Lines_Table.Lines(10) := new Wide_String ' ("-- This program is distributed in the hope that it will be useful,"); Lines_Table.Lines(11) := new Wide_String ' ("-- but WITHOUT ANY WARRANTY; without even the implied warranty of"); Lines_Table.Lines(12) := new Wide_String ' ("-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the"); Lines_Table.Lines(13) := new Wide_String ' ("-- GNU General Public License for more details."); Lines_Table.Lines(14) := new Wide_String ' (""); Lines_Table.Lines(15) := new Wide_String ' ("-- You should have received a copy of the GNU General Public License"); Lines_Table.Lines(16) := new Wide_String ' ("-- along with this program; if not, write to the Free Software"); Lines_Table.Lines(17):= new Wide_String ' ("-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA"); Lines_Table.Lines(18) := new Wide_String ' (Wide_fixed."*"((80-3),'-')); Lines_Table.Lines(19) := new Wide_String ' ("-- Date := """ & Handling.To_Wide_String(Formatting.Image(Docume.Creation_Date)) & """"); Lines_Table.Lines(20) := new Wide_String ' ("-- Version := """ & Version & """"); Lines_Table.Line_Last := 20; end if; end New_Doc; procedure Doc_Init (Center : in Agence_Record; Lines_Table : in out Wide_Set) is Color : constant String := Character'Val(27) & "[01;36m"; Normal : constant String := Character'Val(27) & "[00m"; begin Lines_Table.Lines(1) := new Wide_String ' ("Hello " & Handling.To_Wide_String(Color & Center.User_Auth.Logname.all & Normal) & " and welcome to Devel mode of Main program."); Lines_Table.Lines(2) := new Wide_String ' ("For to create an new document, you must try Crtl+N."); Lines_Table.Lines(3) := new Wide_String ' ("For to open an existing document, you must try Ctrl+O."); Lines_Table.Lines(4) := new Wide_String ' ("For to save an openned document, you must try Ctrl+A."); Lines_Table.Lines(5) := new Wide_String ' (""); Lines_Table.Lines(6) := new Wide_String ' (""); Lines_Table.Lines(7) := new Wide_String ' ("When you create a new document, you must to give :"); Lines_Table.Lines(8) := new Wide_String ' (" - A name of file with 65 characters maximum."); Lines_Table.Lines(9) := new Wide_String ' (" - If you want to initialize you document with an Gnu Public license,"); Lines_Table.Lines(10) := new Wide_String ' (" you must to give the description for your document."); Lines_Table.Lines(11) := new Wide_String ' ("The Gnu Public license is in Ada programming language commented text: "); Lines_Table.Lines(12) := new Wide_String ' (""); Lines_Table.Lines(13) := new Wide_String ' (Wide_fixed."*"((80-3), '-')); Lines_Table.Lines(14) := new Wide_String ' ("-- This program is free software; you can redistribute it and/or modify"); Lines_Table.Lines(15) := new Wide_String ' ("-- it under the terms of the GNU General Public License as published by"); Lines_Table.Lines(16) := new Wide_String ' ("-- the Free Software Foundation; either version 2 of the License, or"); Lines_Table.Lines(17) := new Wide_String ' ("-- (at your option) any later version."); Lines_Table.Lines(18) := new Wide_String ' ("--"); Lines_Table.Lines(19) := new Wide_String ' ("-- This program is distributed in the hope that it will be useful,"); Lines_Table.Lines(20) := new Wide_String ' ("-- but WITHOUT ANY WARRANTY; without even the implied warranty of"); Lines_Table.Lines(21) := new Wide_String ' ("-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the"); Lines_Table.Lines(22) := new Wide_String ' ("-- GNU General Public License for more details."); Lines_Table.Lines(23) := new Wide_String ' (""); Lines_Table.Lines(24) := new Wide_String ' ("-- You should have received a copy of the GNU General Public License"); Lines_Table.Lines(25) := new Wide_String ' ("-- along with this program; if not, write to the Free Software"); Lines_Table.Lines(26):= new Wide_String ' ("-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA"); Lines_Table.Lines(27) := new Wide_String ' (Wide_fixed."*"((80-3), '-')); Lines_Table.Line_Last := 27; end Doc_Init; procedure Edit_Draw_Main_Win (Center : access Agence_Record) is begin Draw_Window(Center.Left_view.Win); Draw_Window(Center.Doc_States.Win); Draw_Window(Center.Document.Win); Draw_Window(Center.Buffer.Win); end Edit_Draw_Main_win; procedure Devel_Draw_Main_Win (Center : access Agence_Record) is begin Draw_Window(Center.Left_view.Win); Draw_Window(Center.Doc_States.Win); Draw_Window(Center.Document.Win); Draw_Window(Center.Buffer.Win); Draw_Window(Center.Cmd.Win); Draw_Window(Center.Err.Win); Draw_Window(Center.Cmd_Result.Win); end Devel_Draw_Main_Win; procedure Print_Buffer (Spawn_Result : in Wide_Result_Access;File_Index : in Natural); procedure Draw_Buffer (Spawn_Result : in Wide_Result_Access; Win : in Window_Record; File_Index : in Natural); function Txt (Ext : String) return Boolean is begin if Ext = "txt" then return True; end if; return False; end Txt; Old_Length : Natural := 0; -- save text'length Old_Total_Length : Natural := 0; -- save total_type'image(total_sum)'length Old_Pwd : Os_Lib.String_Access; Result : Wide_Result_Access; task body Devel_Process is Text : Wide_Access := new Wide_String ' (""); Old_Length : Natural := 0; -- save text'length Old_Total_Length : Natural := 0; -- save total_type'image(total_sum)'length Old_Pwd : Os_Lib.String_Access; Result : Wide_Result_Access; Last_Cmd : Int_Cmd_Enum := None; Width : constant Column_Range := (Columns/2)-5; Height : constant Column_Range := (Lines - 13); Screen_Lock : Binary_Semaphore(True, Default_Ceiling); Left_Buffer : Wide_Access := new Wide_String ' (""); Wbuffer : Wide_Access := new Wide_String ' (""); Wline : Wide_Access := new Wide_String ' (""); Wline_Length : Integer := 0; Line_Current_Pos : Natural := 0; Wchar_Index : Natural := 0; Line_Cur : Positive := 1; Col_Cur : Natural := 1; Is_Overwrite : Boolean := True; --Word_Number : Natural := 0; Total_Line : Natural := 0; Dialog_Buffer_Last : Line_Index_Range := 0; Empty_Win : Window_Record; Cmd_Line : Wide_Access := new Wide_String ' (""); Cmd_Line_Length : Natural := 0; Cmd_Current_Pos : Natural := 0; Title_Line : Wide_String(1..64) := (others => Wide_Character'Val(32)); Title : Wide_Access := new Wide_String ' (""); Errno : Integer := 0; task Clocking is entry Halt; entry Refresh; entry suspend; entry start; end Clocking; task body Clocking is End_Of_Task : Boolean := False; Blink : Boolean := False; Suspended : Boolean := True; Title_Cur : Positive := 1; Sens : Boolean := False; task Deamon is entry Halt; end Deamon; task body Deamon is begin loop select accept Halt; exit; or delay 0.33; select Clocking.Refresh; or delay 1.0; end select; end select; end loop; end deamon; begin accept Start; while not End_Of_Task loop loop select accept Halt do End_Of_Task := True; Deamon.Halt; end Halt; exit; or accept Suspend do Suspended := True; end Suspend; or accept Refresh; or accept Start do if Title /= null and then Title'Length > 0 then Title_Cur := App.Left_View.W/2-Title'Length/2; Title_Cur := 1; end if; Suspended := False; end Start; exit; end select; end loop; while not End_Of_Task loop select accept Halt do End_Of_Task := True; Deamon.Halt; end Halt; exit; or when not Suspended => accept Refresh do Screen_Lock.Seize; W_Io.Put(Handling.To_Wide_String(Save_Cursor)); Draw_Text(App.Left_View.Win, 1, App.Left_View.Win.Win.W-21, Cyan, Handling.To_Wide_String(Formatting.Image(Clock))); W_Io.Put(Handling.To_Wide_String(Restore_Cursor)); case Mode.State is when True => declare Wchar : Wide_Character := Wide_Character ' Val(32); begin if Text /= null and then Text'Length >= 1 then if Cmd_Current_Pos = 0 then Wchar := Wide_Character'Val(32); --Wchar := Wline(Wline'First); elsif Cmd_Current_Pos = Text'Length then Wchar := Wide_Character'Val(32); else Wchar := Wide_Character'Val(32); --Wchar := Text(Line_Current_Pos + 1); end if; -- if Cmd_Current_Pos > 1 then -- Wchar := Text(Cmd_Current_Pos-1); else -- Wchar := Text(1); -- end if; Wchar := Wide_Character'Val(32); end if; if not Blink then if Is_Overwrite then if Cmd_Line'Length /= 0 then Draw_Text(App.Cmd.Win, 1, Cmd_Current_Pos, White, Handling.To_Wide_String(Reverse_Video & Handling.To_Character(Wchar))); Draw_Text(App.Cmd.Win, 1, Cmd_Current_Pos, White, Handling.To_Wide_String(Normal_Mode)); else Draw_Text(App.Cmd.Win, 1, Cmd_Current_Pos+1, White, Handling.To_Wide_String(Reverse_Video & ' ')); Draw_Text(App.Cmd.Win, 1, Cmd_Current_Pos+1, White, Handling.To_Wide_String(Normal_Mode)); Draw_Text(App.Cmd.Win, 1, Cmd_Current_Pos+1, White, ""); end if; elsif Cmd_Line'Length /= 0 then Draw_Text(App.Cmd.Win, 1, Cmd_Current_Pos, White, ""); else Draw_Text(App.Cmd.Win, 1, Cmd_Current_Pos+1, White, ""); end if; else if Is_Overwrite then if Cmd_Line'Length /= 0 then Draw_Text(App.Cmd.Win, 1, Cmd_Current_Pos, White, Wchar & ""); else Draw_Text(App.Cmd.Win, 1, Cmd_Current_Pos+1, White, " "); Draw_Text(App.Cmd.Win, 1, Cmd_Current_Pos+1, White, ""); end if; else Draw_Text(App.Cmd.Win, 1, Cmd_Current_Pos+1, White, ""); end if; end if; Blink := not Blink; end; when False => declare Wchar : Wide_Character := Wide_Character ' Val(32); begin if Wline /= null and then Wline'Length >= 1 then if Line_Current_Pos = 0 then Wchar := Wline(Wline'First); elsif Line_Current_Pos = Wline'Length then Wchar := Wide_Character'Val(32); else Wchar := Wline(Line_Current_Pos + 1); end if; end if; if not Blink then if Is_Overwrite then if Wline'Length /= 0 then Draw_Text(App.Document.Win, Line_Cur, Col_Cur, White, Handling.To_Wide_String(Reverse_Video & Handling.To_Character(Wchar))); Draw_Text(App.Document.Win, Line_Cur, Col_Cur, White, Handling.To_Wide_String(Normal_Mode)); Draw_Text(App.Document.Win, Line_Cur, Col_Cur, White, ""); else Draw_Text(App.Document.Win, Line_Cur, Col_Cur, White, Handling.To_Wide_String(Reverse_Video & ' ')); Draw_Text(App.Document.Win, Line_Cur, Col_Cur, White, Handling.To_Wide_String(Normal_Mode) & ""); end if; elsif Wline'Length /= 0 then Draw_Text(App.Document.Win, Line_Cur, Col_Cur, White, ""); else Draw_Text(App.Document.Win, Line_Cur, Col_Cur, White, ""); end if; else if Is_Overwrite then if Wline'Length /= 0 then Draw_Text(App.Document.Win, Line_Cur, Col_Cur, White, Wchar & ""); Draw_Text(App.Document.Win, Line_Cur, Col_Cur, White, ""); else Draw_Text(App.Document.Win, Line_Cur, Col_Cur, White, " "); Draw_Text(App.Document.Win, Line_Cur, Col_Cur, White, ""); end if; else Draw_Text(App.Document.Win, Line_Cur, Col_Cur, White, ""); end if; end if; -- if not Blink then -- if Is_Overwrite then  -- Draw_Text(App.Document.Win, Line_cur, Col_Cur, White, Handling.To_Wide_String(Reverse_Video & Handling.To_Character(Wchar))); -- Draw_Text(App.Document.Win, Line_cur, Col_Cur, White, Handling.To_Wide_String(Normal_Mode));  -- Draw_Text(App.Document.Win, Line_Cur, Col_Cur, White, ""); -- else -- Draw_Text(App.Document.Win, Line_Cur, Col_Cur, White, ""); -- end if; -- else -- Draw_Text(App.Document.Win, Line_Cur, Col_Cur, White, ""); -- end if; Blink := not Blink; end; end case; Screen_Lock.Release; end Refresh; or accept Suspend do Suspended := True; end Suspend; exit; or accept Start do if Title /= null and then Title'Length > 0 then Title_Cur := App.Left_View.W/2-Title'Length/2; Title_Cur := 1; end if; Suspended := False; end Start; or delay 0.2; Title_Line := (others => Wide_Character'Val(32)); if Title /= null and then Title'Length > 0 then Wide_Fixed.Replace_Slice(Title_line, Title_Cur, 0, Title.all); Screen_Lock.Seize; W_Io.Put(Handling.To_Wide_String(Save_Cursor)); Draw_Text(App.Left_View.Win, 1, 30, Yellow, Title_Line); W_Io.Put(Handling.To_Wide_String(Restore_Cursor)); Screen_Lock.Release; if Sens then if Title_Cur + Title'Length-1 < 60 then Title_Cur := Title_Cur + 1; else Sens := not Sens; end if; else if Title_Cur > 1 then Title_Cur := Title_Cur - 1; else Sens := not Sens; end if; end if; end if; end select; end loop; end loop; end Clocking; task File_Thread is entry Page_Down; entry Page_Up; entry Up_Arrow; entry Down_Arrow; entry Start; entry Reset; entry Release; entry Halt; end File_Thread; task body File_Thread is Line_Count : Natural := 0; Count : Natural := 0; Old_Count : integer := 0; Line_Index : Natural := 0; File : File_Type; Free : Boolean := False; Only_One : Boolean := False; Done : boolean := True; begin Main_Loop : loop loop select accept Page_Down do Line_Index := 1; Line_count := Line_count + App.Cmd_Result.Win.H/2; Draw_Window(App.Cmd_Result.Win); Only_One := True; end Page_Down; exit; or accept Page_Up do Line_Index := 1; if Line_count - App.Cmd_Result.Win.H/2 >= 0 then Line_count := Line_count - App.Cmd_Result.Win.H/2; end if; Draw_Window(App.Cmd_Result.Win); Only_One := True; end Page_Up; exit; or accept Up_Arrow do Line_Index := 1; if Line_Count - 1 >= 0 then Line_count := Line_count - 1; end if; Draw_Window(App.Cmd_Result.Win); Only_One := True; end Up_Arrow; exit; or accept Down_Arrow do Line_Index := 1; Line_count := Line_count + 1; Draw_Window(App.Cmd_Result.Win); Only_One := True; end Down_Arrow; exit; or accept Start do Only_One := False; Free := False; Old_Count := 0; Line_Count := 0; Count := 0; line_index := 1; end Start; exit; or accept Halt; exit Main_Loop; or accept Reset do Line_Index := 1; Line_Count := 0; end Reset; or accept Release do Free := True; end Release; end Select; end loop; delay 0.5; loop delay 0.05; --W_Io.Open(File, W_Io.In_File, ".Out", Form => "WCEM=8"); Open(File, In_File, ".Out", Form => "WCEM=8"); --while not W_Io.End_Of_File(File) loop Print_Loop : while not End_Of_File(File) loop declare String_line : String := Get_Line(File); Line : Wide_String := Handling.To_Wide_String(String_Line); Result_Max_Lines : Positive := App.Cmd_Result.Win.Win.H-2; -- Line_Count : Natural := 0;  Term_Width : constant Natural := App.Cmd_Result.Win.Win.W-2; Chars_Max : constant Positive := Term_Width; Lines_Max : constant Positive := (Result_Max_Lines); Pro_Index : Natural := Wide_Fixed.Index(Line, "true"); Against : Natural := Wide_Fixed.Index(Line, "false"); Next : Natural := 0; Line_Cur : Natural := 0; begin if count > old_count then if Done then if (Count - Old_Count) >= (App.Cmd_Result.Win.H-2) - 1 then Draw_Window(App.Cmd_Result.Win); -- elsif (Count - (Old_Count-1) ) + line_index >= (App.Cmd_Result.Win.H-2)*2 then -- Draw_Window(App.Cmd_Result.Win); done := false; end if; end if; if Pro_Index /= 0 then if Line'Length >= Pro_Index + 4 then Next := Pro_Index + 4; end if; elsif Against /= 0 then if Line'Length >= against + 4 then Next := Against + 4; end if; end if; if Real_Length(Line) > 0 and Real_Length(Line) < (Chars_Max * Lines_Max) then for Line_Window in Line_Cur..Integer'min(Real_Length(Line)/Chars_Max, Lines_Max) loop declare B_Inf : constant Positive := Line_Window*Chars_Max + 1; B_Sup : constant Positive := Integer'min((Line_Window + 1)*Chars_Max, Line'length); begin if Real_length(Line) < Chars_max then if Next /= 0 then if Pro_Index /= 0 then Draw_Text(App.Cmd_Result.Win, Line_Index, 1, White, Line(Line'First..Pro_Index-1)); Enlight_Draw_Text(App.Cmd_Result.Win, Line_Index, Pro_Index, White, Line(Pro_Index..Next) & Handling.To_Wide_String(Normal_mode)); if Line'Length > Next then Draw_Text(App.Cmd_Result.Win, Line_Index, Pro_Index+5, White, Line(Next+1..Line'Last)); end if; else Draw_Text(App.Cmd_Result.Win, Line_Index, 1, White, Line(Line'First..Against-1)); Enlight_Draw_Text(App.Cmd_Result.Win, Line_Index, Against, Red, Line(Against..Next) & Handling.To_Wide_String(Normal_mode)); if Line'Length > Next then Draw_Text(App.Cmd_Result.Win, Line_Index, Against+5, White, Line(Next+1..Line'Last)); end if; end if; else Draw_Text(App.Cmd_Result.Win, Line_Index, 1, White, Line); end if; else if Next /= 0 then if Pro_Index /= 0 then if Pro_Index < B_Sup and Pro_Index > B_Inf and Next < B_Sup then Draw_Text(App.Cmd_Result.Win, Line_Index, 1, White, Line(B_Inf..Pro_Index-1)); Enlight_Draw_Text(App.Cmd_Result.Win, Line_Index, Pro_Index, White, Line(Pro_Index..Next) & Handling.To_Wide_String(Normal_mode)); Draw_Text(App.Cmd_Result.Win, Line_Index, 1, White, Line(Next+1..B_Sup)); else Draw_Text(App.Cmd_Result.Win, Line_Index, 1, White, Line(B_Inf..B_Sup)); end if; elsif Against /= 0 then if Against < B_Sup and Against > B_Inf and Next < B_Sup then Draw_Text(App.Cmd_Result.Win, Line_Index, 1, White, Line(B_Inf..Against-1)); Enlight_Draw_Text(App.Cmd_Result.Win, Line_Index, Against, White, Line(Against..Next) & Handling.To_Wide_String(Normal_mode)); Draw_Text(App.Cmd_Result.Win, Line_Index, Against+5, White, Line(Next+1..B_Sup)); else Draw_Text(App.Cmd_Result.Win, Line_Index, 1, White, Line(B_Inf..B_Sup)); end if; end if; else Draw_Text(App.Cmd_Result.Win, Line_Index, 1, White, Line(B_Inf..B_Sup)); end if; end if; end; exit when Line_Index > (Result_Max_Lines-1); Line_Index := Line_Index + 1; end loop; else Line_Index := Line_Index + 1; end if; if Result_Max_Lines-1 <= (count - old_count) then Old_Count := Old_Count + 1; Done := True; end if; end if; Count := Count + 1; end; exit when (App.Cmd_Result.Win.H-2) <= Line_Index ; end loop Print_Loop; Close(File); Line_Index := 1; if not Only_One then select accept Reset do Line_Index := 1; Line_Count := 0; end Reset; exit; or accept Page_Down do Line_Index := 1; Line_count := Line_count + App.Cmd_Result.Win.H/2; Draw_Window(App.Cmd_Result.Win); end Page_Down; or accept Page_Up do Line_Index := 1; if Line_count - App.Cmd_Result.Win.H/2 >= 0 then Line_count := Line_count - App.Cmd_Result.Win.H/2; Draw_Window(App.Cmd_Result.Win); end if; end Page_Up; or accept Up_Arrow do Line_Index := 1; if Line_Count - 1 >= 0 then Line_count := Line_count - 1; Draw_Window(App.Cmd_Result.Win); end if; end Up_Arrow; or accept Down_Arrow do Line_Index := 1; Line_count := Line_count + 1; Draw_Window(App.Cmd_Result.Win); end Down_Arrow; or accept Release do Free := True; end Release; or accept Halt; exit Main_Loop; or delay 0.05; end select; end if; Count := 1; exit when Only_One; end loop; Only_One := False; end loop Main_Loop; end File_Thread; task type Exec_Thread (Cmd_Line : Os_Lib.String_Access) is entry Spawn; entry Wait(Success : out Boolean;Errno : out Integer); entry Read_Line; entry Halt; end Exec_Thread; task body Exec_Thread is Success : Boolean := False; Errno : Integer := 0; PID : Os_Lib.Process_ID; begin accept Spawn do if not (Command_Name(Cmd_line.all)'Length = Cmd_line'Length) then null; end if; end Spawn; Screen_Lock.Seize; if Command_Name(Cmd_Line.all)'Length = Cmd_Line'Length then if not Os_Lib."="(Os_Lib.Locate_Exec_On_Path(Cmd_Line.all), null) then declare Args : constant Os_Lib.Argument_List_Access := Os_Lib.Argument_String_To_List ("-c """ & Os_Lib.Locate_Exec_On_Path(Cmd_Line.all).all & """"); begin Result := new Result_Record ' (M.Tools.Spawn(Cmd_Line.all, ".Out")); Errno := Result.Return_Code; end; end if; elsif Fixed.Index(Command_Name(Cmd_Line.all), "/") = 0 then Result := new Result_Record' (M.Tools.Spawn("/usr/bin/sh -c """ & Tools.Normalize_Quoted_Argument(Cmd_Line.all) & """", ".Out")); Errno := Result.Return_Code; else declare Args : constant Os_Lib.Argument_List_Access := Os_Lib.Argument_String_To_List ("/usr/bin/sh -c """ & Os_Lib.Locate_Exec_On_Path(Command_Name(Cmd_Line.all)).all & " " & Tools.Normalize_Quoted_Argument(Cmd_Line(Command_Name(Cmd_Line.all)'Length+2..Cmd_Line'Last) & """")); begin Os_Lib.Normalize_Arguments(Args.all); PID := Os_Lib.Non_Blocking_Spawn(Os_Lib.Locate_Exec_On_Path(Args(1).all).all, Args(2..Args'Last), ".Out", True); Os_Lib.Wait_Process(PID, Success); end; end if; Screen_Lock.Release; File_Thread.Release; loop select accept Wait(Success : out Boolean;Errno : out Integer) do if Errno = 0 then Success := True; end if; Errno := Exec_Thread.Errno; end Wait; or accept Read_Line; or accept Halt do File_Thread.Reset; end Halt; exit; end select; end loop; end Exec_Thread; End_Of_This_Task : Boolean := False; Line_Index : Natural := 1; Doc_Index : Natural := 0; Line_Last : Natural := 0; Lines_Table : Wide_Set(32735); Lines_Set : Wide_Set(32735); Is_Full : Boolean := False; Done : Boolean := True; Args_Index : Natural := 0; Arguments : Wide_Access; Var_Set : Attributs(2048); Alias_Set : Attributs(2048); Internal_Cmd : Int_Cmd_Enum := None; Is_Internal_Cmd : Boolean := False; Buffer : Wide_Access; Completion_Result : Wide_Result_Access; History_Set : Wide_Set(2048); History_Last : Natural := 0; History_Index : Natural := 0; Result_Index : Natural := 0; Success : Boolean := False; xls_index : Natural := 0; Total : Natural := 0; Old_Text : Wide_Access; begin Alias_Set.List(1) := Make("ls", "ls -C -p --color -w " & Integer'Image(Columns/2-4)); Alias_Set.Index := 1; Initialize(Empty_Win, 1, 1, Lines, Columns, black, black); Clocking.Start; Main_Loop: loop loop select when Mode.State => accept Receive (Wchar : in Wide_Character) do if Is_control(Wchar) then case Wchar is when Wide_Character'Val(5) => Mode.State := False; when Wide_Character'Val(9) => --Lock.Seize; declare Line : constant Os_Lib.String_Access := new String ' (Handling.To_String(Text.all)); Path_On_Line : M.Strings.Wide_String_Access; buffer : OS_Lib.String_Access := new String ' (""); begin if Line /= null and then Line'Length /= 0 then if not "="(Completion_Result, null) then U_Array_Free(Completion_Result.wlines); end if; M.Tools.Completion(Line.all, Path_On_Line, Completion_Result); if Path_On_Line /= null then Buffer := new String ' (Handling.To_String(Path_On_Line.all)); Wide_Free(Path_On_Line); Wide_Free(Text); Text := new Wide_String ' (Handling.To_Wide_String(Buffer.all)); Free(Buffer); U_Array_Free(Completion_Result.Wlines); Wide_Result_Free(Completion_Result); else for I in Completion_Result.wlines'Range loop Put_Line(M.Tools.Delete_Local_Prefix(Handling.To_String((-(Completion_Result.wlines(I)))))); end loop; end if; end if; end; --Lock.Release; when Wide_Character'Val(10) | Wide_Character'Val(13) => Clocking.Suspend; Result_Index := 0; if Text /= null and then Text'Length > 0 and then Wide_Fixed.Index_Non_Blank(Text.all) /= 0 then --Lock.Seize; Text_Io.New_Line; if Text(1) = '-' or Text(1) = '+' then if Text'Length > 1 then declare Val : Total_Type := 0.0; begin Val := Total_Type'Value(Handling.To_String(Text.all)); Total_Sum := Total_Sum + Val; Wide_Free(Text); Text := new Wide_String ' (""); exception when Constraint_error => Put_Line("-: error"); end; Lib.Shared.Line_Cur := Lib.Shared.Line_Cur + 1; end if; else if not "="(Completion_Result, null) then U_Array_Free(Completion_Result.Wlines); Wide_Result_Free(Completion_Result); end if; if not "="(Result, null) then U_Array_Free(Result.Wlines); Wide_Result_Free(Result); end if; Draw_Window(App.Cmd_Result.Win); File_thread.Reset; Internal_Cmd := Internal_Cmd_Value(Handling.To_String(Text.all)); Is_Internal_Cmd := True; --if Internal_Cmd /= None then if not "="(Result, null) then U_Array_Free(Result.Wlines); Wide_Result_Free(Result); end if; case Internal_Cmd is when Help => Result := new Spawn_Result_Record; Internal_Help(Text.all, Spawn_Result_Record(Result.all)); --New_Line; Draw_Buffer(Result, App.Cmd_Result.Win, 0); Wide_Result_Free(Result); --Lib.Shared.Line_Cur := Lib.Shared.Line_Cur + Result.Count+1; when none => Is_Internal_Cmd := False; when Alias => Alias(Handling.To_String(Text.all), Alias_Set); when Unalias => Unalias(Handling.To_String(Text.all), Alias_Set); when Cd => begin M.Tools.Change_Directory(Handling.To_String(Text.all), Old_Pwd); exception when Directory_Error => Text_Io.Put("Directory not found"); Text_Io.New_Line; end; when Set => Set(Handling.To_String(Text.all), Var_Set); when Unset => Unset(Handling.To_String(Text.all), Var_Set); when Put => Args_Index := Index(Handling.To_String(Text.all), " "); if Args_Index /= 0 then Arguments := new Wide_String ' (Text(Args_Index+1..Text'Length)); Put(Handling.To_String(Arguments.all), Var_Set); end if; Text_Io.New_Line; when Put_Line => Args_Index := Index(Handling.To_String(Text.all), " "); if Args_Index /= 0 then Arguments := new Wide_String ' (Text(Args_Index+1..Text'length)); Put_Line(Handling.To_String(Arguments.all), Var_Set); end if; when Clear => Draw_Window(App.Cmd_Result.Win); when Xls => Xls_Index := 0; Internal.xls(Handling.To_String(Text.all), App.Cmd_Result.Win, Xls_Index, Total, true); Total := 0; Wide_Free(Old_Text); Old_Text := new Wide_String ' (Text.all); end case; Last_Cmd := Internal_Cmd; --Line_Cur := Line_Cur + 1; if not Is_Internal_Cmd then --New_Line; declare Alias_Ptr : Os_Lib.String_Access; Buffer : Os_Lib.String_Access; Normal : Os_Lib.String_Access; begin for Iter in 1..Alias_Set.Index loop declare Alias : constant Attribut_Record := Alias_Set.List(Iter); First_Space : Natural := Index(Handling.To_String(Text.all), " "); Non_Blank : constant Natural := Index_Non_Blank(Handling.To_String(Text.all), Backward); begin if Non_Blank < First_Space then First_Space := 0; end if; if First_Space /= 0 then if Names(Alias) = Handling.To_String(Text(Text'First..First_Space - 1)) then Alias_Ptr := new String ' (Images(Alias)); exit; end if; else if Names(Alias) = Handling.To_String(Text(Text'First..Index_Non_Blank(Handling.To_String(Text.all), Backward))) then Alias_Ptr := new String ' (Images(Alias)); exit; end if; end if; end; end loop; if Alias_Ptr /= null then declare First_Space : constant Natural := Index(Handling.To_String(Text.all), " "); begin if First_Space /= 0 then Buffer := new String ' (Alias_Ptr.all & ' ' & Handling.To_String(Text(First_Space+1..Text ' Last))); else Buffer := new String ' (Alias_Ptr.all); end if; end; Wide_Free(Text); Normal := new String ' (M.Tools.Normalize_Quoted_Argument(Buffer.all)); Text := new Wide_String ' (Handling.To_Wide_String(Normal.all)); end if; end; declare Thread : Exec_Thread(new String ' (Handling.to_String(Text.all))); Success : Boolean := False; Errno : Integer := 0; File : File_Type; begin Clocking.Suspend; Thread.Spawn; File_thread.Start; Thread.Wait(Success, Errno); Thread.halt; end; end if; Old_Length := Text'Length; Add_Line(History_Set, History_Last, Text.all); History_Index := 0; Wide_Free(Text); Text := new Wide_String ' (""); Cmd_Current_Pos := Text'Length; Draw_Window(App.Cmd.Win); end if; --Lock.Release; end if; Put(Normal_Mode); when Wide_Character'Val(12) => Screen_Lock.Seize; Put(Save_Cursor); Devel_Draw_Main_Win (App); Draw_Window(App.Buffer.Win); Draw_Window(App.Cmd.Win); Draw_Window(App.Err.Win); if App.Doc_Initialized then Draw_Window(App.Document.Win); end if; if App.Doc_Initialized then Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, True); else Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, False); end if; if App.Current_Doc /= null and then App.Current_Doc.Openned then if App.Current_Doc.Filename /= null then Save_Buffer(App.Current_Doc, Lines_Table); end if; Set_Free(Lines_Set); Highlight(App.Current_Doc, Lines_Set); if not Print_Set(Lines_Set, App.Document.Win, Doc_Index, Total_Line) then raise Spec_Error; end if; else Set_Free(Lines_Table); Doc_Init(App.all, Lines_Table); if not Print_Set(Lines_Table, App.Document.Win, Doc_Index, Total_Line) then raise Program_Error; end if; end if; Put(Restore_Cursor); Screen_Lock.Release; Clocking.Refresh; when Wide_Character'Val(127) => if Text /= null and then Text'Length > 0 then Old_Length := Text'Length; Buffer := new Wide_String ' (Text.all(Text'First..Text'Last-1)); Wide_Free(Text); Text := new Wide_String ' (Buffer.all); Wide_Free(Buffer); if Cmd_Current_Pos > 0 then Cmd_Current_Pos := Cmd_Current_Pos - 1; end if; end if; when others => null; end case; else Buffer := new Wide_String ' (Text.all & Wchar); Wide_Free(Text); Text := new Wide_String ' (buffer.all); Wide_Free(Buffer); Old_Length := Text'Length; Cmd_Current_Pos := Cmd_Current_Pos + 1; end if; if not Mode.State then Screen_Lock.Seize; Devel_Win_Init(App, 0, false); Edit_Draw_Main_Win(App); Draw_Window(App.Buffer.Win); Draw_Text(App.Buffer.Win, 1, 22, white, " ; Alphabet"); Draw_Text(App.Buffer.Win, 1, 33, red, " : "); Draw_Text(App.Buffer.Win, 1, 36, yellow, Alphabet); Draw_Text(App.Buffer.Win, 2, 2, Cyan, "Chars max"); Draw_Text(App.Buffer.Win, 2, 17, white, " : "); Draw_Text(App.Buffer.Win, 2, 20, magenta, Handling.To_Wide_String(Natural'Image(Columns-5))); Draw_Text(App.Buffer.Win, 3, 2, Cyan, "Char(s) left"); Draw_Text(App.Buffer.Win, 3, 17, white, " : "); Draw_Text(App.Buffer.Win, 3, 20, magenta, Handling.To_Wide_String(Integer'Image(255 - Wline_Length))); Draw_Text(App.Buffer.Win, 2, 25, Cyan, " ; Line_Index"); Draw_Text(App.Buffer.Win, 2, 39, white, " : "); Draw_Text(App.Buffer.Win, 2, 43, magenta, Handling.To_Wide_String(positive'Image(Line_index))); Draw_Text(App.Buffer.Win, 3, 25, Cyan, " ; Line, Col"); Draw_Text(App.Buffer.Win, 3, 39, white, " : "); Draw_Text(App.Buffer.Win, 3, 43, magenta, Handling.To_Wide_String(positive'Image(Line_cur) & ", " & positive'Image(Col_cur))); Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Line_Length "); Draw_Text(App.Buffer.Win, 3, 65, white, " : "); Draw_Text(App.Buffer.Win, 3, 69, magenta, Handling.To_Wide_String(Natural'Image(Wline_length))); -- Draw_Text(App.Buffer.Win, 2, 25, Cyan, " ; word max"); -- Draw_Text(App.Buffer.Win, 2, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 2, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Sh_Max_Words))); -- Draw_Text(App.Buffer.Win, 3, 25, Cyan, " ; Word number"); -- Draw_Text(App.Buffer.Win, 3, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Word_Number))); Draw_Text(App.Buffer.Win, 2, 50, Cyan, " ; lines max"); Draw_Text(App.Buffer.Win, 2, 64, white, " : "); Draw_Text(App.Buffer.Win, 2, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(2880))); Draw_Text(App.Buffer.Win, 2, 85, Cyan, " ; line_last"); Draw_Text(App.Buffer.Win, 2, 100, white, " : "); Draw_Text(App.Buffer.Win, 2, 103, magenta, Handling.To_Wide_String(Natural'Image(Lines_Table.Line_last))); -- Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Lines count"); -- Draw_Text(App.Buffer.Win, 3, 64, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(Dialog_Buffer_Last))); Draw_Text(App.Buffer.Win, 3, 76, Cyan, " ; Overwrite"); Draw_Text(App.Buffer.Win, 3, 88, white, " : "); Draw_Text(App.Buffer.Win, 3, 91, magenta, Handling.To_Wide_String(Boolean'Image(Is_Overwrite))); Screen_Lock.Release; else if not "="(Completion_Result, null) and then not "="(Completion_Result.Wlines, null) then Draw_Window(App.Cmd_Result.Win); Draw_Buffer(Completion_Result, App.Cmd_Result.Win, Result_Index); elsif not "="(Result, null) then Draw_Window(App.Err.Win); if Result.Success then Draw_Text(App.Err.Win, 1, 1, White, (-(Result.Program_Name)) & " Success"); else Draw_Text(App.Err.Win, 1, 1, White, (-(Result.Program_Name)) & " Failure"); end if; if Last_Cmd = None then Draw_Window(App.Cmd_Result.Win); Draw_Buffer(Result, App.Cmd_Result.Win, Result_Index); end if; Draw_Window(App.Buffer.Win); if History_Last > 0 then if not "="(Result, null) and then Result.Success then if Os_Lib.Locate_Exec_On_Path(Command_Name(Handling.To_String(History_Set.Lines(History_Last).all))) /= null and then Os_Lib.Locate_Exec_On_Path(Command_Name(Handling.To_String(History_Set.Lines(History_Last).all)))'Length /= 0 then Draw_Text(App.Buffer.Win, 1, 1, Yellow, " Cmd : "); Draw_Text(App.Buffer.Win, 1, 10, White, Handling.To_Wide_String(Os_Lib.Locate_Exec_On_Path(Command_Name(Handling.To_String(History_Set.Lines(History_Last).all))).all)); Draw_Text(App.Buffer.Win, 2, 1, Yellow, " Args : "); Draw_Text(App.Buffer.Win, 2, 10, White, Troncate(History_Set.Lines(History_Last)(Command_Name(Handling.To_String(History_Set.Lines(History_Last).all))'Length+2..History_Set.Lines(History_Last)'Last), Columns/2-10)); Draw_Text(App.Buffer.Win, 3, 1, Yellow, " Error : "); Draw_Text(App.Buffer.Win, 3, 10, White, Handling.To_Wide_String(Integer'Image(Errno))); end if; end if; end if; end if; Draw_Window(App.Cmd.Win); if Text /= null then Draw_Text(App.Cmd.Win, 1, 1, White, Text.all); end if; end if; Screen_Lock.Seize; Put(Save_Cursor); if App.Current_Doc /= null then if App.Doc_Initialized then Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, True); else Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, False); end if; if App.Current_Doc /= null and then App.Current_Doc.Openned then if App.Current_Doc.Filename /= null then Save_Buffer(App.Current_Doc, Lines_Table); end if; Set_Free(Lines_Set); Highlight(App.Current_Doc, Lines_Set); Draw_Window(App.Document.Win); if not Print_Set(Lines_Set, App.Document.Win, Doc_Index, Total_Line) then raise Spec_Error; end if; else Set_Free(Lines_Table); Doc_Init(App.all, Lines_Table); if not Print_Set(Lines_Table, App.Document.Win, Doc_Index, Total_Line) then raise Program_Error; end if; end if; elsif Lines_Table.Line_Last /= 0 then Set_Free(Lines_Table); Doc_Init(App.all, Lines_Table); if not Print_Set(Lines_Table, App.Document.Win, Doc_Index, Total_Line) then raise Program_Error; end if; else if not Print_Set(Lines_Table, App.Document.Win, Doc_Index, Total_Line) then raise Program_Error; end if; end if; Screen_Lock.Release; Clocking.start; end Receive; or when not Mode.State => accept Receive (Wchar : in Wide_Character) do if Is_control(Wchar) then case Wchar is when Wide_Character'Val(5) => Screen_Lock.seize; if App.Current_Doc /= null and then not App.Current_Doc.Openned then Doc_Init(App.all, Lines_Table); end if; Mode.State := True; Line_Cur := 1; Doc_Index := 0; Line_Index := 1; Wline := Lines_Table.Lines(Line_index); Wchar_Index := 0; Wline_Length := Wline'Length; Line_Current_Pos := 0; Col_Cur := 1; if not Mode.State then Edit_Draw_Main_Win(App); Draw_Window(App.Buffer.Win); Draw_Text(App.Buffer.Win, 1, 22, white, " ; Alphabet"); Draw_Text(App.Buffer.Win, 1, 33, red, " : "); Draw_Text(App.Buffer.Win, 1, 36, yellow, Alphabet); Draw_Text(App.Buffer.Win, 2, 2, Cyan, "Chars max"); Draw_Text(App.Buffer.Win, 2, 17, white, " : "); Draw_Text(App.Buffer.Win, 2, 20, magenta, Handling.To_Wide_String(Natural'Image(Columns-5))); Draw_Text(App.Buffer.Win, 3, 2, Cyan, "Char(s) left"); Draw_Text(App.Buffer.Win, 3, 17, white, " : "); Draw_Text(App.Buffer.Win, 3, 20, magenta, Handling.To_Wide_String(Integer'Image(255 - Wline_Length))); -- Draw_Text(App.Buffer.Win, 2, 25, Cyan, " ; word max"); -- Draw_Text(App.Buffer.Win, 2, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 2, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Sh_Max_Words))); -- Draw_Text(App.Buffer.Win, 3, 25, Cyan, " ; Word number"); -- Draw_Text(App.Buffer.Win, 3, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Word_Number))); Draw_Text(App.Buffer.Win, 2, 50, Cyan, " ; lines max"); Draw_Text(App.Buffer.Win, 2, 64, white, " : "); Draw_Text(App.Buffer.Win, 2, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(2880))); Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Line_Length "); Draw_Text(App.Buffer.Win, 3, 65, white, " : "); Draw_Text(App.Buffer.Win, 3, 69, magenta, Handling.To_Wide_String(Natural'Image(Wline_length))); -- Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Lines count"); -- Draw_Text(App.Buffer.Win, 3, 64, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(Dialog_Buffer_Last))); Draw_Text(App.Buffer.Win, 3, 76, Cyan, " ; Overwrite"); Draw_Text(App.Buffer.Win, 3, 88, white, " : "); Draw_Text(App.Buffer.Win, 3, 91, magenta, Handling.To_Wide_String(Boolean'Image(Is_Overwrite))); end if; Draw_Window(App.Doc_states.Win); if App.Current_Doc /= null and then App.Current_Doc.Filename /= null then App.Current_Doc.Openned := True; if App.Doc_Initialized then Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, True); else Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, False); end if; Set_Free(Lines_Set); Highlight(App.Current_Doc, Lines_Set); if not Print_Set(Lines_Set, App.Document.Win, Doc_Index, Total_Line) then raise Spec_Error; end if; end if; if not App.Doc_Initialized then Set_Free(Lines_Table); Doc_Init(App.all, Lines_Table); if not Print_Set(Lines_Table, App.Document.Win, Doc_Index, Total_Line) then raise Program_Error; end if; else Set_Free(Lines_Set); Highlight(App.Current_Doc, Lines_Set); Draw_Window(App.Document.Win); if not Print_Set(Lines_Set, App.Document.Win, Doc_Index, Total_Line) then raise Spec_Error; end if; end if; Screen_Lock.Release; Clocking.Suspend; if Mode.State then Draw_Window(App.Err.Win); Draw_Window(App.Buffer.Win); Draw_Window(App.Cmd_Result.Win); Draw_Window(App.Cmd.Win); Devel_Win_Init(App, 0, Is_full); Devel_Draw_Main_Win(App); if "="(Result, null) then if Result.Success then Draw_Text(App.Err.Win, 1, 1, White, (-(Result.Program_Name)) & " Success"); else Draw_Text(App.Err.Win, 1, 1, White, (-(Result.Program_Name)) & " Failure"); end if; if Last_Cmd = None then Draw_Buffer(Result, App.Cmd_Result.Win, Result_Index); end if; if History_Set.Lines(History_Last) /= null and then Os_Lib.Locate_Exec_On_Path(Command_Name(Handling.To_String(History_Set.Lines(History_Last).all))) /= null then Draw_Text(App.Buffer.Win, 1, 1, Yellow, " Cmd : "); Draw_Text(App.Buffer.Win, 1, 10, White, Handling.To_Wide_String(Os_Lib.Locate_Exec_On_Path(Command_Name(Handling.To_String(History_Set.Lines(History_Last).all))).all)); Draw_Text(App.Buffer.Win, 2, 1, Yellow, " Args : "); Draw_Text(App.Buffer.Win, 2, 10, White, Troncate(History_Set.Lines(History_Last)(Command_Name(Handling.To_String(History_Set.Lines(History_Last).all))'Length+2..History_Set.Lines(History_Last)'Last), Columns/2-10)); Draw_Text(App.Buffer.Win, 3, 1, Yellow, " Error : "); Draw_Text(App.Buffer.Win, 3, 10, White, Handling.To_Wide_String(Integer'Image(Errno))); end if; else Draw_Text(App.Buffer.Win, 1, 1, Yellow, " Cmd : "); Draw_Text(App.Buffer.Win, 2, 1, Yellow, " Args : "); Draw_Text(App.Buffer.Win, 3, 1, Yellow, " Error : "); end if; end if; Clocking.Start; Clocking.refresh; when Wide_Character'Val(6) => if Is_Full then Draw_Window(Empty_Win); Devel_Win_Init(App, 0, not Is_full); Edit_Win_Init(App, 0, False); if App.Current_Doc /= null and then not App.Current_Doc.Openned then Doc_Init(App.all, Lines_Table); end if; Initialize(App.Buffer.Win, Lines-5, 2, 5, Columns/2-2, Cyan, White); else Draw_Window(Empty_Win); Devel_Win_Init(App, 0, not Is_full); Edit_Win_Init(App, 0, True); if App.Current_Doc /= null and then not App.Current_Doc.Openned then Doc_Init(App.all, Lines_Table); end if; Initialize(App.Buffer.Win, Lines-5, 2, 5, Columns-2, Cyan, White); end if; Is_Full := not Is_Full; when Wide_Character'Val(9) => if App.Current_Doc /= null then if App.Current_Doc.Unit.all = "adb" or App.Current_Doc.Unit.all = "ads" or App.Current_Doc.Unit.all = "ada" or App.Current_Doc.Unit.all = "c" or App.Current_Doc.Unit.all = "h" or App.Current_Doc.Unit.all = "pl" then if Wchar_Index = Wline_Length then Wbuffer := new Wide_String ' (Wline.all & " "); Wide_Free(WLine); Wline := new Wide_String ' (Wbuffer.all); Wide_Free(Wbuffer); Wline_Length := Wline'Length; Line_Current_Pos := Wline'Length-1; Wchar_Index := Wline'Length; elsif Line_Current_Pos = 0 then Wbuffer := new Wide_String ' (" " & Wline.all); Wide_Free(WLine); Wline := new Wide_String ' (Wbuffer.all); Wide_Free(Wbuffer); Wline_Length := Wline'Length; Line_Current_Pos := Line_Current_Pos + 3; Wchar_Index := Wchar_Index + 3; else Left_Buffer := new Wide_String ' (Wline(Wline'first..Line_Current_Pos)); Wbuffer := new Wide_String ' (Left_Buffer.all & " " & Wline(Line_Current_Pos+1..Wline'Last)); Wide_Free(Wline); Wline := new Wide_String ' (Wbuffer.all); Wide_Free(Wbuffer); Wline_Length := Wline'Length; Line_Current_Pos := Line_Current_Pos + 3; Wchar_Index := Wchar_Index + 3; end if; else if Wchar_Index = Wline_Length then Wbuffer := new Wide_String ' (Wline.all & " "); Wide_Free(WLine); Wline := new Wide_String ' (Wbuffer.all); Wide_Free(Wbuffer); Wline_Length := Wline'Length; Line_Current_Pos := Wline'Length-1; Wchar_Index := Wline'Length; elsif Line_Current_Pos = 0 then Wbuffer := new Wide_String ' (" " & Wline.all); Wide_Free(WLine); Wline := new Wide_String ' (Wbuffer.all); Wide_Free(Wbuffer); Wline_Length := Wline'Length; Line_Current_Pos := Line_Current_Pos + 7; Wchar_Index := Wchar_Index + 7; else Left_Buffer := new Wide_String ' (Wline(Wline'first..Line_Current_Pos)); Wbuffer := new Wide_String ' (Left_Buffer.all & " " & Wline(Line_Current_Pos+1..Wline'Last)); Wide_Free(Wline); Wline := new Wide_String ' (Wbuffer.all); Wide_Free(Wbuffer); Wline_Length := Wline'Length; Line_Current_Pos := Line_Current_Pos + 7; Wchar_Index := Wchar_Index + 7; end if; end if; Lines_Table.Lines(Line_Index) := Wline; Line_Cur := Count (Lines_Table, Doc_Index, Line_Index, Wchar_Index, Line_Cur, Col_Cur, Height, Width); if ((Wchar_Index) mod Width) /= 0 then Col_Cur := ((Wchar_Index) mod Width) + 1; else Col_Cur := 1; end if; else W_Io.Put(Wide_Character'Val(7)); end if; when Wide_Character'Val(10) => if Line_Index+1 <= Lines_Table.Lines'Last then if Lines_Table.Line_Last < Lines_Table.Lines'Length then if Wchar_Index = Wline_Length then if Line_Index = Lines_Table.Line_Last then Lines_Table.Line_Last := Lines_Table.Line_Last + 1; Line_Index := Line_Index + 1; Wline := new Wide_String ' (""); Lines_Table.Lines(Line_Index) := Wline; else for Line in reverse Line_Index .. Lines_Table.Line_Last loop Lines_Table.Lines(Line + 1) := Lines_Table.Lines(Line); end loop; Line_Index := Line_Index + 1; Wline := new Wide_String ' (""); Lines_Table.Lines(Line_Index) := Wline; Lines_Table.Line_Last := Lines_Table.Line_Last + 1; end if; elsif Wchar_Index > 1 then Left_Buffer := new Wide_String ' (Wline(Wline'first..Wchar_index)); Wline := new Wide_String ' (Wline(Wchar_Index+1..Wline'Length)); Wide_Free(Lines_Table.Lines(Line_Index)); Lines_Table.Lines(Line_Index) := Left_Buffer; for Line in reverse Line_Index .. Lines_Table.Line_Last loop Lines_Table.Lines(Line + 1) := Lines_Table.Lines(Line); end loop; Line_Index := Line_Index + 1; Lines_Table.Lines(Line_Index) := Wline; Lines_Table.Line_Last := Lines_Table.Line_Last + 1; else Wbuffer := new Wide_String ' (Wline.all); Wline := new Wide_String ' (""); for Line in reverse Line_Index .. Lines_Table.Line_Last loop Lines_Table.Lines(Line + 1) := Lines_Table.Lines(Line); end loop; Lines_Table.Lines(Line_Index) := Wline ; Line_Index := Line_Index + 1; Lines_Table.Lines(Line_Index) := Wbuffer; Lines_Table.Line_Last := Lines_Table.Line_Last + 1; end if; Wline := Lines_Table.Lines(Line_index); Wchar_Index := 0; Wline_Length := Wline'Length; Line_Current_Pos := 0; if Line_Cur >= App.Document.Win.H-2 then Doc_Index := Doc_Index + 1; else Line_Cur := Line_Cur + 1; end if; Col_Cur := 1; else W_Io.Put(Wide_Character'Val(7)); end if; else Line_Index := Line_Index + 1; Wline := new Wide_String ' (""); Lines_Table.Lines(Line_Index) := Wline; Lines_Table.Line_Last := Lines_Table.Line_Last + 1; if Line_Cur >= Height then Doc_Index := Doc_Index + 1; else Line_Cur := Line_Cur + 1; end if; Col_Cur := 1; end if; --Clocking.refresh; when Wide_Character'Val(12) => Screen_Lock.Seize; Put(Save_Cursor); Edit_Draw_Main_Win (App); Draw_Window(App.Buffer.Win); Draw_Text(App.Buffer.Win, 1, 22, white, " ; Alphabet"); Draw_Text(App.Buffer.Win, 1, 33, red, " : "); Draw_Text(App.Buffer.Win, 1, 36, yellow, Alphabet); Draw_Text(App.Buffer.Win, 2, 2, Cyan, "Chars max"); Draw_Text(App.Buffer.Win, 2, 17, white, " : "); Draw_Text(App.Buffer.Win, 2, 20, magenta, Handling.To_Wide_String(Natural'Image(Columns-5))); Draw_Text(App.Buffer.Win, 3, 2, Cyan, "Char(s) left"); Draw_Text(App.Buffer.Win, 3, 17, white, " : "); Draw_Text(App.Buffer.Win, 3, 20, magenta, Handling.To_Wide_String(Natural'Image(255 - Wline_Length))); Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Line_Length "); Draw_Text(App.Buffer.Win, 3, 65, white, " : "); Draw_Text(App.Buffer.Win, 3, 69, magenta, Handling.To_Wide_String(Natural'Image(Wline_length))); -- Draw_Text(App.Buffer.Win, 2, 25, Cyan, " ; word max"); -- Draw_Text(App.Buffer.Win, 2, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 2, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Sh_Max_Words))); -- Draw_Text(App.Buffer.Win, 3, 25, Cyan, " ; Word number"); -- Draw_Text(App.Buffer.Win, 3, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Word_Number))); Draw_Text(App.Buffer.Win, 2, 50, Cyan, " ; lines max"); Draw_Text(App.Buffer.Win, 2, 64, white, " : "); Draw_Text(App.Buffer.Win, 2, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(2880))); -- Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Lines count"); -- Draw_Text(App.Buffer.Win, 3, 64, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(Dialog_Buffer_Last))); Draw_Text(App.Buffer.Win, 3, 76, Cyan, " ; Overwrite"); Draw_Text(App.Buffer.Win, 3, 88, white, " : "); Draw_Text(App.Buffer.Win, 3, 91, magenta, Handling.To_Wide_String(Boolean'Image(Is_Overwrite))); if App.Doc_Initialized then Draw_Window(App.Document.Win); end if; if App.Doc_Initialized then Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, True); else Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, False); end if; if App.Current_Doc /= null and then App.Current_Doc.Openned then if App.Current_Doc.Filename /= null then Save_Buffer(App.Current_Doc, Lines_Table); end if; Set_Free(Lines_Set); Highlight(App.Current_Doc, Lines_Set); if not Print_Set(Lines_Set, App.Document.Win, Doc_Index, Total_Line) then raise Spec_Error; end if; else Set_Free(Lines_Table); Doc_Init(App.all, Lines_Table); if not Print_Set(Lines_Table, App.Document.Win, Doc_Index, Total_Line) then raise Program_Error; end if; end if; Put(Restore_Cursor); Screen_Lock.Release; Clocking.Refresh; when Wide_Character'Val(14) => Clocking.Suspend; --Goal_Path_Deamon.Suspend; loop begin Draw_Window(Empty_Win); declare Filename : Wide_String := New_Wide_String ("New file", "Filename : ", 64, Lines/2-2, Columns/4-40, True); begin Draw_Window(Empty_Win); declare Response : constant Wide_String := (New_Wide_String ("License", "Include the Gnu Public Licence ? (y/o or n) : ", 50, Lines/2-2, Columns/4-50, True)); License : Boolean := False; begin if Response(1) = 'y' or Response(1) = 'Y' or Response(1) = 'o' or Response(1) = 'O' then License := True; end if; if License then Draw_Window(Empty_Win); declare Description : Wide_String := New_Wide_String ("Descrption", "Descr : ", 64, Lines/2-2, Columns/4-40, True); begin Draw_Window(Empty_Win); declare Version : Wide_String := New_Wide_String ("Version", "Version : ", 20, Lines/2-2, Columns/4-20, True); begin Set_Free(Lines_Table); Docume_Free(App.Current_Doc); New_Doc (Center => App.all, Lines_Table => Lines_Table, Docume => App.Current_Doc, Filename => Handling.To_String(Filename), Version => Version, License => True, Description => Description); App.Current_Doc.Owner := new String ' (App.User.Logname.all); Wline := new Wide_String ' (""); Lines_Table.lines(Lines_Table.Line_Last + 1) := Wline; Lines_Table.Line_Last := Lines_Table.Line_Last + 1; App.Doc_Initialized := True; Doc_Index := 0; Line_Cur := 1; Col_Cur := 1; Wchar_Index := 0; Line_Current_Pos := 0; end; end; else Draw_Window(Empty_Win); declare Version : Wide_String := New_Wide_String ("Version", "Version : ", 20, Lines/2-2, Columns/4-20, True); begin Set_Free(Lines_Table); Docume_Free(App.Current_Doc); New_Doc (Center => App.all, Lines_Table => Lines_Table, Docume => App.Current_Doc, Filename => Handling.To_String(Filename), Version => Version, License => False, Description => ""); App.Current_Doc.Owner := new String ' (App.User.Logname.all); Wline := new Wide_String ' (""); Lines_Table.lines(Lines_Table.Line_Last + 1) := Wline; Lines_Table.Line_Last := Lines_Table.Line_Last + 1; App.Doc_Initialized := True; Doc_Index := 0; Line_Cur := 1; Col_Cur := 1; Wchar_Index := 0; Line_Current_Pos := 0; end; end if; --Current_State := Document; exception when End_Error => exit; end; exception when End_Error => exit; end; Screen_Lock.Seize; Edit_Draw_Main_Win (App); Draw_Text(App.Buffer.Win, 1, 22, white, " ; Alphabet"); Draw_Text(App.Buffer.Win, 1, 33, red, " : "); Draw_Text(App.Buffer.Win, 1, 36, yellow, Alphabet); Draw_Text(App.Buffer.Win, 2, 2, Cyan, "Chars max"); Draw_Text(App.Buffer.Win, 2, 17, white, " : "); Draw_Text(App.Buffer.Win, 2, 20, magenta, Handling.To_Wide_String(Natural'Image(Columns-5))); Draw_Text(App.Buffer.Win, 3, 2, Cyan, "Char(s) left"); Draw_Text(App.Buffer.Win, 3, 17, white, " : "); Draw_Text(App.Buffer.Win, 3, 20, magenta, Handling.To_Wide_String(Integer'Image(255 - Wline_Length))); Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Line_Length "); Draw_Text(App.Buffer.Win, 3, 65, white, " : "); Draw_Text(App.Buffer.Win, 3, 69, magenta, Handling.To_Wide_String(Natural'Image(Wline_length))); -- Draw_Text(App.Buffer.Win, 2, 25, Cyan, " ; word max"); -- Draw_Text(App.Buffer.Win, 2, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 2, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Sh_Max_Words))); -- Draw_Text(App.Buffer.Win, 3, 25, Cyan, " ; Word number"); -- Draw_Text(App.Buffer.Win, 3, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Word_Number))); Draw_Text(App.Buffer.Win, 2, 50, Cyan, " ; lines max"); Draw_Text(App.Buffer.Win, 2, 64, white, " : "); Draw_Text(App.Buffer.Win, 2, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(2880))); -- Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Lines count"); -- Draw_Text(App.Buffer.Win, 3, 64, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(Dialog_Buffer_Last))); Draw_Text(App.Buffer.Win, 3, 71, Cyan, " ; Overwrite"); Draw_Text(App.Buffer.Win, 3, 83, white, " : "); Draw_Text(App.Buffer.Win, 3, 86, magenta, Handling.To_Wide_String(Boolean'Image(Is_Overwrite))); Screen_Lock.Release; exit; exception when W_Io.End_Error => null; end; end loop; Clocking.Start; --Goal_Path_Deamon.Restart; Done := False; when Wide_Character'Val(15) => Clocking.Suspend; --Goal_Path_Deamon.Suspend; loop begin Draw_Window(Empty_Win); declare Filename : Wide_String := New_Wide_String ("Open file", "Filename : ", 64, Lines/2-2, Columns/4-40, True); begin Docume_Free(App.Current_Doc); Set_Free(Lines_Table); Open_Doc (Lines_Table => Lines_Table, Docume => App.Current_Doc, Filename => Handling.To_String(Filename)); Wide_Free(Title); Title := new Wide_String ' (Troncate(Filename, 50)); App.Doc_Initialized := True; if Lines_Table.Line_Last /= 0 then Wline := Lines_Table.Lines(1); Wline_Length := Real_Length(Wline.all); else Lines_Table.Lines(1) := Wline; end if; Line_Index := 1; Doc_Index := 0; Line_Current_Pos := 0; Line_Cur := 1; Col_Cur := 1; Wchar_Index := 0; exit ; exception when Spec_Error => null; end; exception when End_Error => exit; end; Screen_Lock.Seize; Edit_Draw_Main_Win (App); --Current_State := Document; Draw_Text(App.Buffer.Win, 1, 2, cyan, "Is Document mode"); Draw_Text(App.Buffer.Win, 1, 22, white, " ; Alphabet"); Draw_Text(App.Buffer.Win, 1, 33, red, " : "); Draw_Text(App.Buffer.Win, 1, 36, yellow, Alphabet); Draw_Text(App.Buffer.Win, 2, 2, Cyan, "Chars max"); Draw_Text(App.Buffer.Win, 2, 17, white, " : "); Draw_Text(App.Buffer.Win, 2, 20, magenta, Handling.To_Wide_String(Natural'Image(Columns-5))); Draw_Text(App.Buffer.Win, 3, 2, Cyan, "Char(s) left"); Draw_Text(App.Buffer.Win, 3, 17, white, " : "); Draw_Text(App.Buffer.Win, 3, 20, magenta, Handling.To_Wide_String(Integer'Image(255 - Wline_Length))); Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Line_Length "); Draw_Text(App.Buffer.Win, 3, 65, white, " : "); Draw_Text(App.Buffer.Win, 3, 69, magenta, Handling.To_Wide_String(Natural'Image(Wline_length))); -- Draw_Text(App.Buffer.Win, 2, 25, Cyan, " ; word max"); -- Draw_Text(App.Buffer.Win, 2, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 2, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Sh_Max_Words))); -- Draw_Text(App.Buffer.Win, 3, 25, Cyan, " ; Word number"); -- Draw_Text(App.Buffer.Win, 3, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Word_Number))); Draw_Text(App.Buffer.Win, 2, 50, Cyan, " ; lines max"); Draw_Text(App.Buffer.Win, 2, 64, white, " : "); Draw_Text(App.Buffer.Win, 2, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(2880))); -- Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Lines count"); -- Draw_Text(App.Buffer.Win, 3, 64, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(Dialog_Buffer_Last))); Draw_Text(App.Buffer.Win, 3, 76, Cyan, " ; Overwrite"); Draw_Text(App.Buffer.Win, 3, 88, white, " : "); Draw_Text(App.Buffer.Win, 3, 91, magenta, Handling.To_Wide_String(Boolean'Image(Is_Overwrite))); Screen_Lock.Release; end loop; Clocking.Start; --Goal_Path_Deamon.Restart; Done := False; when Wide_Character'Val(18) => Clocking.Suspend; Is_Overwrite := True; Is_Full := False; Devel_Win_Init(App, 0, false); Mode.State := True; Done := True; if not "="(Result, null) then Draw_Window(App.Err.Win); if Result.Success then Draw_Text(App.Err.Win, 1, 1, White, (-(Result.Program_Name)) & " Success"); else Draw_Text(App.Err.Win, 1, 1, White, (-(Result.Program_Name)) & " Failure"); end if; Draw_Window(App.Cmd_Result.Win); Draw_Buffer(Result, App.Cmd_Result.Win, Result_Index); end if; Draw_Window(App.Buffer.Win); if not "="(Result, null) and then Result.Success then Draw_Text(App.Buffer.Win, 1, 1, Yellow, " Cmd : "); Draw_Text(App.Buffer.Win, 1, 10, White, Handling.To_Wide_String(Os_Lib.Locate_Exec_On_Path(Command_Name(Handling.To_String(History_Set.Lines(History_Last).all))).all)); Draw_Text(App.Buffer.Win, 2, 1, Yellow, " Args : "); Draw_Text(App.Buffer.Win, 2, 10, White, Troncate(History_Set.Lines(History_Last)(Command_Name(Handling.To_String(History_Set.Lines(History_Last).all))'Length+2..History_Set.Lines(History_Last)'Last), Columns/2-10)); Draw_Text(App.Buffer.Win, 3, 1, Yellow, " Error : "); Draw_Text(App.Buffer.Win, 3, 10, White, Handling.To_Wide_String(Integer'Image(Result.Return_Code))); end if; Draw_Window(App.Cmd.Win); if Text /= null then Draw_Text(App.Cmd.Win, 1, 1, White, Text.all); end if; Clocking.start; when Wide_Character'Val(127) => if Lines_Table.Lines(Line_Index) /= null then if Line_Current_Pos > 1 then if Line_Current_Pos > 2 then if Wline'Length >= 2 then Left_Buffer := new Wide_String ' (Wline(Wline'first..Line_Current_Pos-1)); if Line_Current_Pos < Wline'Length then Wbuffer := new Wide_String ' (Left_Buffer.all & Wline(Line_Current_Pos+1..Wline'Last)); elsif Line_Current_Pos+1 = Wline'Length then Wbuffer := new Wide_String ' (Left_Buffer.all); else Wbuffer := new Wide_String ' (Left_Buffer.all); end if; else Left_Buffer := new Wide_String ' (Wline(Wline'first..Line_Current_Pos-1)); Wbuffer := new Wide_String ' (Left_Buffer.all); end if; elsif Line_Current_Pos = 2 then Left_Buffer := new Wide_String ' (Wline(Wline'first..Wline'first)); if Wline'Length >= 2 then Wbuffer := new Wide_String ' (Left_Buffer.all & Wline(Line_Current_Pos+1..Wline_Length)); else Wbuffer := new Wide_String ' (Left_Buffer.all); end if; else if Wline'Length >= 2 then Left_Buffer := new Wide_String ' (Wline(Line_Current_Pos+1..Wline'Length)); Wbuffer := new Wide_String ' (Left_Buffer.all); else Wbuffer := new Wide_String ' (""); end if; end if; Wide_Free(Wline); Wline := new Wide_String ' (Wbuffer.all); Wide_Free(Wbuffer); Wide_Free(Left_Buffer); Lines_Table.Lines(Line_Index) := Wline; wchar_Index := Wchar_Index - 1; Line_Current_Pos := Line_Current_Pos - 1; Wline_Length := Wline'Length; Line_Cur := Count (Lines_Table, Doc_Index, Line_Index, Wchar_Index, Line_Cur, Col_Cur, Height, Width); if (Wchar_Index mod Width) /= 0 then Col_Cur := (Wchar_Index mod Width) + 1; else Col_Cur := 1; end if; else if Wline'Length = 0 then if Line_Index > 1 then if Wline'Length >= 1 then Left_Buffer := new Wide_String ' (Lines_Table.Lines(Line_Index - 1).all & Wline(Wline'first..Line_Current_Pos)); if Line_Current_Pos+1 < Wline'Length then Wbuffer := new Wide_String ' (Left_Buffer.all & Wline(Line_Current_Pos+1..Wline'Last)); else Wbuffer := new Wide_String ' (Left_Buffer.all); end if; else Left_Buffer := new Wide_String ' (Lines_Table.Lines(Line_Index - 1).all); Wbuffer := new Wide_String ' (Left_Buffer.all); end if; Wline := new Wide_String ' (Wbuffer.all); Wide_Free(Wbuffer); Wide_Free(Left_Buffer); Wide_Free(Lines_Table.Lines(Line_Index - 1)); Lines_Table.Lines(Line_Index - 1) := Wline; if Line_Index < Lines_Table.Line_Last then for Line in Line_Index + 1.. Lines_Table.Line_Last loop Lines_Table.Lines(Line-1) := Lines_Table.Lines(Line); end loop; end if; Line_Index := Line_Index - 1; Lines_Table.Lines(Lines_Table.Line_Last) := null; Lines_Table.Line_Last := Lines_Table.Line_Last - 1; Wline_Length := Lines_Table.Lines(Line_Index)'Length; Wchar_Index := Wline_Length; Line_Current_Pos := Wchar_Index; Line_Cur := Count (Lines_Table, Doc_Index, Line_Index, Wchar_Index, Line_Cur, Col_Cur, Height, Width); if (Wchar_Index mod Width) /= 0 then Col_Cur := (Wchar_Index mod Width) + 1; else Col_Cur := 1; end if; else W_Io.Put(Wide_Character'Val(7)); end if; elsif Line_Index > 1 then if Line_Current_Pos = 0 then Wchar_Index := Lines_Table.Lines(Line_Index - 1)'Length; if Wline'Length >= 1 then Text_Io.Put_Line("3"); Left_Buffer := new Wide_String ' (Lines_Table.Lines(Line_Index - 1).all & Wline.all); end if; Wline := new Wide_String ' (Left_Buffer.all); Wide_Free(Left_Buffer); Wide_Free(Lines_Table.Lines(Line_Index - 1)); Lines_Table.Lines(Line_Index - 1) := Wline; if Line_Index <= Lines_Table.Line_Last then for Line in Line_Index .. Lines_Table.Line_Last-1 loop Lines_Table.Lines(Line) := Lines_Table.Lines(Line+1); end loop; Lines_Table.Lines(Lines_Table.Line_Last) := null; Lines_Table.Line_Last := Lines_Table.Line_Last - 1; end if; Line_Index := Line_Index - 1; Wline_Length := Lines_Table.Lines(Line_Index)'Length; Line_Current_Pos := Wchar_Index; Line_Cur := Count (Lines_Table, Doc_Index, Line_Index, Wchar_Index, Line_Cur, Col_Cur, Height, Width); if (Wchar_Index mod Width) /= 0 then Col_Cur := (Wchar_Index mod Width) + 1; else Col_Cur := 1; end if; elsif Line_Current_Pos < Wline'Length then Wbuffer := new Wide_String ' (Wline(Line_Current_Pos+1..Wline'Last)); Wline := new Wide_String ' (Wbuffer.all); Wide_Free(Wbuffer); Lines_Table.Lines(Line_Index) := Wline; else Wbuffer := new Wide_String ' (""); Wline := new Wide_String ' (Wbuffer.all); Wide_Free(Wbuffer); Lines_Table.Lines(Line_Index) := Wline; end if; Wide_Free(Left_Buffer); Wline_Length := Lines_Table.Lines(Line_Index)'Length; Wchar_Index := 0; Line_Current_Pos := 0; Col_Cur := 1; elsif Line_Index = 1 then if Line_Current_Pos > 2 then if Wline'Length >= 2 then Left_Buffer := new Wide_String ' (Wline(Wline'first..Line_Current_Pos-1)); if Line_Current_Pos < Wline'Length then Wbuffer := new Wide_String ' (Left_Buffer.all & Wline(Line_Current_Pos+1..Wline'Last)); else Wbuffer := new Wide_String ' (Left_Buffer.all); end if; else Left_Buffer := new Wide_String ' (Wline(Wline'first..Line_Current_Pos-1)); Wbuffer := new Wide_String ' (Left_Buffer.all); end if; Wide_Free(Wline); Wline := new Wide_String ' (Wbuffer.all); Wide_Free(Wbuffer); Wide_Free(Left_Buffer); Lines_Table.Lines(Line_Index) := Wline; Wchar_Index := Wchar_Index - 1; Line_Current_Pos := Line_Current_Pos - 1; Wline_Length := Wline'Length; Line_Cur := Count (Lines_Table, Doc_Index, Line_Index, Wchar_Index, Line_Cur, Col_Cur, Height, Width); if (Wchar_Index mod Width) /= 0 then Col_Cur := (Wchar_Index mod Width) + 1; else Col_Cur := 1; end if; elsif Line_Current_Pos = 2 then Left_Buffer := new Wide_String ' (Wline(Wline'first..Wline'first)); if Wline'Length >= 2 then Wbuffer := new Wide_String ' (Left_Buffer.all & Wline(Line_Current_Pos+1..Wline_Length)); else Wbuffer := new Wide_String ' (Left_Buffer.all); end if; Wide_Free(Wline); Wline := new Wide_String ' (Wbuffer.all); Wide_Free(Wbuffer); Wide_Free(Left_Buffer); Lines_Table.Lines(Line_Index) := Wline; Wchar_Index := Wchar_Index - 1; Line_Current_Pos := Line_Current_Pos - 1; Wline_Length := Wline'Length; Line_Cur := Count (Lines_Table, Doc_Index, Line_Index, Wchar_Index, Line_Cur, Col_Cur, Height, Width); if (Wchar_Index mod Width) /= 0 then Col_Cur := (Wchar_Index mod Width) + 1; else Col_Cur := 1; end if; elsif Line_Current_Pos = 1 then if Wline'Length >= 2 then Left_Buffer := new Wide_String ' (Wline(Line_Current_Pos+1..Wline'Length)); Wbuffer := new Wide_String ' (Left_Buffer.all); else Wbuffer := new Wide_String ' (""); end if; Wide_Free(Wline); Wline := new Wide_String ' (Wbuffer.all); Wide_Free(Wbuffer); Wide_Free(Left_Buffer); Lines_Table.Lines(Line_Index) := Wline; Wchar_Index := Wchar_Index - 1; Line_Current_Pos := Line_Current_Pos - 1; Wline_Length := Wline'Length; Line_Cur := Count (Lines_Table, Doc_Index, Line_Index, Wchar_Index, Line_Cur, Col_Cur, Height, Width); if (Wchar_Index mod Width) /= 0 then Col_Cur := (Wchar_Index mod Width) + 1; else Col_Cur := 1; end if; elsif Line_Current_Pos = 0 then if Wline'Length > 0 then Left_Buffer := new Wide_String ' (Wline(Line_Current_Pos+1..Wline'Length)); Wbuffer := new Wide_String ' (Left_Buffer.all); else Wbuffer := new Wide_String ' (""); end if; Wide_Free(Wline); Wline := new Wide_String ' (Wbuffer.all); Wide_Free(Wbuffer); Wide_Free(Left_Buffer); Lines_Table.Lines(Line_Index) := Wline; Wline_Length := Wline'Length; Line_Cur := Count (Lines_Table, Doc_Index, Line_Index, Wchar_Index, Line_Cur, Col_Cur, Height, Width); if (Wchar_Index mod Width) /= 0 then Col_Cur := (Wchar_Index mod Width) + 1; else Col_Cur := 1; end if; else W_Io.Put(Wide_Character'Val(7)); end if; end if; end if; else W_Io.Put(Wide_Character'Val(7)); -- beep... end if; when others => null; end case; Screen_Lock.Seize; Put(Save_Cursor); if App.Doc_Initialized then Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, True); else Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, False); end if; if App.Current_Doc /= null and then App.Current_Doc.Openned then if App.Current_Doc.Filename /= null then Save_Buffer(App.Current_Doc, Lines_Table); end if; Set_Free(Lines_Set); Highlight(App.Current_Doc, Lines_Set); Draw_Window(App.Document.Win); if not Print_Set(Lines_Set, App.Document.Win, Doc_Index, Total_Line) then raise Spec_Error; end if; else Set_Free(Lines_Table); Doc_Init(App.all, Lines_Table); if not Print_Set(Lines_Table, App.Document.Win, Doc_Index, Total_Line) then raise Program_Error; end if; end if; Put(Restore_Cursor); Screen_Lock.Release; --Clocking.Refresh; else if Wline /= null and then Wline'Length = 256 then Text_Io.Put(Character'Val(7)); else if Wline'Length = 0 then Wbuffer := new Wide_String ' (Wline.all & Wchar); Wide_Free(Wline); Wline := new Wide_String ' (Wbuffer.all); Wide_Free(Wbuffer); Wchar_Index := Wline'Length; Line_Current_Pos := Wline'Length; Wline_Length := Wline'Length; elsif Line_Current_Pos = Wline'Length then Wbuffer := new Wide_String ' (Wline.all & Wchar); Wide_Free(Wline); Wline := new Wide_String ' (Wbuffer.all); Wide_Free(Wbuffer); Wline_Length := Wline'Length; Line_Current_Pos := Wline_length; Wchar_Index := Wline'Length; else if Line_Current_Pos > 1 then if not Is_Overwrite then Left_Buffer := new Wide_String ' (Wline(Wline'first..Line_Current_Pos)); if Wline'Length > Line_Current_Pos then Wbuffer := new Wide_String ' (Left_Buffer.all & Wchar & Wline(Line_Current_Pos+1..Wline'Last)); else Wbuffer := new Wide_String ' (Left_Buffer.all & Wchar); end if; Wide_Free(Wline); Wline := new Wide_String ' (Wbuffer.all); Wide_Free(Wbuffer); Wide_Free(Left_Buffer); Wline_Length := Wline_Length + 1; Line_Current_Pos := Line_Current_Pos + 1; Wchar_Index := Wchar_Index + 1; else Wide_Fixed.Replace_Slice (Wline.all, Line_Current_Pos+1, Line_Current_Pos+1, Wchar & ""); Line_Current_Pos := Line_Current_Pos + 1; Wchar_Index := Wchar_Index + 1; end if; elsif not Is_Overwrite then if Line_Current_Pos = 1 then Left_Buffer := new Wide_String ' (Wline(Wline'first..Line_Current_Pos)); if Wline'Length > Line_Current_Pos then Wbuffer := new Wide_String ' (Left_Buffer.all & Wchar & Wline(Line_Current_Pos+1..Wline'Last)); else Wbuffer := new Wide_String ' (Left_Buffer.all & Wchar); end if; Wide_Free(Wline); Wline := new Wide_String ' (Wbuffer.all); Wide_Free(Wbuffer); Wide_Free(Left_Buffer); Wline_Length := Wline_Length + 1; Line_Current_Pos := Line_Current_Pos + 1; Wchar_Index := Wchar_Index + 1; else Wbuffer := new Wide_String ' (Wchar & Wline.all); Wide_Free(Wline); Wline := new Wide_String ' (Wbuffer.all); Wide_Free(Wbuffer); Wline_Length := Wline_Length + 1; Line_Current_Pos := Line_Current_Pos + 1; Wchar_Index := Wchar_Index + 1; end if; else Wide_Fixed.Replace_Slice (Wline.all, Line_Current_Pos+1, Line_Current_Pos+1, Wchar & ""); Line_Current_Pos := Line_Current_Pos + 1; Wchar_Index := Wchar_Index + 1; end if; end if; if ((Col_Cur + 1) mod Width) = 0 then Line_Cur := Line_Cur + 1; Col_Cur := 1; else Col_Cur := (Wchar_Index mod Width) + 1; end if; end if; Lines_Table.Lines(Line_index) := Wline; Screen_Lock.Seize; Put(Save_Cursor); if App.Doc_Initialized then Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, True); else Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, False); end if; if App.Current_Doc /= null and then App.Current_Doc.Openned then if App.Current_Doc.Filename /= null then Save_Buffer(App.Current_Doc, Lines_Table); end if; Set_Free(Lines_Set); Highlight(App.Current_Doc, Lines_Set); Draw_Window(App.Document.Win); if not Print_Set(Lines_Set, App.Document.Win, Doc_Index, Total_Line) then raise Spec_Error; end if; else Set_Free(Lines_Table); Doc_Init(App.all, Lines_Table); if not Print_Set(Lines_Table, App.Document.Win, Doc_Index, Total_Line) then raise Program_Error; end if; end if; Put(Restore_Cursor); Screen_Lock.Release; Clocking.Refresh; end if; if not Mode.State then Screen_Lock.Seize; Put(Save_Cursor); Draw_Window(App.Buffer.Win); Draw_Text(App.Buffer.Win, 1, 22, white, " ; Alphabet"); Draw_Text(App.Buffer.Win, 1, 33, red, " : "); Draw_Text(App.Buffer.Win, 1, 36, yellow, Alphabet); Draw_Text(App.Buffer.Win, 2, 2, Cyan, "Chars max"); Draw_Text(App.Buffer.Win, 2, 17, white, " : "); Draw_Text(App.Buffer.Win, 2, 20, magenta, Handling.To_Wide_String(Natural'Image(Columns-5))); Draw_Text(App.Buffer.Win, 3, 2, Cyan, "Char(s) left"); Draw_Text(App.Buffer.Win, 3, 17, white, " : "); Draw_Text(App.Buffer.Win, 3, 20, magenta, Handling.To_Wide_String(Integer'Image(255 - Wline_Length))); Draw_Text(App.Buffer.Win, 2, 25, Cyan, " ; Line_Index"); Draw_Text(App.Buffer.Win, 2, 39, white, " : "); Draw_Text(App.Buffer.Win, 2, 43, magenta, Handling.To_Wide_String(positive'Image(Line_index))); Draw_Text(App.Buffer.Win, 3, 25, Cyan, " ; Line, Col"); Draw_Text(App.Buffer.Win, 3, 39, white, " : "); Draw_Text(App.Buffer.Win, 3, 43, magenta, Handling.To_Wide_String(positive'Image(Line_cur) & ", " & positive'Image(Col_cur))); Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Line_Length "); Draw_Text(App.Buffer.Win, 3, 65, white, " : "); Draw_Text(App.Buffer.Win, 3, 69, magenta, Handling.To_Wide_String(Natural'Image(Wline_length))); -- Draw_Text(App.Buffer.Win, 2, 25, Cyan, " ; word max"); -- Draw_Text(App.Buffer.Win, 2, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 2, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Sh_Max_Words))); -- Draw_Text(App.Buffer.Win, 3, 25, Cyan, " ; Word number"); -- Draw_Text(App.Buffer.Win, 3, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Word_Number))); Draw_Text(App.Buffer.Win, 2, 50, Cyan, " ; lines max"); Draw_Text(App.Buffer.Win, 2, 64, white, " : "); Draw_Text(App.Buffer.Win, 2, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(2880))); Draw_Text(App.Buffer.Win, 2, 85, Cyan, " ; line_last"); Draw_Text(App.Buffer.Win, 2, 100, white, " : "); Draw_Text(App.Buffer.Win, 2, 103, magenta, Handling.To_Wide_String(Natural'Image(Lines_Table.Line_last))); -- Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Lines count"); -- Draw_Text(App.Buffer.Win, 3, 64, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(Dialog_Buffer_Last))); Draw_Text(App.Buffer.Win, 3, 76, Cyan, " ; Overwrite"); Draw_Text(App.Buffer.Win, 3, 88, white, " : "); Draw_Text(App.Buffer.Win, 3, 91, magenta, Handling.To_Wide_String(Boolean'Image(Is_Overwrite))); Put(Restore_Cursor); Screen_Lock.Release; if App.Current_Doc /= null and then App.Current_Doc.Openned then if App.Current_Doc.Filename /= null then Save_Buffer(App.Current_Doc, Lines_Table); end if; Set_Free(Lines_Set); Highlight(App.Current_Doc, Lines_Set); Draw_Window(App.Document.Win); if not Print_Set(Lines_Set, App.Document.Win, Doc_Index, Total_Line) then raise Spec_Error; end if; else Set_Free(Lines_Table); Doc_Init(App.all, Lines_Table); if not Print_Set(Lines_Table, App.Document.Win, Doc_Index, Total_Line) then raise Program_Error; end if; end if; else Screen_Lock.Seize; Put(Save_Cursor); Devel_Draw_Main_Win(App); if App.Doc_Initialized then Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, True); else Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, False); end if; if App.Current_Doc /= null and then App.Current_Doc.Openned then if App.Current_Doc.Filename /= null then Save_Buffer(App.Current_Doc, Lines_Table); end if; Set_Free(Lines_Set); Highlight(App.Current_Doc, Lines_Set); Draw_Window(App.Document.Win); if not Print_Set(Lines_Set, App.Document.Win, Doc_Index, Total_Line) then raise Spec_Error; end if; else Set_Free(Lines_Table); Doc_Init(App.all, Lines_Table); if not Print_Set(Lines_Table, App.Document.Win, Doc_Index, Total_Line) then raise Program_Error; end if; end if; Screen_Lock.Release; end if; end Receive; Clocking.start; Clocking.Refresh; if not Done then if not Is_Full then if App.desktop(2) /= null then case App.desktop(2).Name is when None => null; when Organizer => Organizer_Record(App.Desktop(2).all).Proc.Wake_up(App.Columns/2); when Manager => Manager_Record(App.Desktop(2).all).Proc.Wake_up(App.Columns/2); when others => null; end case; end if; end if; Done :=True; end if; or accept Halt do Clocking.Halt; File_thread.halt; end Halt; exit Main_Loop; or accept Full_Screen do if Is_Full then Draw_Window(Empty_Win); Devel_Win_Init(App, 0, not Is_full); if App.Current_Doc /= null and then not App.Current_Doc.Openned then Doc_Init(App.all, Lines_Table); end if; Initialize(App.Buffer.Win, Lines-5, 2, 5, Columns/2-2, Cyan, White); else Draw_Window(Empty_Win); Devel_Win_Init(App, 0, not Is_full); if App.Current_Doc /= null and then not App.Current_Doc.Openned then Doc_Init(App.all, Lines_Table); end if; Initialize(App.Buffer.Win, Lines-5, 2, 5, Columns-2, Cyan, White); end if; end Full_Screen; Is_Full := not Is_Full; if not Is_Full then if App.desktop(2) /= null then case App.desktop(2).Name is when None => null; when Organizer => Organizer_Record(App.Desktop(2).all).Proc.Wake_up(App.Columns/2); when Manager => Manager_Record(App.Desktop(2).all).Proc.Wake_up(App.Columns/2); when others => null; end case; end if; end if; Screen_Lock.seize; Draw_Window(App.Buffer.Win); Draw_Text(App.Buffer.Win, 1, 22, white, " ; Alphabet"); Draw_Text(App.Buffer.Win, 1, 33, red, " : "); Draw_Text(App.Buffer.Win, 1, 36, yellow, Alphabet); Draw_Text(App.Buffer.Win, 2, 2, Cyan, "Chars max"); Draw_Text(App.Buffer.Win, 2, 17, white, " : "); Draw_Text(App.Buffer.Win, 2, 20, magenta, Handling.To_Wide_String(Natural'Image(Columns-5))); Draw_Text(App.Buffer.Win, 3, 2, Cyan, "Char(s) left"); Draw_Text(App.Buffer.Win, 3, 17, white, " : "); Draw_Text(App.Buffer.Win, 3, 20, magenta, Handling.To_Wide_String(Integer'Image(255 - Wline_Length))); Draw_Text(App.Buffer.Win, 3, 20, magenta, Handling.To_Wide_String(Integer'Image(255 - Wline_Length))); Draw_Text(App.Buffer.Win, 2, 25, Cyan, " ; Line_Index"); Draw_Text(App.Buffer.Win, 2, 39, white, " : "); Draw_Text(App.Buffer.Win, 2, 43, magenta, Handling.To_Wide_String(positive'Image(Line_index))); Draw_Text(App.Buffer.Win, 3, 25, Cyan, " ; Line, Col"); Draw_Text(App.Buffer.Win, 3, 39, white, " : "); Draw_Text(App.Buffer.Win, 3, 43, magenta, Handling.To_Wide_String(positive'Image(Line_cur) & ", " & positive'Image(Col_cur))); Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Line_Length "); Draw_Text(App.Buffer.Win, 3, 65, white, " : "); Draw_Text(App.Buffer.Win, 3, 69, magenta, Handling.To_Wide_String(Natural'Image(Wline_length))); -- Draw_Text(App.Buffer.Win, 2, 25, Cyan, " ; word max"); -- Draw_Text(App.Buffer.Win, 2, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 2, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Sh_Max_Words))); -- Draw_Text(App.Buffer.Win, 3, 25, Cyan, " ; Word number"); -- Draw_Text(App.Buffer.Win, 3, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Word_Number))); Draw_Text(App.Buffer.Win, 2, 50, Cyan, " ; lines max"); Draw_Text(App.Buffer.Win, 2, 64, white, " : "); Draw_Text(App.Buffer.Win, 2, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(2880))); Draw_Text(App.Buffer.Win, 2, 85, Cyan, " ; line_last"); Draw_Text(App.Buffer.Win, 2, 100, white, " : "); Draw_Text(App.Buffer.Win, 2, 103, magenta, Handling.To_Wide_String(Natural'Image(Lines_Table.Line_last))); -- Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Lines count"); -- Draw_Text(App.Buffer.Win, 3, 64, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(Dialog_Buffer_Last))); Draw_Text(App.Buffer.Win, 3, 71, Cyan, " ; Overwrite"); Draw_Text(App.Buffer.Win, 3, 83, white, " : "); Draw_Text(App.Buffer.Win, 3, 86, magenta, Handling.To_Wide_String(Boolean'Image(Is_Overwrite))); Draw_Window(App.Doc_states.Win); if App.Current_Doc /= null and then App.Current_Doc.Filename /= null then App.Current_Doc.Openned := True; if App.Doc_Initialized then Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, True); else Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, False); end if; Set_Free(Lines_Set); Highlight(App.Current_Doc, Lines_Set); if not Print_Set(Lines_Set, App.Document.Win, Doc_Index, Total_Line) then raise Spec_Error; end if; end if; if not App.Doc_Initialized then Set_Free(Lines_Table); Doc_Init(App.all, Lines_Table); if not Print_Set(Lines_Table, App.Document.Win, Doc_Index, Total_Line) then raise Program_Error; end if; else Set_Free(Lines_Set); Highlight(App.Current_Doc, Lines_Set); Draw_Window(App.Document.Win); if not Print_Set(Lines_Set, App.Document.Win, Doc_Index, Total_Line) then raise Spec_Error; end if; end if; Screen_Lock.Release; Clocking.Start; delay 0.25; or accept Wake_Up(Top : in Natural) do Is_Full := False; Screen_Lock.seize; if App.Current_Doc /= null and then not App.Current_Doc.Openned then Doc_Init(App.all, Lines_Table); end if; Initialize(App.Buffer.Win, Lines-5, Top+2, 5, Columns/2-2, Cyan, White); if not Mode.State then Edit_Win_Init(App, Top, false); Edit_Draw_Main_Win(App); Draw_Window(App.Buffer.Win); Draw_Text(App.Buffer.Win, 1, 22, white, " ; Alphabet"); Draw_Text(App.Buffer.Win, 1, 33, red, " : "); Draw_Text(App.Buffer.Win, 1, 36, yellow, Alphabet); Draw_Text(App.Buffer.Win, 2, 2, Cyan, "Chars max"); Draw_Text(App.Buffer.Win, 2, 17, white, " : "); Draw_Text(App.Buffer.Win, 2, 20, magenta, Handling.To_Wide_String(Natural'Image(Columns-5))); Draw_Text(App.Buffer.Win, 3, 2, Cyan, "Char(s) left"); Draw_Text(App.Buffer.Win, 3, 17, white, " : "); Draw_Text(App.Buffer.Win, 3, 20, magenta, Handling.To_Wide_String(Integer'Image(255 - Wline_Length))); -- Draw_Text(App.Buffer.Win, 2, 25, Cyan, " ; word max"); -- Draw_Text(App.Buffer.Win, 2, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 2, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Sh_Max_Words))); -- Draw_Text(App.Buffer.Win, 3, 25, Cyan, " ; Word number"); -- Draw_Text(App.Buffer.Win, 3, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Word_Number))); Draw_Text(App.Buffer.Win, 2, 50, Cyan, " ; lines max"); Draw_Text(App.Buffer.Win, 2, 64, white, " : "); Draw_Text(App.Buffer.Win, 2, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(2880))); Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Line_Length "); Draw_Text(App.Buffer.Win, 3, 65, white, " : "); Draw_Text(App.Buffer.Win, 3, 69, magenta, Handling.To_Wide_String(Natural'Image(Wline_length))); -- Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Lines count"); -- Draw_Text(App.Buffer.Win, 3, 64, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(Dialog_Buffer_Last))); Draw_Text(App.Buffer.Win, 3, 76, Cyan, " ; Overwrite"); Draw_Text(App.Buffer.Win, 3, 88, white, " : "); Draw_Text(App.Buffer.Win, 3, 91, magenta, Handling.To_Wide_String(Boolean'Image(Is_Overwrite))); else Devel_Win_Init(App, Top, false); Devel_Draw_Main_Win(App); end if; Draw_Window(App.Doc_states.Win); if App.Current_Doc /= null and then App.Current_Doc.Filename /= null then App.Current_Doc.Openned := True; if App.Doc_Initialized then Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, True); else Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, False); end if; Set_Free(Lines_Set); Highlight(App.Current_Doc, Lines_Set); if not Print_Set(Lines_Set, App.Document.Win, Doc_Index, Total_Line) then raise Spec_Error; end if; end if; if not App.Doc_Initialized then Set_Free(Lines_Table); Doc_Init(App.all, Lines_Table); if not Print_Set(Lines_Table, App.Document.Win, Doc_Index, Total_Line) then raise Program_Error; end if; else Set_Free(Lines_Set); Highlight(App.Current_Doc, Lines_Set); Draw_Window(App.Document.Win); if not Print_Set(Lines_Set, App.Document.Win, Doc_Index, Total_Line) then raise Spec_Error; end if; end if; if Mode.State then Draw_Window(App.Err.Win); Draw_Window(App.Buffer.Win); Draw_Window(App.Cmd_Result.Win); Draw_Window(App.Cmd.Win); if not "="(Result, null) then if Os_Lib.Locate_Exec_On_Path(Command_Name(Handling.To_String(History_Set.Lines(History_Last).all))) /= null and then Os_Lib.Locate_Exec_On_Path(Command_Name(Handling.To_String(History_Set.Lines(History_Last).all)))'Length /= 0 then if Result.Success then Draw_Text(App.Err.Win, 1, 1, White, (-(Result.Program_Name)) & " Success"); else Draw_Text(App.Err.Win, 1, 1, White, (-(Result.Program_Name)) & " Failure"); end if; if Last_Cmd = None then Draw_Buffer(Result, App.Cmd_Result.Win, Result_Index); end if; Draw_Text(App.Buffer.Win, 1, 1, Yellow, " Cmd : "); Draw_Text(App.Buffer.Win, 1, 10, White, Handling.To_Wide_String(Os_Lib.Locate_Exec_On_Path(Command_Name(Handling.To_String(History_Set.Lines(History_Last).all))).all)); Draw_Text(App.Buffer.Win, 2, 1, Yellow, " Args : "); Draw_Text(App.Buffer.Win, 2, 10, White, Troncate(History_Set.Lines(History_Last)(Command_Name(Handling.To_String(History_Set.Lines(History_Last).all))'Length+2..History_Set.Lines(History_Last)'Last), Columns/2-10)); Draw_Text(App.Buffer.Win, 3, 1, Yellow, " Error : "); Draw_Text(App.Buffer.Win, 3, 10, White, Handling.To_Wide_String(Integer'Image(Errno))); end if; else Draw_Text(App.Buffer.Win, 1, 1, Yellow, " Cmd : "); Draw_Text(App.Buffer.Win, 2, 1, Yellow, " Args : "); Draw_Text(App.Buffer.Win, 3, 1, Yellow, " Error : "); end if; end if; Screen_Lock.Release; if Top = 0 then Clocking.Start; end if; end Wake_Up; or accept Suspend do Clocking.Suspend; File_Thread.Reset; end Suspend; exit; or accept Page_Down do Screen_Lock.Seize; Put(Save_Cursor); if not Mode.State then if Doc_Index + (Height /3 * 2) <= Lines_Set.Line_Last then Doc_Index := Doc_Index + (Height/3*2); Line_Index := Line_Index + (Height/3*2); Wline := Lines_Set.Lines(Line_Index); Wline_Length := Wline'Length; Line_Current_Pos := 0; Wchar_Index := 1; Line_Cur := Line_Index - (Doc_Index); Col_Cur := 1; if App.Doc_Initialized then Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, True); end if; Draw_Window(App.Document.Win); if not Print_Set(Lines_Set, App.Document.Win, Doc_Index, Total_Line) then raise Spec_Error; end if; else Put(Character'Val(7)); end if; Draw_Window(App.Buffer.Win); Draw_Text(App.Buffer.Win, 1, 22, white, " ; Alphabet"); Draw_Text(App.Buffer.Win, 1, 33, red, " : "); Draw_Text(App.Buffer.Win, 1, 36, yellow, Alphabet); Draw_Text(App.Buffer.Win, 2, 2, Cyan, "Chars max"); Draw_Text(App.Buffer.Win, 2, 17, white, " : "); Draw_Text(App.Buffer.Win, 2, 20, magenta, Handling.To_Wide_String(Natural'Image(Columns-5))); Draw_Text(App.Buffer.Win, 3, 2, Cyan, "Char(s) left"); Draw_Text(App.Buffer.Win, 3, 17, white, " : "); Draw_Text(App.Buffer.Win, 3, 20, magenta, Handling.To_Wide_String(Integer'Image(255 - Wline_Length))); Draw_Text(App.Buffer.Win, 2, 25, Cyan, " ; Line_Index"); Draw_Text(App.Buffer.Win, 2, 39, white, " : "); Draw_Text(App.Buffer.Win, 2, 43, magenta, Handling.To_Wide_String(positive'Image(Line_index))); Draw_Text(App.Buffer.Win, 3, 25, Cyan, " ; Line, Col"); Draw_Text(App.Buffer.Win, 3, 39, white, " : "); Draw_Text(App.Buffer.Win, 3, 43, magenta, Handling.To_Wide_String(positive'Image(Line_cur) & ", " & positive'Image(Col_cur))); Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Line_Length "); Draw_Text(App.Buffer.Win, 3, 65, white, " : "); Draw_Text(App.Buffer.Win, 3, 69, magenta, Handling.To_Wide_String(Natural'Image(Wline_length))); -- Draw_Text(App.Buffer.Win, 2, 25, Cyan, " ; word max"); -- Draw_Text(App.Buffer.Win, 2, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 2, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Sh_Max_Words))); -- Draw_Text(App.Buffer.Win, 3, 25, Cyan, " ; Word number"); -- Draw_Text(App.Buffer.Win, 3, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Word_Number))); Draw_Text(App.Buffer.Win, 2, 50, Cyan, " ; lines max"); Draw_Text(App.Buffer.Win, 2, 64, white, " : "); Draw_Text(App.Buffer.Win, 2, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(2880))); Draw_Text(App.Buffer.Win, 2, 85, Cyan, " ; line_last"); Draw_Text(App.Buffer.Win, 2, 100, white, " : "); Draw_Text(App.Buffer.Win, 2, 103, magenta, Handling.To_Wide_String(Natural'Image(Lines_Table.Line_last))); -- Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Lines count"); -- Draw_Text(App.Buffer.Win, 3, 64, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(Dialog_Buffer_Last))); Draw_Text(App.Buffer.Win, 3, 76, Cyan, " ; Overwrite"); Draw_Text(App.Buffer.Win, 3, 88, white, " : "); Draw_Text(App.Buffer.Win, 3, 91, magenta, Handling.To_Wide_String(Boolean'Image(Is_Overwrite))); else Clocking.Suspend; case Last_Cmd is when None => if not "="(Result, null) and then Result_Index+(App.Cmd_Result.Win.H-App.Cmd_Result.Win.H/2) < Result.Wlines'Length then Draw_Window(App.Cmd_Result.Win); Result_Index := Positive'Min(Result_Index+(App.Cmd_Result.Win.H-App.Cmd_Result.Win.H/2), Result.Wlines'Length); --else --Text_Io.Put(Character'Val(7)); Draw_Buffer(Result, App.Cmd_Result.Win, Result_Index); else File_Thread.Page_Down; end if; when Xls => Xls_Index := Xls_Index + (App.Cmd_Result.Win.H-2); Draw_Window(App.Cmd_Result.Win); Internal.xls(Handling.To_String(Old_Text.all), App.Cmd_Result.Win, Xls_Index, Total, true); when others => null; end case; Clocking.Start; end if; Put(Restore_Cursor); Screen_Lock.Release; end Page_Down; or accept Page_Up do Screen_Lock.Seize; Put(Save_Cursor); if not Mode.State then if Doc_Index - (Height /3 * 2) >= 0 then Doc_Index := Doc_Index - (Height/3*2); Line_Index := Line_Index - (Height/3*2); Put(Save_Cursor); if App.Doc_Initialized then Wline := Lines_Set.Lines(Line_Index); Wline_Length := Wline'Length; Line_Current_Pos := 0; Wchar_Index := 0; Line_Cur := Line_Index - (Doc_Index); --Line_Cur := 1; Col_Cur := 1; Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, True); end if; Draw_Window(App.Document.Win); if not Print_Set(Lines_Set, App.Document.Win, Doc_Index, Total_Line) then raise Spec_Error; end if; elsif Doc_Index /= 0 then Doc_Index := 0; if App.Doc_Initialized then Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, True); end if; Draw_Window(App.Document.Win); if not Print_Set(Lines_Set, App.Document.Win, Doc_Index, Total_Line) then raise Spec_Error; end if; else Put(Character'Val(7)); end if; Draw_Window(App.Buffer.Win); Draw_Text(App.Buffer.Win, 1, 22, white, " ; Alphabet"); Draw_Text(App.Buffer.Win, 1, 33, red, " : "); Draw_Text(App.Buffer.Win, 1, 36, yellow, Alphabet); Draw_Text(App.Buffer.Win, 2, 2, Cyan, "Chars max"); Draw_Text(App.Buffer.Win, 2, 17, white, " : "); Draw_Text(App.Buffer.Win, 2, 20, magenta, Handling.To_Wide_String(Natural'Image(Columns-5))); Draw_Text(App.Buffer.Win, 3, 2, Cyan, "Char(s) left"); Draw_Text(App.Buffer.Win, 3, 17, white, " : "); Draw_Text(App.Buffer.Win, 3, 20, magenta, Handling.To_Wide_String(Integer'Image(255 - Wline_Length))); Draw_Text(App.Buffer.Win, 2, 25, Cyan, " ; Line_Index"); Draw_Text(App.Buffer.Win, 2, 39, white, " : "); Draw_Text(App.Buffer.Win, 2, 43, magenta, Handling.To_Wide_String(positive'Image(Line_index))); Draw_Text(App.Buffer.Win, 3, 25, Cyan, " ; Line, Col"); Draw_Text(App.Buffer.Win, 3, 39, white, " : "); Draw_Text(App.Buffer.Win, 3, 43, magenta, Handling.To_Wide_String(positive'Image(Line_cur) & ", " & positive'Image(Col_cur))); Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Line_Length "); Draw_Text(App.Buffer.Win, 3, 65, white, " : "); Draw_Text(App.Buffer.Win, 3, 69, magenta, Handling.To_Wide_String(Natural'Image(Wline_length))); -- Draw_Text(App.Buffer.Win, 2, 25, Cyan, " ; word max"); -- Draw_Text(App.Buffer.Win, 2, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 2, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Sh_Max_Words))); -- Draw_Text(App.Buffer.Win, 3, 25, Cyan, " ; Word number"); -- Draw_Text(App.Buffer.Win, 3, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Word_Number))); Draw_Text(App.Buffer.Win, 2, 50, Cyan, " ; lines max"); Draw_Text(App.Buffer.Win, 2, 64, white, " : "); Draw_Text(App.Buffer.Win, 2, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(2880))); Draw_Text(App.Buffer.Win, 2, 85, Cyan, " ; line_last"); Draw_Text(App.Buffer.Win, 2, 100, white, " : "); Draw_Text(App.Buffer.Win, 2, 103, magenta, Handling.To_Wide_String(Natural'Image(Lines_Table.Line_last))); -- Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Lines count"); -- Draw_Text(App.Buffer.Win, 3, 64, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(Dialog_Buffer_Last))); Draw_Text(App.Buffer.Win, 3, 76, Cyan, " ; Overwrite"); Draw_Text(App.Buffer.Win, 3, 88, white, " : "); Draw_Text(App.Buffer.Win, 3, 91, magenta, Handling.To_Wide_String(Boolean'Image(Is_Overwrite))); else Clocking.Suspend; case Last_Cmd is when None => if not "="(Result, null) and then Result_Index-(App.Cmd_Result.Win.H-App.Cmd_Result.Win.H/2) >= 0 then Draw_Window(App.Cmd_Result.Win); Result_Index := Result_Index - (App.Cmd_Result.Win.H-App.Cmd_Result.Win.H/2); Draw_Buffer(Result, App.Cmd_Result.Win, Result_Index); elsif not "="(Result, null) then Result_Index := 0; --Text_Io.Put(Character'Val(7)); Draw_Window(App.Cmd_Result.Win); Draw_Buffer(Result, App.Cmd_Result.Win, Result_Index); else File_Thread.Page_Up; end if; when Xls => if Xls_Index >= (App.Cmd_Result.Win.H-2) then Draw_Window(App.Cmd_Result.Win); Xls_Index := Xls_Index - (App.Cmd_Result.Win.H-2); Internal.xls(Handling.To_String(Old_Text.all), App.Cmd_Result.Win, Xls_Index, Total, true); end if; when others => null; end case; Clocking.Start; end if; Put(Restore_Cursor); Screen_Lock.Release; end Page_Up; or accept Up_Arrow do if not Mode.State then if not (Line_Cur = 1 and Doc_Index = 0) then Up_Arrow(Lines_Table, Doc_Index, Line_Index, Wchar_Index, Line_Cur, Col_Cur, App.Document.Win.H, App.Document.Win.W); Wline := Lines_Table.Lines(Line_index); Wline_Length := Real_Length(Wline.all); Line_Current_Pos := Wchar_Index; Screen_Lock.Seize; Put(Save_Cursor); if App.Doc_Initialized then Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, True); end if; Draw_Window(App.Document.Win); if not Print_Set(Lines_Set, App.Document.Win, Doc_Index, Total_Line) then raise Spec_Error; end if; Draw_Window(App.Buffer.Win); Draw_Text(App.Buffer.Win, 1, 22, white, " ; Alphabet"); Draw_Text(App.Buffer.Win, 1, 33, red, " : "); Draw_Text(App.Buffer.Win, 1, 36, yellow, Alphabet); Draw_Text(App.Buffer.Win, 2, 2, Cyan, "Chars max"); Draw_Text(App.Buffer.Win, 2, 17, white, " : "); Draw_Text(App.Buffer.Win, 2, 20, magenta, Handling.To_Wide_String(Natural'Image(Columns-5))); Draw_Text(App.Buffer.Win, 3, 2, Cyan, "Char(s) left"); Draw_Text(App.Buffer.Win, 3, 17, white, " : "); Draw_Text(App.Buffer.Win, 3, 20, magenta, Handling.To_Wide_String(Integer'Image(255 - Wline_Length))); Draw_Text(App.Buffer.Win, 2, 25, Cyan, " ; Line_Index"); Draw_Text(App.Buffer.Win, 2, 39, white, " : "); Draw_Text(App.Buffer.Win, 2, 43, magenta, Handling.To_Wide_String(positive'Image(Line_index))); Draw_Text(App.Buffer.Win, 3, 25, Cyan, " ; Line, Col"); Draw_Text(App.Buffer.Win, 3, 39, white, " : "); Draw_Text(App.Buffer.Win, 3, 43, magenta, Handling.To_Wide_String(positive'Image(Line_cur) & ", " & positive'Image(Col_cur))); Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Line_Length "); Draw_Text(App.Buffer.Win, 3, 65, white, " : "); Draw_Text(App.Buffer.Win, 3, 69, magenta, Handling.To_Wide_String(Natural'Image(Wline_length))); -- Draw_Text(App.Buffer.Win, 2, 25, Cyan, " ; word max"); -- Draw_Text(App.Buffer.Win, 2, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 2, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Sh_Max_Words))); -- Draw_Text(App.Buffer.Win, 3, 25, Cyan, " ; Word number"); -- Draw_Text(App.Buffer.Win, 3, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Word_Number))); Draw_Text(App.Buffer.Win, 2, 50, Cyan, " ; lines max"); Draw_Text(App.Buffer.Win, 2, 64, white, " : "); Draw_Text(App.Buffer.Win, 2, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(2880))); Draw_Text(App.Buffer.Win, 2, 85, Cyan, " ; line_last"); Draw_Text(App.Buffer.Win, 2, 100, white, " : "); Draw_Text(App.Buffer.Win, 2, 103, magenta, Handling.To_Wide_String(Natural'Image(Lines_Table.Line_last))); -- Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Lines count"); -- Draw_Text(App.Buffer.Win, 3, 64, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(Dialog_Buffer_Last))); Draw_Text(App.Buffer.Win, 3, 76, Cyan, " ; Overwrite"); Draw_Text(App.Buffer.Win, 3, 88, white, " : "); Draw_Text(App.Buffer.Win, 3, 91, magenta, Handling.To_Wide_String(Boolean'Image(Is_Overwrite))); Put(Restore_Cursor); Screen_Lock.Release; Screen_Lock.Seize; Put(Save_Cursor); if App.Doc_Initialized then Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, True); else Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, False); end if; if App.Current_Doc /= null and then App.Current_Doc.Openned then if App.Current_Doc.Filename /= null then Save_Buffer(App.Current_Doc, Lines_Table); end if; Set_Free(Lines_Set); Highlight(App.Current_Doc, Lines_Set); Draw_Window(App.Document.Win); if not Print_Set(Lines_Set, App.Document.Win, Doc_Index, Total_Line) then raise Spec_Error; end if; else Set_Free(Lines_Table); Doc_Init(App.all, Lines_Table); if not Print_Set(Lines_Table, App.Document.Win, Doc_Index, Total_Line) then raise Program_Error; end if; end if; Put(Restore_Cursor); Screen_Lock.Release; Clocking.Refresh; end if; else Screen_Lock.Seize; Put(Save_Cursor); if (History_Last > 0) and then (History_Last - History_Index) > 0 then Old_Length := Text'Length; Wide_Free(Text); Text := new Wide_String ' (History_Set.Lines(History_Last - (History_Index)).all); History_Index := History_Index + 1; Cmd_Current_Pos := Text'Length; else Put(Character'Val(7)); end if; Draw_Window(App.Cmd.Win); if Text /= null then Draw_Text(App.Cmd.Win, 1, 1, White, Text.all); end if; -- case Last_Cmd is -- when None => -- if Result /= null and then Result_Index - 1 >= 0 then -- Draw_Window(App.Cmd_Result.Win);  -- Result_Index := Result_Index - 1; -- Draw_Buffer(Result, App.Cmd_Result.Win, Result_Index); -- elsif Result /= null then -- Text_Io.Put(Character'Val(7)); -- else -- File_Thread.Up_Arrow; -- end if; -- when Xls => -- Clocking.Suspend;  -- if Xls_Index > 0 then -- Draw_Window(App.Cmd_Result.Win);  -- Xls_Index := Xls_Index -1; -- Internal.xls(Handling.To_String(Old_Text.all), App.Cmd_Result.Win, Xls_Index, Total); -- end if; -- Clocking.Start; -- when others => -- null; -- end case; Put(Restore_Cursor); Screen_Lock.Release; Clocking.Refresh; end if; end Up_Arrow; or accept Down_Arrow do if not Mode.State then Down_Arrow(Lines_Table, Doc_Index, Line_Index, Wchar_Index, Line_Cur, Col_Cur, App.Document.Win.H, App.Document.Win.W); Wline := Lines_Table.Lines(Line_index); Wline_Length := Real_Length(Wline.all); Line_Current_Pos := 0; Screen_Lock.Seize; Put(Save_Cursor); if App.Doc_Initialized then Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, True); end if; Draw_Window(App.Document.Win); if not Print_Set(Lines_Set, App.Document.Win, Doc_Index, Total_Line) then raise Spec_Error; end if; Draw_Window(App.Buffer.Win); Draw_Text(App.Buffer.Win, 1, 22, white, " ; Alphabet"); Draw_Text(App.Buffer.Win, 1, 33, red, " : "); Draw_Text(App.Buffer.Win, 1, 36, yellow, Alphabet); Draw_Text(App.Buffer.Win, 2, 2, Cyan, "Chars max"); Draw_Text(App.Buffer.Win, 2, 17, white, " : "); Draw_Text(App.Buffer.Win, 2, 20, magenta, Handling.To_Wide_String(Natural'Image(Columns-5))); Draw_Text(App.Buffer.Win, 3, 2, Cyan, "Char(s) left"); Draw_Text(App.Buffer.Win, 3, 17, white, " : "); Draw_Text(App.Buffer.Win, 3, 20, magenta, Handling.To_Wide_String(Integer'Image(255 - Wline_Length))); Draw_Text(App.Buffer.Win, 2, 25, Cyan, " ; Line_Index"); Draw_Text(App.Buffer.Win, 2, 39, white, " : "); Draw_Text(App.Buffer.Win, 2, 43, magenta, Handling.To_Wide_String(positive'Image(Line_index))); Draw_Text(App.Buffer.Win, 3, 25, Cyan, " ; Line, Col"); Draw_Text(App.Buffer.Win, 3, 39, white, " : "); Draw_Text(App.Buffer.Win, 3, 43, magenta, Handling.To_Wide_String(positive'Image(Line_cur) & ", " & positive'Image(Col_cur))); Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Line_Length "); Draw_Text(App.Buffer.Win, 3, 65, white, " : "); Draw_Text(App.Buffer.Win, 3, 69, magenta, Handling.To_Wide_String(Natural'Image(Wline_length))); -- Draw_Text(App.Buffer.Win, 2, 25, Cyan, " ; word max"); -- Draw_Text(App.Buffer.Win, 2, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 2, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Sh_Max_Words))); -- Draw_Text(App.Buffer.Win, 3, 25, Cyan, " ; Word number"); -- Draw_Text(App.Buffer.Win, 3, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Word_Number))); Draw_Text(App.Buffer.Win, 2, 50, Cyan, " ; lines max"); Draw_Text(App.Buffer.Win, 2, 64, white, " : "); Draw_Text(App.Buffer.Win, 2, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(2880))); Draw_Text(App.Buffer.Win, 2, 85, Cyan, " ; line_last"); Draw_Text(App.Buffer.Win, 2, 100, white, " : "); Draw_Text(App.Buffer.Win, 2, 103, magenta, Handling.To_Wide_String(Natural'Image(Lines_Table.Line_last))); -- Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Lines count"); -- Draw_Text(App.Buffer.Win, 3, 64, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(Dialog_Buffer_Last))); Draw_Text(App.Buffer.Win, 3, 76, Cyan, " ; Overwrite"); Draw_Text(App.Buffer.Win, 3, 88, white, " : "); Draw_Text(App.Buffer.Win, 3, 91, magenta, Handling.To_Wide_String(Boolean'Image(Is_Overwrite))); Put(Restore_Cursor); Screen_Lock.Release; Screen_Lock.Seize; Put(Save_Cursor); if App.Doc_Initialized then Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, True); else Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, False); end if; if App.Current_Doc /= null and then App.Current_Doc.Openned then if App.Current_Doc.Filename /= null then Save_Buffer(App.Current_Doc, Lines_Table); end if; Set_Free(Lines_Set); Highlight(App.Current_Doc, Lines_Set); Draw_Window(App.Document.Win); if not Print_Set(Lines_Set, App.Document.Win, Doc_Index, Total_Line) then raise Spec_Error; end if; else Set_Free(Lines_Table); Doc_Init(App.all, Lines_Table); if not Print_Set(Lines_Table, App.Document.Win, Doc_Index, Total_Line) then raise Program_Error; end if; end if; Put(Restore_Cursor); Screen_Lock.Release; Clocking.refresh; else Screen_Lock.Seize; Put(Save_Cursor); if (History_Index > 1) then Old_Length := Text'Length; Wide_Free(Text); Text := new Wide_String ' (History_Set.Lines(History_Last - (History_Index - 2)).all); History_Index := History_Index - 1; Cmd_Current_Pos := Text'Length; elsif History_Index = 1 then Old_Length := Text'Length; Wide_Free(Text); Text := new Wide_String ' (""); History_Index := History_Index - 1; Cmd_Current_Pos := Text'Length; else Put(Character'Val(7)); end if; Draw_Window(App.Cmd.Win); if Text /= null then Draw_Text(App.Cmd.Win, 1, 1, White, Text.all); end if; -- case Last_Cmd is -- when None => -- if Result /= null then -- Draw_Window(App.Cmd_Result.Win);  -- Result_Index := Result_Index + 1; -- Draw_Buffer(Result, App.Cmd_Result.Win, Result_Index); -- else -- File_Thread.Down_Arrow; -- end if; -- when Xls => -- Clocking.Suspend; -- Draw_Window(App.Cmd_Result.Win);  -- Xls_Index := Xls_Index + 1; -- Internal.xls(Handling.To_String(Old_Text.all), App.Cmd_Result.Win, Xls_Index, total); -- Clocking.Start; -- when others => -- null; -- end case; Put(Restore_Cursor); Screen_Lock.Release; Clocking.Refresh; end if; end Down_Arrow; or accept Left_Arrow do if not Mode.State then Left_Arrow(Lines_Table, Doc_Index, Line_Index, Wchar_Index, Line_Cur, Col_Cur, Height, Width); Wline := Lines_Table.Lines(Line_index); Wline_Length := Real_Length(Wline.all); declare Count : Natural := Col_Count(Wline.all, Col_Cur-1, Txt(App.Current_Doc.Unit.all)); begin if Count /= Wline_Length then Col_Cur := Col_cur + (Count - Real_Length(Wline(Wline'First..Col_Cur-1))); end if; end; Line_Current_Pos := Wchar_Index; Draw_Text(App.Buffer.Win, 1, 22, white, " ; Alphabet"); Draw_Text(App.Buffer.Win, 1, 33, red, " : "); Draw_Text(App.Buffer.Win, 1, 36, yellow, Alphabet); Draw_Text(App.Buffer.Win, 2, 2, Cyan, "Chars max"); Draw_Text(App.Buffer.Win, 2, 17, white, " : "); Draw_Text(App.Buffer.Win, 2, 20, magenta, Handling.To_Wide_String(Natural'Image(Columns-5))); Draw_Text(App.Buffer.Win, 3, 2, Cyan, "Char(s) left"); Draw_Text(App.Buffer.Win, 3, 17, white, " : "); Draw_Text(App.Buffer.Win, 3, 20, magenta, Handling.To_Wide_String(Integer'Image(255 - Wline_Length))); Draw_Text(App.Buffer.Win, 2, 25, Cyan, " ; Line_Index"); Draw_Text(App.Buffer.Win, 2, 39, white, " : "); Draw_Text(App.Buffer.Win, 2, 43, magenta, Handling.To_Wide_String(positive'Image(Line_index))); Draw_Text(App.Buffer.Win, 3, 25, Cyan, " ; Line, Col"); Draw_Text(App.Buffer.Win, 3, 39, white, " : "); Draw_Text(App.Buffer.Win, 3, 43, magenta, Handling.To_Wide_String(positive'Image(Line_cur) & ", " & positive'Image(Col_cur))); Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Line_Length "); Draw_Text(App.Buffer.Win, 3, 65, white, " : "); Draw_Text(App.Buffer.Win, 3, 69, magenta, Handling.To_Wide_String(Natural'Image(Wline_length))); -- Draw_Text(App.Buffer.Win, 2, 25, Cyan, " ; word max"); -- Draw_Text(App.Buffer.Win, 2, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 2, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Sh_Max_Words))); -- Draw_Text(App.Buffer.Win, 3, 25, Cyan, " ; Word number"); -- Draw_Text(App.Buffer.Win, 3, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Word_Number))); Draw_Text(App.Buffer.Win, 2, 50, Cyan, " ; lines max"); Draw_Text(App.Buffer.Win, 2, 64, white, " : "); Draw_Text(App.Buffer.Win, 2, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(2880))); Draw_Text(App.Buffer.Win, 2, 85, Cyan, " ; line_last"); Draw_Text(App.Buffer.Win, 2, 100, white, " : "); Draw_Text(App.Buffer.Win, 2, 103, magenta, Handling.To_Wide_String(Natural'Image(Lines_Table.Line_last))); -- Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Lines count"); -- Draw_Text(App.Buffer.Win, 3, 64, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(Dialog_Buffer_Last))); Draw_Text(App.Buffer.Win, 3, 76, Cyan, " ; Overwrite"); Draw_Text(App.Buffer.Win, 3, 88, white, " : "); Draw_Text(App.Buffer.Win, 3, 91, magenta, Handling.To_Wide_String(Boolean'Image(Is_Overwrite))); Screen_Lock.Seize; Put(Save_Cursor); if App.Doc_Initialized then Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, True); else Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, False); end if; if App.Current_Doc /= null and then App.Current_Doc.Openned then if App.Current_Doc.Filename /= null then Save_Buffer(App.Current_Doc, Lines_Table); end if; Set_Free(Lines_Set); Highlight(App.Current_Doc, Lines_Set); Draw_Window(App.Document.Win); if not Print_Set(Lines_Set, App.Document.Win, Doc_Index, Total_Line) then raise Spec_Error; end if; else Set_Free(Lines_Table); Doc_Init(App.all, Lines_Table); if not Print_Set(Lines_Table, App.Document.Win, Doc_Index, Total_Line) then raise Program_Error; end if; end if; Put(Restore_Cursor); Screen_Lock.Release; Clocking.refresh; end if; end Left_Arrow; or accept Right_Arrow do if not Mode.State then Right_Arrow(Lines_Table, Doc_Index, Line_Index, Wchar_Index, Line_Cur, Col_Cur, Height, Width); Wline := Lines_Table.Lines(Line_index); Wline_Length := Real_Length(Wline.all); declare Count : Natural := Col_Count(Wline.all, Col_Cur-1, Txt(App.Current_Doc.Unit.all)); begin if Count /= Wline_Length then Col_Cur := Col_cur + (Count - Real_Length(Wline(Wline'First..Col_Cur-1))); end if; end; Line_Current_Pos := Wchar_Index; Draw_Text(App.Buffer.Win, 1, 22, white, " ; Alphabet"); Draw_Text(App.Buffer.Win, 1, 33, red, " : "); Draw_Text(App.Buffer.Win, 1, 36, yellow, Alphabet); Draw_Text(App.Buffer.Win, 2, 2, Cyan, "Chars max"); Draw_Text(App.Buffer.Win, 2, 17, white, " : "); Draw_Text(App.Buffer.Win, 2, 20, magenta, Handling.To_Wide_String(Natural'Image(Columns-5))); Draw_Text(App.Buffer.Win, 3, 2, Cyan, "Char(s) left"); Draw_Text(App.Buffer.Win, 3, 17, white, " : "); Draw_Text(App.Buffer.Win, 3, 20, magenta, Handling.To_Wide_String(Integer'Image(255 - Wline_Length))); Draw_Text(App.Buffer.Win, 2, 25, Cyan, " ; Line_Index"); Draw_Text(App.Buffer.Win, 2, 39, white, " : "); Draw_Text(App.Buffer.Win, 2, 43, magenta, Handling.To_Wide_String(positive'Image(Line_index))); Draw_Text(App.Buffer.Win, 3, 25, Cyan, " ; Line, Col"); Draw_Text(App.Buffer.Win, 3, 39, white, " : "); Draw_Text(App.Buffer.Win, 3, 43, magenta, Handling.To_Wide_String(positive'Image(Line_cur) & ", " & positive'Image(Col_cur))); Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Line_Length "); Draw_Text(App.Buffer.Win, 3, 65, white, " : "); Draw_Text(App.Buffer.Win, 3, 69, magenta, Handling.To_Wide_String(Natural'Image(Wline_length))); -- Draw_Text(App.Buffer.Win, 2, 25, Cyan, " ; word max"); -- Draw_Text(App.Buffer.Win, 2, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 2, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Sh_Max_Words))); -- Draw_Text(App.Buffer.Win, 3, 25, Cyan, " ; Word number"); -- Draw_Text(App.Buffer.Win, 3, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Word_Number))); Draw_Text(App.Buffer.Win, 2, 50, Cyan, " ; lines max"); Draw_Text(App.Buffer.Win, 2, 64, white, " : "); Draw_Text(App.Buffer.Win, 2, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(2880))); Draw_Text(App.Buffer.Win, 2, 85, Cyan, " ; line_last"); Draw_Text(App.Buffer.Win, 2, 100, white, " : "); Draw_Text(App.Buffer.Win, 2, 103, magenta, Handling.To_Wide_String(Natural'Image(Lines_Table.Line_last))); -- Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Lines count"); -- Draw_Text(App.Buffer.Win, 3, 64, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(Dialog_Buffer_Last))); Draw_Text(App.Buffer.Win, 3, 76, Cyan, " ; Overwrite"); Draw_Text(App.Buffer.Win, 3, 88, white, " : "); Draw_Text(App.Buffer.Win, 3, 91, magenta, Handling.To_Wide_String(Boolean'Image(Is_Overwrite))); Screen_Lock.Seize; Put(Save_Cursor); if App.Doc_Initialized then Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, True); else Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, False); end if; if App.Current_Doc /= null and then App.Current_Doc.Openned then if App.Current_Doc.Filename /= null then Save_Buffer(App.Current_Doc, Lines_Table); end if; Set_Free(Lines_Set); Highlight(App.Current_Doc, Lines_Set); Draw_Window(App.Document.Win); if not Print_Set(Lines_Set, App.Document.Win, Doc_Index, Total_Line) then raise Spec_Error; end if; else Set_Free(Lines_Table); Doc_Init(App.all, Lines_Table); if not Print_Set(Lines_Table, App.Document.Win, Doc_Index, Total_Line) then raise Program_Error; end if; end if; Put(Restore_Cursor); Screen_Lock.Release; Clocking.refresh; end if; end Right_Arrow; or accept Begin_Of do if not Mode.State then At_Begin(Lines_Table, Doc_Index, Line_Index, Wchar_Index, Line_Cur, Col_Cur, Height, Width); Col_Cur := 1; Wchar_Index := 0; Line_Current_Pos := 0; Screen_Lock.Seize; Draw_Window(App.Document.Win); if not Print_Set(Lines_Set, App.Document.Win, Doc_Index, Total_Line) then raise Spec_Error; end if; Draw_Window(App.Buffer.Win); Draw_Text(App.Buffer.Win, 1, 22, white, " ; Alphabet"); Draw_Text(App.Buffer.Win, 1, 33, red, " : "); Draw_Text(App.Buffer.Win, 1, 36, yellow, Alphabet); Draw_Text(App.Buffer.Win, 2, 2, Cyan, "Chars max"); Draw_Text(App.Buffer.Win, 2, 17, white, " : "); Draw_Text(App.Buffer.Win, 2, 20, magenta, Handling.To_Wide_String(Natural'Image(Columns-5))); Draw_Text(App.Buffer.Win, 3, 2, Cyan, "Char(s) left"); Draw_Text(App.Buffer.Win, 3, 17, white, " : "); Draw_Text(App.Buffer.Win, 3, 20, magenta, Handling.To_Wide_String(Integer'Image(255 - Wline_Length))); Draw_Text(App.Buffer.Win, 2, 25, Cyan, " ; Line_Index"); Draw_Text(App.Buffer.Win, 2, 39, white, " : "); Draw_Text(App.Buffer.Win, 2, 43, magenta, Handling.To_Wide_String(positive'Image(Line_index))); Draw_Text(App.Buffer.Win, 3, 25, Cyan, " ; Line, Col"); Draw_Text(App.Buffer.Win, 3, 39, white, " : "); Draw_Text(App.Buffer.Win, 3, 43, magenta, Handling.To_Wide_String(positive'Image(Line_cur) & ", " & positive'Image(Col_cur))); Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Line_Length "); Draw_Text(App.Buffer.Win, 3, 65, white, " : "); Draw_Text(App.Buffer.Win, 3, 69, magenta, Handling.To_Wide_String(Natural'Image(Wline_length))); -- Draw_Text(App.Buffer.Win, 2, 25, Cyan, " ; word max"); -- Draw_Text(App.Buffer.Win, 2, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 2, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Sh_Max_Words))); -- Draw_Text(App.Buffer.Win, 3, 25, Cyan, " ; Word number"); -- Draw_Text(App.Buffer.Win, 3, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Word_Number))); Draw_Text(App.Buffer.Win, 2, 50, Cyan, " ; lines max"); Draw_Text(App.Buffer.Win, 2, 64, white, " : "); Draw_Text(App.Buffer.Win, 2, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(2880))); Draw_Text(App.Buffer.Win, 2, 85, Cyan, " ; line_last"); Draw_Text(App.Buffer.Win, 2, 100, white, " : "); Draw_Text(App.Buffer.Win, 2, 103, magenta, Handling.To_Wide_String(Natural'Image(Lines_Table.Line_last))); -- Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Lines count"); -- Draw_Text(App.Buffer.Win, 3, 64, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(Dialog_Buffer_Last))); Draw_Text(App.Buffer.Win, 3, 76, Cyan, " ; Overwrite"); Draw_Text(App.Buffer.Win, 3, 88, white, " : "); Draw_Text(App.Buffer.Win, 3, 91, magenta, Handling.To_Wide_String(Boolean'Image(Is_Overwrite))); Screen_Lock.Release; Clocking.Refresh; end if; end Begin_Of; or accept End_Of do if not Mode.State then Screen_Lock.Seize; At_End(Lines_Table, Doc_Index, Line_Index, Wchar_Index, Line_Cur, Col_Cur, Height, Width); if (Wchar_Index mod Width) /= 0 then Col_Cur := (Wchar_Index mod Width) + 1; else Col_Cur := 1; end if; Line_Current_Pos := Wline'Last; Wchar_Index := Wline'Last; Wline_Length := Real_Length(Wline.all); declare Count : Natural := Col_Count(Wline.all, Col_Cur-1, Txt(App.Current_Doc.Unit.all)); begin if Count /= Wline_Length then Col_cur := Col_cur + ((Count - Real_Length(Wline(Wline'First..Col_Cur-1)))-1); end if; end; Draw_Window(App.Document.Win); if not Print_Set(Lines_Set, App.Document.Win, Doc_Index, Total_Line) then raise Spec_Error; end if; Screen_Lock.Release; Draw_Window(App.Buffer.Win); Draw_Text(App.Buffer.Win, 1, 22, white, " ; Alphabet"); Draw_Text(App.Buffer.Win, 1, 33, red, " : "); Draw_Text(App.Buffer.Win, 1, 36, yellow, Alphabet); Draw_Text(App.Buffer.Win, 2, 2, Cyan, "Chars max"); Draw_Text(App.Buffer.Win, 2, 17, white, " : "); Draw_Text(App.Buffer.Win, 2, 20, magenta, Handling.To_Wide_String(Natural'Image(Columns-5))); Draw_Text(App.Buffer.Win, 3, 2, Cyan, "Char(s) left"); Draw_Text(App.Buffer.Win, 3, 17, white, " : "); Draw_Text(App.Buffer.Win, 3, 20, magenta, Handling.To_Wide_String(Integer'Image(255 - Wline_Length))); Draw_Text(App.Buffer.Win, 2, 25, Cyan, " ; Line_Index"); Draw_Text(App.Buffer.Win, 2, 39, white, " : "); Draw_Text(App.Buffer.Win, 2, 43, magenta, Handling.To_Wide_String(positive'Image(Line_index))); Draw_Text(App.Buffer.Win, 3, 25, Cyan, " ; Line, Col"); Draw_Text(App.Buffer.Win, 3, 39, white, " : "); Draw_Text(App.Buffer.Win, 3, 43, magenta, Handling.To_Wide_String(positive'Image(Line_cur) & ", " & positive'Image(Col_cur))); Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Line_Length "); Draw_Text(App.Buffer.Win, 3, 65, white, " : "); Draw_Text(App.Buffer.Win, 3, 69, magenta, Handling.To_Wide_String(Natural'Image(Wline_length))); -- Draw_Text(App.Buffer.Win, 2, 25, Cyan, " ; word max"); -- Draw_Text(App.Buffer.Win, 2, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 2, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Sh_Max_Words))); -- Draw_Text(App.Buffer.Win, 3, 25, Cyan, " ; Word number"); -- Draw_Text(App.Buffer.Win, 3, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Word_Number))); Draw_Text(App.Buffer.Win, 2, 50, Cyan, " ; lines max"); Draw_Text(App.Buffer.Win, 2, 64, white, " : "); Draw_Text(App.Buffer.Win, 2, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(2880))); Draw_Text(App.Buffer.Win, 2, 85, Cyan, " ; line_last"); Draw_Text(App.Buffer.Win, 2, 100, white, " : "); Draw_Text(App.Buffer.Win, 2, 103, magenta, Handling.To_Wide_String(Natural'Image(Lines_Table.Line_last))); -- Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Lines count"); -- Draw_Text(App.Buffer.Win, 3, 64, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(Dialog_Buffer_Last))); Draw_Text(App.Buffer.Win, 3, 76, Cyan, " ; Overwrite"); Draw_Text(App.Buffer.Win, 3, 88, white, " : "); Draw_Text(App.Buffer.Win, 3, 91, magenta, Handling.To_Wide_String(Boolean'Image(Is_Overwrite))); Clocking.Refresh; end if; end End_Of; or accept Del do if not Mode.State then if Lines_Table.Lines(Line_Index) /= null then if Wline'Length = 0 then if Lines_Table.Line_Last > Line_Index then if Lines_Table.Line_Last > Line_Index then For I in Line_Index+1..Lines_Table.Line_Last loop Lines_Table.Lines(I-1) := Lines_Table.Lines(I); end loop; Wline := Lines_Table.Lines(Line_Index); Lines_Table.Lines(Lines_Table.Line_Last) := null; Lines_Table.Line_Last := Lines_Table.Line_Last - 1; end if; else Text_Io.Put(Character'Val(7)); end if; elsif Wline'Length > 1 and Wline'Length > Line_Current_Pos+1 then if Line_Current_Pos >= 2 then Left_Buffer := new Wide_String ' (Wline(Wline'first..Line_Current_Pos)); Wbuffer := new Wide_String ' (Wline(Line_Current_Pos+2..Wline'Last)); Wide_Free(Wline); Wline := new Wide_String ' (Left_Buffer.all & Wbuffer.all); Wide_Free(Left_Buffer); Wide_Free(Wbuffer); else Wbuffer := new Wide_String ' (Wline(Wline'First+1..Wline'Last)); Wide_Free(Wline); Wline := new Wide_String ' (Wbuffer.all); Wide_Free(Wbuffer); end if; elsif Line_Current_Pos = 1 and Wline'Length = 1 then Wbuffer := new Wide_String ' (""); Wide_Free(Wline); Wline := new Wide_String ' (Wbuffer.all); Wide_Free(Wbuffer); elsif Line_Current_Pos + 1 = Wline'Length then Left_Buffer := new Wide_String ' (Wline.all); Wide_Free(Wline); Wline := new Wide_String ' (Left_Buffer(Left_Buffer'First..Left_Buffer'Last-1)); Wide_Free(Left_Buffer); elsif Line_Current_Pos + 1 = Wline'Length + 1 and Line_Index < Lines_Table.Line_Last then Left_Buffer := new Wide_String ' (Wline.all); Wide_Free(Wline); Wline := new Wide_String ' (Left_Buffer.all & Lines_Table.Lines(Line_Index + 1).all); for I in Line_Index+1..Lines_Table.Line_Last loop Lines_Table.Lines(I) := Lines_Table.Lines(I+1); end loop; Lines_Table.Lines(Lines_Table.Line_Last) := null; Lines_Table.Line_Last := Lines_Table.Line_Last - 1; else W_Io.Put(Wide_Character'Val(7)); -- beep... end if; end if; Lines_Table.Lines(Line_Index) := Wline; Wline_Length := Wline'Length; Screen_Lock.Seize; Put(Save_Cursor); if App.Doc_Initialized then Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, True); else Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, False); end if; if App.Current_Doc /= null and then App.Current_Doc.Openned then if App.Current_Doc.Filename /= null then Save_Buffer(App.Current_Doc, Lines_Table); end if; Set_Free(Lines_Set); Highlight(App.Current_Doc, Lines_Set); Draw_Window(App.Document.Win); if not Print_Set(Lines_Set, App.Document.Win, Doc_Index, Total_Line) then raise Spec_Error; end if; else Set_Free(Lines_Table); Doc_Init(App.all, Lines_Table); if not Print_Set(Lines_Table, App.Document.Win, Doc_Index, Total_Line) then raise Program_Error; end if; end if; Draw_Window(App.Buffer.Win); Draw_Text(App.Buffer.Win, 1, 22, white, " ; Alphabet"); Draw_Text(App.Buffer.Win, 1, 33, red, " : "); Draw_Text(App.Buffer.Win, 1, 36, yellow, Alphabet); Draw_Text(App.Buffer.Win, 2, 2, Cyan, "Chars max"); Draw_Text(App.Buffer.Win, 2, 17, white, " : "); Draw_Text(App.Buffer.Win, 2, 20, magenta, Handling.To_Wide_String(Natural'Image(Columns-5))); Draw_Text(App.Buffer.Win, 3, 2, Cyan, "Char(s) left"); Draw_Text(App.Buffer.Win, 3, 17, white, " : "); Draw_Text(App.Buffer.Win, 3, 20, magenta, Handling.To_Wide_String(Integer'Image(255 - Wline_Length))); -- Draw_Text(App.Buffer.Win, 2, 25, Cyan, " ; word max"); -- Draw_Text(App.Buffer.Win, 2, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 2, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Sh_Max_Words))); -- Draw_Text(App.Buffer.Win, 3, 25, Cyan, " ; Word number"); -- Draw_Text(App.Buffer.Win, 3, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Word_Number))); Draw_Text(App.Buffer.Win, 2, 50, Cyan, " ; lines max"); Draw_Text(App.Buffer.Win, 2, 64, white, " : "); Draw_Text(App.Buffer.Win, 2, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(2880))); Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Line_Length "); Draw_Text(App.Buffer.Win, 3, 65, white, " : "); Draw_Text(App.Buffer.Win, 3, 69, magenta, Handling.To_Wide_String(Natural'Image(Wline_length))); -- Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Lines count"); -- Draw_Text(App.Buffer.Win, 3, 64, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(Dialog_Buffer_Last))); Draw_Text(App.Buffer.Win, 3, 76, Cyan, " ; Overwrite"); Draw_Text(App.Buffer.Win, 3, 88, white, " : "); Draw_Text(App.Buffer.Win, 3, 91, magenta, Handling.To_Wide_String(Boolean'Image(Is_Overwrite))); Put(Restore_Cursor); Screen_Lock.Release; Clocking.Refresh; end if; end Del; or accept Overwrite do if not Mode.State then Is_Overwrite := not Is_Overwrite; Draw_Window(App.Buffer.Win); Screen_Lock.Seize; Put(Save_Cursor); Draw_Text(App.Buffer.Win, 1, 22, white, " ; Alphabet"); Draw_Text(App.Buffer.Win, 1, 33, red, " : "); Draw_Text(App.Buffer.Win, 1, 36, yellow, Alphabet); Draw_Text(App.Buffer.Win, 2, 2, Cyan, "Chars max"); Draw_Text(App.Buffer.Win, 2, 17, white, " : "); Draw_Text(App.Buffer.Win, 2, 20, magenta, Handling.To_Wide_String(Natural'Image(Columns-5))); Draw_Text(App.Buffer.Win, 3, 2, Cyan, "Char(s) left"); Draw_Text(App.Buffer.Win, 3, 17, white, " : "); Draw_Text(App.Buffer.Win, 3, 20, magenta, Handling.To_Wide_String(Integer'Image(255 - Wline_Length))); -- Draw_Text(App.Buffer.Win, 2, 25, Cyan, " ; word max"); -- Draw_Text(App.Buffer.Win, 2, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 2, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Sh_Max_Words))); -- Draw_Text(App.Buffer.Win, 3, 25, Cyan, " ; Word number"); -- Draw_Text(App.Buffer.Win, 3, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Word_Number))); Draw_Text(App.Buffer.Win, 2, 50, Cyan, " ; lines max"); Draw_Text(App.Buffer.Win, 2, 64, white, " : "); Draw_Text(App.Buffer.Win, 2, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(2880))); Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Line_Length "); Draw_Text(App.Buffer.Win, 3, 65, white, " : "); Draw_Text(App.Buffer.Win, 3, 69, magenta, Handling.To_Wide_String(Natural'Image(Wline_length))); -- Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Lines count"); -- Draw_Text(App.Buffer.Win, 3, 64, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(Dialog_Buffer_Last))); Draw_Text(App.Buffer.Win, 3, 76, Cyan, " ; Overwrite"); Draw_Text(App.Buffer.Win, 3, 88, white, " : "); Draw_Text(App.Buffer.Win, 3, 91, magenta, Handling.To_Wide_String(Boolean'Image(Is_Overwrite))); Put(Restore_Cursor); Screen_Lock.Release; Clocking.Refresh; end if; end Overwrite; end select; end loop; loop select accept Halt do Clocking.Halt; File_thread.halt; end Halt; exit Main_Loop; or accept Suspend do Clocking.Suspend; File_Thread.Reset; end Suspend; or accept Wake_Up(Top : in Natural) do Is_Full := False; Screen_Lock.seize; if App.Current_Doc /= null and then not App.Current_Doc.Openned then Doc_Init(App.all, Lines_Table); end if; Initialize(App.Buffer.Win, Lines-5, Top+2, 5, Columns/2-2, Cyan, White); if not Mode.State then Edit_Win_Init(App, Top, false); Edit_Draw_Main_Win(App); Draw_Window(App.Buffer.Win); Draw_Text(App.Buffer.Win, 1, 22, white, " ; Alphabet"); Draw_Text(App.Buffer.Win, 1, 33, red, " : "); Draw_Text(App.Buffer.Win, 1, 36, yellow, Alphabet); Draw_Text(App.Buffer.Win, 2, 2, Cyan, "Chars max"); Draw_Text(App.Buffer.Win, 2, 17, white, " : "); Draw_Text(App.Buffer.Win, 2, 20, magenta, Handling.To_Wide_String(Natural'Image(Columns-5))); Draw_Text(App.Buffer.Win, 3, 2, Cyan, "Char(s) left"); Draw_Text(App.Buffer.Win, 3, 17, white, " : "); Draw_Text(App.Buffer.Win, 3, 20, magenta, Handling.To_Wide_String(Integer'Image(255 - Wline_Length))); -- Draw_Text(App.Buffer.Win, 2, 25, Cyan, " ; word max"); -- Draw_Text(App.Buffer.Win, 2, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 2, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Sh_Max_Words))); -- Draw_Text(App.Buffer.Win, 3, 25, Cyan, " ; Word number"); -- Draw_Text(App.Buffer.Win, 3, 39, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 43, magenta, Handling.To_Wide_String(Word_Range'Image(Word_Number))); Draw_Text(App.Buffer.Win, 2, 50, Cyan, " ; lines max"); Draw_Text(App.Buffer.Win, 2, 64, white, " : "); Draw_Text(App.Buffer.Win, 2, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(2880))); Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Line_Length "); Draw_Text(App.Buffer.Win, 3, 65, white, " : "); Draw_Text(App.Buffer.Win, 3, 69, magenta, Handling.To_Wide_String(Natural'Image(Wline_length))); -- Draw_Text(App.Buffer.Win, 3, 50, Cyan, " ; Lines count"); -- Draw_Text(App.Buffer.Win, 3, 64, white, " : "); -- Draw_Text(App.Buffer.Win, 3, 66, magenta, Handling.To_Wide_String(Line_Index_Range'Image(Dialog_Buffer_Last))); Draw_Text(App.Buffer.Win, 3, 76, Cyan, " ; Overwrite"); Draw_Text(App.Buffer.Win, 3, 88, white, " : "); Draw_Text(App.Buffer.Win, 3, 91, magenta, Handling.To_Wide_String(Boolean'Image(Is_Overwrite))); else Devel_Win_Init(App, Top, false); Devel_Draw_Main_Win(App); end if; Draw_Window(App.Doc_states.Win); if App.Current_Doc /= null and then App.Current_Doc.Filename /= null then App.Current_Doc.Openned := True; if App.Doc_Initialized then Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, True); else Devel_Draw_Docume(App.Current_Doc, App.Doc_States.Win, False); end if; Set_Free(Lines_Set); Highlight(App.Current_Doc, Lines_Set); if not Print_Set(Lines_Set, App.Document.Win, Doc_Index, Total_Line) then raise Spec_Error; end if; end if; if not App.Doc_Initialized then Set_Free(Lines_Table); Doc_Init(App.all, Lines_Table); if not Print_Set(Lines_Table, App.Document.Win, Doc_Index, Total_Line) then raise Program_Error; end if; else Set_Free(Lines_Set); Highlight(App.Current_Doc, Lines_Set); Draw_Window(App.Document.Win); if not Print_Set(Lines_Set, App.Document.Win, Doc_Index, Total_Line) then raise Spec_Error; end if; end if; Screen_Lock.Release; Clocking.Suspend; if Mode.State then Draw_Window(App.Err.Win); Draw_Window(App.Buffer.Win); Draw_Window(App.Cmd_Result.Win); Draw_Window(App.Cmd.Win); if not "="(Result, null) then if Os_Lib.Locate_Exec_On_Path(Command_Name(Handling.To_String(History_Set.Lines(History_Last).all))) /= null and then Os_Lib.Locate_Exec_On_Path(Command_Name(Handling.To_String(History_Set.Lines(History_Last).all)))'Length /= 0 then if Result.Success then Draw_Text(App.Err.Win, 1, 1, White, (-(Result.Program_Name)) & " Success"); else Draw_Text(App.Err.Win, 1, 1, White, (-(Result.Program_Name)) & " Failure"); end if; if Last_Cmd = None then Draw_Buffer(Result, App.Cmd_Result.Win, Result_Index); end if; Draw_Text(App.Buffer.Win, 1, 1, Yellow, " Cmd : "); Draw_Text(App.Buffer.Win, 1, 10, White, Handling.To_Wide_String(Os_Lib.Locate_Exec_On_Path(Command_Name(Handling.To_String(History_Set.Lines(History_Last).all))).all)); Draw_Text(App.Buffer.Win, 2, 1, Yellow, " Args : "); Draw_Text(App.Buffer.Win, 2, 10, White, Troncate(History_Set.Lines(History_Last)(Command_Name(Handling.To_String(History_Set.Lines(History_Last).all))'Length+2..History_Set.Lines(History_Last)'Last), Columns/2-10)); Draw_Text(App.Buffer.Win, 3, 1, Yellow, " Error : "); Draw_Text(App.Buffer.Win, 3, 10, White, Handling.To_Wide_String(Integer'Image(Errno))); else Draw_Text(App.Buffer.Win, 1, 1, Yellow, " Cmd : "); Draw_Text(App.Buffer.Win, 2, 1, Yellow, " Args : "); Draw_Text(App.Buffer.Win, 3, 1, Yellow, " Error : "); end if; end if; end if; if not Mode.Logged then declare Thread : Exec_Thread(new String ' ("bin/logname")); Success : Boolean := False; Errno : Integer := 0; File : File_Type; begin Add_Line(History_Set, History_Last, "bin/logname"); Wide_Free(Text); Text := new Wide_String ' ("bin/logname"); Cmd_Current_Pos := 0; Wide_Free(Text); Text := new Wide_String ' (""); Draw_Text(App.Buffer.Win, 1, 10, White, "logname"); Thread.Spawn; File_thread.Start; Thread.Wait(Success, Errno); Thread.halt; Mode.Logged := True; Errno := System("/usr/bin/espeak -s 150 ""Greetting professor " & App.User.Logname.all & """" & Character'Val(0)); Errno := System("/usr/bin/espeak -s 150 -p 100 'Computer ready!'" & Character'Val(0)); end; if Mode.State then Draw_Window(App.Err.Win); Draw_Window(App.Buffer.Win); Draw_Window(App.Cmd_Result.Win); Draw_Window(App.Cmd.Win); if not "="(Result, null) then if Result.Success then Draw_Text(App.Err.Win, 1, 1, White, (-(Result.Program_Name)) & " Success"); else Draw_Text(App.Err.Win, 1, 1, White, (-(Result.Program_Name)) & " Failure"); end if; if Last_Cmd = None then Draw_Buffer(Result, App.Cmd_Result.Win, Result_Index); end if; Draw_Text(App.Buffer.Win, 1, 1, Yellow, " Cmd : "); Draw_Text(App.Buffer.Win, 1, 10, White, "logname"); Draw_Text(App.Buffer.Win, 2, 1, Yellow, " Args : "); Draw_Text(App.Buffer.Win, 3, 1, Yellow, " Error : "); Draw_Text(App.Buffer.Win, 3, 10, white, Handling.To_Wide_String(Integer'Image(Errno))); end if; end if; end if; if Top = 0 then Clocking.Start; Clocking.refresh; end if; end Wake_Up; exit; end select; end loop; end loop Main_Loop; --W_Io.Put_Line("Planning process halted"); end Devel_Process; procedure Draw_Buffer (Spawn_Result : in Wide_Result_Access; Win : in Window_Record; File_Index : in Natural) is Line_Index : Natural := 0; Result_Max_Lines : Positive := Win.Win.H-2; Line_Count : Natural := 0; Term_Width : constant Natural := Win.Win.W-2; begin if not "="(Spawn_Result, null) and then not "="(Spawn_result.Wlines, null) then Print_Loop: for I in File_Index+1..Positive'min(File_Index+((Result_Max_Lines-1)), Spawn_Result.Wlines'Length) loop declare tmp : constant Wide_String := (-(Spawn_Result.Wlines(I))); Line : constant Wide_String := Tmp(Tmp'First..Wide_Fixed.Index_Non_Blank((Tmp), Backward)); Chars_Max : constant Positive := Term_Width; Lines_Max : constant Positive := (Result_Max_Lines-5); Pro_Index : Natural := Wide_Fixed.Index(Line, "true"); Against : Natural := Wide_Fixed.Index(Line, "false"); Next : Natural := 0; begin if Real_Length(Line) > 0 and Real_Length(Line) < (Chars_Max * Lines_Max) then for Line_Window in Line_Index..Integer'min(Real_Length(Line)/Chars_Max, Lines_Max) loop declare B_Inf : constant Positive := Line_Window*Chars_Max + 1; B_Sup : constant Positive := Integer'min((Line_Window + 1)*Chars_Max, Real_Length(Line)); begin if Real_length(Line) < Chars_max then if Pro_Index /= 0 then if Line'Length >= Pro_Index + 4 then Next := Pro_Index + 4; end if; elsif Against /= 0 then if Line'Length >= against + 4 then Next := Against + 4; end if; end if; if Next /= 0 then if Pro_Index /= 0 then Draw_Text(App.Cmd_Result.Win, Line_Count+1, 1, White, Line(Line'First..Pro_Index-1)); Enlight_Draw_Text(App.Cmd_Result.Win, Line_Count+1, Pro_Index, White, Line(Pro_Index..Next) & Handling.To_Wide_String(Normal_mode)); if Line'Length > Next then Draw_Text(App.Cmd_Result.Win, Line_Count+1, Pro_Index+5, White, Line(Next+1..Line'Last)); end if; else Draw_Text(App.Cmd_Result.Win, Line_Count+1, 1, White, Line(Line'First..Against-1)); Enlight_Draw_Text(App.Cmd_Result.Win, Line_Count+1, Against, Red, Line(Against..Next) & Handling.To_Wide_String(Normal_mode)); if Line'Length > Next then Draw_Text(App.Cmd_Result.Win, Line_Count+1, Against+5, White, Line(Next+1..Line'Last)); end if; end if; else Draw_Text(App.Cmd_Result.Win, Line_Count+1, 1, White, Line); end if; else if Next /= 0 then if Pro_Index /= 0 then if Pro_Index < B_Sup and Pro_Index > B_Inf and Next < B_Sup then Draw_Text(App.Cmd_Result.Win, Line_Count+1, 1, White, Line(B_Inf..Pro_Index-1)); Enlight_Draw_Text(App.Cmd_Result.Win, Line_Count+1, Pro_Index, White, Line(Pro_Index..Next) & Handling.To_Wide_String(Normal_mode)); Draw_Text(App.Cmd_Result.Win, Line_Count+1, 1, White, Line(Next+1..B_Sup)); else Draw_Text(App.Cmd_Result.Win, Line_Count+1, 1, White, Line(B_Inf..B_Sup)); end if; elsif Against /= 0 then if Against < B_Sup and Against > B_Inf and Next < B_Sup then Draw_Text(App.Cmd_Result.Win, Line_Count+1, 1, White, Line(B_Inf..Against-1)); Enlight_Draw_Text(App.Cmd_Result.Win, Line_Count+1, Against, White, Line(Against..Next) & Handling.To_Wide_String(Normal_mode)); Draw_Text(App.Cmd_Result.Win, Line_Count+1, Against+5, White, Line(Next+1..B_Sup)); else Draw_Text(App.Cmd_Result.Win, Line_Count+1, 1, White, Line(B_Inf..B_Sup)); end if; end if; else Draw_Text(App.Cmd_Result.Win, Line_Count+1, 1, White, Line(B_Inf..B_Sup)); end if; end if; end; Line_Count := Line_Count + 1; exit Print_Loop When Line_Count > (Result_Max_Lines-1); end loop; else Line_Count := Line_Count + 1; end if; end; exit Print_Loop when Line_Count > (Result_Max_Lines-1); end loop Print_Loop; end if; end Draw_Buffer; use M.Tools; procedure Print_Buffer (Spawn_Result : in Wide_Result_Access;File_Index : in Natural) is Line_Index : Natural := 0; --Result_Max_Lines : Positive := Win.Win.H; Line_Count : Natural := 0; --Term_Width : constant Natural := Win.Win.W-2; Term_Width : constant Natural := Columns/2-2; begin if not "="(Spawn_Result, null) and then not "="(Spawn_result.Wlines, null) then Print_Loop: -- for I in File_Index+1..Positive'min(File_Index+((Result_Max_Lines-5)),  -- Spawn_Result.Wlines'Length) loop for I in File_Index+1..Spawn_Result.Wlines'Length loop declare tmp : constant Wide_String := (-Spawn_Result.Wlines(I)); Line : constant Wide_String := Tmp(Tmp'First..Wide_Fixed.Index_Non_Blank((Tmp), Backward)); Chars_Max : constant Positive := Term_Width; --Lines_Max : constant Positive := (Result_Max_Lines-5); begin if Real_Length(Line) > 0 then-- and Real_Length(Line) < (Chars_Max * Lines_Max) then --for Line_Window in Line_Index..Integer'min(Real_Length(Line)/Chars_Max, Lines_Max) loop for Line_Window in Line_Index..Real_Length(Line)/Chars_Max loop declare B_Inf : constant Positive := Line_Window*Chars_Max + 1; B_Sup : constant Positive := Integer'min((Line_Window + 1)*Chars_Max, Real_Length(Line)); begin if Real_length(Line) < Chars_max then --Draw_Text(Win, Line_Count+1, 1, White, Line); W_Io.Put_Line(Line); else --Draw_Text(Win, Line_Count+1, 1, White, Line(B_Inf..B_Sup)); W_Io.Put_Line(Line(B_Inf..B_Sup)); end if; end; Line_Count := Line_Count + 1; --exit Print_Loop When Line_Count > (Result_Max_Lines-1); end loop; else Line_Count := Line_Count + 1; end if; end; --exit Print_Loop when Line_Count > (Result_Max_Lines-1); end loop Print_Loop; end if; end Print_Buffer; procedure Internal_Help (Line : in Wide_string; Result : in out Spawn_Result_Record) is Command : Gnat.Command_Line.Command_Line; Cmd : Int_Cmd_Enum := None; Args_List : Os_Lib.Argument_List_Access; Buffer : U_Array_Access; Last : Natural := 0; begin U_Array_Free(Result.Wlines); Buffer := new U_Array(1..5); Gnat.Command_Line.Set_Command_Line(Command, Handling.To_String(Line)); Gnat.Command_Line.Build(Command, Args_List, False); if Args_List'Last > 1 then if not OS_Lib."="(Args_List(2), null) and then Args_List(2).all /= "" then begin Cmd := Int_Cmd_Enum'Value(Args_list(2).all); exception when Constraint_Error => Buffer(1) := (+(Handling.To_Wide_String(Args_List(2).all) & " is not an internal command.")); Buffer(2) := (+("Command help : help COMMAND")); Buffer(3) := (+(" -- help ? print command help for ? --")); Result.Wlines := Buffer; Result.Count := 3; return; end; else Cmd := None; end if; else Cmd := None; end if; Result.Count := 0; case Cmd is when None => Buffer(1) := (+("Command help : help COMMAND")); Buffer(2) := (+(" -- help ? print command help for ? --")); Result.Count := Result.Count + 2; when Xls => Buffer(1) := (+( "Command help : xls")); Buffer(2) := (+( " -- list files in directory --")); Buffer(3) := (+( " -- Ex : xls --")); Buffer(4) := (+( " -- Ex : xls -l ] (list files in long format) --")); Result.Count := Result.Count + 4; when Clear => Buffer(1) := (+( "Command help : clear")); Buffer(2) := (+( " -- Erase the shell file named "".shell_file.txt"" --")); Result.Count := Result.Count + 2; when Alias => Buffer(1) := (+( "Command help : alias")); Buffer(2) := (+( " -- Create an alias to any command --")); Buffer(3) := (+( " -- Ex : alias name=value --")); Result.Count := Result.Count + 3; when Unalias => Buffer(1) := (+( "Command help : unalias")); Buffer(2) := (+( " -- Delete an alias --")); Buffer(3) := (+( " -- Ex : unalias name --")); Result.Count := Result.Count + 3; when Cd => Buffer(1) := (+( "Command help : cd")); Buffer(2) := (+( " -- Change current working directory --")); Buffer(3) := (+( " -- Ex : cd Documents [ Enter ] --")); Buffer(4) := (+( " -- Ex : cd - [ Enter ] (Change current dir to OLD_PWD --")); Buffer(5) := (+( " -- Ex : cd [ Enter ] (Change current dir to $HOME directory --")); Result.Count := Result.Count + 5; -- when Logout => -- Buffer.all := Buffer.all & (+( "Command help : logout")); -- Buffer.all := Buffer.all & (+( " -- Quit the program --")); -- when Pwd => -- Buffer.all := Buffer.all & (+( "Command help : pwd")); -- Buffer.all := Buffer.all & (+( " -- Return the current working directory --")); when Help => null; when others => null; end case; Result.wlines := Buffer; end Internal_Help; task body None_Process is Lock : Binary_Semaphore(True, Default_Ceiling); Text : M.Strings.Wide_String_Access := new Wide_String ' (""); Old_Length : Natural := 0; -- save text'length Old_Total_Length : Natural := 0; -- save total_type'image(total_sum)'length Old_Pwd : Os_Lib.String_Access; Cpu_Lock : Binary_Semaphore(True, Default_Ceiling); --Application : App_Access; xls_index : Natural := 0; task Screen is entry Refresh; entry Halt; end Screen; task body Screen is Prompt : Os_Lib.String_Access; Cpu : Cpu_String := (others => ' '); begin loop select accept Halt; exit; or accept Refresh do Lock.Seize; Cpu_Lock.Seize; Cpu_Process.Initialize; Cpu_Process.Cpu_Get(Cpu); Cpu_Lock.Release; Free(Prompt); Prompt := new String ' (Term_Enum'Image(Mode.App.Term) & ':' & cpu & ": " & Formatting.Image(Clock)(12..Formatting.Image(Clock)'Length) & ":" & Total_Type'Image(Total_Sum) & "$ "); if Text /= null then Put(Character'Val (13) & Prompt.all); Put((Old_Length+Old_Total_Length+Cpu'length) * ' '); Put(Character'Val (13) & Prompt.all); W_Io.Put(Text.all); else Put(Character'Val (13) & Prompt.all); Put((Old_Length+Old_Total_Length+Cpu'length) * ' '); Put(Character'Val (13) & Prompt.all); end if; Old_Total_Length := Total_Type'Image(Total_Sum)'Length; Old_Length := 0; Lock.Release; end Refresh; end select; end loop; end Screen; task Deamon is entry Halt; entry Lock; entry Unlock; end Deamon; task body Deamon is End_Of_Task : Boolean := False; begin Main_Loop : while not End_Of_Task loop loop select accept Halt; End_Of_Task := True; exit Main_Loop; or accept Lock; or accept Unlock; screen.Refresh; exit; end select; end loop; while not End_Of_Task loop select accept Halt; End_Of_Task := True; exit Main_Loop; or accept Lock; exit; or accept Unlock; or delay 1.0; screen.Refresh; end select; end loop; end loop Main_Loop; end Deamon; Args_Index : Natural := 0; Arguments : M.Strings.Wide_String_Access; Var_Set : Attributs(2048); Alias_Set : Attributs(2048); Internal_Cmd : Int_Cmd_Enum := None; Is_Internal_Cmd : Boolean := False; Buffer : M.Strings.Wide_String_Access; Completion_Result : Wide_Result_Access; History_Set : Wide_Set(2048); History_Last : Natural := 0; History_Index : Natural := 0; Errno : Integer := 0; Result : Wide_Result_Access; Old_Text : M.Strings.Wide_String_Access; Total : Natural := 0; Success : Boolean := False; begin Initialize(App.Cmd_Result.Win, 1, 1, lines, Columns, White, Red); Alias_Set.List(1) := Make("ls", "ls -C -p --color -w " & Integer'Image(Columns-2)); Alias_Set.Index := 1; begin Main_Loop: loop loop select accept Halt do Deamon.Halt; Screen.Halt; end Halt; exit Main_Loop; or accept Suspend do Deamon.Lock; end Suspend; exit; or accept Wake_Up(Top : in Natural); or accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(9) => if Text'Length > 0 then Lock.Seize; declare Line : constant Os_Lib.String_Access := new String ' (Handling.To_String(Text.all)); Path_On_Line : M.Strings.Wide_String_Access; buffer : Os_Lib.String_Access := new String ' (""); begin if Completion_Result /= null then U_Array_Free(Completion_Result.Wlines); end if; Completion(Line.all, Path_On_Line, Completion_Result); if Path_On_Line /= null then Buffer := new String ' (Handling.To_String(Path_On_Line.all)); Wide_Free(Path_On_Line); Wide_Free(Text); Text := new Wide_String ' (Handling.To_Wide_String(Buffer.all)); Free(Buffer); U_Array_Free(Completion_Result.Wlines); Wide_Result_Free(Completion_Result); else for I in Completion_Result.Wlines'Range loop Put_Line(M.Tools.Delete_Local_Prefix(Handling.To_String((-(completion_Result.Wlines(I)))))); end loop; end if; end; Lock.Release; end if; when Wide_Character'Val(10) | Wide_Character'Val(13) => if Text /= null and then Text'Length > 0 then Lock.Seize; Text_Io.New_Line; Deamon.Lock; if Text(1) = '-' or Text(1) = '+' then if Text'Length > 1 then declare Val : Total_Type := 0.0; begin Val := Total_Type'Value(Handling.To_String(Text.all)); Total_Sum := Total_Sum + Val; Wide_Free(Text); Text := new Wide_String ' (""); exception when Constraint_error => Put_Line("-: error"); end; end if; else Internal_Cmd := Internal_Cmd_Value(Handling.To_String(Text.all)); Is_Internal_Cmd := True; case Internal_Cmd is when none => Is_Internal_Cmd := False; when Alias => Alias(Handling.To_String(Text.all), Alias_Set); when Unalias => Unalias(Handling.To_String(Text.all), Alias_Set); when Cd => begin Cpu_Lock.Seize; Change_Directory(Handling.To_String(Text.all), Old_Pwd); Cpu_Lock.Release; exception when Directory_Error => Cpu_Lock.Release; Text_Io.Put("Directory not found"); Text_Io.New_Line; end; when Set => Set(Handling.To_String(Text.all), Var_Set); when Unset => Unset(Handling.To_String(Text.all), Var_Set); when Put => Args_Index := Index(Handling.To_String(Text.all), " ")+1; if Args_Index /= 0 then Arguments := new Wide_String ' (Text(Args_Index..Text'Length)); Put(Handling.To_String(Arguments.all), Var_Set); end if; Text_Io.New_Line; when Put_Line => Args_Index := Index(Handling.To_String(Text.all), " ")+1; if Args_Index /= 0 then Arguments := new Wide_String ' (Text(Args_Index..Text'length)); Put_Line(Handling.To_String(Arguments.all), Var_Set); end if; when Xls => Xls_Index := 0; Internal.xls(Handling.To_String(Text.all), App.Cmd_Result.Win, Xls_Index, Total); Total := 0; Wide_Free(Old_Text); Old_Text := new Wide_String ' (Text.all); when Clear => --Draw_Window(App.Cmd_Result.Win); Put(Ansi_Tty_Control.Clear_Screen); Lib.Shared.Line_Cur := 1; when Help => Result := new Spawn_Result_Record; Internal_Help(Text.all, Spawn_Result_record(Result.all)); --New_Line; Print_buffer(Result, 0); Wide_Result_Free(Result); Lib.Shared.Line_Cur := Lib.Shared.Line_Cur + Result.Count+1; Total := 0; end case; if not Is_Internal_Cmd then --New_Line; declare Alias_Ptr : Os_Lib.String_Access; Buffer : Os_Lib.String_Access; Normal : Os_Lib.String_Access; begin for Iter in 1..Alias_Set.Index loop declare Alias : constant Attribut_Record := Alias_Set.List(Iter); First_Space : Natural := Index(Handling.To_String(Text.all), " "); Non_Blank : constant Natural := Index_Non_Blank(Handling.To_String(Text.all), Backward); begin if Non_Blank < First_Space then First_Space := 0; end if; if First_Space /= 0 then if Names(Alias) = Handling.To_String(Text(Text'First..First_Space - 1)) then Alias_Ptr := new String ' (Images(Alias)); exit; end if; else if Names(Alias) = Handling.To_String(Text(Text'First..Index_Non_Blank(Handling.To_String(Text.all), Backward))) then Alias_Ptr := new String ' (Images(Alias)); exit; end if; end if; end; end loop; if Alias_Ptr /= null then declare First_Space : constant Natural := Index(Handling.To_String(Text.all), " "); begin if First_Space /= 0 then Buffer := new String ' (Alias_Ptr.all & ' ' & Handling.To_String(Text(First_Space+1..Text ' Last))); else Buffer := new String ' (Alias_Ptr.all); end if; end; Wide_Free(Text); Normal := new String ' (Normalize_Quoted_Argument(Buffer.all)); Text := new Wide_String ' (Handling.To_Wide_String(Normal.all)); end if; end; if Locate_Exec_On_path(Command_Name(Handling.To_String(Text.all))) /= null then if Command_Name(Handling.To_String(Text.all))'Length = Text'Length then declare -- Args : constant Os_Lib.Argument_List_Access := Os_Lib.Argument_String_To_List -- ( -- "-c " & -- Os_Lib.Locate_Exec_On_Path(Command_Name(Handling.To_String(Text.all))).all); begin if Os_Lib.Locate_Exec_On_Path(Command_Name(Handling.To_String(Text.all))).all'Length /= 0 then --Errno := Spawn("/usr/bin/sh", Args.all); Errno := System("/usr/bin/sh -c """ & Os_Lib.Locate_Exec_On_Path(Command_Name(Handling.To_String(Text.all))).all & " | /usr/bin/tee ./flush.txt""" & Character'Val(0)); Lib.Shared.Line_Cur := Lib.Shared.Line_Cur + Line_Count("./flush.txt") + 1; Os_Lib.Delete_File("flush.txt", Success); end if; end; else declare -- Args : constant Os_Lib.Argument_List_Access := new Os_Lib.Argument_List ' (new String ' ("-c"),  -- new String ' (Os_Lib.Locate_Exec_On_Path(Command_Name(Handling.To_String(Text.all))).all & " " &  -- Handling.To_String(Text.all)(Command_Name(Handling.To_String(Text.all))'Length+2..Text'Last) -- ) -- ); begin --Normalize_Arguments(Args.all); --Errno := Spawn("/usr/bin/sh", Args.all); Errno := System("/usr/bin/sh -c """ & Os_Lib.Locate_Exec_On_Path(Command_Name(Handling.To_String(Text.all))).all & " " & Normalize_Quoted_Argument(Handling.To_String(Text.all)(Command_Name(Handling.To_String(Text.all))'Length+2..Text'Last)) & " | /usr/bin/tee ./flush.txt""" & Character'Val(0)); Lib.Shared.Line_Cur := Lib.Shared.Line_Cur + Line_Count("./flush.txt") + 1; Os_Lib.Delete_File("flush.txt", Success); end; end if; else Errno := System("/usr/bin/sh -c """ & Normalize_Quoted_Argument(Handling.To_String(Text.all)) & " | /usr/bin/tee ./flush.txt""" & Character'Val(0)); Lib.Shared.Line_Cur := Lib.Shared.Line_Cur + Line_Count("./flush.txt") + 1; Os_Lib.Delete_File("flush.txt", Success); if Errno /= 0 then New_Line; Put_Line("Command not found"); end if; end if; end if; if Errno /= 0 then Put_Line("Error: errno = " & Integer'Image(Errno)); end if; Old_Length := Text'Length; Add_Line(History_Set, History_Last, Text.all); History_Index := 0; Wide_Free(Text); Text := new Wide_String ' (""); end if; Deamon.Unlock; Lock.Release; end if; when Wide_Character'Val(12) => Put(Ansi_Tty_Control.Clear_Screen); --Errno := System("clear" & Character'Val(0)); Lib.Shared.Line_Cur := 1; Screen.Refresh; when Wide_Character'Val(127) => Old_Length := Text'Length; Buffer := new Wide_String ' (Text.all(Text'First..Text'Last-1)); Wide_Free(Text); Text := new Wide_String ' (Buffer.all); Wide_Free(Buffer); Screen.Refresh; when others => null; end case; else Lock.Seize; Buffer := new Wide_String ' (Text.all & Wchar); Wide_Free(Text); Text := new Wide_String ' (buffer.all); Wide_Free(Buffer); Old_Length := Text'Length; Lock.Release; end if; end Receive; Screen.Refresh; or accept Refresh; Screen.Refresh; or accept Page_Down; or accept Page_Up; or accept Up_Arrow do if (History_Last > 0) and then (History_Last - History_Index) > 0 then Old_Length := Text'Length; Screen.Refresh; Wide_Free(Text); Text := new Wide_String ' (History_Set.Lines(History_Last - (History_Index)).all); History_Index := History_Index + 1; Screen.Refresh; else Put(Character'Val(7)); end if; end up_arrow; or accept Down_Arrow do if (History_Index > 1) then Old_Length := Text'Length; Wide_Free(Text); Text := new Wide_String ' (History_Set.Lines(History_Last - (History_Index - 2)).all); History_Index := History_Index - 1; Screen.Refresh; elsif History_Index = 1 then Old_Length := Text'Length; Wide_Free(Text); Text := new Wide_String ' (""); History_Index := History_Index - 1; Screen.Refresh; else Put(Character'Val(7)); end if; end Down_Arrow; or accept Left_Arrow; or accept Right_Arrow; or accept Full_Screen; or accept Del; or accept Begin_Of; or accept End_Of; or accept Overwrite; or accept Full_Screen; end select; end loop; loop select accept Halt do Deamon.Halt; Screen.Halt; end Halt; exit Main_Loop; or accept Suspend; or accept Wake_Up(Top : in Natural) do --Text_Io.Put_Line("Greetings " & Getenv("USER").all & "!"); Deamon.Unlock; end Wake_Up; exit; end select; end loop; end loop Main_Loop; end; --W_Io.Put_Line("None process halted"); end None_Process; subtype Function_Enum is Mode_Enum range None..Library; subtype Managment_Enum is Mode_Enum range Navigation..Agent; subtype Supervision_Enum is Mode_Enum range Ai_Managment..Quit; type Mode_Menu_Array is array (Mode_Enum range <>) of OS_Lib.String_Access; type Page_Enum is (operations, Managments, Supervisions); type Page_Array is array (Page_Enum) of access Mode_Menu_Array; --Function_Page : constant access Mode_Menu_Array := new Mode_Menu_Array(Function_Enum'Range); --Managment_Page : constant access Mode_Menu_Array := new Mode_Menu_Array(Managment_Enum'Range); --Supervision_Page : constant access Mode_Menu_Array := new Mode_Menu_Array(Supervision_Enum'Range); --Pages : constant Page_Array := (Function_Page, Managment_Page, Supervision_Page); Pages : constant Page_Array := (new Mode_Menu_Array(Function_Enum'Range), new Mode_Menu_Array(Managment_Enum'Range), new Mode_Menu_Array(Supervision_Enum'Range)); package Page_Wrap is new PragmARC.Wrapping(Page_Enum); use Page_Wrap; procedure Gate_Print(Page : in Page_Enum; Mode : in Mode_Enum) is Page_Cur : Page_Enum := Page; Line : Line_Range := 6; Col : Column_Range := Columns/6; begin Ansi.Console.Clear_Screen; Put(Position(2, Col) & Page_Enum'Image(Page_cur)); Page_Cur := Wrap_Succ(Page_Cur); Put(Position(2, Col+(Columns/6)*2) & Page_Enum'Image(Page_Cur)); Col := Col+(Columns/6)*2; Page_Cur := Wrap_Succ(Page_Cur); Put(Position(2, Col+(Columns/6)*2) & Page_Enum'Image(Page_Cur)); Col := Columns/6-10; Page_Cur := Page; for Page in 1..3 loop for Mode_Cur in Pages(Page_Cur)'Range loop if Functions(Mode_Enum'Pos(Mode_Enum'Value(Pages(Page_Cur)(Mode_cur).all))) = null then Text_Io.Put(Position(Line, Col) & Internal.Red & Pages(Page_Cur)(Mode_cur).all & Normal_Mode); elsif Mode_Enum'Value(Pages(Page_Cur)(Mode_cur).all) = Mode then Text_Io.Put(Position(Line, Col) & Reverse_video & Pages(Page_Cur)(Mode_cur).all & Normal_Mode); else Text_Io.Put(Position(Line, Col) & Pages(Page_Cur)(Mode_cur).all); end if; Line := Line + 2; end loop; exit when Page = 3; Line := 6; Col := Col+(Columns/6)*2-10; Page_Cur := Wrap_Succ(Page_Cur); end loop; end Gate_Print; procedure Page_Initialize is begin for Page in Page_Enum'Range loop for Mode in Pages(Page)'Range loop Pages(Page)(Mode) := new String ' (Mode_Enum'Image(Mode)); end loop; end loop; end Page_Initialize; task body Gate_Process is Page : Page_Enum := operations; Mode_Index : Natural := 0; Offset : Natural := 0; The_Mode : Mode_Enum := Gate; begin Page_Initialize; Main_Loop: loop loop select accept Receive (Wchar : in Wide_Character) do if Is_Control (Wchar) then case Wchar is when Wide_Character'Val(9) => case Page is when Supervisions => Page := Operations; Offset := 0; when operations => Page := Managments; Offset := 13; when Managments => Page := Supervisions; Offset := Offset+12; end case; Mode_Index := 0; Gate_Print(Page, Mode_Enum'Value(Pages(Page)(Mode_Enum'Val(Mode_Index+Offset)).all)); when Wide_Character'Val(10) | Wide_Character'Val(13) => Put_Line("mode index : " & Integer'Image(Mode_Index) & " offset : " & Integer'Image(Offset)); The_Mode := Mode_Enum'Value(Pages(Page)(Mode_Enum'Val(Mode_Index+Offset)).all); Put_Line(Mode_Enum'Image(The_Mode)); when Wide_Character'Val(12) => Gate_Print(Page, Mode_Enum'Value(Pages(Page)(Mode_Enum'Val(Mode_Index+Offset)).all)); when others => null; end case; else null; end if; end Receive; --Ansi.Console.Clear_Screen;  if The_Mode /= Gate then App.Console.Switch(The_Mode); exit; end if; or accept Halt; exit Main_loop; or accept Wake_Up(Top : in Natural) do W_Io.Put_Line("Gate"); Ansi.Console.Clear_Screen; Mode_Index := 0; Offset := 0; The_Mode := Gate; Page := Operations; Gate_Print(Page, Mode_Enum'Value(Pages(Page)(Mode_Enum'Val(Mode_Index+Offset)).all)); end Wake_Up; or accept Suspend; exit; or accept Refresh; or accept Page_Down; or accept Page_Up; or accept Up_Arrow do if Mode_Index > 0 then Mode_Index := Mode_Index - 1; end if; Gate_Print(Page, Mode_Enum'Value(Pages(Page)(Mode_Enum'Val(Mode_Index+Offset)).all)); end up_arrow; or accept Down_Arrow do if Mode_Index < Pages(Page)'Length-1 then Mode_Index := Mode_Index + 1; end if; Gate_Print(Page, Mode_Enum'Value(Pages(Page)(Mode_Enum'Val(Mode_Index+Offset)).all)); end Down_Arrow; or accept Left_Arrow; or accept Right_Arrow; or accept Del; or accept Begin_Of; or accept End_Of; or accept Overwrite; or accept Screen_Print; end select; end loop; loop select accept Halt; exit Main_Loop; or accept Suspend; or accept Wake_Up(Top : in Natural) do W_Io.Put_Line("Gate"); --Text_Io.Put_Line("Greetings " & Getenv("USER").all & "!"); Ansi.Console.Clear_Screen; Mode_Index := 0; Offset := 0; The_Mode := Gate; Page := Operations; Gate_Print(Page, Mode_Enum'Value(Pages(Page)(Mode_Enum'Val(Mode_Index+Offset)).all)); end Wake_Up; exit; end select; end loop; end loop Main_Loop; --W_Io.Put_Line("Gate process halted"); end Gate_Process; --------------------------------------------------------------------------- -- -- -- Organizer -- -- -- --------------------------------------------------------------------------- use Abstract_Vectors; function Id (Name : in Class_Enum) return Abstract_Access is begin if Name = Planning then return new Planning_Class; elsif Name = Content then return new Content_Class; elsif Name = Universe then return new Universe_Class; elsif Name = Program then return new Classes.Program_Class; elsif Name = Event then return new Event_Class; elsif Name = Meeting then return new Meeting_Class; elsif Name = Rendezvous then return new Rendezvous_Class; elsif Name = Job then return new Job_Class; elsif Name = Profile then return new Profile_Class; elsif Name = Book then return new Book_Class; elsif Name = CDROM then return new CDROM_Class; elsif Name = DVD then return new DVD_Class; elsif Name = Car then return new Car_Class; elsif Name = House then return new House_Class; end if; return null; end Id; type Object_Counter is array (Class_Enum'Range) of Natural; procedure Global_Content_Print (Object : Abstract_Access; Win : in Window_Type) is Objects : Abstract_Vectors.Vector; Counter : Object_Counter := (others => 0); Win_Index : Natural := 0; begin if Object /= null then Objects := Object.Childs; for I in 1..Last_Index(Objects) loop declare E : constant Abstract_Access := Abstract_Vectors.Element(Objects, I); begin for J in Class_Enum'Succ(None)..Class_Enum'Last loop if E.Tag = J then Counter(J) := Counter(J) + 1; end if; end loop; end; end loop; for I in Class_Enum'Succ(None)..Class_Enum'Last loop Draw(Win, Win_Index+1, 3, White, Handling.To_Wide_String(Class_Enum'Image(I)) & Wide_Fixed."*"((16 - Class_Enum'Image(I)'Length),' ') & " : Total = " & Handling.To_Wide_String(Natural'Image(Counter(I))) & " " & Handling.To_Wide_String(Class_Enum'Image((i)))); Win_Index := Win_Index + 1; end loop; else Draw(Win, Win_Index+1, 3, White, "Obj = null"); end if; end Global_Content_Print; procedure Global_Read(File : W_Io.File_Type; End_Of_File : out Boolean; Object : out Abstract_Access) is Tag : Class_Enum := None; Name : Wide_String(1..8) := (others => Wide_Character'Val(32)); Name_Last : Natural := 0; Index : Natural := 0; begin End_Of_File := False; while not W_Io.End_Of_File(File) loop declare Name : Wide_String := W_Io.Get_Line(File); begin Index := Wide_Fixed.Index_Non_Blank(Name, backward); if index = 0 then raise Constraint_Error; else if Wide_Characters.Handling.Is_Control(Name(Index)) then raise Constraint_Error; end if; end if; Tag := Class_Enum'Value(Handling.To_String(Name)); exit; exception when Constraint_Error => W_Io.Get_Line(File, Name, Name_Last); begin Tag := Class_Enum'Value(Handling.To_String(Name(Name'First..Name_Last))); exit; end; end; end loop; Object := Id(Tag); End_Of_File := W_Io.End_Of_File(File); if not End_Of_File then Object.Read(File); end if; exception when Constraint_Error => raise; when others => null; end Global_Read; procedure Global_Print(Object : Abstract_Access; Header : in Window_Type; Win : in Window_Type) is begin if Object = null then return; end if; if Object.all'Tag = Universe_Class'Tag then Universe_Class(Object.all).Print(Header, Win); elsif Object.all'Tag = Planning_Class'Tag then Planning_Class(Object.all).Print(Header, Win); elsif Object.all'Tag = Content_Class'Tag then Content_Class(Object.all).Print(Header, Win); elsif Object.all'Tag = Event_Class'Tag then Event_Class(Object.all).Print(Header, Win); elsif Object.all'Tag = Job_Class'Tag then Job_Class(Object.all).Print(Header, Win); elsif Object.all'Tag = Meeting_Class'Tag then Meeting_Class(Object.all).Print(Header, Win); elsif Object.all'Tag = Rendezvous_Class'Tag then Rendezvous_Class(Object.all).Print(Header, Win); elsif Object.all'Tag = Profile_Class'Tag then Profile_Class(Object.all).Print(Header, Win); end if; end Global_Print; procedure Parent(T : in out Terminal_Type) is V : Abstract_Vectors.Vector := T.Path; begin if not Is_Empty(V) then if Last_Index(V) >= 1 then T.Cur := Last_Element(V); if Last_Index(V) > 1 then Delete(V, Last_Index(V)); end if; end if; end if; T.Path := V; end Parent; procedure Switch(T : in out Terminal_Type; Num : in Abstract_Index; Success : out boolean) is Vector : Abstract_Vectors.Vector; begin Success := False; if T.Cur /= null then Vector := T.Cur.Childs; if not Is_Empty(Vector) then if Num <= Last_Index(Vector) then T.Path := T.Path & T.Cur; T.Cur := Abstract_Vectors.Element(Vector, Num); if T.Cur /= null then Success := True; else raise Program_Error; end if; end if; end if; end if; end Switch; procedure Add_To (Terminal : in out Terminal_Type; Obj : Abstract_Access) is begin if Terminal.Root = null then Obj.Info.Index := 1; Terminal.Root := Obj; Terminal.Cur := Obj; Terminal.Path := Terminal.Path & Obj; else Obj.Info.Index := Abstract_Index(Abstract_Vectors.Length(Terminal.Cur.Childs) + 1); Terminal.Cur.Childs := Terminal.Cur.Childs & Obj; Terminal.Cur.Info.Childs_Num := Terminal.Cur.Info.Childs_Num + 1; end if; end Add_To; procedure Restore_Vector(T : in out Terminal_Type; File : W_Io.File_Type) is Success : Boolean := False; N, O : Abstract_Access; Child_Childs, Child_Numb : Natural := 0; End_Of_File : Boolean := False; begin if T.Root = null then Global_Read(File, End_Of_File, T.Root); if T.Root.all in Profile_Class then T.U_Count := T.U_Count + 1; end if; T.Cur := T.Root; if T.Cur.Info.Childs_Num /= 0 then for Child in 1..T.Cur.Info.Childs_Num loop if not W_Io.End_Of_File(File) then Restore_Vector(T, File); end if; Parent(T); end loop; end if; else for Child in 1..T.Cur.Info.Childs_Num loop Global_Read(File, End_Of_File, N); if N.all in Profile_Class then T.U_count := T.U_Count + 1; end if; T.Cur.Childs := T.Cur.Childs & N; if not W_Io.End_Of_File(File) then if N.Info.Childs_num /= 0 then Switch(T, Last_Index(T.Cur.Childs), Success); Restore_Vector(T, File); Parent(T); end if; end if; end loop; end if; end Restore_Vector; procedure Restore(T : in out Terminal_Type; Filename : in String) is End_Of_File : Boolean := False; File : W_Io.File_Type; begin W_Io.Open(File, W_Io.in_File, Filename); if not W_Io.End_Of_File(File) then Restore_Vector(T, File); end if; W_Io.Close(File); end Restore; procedure Search(T : in out Terminal_Type; name : in Wide_String; Path_Index : in out Natural; Success : out boolean) is Vector : Abstract_Vectors.Vector := T.Cur.Childs; begin Success := False; if not Is_Empty(Vector) then for I in 1..Last_Index(Vector) loop declare E : constant Abstract_Access := Abstract_Vectors.Element(Vector, I); Term : Terminal_Type := T; begin if E /= null then if E.Info.Name.all = Name then Switch(Term, I, success); if Success then T := Term; exit; end if; else Switch(Term, I, success); Path_Index := Path_Index + 1; if Success then Search(Term, Name, Path_Index, Success); if Success then T := Term; exit; end if; end if; end if; else raise Program_Error; end if; end; end loop; end if; end Search; procedure Save_Object (Object : Abstract_Access; File : W_Io.File_Type; Index : Natural := 0) is O : constant Abstract_Access := Object; New_Index : Natural := Index; begin if O = null then return; end if; O.all.Write(File); if not Is_Empty(O.Childs) then for I in 1..Last_Index(O.Childs) loop declare E : constant Abstract_Access := Abstract_Vectors.Element(O.Childs, I); begin Save_Object(E, File, New_Index+1); end; end loop; end if; end Save_Object; procedure Save (Object : in Abstract_Access; Filename : in String) is File : W_Io.File_Type; begin W_Io.Create(File, W_Io.Out_File, Filename); Save_Object(Object, File); W_Io.Close(File); end Save; type Organizer_Type; task type Date_Process (Organizer : access Organizer_Type) is entry Start; entry Stop; entry Halt; end Date_Process; type Organizer_Type is limited record Main_Win : Window_Record := (1, 1, App.lines, App.Columns/2, Blue, The_Window); Header_Win : Window_Record := (2, 2, 3, App.Columns/2-2, white, The_Window); content_Win : Window_Record := (5, 2, 22, (App.Columns/2-2)/2, white, The_Window); Cmd_Win : Window_Record := (27, 2, 3, (App.Columns/2-2)/2, Blue, The_Window); Proc : Date_Process(Organizer_Type'Access); Obj_Header : Window_Record := (5, (App.Columns/2-2)/2+2, 6, (App.Columns/2-2)/2, Blue, The_Window); Obj_Main : Window_Record := (11, (App.Columns/2-2)/2+2, 7, (App.Columns/2-2)/2, white, The_Window); Obj_Attr : Window_Record := (18, (App.Columns/2-2)/2+2, 12, (App.Columns/2-2)/2, Blue, The_Window); List_Win : Window_Record := (30, 2, App.Lines-29, (App.Columns/2-2), white, The_Window); end record; task body Date_Process is begin Main_Loop: loop loop select accept Start; exit; or accept Stop; or accept Halt; exit Main_Loop; end select; end loop; loop select accept Start; or accept Stop; exit; or accept Halt; exit Main_Loop; or delay 1.0; Text_Io.Put(Save_Cursor); Draw_Text(Organizer.Header_Win, 1, App.Columns/4-10, White, Handling.To_Wide_String(Formatting.Image(Clock))); Text_Io.Put(Restore_Cursor); end select; end loop; end loop Main_Loop; end Date_Process; procedure Initialize (Organizer : out Organizer_Type; Top : Natural := 0) is begin Initialize(Organizer.Main_Win, 1, Top+1, App.lines, App.Columns/2, Blue, white); Initialize(Organizer.Header_Win, 2, Top+2, 3, App.Columns/2-2, white, Cyan); Initialize(Organizer.Content_Win, 5, Top+2, 22, (App.Columns/2-2)/2, white, Cyan); Initialize(Organizer.Cmd_Win, 27, Top+2, 3, (App.Columns/2-2)/2, Blue, White); Initialize(Organizer.Obj_Header, 5, Top+(App.Columns/2-2)/2+2, 6, (App.Columns/2-2)/2, Blue, White); Initialize(Organizer.Obj_Main, 11, Top+(App.Columns/2-2)/2+2, 7, (App.Columns/2-2)/2, white, Cyan); Initialize(Organizer.Obj_Attr, 18, Top+(App.Columns/2-2)/2+2, 12, (App.Columns/2-2)/2, Blue, White); Initialize(Organizer.List_Win, 30, Top+2, App.Lines-29, (App.Columns/2-2), white, Red); end Initialize; procedure Draw (Organizer : in Organizer_Type; Terminal : in Terminal_Type) is begin Enlight_Window(Organizer.Main_Win); Enlight_Window(Organizer.Header_win); Enlight_Window(Organizer.Content_Win); Enlight_Window(Organizer.cmd_Win); Enlight_Window(Organizer.Obj_Header); Enlight_Window(Organizer.Obj_Main); Enlight_Window(Organizer.Obj_Attr); Enlight_Window(Organizer.List_Win); Text_Io.Put(Normal_Mode); end Draw; type Class_Cmd_Enum is (Null_Cmd, Make, List, Switch, Root, Parent, Print, Search, Tree, Attribute, Remove, help); function Class_Cmd_Value (Line : in Wide_String) return Class_Cmd_Enum is Cmd : Class_Cmd_Enum := Null_Cmd; First_Space : constant Natural := Wide_Fixed.Index(Line, " "); begin if First_Space /= 0 then begin Cmd := Class_Cmd_Enum'Value(Handling.To_String(Line(Line'First..First_Space-1))); exception when others => Cmd := Null_Cmd; end; elsif Wide_Fixed.Index_Non_Blank(Line) /= 0 then begin Cmd := Class_Cmd_Enum'Value(Handling.To_String(Line(Wide_Fixed.Index_Non_Blank(Line)..Wide_Fixed.Index_Non_Blank(Line, Backward)))); exception when others => Cmd := Null_Cmd; end; end if; return Cmd; end Class_Cmd_Value; --------------------------------------------------------------------- -- Planning curs type Planning_enum is (Planning_None, Planning_Name, Planning_From, Planning_To); type Planning_Type is record Name : Planning_Enum := Planning_None; Line : Wstring_45 := (others => ' '); Line_Last : Natural := 0; Line_Pos : Line_Range := 1; Column_Pos : Column_Range := 1; end record; type Planning_Curs_Set is array (Planning_Enum) of Planning_Type; type Planning_Cursor_Type is record Values : Planning_Curs_Set; Val_Cur : Planning_Enum := Planning_Name; end record; function Initialize return Planning_Cursor_Type is Curs : Planning_Cursor_Type; begin Curs.Values(Planning_Name) := (Planning_name, (others => ' '), 0, 1, 8 ); Curs.Values(Planning_From) := (Planning_From, (others => ' '), 0, 2, 8 ); Curs.Values(Planning_To) := (Planning_To, (others => ' '), 0, 3, 8 ); Curs.Val_Cur := Planning_name; return Curs; end Initialize; function To_Planning (Curs : in Planning_Cursor_Type; Index : in Abstract_Index) return Planning_Class is Planning : Planning_Class := Create; begin Planning.info.Index := Index; Planning.info.Name := new Wide_String ' (Curs.Values(Planning_Name).Line(1..Curs.Values(Planning_Name).Line_Last)); Planning.From := Formatting.Value(Handling.To_String(Curs.Values(Planning_From).Line(1..Curs.Values(Planning_From).Line_Last))); Planning.To := Formatting.Value(Handling.To_String(Curs.Values(Planning_To).Line(1..Curs.Values(Planning_To).Line_Last))); return Planning; exception when others => raise Spec_Error; end To_Planning; --------------------------------------------------------------------------------- -- Attribute curs type Attribute_Enum is (Attribute_None, Attribute_Name, Attribute_Image); type Attribute_Type is record Name : Attribute_Enum := Attribute_None; Line : Wstring_45 := (others => ' '); Line_Last : Natural := 0; Line_Pos : Line_Range := 1; Column_Pos : Column_Range := 1; end record; type Attribute_Curs_Set is array (Attribute_Enum) of Attribute_Type; type Attribute_Cursor_Type is record Values : Attribute_Curs_Set; Val_Cur : Attribute_Enum := Attribute_Name; end record; function Initialize return Attribute_Cursor_Type is Curs : Attribute_Cursor_Type; begin Curs.Values(Attribute_Name) := (Attribute_name, (others => ' '), 0, 1, 8 ); Curs.Values(Attribute_Image) := (Attribute_Image, (others => ' '), 0, 2, 9 ); Curs.Val_Cur := Attribute_name; return Curs; end Initialize; --------------------------------------------------------------------------------- -- Event curs type Event_Enum is (Event_None, Event_Name, Event_Date, Event_Period, Event_Locality, Event_Define); type Event_Type is record Name : Event_Enum := Event_None; Line : Wstring_45 := (others => ' '); Line_Last : Natural := 0; Line_Pos : Line_Range := 1; Column_Pos : Column_Range := 1; end record; type Event_Curs_Set is array (Event_Enum) of Event_Type; type Event_Cursor_Type is record Values : Event_Curs_Set; Val_Cur : Event_Enum := Event_Name; end record; function Initialize return Event_Cursor_Type is Curs : Event_Cursor_Type; begin Curs.Values(Event_Name) := (Event_name, (others => ' '), 0, 1, 8 ); Curs.Values(Event_Date) := (Event_Date, (others => ' '), 0, 2, 8 ); Curs.Values(Event_Period) := (Event_Period, (others => ' '), 0, 3, 9 ); Curs.Values(Event_Locality) := (Event_Locality, (others => ' '), 0, 4, 12 ); Curs.Values(Event_Define) := (Event_Define, (others => ' '), 0, 5, 10 ); Curs.Val_Cur := Event_name; return Curs; end Initialize; function To_Event (Curs : in Event_Cursor_Type;Index : in Abstract_Index) return Event_Class is Event : Event_Class := Create; begin Event.info.Index := Index; Event.info.Name := new Wide_String ' (Curs.Values(Event_Name).Line(1..Curs.Values(Event_Name).Line_Last)); Event.Date := Formatting.Value(Handling.To_String(Curs.Values(Event_Date).Line(1..Curs.Values(Event_Date).Line_Last))); Event.Period := Duration(Float'Value(Handling.To_String(Curs.Values(Event_Period).Line(1..Curs.Values(Event_Period).Line_Last))) * 60.0); Event.Locality := new Wide_String ' (Curs.Values(Event_Locality).Line(1..Curs.Values(Event_Locality).Line_Last)); Event.Define := new Wide_String ' (Curs.Values(Event_Define).Line(1..Curs.Values(Event_Define).Line_Last)); return Event; exception when others => raise Spec_Error; end To_Event; --------------------------------------------------------------------------------- -- Job curs type Job_Enum is (Job_None, Job_Name, Job_Date, Job_Period, Job_Locality, Job_Define); type Job_Type is record Name : Job_Enum := Job_None; Line : Wstring_45 := (others => ' '); Line_Last : Natural := 0; Line_Pos : Line_Range := 1; Column_Pos : Column_Range := 1; end record; type Job_Curs_Set is array (Job_Enum) of Job_Type; type Job_Cursor_Type is record Values : Job_Curs_Set; Val_Cur : Job_Enum := Job_Name; end record; function Initialize return Job_Cursor_Type is Curs : Job_Cursor_Type; begin Curs.Values(Job_Name) := (Job_name, (others => ' '), 0, 1, 9 ); Curs.Values(Job_Date) := (Job_Date, (others => ' '), 0, 2, 9 ); Curs.Values(Job_Period) := (Job_Period, (others => ' '), 0, 3, 9 ); Curs.Values(Job_Locality) := (Job_Locality, (others => ' '), 0, 4, 12 ); Curs.Values(Job_Define) := (Job_Define, (others => ' '), 0, 5, 10 ); Curs.Val_Cur := Job_name; return Curs; end Initialize; function To_Job (Curs : in Job_Cursor_Type;Index : in Abstract_Index) return Job_Class is Job : Job_Class := Create; begin Job.info.Index := Index; Job.info.Name := new Wide_String ' (Curs.Values(Job_Name).Line(1..Curs.Values(Job_Name).Line_Last)); Job.Date := Formatting.Value(Handling.To_String(Curs.Values(Job_Date).Line(1..Curs.Values(Job_Date).Line_Last))); Job.Period := Duration(Float'Value(Handling.To_String(Curs.Values(Job_Period).Line(1..Curs.Values(Job_Period).Line_Last))) * 60.0); Job.Locality := new Wide_String ' (Curs.Values(Job_Locality).Line(1..Curs.Values(Job_Locality).Line_Last)); Job.Define := new Wide_String ' (Curs.Values(Job_Define).Line(1..Curs.Values(Job_Define).Line_Last)); return Job; exception when others => raise Spec_Error; end To_Job; --------------------------------------------------------------------------------- -- Meeting curs type Meeting_Enum is (Meeting_None, Meeting_Name, Meeting_Date, Meeting_Period, Meeting_Locality, Meeting_Define); type Meeting_Type is record Name : Meeting_Enum := Meeting_None; Line : Wstring_45 := (others => ' '); Line_Last : Natural := 0; Line_Pos : Line_Range := 1; Column_Pos : Column_Range := 1; end record; type Meeting_Curs_Set is array (Meeting_Enum) of Meeting_Type; type Meeting_Cursor_Type is record Values : Meeting_Curs_Set; Val_Cur : Meeting_Enum := Meeting_Name; end record; function Initialize return Meeting_Cursor_Type is Curs : Meeting_Cursor_Type; begin Curs.Values(Meeting_Name) := (Meeting_name, (others => ' '), 0, 1, 9 ); Curs.Values(Meeting_Date) := (Meeting_Date, (others => ' '), 0, 2, 9 ); Curs.Values(Meeting_Period) := (Meeting_Period, (others => ' '), 0, 3, 9 ); Curs.Values(Meeting_Locality) := (Meeting_Locality, (others => ' '), 0, 4, 12 ); Curs.Values(Meeting_Define) := (Meeting_Define, (others => ' '), 0, 5, 10 ); Curs.Val_Cur := Meeting_name; return Curs; end Initialize; function To_Meeting (Curs : in Meeting_Cursor_Type;Index : in Abstract_Index) return Meeting_Class is Meeting : Meeting_Class := Create; begin Meeting.info.Index := Index; Meeting.info.Name := new Wide_String ' (Curs.Values(Meeting_Name).Line(1..Curs.Values(Meeting_Name).Line_Last)); Meeting.Date := Formatting.Value(Handling.To_String(Curs.Values(Meeting_Date).Line(1..Curs.Values(Meeting_Date).Line_Last))); Meeting.Period := Duration(Float'Value(Handling.To_String(Curs.Values(Meeting_Period).Line(1..Curs.Values(Meeting_Period).Line_Last))) * 60.0); Meeting.Locality := new Wide_String ' (Curs.Values(Meeting_Locality).Line(1..Curs.Values(Meeting_Locality).Line_Last)); Meeting.Define := new Wide_String ' (Curs.Values(Meeting_Define).Line(1..Curs.Values(Meeting_Define).Line_Last)); return Meeting; exception when others => raise Spec_Error; end To_Meeting; --------------------------------------------------------------------------------- -- Rendezvous curs type Rendezvous_Enum is (Rendezvous_None, Rendezvous_Name, Rendezvous_Date, Rendezvous_Period, Rendezvous_Locality, Rendezvous_Define); type Rendezvous_Type is record Name : Rendezvous_Enum := Rendezvous_None; Line : Wstring_45 := (others => ' '); Line_Last : Natural := 0; Line_Pos : Line_Range := 1; Column_Pos : Column_Range := 1; end record; type Rendezvous_Curs_Set is array (Rendezvous_Enum) of Rendezvous_Type; type Rendezvous_Cursor_Type is record Values : Rendezvous_Curs_Set; Val_Cur : Rendezvous_Enum := Rendezvous_Name; end record; function Initialize return Rendezvous_Cursor_Type is Curs : Rendezvous_Cursor_Type; begin Curs.Values(Rendezvous_Name) := (Rendezvous_name, (others => ' '), 0, 1, 9 ); Curs.Values(Rendezvous_Date) := (Rendezvous_Date, (others => ' '), 0, 2, 9 ); Curs.Values(Rendezvous_Period) := (Rendezvous_Period, (others => ' '), 0, 3, 9 ); Curs.Values(Rendezvous_Locality) := (Rendezvous_Locality, (others => ' '), 0, 4, 12 ); Curs.Values(Rendezvous_Define) := (Rendezvous_Define, (others => ' '), 0, 5, 10 ); Curs.Val_Cur := Rendezvous_name; return Curs; end Initialize; function To_Rendezvous (Curs : in Rendezvous_Cursor_Type;Index : in Abstract_Index) return Rendezvous_Class is Rendezvous : Rendezvous_Class := Create; begin Rendezvous.info.Index := Index; Rendezvous.info.Name := new Wide_String ' (Curs.Values(Rendezvous_Name).Line(1..Curs.Values(Rendezvous_Name).Line_Last)); Rendezvous.Date := Formatting.Value(Handling.To_String(Curs.Values(Rendezvous_Date).Line(1..Curs.Values(Rendezvous_Date).Line_Last))); Rendezvous.Period := Duration(Float'Value(Handling.To_String(Curs.Values(Rendezvous_Period).Line(1..Curs.Values(Rendezvous_Period).Line_Last))) * 60.0); Rendezvous.Locality := new Wide_String ' (Curs.Values(Rendezvous_Locality).Line(1..Curs.Values(Rendezvous_Locality).Line_Last)); Rendezvous.Define := new Wide_String ' (Curs.Values(Rendezvous_Define).Line(1..Curs.Values(Rendezvous_Define).Line_Last)); return Rendezvous; exception when others => raise Spec_Error; end To_Rendezvous; --------------------------------------------------------------------------- -- Content curs type Content_enum is (Content_None, Content_Name, Content_Description, Content_Price); type Content_Type is record Name : Content_Enum := Content_None; Line : Wstring_45 := (others => ' '); Line_Last : Natural := 0; Line_Pos : Line_Range := 1; Column_Pos : Column_Range := 1; end record; type Content_Curs_Set is array (Content_Enum) of Content_Type; type Content_Cursor_Type is record Values : Content_Curs_Set; Val_Cur : Content_Enum := Content_Name; end record; function Initialize return Content_Cursor_Type is Curs : Content_Cursor_Type; begin Curs.Values(Content_Name) := (Content_name, (others => ' '), 0, 1, 8 ); Curs.Values(Content_Description) := (Content_Description, (others => ' '), 0, 2, 9 ); Curs.Values(Content_Price) := (Content_Price, (others => ' '), 0, 3, 9 ); Curs.Val_Cur := Content_name; return Curs; end Initialize; function To_Content (Curs : in Content_Cursor_Type;Index : in Abstract_Index) return Content_Class is Content : Content_Class := Create; begin Content.info.Index := Index; Content.info.Name := new Wide_String ' (Curs.Values(Content_Name).Line(1..Curs.Values(Content_Name).Line_Last)); Content.Description := new Wide_String ' (Curs.Values(Content_Description).Line(1..Curs.Values(Content_Description).Line_Last)); Content.Price := Fixed_Unit_Ttc'Value(Handling.To_String(Curs.Values(Content_Price).Line(1..Curs.Values(Content_Price).Line_Last))); return Content; exception when others => raise Spec_Error; end To_Content; --------------------------------------------------------------------------- -- Profile curs type Profile_enum is (Profile_None, Profile_Full_Name, Profile_Born, Profile_Addr, Profile_Phone, Profile_Email); type Profile_Type is record Name : Profile_Enum := Profile_None; Line : Wstring_45 := (others => ' '); Line_Last : Natural := 0; Line_Pos : Line_Range := 1; Column_Pos : Column_Range := 1; end record; type Profile_Curs_Set is array (Profile_Enum) of Profile_Type; type Profile_Cursor_Type is record Values : Profile_Curs_Set; Val_Cur : Profile_Enum := Profile_Full_Name; end record; function Initialize return Profile_Cursor_Type is Curs : Profile_Cursor_Type; begin Curs.Values(Profile_Full_Name) := (Profile_Full_Name, (others => ' '), 0, 1, 8 ); Curs.Values(Profile_Born) := (Profile_Born, (others => ' '), 0, 2, 8 ); Curs.Values(Profile_Addr) := (Profile_Addr, (others => ' '), 0, 3, 8 ); Curs.Values(Profile_Phone) := (Profile_Phone, (others => ' '), 0, 4, 9 ); Curs.Values(Profile_Email) := (Profile_Email, (others => ' '), 0, 5, 9 ); Curs.Val_Cur := Profile_Full_Name; return Curs; end Initialize; function To_Profile (Curs : in Profile_Cursor_Type;Index : in Abstract_Index) return Profile_Class is Profile : Profile_Class := Create; begin Profile.Info.Index := Index; Profile.info.Name := new Wide_String ' (Curs.Values(Profile_Full_Name).Line(1..Curs.Values(Profile_Full_Name).Line_Last)); Profile.Full_Name := new Wide_String ' (Curs.Values(Profile_Full_Name).Line(1..Curs.Values(Profile_Full_Name).Line_Last)); Profile.Born := Formatting.Value(Handling.To_String(Curs.Values(Profile_Born).Line(1..Curs.Values(Profile_Born).Line_Last))); Profile.Addr := new Wide_String ' (Curs.Values(Profile_Addr).Line(1..Curs.Values(Profile_Addr).Line_Last)); Profile.Phone := new Wide_String ' (Curs.Values(Profile_Phone).Line(1..Curs.Values(Profile_Phone).Line_Last)); Profile.Email := new Wide_String ' (Curs.Values(Profile_Email).Line(1..Curs.Values(Profile_Email).Line_Last)); return Profile; exception when others => raise Spec_Error; end To_Profile; --------------------------------------------------------------------------- -- Universe curs type Universe_enum is (Universe_None, Universe_Name); type Universe_Type is record Name : Universe_Enum := Universe_None; Line : Wstring_45 := (others => ' '); Line_Last : Natural := 0; Line_Pos : Line_Range := 1; Column_Pos : Column_Range := 1; end record; type Universe_Curs_Set is array (Universe_Enum) of Universe_Type; type Universe_Cursor_Type is record Values : Universe_Curs_Set; Val_Cur : Universe_Enum := Universe_Name; end record; function Initialize return Universe_Cursor_Type is Curs : Universe_Cursor_Type; begin Curs.Values(Universe_Name) := (Universe_Name, (others => ' '), 0, 1, 8 ); Curs.Val_Cur := Universe_Name; return Curs; end Initialize; function To_Universe (Curs : in Universe_Cursor_Type;Index : in Abstract_Index) return Universe_Class is Universe : Universe_Class := Create; begin Universe.Info.Index := Index; Universe.info.Name := new Wide_String ' (Curs.Values(Universe_Name).Line(1..Curs.Values(Universe_Name).Line_Last)); return Universe; exception when others => raise Spec_Error; end To_Universe; --------------------------------------------------------------------------- -- Car curs type Car_enum is (Car_None, Car_Name, Car_Mark, Car_Model, Car_mat); type Car_Type is record Name : Car_Enum := Car_None; Line : Wstring_45 := (others => ' '); Line_Last : Natural := 0; Line_Pos : Line_Range := 1; Column_Pos : Column_Range := 1; end record; type Car_Curs_Set is array (Car_Enum) of Car_Type; type Car_Cursor_Type is record Values : Car_Curs_Set; Val_Cur : Car_Enum := Car_Name; end record; function Initialize return Car_Cursor_Type is Curs : Car_Cursor_Type; begin Curs.Values(Car_Name) := (Car_Name, (others => ' '), 0, 1, 8 ); Curs.Values(Car_Mark) := (Car_Mark, (others => ' '), 0, 2, 8 ); Curs.Values(Car_Model) := (Car_Model, (others => ' '), 0, 3, 9 ); Curs.Values(Car_Mat) := (Car_Mat, (others => ' '), 0, 4, 7 ); Curs.Val_Cur := Car_Name; return Curs; end Initialize; function To_Car (Curs : in Car_Cursor_Type;Index : in Abstract_Index) return Car_Class is Car : Car_Class := Create; begin Car.Info.Index := Index; Car.info.Name := new Wide_String ' (Curs.Values(Car_Name).Line(1..Curs.Values(Car_Name).Line_Last)); Car.Mark := new Wide_String ' (Curs.Values(Car_Mark).Line(1..Curs.Values(Car_Mark).Line_Last)); Car.Model := new Wide_String ' (Curs.Values(Car_Model).Line(1..Curs.Values(Car_Model).Line_Last)); Car.Mat := new Wide_String ' (Curs.Values(Car_Mat).Line(1..Curs.Values(Car_Mat).Line_Last)); return Car; exception when others => raise Spec_Error; end To_Car; --------------------------------------------------------------------------- -- House curs type House_enum is (House_None, House_Name, House_Addr, House_Surface); type House_Type is record Name : House_Enum := House_None; Line : Wstring_45 := (others => ' '); Line_Last : Natural := 0; Line_Pos : Line_Range := 1; Column_Pos : Column_Range := 1; end record; type House_Curs_Set is array (House_Enum) of House_Type; type House_Cursor_Type is record Values : House_Curs_Set; Val_Cur : House_Enum := House_Name; end record; function Initialize return House_Cursor_Type is Curs : House_Cursor_Type; begin Curs.Values(House_Name) := (House_Name, (others => ' '), 0, 1, 8 ); Curs.Values(House_addr) := (House_addr, (others => ' '), 0, 1, 8 ); Curs.Values(House_Surface) := (House_Surface, (others => ' '), 0, 1, 8 ); Curs.Val_Cur := House_Name; return Curs; end Initialize; function To_House (Curs : in House_Cursor_Type;Index : in Abstract_Index) return House_Class is House : House_Class := Create; begin House.Info.Index := Index; House.info.Name := new Wide_String ' (Curs.Values(House_Name).Line(1..Curs.Values(House_Name).Line_Last)); House.Addr := new Wide_String ' (Curs.Values(House_Addr).Line(1..Curs.Values(House_Addr).Line_Last)); House.Surf := new Wide_String ' (Curs.Values(House_Surface).Line(1..Curs.Values(House_surface).Line_Last)); return House; exception when others => raise Spec_Error; end To_house; --------------------------------------------------------------------------- -- Media curs type Media_enum is (Media_None, Media_title, Media_Author, Media_Editor); type Media_Type is record Name : Media_Enum := Media_None; Line : Wstring_45 := (others => ' '); Line_Last : Natural := 0; Line_Pos : Line_Range := 1; Column_Pos : Column_Range := 1; end record; type Media_Curs_Set is array (Media_Enum) of Media_Type; type Media_Cursor_Type is record Values : Media_Curs_Set; Val_Cur : Media_Enum := Media_Title; end record; function Initialize return Media_Cursor_Type is Curs : Media_Cursor_Type; begin Curs.Values(Media_title) := (Media_Title, (others => ' '), 0, 1, 9 ); Curs.Values(Media_Author) := (Media_Author, (others => ' '), 0, 2, 10 );Curs.Values(Media_Editor) := (Media_Editor, (others => ' '), 0, 3, 10 ); Curs.Val_Cur := Media_Title; return Curs; end Initialize; function To_CDROM (Curs : in Media_Cursor_Type;Index : in Abstract_Index) return CDROM_Class is CDROM : CDROM_Class := Create; begin CDROM.Info.Index := Index; CDROM.info.Name := new Wide_String ' (Curs.Values(Media_title).Line(1..Curs.Values(Media_title).Line_Last)); CDROM.Author := new Wide_String ' (Curs.Values(Media_Author).Line(1..Curs.Values(Media_Author).Line_Last)); CDROM.Editor := new Wide_String ' (Curs.Values(Media_Editor).Line(1..Curs.Values(Media_Editor).Line_Last)); return CDROM; exception when others => raise Spec_Error; end To_CDROM; function To_DVD (Curs : in Media_Cursor_Type;Index : in Abstract_Index) return DVD_Class is DVD : DVD_Class := Create; begin DVD.Info.Index := Index; DVD.info.Name := new Wide_String ' (Curs.Values(Media_title).Line(1..Curs.Values(Media_title).Line_Last)); DVD.Author := new Wide_String ' (Curs.Values(Media_Author).Line(1..Curs.Values(Media_Author).Line_Last)); DVD.Editor := new Wide_String ' (Curs.Values(Media_Editor).Line(1..Curs.Values(Media_Editor).Line_Last)); return DVD; exception when others => raise Spec_Error; end To_DVD; function To_Book (Curs : in Media_Cursor_Type;Index : in Abstract_Index) return Book_Class is Book : Book_Class := Create; begin Book.Info.Index := Index; Book.info.Name := new Wide_String ' (Curs.Values(Media_title).Line(1..Curs.Values(Media_title).Line_Last)); Book.Author := new Wide_String ' (Curs.Values(Media_Author).Line(1..Curs.Values(Media_Author).Line_Last)); Book.Editor := new Wide_String ' (Curs.Values(Media_Editor).Line(1..Curs.Values(Media_Editor).Line_Last)); return Book; exception when others => raise Spec_Error; end To_Book; function Child (Cur : in Abstract_Access;Index : in Natural) return Abstract_Access is begin if Index = 0 then return Cur; end if; if Cur = null then return null; end if; return Abstract_Vectors.Element(Cur.Childs, Abstract_Index(Index)); exception when others => return null; end Child; function Child (Cur : in Abstract_Access;Name : in Wide_String) return Abstract_Access is Obj : Abstract_Access; begin if Cur = null then return null; end if; if Cur.Info.Name.all = Name then return Cur; end if; if not Abstract_Vectors.Is_Empty(Cur.Childs) then for Child in 1..Abstract_Vectors.Length(Cur.Childs) loop declare E : constant Abstract_Access := Abstract_Vectors.Element(Cur.Childs, Abstract_Index(Child)); begin if E.Info.Name /= null and then E.Info.Name.all = Name then return E; end if; end; end loop; end if; return null; end Child; function To_String(Info : in Abstract_Info) return Wide_String is begin if Info.Name = null then raise Program_Error; end if; return Handling.To_Wide_String(Abstract_Index'Image(Info.Index)) & " " & Handling.To_Wide_String(Class_Enum'Image(Info.Tag)) & " " & Info.Name.all & " " & Handling.To_Wide_String(Formatting.Image(Info.Created)); end To_String; function To_Tree(Info : in Abstract_Info; Level : in Natural) return Wide_String is begin if Info.Name = null then raise Program_Error; end if; return Wide_Fixed."*"(Level, ' ') & '+' & ' ' & Handling.To_Wide_String(Abstract_Index'Image(Info.Index)) & " " & Handling.To_Wide_String(Class_Enum'Image(Info.Tag)) & " " & Info.Name.all & " " & Handling.To_Wide_String(Formatting.Image(Info.Created)); end To_Tree; procedure Tree (Obj : in Abstract_Access; Level : in Natural; Set : in out Wide_Set; Last : in out Natural) is begin if Obj /= null then if Level = 0 then Add_Line(Set, Last, To_tree(Obj.Info, Level+1)); end if; if not Abstract_Vectors.Is_Empty(Obj.Childs) then Add_Line(Set, Last, Wide_Fixed."*"(Level+1, ' ') & "| "); for Child in 1..Abstract_Vectors.Length(Obj.Childs) loop declare E : Abstract_Access := Abstract_Vectors.Element(Obj.Childs, Abstract_Index(Child)); begin Add_Line(Set, Last, To_tree(E.Info, Level+2)); Tree(E, Level+3, Set, Last); end; end loop; end if; end if; end Tree; procedure Tree_Free (O : in out Abstract_Access) is begin if O = null then return; end if; if Abstract_Vectors.Length(O.Childs) /= 0 then for Child in 1 .. Abstract_Index(Abstract_Vectors.Length(O.Childs)) loop declare E : Abstract_Access := Abstract_Vectors.Element(O.Childs, Child); begin Tree_Free(E); end; end loop; end if; Obj_free(O); end Tree_Free; procedure Remove (T : in out Terminal_Type; Index : in Abstract_Index) is begin if Index > Abstract_Index(Abstract_Vectors.Length(T.Cur.Childs)) then return; end if; declare E : Abstract_Access := Abstract_Vectors.Element(T.Cur.Childs, Index); begin Tree_Free(E); end; Abstract_Vectors.Delete(T.Cur.Childs, Index); T.Cur.Info.Childs_Num := T.Cur.Info.Childs_Num - 1; if not Abstract_Vectors.Is_empty(T.Cur.Childs)and then Index <= Abstract_Index(Abstract_Vectors.Length(T.Cur.Childs)) then for Child in Index .. Abstract_Index(Abstract_Vectors.Length(T.Cur.Childs)) loop declare E : constant Abstract_Access := Abstract_Vectors.Element(T.Cur.Childs, Index); begin E.Info.Index := E.Info.Index - 1; end; end loop; end if; end Remove; procedure Object_Help(Win : in Window_Record; Win_Index : in out Positive) is Index : Natural := 0; begin Draw_Text(Win, Win_Index, 3, Red, "help : "); Draw_Text(Win, Win_Index+1, 3, Cyan, "Classes : ("); for I in 1..Class_Enum'Pos(Class_Enum'Last) loop Draw_Text(Win, Win_Index+2+index, 3, Cyan, Handling.To_Wide_String(Class_Enum'Image(Class_Enum'Val(i)))); Index := Index + 1; end loop; Draw_Text(Win, Win_Index+2+Index, 3, Cyan, ")"); Index := 0; Draw_Text(Win, Win_Index+2, 15, Cyan, "Commands : ("); for I in 1..Class_Cmd_Enum'Pos(Class_Cmd_Enum'Last) loop Draw_Text(Win, Win_Index+3+index, 15, Cyan, Handling.To_Wide_String(Class_Cmd_Enum'image(Class_Cmd_Enum'Val(I)))); Index := Index + 1; end loop; Draw_Text(Win, Win_Index+3+Index, 15, Cyan, ")"); Index := 0; Draw_Text(Win, Win_Index+2, 29, Cyan, "Attributs : ("); for I in 1..Attribut_Enum'Pos(Attribut_Enum'Last) loop Draw_Text(Win, Win_Index+3+index, 29, Cyan, Handling.To_Wide_String(Attribut_Enum'image(Attribut_Enum'Val(I)))); Index := Index + 1; end loop; Draw_Text(Win, Win_Index+3+Index, 29, Cyan, ")"); Index := 0; Draw_Text(Win, Win_Index+2, 43, Cyan, "BINARIES : ("); for I in 0..boolean'Pos(Boolean'Last) loop Draw_Text(Win, Win_Index+3+index, 43, Cyan, Handling.To_Wide_String(boolean'image(boolean'Val(I)))); Index := Index + 1; end loop; Draw_Text(Win, Win_Index+3+Index, 43, Cyan, ")"); Index := Index + 1; end Object_Help; ----------------------------------- -- Organizer process -- ----------------------------------- task body Organizer_Process is Win_Index : Natural := 1; Attribute_Curs : Attribute_Cursor_Type; Universe_Curs : Universe_Cursor_Type; Profile_Curs : Profile_Cursor_Type; Event_Curs : Event_Cursor_Type; Job_Curs : Job_Cursor_Type; Meeting_Curs : Meeting_Cursor_Type; Rendezvous_Curs : Rendezvous_Cursor_Type; Content_Curs : Content_Cursor_Type; Planning_Curs : Planning_Cursor_Type; Media_Curs : Media_Cursor_Type; Car_Curs : Car_Cursor_Type; House_Curs : House_Cursor_Type; Obj_Tag : Class_Enum := None; Cmd_Line : Wide_String (1..App.Columns/2-6); Line_Last : Natural := 0; Cmd : Class_Cmd_Enum := Null_cmd; Organizer : Organizer_Type; Verax : Boolean := False; Top : Natural := 0; In_Print : Boolean := False; Print_Index : Natural := 0; Printed : Abstract_Access; Path_Index : Natural := 0; Success : Boolean := False; Childs_Set : Wide_Set(4096); Line_Index : Natural := 0; Last : Natural := 0; Total_Line : Natural := 0; Level : Natural := 0; Is_Initialized : Boolean := False; Child_Index : Abstract_Index := 1; On_List : Boolean := False; On_Tree : Boolean := False; Name : Os_Lib.String_Access; begin Initialize(Organizer, 0); Main_Loop: loop loop select when Obj_Tag = None and Cmd /= Attribute => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(1) => null; when Wide_Character'Val(10) => if Line_Last /= 0 then In_Print := False; Cmd := Class_Cmd_Value(Cmd_Line(1..Line_Last)); case Cmd is when Null_Cmd => null; when Help => Enlight_Window(Organizer.List_Win); Object_Help(Organizer.List_Win, Win_Index); Win_Index := 1; when Make => declare Tag_Name : Os_Lib.String_Access; begin if Wide_Fixed.Index(Cmd_Line(Cmd_Line'First..Line_Last), " ") /= 0 then Tag_Name := new String ' (Handling.To_String(Cmd_Line(Wide_Fixed.Index(Cmd_Line, " ")+1..Line_Last))); Obj_Tag := Class_Enum'Value(Tag_Name.all); case Obj_Tag is when None => null; when universe => Universe_Curs := Initialize; when Profile => Profile_Curs := Initialize; when Event => Event_Curs := Initialize; when Meeting => Meeting_Curs := Initialize; when Job => Job_Curs := Initialize; when Rendezvous => Rendezvous_Curs := Initialize; when Content => Content_Curs := Initialize; when Planning => Planning_Curs := Initialize; when Book..DVD => Media_Curs := Initialize; when Car => Car_Curs := Initialize; when House => House_Curs := Initialize; when others => null; end case; end if; exception when others => null; end; when Attribute => Attribute_Curs := Initialize; when Parent => Parent(App.Terminal); when Switch => if App.Terminal.Cur /= null then if Wide_Fixed.Index(Cmd_Line(Cmd_Line'First..Line_Last), " ") /= 0 then declare Index_name : M.Strings.Wide_String_Access; Index : Abstract_Index := 1; begin Index_name := new Wide_String ' (Cmd_Line(Wide_Fixed.Index(Cmd_Line, " ")+1..Line_Last)); Index := Abstract_Index'Value(Handling.To_String(Index_Name.all)); Switch(App.Terminal, Index, Verax); exception when others => null; end; end if; end if; when Root => App.Terminal.Cur := App.Terminal.Root; App.Terminal.Path := Abstract_Vectors.Empty_Vector; App.Terminal.Path := App.Terminal.Path & App.Terminal.Root; when Print => if App.Terminal.Cur /= null then if Wide_Fixed.Index(Cmd_Line(Cmd_Line'First..Line_Last), " ") /= 0 then declare Index_name : M.Strings.Wide_String_Access; Index : Natural := 0; begin Index_name := new Wide_String ' (Cmd_Line(Wide_Fixed.Index(Cmd_Line, " ")+1..Line_Last)); Print_Index := Natural'Value(Handling.To_String(Index_Name.all)); Printed := Child(App.Terminal.Cur, Print_Index); In_Print := True; Enlight_Window(Organizer.Obj_Header); Text_Io.Put(Normal_Mode); Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Printed.Print(Organizer.Obj_Header.Win, Organizer.Obj_Main.Win); Enlight_Window(Organizer.Obj_Attr); Text_Io.Put(Normal_Mode); Classes.Print(Printed.definition, Organizer.Obj_Attr.Win); exception when others => declare Name : M.Strings.Wide_String_Access; Index : Abstract_Index := 1; begin Index_name := new Wide_String ' (Cmd_Line(Wide_Fixed.Index(Cmd_Line, " ")+1..Line_Last)); Printed := Child(App.Terminal.Cur, Index_Name.all); In_Print := True; Enlight_Window(Organizer.Obj_Header); Text_Io.Put(Normal_Mode); Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Printed.Print(Organizer.Obj_Header.Win, Organizer.Obj_Main.Win); Enlight_Window(Organizer.Obj_Attr); Text_Io.Put(Normal_Mode); Classes.Print(Printed.definition, Organizer.Obj_Attr.Win); exception when others => null; end; end; else In_Print := True; Enlight_Window(Organizer.Obj_Header); Text_Io.Put(Normal_Mode); Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); App.Terminal.Cur.Print(Organizer.Obj_Header.Win, Organizer.Obj_Main.Win); Enlight_Window(Organizer.Obj_Attr); Text_Io.Put(Normal_Mode); Classes.Print(App.Terminal.Cur.Definition, Organizer.Obj_Attr.Win); Print_Index := 0; Printed := null; end if; end if; when Search => if App.Terminal.Cur /= null then if Wide_Fixed.Index(Cmd_Line(Cmd_Line'First..Line_Last), " ") /= 0 then declare Index_name : M.Strings.Wide_String_Access; Index : Abstract_Index := 1; begin Index_name := new Wide_String ' (Cmd_Line(Wide_Fixed.Index(Cmd_Line, " ")+1..Line_Last)); Search(App.Terminal, Index_Name.all, Path_Index, Success); if Success then Enlight_Window(Organizer.Obj_Header); Text_Io.Put(Normal_Mode); Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); App.Terminal.Cur.Print(Organizer.Obj_Header.Win, Organizer.Obj_Main.Win); Enlight_Window(Organizer.Obj_Attr); Text_Io.Put(Normal_Mode); Classes.Print(Printed.definition, Organizer.Obj_Attr.Win); In_Print := True; end if; Success := False; Path_Index := 0; exception when Constraint_Error => null; end; end if; end if; when List => Set_Free(Childs_Set); Enlight_Window(Organizer.List_Win); Text_Io.Put(Normal_Mode); Last := 0; Total_Line := 0; Line_Index := 0; On_List := True; On_Tree := False; if App.Terminal.Cur /= null then if not Abstract_Vectors.Is_Empty(App.Terminal.Cur.Childs) then for Child in 1..Abstract_Vectors.Length(App.Terminal.Cur.Childs) loop declare E : constant Abstract_Access := Abstract_Vectors.Element(App.Terminal.Cur.Childs, Abstract_Index(Child)); begin Add_Line(Childs_Set, Last, To_String(E.Info)); end; end loop; end if; end if; Success := Print_Set(Childs_Set, Organizer.List_Win, Line_Index, Total_Line); when Tree => On_Tree := True; On_List := False; Enlight_Window(Organizer.List_Win); Text_Io.Put(Normal_Mode); Total_Line := 0; Line_Index := 0; Set_Free(Childs_Set); if App.Terminal.Cur /= null then Tree(App.Terminal.Cur, Level, Childs_Set, Last); Success := Print_Set(Childs_Set, Organizer.List_Win, Line_Index, Total_Line); end if; when Remove => declare Name : M.Strings.Wide_String_Access; Index : Abstract_Index := 1; begin if Wide_Fixed.Index(Cmd_Line, " ") /= 0 then name := new Wide_String ' (Cmd_Line(Wide_Fixed.Index(Cmd_Line, " ")+1..Line_Last)); if Wide_Fixed.Index_Non_Blank(Name.all) /= 0 then Index := Abstract_Index'Value(Handling.To_String(Name.all)); Remove(App.terminal, Index); Save(App.Terminal.root, Organizer_Filename); end if; end if; if On_List then Set_Free(Childs_Set); Enlight_Window(Organizer.List_Win); Text_Io.Put(Normal_Mode); Last := 0; Total_Line := 0; Line_Index := 0; if App.Terminal.Cur /= null then if not Abstract_Vectors.Is_Empty(App.Terminal.Cur.Childs) then for Child in 1..Abstract_Vectors.Length(App.Terminal.Cur.Childs) loop declare E : constant Abstract_Access := Abstract_Vectors.Element(App.Terminal.Cur.Childs, Abstract_Index(Child)); begin Add_Line(Childs_Set, Last, To_String(E.Info)); end; end loop; end if; end if; Success := Print_Set(Childs_Set, Organizer.List_Win, Line_Index, Total_Line); elsif On_Tree then Total_Line := 0; Line_Index := 0; Enlight_Window(Organizer.List_Win); Text_Io.Put(Normal_Mode); Set_Free(Childs_Set); if App.Terminal.Cur /= null then Tree(App.Terminal.Cur, Level, Childs_Set, Last); Success := Print_Set(Childs_Set, Organizer.List_Win, Line_Index, Total_Line); end if; end if; Success := Print_Set(Childs_Set, Organizer.List_Win, Line_Index, Total_Line); exception when others => null; end; end case; end if; Line_Last := 0; when Wide_Character'Val(12) => Last := 0; Printed := null; Print_Index := 0; Initialize(Organizer, Top); Draw(Organizer, App.Terminal); Enlight_Window(Organizer.Content_Win); Text_Io.Put(Normal_Mode); Global_Content_Print(App.Terminal.Cur, Organizer.Content_Win.win); Enlight_Window(Organizer.cmd_Win); Text_Io.Put(Normal_Mode); if App.Terminal.Cur = null then Draw_Text(Organizer.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Terminal.Cur.Info.Name /= null then Draw_Text(Organizer.Cmd_Win, 1, 1, White, App.Terminal.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(Organizer.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; when Wide_Character'Val(127) => if Line_Last > 0 then Cmd_Line(Line_Last) := Wide_Character'Val(32); Line_Last := Line_Last - 1; else Text_Io.Put(Character'Val(7)); end if; when others => null; end case; else if App.Terminal.Root /= null and then App.Terminal.cur.Info.Name /= null then if Line_Last + 1 <= (Cmd_Line'Length-App.Terminal.cur.Info.Name'Length) then Cmd_Line(Line_Last + 1) := Wchar; Line_Last := Line_Last + 1; else Text_Io.Put(Character'Val(7)); end if; elsif Line_Last + 1 <= Cmd_Line'Length then Cmd_Line(Line_Last + 1) := Wchar; Line_Last := Line_Last + 1; else Text_Io.Put(Character'Val(7)); end if; end if; end Receive; Enlight_Window(Organizer.Content_Win); Text_Io.Put(Normal_Mode); Global_Content_Print(App.Terminal.Cur, Organizer.Content_Win.win); Enlight_Window(Organizer.cmd_Win); Text_Io.Put(Normal_Mode); if App.Terminal.Cur = null then Draw_Text(Organizer.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Terminal.Cur.Info.Name /= null then Draw_Text(Organizer.Cmd_Win, 1, 1, White, App.Terminal.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(Organizer.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; case Obj_Tag is when None => case Cmd is when Attribute => Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Organizer.Obj_Main, 2, 1, White, "Image : "); Draw_Text(Organizer.Obj_Main, 1, 1, White, "Name : "); for Val in Attribute_Name..Attribute_Image loop Draw_Text(Organizer.Obj_Main, Attribute_Curs.values(Val).Line_Pos, Attribute_Curs.values(Val).Column_Pos, White, Attribute_Curs.values(Val).Line(1..Attribute_Curs.values(Val).Line_Last)); end loop; Draw_Text(Organizer.Obj_Main, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Pos, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Column_Pos, White, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line(1..Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last)); when others => null; end case; when Profile => Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Organizer.Obj_Main, 2, 1, White, "Born : "); Draw_Text(Organizer.Obj_Main, 3, 1, White, "Addr : "); Draw_Text(Organizer.Obj_Main, 4, 1, White, "Phone : "); Draw_Text(Organizer.Obj_Main, 5, 1, White, "Email : "); Draw_Text(Organizer.Obj_Main, 1, 1, White, "Name : "); when Content => Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Organizer.Obj_Main, 2, 1, White, "Define : "); Draw_Text(Organizer.Obj_Main, 3, 1, White, "Price : "); Draw_Text(Organizer.Obj_Main, 1, 1, White, "Name : "); when Planning => Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Organizer.Obj_Main, 2, 1, White, "From : "); Draw_Text(Organizer.Obj_Main, 3, 1, White, "To : "); Draw_Text(Organizer.Obj_Main, 1, 1, White, "Name : "); when Universe => Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Organizer.Obj_Main, 1, 1, White, "Name : "); when Event .. Rendezvous => Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Organizer.Obj_Main, 2, 1, White, "Date : "); Draw_Text(Organizer.Obj_Main, 3, 1, White, "Period : "); Draw_Text(Organizer.Obj_Main, 4, 1, White, "Locality : "); Draw_Text(Organizer.Obj_Main, 5, 1, White, "Define : "); Draw_Text(Organizer.Obj_Main, 1, 1, White, "Name : "); when Book..CDROM => Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Organizer.Obj_Main, 2, 1, White, "Author : "); Draw_Text(Organizer.Obj_Main, 3, 1, White, "Editor : "); Draw_Text(Organizer.Obj_Main, 1, 1, White, "Title : "); when Car => Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Organizer.Obj_Main, 2, 1, White, "Mark : "); Draw_Text(Organizer.Obj_Main, 3, 1, White, "Model : "); Draw_Text(Organizer.Obj_Main, 4, 1, White, "Mat : "); Draw_Text(Organizer.Obj_Main, 1, 1, White, "Name : "); when House => Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Organizer.Obj_Main, 2, 1, White, "Addr : "); Draw_Text(Organizer.Obj_Main, 3, 1, White, "Surf : "); Draw_Text(Organizer.Obj_Main, 1, 1, White, "Name : "); when others => Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Organizer.Obj_Main, 1, 1, White, "Name : "); end case; if App.Terminal.Root /= null then Child_Index := Abstract_Index(Abstract_Vectors.Length(App.Terminal.Cur.childs)+1); else Child_Index := 1; end if; or when cmd = attribute => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(1) => Attribute_Curs := Initialize; Enlight_Window(Organizer.Obj_Header); Enlight_Window(Organizer.Obj_Main); Enlight_Window(Organizer.Obj_Attr); Text_Io.Put(Normal_Mode); Obj_Tag := None; when Wide_Character'Val(10) => if Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last /= 0 then case Attribute_Curs.Val_Cur is when Attribute_None => null; when Attribute_Name => Name := new String ' (Handling.To_String(Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line(1..Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last))); Attribute_Curs.Val_Cur := Attribute_Enum'Succ(Attribute_Curs.Val_Cur); when Attribute_Image => if App.Terminal.Cur /= null then if App.Terminal.Cur.Definition.Index < App.Terminal.Cur.Definition.List'Last then App.Terminal.Cur.Definition.List(App.Terminal.Cur.Definition.Index + 1) := Make(Name.all, Handling.To_String(Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line(1..Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last))); App.Terminal.Cur.Definition.Index := App.Terminal.Cur.Definition.Index + 1; end if; end if; attribute_Curs := Initialize; Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Free(Name); Attribute_Curs.Val_Cur := Attribute_None; Cmd := Null_cmd; Save(App.Terminal.root, Organizer_Filename); end case; else Put(Character'Val(7)); end if; when Wide_Character ' Val (127) => if Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last > 0 then Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line(Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last) := ' '; Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last := Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last - 1; end if; when others => null; end case; elsif Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last < 45 then Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line(Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last + 1) := Wchar; Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last := Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last + 1; for Val in Attribute_Name..Attribute_image loop Draw_Text(Organizer.Obj_Main, Attribute_Curs.values(Val).Line_Pos, Attribute_Curs.values(Val).Column_Pos, White, Attribute_Curs.values(Val).Line(1..Attribute_Curs.values(Val).Line_Last)); end loop; Draw_Text(Organizer.Obj_Main, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Pos, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Column_Pos, White, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line(1..Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; end Receive; case Attribute_Curs.Val_Cur is when Attribute_none => Draw(Organizer, App.Terminal); Global_Content_Print(App.Terminal.Cur, Organizer.Content_Win.win); Enlight_Window(Organizer.Obj_Main); Enlight_Window(Organizer.Obj_Attr); Text_Io.Put(Normal_Mode); if App.Terminal.Cur /= null then for I in 1..App.Terminal.Cur.Definition.Index loop Draw_Text(Organizer.Obj_Attr, I, 1, white, Handling.To_Wide_String(App.Terminal.Cur.Definition.List(I).Name.all)); Draw_Text(Organizer.Obj_Attr, I, App.Terminal.Cur.Definition.List(I).Name'Length+1, Red, "="); Draw_Text(Organizer.Obj_Attr, I, App.Terminal.Cur.Definition.List(I).Name'Length+2, white, Handling.To_Wide_String(App.Terminal.Cur.Definition.List(I).Value.all)); end loop; end if; Enlight_Window(Organizer.cmd_Win); Text_Io.Put(Normal_Mode); if App.Terminal.Cur = null then Draw_Text(Organizer.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Terminal.Cur.Info.Name /= null then Draw_Text(Organizer.Cmd_Win, 1, 1, White, App.Terminal.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(Organizer.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; when others => Draw(Organizer, App.Terminal); Global_Content_Print(App.Terminal.Cur, Organizer.Content_Win.win); Enlight_Window(Organizer.Obj_Main); Enlight_Window(Organizer.cmd_Win); Enlight_Window(Organizer.Obj_Attr); Text_Io.Put(Normal_Mode); if App.Terminal.Cur /= null then for I in 1..App.Terminal.Cur.Definition.Index loop Draw_Text(Organizer.Obj_Attr, I, 1, white, Handling.To_Wide_String(App.Terminal.Cur.Definition.List(I).Name.all)); Draw_Text(Organizer.Obj_Attr, I, App.Terminal.Cur.Definition.List(I).Name'Length+1, Red, "="); Draw_Text(Organizer.Obj_Attr, I, App.Terminal.Cur.Definition.List(I).Name'Length+2, white, Handling.To_Wide_String(App.Terminal.Cur.Definition.List(I).Value.all)); end loop; end if; if App.Terminal.Cur = null then Draw_Text(Organizer.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Terminal.Cur.Info.Name /= null then Draw_Text(Organizer.Cmd_Win, 1, 1, White, App.Terminal.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(Organizer.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; Draw_Text(Organizer.Obj_Main, 2, 1, White, "Image : "); Draw_Text(Organizer.Obj_Main, 1, 1, White, "Name : "); for Val in Attribute_Name..Attribute_Image loop Draw_Text(Organizer.Obj_Main, Attribute_Curs.values(Val).Line_Pos, Attribute_Curs.values(Val).Column_Pos, White, Attribute_Curs.values(Val).Line(1..Attribute_Curs.values(Val).Line_Last)); end loop; Draw_Text(Organizer.Obj_Main, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Pos, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Column_Pos, White, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line(1..Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last)); null; end case; or when Obj_Tag = Profile => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(1) => Profile_Curs := Initialize; Enlight_Window(Organizer.Obj_Header); Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Obj_Tag := None; when Wide_Character'Val(10) => if Profile_Curs.Values(Profile_Curs.Val_Cur).Line_Last /= 0 then case Profile_Curs.Val_Cur is when Profile_None => null; when Profile_Email => declare Profile : Profile_Class := To_Profile(Profile_Curs, Child_Index); begin Profile.Id := App.Terminal.U_Count + 1; Add_To(App.Terminal, new Profile_Class '(Profile)); Save(App.Terminal.root, Organizer_Filename); App.Terminal.U_Count := App.Terminal.U_Count + 1; end; Profile_Curs := Initialize; Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Obj_Tag := None; when others => Profile_Curs.Val_Cur := Profile_Enum'Succ(Profile_Curs.Val_Cur); end case; Draw_Text(Organizer.Obj_Main, Profile_Curs.Values(Profile_Curs.Val_Cur).Line_Pos, Profile_Curs.Values(Profile_Curs.Val_Cur).Column_Pos, White, Profile_Curs.Values(Profile_Curs.Val_Cur).Line(1..Profile_Curs.Values(Profile_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; when Wide_Character ' Val (127) => if Profile_Curs.Values(Profile_Curs.Val_Cur).Line_Last > 0 then Profile_Curs.Values(Profile_Curs.Val_Cur).Line(Profile_Curs.Values(Profile_Curs.Val_Cur).Line_Last) := ' '; Profile_Curs.Values(Profile_Curs.Val_Cur).Line_Last := Profile_Curs.Values(Profile_Curs.Val_Cur).Line_Last - 1; end if; Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Organizer.Obj_Main, 2, 1, White, "Born : "); Draw_Text(Organizer.Obj_Main, 3, 1, White, "Addr : "); Draw_Text(Organizer.Obj_Main, 4, 1, White, "Phone : "); Draw_Text(Organizer.Obj_Main, 5, 1, White, "Email : "); Draw_Text(Organizer.Obj_Main, 1, 1, White, "Name : "); for Val in Profile_Full_Name..Profile_Email loop Draw_Text(Organizer.Obj_Main, Profile_Curs.values(Val).Line_Pos, Profile_Curs.values(Val).Column_Pos, White, Profile_Curs.values(Val).Line(1..Profile_Curs.values(Val).Line_Last)); end loop; Draw_Text(Organizer.Obj_Main, Profile_Curs.Values(Profile_Curs.Val_Cur).Line_Pos, Profile_Curs.Values(Profile_Curs.Val_Cur).Column_Pos, White, Profile_Curs.Values(Profile_Curs.Val_Cur).Line(1..Profile_Curs.Values(Profile_Curs.Val_Cur).Line_Last)); when others => null; end case; elsif Profile_Curs.Values(Profile_Curs.Val_Cur).Line_Last < 45 then Profile_Curs.Values(Profile_Curs.Val_Cur).Line(Profile_Curs.Values(Profile_Curs.Val_Cur).Line_Last + 1) := Wchar; Profile_Curs.Values(Profile_Curs.Val_Cur).Line_Last := Profile_Curs.Values(Profile_Curs.Val_Cur).Line_Last + 1; else Put(Character'Val(7)); end if; end Receive; Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Organizer.Obj_Main, 2, 1, White, "Born : "); Draw_Text(Organizer.Obj_Main, 3, 1, White, "Addr : "); Draw_Text(Organizer.Obj_Main, 4, 1, White, "Phone : "); Draw_Text(Organizer.Obj_Main, 5, 1, White, "Email : "); Draw_Text(Organizer.Obj_Main, 1, 1, White, "Name : "); for Val in Profile_Full_Name..Profile_Email loop Draw_Text(Organizer.Obj_Main, Profile_Curs.values(Val).Line_Pos, Profile_Curs.values(Val).Column_Pos, White, Profile_Curs.values(Val).Line(1..Profile_Curs.values(Val).Line_Last)); end loop; Draw_Text(Organizer.Obj_Main, Profile_Curs.Values(Profile_Curs.Val_Cur).Line_Pos, Profile_Curs.Values(Profile_Curs.Val_Cur).Column_Pos, White, Profile_Curs.Values(Profile_Curs.Val_Cur).Line(1..Profile_Curs.Values(Profile_Curs.Val_Cur).Line_Last)); case Obj_Tag is when None => Draw(Organizer, App.Terminal); Global_Content_Print(App.Terminal.Cur, Organizer.Content_Win.win); Enlight_Window(Organizer.cmd_Win); Text_Io.Put(Normal_Mode); if App.Terminal.Root = null then Draw_Text(Organizer.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Terminal.Cur.Info.Name /= null then Draw_Text(Organizer.Cmd_Win, 1, 1, White, App.Terminal.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(Organizer.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; when others => null; end case; or when Obj_Tag = Content => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(1) => Content_Curs := Initialize; Enlight_Window(Organizer.Obj_Header); Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Obj_Tag := None; when Wide_Character'Val(10) => if Content_Curs.Values(Content_Curs.Val_Cur).Line_Last /= 0 then case Content_Curs.Val_Cur is when Content_None => null; when Content_Price => declare Content : constant Content_Class := To_Content(Content_Curs, Child_Index); begin Add_To(App.Terminal, new Content_Class '(Content)); Save(App.Terminal.root, Organizer_Filename); end; Content_Curs := Initialize; Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Obj_Tag := None; when others => Content_Curs.Val_Cur := Content_Enum'Succ(Content_Curs.Val_Cur); end case; Draw_Text(Organizer.Obj_Main, Content_Curs.Values(Content_Curs.Val_Cur).Line_Pos, Content_Curs.Values(Content_Curs.Val_Cur).Column_Pos, White, Content_Curs.Values(Content_Curs.Val_Cur).Line(1..Content_Curs.Values(Content_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; when Wide_Character ' Val (127) => if Content_Curs.Values(Content_Curs.Val_Cur).Line_Last > 0 then Content_Curs.Values(Content_Curs.Val_Cur).Line(Content_Curs.Values(Content_Curs.Val_Cur).Line_Last) := ' '; Content_Curs.Values(Content_Curs.Val_Cur).Line_Last := Content_Curs.Values(Content_Curs.Val_Cur).Line_Last - 1; end if; Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Organizer.Obj_Main, 2, 1, White, "Define : "); Draw_Text(Organizer.Obj_Main, 3, 1, White, "Price : "); Draw_Text(Organizer.Obj_Main, 1, 1, White, "Name : "); for Val in Content_Name..Content_Price loop Draw_Text(Organizer.Obj_Main, Content_Curs.values(Val).Line_Pos, Content_Curs.values(Val).Column_Pos, White, Content_Curs.values(Val).Line(1..Content_Curs.values(Val).Line_Last)); end loop; Draw_Text(Organizer.Obj_Main, Content_Curs.Values(Content_Curs.Val_Cur).Line_Pos, Content_Curs.Values(Content_Curs.Val_Cur).Column_Pos, White, Content_Curs.Values(Content_Curs.Val_Cur).Line(1..Content_Curs.Values(Content_Curs.Val_Cur).Line_Last)); when others => null; end case; elsif Content_Curs.Values(Content_Curs.Val_Cur).Line_Last < 45 then Content_Curs.Values(Content_Curs.Val_Cur).Line(Content_Curs.Values(Content_Curs.Val_Cur).Line_Last + 1) := Wchar; Content_Curs.Values(Content_Curs.Val_Cur).Line_Last := Content_Curs.Values(Content_Curs.Val_Cur).Line_Last + 1; for Val in Content_Name..Content_Price loop Draw_Text(Organizer.Obj_Main, Content_Curs.values(Val).Line_Pos, Content_Curs.values(Val).Column_Pos, White, Content_Curs.values(Val).Line(1..Content_Curs.values(Val).Line_Last)); end loop; Draw_Text(Organizer.Obj_Main, Content_Curs.Values(Content_Curs.Val_Cur).Line_Pos, Content_Curs.Values(Content_Curs.Val_Cur).Column_Pos, White, Content_Curs.Values(Content_Curs.Val_Cur).Line(1..Content_Curs.Values(Content_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; end Receive; case Obj_Tag is when None => Draw(Organizer, App.Terminal); Global_Content_Print(App.Terminal.Cur, Organizer.Content_Win.win); Enlight_Window(Organizer.cmd_Win); Text_Io.Put(Normal_Mode); if App.Terminal.Cur = null then Draw_Text(Organizer.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Terminal.Cur.Info.Name /= null then Draw_Text(Organizer.Cmd_Win, 1, 1, White, App.Terminal.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(Organizer.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; when others => null; end case; or when Obj_Tag = Planning => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(1) => Planning_Curs := Initialize; Enlight_Window(Organizer.Obj_Header); Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Obj_Tag := None; when Wide_Character'Val(10) => if Planning_Curs.Values(Planning_Curs.Val_Cur).Line_Last /= 0 then case Planning_Curs.Val_Cur is when Planning_None => null; when Planning_To => declare Planning : constant Planning_Class := To_Planning(Planning_Curs, Child_Index); begin Add_To(App.Terminal, new Planning_Class '(Planning)); Save(App.Terminal.root, Organizer_Filename); end; Planning_Curs := Initialize; Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Obj_Tag := None; when others => Planning_Curs.Val_Cur := Planning_Enum'Succ(Planning_Curs.Val_Cur); end case; Draw_Text(Organizer.Obj_Main, Planning_Curs.Values(Planning_Curs.Val_Cur).Line_Pos, Planning_Curs.Values(Planning_Curs.Val_Cur).Column_Pos, White, Planning_Curs.Values(Planning_Curs.Val_Cur).Line(1..Planning_Curs.Values(Planning_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; when Wide_Character ' Val (127) => if Planning_Curs.Values(Planning_Curs.Val_Cur).Line_Last > 0 then Planning_Curs.Values(Planning_Curs.Val_Cur).Line(Planning_Curs.Values(Planning_Curs.Val_Cur).Line_Last) := ' '; Planning_Curs.Values(Planning_Curs.Val_Cur).Line_Last := Planning_Curs.Values(Planning_Curs.Val_Cur).Line_Last - 1; end if; Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Organizer.Obj_Main, 2, 1, White, "From : "); Draw_Text(Organizer.Obj_Main, 3, 1, White, "To : "); Draw_Text(Organizer.Obj_Main, 1, 1, White, "Name : "); for Val in Planning_Name..Planning_To loop Draw_Text(Organizer.Obj_Main, Planning_Curs.values(Val).Line_Pos, Planning_Curs.values(Val).Column_Pos, White, Planning_Curs.values(Val).Line(1..Planning_Curs.values(Val).Line_Last)); end loop; Draw_Text(Organizer.Obj_Main, Planning_Curs.Values(Planning_Curs.Val_Cur).Line_Pos, Planning_Curs.Values(Planning_Curs.Val_Cur).Column_Pos, White, Planning_Curs.Values(Planning_Curs.Val_Cur).Line(1..Planning_Curs.Values(Planning_Curs.Val_Cur).Line_Last)); when others => null; end case; elsif Planning_Curs.Values(Planning_Curs.Val_Cur).Line_Last < 45 then Planning_Curs.Values(Planning_Curs.Val_Cur).Line(Planning_Curs.Values(Planning_Curs.Val_Cur).Line_Last + 1) := Wchar; Planning_Curs.Values(Planning_Curs.Val_Cur).Line_Last := Planning_Curs.Values(Planning_Curs.Val_Cur).Line_Last + 1; for Val in Planning_Name..Planning_To loop Draw_Text(Organizer.Obj_Main, Planning_Curs.values(Val).Line_Pos, Planning_Curs.values(Val).Column_Pos, White, Planning_Curs.values(Val).Line(1..Planning_Curs.values(Val).Line_Last)); end loop; Draw_Text(Organizer.Obj_Main, Planning_Curs.Values(Planning_Curs.Val_Cur).Line_Pos, Planning_Curs.Values(Planning_Curs.Val_Cur).Column_Pos, White, Planning_Curs.Values(Planning_Curs.Val_Cur).Line(1..Planning_Curs.Values(Planning_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; end Receive; case Obj_Tag is when None => Draw(Organizer, App.Terminal); Global_Content_Print(App.Terminal.Cur, Organizer.Content_Win.win); Enlight_Window(Organizer.cmd_Win); Text_Io.Put(Normal_Mode); if App.Terminal.Cur = null then Draw_Text(Organizer.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Terminal.Cur.Info.Name /= null then Draw_Text(Organizer.Cmd_Win, 1, 1, White, App.Terminal.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(Organizer.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; when others => null; end case; or when Obj_Tag = Event => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(1) => Event_Curs := Initialize; Enlight_Window(Organizer.Obj_Header); Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Obj_Tag := None; when Wide_Character'Val(10) => if Event_Curs.Values(Event_Curs.Val_Cur).Line_Last /= 0 then case Event_Curs.Val_Cur is when Event_None => null; when Event_Define => declare Event : constant Event_Class := To_Event(Event_Curs, Child_Index); begin Add_To(App.Terminal, new Event_Class '(Event)); Save(App.Terminal.root, Organizer_Filename); end; Event_Curs := Initialize; Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Obj_Tag := None; when others => Event_Curs.Val_Cur := Event_Enum'Succ(Event_Curs.Val_Cur); end case; Draw_Text(Organizer.Obj_Main, Event_Curs.Values(Event_Curs.Val_Cur).Line_Pos, Event_Curs.Values(Event_Curs.Val_Cur).Column_Pos, White, Event_Curs.Values(Event_Curs.Val_Cur).Line(1..Event_Curs.Values(Event_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; when Wide_Character ' Val (127) => if Event_Curs.Values(Event_Curs.Val_Cur).Line_Last > 0 then Event_Curs.Values(Event_Curs.Val_Cur).Line(Event_Curs.Values(Event_Curs.Val_Cur).Line_Last) := ' '; Event_Curs.Values(Event_Curs.Val_Cur).Line_Last := Event_Curs.Values(Event_Curs.Val_Cur).Line_Last - 1; end if; Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Organizer.Obj_Main, 2, 1, White, "Date : "); Draw_Text(Organizer.Obj_Main, 3, 1, White, "Period : "); Draw_Text(Organizer.Obj_Main, 4, 1, White, "Locality : "); Draw_Text(Organizer.Obj_Main, 5, 1, White, "Define : "); Draw_Text(Organizer.Obj_Main, 1, 1, White, "Name : "); for Val in Event_Name..Event_Define loop Draw_Text(Organizer.Obj_Main, Event_Curs.values(Val).Line_Pos, Event_Curs.values(Val).Column_Pos, White, Event_Curs.values(Val).Line(1..Event_Curs.values(Val).Line_Last)); end loop; Draw_Text(Organizer.Obj_Main, Event_Curs.Values(Event_Curs.Val_Cur).Line_Pos, Event_Curs.Values(Event_Curs.Val_Cur).Column_Pos, White, Event_Curs.Values(Event_Curs.Val_Cur).Line(1..Event_Curs.Values(Event_Curs.Val_Cur).Line_Last)); when others => null; end case; elsif Event_Curs.Values(Event_Curs.Val_Cur).Line_Last < 45 then Event_Curs.Values(Event_Curs.Val_Cur).Line(Event_Curs.Values(Event_Curs.Val_Cur).Line_Last + 1) := Wchar; Event_Curs.Values(Event_Curs.Val_Cur).Line_Last := Event_Curs.Values(Event_Curs.Val_Cur).Line_Last + 1; for Val in Event_Name..Event_Define loop Draw_Text(Organizer.Obj_Main, Event_Curs.values(Val).Line_Pos, Event_Curs.values(Val).Column_Pos, White, Event_Curs.values(Val).Line(1..Event_Curs.values(Val).Line_Last)); end loop; Draw_Text(Organizer.Obj_Main, Event_Curs.Values(Event_Curs.Val_Cur).Line_Pos, Event_Curs.Values(Event_Curs.Val_Cur).Column_Pos, White, Event_Curs.Values(Event_Curs.Val_Cur).Line(1..Event_Curs.Values(Event_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; end Receive; case Obj_Tag is when None => Draw(Organizer, App.Terminal); Global_Content_Print(App.Terminal.Cur, Organizer.Content_Win.win); Enlight_Window(Organizer.cmd_Win); Text_Io.Put(Normal_Mode); if App.Terminal.Cur = null then Draw_Text(Organizer.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Terminal.Cur.Info.Name /= null then Draw_Text(Organizer.Cmd_Win, 1, 1, White, App.Terminal.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(Organizer.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; when others => null; end case; or when Obj_Tag = Job => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(1) => Job_Curs := Initialize; Enlight_Window(Organizer.Obj_Header); Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Obj_Tag := None; when Wide_Character'Val(10) => if Job_Curs.Values(Job_Curs.Val_Cur).Line_Last /= 0 then case Job_Curs.Val_Cur is when Job_None => null; when Job_Define => declare Job : constant Job_Class := To_Job(Job_Curs, Child_Index); begin Add_To(App.Terminal, new Job_Class '(Job)); Save(App.Terminal.root, Organizer_Filename); end; Job_Curs := Initialize; Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Obj_Tag := None; when others => Job_Curs.Val_Cur := Job_Enum'Succ(Job_Curs.Val_Cur); end case; Draw_Text(Organizer.Obj_Main, Job_Curs.Values(Job_Curs.Val_Cur).Line_Pos, Job_Curs.Values(Job_Curs.Val_Cur).Column_Pos, White, Job_Curs.Values(Job_Curs.Val_Cur).Line(1..Job_Curs.Values(Job_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; when Wide_Character ' Val (127) => if Job_Curs.Values(Job_Curs.Val_Cur).Line_Last > 0 then Job_Curs.Values(Job_Curs.Val_Cur).Line(Job_Curs.Values(Job_Curs.Val_Cur).Line_Last) := ' '; Job_Curs.Values(Job_Curs.Val_Cur).Line_Last := Job_Curs.Values(Job_Curs.Val_Cur).Line_Last - 1; end if; Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Organizer.Obj_Main, 2, 1, White, "Date : "); Draw_Text(Organizer.Obj_Main, 3, 1, White, "Period : "); Draw_Text(Organizer.Obj_Main, 4, 1, White, "Locality : "); Draw_Text(Organizer.Obj_Main, 5, 1, White, "Define : "); Draw_Text(Organizer.Obj_Main, 1, 1, White, "Name : "); for Val in Job_Name..Job_Define loop Draw_Text(Organizer.Obj_Main, Job_Curs.values(Val).Line_Pos, Job_Curs.values(Val).Column_Pos, White, Job_Curs.values(Val).Line(1..Job_Curs.values(Val).Line_Last)); end loop; Draw_Text(Organizer.Obj_Main, Job_Curs.Values(Job_Curs.Val_Cur).Line_Pos, Job_Curs.Values(Job_Curs.Val_Cur).Column_Pos, White, Job_Curs.Values(Job_Curs.Val_Cur).Line(1..Job_Curs.Values(Job_Curs.Val_Cur).Line_Last)); when others => null; end case; elsif Job_Curs.Values(Job_Curs.Val_Cur).Line_Last < 45 then Job_Curs.Values(Job_Curs.Val_Cur).Line(Job_Curs.Values(Job_Curs.Val_Cur).Line_Last + 1) := Wchar; Job_Curs.Values(Job_Curs.Val_Cur).Line_Last := Job_Curs.Values(Job_Curs.Val_Cur).Line_Last + 1; for Val in Job_Name..Job_Define loop Draw_Text(Organizer.Obj_Main, Job_Curs.values(Val).Line_Pos, Job_Curs.values(Val).Column_Pos, White, Job_Curs.values(Val).Line(1..Job_Curs.values(Val).Line_Last)); end loop; Draw_Text(Organizer.Obj_Main, Job_Curs.Values(Job_Curs.Val_Cur).Line_Pos, Job_Curs.Values(Job_Curs.Val_Cur).Column_Pos, White, Job_Curs.Values(Job_Curs.Val_Cur).Line(1..Job_Curs.Values(Job_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; end Receive; case Obj_Tag is when None => Draw(Organizer, App.Terminal); Global_Content_Print(App.Terminal.Cur, Organizer.Content_Win.win); Enlight_Window(Organizer.cmd_Win); Text_Io.Put(Normal_Mode); if App.Terminal.Cur = null then Draw_Text(Organizer.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Terminal.Cur.Info.Name /= null then Draw_Text(Organizer.Cmd_Win, 1, 1, White, App.Terminal.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(Organizer.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; when others => null; end case; or when Obj_Tag = Meeting => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(1) => Meeting_Curs := Initialize; Enlight_Window(Organizer.Obj_Header); Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Obj_Tag := None; when Wide_Character'Val(10) => if Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line_Last /= 0 then case Meeting_Curs.Val_Cur is when Meeting_None => null; when Meeting_Define => declare Meeting : constant Meeting_Class := To_Meeting(Meeting_Curs, Child_index); begin Add_To(App.Terminal, new Meeting_Class '(Meeting)); Save(App.Terminal.root, Organizer_Filename); end; Meeting_Curs := Initialize; Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Obj_Tag := None; when others => Meeting_Curs.Val_Cur := Meeting_Enum'Succ(Meeting_Curs.Val_Cur); end case; Draw_Text(Organizer.Obj_Main, Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line_Pos, Meeting_Curs.Values(Meeting_Curs.Val_Cur).Column_Pos, White, Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line(1..Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; when Wide_Character ' Val (127) => if Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line_Last > 0 then Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line(Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line_Last) := ' '; Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line_Last := Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line_Last - 1; end if; Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Organizer.Obj_Main, 2, 1, White, "Date : "); Draw_Text(Organizer.Obj_Main, 3, 1, White, "Period : "); Draw_Text(Organizer.Obj_Main, 4, 1, White, "Locality : "); Draw_Text(Organizer.Obj_Main, 5, 1, White, "Define : "); Draw_Text(Organizer.Obj_Main, 1, 1, White, "Name : "); for Val in Meeting_Name..Meeting_Define loop Draw_Text(Organizer.Obj_Main, Meeting_Curs.values(Val).Line_Pos, Meeting_Curs.values(Val).Column_Pos, White, Meeting_Curs.values(Val).Line(1..Meeting_Curs.values(Val).Line_Last)); end loop; Draw_Text(Organizer.Obj_Main, Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line_Pos, Meeting_Curs.Values(Meeting_Curs.Val_Cur).Column_Pos, White, Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line(1..Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line_Last)); when others => null; end case; elsif Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line_Last < 45 then Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line(Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line_Last + 1) := Wchar; Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line_Last := Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line_Last + 1; for Val in Meeting_Name..Meeting_Define loop Draw_Text(Organizer.Obj_Main, Meeting_Curs.values(Val).Line_Pos, Meeting_Curs.values(Val).Column_Pos, White, Meeting_Curs.values(Val).Line(1..Meeting_Curs.values(Val).Line_Last)); end loop; Draw_Text(Organizer.Obj_Main, Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line_Pos, Meeting_Curs.Values(Meeting_Curs.Val_Cur).Column_Pos, White, Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line(1..Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; end Receive; case Obj_Tag is when None => Draw(Organizer, App.Terminal); Global_Content_Print(App.Terminal.Cur, Organizer.Content_Win.win); Enlight_Window(Organizer.cmd_Win); Text_Io.Put(Normal_Mode); if App.Terminal.Cur = null then Draw_Text(Organizer.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Terminal.Cur.Info.Name /= null then Draw_Text(Organizer.Cmd_Win, 1, 1, White, App.Terminal.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(Organizer.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; when others => null; end case; or when Obj_Tag = Rendezvous => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(1) => Rendezvous_Curs := Initialize; Enlight_Window(Organizer.Obj_Header); Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Obj_Tag := None; when Wide_Character'Val(10) => if Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line_Last /= 0 then case Rendezvous_Curs.Val_Cur is when Rendezvous_None => null; when Rendezvous_Define => declare Rendezvous : constant Rendezvous_Class := To_Rendezvous(Rendezvous_Curs, Child_Index); begin Add_To(App.Terminal, new Rendezvous_Class '(Rendezvous)); Save(App.Terminal.root, Organizer_Filename); end; Rendezvous_Curs := Initialize; Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Obj_Tag := None; when others => Rendezvous_Curs.Val_Cur := Rendezvous_Enum'Succ(Rendezvous_Curs.Val_Cur); end case; Draw_Text(Organizer.Obj_Main, Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line_Pos, Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Column_Pos, White, Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line(1..Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; when Wide_Character ' Val (127) => if Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line_Last > 0 then Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line(Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line_Last) := ' '; Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line_Last := Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line_Last - 1; end if; Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Organizer.Obj_Main, 2, 1, White, "Date : "); Draw_Text(Organizer.Obj_Main, 3, 1, White, "Period : "); Draw_Text(Organizer.Obj_Main, 4, 1, White, "Locality : "); Draw_Text(Organizer.Obj_Main, 5, 1, White, "Define : "); Draw_Text(Organizer.Obj_Main, 1, 1, White, "Name : "); for Val in Rendezvous_Name..Rendezvous_Define loop Draw_Text(Organizer.Obj_Main, Rendezvous_Curs.values(Val).Line_Pos, Rendezvous_Curs.values(Val).Column_Pos, White, Rendezvous_Curs.values(Val).Line(1..Rendezvous_Curs.values(Val).Line_Last)); end loop; Draw_Text(Organizer.Obj_Main, Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line_Pos, Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Column_Pos, White, Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line(1..Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line_Last)); when others => null; end case; elsif Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line_Last < 45 then Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line(Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line_Last + 1) := Wchar; Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line_Last := Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line_Last + 1; for Val in Rendezvous_Name..Rendezvous_Define loop Draw_Text(Organizer.Obj_Main, Rendezvous_Curs.values(Val).Line_Pos, Rendezvous_Curs.values(Val).Column_Pos, White, Rendezvous_Curs.values(Val).Line(1..Rendezvous_Curs.values(Val).Line_Last)); end loop; Draw_Text(Organizer.Obj_Main, Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line_Pos, Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Column_Pos, White, Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line(1..Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; end Receive; case Obj_Tag is when None => Draw(Organizer, App.Terminal); Global_Content_Print(App.Terminal.Cur, Organizer.Content_Win.win); Enlight_Window(Organizer.cmd_Win); Text_Io.Put(Normal_Mode); if App.Terminal.Cur = null then Draw_Text(Organizer.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Terminal.Cur.Info.Name /= null then Draw_Text(Organizer.Cmd_Win, 1, 1, White, App.Terminal.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(Organizer.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; when others => null; end case; or when Obj_Tag = Universe => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(1) => Content_Curs := Initialize; Enlight_Window(Organizer.Obj_Header); Enlight_Window(Organizer.Obj_Main); Enlight_Window(Organizer.Obj_Attr); Text_Io.Put(Normal_Mode); Obj_Tag := None; when Wide_Character'Val(10) => if Universe_Curs.Values(Universe_Curs.Val_Cur).Line_Last /= 0 then case Universe_Curs.Val_Cur is when Universe_None => null; when Universe_Name => declare Universe : constant Universe_Class := To_Universe(Universe_Curs, Child_index); begin Add_To(App.Terminal, new Universe_Class '(Universe)); Save(App.Terminal.root, Organizer_Filename); end; -------------------------------- Universe_Curs := Initialize; -------------------------------- Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Obj_Tag := None; when others => Universe_Curs.Val_Cur := Universe_Enum'Succ(Universe_Curs.Val_Cur); end case; else Put(Character'Val(7)); end if; when Wide_Character ' Val (127) => if Universe_Curs.Values(Universe_Curs.Val_Cur).Line_Last > 0 then Universe_Curs.Values(Universe_Curs.Val_Cur).Line(Universe_Curs.Values(Universe_Curs.Val_Cur).Line_Last) := ' '; Universe_Curs.Values(Universe_Curs.Val_Cur).Line_Last := Universe_Curs.Values(Universe_Curs.Val_Cur).Line_Last - 1; end if; Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Organizer.Obj_Main, 1, 1, White, "Name : "); for Val in Universe_Name..Universe_Name loop Draw_Text(Organizer.Obj_Main, Universe_Curs.values(Val).Line_Pos, Universe_Curs.values(Val).Column_Pos, White, Universe_Curs.values(Val).Line(1..Universe_Curs.values(Val).Line_Last)); end loop; Draw_Text(Organizer.Obj_Main, Universe_Curs.Values(Universe_Curs.Val_Cur).Line_Pos, Universe_Curs.Values(Universe_Curs.Val_Cur).Column_Pos, White, Universe_Curs.Values(Universe_Curs.Val_Cur).Line(1..Universe_Curs.Values(Universe_Curs.Val_Cur).Line_Last)); when others => null; end case; elsif Universe_Curs.Values(Universe_Curs.Val_Cur).Line_Last < 45 then Universe_Curs.Values(Universe_Curs.Val_Cur).Line(Universe_Curs.Values(Universe_Curs.Val_Cur).Line_Last + 1) := Wchar; Universe_Curs.Values(Universe_Curs.Val_Cur).Line_Last := Universe_Curs.Values(Universe_Curs.Val_Cur).Line_Last + 1; for Val in Universe_Name..Universe_name loop Draw_Text(Organizer.Obj_Main, Universe_Curs.values(Val).Line_Pos, Universe_Curs.values(Val).Column_Pos, White, Universe_Curs.values(Val).Line(1..Universe_Curs.values(Val).Line_Last)); end loop; Draw_Text(Organizer.Obj_Main, Universe_Curs.Values(Universe_Curs.Val_Cur).Line_Pos, Universe_Curs.Values(Universe_Curs.Val_Cur).Column_Pos, White, Universe_Curs.Values(Universe_Curs.Val_Cur).Line(1..Universe_Curs.Values(Universe_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; end Receive; Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Organizer.Obj_Main, 1, 1, White, "Name : "); for Val in Universe_Name..Universe_Name loop Draw_Text(Organizer.Obj_Main, Universe_Curs.values(Val).Line_Pos, Universe_Curs.values(Val).Column_Pos, White, Universe_Curs.values(Val).Line(1..Universe_Curs.values(Val).Line_Last)); end loop; Draw_Text(Organizer.Obj_Main, Universe_Curs.Values(Universe_Curs.Val_Cur).Line_Pos, Universe_Curs.Values(Universe_Curs.Val_Cur).Column_Pos, White, Universe_Curs.Values(Universe_Curs.Val_Cur).Line(1..Universe_Curs.Values(Universe_Curs.Val_Cur).Line_Last)); case Obj_Tag is when None => Draw(Organizer, App.Terminal); Text_Io.Put(Normal_Mode); Global_Content_Print(App.Terminal.Cur, Organizer.Content_Win.win); Enlight_Window(Organizer.cmd_Win); Text_Io.Put(Normal_Mode); if App.Terminal.Cur = null then Draw_Text(Organizer.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Terminal.Cur.Info.Name /= null then Draw_Text(Organizer.Cmd_Win, 1, 1, White, App.Terminal.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(Organizer.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; when others => null; end case; or when Obj_Tag = Book or Obj_Tag = CDROM or Obj_Tag = DVD => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(1) => Content_Curs := Initialize; Enlight_Window(Organizer.Obj_Header); Enlight_Window(Organizer.Obj_Main); Enlight_Window(Organizer.Obj_Attr); Text_Io.Put(Normal_Mode); Obj_Tag := None; when Wide_Character'Val(10) => if Media_Curs.Values(Media_Curs.Val_Cur).Line_Last /= 0 then case Media_Curs.Val_Cur is when Media_None => null; when Media_Editor => case Obj_Tag is when Book => declare Book : constant Book_Class := To_Book(Media_Curs, Child_index); begin Add_To(App.Terminal, new Book_Class '(Book)); Save(App.Terminal.root, Organizer_Filename); end; when CDROM => declare CDROM : constant CDROM_Class := To_CDROM(Media_Curs, Child_index); begin Add_To(App.Terminal, new CDROM_Class '(CDROM)); Save(App.Terminal.root, Organizer_Filename); end; when DVD => declare DVD : constant DVD_Class := To_DVD(Media_Curs, Child_index); begin Add_To(App.Terminal, new DVD_Class '(DVD)); Save(App.Terminal.root, Organizer_Filename); end; when others => null; end case; -------------------------------- Media_Curs := Initialize; -------------------------------- Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Obj_Tag := None; when others => Media_Curs.Val_Cur := Media_Enum'Succ(Media_Curs.Val_Cur); end case; else Put(Character'Val(7)); end if; when Wide_Character ' Val (127) => if Media_Curs.Values(Media_Curs.Val_Cur).Line_Last > 0 then Media_Curs.Values(Media_Curs.Val_Cur).Line(Media_Curs.Values(Media_Curs.Val_Cur).Line_Last) := ' '; Media_Curs.Values(Media_Curs.Val_Cur).Line_Last := Media_Curs.Values(Media_Curs.Val_Cur).Line_Last - 1; end if; Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Organizer.Obj_Main, 2, 1, White, "Author : "); Draw_Text(Organizer.Obj_Main, 3, 1, White, "Editor : "); Draw_Text(Organizer.Obj_Main, 1, 1, White, "Title : "); for Val in Media_title..Media_Editor loop Draw_Text(Organizer.Obj_Main, Media_Curs.values(Val).Line_Pos, Media_Curs.values(Val).Column_Pos, White, Media_Curs.values(Val).Line(1..Media_Curs.values(Val).Line_Last)); end loop; Draw_Text(Organizer.Obj_Main, Media_Curs.Values(Media_Curs.Val_Cur).Line_Pos, Media_Curs.Values(Media_Curs.Val_Cur).Column_Pos, White, Media_Curs.Values(Media_Curs.Val_Cur).Line(1..Media_Curs.Values(Media_Curs.Val_Cur).Line_Last)); when others => null; end case; elsif Media_Curs.Values(Media_Curs.Val_Cur).Line_Last < 45 then Media_Curs.Values(Media_Curs.Val_Cur).Line(Media_Curs.Values(Media_Curs.Val_Cur).Line_Last + 1) := Wchar; Media_Curs.Values(Media_Curs.Val_Cur).Line_Last := Media_Curs.Values(Media_Curs.Val_Cur).Line_Last + 1; for Val in Media_Title..Media_Editor loop Draw_Text(Organizer.Obj_Main, Media_Curs.values(Val).Line_Pos, Media_Curs.values(Val).Column_Pos, White, Media_Curs.values(Val).Line(1..Media_Curs.values(Val).Line_Last)); end loop; Draw_Text(Organizer.Obj_Main, Media_Curs.Values(Media_Curs.Val_Cur).Line_Pos, Media_Curs.Values(Media_Curs.Val_Cur).Column_Pos, White, Media_Curs.Values(Media_Curs.Val_Cur).Line(1..Media_Curs.Values(Media_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; end Receive; Enlight_Window(Organizer.Obj_Main); Text_Io.Put(Normal_Mode); case Obj_Tag is when None => Draw(Organizer, App.Terminal); Text_Io.Put(Normal_Mode); Global_Content_Print(App.Terminal.Cur, Organizer.Content_Win.win); Enlight_Window(Organizer.cmd_Win); Text_Io.Put(Normal_Mode); if App.Terminal.Cur = null then Draw_Text(Organizer.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Terminal.Cur.Info.Name /= null then Draw_Text(Organizer.Cmd_Win, 1, 1, White, App.Terminal.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(Organizer.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; when Book .. DVD => Draw_Text(Organizer.Obj_Main, 2, 1, White, "Author : "); Draw_Text(Organizer.Obj_Main, 3, 1, White, "Editor : "); Draw_Text(Organizer.Obj_Main, 1, 1, White, "Title : "); for Val in Media_Title..Media_Editor loop Draw_Text(Organizer.Obj_Main, Media_Curs.values(Val).Line_Pos, Media_Curs.values(Val).Column_Pos, White, Media_Curs.values(Val).Line(1..Media_Curs.values(Val).Line_Last)); end loop; Draw_Text(Organizer.Obj_Main, Media_Curs.Values(Media_Curs.Val_Cur).Line_Pos, Media_Curs.Values(Media_Curs.Val_Cur).Column_Pos, White, Media_Curs.Values(Media_Curs.Val_Cur).Line(1..Media_Curs.Values(Media_Curs.Val_Cur).Line_Last)); when others => null; end case; or accept Halt do Organizer.Proc.Halt; end Halt; exit Main_loop; or accept Wake_Up(Top : in Natural) do Organizer_Process.Top := Top; Initialize(Organizer, Top); Draw(Organizer, App.Terminal); Obj_Tag := None; if Top = 0 then Organizer.Proc.Start; end if; Global_Content_Print(App.Terminal.Cur, Organizer.Content_Win.win); if In_Print then if Print_Index /= 0 then if Printed /= null then Printed.Print(Organizer.Obj_Header.Win, Organizer.Obj_Main.Win); end if; else if Printed /= null then Printed.Print(Organizer.Obj_Header.Win, Organizer.Obj_Main.Win); else App.Terminal.Cur.Print(Organizer.Obj_Header.Win, Organizer.Obj_Main.Win); end if; end if; end if; if Last /= 0 then Success := Print_Set(Childs_Set, Organizer.List_Win, Line_Index, Total_Line); end if; if App.Terminal.Root = null then Draw_Text(Organizer.Cmd_Win, 1, 1, White, "# "); elsif App.Terminal.Cur.Info.Name /= null then Draw_Text(Organizer.Cmd_Win, 1, 1, White, App.Terminal.Cur.Info.Name.all & "# "); else Draw_Text(Organizer.Cmd_Win, 1, 1, White, "null# "); end if; end Wake_Up; or accept Suspend do Organizer.Proc.Stop; end Suspend; exit; or accept Page_Down do if Line_Index + (Organizer.List_Win.H-2) <= Last then Line_Index := Line_Index + (Organizer.List_Win.H-2); Success := Print_Set(Childs_Set, Organizer.List_Win, Line_Index, Total_Line); else Text_Io.Put(Character'Val(7)); end if; end Page_Down; or accept Page_Up do if Line_Index > 0 then Line_Index := Line_Index - (Organizer.List_Win.H-2); Success := Print_Set(Childs_Set, Organizer.List_Win, Line_Index, Total_Line); else Text_Io.Put(Character'Val(7)); end if; end Page_Up; or accept Up_Arrow do null; end Up_Arrow; or accept Down_Arrow do null; end Down_Arrow; or accept Left_Arrow; or accept Right_Arrow; or accept Begin_Of; or accept End_Of; or accept Del; or accept Overwrite; end select; end loop; loop select accept Halt do Organizer.Proc.Halt; end Halt; exit Main_Loop; or accept Suspend do Organizer.Proc.Stop; end Suspend; or accept Wake_Up(Top : in Natural) do Initialize(Organizer, Top); Organizer_Process.Top := Top; Draw(Organizer, App.Terminal); if Top = 0 then Organizer.Proc.Start; end if; Obj_Tag := None; Global_Content_Print(App.Terminal.Cur, Organizer.Content_Win.win); if In_Print then if Print_Index /= 0 then if Printed /= null then Printed.Print(Organizer.Obj_Header.Win, Organizer.Obj_Main.Win); end if; else if Printed /= null then Printed.Print(Organizer.Obj_Header.Win, Organizer.Obj_Main.Win); else App.Terminal.Cur.Print(Organizer.Obj_Header.Win, Organizer.Obj_Main.Win); end if; end if; end if; if Last /= 0 then Success := Print_Set(Childs_Set, Organizer.List_Win, Line_Index, Total_Line); end if; if App.Terminal.Root = null then Draw_Text(Organizer.Cmd_Win, 1, 1, White, "# "); elsif App.Terminal.Cur.Info.Name /= null then Draw_Text(Organizer.Cmd_Win, 1, 1, White, App.Terminal.Cur.Info.Name.all & "# "); else Draw_Text(Organizer.Cmd_Win, 1, 1, White, "null# "); end if; end Wake_Up; exit; end select; end loop; end loop Main_Loop; --W_Io.Put_Line("Organizer process halted"); end Organizer_Process; procedure Make_Html(Set : in Wide_Set) is File : W_Io.File_Type; begin W_Io.Create(File, W_Io.Out_File, "/var/www/html/dialog.html", Form => "WCEM=8"); W_Io.Put_Line(File, ""); W_Io.Put_Line(File, ""); W_Io.Put_Line(File, " "); W_Io.Put_Line(File, ""); W_Io.Put_Line(File, ""); W_Io.Put_Line(File, ""); W_Io.Put_Line(File, ""); for Line in 1..Set.Line_Last loop if Set.lines(Line) /= null then W_Io.Put_Line(File, Set.lines(Line).all); else exit; end if; end loop; W_Io.Put_Line(File, ""); W_Io.Put_Line(File, ""); W_Io.Close(File); end Make_Html; task body Vbrain_Process is Suspended : Boolean := False; task Clock_Tasking is entry Halt; entry Suspend; entry Start; end Clock_Tasking; Dialog_Lock : Binary_Semaphore(True, Default_Ceiling); task body Clock_Tasking is Lock : Boolean := True; begin Clock_Loop : loop while Lock loop select accept Suspend; or accept Start do Lock := False; end Start; exit; or accept Halt; exit Clock_Loop; end select; end loop; loop select accept Start; or accept Suspend do Lock := True; end Suspend; exit; or accept Halt; exit Clock_Loop; or delay 1.0; case App.Mode is when Dialog => Dialog_Lock.Seize; Text_Io.Put(Save_Cursor); Window.Draw_Text(App.Frames(Header).Win, 1, App.Frames(Header).Win.Win.W/2-10, Yellow, Handling.To_Wide_String(Formatting.Image(Clock))); Text_Io.Put(Restore_Cursor); Dialog_Lock.Release; when others => null; end case; end select; end loop; end loop Clock_Loop; W_Io.Put_Line("Clocking halted"); end Clock_Tasking; Height : Positive := App.Frames(Dialog_View).Win.H-2; Width : Positive := App.Frames(Dialog_View).Win.W-2; task Deamon_Network is entry Receive (Feedback : in Neural_Retrain.Input_type; Input : in Neural_Retrain.Input_Type; Output : in Neural_Retrain.Output_Type); entry Suspend; entry Start; entry Halt; end Deamon_Network; Dialog_Initialized : Boolean := False; task body Deamon_Network is begin Main_Loop : loop loop select accept Suspend; exit; or accept Start; or accept Receive (Feedback : in Neural_Retrain.Input_type; Input : in Neural_Retrain.Input_Type; Output : in Neural_Retrain.Output_Type) do App.Samples(1).Input := Feedback; App.Samples(1).output := Neural_Retrain.Output_Type(Input); App.Samples(2).Input := Input; App.Samples(2).output := Output; end Receive; or accept Halt; exit Main_loop; or delay 10.0; if not Suspended and Dialog_initialized then Vbrain_Process.Dialog; end if; end select; end loop; loop select accept Suspend; or accept Start; exit; or accept Halt; exit Main_loop; end select; end loop; end loop Main_Loop; end Deamon_Network; Conv : PragmARC.Rem_NN_Wrapper.Real := 0.006; Epoch_Max : Natural := 250; Reuse : constant Boolean := True; Rms_Error : PragmARC.Rem_NN_Wrapper.Real := 0.0; End_Of_This_Task : Boolean := False; End_Of_Program : Boolean := False; Is_Overwrite : Boolean := False; Wchar_Max : Positive := App.Columns-4; Wline : M.Strings.Wide_String_Access := new Wide_String ' (""); Wbuffer : M.Strings.Wide_String_Access; Wline_Length : Natural := 0; Current_Pos : Natural := 1; Left_Buffer : M.Strings.Wide_String_Access; Word_Number : Word_Range := 0; Response_Buffer : Wide_Set(1); internal_Buffer : Wide_Set(1); Dialog_Buffer_Last : Line_Index_Range := 0; Dialog_Buffer_Index : Line_Index_Range := 0; Dialog_Buffer : Wide_Set(2880); -- 24 h self : 1440 * 2. Samples_Last : Line_Index_Range := 0; Samples_Index : Line_Index_Range := 0; Samples_Set : Wide_Set(1024); Samples_Loaded : Boolean := False; Glossary_Last : Line_Index_Range := 0; Glossary_Index : Line_Index_Range := 0; Glossary_Set : Wide_Set(4096); Glossary_Loaded : Boolean := False; Total_Lines : Line_Index_Range := 0; Total : Line_Index_Range := 0; View : Boolean := False; -- Samples if false, Glossary else. Tab to change. html_Buffer : Wide_Set(12); Main1 : W_Io.File_Type; Errno : Integer := 0; begin Glossary.Initialize(App.Words, "./data" & Dir_Separator & "glossary.txt"); Text_Io.Put_Line("initializing sample_set"); Init_Samples(App.Samples_Set, App.Words, "data/" & App.Set_Filename.all); -- Text_Io.Put_Line("Going to train"); -- Neural_Train.Train (Samples => App.Samples_Set ' access, -- Max_Epochs => 25_8000, -- Converged => 0.006, -- Reuse => False, -- RMS_Error => RMS_Error); -- -- do 1000 epochs by samples for max words 2048 and line width of 80 words. -- -- copying elhoim.wgt1 into elhoim.wgt2 after learn. -- -- the delay for only one request on dialogic agent is 20s ; 250 epochs for 2 samples. Window.Initialize(App.Frames(Header).Win, 1, 1, 3, App.Columns, White, Red); Window.Initialize(App.Frames(Global_View).Win, 4, 1, App.Lines-3, Columns, green, Yellow); Window.Initialize(App.Frames(Input).Win, 6, 2, 3, App.Columns-2, Blue, White); Window.Initialize(App.Frames(Resp).Win, 10, 2, 5, App.Columns/2-2, Blue, White); Window.Initialize(App.Frames(Output).Win, 16, 2, 5, App.Columns/2-2, Blue, White); Window.Initialize(App.Frames(Dialog_View).Win, 22, 2, App.Lines/8*5, App.Columns/2-2, Blue, White); Window.Initialize(App.Frames(Buffer).Win, App.Lines-5, 2, 5, App.Columns/2-2, Blue, White); Window.Initialize(App.Frames(Right_View).Win, 10, App.Columns/2, App.Lines-10, App.Columns/2, yellow, green); Main_Loop: while not End_Of_This_Task loop null; loop select accept Halt do End_Of_This_Task := True; Clock_Tasking.Halt; Text_Io.Put_Line("Deamon halting..."); Deamon_Network.Halt; Text_Io.Put_Line("Deamon halted!"); end Halt; exit Main_loop; --or or accept Suspend do null; end Suspend; --accept Lock; or accept Wake_Up(Top : in Natural) do Suspended := False; Dialog_Lock.Seize; Window.Draw_Window(App.Frames(Header).Win); Window.Draw_Window(App.Frames(Global_View).Win); Window.Draw_Window(App.Frames(Input).Win); Window.Draw_Window(App.Frames(Resp).Win); Window.Draw_Window(App.Frames(Output).Win); Window.Draw_Window(App.Frames(Dialog_View).Win); Window.Draw_Window(App.Frames(Buffer).Win); Window.Draw_Window(App.Frames(Right_View).Win); ------------------------------------------------------------------- -- Drawing the windows titles -- -------------------------------------------------------------------  Window.Draw_Text(App.Frames(Global_View).Win, 1, 1, Green, "Input"); Window.Draw_Text(App.Frames(Global_View).Win, 5, 1, Magenta, "Response"); Window.Draw_Text(App.Frames(Global_View).Win, 11, 1, Yellow, "Internal"); Window.Draw_Text(App.Frames(Global_View).Win, 17, 1, Cyan, "Dialog"); Window.Draw_Text(App.Frames(Global_View).Win, 5, Columns/4*3-8, Blue, "Samples/Glossary"); ------------------------------------------------------------------- -- Drawing the buffer states -- ------------------------------------------------------------------- if App.On_Esc then Window.Draw_Text(App.Frames(Buffer).Win, 1, 2, cyan, "one esc to quit"); else Window.Draw_Text(App.Frames(Buffer).Win, 1, 2, Cyan, "two esc to quit"); end if; Window.Draw_Text(App.Frames(Buffer).Win, 1, 22, White, " ; Alphabet"); Window.Draw_Text(App.Frames(Buffer).Win, 1, 33, Red, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 1, 36, yellow, Alphabet); Window.Draw_Text(App.Frames(Buffer).Win, 2, 2, Cyan, "Chars max"); Window.Draw_Text(App.Frames(Buffer).Win, 2, 17, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 2, 20, Magenta, Handling.To_Wide_String(Natural'Image(App.Columns-5))); Window.Draw_Text(App.Frames(Buffer).Win, 3, 2, Cyan, "Char(s) left"); Window.Draw_Text(App.Frames(Buffer).Win, 3, 17, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 3, 20, Magenta, Handling.To_Wide_String(Natural'Image(((App.Columns- 5) - Wline_Length)))); Window.Draw_Text(App.Frames(Buffer).Win, 2, 25, Cyan, " ; word max"); Window.Draw_Text(App.Frames(Buffer).Win, 2, 39, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 2, 43, Magenta, Handling.To_Wide_String(Word_Range'Image(80))); Window.Draw_Text(App.Frames(Buffer).Win, 3, 25, Cyan, " ; Word number"); Window.Draw_Text(App.Frames(Buffer).Win, 3, 39, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 3, 43, Magenta, Handling.To_Wide_String(Word_Range'Image(Word_Number))); Window.Draw_Text(App.Frames(Buffer).Win, 2, 50, Cyan, " ; lines max"); Window.Draw_Text(App.Frames(Buffer).Win, 2, 64, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 2, 66, Magenta, Handling.To_Wide_String(Line_Index_Range'Image(2880))); Window.Draw_Text(App.Frames(Buffer).Win, 3, 50, Cyan, " ; Lines count"); Window.Draw_Text(App.Frames(Buffer).Win, 3, 64, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 3, 66, Magenta, Handling.To_Wide_String(Line_Index_Range'Image(Dialog_Buffer_Last))); Window.Draw_Text(App.Frames(Buffer).Win, 3, 71, Cyan, " ; Overwrite"); Window.Draw_Text(App.Frames(Buffer).Win, 3, 83, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 3, 86, Magenta, Handling.To_Wide_String(Boolean'Image(Is_Overwrite))); case View is when False => if Os_Lib.Is_Regular_File(App.Set_Filename.all) then Samples_Set.Line_Last := 0; Load_File(Samples_Set, App.Set_Filename.all, Samples_Last); elsif Os_Lib.Is_Regular_File("data" & Dir_Separator & App.Set_Filename.all) then Load_File(Samples_Set, "data" & Dir_Separator & App.Set_Filename.all, Samples_Last); end if; if not Print_Set(Samples_Set, App.Frames(Right_View).Win, Samples_Index, Total) then Add_Line(Dialog_Buffer, Dialog_Buffer_Last, "Error during samples printing !"); end if; Samples_Loaded := True; when True => if Os_Lib.Is_Regular_File("data" & Dir_Separator & "glossary.txt") then Glossary_Set.Line_Last := 0; Load_File(Glossary_Set, "data" & Dir_Separator & "glossary.txt", Glossary_Last); if not Print_Set(Glossary_Set, App.Frames(Right_View).Win, glossary_Index, Total) then Add_Line(Dialog_Buffer, Dialog_Buffer_Last, "Error during glossary printing !"); end if; end if; Glossary_Loaded := True; end case; if Print_Set(App.Response_Buffer, App.Frames(Resp).Win, 0, Total) then null; end if; Total := 0; if Print_Set(App.Internal_Buffer, App.Frames(Output).Win, 0, Total) then null; end if; Total_Lines := 0; if not Print_Set(Dialog_Buffer, App.Frames(Dialog_View).Win, Dialog_Buffer_Index, Total_lines) then Add_Line(Dialog_Buffer, Dialog_Buffer_Last, "Error during dialog printing !"); end if; if Wline /= null and then Wline'Length /= 0 then Window.Draw_Text(App.Frames(Input).Win, 1, 1, White, Wline.all); else Window.Draw_Text(App.Frames(Input).Win, 1, 1, White, ""); end if; Dialog_Lock.Release; Clock_Tasking.Start; Deamon_Network.Start; end Wake_Up; exit; end select; end loop; while not End_Of_This_Task Loop select accept Wake_Up(Top : in Natural) do Suspended := False; Dialog_Lock.Seize; Window.Draw_Window(App.Frames(Header).Win); Window.Draw_Window(App.Frames(Global_View).Win); Window.Draw_Window(App.Frames(Input).Win); Window.Draw_Window(App.Frames(Resp).Win); Window.Draw_Window(App.Frames(Output).Win); Window.Draw_Window(App.Frames(Dialog_View).Win); Window.Draw_Window(App.Frames(Buffer).Win); Window.Draw_Window(App.Frames(Right_View).Win); ------------------------------------------------------------------- -- Drawing the windows titles -- -------------------------------------------------------------------  Window.Draw_Text(App.Frames(Global_View).Win, 1, 1, Green, "Input"); Window.Draw_Text(App.Frames(Global_View).Win, 5, 1, Magenta, "Response"); Window.Draw_Text(App.Frames(Global_View).Win, 11, 1, Yellow, "Internal"); Window.Draw_Text(App.Frames(Global_View).Win, 17, 1, Cyan, "Dialog"); Window.Draw_Text(App.Frames(Global_View).Win, 5, Columns/4*3-8, Blue, "Samples/Glossary"); ------------------------------------------------------------------- -- Drawing the buffer states -- ------------------------------------------------------------------- if App.On_Esc then Window.Draw_Text(App.Frames(Buffer).Win, 1, 2, Cyan, "one esc to quit"); else Window.Draw_Text(App.Frames(Buffer).Win, 1, 2, Cyan, "two esc to quit"); end if; Window.Draw_Text(App.Frames(Buffer).Win, 1, 22, White, " ; Alphabet"); Window.Draw_Text(App.Frames(Buffer).Win, 1, 33, Red, " : "); Draw_Text(App.Frames(Buffer).Win, 1, 36, yellow, Alphabet); Window.Draw_Text(App.Frames(Buffer).Win, 2, 2, Cyan, "Chars max"); Window.Draw_Text(App.Frames(Buffer).Win, 2, 17, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 2, 20, Magenta, Handling.To_Wide_String(Natural'Image(App.Columns-5))); Window.Draw_Text(App.Frames(Buffer).Win, 3, 2, Cyan, "Char(s) left"); Window.Draw_Text(App.Frames(Buffer).Win, 3, 17, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 3, 20, Magenta, Handling.To_Wide_String(Natural'Image(((App.Columns- 5) - Wline_Length)))); Window.Draw_Text(App.Frames(Buffer).Win, 2, 25, Cyan, " ; word max"); Window.Draw_Text(App.Frames(Buffer).Win, 2, 39, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 2, 43, Magenta, Handling.To_Wide_String(Word_Range'Image(80))); Window.Draw_Text(App.Frames(Buffer).Win, 3, 25, Cyan, " ; Word number"); Window.Draw_Text(App.Frames(Buffer).Win, 3, 39, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 3, 43, Magenta, Handling.To_Wide_String(Word_Range'Image(Word_Number))); Window.Draw_Text(App.Frames(Buffer).Win, 2, 50, Cyan, " ; lines max"); Window.Draw_Text(App.Frames(Buffer).Win, 2, 64, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 2, 66, Magenta, Handling.To_Wide_String(Line_Index_Range'Image(2880))); Window.Draw_Text(App.Frames(Buffer).Win, 3, 50, Cyan, " ; Lines count"); Window.Draw_Text(App.Frames(Buffer).Win, 3, 64, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 3, 66, Magenta, Handling.To_Wide_String(Line_Index_Range'Image(Dialog_Buffer_Last))); Window.Draw_Text(App.Frames(Buffer).Win, 3, 71, Cyan, " ; Overwrite"); Window.Draw_Text(App.Frames(Buffer).Win, 3, 83, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 3, 86, Magenta, Handling.To_Wide_String(Boolean'Image(Is_Overwrite))); case View is when False => if Os_Lib.Is_Regular_File(App.Set_Filename.all) then Samples_Set.Line_Last := 0; Load_File(Samples_Set, App.Set_Filename.all, Samples_Last); elsif Os_Lib.Is_Regular_File("data" & Dir_Separator & App.Set_Filename.all) then Load_File(Samples_Set, "data" & Dir_Separator & App.Set_Filename.all, Samples_Last); end if; if not Print_Set(Samples_Set, App.Frames(Right_View).Win, Samples_Index, Total) then Add_Line(Dialog_Buffer, Dialog_Buffer_Last, "Error during samples printing !"); end if; Samples_Loaded := True; when True => if Os_Lib.Is_Regular_File("data" & Dir_Separator & "glossary.txt") then Glossary_Set.Line_Last := 0; Load_File(Glossary_Set, "data" & Dir_Separator & "glossary.txt", Glossary_Last); if not Print_Set(Glossary_Set, App.Frames(Right_View).Win, glossary_Index, Total) then Add_Line(Dialog_Buffer, Dialog_Buffer_Last, "Error during glossary printing !"); end if; end if; Glossary_Loaded := True; end case; Total := 0; if Print_Set(App.Response_Buffer, App.Frames(Resp).Win, 0, Total) then null; end if; Total := 0; if Print_Set(App.Internal_Buffer, App.Frames(Output).Win, 0, Total) then null; end if; Total_Lines := 0; if not Print_Set(Dialog_Buffer, App.Frames(Dialog_View).Win, Dialog_Buffer_Index, Total_lines) then Add_Line(Dialog_Buffer, Dialog_Buffer_Last, "Error during dialog printing !"); end if; if Wline /= null and then Wline'Length /= 0 then Window.Draw_Text(App.Frames(Input).Win, 1, 1, White, Wline.all); else Window.Draw_Text(App.Frames(Input).Win, 1, 1, White, ""); end if; Dialog_Lock.Release; Clock_Tasking.Start; Deamon_Network.Start; end Wake_Up; or accept Halt do End_Of_This_Task := True; Clock_Tasking.Halt; Text_Io.Put_Line("Deamon halting..."); Deamon_Network.Halt; Text_Io.Put_Line("Deamon halted!"); end Halt; exit Main_loop; or accept Suspend do Deamon_Network.Suspend; Clock_Tasking.Suspend; end Suspend; exit; or ------------------------------------------------------------------------------- -- Dialog recheive an Wide_Character -- ------------------------------------------------------------------------------- accept Receive (Wchar : in Wide_Character) do End_Of_This_Task := False; if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(1) => null; -- save (as); when Wide_Character'Val(4) => End_Of_Program := True; when Wide_Character'Val(5) => Set_Free(Dialog_Buffer); Window.Draw_Window(App.Frames(Resp).Win); Window.Draw_Window(App.Frames(Output).Win); Window.Draw_Window(App.Frames(Dialog_View).Win); when Wide_Character'Val(9) => -- switch between sample and glossary View := not View; Dialog_Lock.Seize; Window.Draw_Window(App.Frames(Right_View).Win); case View is when False => if not Samples_Loaded then if Os_Lib.Is_Regular_File(App.Set_Filename.all) then Samples_Set.Line_Last := 0; Load_File(Samples_Set, App.Set_filename.all, Samples_Last); elsif Os_Lib.Is_Regular_File("data" & Dir_Separator & App.Set_filename.all) then Load_File(Samples_Set, "data" & Dir_Separator & App.Set_Filename.all, Samples_Last); end if; Samples_Loaded := True; end if; if not Print_Set(Samples_Set, App.Frames(Right_View).Win, 0, Total) then Add_Line(Dialog_Buffer, Dialog_Buffer_Last, "Error during samples printing !"); end if; when True => if Os_Lib.Is_Regular_File("data" & Dir_Separator & "glossary.txt") then Glossary_Set.Line_Last := 0; Load_File(Glossary_Set, "data" & Dir_Separator & "glossary.txt", Glossary_Last); end if; Glossary_Loaded := True; if not Print_Set(Glossary_Set, App.Frames(Right_View).Win, 0, Total) then Add_Line(Dialog_Buffer, Dialog_Buffer_Last, "Error during glossary printing !"); end if; end case; Dialog_Lock.Release; when Wide_Character'Val(10) | Wide_Character'Val(13) => -------------------------------------------------- -- Network intercation -- -------------------------------------------------- if Wline /= null and then Wline'Length /= 0 then ----------------------------------------------------------- -- Initilizeing neural input -- App.Input := String2input (Wline.all, App.Words); -- -- -- ----------------------------------------------------------- --W_Io.Open(Main1, W_Io.Append_File, "/var/www/html/dialog.html", Form => "WCEM=8"); --W_Io.Put_Line(Main1, "Le Tout puissant : " & WLine.all & "
"); --W_Io.Close(Main1); Add_Line(Html_buffer, html_Buffer.Line_Last, "Manuel : " & Wline.all & "
"); Add_Line(Dialog_Buffer, Dialog_Buffer.Line_Last, Wline.all); if Total_Lines+2 >= App.Frames(Dialog_View).Win.Win.H-2 then Dialog_Buffer_Index := Dialog_Buffer_Index + Wline'Length/(App.Frames(Dialog_View).Win.Win.W-2); end if; else App.Input := string2Input ("", App.words); Add_Line(Dialog_Buffer, Dialog_Buffer_Last, ""); if Total_Lines+2 >= App.Frames(Dialog_View).Win.Win.H-2 then Dialog_Buffer_Index := Dialog_Buffer_Index + 1; end if; end if; Wide_Free(Wline); Wline := new Wide_String ' (""); Current_Pos := 1; declare --Request : Neural_Retrain.Request_NN; begin --Request.Respond (App.Input, App.Output); App.Output := Neural_Retrain.Respond(App.Input); exception when others => null; end; App.Dialog_Response := new Wide_String ' (Output2string (App.Output, App.Words)); --W_Io.Open(Main1, W_Io.Append_File, "/var/www/html/dialog.html", Form => "WCEM=8"); --W_Io.Put_Line(Main1, "Chaos : " & App.Dialog_Response.all & "
"); Add_Line(Html_buffer, html_Buffer.Line_Last, "Chaos : " & webOutput2string (App.Output, App.Words) & "
"); --W_Io.Put_Line(Main1, "Chaos : " & webOutput2string (App.Output, App.Words) & "
"); --Errno := System("espeak """ & Handling.To_String(App.Dialog_Response.all) & """" & Character'Val(0)); --W_Io.Close(Main1); declare --Request : Neural_Retrain.Request_NN; begin --Request.Respond (Neural_Retrain.Input_Type(App.Output), App.Feedback); App.Feedback := Neural_Retrain.Respond(Neural_Retrain.Input_Type(App.Output)); exception when others => null; end; App.Internal := new Wide_String ' (Output2string(App.Feedback, App.Words)); --W_Io.Open(Main1, W_Io.Append_File, "/var/www/html/dialog.html", Form => "WCEM=8"); --W_Io.Put_Line(Main1, "Chaos : " & App.Internal.all & "
"); Add_Line(Html_buffer, html_Buffer.Line_Last, "Chaos : " & webOutput2string (App.Feedback, App.Words) & "
"); --W_Io.Put_Line(Main1, "Chaos : " & webOutput2string(App.Feedback, App.Words) & "
"); --W_Io.Close(Main1); Make_Html(Html_Buffer); Dialog_Initialized := True; select Deamon_Network.Receive(Neural_Retrain.Input_Type(App.Feedback), App.Input, App.Output); Neural_Retrain.Train(App.Samples ' access, Epoch_Max, Conv, Reuse, Rms_Error); or delay 1.0; end select; App.Input := Neural_Retrain.Input_Type(App.Feedback); -------------------------------------------------- -- Drawing the results -- -------------------------------------------------- Dialog_Lock.Seize; Window.Draw_Window(App.Frames(Resp).Win); Window.Draw_Window(App.Frames(Output).Win); Window.Draw_Window(App.Frames(Dialog_View).Win); Window.Draw_Window(App.Frames(Buffer).Win); if App.Dialog_Response /= null and then App.Dialog_Response'Length /= 0 then Add_Line(Dialog_Buffer, Dialog_Buffer.Line_Last, App.Dialog_Response.all); if Total_Lines+2 >= App.Frames(Dialog_View).Win.Win.H-2 then Dialog_Buffer_Index := Dialog_Buffer_Index + App.Dialog_Response'Length/(App.Frames(Dialog_View).Win.Win.W-2) + 1; end if; Total := 0; Add_Line(App.Response_Buffer, App.Response_Buffer.Line_Last, App.Dialog_Response.all); if Print_Set(App.Response_Buffer, App.Frames(Resp).Win, 0, Total) then null; end if; else Add_Line(Dialog_Buffer, Dialog_Buffer.Line_Last, ""); if Total_Lines+2 >= App.Frames(Dialog_View).Win.Win.H-2 then Dialog_Buffer_Index := Dialog_Buffer_Index + 1; end if; Window.Draw_Text(App.Frames(Resp).Win, 1, 1, White, ""); end if; if App.Internal /= null and then App.Internal'Length /= 0 then Add_Line(Dialog_Buffer, Dialog_Buffer.Line_Last, App.Internal.all); if Total_Lines+2 >= App.Frames(Dialog_View).Win.Win.H-2 then Dialog_Buffer_Index := Dialog_Buffer_Index + App.internal'Length/(App.Frames(Dialog_View).Win.Win.W-2) + 1; end if; Total := 0; Add_Line(App.Internal_Buffer, Total, App.Internal.all); if Print_Set(App.Internal_Buffer, App.Frames(Output).Win, 0, Total) then null; end if; else Add_Line(Dialog_Buffer, Dialog_Buffer_Last, ""); if Total_Lines+2 >= App.Frames(Dialog_View).Win.Win.H-2 then Dialog_Buffer_Index := Dialog_Buffer_Index + 1; end if; Window.Draw_Text(App.Frames(Output).Win, 1, 1, White, ""); end if; Window.Draw_Text(App.Frames(Input).Win, 1, Current_Pos, White, ""); Dialog_Lock.Release; when Wide_Character'Val(12) => Put(Ansi_Tty_Control.Clear_Screen); Dialog_Lock.Seize; Window.Draw_Window(App.Frames(Header).Win); Window.Draw_Window(App.Frames(Global_View).Win); ------------------------------------------------------------------- -- Drawing the windows titles -- -------------------------------------------------------------------  Window.Draw_Text(App.Frames(Global_View).Win, 1, 1, Green, "Input"); Window.Draw_Text(App.Frames(Global_View).Win, 5, 1, Magenta, "Response"); Window.Draw_Text(App.Frames(Global_View).Win, 11, 1, Yellow, "Internal"); Window.Draw_Text(App.Frames(Global_View).Win, 17, 1, Cyan, "Dialog"); Window.Draw_Text(App.Frames(Global_View).Win, 5, Columns/4*3-8, Blue, "Samples/Glossary"); Window.Draw_Window(App.Frames(Input).Win); Window.Draw_Window(App.Frames(Resp).Win); Window.Draw_Window(App.Frames(Output).Win); Window.Draw_Window(App.Frames(Dialog_View).Win); Window.Draw_Window(App.Frames(Buffer).Win); Window.Draw_Window(App.Frames(Right_View).Win); case View is when False => if not Print_Set(Samples_Set, App.Frames(Right_View).Win, Samples_Index, Total) then Add_Line(Dialog_Buffer, Dialog_Buffer_Last, "Error during samples printing !"); end if; when True => if not Print_Set(Glossary_Set, App.Frames(Right_View).Win, glossary_Index, Total) then Add_Line(Dialog_Buffer, Dialog_Buffer_Last, "Error during glossary printing !"); end if; end case; Dialog_Lock.Release; when Wide_Character'Val(127) => if Wline /= null and then Wline'Length > 0 then if Current_Pos > 1 then case Is_Overwrite is when False => if Current_Pos > 2 then if Wline'Length >= 2 then Left_Buffer := new Wide_String ' (Wline(1..Current_Pos-2)); if Current_Pos <= Wline'Length then Wbuffer := new Wide_String ' (Left_Buffer.all & Wline(Current_Pos..Wline'Last)); else Wbuffer := new Wide_String ' (Left_Buffer.all); end if; else Left_Buffer := new Wide_String ' (Wline(1..Current_Pos-2)); Wbuffer := new Wide_String ' (Left_Buffer.all); end if; elsif Current_Pos = 2 then if Wline'Length >= 2 then Left_Buffer := new Wide_String ' (Wline(Current_pos..Wline'Length)); Wbuffer := new Wide_String ' (Left_Buffer.all); else Wbuffer := new Wide_String ' (""); end if; end if; Wide_Free(Wline); Wline := new Wide_String ' (Wbuffer.all); Wide_Free(Wbuffer); Wide_Free(Left_Buffer); Current_Pos := Current_Pos - 1; Wline_Length := Wline_Length - 1; when True => Wide_Fixed.Replace_Slice (Wline.all, Current_Pos-1, Current_Pos-1, " "); Current_Pos := Current_Pos - 1; end case; else W_Io.Put(Wide_Character'Val(7)); end if; else W_Io.Put(Wide_Character'Val(7)); -- beep... end if; when others => null; end case; elsif Is_Special(Wchar) then case Wchar is when '!' | ';' | '.' | ''' | '?' | ' ' | '_' | '-' => if Wline /= null and then Wline'Length < Wchar_Max then if Current_Pos = Wline'Length+1 then Wbuffer := new Wide_String ' (Wline.all & Wchar); Wide_Free(Wline); Wline := new Wide_String ' (Wbuffer.all); Wide_Free(Wbuffer); Wline_Length := Wline_Length + 1; Current_Pos := Current_Pos + 1; else if Current_Pos > 2 then if not Is_Overwrite then Left_Buffer := new Wide_String ' (Wline(1..Current_Pos-1)); Wbuffer := new Wide_String ' (Left_Buffer.all & Wchar & Wline(Current_Pos..Wline'Last)); Wide_Free(Wline); Wline := new Wide_String ' (Wbuffer.all); Wide_Free(Wbuffer); Wide_Free(Left_Buffer); Wline_Length := Wline_Length + 1; Current_Pos := Current_Pos + 1; else Wide_Fixed.Replace_Slice (Wline.all, Current_Pos, Current_Pos, Wchar & ""); Current_Pos := Current_Pos + 1; end if; elsif not Is_Overwrite then Wbuffer := new Wide_String ' (Wchar & Wline.all); Wide_Free(Wline); Wline := new Wide_String ' (Wbuffer.all); Wide_Free(Wbuffer); Wline_Length := Wline_Length + 1; Current_Pos := Current_Pos + 1; else Wide_Fixed.Replace_Slice (Wline.all, Current_Pos, Current_Pos, Wchar & ""); Current_Pos := Current_Pos + 1; end if; end if; else W_Io.Put(Wide_Character'Val(7)); -- beep... end if; when Others => W_Io.Put(Wide_Character'Val(7)); -- beep... end case; elsif Is_Digit(Wchar) then W_Io.Put(Wide_Character'Val(7)); -- beep... else if Wline /= null and then Wline'Length < Wchar_Max then if Current_Pos = Wline'Length + 1 then Wbuffer := new Wide_String ' (Wline.all & Wchar); Wide_Free(Wline); Wline := new Wide_String ' (Wbuffer.all); Wide_Free(Wbuffer); Current_Pos := Current_Pos + 1; Wline_Length := Wline_Length + 1; else if Current_Pos > 1 then if not Is_Overwrite then Left_Buffer := new Wide_String ' (Wline(1..Current_Pos-1)); Wbuffer := new Wide_String ' (Left_Buffer.all & Wchar & Wline(Current_Pos..Wline'Last)); Wide_Free(Wline); Wline := new Wide_String ' (Wbuffer.all); Wide_Free(Wbuffer); Wide_Free(Left_Buffer); Wline_Length := Wline_Length + 1; Current_Pos := Current_Pos + 1; else Wide_Fixed.Replace_Slice (Wline.all, Current_Pos, Current_Pos, Wchar & ""); Current_Pos := Current_Pos + 1; end if; elsif not Is_Overwrite then Wbuffer := new Wide_String ' (Wchar & Wline.all); Wide_Free(Wline); Wline := new Wide_String ' (Wbuffer.all); Wide_Free(Wbuffer); Wline_Length := Wline_Length + 1; Current_Pos := Current_Pos + 1; else Wide_Fixed.Replace_Slice (Wline.all, Current_Pos, Current_Pos, Wchar & ""); Current_Pos := Current_Pos + 1; end if; end if; else W_Io.Put(Wide_Character'Val(7)); -- beep... end if; end if; ------------------------------------------------------------------- -- Drawing the diallog buffer -- -------------------------------------------------------------------  Dialog_Lock.Seize; if not Print_Set(Dialog_Buffer, App.Frames(Dialog_View).Win, Dialog_Buffer_Index, Total_lines) then Add_Line(Dialog_Buffer, Dialog_Buffer_Last, "Error during dialog printing !"); end if; Window.Draw_Window(App.Frames(Buffer).Win); ------------------------------------------------------------------- -- Drawing the states -- ------------------------------------------------------------------- if App.On_Esc then Window.Draw_Text(App.Frames(Buffer).Win, 1, 2, Cyan, "one esc to quit"); else Window.Draw_Text(App.Frames(Buffer).Win, 1, 2, Cyan, "two esc to quit"); end if; Word_Number := Word_Count(Wline.all, Integer(80)); Window.Draw_Text(App.Frames(Buffer).Win, 1, 22, White, " ; Alphabet"); Window.Draw_Text(App.Frames(Buffer).Win, 1, 33, Red, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 1, 36, yellow, Alphabet); Window.Draw_Text(App.Frames(Buffer).Win, 2, 2, Cyan, "Chars max"); Window.Draw_Text(App.Frames(Buffer).Win, 2, 17, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 2, 20, Magenta, Handling.To_Wide_String(Natural'Image(App.Columns-5))); Window.Draw_Text(App.Frames(Buffer).Win, 3, 2, Cyan, "Char(s) left"); Window.Draw_Text(App.Frames(Buffer).Win, 3, 17, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 3, 20, Magenta, Handling.To_Wide_String(Natural'Image(((App.Columns- 5) - Wline_Length)))); Window.Draw_Text(App.Frames(Buffer).Win, 2, 25, Cyan, " ; word max"); Window.Draw_Text(App.Frames(Buffer).Win, 2, 39, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 2, 43, Magenta, Handling.To_Wide_String(Word_Range'Image(80))); Window.Draw_Text(App.Frames(Buffer).Win, 3, 25, Cyan, " ; Word number"); Window.Draw_Text(App.Frames(Buffer).Win, 3, 39, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 3, 43, Magenta, Handling.To_Wide_String(Word_Range'Image(Word_Number))); Window.Draw_Text(App.Frames(Buffer).Win, 2, 50, Cyan, " ; lines max"); Window.Draw_Text(App.Frames(Buffer).Win, 2, 64, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 2, 66, Magenta, Handling.To_Wide_String(Line_Index_Range'Image(2880))); Window.Draw_Text(App.Frames(Buffer).Win, 3, 50, Cyan, " ; Lines count"); Window.Draw_Text(App.Frames(Buffer).Win, 3, 64, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 3, 66, Magenta, Handling.To_Wide_String(Line_Index_Range'Image(Dialog_Buffer_Last))); Window.Draw_Text(App.Frames(Buffer).Win, 3, 71, Cyan, " ; Overwrite"); Window.Draw_Text(App.Frames(Buffer).Win, 3, 83, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 3, 86, Magenta, Handling.To_Wide_String(Boolean'Image(Is_Overwrite))); Window.Draw_Window(App.Frames(Input).Win); if Wline /= null and then Wline'Length /= 0 then Window.Draw_Text(App.Frames(Input).Win, 1, 1, White, Wline.all); else Window.Draw_Text(App.Frames(Input).Win, 1, 1, White, ""); end if; Window.Draw_Text(App.Frames(Input).Win, 1, Current_Pos, White, ""); Dialog_Lock.Release; end Receive; if End_Of_Program then App.Desktop(2) := App.Desktop(1); App.Desktop(1) := Functions(3); App.Mode := Planning; End_Of_Program := False; exit; end if; or accept Page_Down do case View is when False => -- samples view if Samples_Index < Samples_Last then Samples_Index := Positive'Min(Samples_Index + App.Frames(Right_View).Win.Win.H/2+1, Samples_Last); else Samples_Index := Samples_Last; Text_Io.Put(Character'Val(7)); end if; when True => -- glossary view if Glossary_Index < Glossary_Last then Glossary_Index := Positive'Min(Glossary_Index + App.Frames(Right_View).Win.Win.H/2+1, Glossary_Last); else Glossary_Index := Glossary_Last; Text_Io.Put(Character'Val(7)); end if; end case; Dialog_Lock.Seize; Window.Draw_Window(App.Frames(Right_View).Win); case View is when False => if not Print_Set(Samples_Set, App.Frames(Right_View).Win, Samples_Index, Total) then Add_Line(Dialog_Buffer, Dialog_Buffer_Last, "Error during samples printing !"); end if; when True => if not Print_Set(Glossary_Set, App.Frames(Right_View).Win, glossary_Index, Total) then Add_Line(Dialog_Buffer, Dialog_Buffer_Last, "Error during glossary printing !"); end if; end case; if Wline /= null and then Wline'Length /= 0 then Window.Draw_Text(App.Frames(Input).Win, 1, 1, White, Wline.all); else Window.Draw_Text(App.Frames(Input).Win, 1, 1, White, ""); end if; Window.Draw_Text(App.Frames(Input).Win, 1, Current_Pos, White, ""); Dialog_Lock.Release; end Page_Down; or accept Page_Up do case View is when False => -- samples view if Samples_Index > App.Frames(Right_View).Win.Win.H/2 then Samples_Index := Positive'Min(Samples_Index - (App.Frames(Right_View).Win.Win.H/2-1), Samples_Last); else Samples_Index := 0; Text_Io.Put(Character'Val(7)); end if; when True => -- glossary view if Glossary_Index > App.Frames(Right_View).Win.H then Glossary_Index := Positive'Min(Glossary_Index - (App.Frames(Right_View).Win.Win.H/2-1), Glossary_Last); else Glossary_Index := 0; Text_Io.Put(Character'Val(7)); end if; end case; Dialog_Lock.Seize; Window.Draw_Window(App.Frames(Right_View).Win); case View is when False => if not Print_Set(Samples_Set, App.Frames(Right_View).Win, Samples_Index, Total) then Add_Line(Dialog_Buffer, Dialog_Buffer_Last, "Error during samples printing !"); end if; when True => if not Print_Set(Glossary_Set, App.Frames(Right_View).Win, glossary_Index, Total) then Add_Line(Dialog_Buffer, Dialog_Buffer_Last, "Error during glossary printing !"); end if; end case; if Wline /= null and then Wline'Length /= 0 then Window.Draw_Text(App.Frames(Input).Win, 1, 1, White, Wline.all); else Window.Draw_Text(App.Frames(Input).Win, 1, 1, White, ""); end if; Window.Draw_Text(App.Frames(Input).Win, 1, Current_Pos, White, ""); Dialog_Lock.Release; end Page_Up; or accept Up_Arrow do if Dialog_Buffer_index > 0 then Dialog_Buffer_Index := Dialog_Buffer_Index - 1; else Text_Io.Put(Character'Val(7)); end if; Dialog_Lock.Seize; Window.Draw_Window(App.Frames(Dialog_View).Win); if not Print_Set(Dialog_Buffer, App.Frames(Dialog_View).Win, Dialog_Buffer_Index, Total_lines) then Add_Line(Dialog_Buffer, Dialog_Buffer_Last, "Error during dialog printing !"); end if; if Wline /= null and then Wline'Length /= 0 then Window.Draw_Text(App.Frames(Input).Win, 1, 1, White, Wline.all); else Window.Draw_Text(App.Frames(Input).Win, 1, 1, White, ""); end if; Window.Draw_Text(App.Frames(Input).Win, 1, Current_Pos, White, ""); Dialog_Lock.Release; end Up_Arrow; or accept Down_Arrow do if Dialog_Buffer_Index < Dialog_Buffer_Last then Dialog_Buffer_Index := Dialog_Buffer_Index + 1; else Text_Io.Put(Character'Val(7)); end if; Dialog_Lock.Seize; Window.Draw_Window(App.Frames(Dialog_View).Win); if not Print_Set(Dialog_Buffer, App.Frames(Dialog_View).Win, Dialog_Buffer_Index, Total_lines) then Add_Line(Dialog_Buffer, Dialog_Buffer_Last, "Error during dialog printing !"); end if; if Wline /= null and then Wline'Length /= 0 then Window.Draw_Text(App.Frames(Input).Win, 1, 1, White, Wline.all); else Window.Draw_Text(App.Frames(Input).Win, 1, 1, White, ""); end if; Window.Draw_Text(App.Frames(Input).Win, 1, Current_Pos, White, ""); Dialog_Lock.Release; end Down_Arrow; or accept Left_Arrow do if Wline /= null and then Wline'Length > 0 then if Current_Pos > 1 then Current_Pos := Current_Pos - 1; Dialog_Lock.Seize; Window.Draw_Window(App.Frames(Input).Win); if Wline /= null and then Wline'Length /= 0 then Window.Draw_Text(App.Frames(Input).Win, 1, 1, White, Wline.all); else Window.Draw_Text(App.Frames(Input).Win, 1, 1, White, ""); end if; Window.Draw_Text(App.Frames(Input).Win, 1, Current_Pos, White, ""); Dialog_Lock.Release; else Text_Io.Put(Character'Val(7)); end if; end if; end Left_Arrow; or accept Right_Arrow do if Wline /= null and then Wline'Length > 0 then if Current_Pos < Wline'Length+1 then if Wline'Length >= 1 then Current_Pos := Current_Pos+1; Dialog_Lock.Seize; Window.Draw_Window(App.Frames(Input).Win); if Wline /= null and then Wline'Length /= 0 then Window.Draw_Text(App.Frames(Input).Win, 1, 1, White, Wline.all); else Window.Draw_Text(App.Frames(Input).Win, 1, 1, White, ""); end if; Window.Draw_Text(App.Frames(Input).Win, 1, Current_Pos, White, ""); Dialog_Lock.Release; else Text_Io.Put(Character'Val(7)); end if; else Text_Io.Put(Character'Val(7)); end if; end if; end Right_Arrow; --or --accept Full_Screen; or accept Del do if Wline /= null and then Wline'Length > 0 then if Current_Pos < Wline'length then if Current_Pos > 1 then Left_Buffer := new Wide_String ' (Wline(1..Current_Pos-1)); Wbuffer := new Wide_String ' (Left_Buffer.all & Wline(Current_Pos+1..Wline'Length)); else Left_Buffer := new Wide_String ' (Wline(Current_Pos+1..Wline'length)); Wbuffer := new Wide_String ' (Left_Buffer.all); end if; Wide_Free(Wline); Wline := new Wide_String ' (Wbuffer.all); Wide_Free(Wbuffer); Wide_Free(Left_Buffer); Wline_Length := Wline_Length - 1; elsif Current_Pos = Wline'length then Left_Buffer := new Wide_String ' (Wline(Wline'First..Current_Pos-1)); Wbuffer := new Wide_String ' (Left_Buffer.all); Wide_Free(Wline); Wline := new Wide_String ' (Wbuffer.all); Wide_Free(Wbuffer); Wide_Free(Left_Buffer); Wline_Length := Wline_Length - 1; else Text_Io.Put(Character'Val(7)); end if; else Text_Io.Put(Character'Val(7)); end if; Dialog_Lock.Seize; Window.Draw_Window(App.Frames(Input).Win); Window.Draw_Window(App.Frames(Buffer).Win); if App.On_Esc then Window.Draw_Text(App.Frames(Buffer).Win, 1, 2, Cyan, "one esc to quit"); else Window.Draw_Text(App.Frames(Buffer).Win, 1, 2, Cyan, "two esc to quit"); end if; Word_Number := Word_Count(Wline.all, Integer(80)); Window.Draw_Text(App.Frames(Buffer).Win, 1, 22, White, " ; Alphabet"); Window.Draw_Text(App.Frames(Buffer).Win, 1, 33, Red, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 1, 36, yellow, Alphabet); Window.Draw_Text(App.Frames(Buffer).Win, 2, 2, Cyan, "Chars max"); Window.Draw_Text(App.Frames(Buffer).Win, 2, 17, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 2, 20, Magenta, Handling.To_Wide_String(Natural'Image(App.Columns-5))); Window.Draw_Text(App.Frames(Buffer).Win, 3, 2, Cyan, "Char(s) left"); Window.Draw_Text(App.Frames(Buffer).Win, 3, 17, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 3, 20, Magenta, Handling.To_Wide_String(Natural'Image(((App.Columns- 5) - Wline_Length)))); Window.Draw_Text(App.Frames(Buffer).Win, 2, 25, Cyan, " ; word max"); Window.Draw_Text(App.Frames(Buffer).Win, 2, 39, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 2, 43, Magenta, Handling.To_Wide_String(Word_Range'Image(80))); Window.Draw_Text(App.Frames(Buffer).Win, 3, 25, Cyan, " ; Word number"); Window.Draw_Text(App.Frames(Buffer).Win, 3, 39, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 3, 43, Magenta, Handling.To_Wide_String(Word_Range'Image(Word_Number))); Window.Draw_Text(App.Frames(Buffer).Win, 2, 50, Cyan, " ; lines max"); Window.Draw_Text(App.Frames(Buffer).Win, 2, 64, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 2, 66, Magenta, Handling.To_Wide_String(Line_Index_Range'Image(2880))); Window.Draw_Text(App.Frames(Buffer).Win, 3, 50, Cyan, " ; Lines count"); Window.Draw_Text(App.Frames(Buffer).Win, 3, 64, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 3, 66, Magenta, Handling.To_Wide_String(Line_Index_Range'Image(Dialog_Buffer_Last))); Window.Draw_Text(App.Frames(Buffer).Win, 3, 71, Cyan, " ; Overwrite"); Window.Draw_Text(App.Frames(Buffer).Win, 3, 83, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 3, 86, Magenta, Handling.To_Wide_String(Boolean'Image(Is_Overwrite))); ------------------------------------------------------------------ -- Drawing then dialog info -- ------------------------------------------------------------------ if Wline /= null and then Wline'Length /= 0 then Window.Draw_Text(App.Frames(Input).Win, 1, 1, White, Wline.all); else Window.Draw_Text(App.Frames(Input).Win, 1, 1, White, ""); end if; Window.Draw_Text(App.Frames(Input).Win, 1, Current_Pos, White, ""); Dialog_Lock.Release; end Del; or accept Begin_Of do Current_Pos := 1; Dialog_Lock.Seize; Window.Draw_Window(App.Frames(Input).Win); if Wline /= null and then Wline'Length /= 0 then Window.Draw_Text(App.Frames(Input).Win, 1, 1, White, Wline.all); else Window.Draw_Text(App.Frames(Input).Win, 1, 1, White, ""); end if; Window.Draw_Text(App.Frames(Input).Win, 1, Current_Pos, White, ""); Dialog_Lock.Release; end Begin_Of; or accept End_Of do Current_Pos := Wline'Length + 1; Dialog_Lock.Seize; Window.Draw_Window(App.Frames(Input).Win); if Wline /= null and then Wline'Length /= 0 then Window.Draw_Text(App.Frames(Input).Win, 1, 1, White, Wline.all); else Window.Draw_Text(App.Frames(Input).Win, 1, 1, White, ""); end if; Window.Draw_Text(App.Frames(Input).Win, 1, Current_Pos, White, ""); Dialog_Lock.Release; end End_Of; or accept Overwrite do Is_Overwrite := not Is_Overwrite; Dialog_Lock.Seize; Window.Draw_Window(App.Frames(Buffer).Win); if App.On_Esc then Window.Draw_Text(App.Frames(Buffer).Win, 1, 2, Cyan, "one esc to quit"); else Window.Draw_Text(App.Frames(Buffer).Win, 1, 2, Cyan, "two esc to quit"); end if; Word_Number := Word_Count(Wline.all, Integer(80)); Window.Draw_Text(App.Frames(Buffer).Win, 1, 22, White, " ; Alphabet"); Window.Draw_Text(App.Frames(Buffer).Win, 1, 33, Red, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 1, 36, yellow, Alphabet); Window.Draw_Text(App.Frames(Buffer).Win, 2, 2, Cyan, "Chars max"); Window.Draw_Text(App.Frames(Buffer).Win, 2, 17, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 2, 20, Magenta, Handling.To_Wide_String(Natural'Image(App.Columns-5))); Window.Draw_Text(App.Frames(Buffer).Win, 3, 2, Cyan, "Char(s) left"); Window.Draw_Text(App.Frames(Buffer).Win, 3, 17, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 3, 20, Magenta, Handling.To_Wide_String(Natural'Image(((App.Columns- 5) - Wline_Length)))); Window.Draw_Text(App.Frames(Buffer).Win, 2, 25, Cyan, " ; word max"); Window.Draw_Text(App.Frames(Buffer).Win, 2, 39, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 2, 43, Magenta, Handling.To_Wide_String(Word_Range'Image(80))); Window.Draw_Text(App.Frames(Buffer).Win, 3, 25, Cyan, " ; Word number"); Window.Draw_Text(App.Frames(Buffer).Win, 3, 39, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 3, 43, Magenta, Handling.To_Wide_String(Word_Range'Image(Word_Number))); Window.Draw_Text(App.Frames(Buffer).Win, 2, 50, Cyan, " ; lines max"); Window.Draw_Text(App.Frames(Buffer).Win, 2, 64, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 2, 66, Magenta, Handling.To_Wide_String(Line_Index_Range'Image(2880))); Window.Draw_Text(App.Frames(Buffer).Win, 3, 50, Cyan, " ; Lines count"); Window.Draw_Text(App.Frames(Buffer).Win, 3, 64, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 3, 66, Magenta, Handling.To_Wide_String(Line_Index_Range'Image(Dialog_Buffer_Last))); Window.Draw_Text(App.Frames(Buffer).Win, 3, 71, Cyan, " ; Overwrite"); Window.Draw_Text(App.Frames(Buffer).Win, 3, 83, White, " : "); Window.Draw_Text(App.Frames(Buffer).Win, 3, 86, Magenta, Handling.To_Wide_String(Boolean'Image(Is_Overwrite))); Window.Draw_Text(App.Frames(Input).Win, 1, Current_Pos, White, ""); Dialog_Lock.Release; end Overwrite; --or --accept Full_Screen; --or --accept New_Evidence; --or -- accept Shutdown do null; -- end shutdown; or accept Dialog do if Dialog_Initialized then declare --Request : Neural_Retrain.Request_NN;  begin --Request.Respond (App.Input, App.Output); App.Output := Neural_Retrain.Respond(App.Input); exception when others => null; end; App.Dialog_Response := new Wide_String ' (Output2string(App.Output, App.Words)); --W_Io.Open(Main1, W_Io.Append_File, "/var/www/html/dialog.html", Form => "WCEM=8"); --W_Io.Put_Line(Main1, "Chaos : " & App.Dialog_Response.all & "
"); Add_Line(Html_buffer, html_Buffer.Line_Last, "Chaos : " & webOutput2string (App.Output, App.Words) & "
"); --W_Io.Put_Line(Main1, "Chaos : " & webOutput2string(App.Output, App.Words) & "
"); declare --Request : Neural_Retrain.Request_NN; begin --Request.Respond (Neural_Retrain.Input_Type(App.Output), App.Feedback); App.Feedback := Neural_Retrain.Respond(Neural_Retrain.Input_Type(App.Output)); exception when others => null; end; App.Internal := new Wide_String ' (Output2String(App.Feedback, App.Words)); --W_Io.Put_Line(Main1, "Chaos : " & App.internal.all & "
"); Add_Line(Html_buffer, html_Buffer.Line_Last, "Chaos : " & webOutput2string (App.Feedback, App.Words) & "
"); --W_Io.Put_Line(Main1, "Chaos : " & webOutput2String(App.Feedback, App.Words) & "
"); App.Input := Neural_Retrain.Input_Type(App.Feedback); --W_Io.Close(Main1); Make_Html(Html_Buffer); -------------------------------------------------- -- Drawing the results -- -------------------------------------------------- Dialog_Lock.Seize; Window.Draw_Window(App.Frames(Resp).Win); Window.Draw_Window(App.Frames(Output).Win); Window.Draw_Window(App.Frames(Dialog_View).Win); if App.Dialog_Response /= null and then App.Dialog_Response'Length /= 0 then Add_Line(Dialog_Buffer, Dialog_Buffer.Line_Last, App.Dialog_Response.all); if Total_Lines+2 >= App.Frames(Dialog_View).Win.Win.H-2 then Dialog_Buffer_Index := Dialog_Buffer_Index + App.Dialog_Response'Length/(App.Frames(Dialog_View).Win.Win.W-2) + 1; end if; Total := 0; Add_Line(App.Response_Buffer, App.Response_Buffer.Line_Last, App.Dialog_Response.all); if Print_Set(App.Response_Buffer, App.Frames(Resp).Win, 0, Total) then --Errno := System("espeak """ & Handling.To_String(App.Dialog_Response.all) & """" & Character'Val(0)); null; end if; else Add_Line(Dialog_Buffer, Dialog_Buffer.Line_Last, ""); if Total_Lines+2 >= App.Frames(Dialog_View).Win.Win.H-2 then Dialog_Buffer_Index := Dialog_Buffer_Index + 1; end if; Window.Draw_Text(App.Frames(Resp).Win, 1, 1, White, ""); end if; if App.Internal /= null and then App.Internal'Length /= 0 then Add_Line(Dialog_Buffer, Dialog_Buffer.Line_Last, App.Internal.all); if Total_Lines+2 >= App.Frames(Dialog_View).Win.Win.H-2 then Dialog_Buffer_Index := Dialog_Buffer_Index + App.internal'Length/(App.Frames(Dialog_View).Win.Win.W-2) + 1; end if; Total := 0; Add_Line(App.Internal_Buffer, Total, App.Internal.all); if Print_Set(App.Internal_Buffer, App.Frames(Output).Win, 0, Total) then --Errno := System("espeak """ & Handling.To_String(App.Internal.all) & """" & Character'Val(0)); null; end if; else Add_Line(Dialog_Buffer, Dialog_Buffer_Last, ""); if Total_Lines+2 >= App.Frames(Dialog_View).Win.Win.H-2 then Dialog_Buffer_Index := Dialog_Buffer_Index + 1; end if; Window.Draw_Text(App.Frames(Output).Win, 1, 1, White, ""); end if; if not Print_Set(Dialog_Buffer, App.Frames(Dialog_View).Win, Dialog_Buffer_Index, Total_lines) then Add_Line(Dialog_Buffer, Dialog_Buffer_Last, "Error during dialog printing !"); end if; Window.Draw_Text(App.Frames(Input).Win, 1, Current_Pos, White, ""); Dialog_Lock.Release; end if; end Dialog; end select; end loop; end loop Main_loop; --W_Io.Put_Line("Library process halted"); end Vbrain_Process; use Projects_Dll; function Get_Info(Projects : in Projects_Record; Project_Num : in Project_Num_Range) return Project_Info_Record is Curs : Projects_Dll.Cursor; First : Projects_Dll.Cursor; begin if Projects_Dll.Length(Projects.List) /= 0 then Curs := Projects_Dll.First(Projects.List); First := Curs; loop declare Current : constant Project.Project_Access := Projects_Dll.Element(Curs); begin if Current.Project_Num = Project_Num then return Project_Info_Record(Current.all); end if; end; Curs := Projects_Dll.Next(Curs); exit when Curs = First; end loop; end if; return Project_Info_Record(Null_Project); exception when others => return Project_Info_Record(Null_Project); end Get_Info; function Get_Project(Projects : in Projects_Record; Project_Num : in Project_Num_Range) return Project.Project_Access is Curs : Projects_Dll.Cursor; begin if Projects_Dll.Length(Projects.List) /= 0 then Curs := Projects_Dll.First(Projects.List); for Ier in 1..Projects_Dll.Length(Projects.List) loop declare Current : constant Project.Project_Access := Projects_Dll.Element(Curs); begin if Current.Project_Num = Project_Num then return Current; end if; end; Curs := Projects_Dll.Next(Curs); end loop; end if; return null; exception when others => return null; end Get_Project; procedure Component_Info_Draw (Name : in String; Line_Pos : in Line_Range; Width : in Column_Range; Top : in Natural := 0) is Win : Window_Record := (Line_Pos, Top+2, 3, Width, Cyan, The_Window); begin Initialize(Win, Line_Pos, Top+2, 3, Width, Cyan, Yellow); Draw_Window(Win); Draw_Text(Win, 1, 1, White, "Library name : " & Handling.To_Wide_String(Name)); end Component_Info_Draw; procedure Enlight_Component_Info_Draw (Name : in String; Line_Pos : in Line_Range; Width : in Column_Range; Top : in Natural := 0) is Win : Window_Record := (Line_Pos, Top+2, 3, Width, Cyan, The_Window); begin Initialize(Win, Line_Pos, Top+2, 3, Width, Yellow, Yellow); enlight_Window(Win); Put(Normal_Mode); Draw_Text(Win, 1, 1, White, "Library name : " & Handling.To_Wide_String(Name)); end Enlight_Component_Info_Draw; procedure Components_Print(Project : in Project_Record; Component_Index : in Natural; Highlighted : in Natural; lines : in Line_Range; columns : in Column_Range; Top : in Natural := 0) is Line_Pos : Line_Range := 7; begin if Project.Lib_Last > 0 then for Iter in Component_Index+1 .. Project.Lib_Last loop declare Libname : constant Os_Lib.String_Access := Project.Libs(Iter).Unit_Name; begin if Libname /= null then if Highlighted /= 0 and Iter = Highlighted then Enlight_Component_Info_Draw(Libname.all, Line_Pos, Columns/2-2, top); else Component_Info_Draw(Libname.all, Line_Pos, Columns/2-2, top); end if; Line_Pos := Line_Pos + 3; exit when Line_Pos >= Lines + 7; end if; end; end loop; end if; end Components_Print; procedure Archive_Info_Draw (Info : in Project_Info_Record; Line_Pos : in Line_Range; Width : in Column_Range; Top : in Natural := 0) is Win : Window_Record := (Line_Pos, Top + 2, 5, Width, Blue, The_Window); begin Initialize(Win, Line_Pos, Top+2, 5, Width, Blue, Red); Draw_Window(Win); Draw_Text(Win, 1, 1, White, "Project Name : " & Handling.To_Wide_String(Info.Project_Name.all)); Draw_Text(Win, 2, 1, White, "Version : " & Handling.To_Wide_String(Version_io.To_String(Info.Version))); Draw_Text(Win, 3, 1, White, "Elapsed : " & Handling.To_Wide_String(Long_Integer'Image(Long_Integer(Long_Integer(Info.Days) * 86400 + Long_Integer(Info.Elapsed/3600.0))/3600)) & " hours"); end Archive_Info_Draw; procedure Enlight_Archive_Info_Draw (Info : in Project_Info_Record; Line_Pos : in Line_Range; Width : in Column_Range; Top : in Natural := 0) is Win : Window_Record := (Line_Pos, Top + 2, 5, Width, Cyan, The_Window); begin Initialize(Win, Line_Pos, Top + 2, 5, Width, Magenta, Red); enlight_Window(Win); Put(Normal_Mode); Draw_Text(Win, 1, 1, White, "Project Name : " & Handling.To_Wide_String(Info.Project_Name.all)); Draw_Text(Win, 2, 1, White, "Version : " & Handling.To_Wide_String(Version_Io.To_String(Info.Version))); Draw_Text(Win, 3, 1, White, "Elapsed : " & Handling.To_Wide_String(Long_Integer'Image(Long_Integer(Long_Integer(Info.Days) * 86400 + Long_Integer(Info.Elapsed/3600.0))/3600)) & " hours"); end Enlight_Archive_Info_Draw; procedure Archives_Print(Archives : in Projects_Record; Project_Index : in Natural; Highlighted : in Project_Num_Range; lines : in Line_Range; columns : in Column_Range; Top : in Natural := 0) is Curs : Projects_Dll.Cursor; First : Projects_Dll.Cursor; Line_Pos : Line_Range := 7; begin if Projects_Dll.Length(Archives.List) /= 0 then Curs := Projects_Dll.First(Archives.List); First := Curs; for I in 1..Project_Index loop Curs := Projects_Dll.Next(Curs); end loop; loop declare The_Project : constant Project.Project_Access := Projects_Dll.Element(Curs); begin if The_Project /= null then if The_Project.Project_Num = Highlighted then Enlight_Archive_Info_Draw(Project_Info_Record(The_Project.all), Line_Pos, Columns/2-2, top); else Archive_Info_Draw(Project_Info_Record(The_Project.all), Line_Pos, Columns/2-2, top); end if; Line_Pos := Line_Pos + 5; exit when Line_Pos >= Lines; end if; end; if Curs /= Last(Archives.List) then Curs := Projects_Dll.Next(Curs); else exit; end if; end loop; end if; end Archives_Print; procedure Project_Info_Draw (Info : in Project_Info_Record; Line_Pos : in Line_Range; Width : in Column_Range; Top : in Natural := 0) is Win : Window_Record := (Line_Pos, Top + 2, 5, Width, Cyan, The_Window); begin Initialize(Win, Line_Pos, Top + 2, 5, Width, Cyan, White); Draw_Window(Win); Draw_Text(Win, 1, 1, White, "Project Name : " & Handling.To_Wide_String(Info.Project_Name.all)); Draw_Text(Win, 2, 1, White, "Version : " & Handling.To_Wide_String(Version_io.To_String(Info.Version))); Draw_Text(Win, 3, 1, White, "Project path : " & Handling.To_Wide_String(Info.Source_Path.all)); end Project_Info_Draw; procedure Enlight_Project_Info_Draw (Info : in Project_Info_Record; Line_Pos : in Line_Range; Width : in Column_Range; Top : in Natural := 0) is Win : Window_Record := (Line_Pos, Top + 2, 5, Width, Cyan, The_Window); begin Initialize(Win, Line_Pos, Top + 2, 5, Width, Green, White); enlight_Window(Win); Put(Normal_Mode); Draw_Text(Win, 1, 1, White, "Project Name : " & Handling.To_Wide_String(Info.Project_Name.all)); Draw_Text(Win, 2, 1, White, "Version : " & Handling.To_Wide_String(Version_Io.To_String(Info.Version))); Draw_Text(Win, 3, 1, White, "Project path : " & Handling.To_Wide_String(Info.Source_Path.all)); end Enlight_Project_Info_Draw; procedure Projects_Print(Projects : in Projects_Record; Project_Index : in Natural; Highlighted : in Project_Num_Range; lines : in Line_Range; columns : in Column_Range; Top : in Natural := 0) is Curs : Projects_Dll.Cursor; First : Projects_Dll.Cursor; Line_Pos : Line_Range := 7; begin if Projects_Dll.Length(Projects.List) /= 0 then Curs := Projects_Dll.First(Projects.List); First := Curs; for I in 1..Project_Index loop Curs := Projects_Dll.Next(Curs); end loop; loop declare The_Project : constant Project.Project_Access := Projects_Dll.Element(Curs); begin if The_Project /= null then if The_Project.Project_Num = Highlighted then Enlight_Project_Info_Draw(Project_Info_Record(The_Project.all), Line_Pos, Columns/2-2, top); Put(Normal_Mode); else Project_Info_Draw(Project_Info_Record(The_Project.all), Line_Pos, Columns/2-2, top); end if; Line_Pos := Line_Pos + 5; exit when Line_Pos >= Lines; end if; end; if Curs /= Last(Projects.List) then Curs := Projects_Dll.Next(Curs); else exit; end if; end loop; end if; end Projects_Print; type Part_Enum is (Creator_None, Creator_Abstract, Creator_Name, Creator_Version, Creator_Author, Creator_Library); type Part_Record is record Tag : String(1..12) := (others => Character'Val(32)); Part : Part_Enum := Creator_None; Line : Wide_String(1..78) := (others => Wide_Character ' Val (32)) ; Last : Natural := 0; Win : Window_Record; Line_Pos : Line_Range := 1; Column_Pos : Column_Range := 13; end record; type Part_Array is array (Part_Enum) of Part_Record; type Page_Curs_Type is record Parts : Part_Array; Part_Cur : Part_Enum := Creator_None; end record; type Win_Set is array (Part_Enum range Creator_Abstract .. Creator_Library) of Window_Record; procedure Cursor_Set(Curs : in out Page_Curs_Type; From : in Project_Record) is begin Wide_Fixed.Move(Handling.To_Wide_String(From.Project_Name.all), Curs.Parts(Creator_Name).Line, Error, Left); Curs.Parts(Creator_Name).Last := From.Project_Name'Length; Wide_Fixed.Move(Handling.To_Wide_String(Version_Io.To_String(From.Version)), Curs.Parts(Creator_Version).Line, Error, Left); Curs.Parts(Creator_Version).Last := Version_Io.To_String(From.Version)'Length; Wide_Fixed.Move(Handling.To_Wide_String(From.Copyright.all), Curs.Parts(Creator_Author).Line, Error, Left); Curs.Parts(Creator_Author).Last := From.Copyright'Length; Curs.Part_Cur := Creator_Library; end Cursor_Set; function Initialize (Wins : Win_Set) return Page_Curs_Type is Page_Curs : Page_Curs_Type; begin Page_Curs.Part_Cur := Creator_Abstract; Page_Curs.Parts(Creator_Abstract) := ( "Abstract : ", Creator_Abstract, (others => Wide_Character ' Val (32)), 0, Wins(Creator_Abstract), 1, 13 ); Page_Curs.Parts(Creator_Name) := ( "Name : ", Creator_Name, (others => Wide_Character ' Val (32)), 0, Wins(Creator_Name), 1, 13 ); Page_Curs.Parts(Creator_Version) := ( "Version : ", Creator_Version, (others => Wide_Character ' Val (32)), 0, Wins(Creator_Version), 1, 13 ); Page_Curs.Parts(Creator_Author) := ( "Author : ", Creator_Author, (others => Wide_Character ' Val (32)), 0, Wins(Creator_Author), 1, 13 ); Page_Curs.Parts(Creator_Library) := ( "Library : ", Creator_Library, (others => Wide_Character ' Val (32)), 0, Wins(Creator_Library), 1, 13 ); return Page_Curs; end Initialize; procedure Page_Print(Page : in Page_Curs_Type) is begin for Part in Creator_Abstract .. Page.Part_Cur loop Draw_Window(Page.Parts(Part).Win); Draw_Text(Page.Parts(Part).Win, Page.Parts(Part).Line_Pos, 1, White, Handling.To_Wide_String(Page.Parts(Part).Tag)); Draw_Text(Page.Parts(Part).Win, Page.Parts(Part).Line_Pos, Page.Parts(Part).Column_Pos, White, Page.Parts(Part).Line(1..Page.Parts(Part).Last)); end loop; end Page_Print; procedure List_Print (Project : in Project_Record; Win : in Window_Record ; Lib_Index : in Natural) is Line_Pos : Natural := 1; begin Draw_Window(Win); for Lib in Lib_Index + 1 .. Project.Lib_Last loop Draw_Text(Win, Line_Pos, 1, White, Handling.To_Wide_String(Natural'Image(Lib) & " - " & Project.Libs(Lib).Unit_Name.all)); Line_Pos := Line_Pos + 1; exit when Line_Pos > Win.win.H-2; end loop; end List_Print; type Creator_Record is record Curs : Page_Curs_Type; New_Project : Project.Project_Access; end record; function To_Project (Creator : in Creator_Record; Num : in Project_Num_Range) return Project.Project_Access is begin Creator.New_Project.Project_Num := Num; Creator.New_Project.Project_Name := new String ' ( Handling.To_String(Creator.Curs.Parts(Creator_Name).Line(1..Creator.Curs.Parts(Creator_Name).Last)) ); Creator.New_Project.Copyright := new String ' ( Handling.To_String(Creator.Curs.Parts(Creator_Author).Line(1..Creator.Curs.Parts(Creator_Author).Last)) ); Creator.New_Project.Version := Version_Io.To_Version(From => Handling.To_String(Creator.Curs.Parts(Creator_Version).Line(1..Creator.Curs.Parts(Creator_Version).Last))); return Creator.New_Project; end To_Project; procedure Write_To_Append (Filename : in String; Line : in String) is File : File_Type; begin Open(File, Append_File, Filename); Put_Line(File, Line); Close(File); end Write_To_Append; procedure List_Save (Project : in Project_Record) is Filename : constant String := Project.Project_Name.all & "-" & Version_Io.To_String(Project.Version) & '/' & "Project.lst"; File : File_Type; begin if Project.Lib_Last /= 0 then Create(File, Out_File, filename); Put_Line(File, Project.Project_Name.all); Put_Line(File, Project.Project_Name.all); for lib in 1..Project.Lib_Last loop Put_Line(File, Project.Libs(Lib).Unit_Name.all); end loop; Close(File); end if; end List_Save; procedure Make_Project (Creator : in Creator_Record) is Info : constant Project_Info_Record := Project_Info_record(Creator.New_Project.all); begin -- mkdir $project-$2 Make_Dir(Creator.New_Project.Project_Name.all & "-" & Version_Io.To_String(Creator.New_Project.Version)); -- cd $project-$2 Change_Dir(Creator.New_Project.Project_Name.all & "-" & Version_Io.To_String(Creator.New_Project.Version)); -- gunzip ./.Ada/Ada_Empty-6.4.0.tar.gz Declare Success : Boolean; Args : Argument_List_Access := Argument_String_To_List("../.Ada/Ada_Empty-6.4.0.tar.gz"); Begin Spawn(Locate_Exec_On_Path("gunzip").all, Args.all, Success); End; -- tar -x -v -f ./.Ada/Ada_Empty-6.4.0.tar Declare Success : Boolean; Args : Argument_List_Access := Argument_String_To_List("-x -v -f ../.Ada/Ada_Empty-6.4.0.tar"); Begin Spawn(Locate_Exec_On_Path("tar").all, Args.all, Success); End; -- gzip ./.Ada/Ada_Empty-6.4.0.tar Declare Success : Boolean; Args : Argument_List_Access := Argument_String_To_List("../.Ada/Ada_Empty-6.4.0.tar"); Begin Spawn(Locate_Exec_On_Path("gzip").all, Args.all, Success); End; -- make pre Declare Success : Boolean; Args : Argument_List_Access := Argument_String_To_List("pre tail head"); Begin Spawn(Locate_Exec_On_Path("make").all, Args.all, Success); End; Write_To_Append("Abstract.txt", Handling.To_String(Creator.Curs.Parts(Creator_Abstract).Line(1..Creator.Curs.Parts(Creator_Abstract).Last))); Write_To_Append("Project.lst", Handling.To_String(Creator.Curs.Parts(Creator_Name).Line(1..Creator.Curs.Parts(Creator_Name).Last))); Write_To_Append("Project.lst", Handling.To_String(Creator.Curs.Parts(Creator_Name).Line(1..Creator.Curs.Parts(Creator_Name).Last))); for Lib in 1..Creator.New_Project.Lib_Last loop Write_To_Append("Project.lst", Creator.New_Project.Libs(Lib).Unit_Name.all); end loop; Write_To_Append("Versions.lst", Version_Io.To_String(Creator.New_Project.Version)); Write_To_Append("Copyright", Handling.To_String(Creator.Curs.Parts(Creator_Author).Line(1..Creator.Curs.Parts(Creator_Author).Last))); Declare Success : Boolean; Args : Argument_List_Access := Argument_String_To_List("prepare project all"); Begin Spawn(Locate_Exec_On_Path("make").all, Args.all, Success); End; Change_Dir(".."); end Make_Project; -- upgrade of 1 the Revision of Version function Update (Info : Project_Info_Record; Version : in M.Versions.Version_Type; Sessions : in out Session_Array; Logs : in out Log_Array) return Integer is Errno : Integer := 0; begin Put_Line("version " & Info.Project_Name.all & ' ' & Integer'Image(Info.Version.Major_Version)(2..Integer'Image(Info.Version.Major_Version)'Last) & ' ' & Integer'Image(Info.Version.Minor_Version)(2..Integer'Image(Info.Version.Minor_Version)'Last) & ' ' & Integer'Image(Info.Version.Revision_Version)(2..Integer'Image(Info.Version.Revision_Version)'Last) & ' ' & Info.Version.Release_Version); Put_Line("Upgrade " & Integer'Image(Version.Major_Version)(2..Integer'Image(Version.Major_Version)'Last) & ' ' & Integer'Image(Version.Minor_Version)(2..Integer'Image(Version.Minor_Version)'Last) & ' ' & Integer'Image(Version.Revision_Version)(2..Integer'Image(Version.Revision_Version)'Last) & ' ' & Version.Release_Version); Text_Io.Put_Line("cp -r " & Info.Project_Name.all & '-' & To_String(Info.Version) & ' ' & Info.Project_Name.all & '-' & To_String(Version) & Character'Val(0)); Declare Success : Boolean; Args : Argument_List_Access := Argument_String_To_List("-r " & Info.Project_Name.all & '-' & To_String(Info.Version) & ' ' & Info.Project_Name.all & '-' & To_String(Version)); Begin Spawn(Locate_Exec_On_Path("cp").all, Args.all, Success); --Errno := System("cp -r " & Info.Project_Name.all & '-' & To_String(Info.Version) & ' ' & Info.Project_Name.all & '-' & To_String(Version) & Character'Val(0)); End; Text_Io.Put_Line("cp " & Info.Project_Name.all & '-' & To_String(Info.Version) & "/log/Todo.lst" & '-' & To_String(Info.Version) & ' ' & Info.Project_Name.all & '-' & To_String(Version) & "/log/Todo.lst" & '-' & To_String(Version) & Character'Val(0)); Declare Success : Boolean; Args : Argument_List_Access := Argument_String_To_List(Info.Project_Name.all & '-' & To_String(Info.Version) & "/log/Todo.lst" & '-' & To_String(Info.Version) & ' ' & Info.Project_Name.all & '-' & To_String(Version) & "/log/Todo.lst" & '-' & To_String(Version)); Begin Spawn(Locate_Exec_On_Path("cp").all, Args.all, Success); End; Text_Io.Put_Line("emacs " & Info.Project_Name.all & '-' & To_String(Version) & "/log/Todo.lst" & '-' & To_String(Version) & Character'Val(0)); Declare Success : Boolean; Args : Argument_List_Access := Argument_String_To_List(Info.Project_Name.all & '-' & To_String(Version) & "/log/Todo.lst" & '-' & To_String(Version)); Begin Spawn(Locate_Exec_On_Path("emacs").all, Args.all, Success); End; declare File : Text_Io.File_Type; begin Create(File, Out_File, Info.Project_Name.all & '-' & To_String(Version) & "/Versions.lst"); Put_Line(File, To_String(Version)); Close(File); end; Open(App.Sessions(M.Logs.Project)); Declare Success : Boolean; Args : Argument_List_Access := Argument_String_To_List(Info.Project_Name.all & '-' & To_String(Version) & '/' & Info.Project_Name.all & '/' & Info.Project_Name.all & "/src/" & Info.Project_Name.all & ".adb"); Begin Spawn(Locate_Exec_On_Path("emacs").all, Args.all, Success); End; Close(Sessions(M.Logs.Project)); Statistic(Sessions, Logs); Open(App.Sessions(Howto)); Declare Success : Boolean; Args : Argument_List_Access := Argument_String_To_List(Info.Project_Name.all & '-' & To_String(Version) & '/' & "HOWTO"); Begin Spawn(Locate_Exec_On_Path("emacs").all, Args.all, Success); End; Close(Sessions(Howto)); Statistic(Sessions, Logs); Open(App.Sessions(HISTORY)); Declare Success : Boolean; Args : Argument_List_Access := Argument_String_To_List(Info.Project_Name.all & '-' & To_String(Version) & '/' & "HISTORY"); Begin Spawn(Locate_Exec_On_Path("emacs").all, Args.all, Success); End; Close(Sessions(HISTORY)); Statistic(Sessions, Logs); Declare Success : Boolean; Args : Argument_List_Access := Argument_String_To_List(Info.Project_Name.all & '-' & To_String(Version) & "/doc/man/man1/" & Info.Project_Name.all & ".1.gz"); Begin Spawn(Locate_Exec_On_Path("gunzip").all, Args.all, Success); End; Open(App.Sessions(Manpage)); Declare Success : Boolean; Args : Argument_List_Access := Argument_String_To_List(Info.Project_Name.all & '-' & To_String(Version) & "/doc/man/man1/" & Info.Project_Name.all & ".1"); Begin Spawn(Locate_Exec_On_Path("emacs").all, Args.all, Success); End; Declare Success : Boolean; Args : Argument_List_Access := Argument_String_To_List(Info.Project_Name.all & '-' & To_String(Version) & "/doc/man/man1/" & Info.Project_Name.all & ".1"); Begin Spawn(Locate_Exec_On_Path("gzip").all, Args.all, Success); End; Close(Sessions(Manpage)); Statistic(Sessions, Logs); Open(App.Sessions(Makefile)); Declare Success : Boolean; Args : Argument_List_Access := Argument_String_To_List(Info.Project_Name.all & '-' & To_String(Version) & "/Makefile"); Begin Spawn(Locate_Exec_On_Path("emacs").all, Args.all, Success); End; Close(Sessions(Makefile)); Statistic(Sessions, Logs); Declare Success : Boolean; Args : Argument_List_Access := Argument_String_To_List("-C " & Info.Project_Name.all & '-' & To_String(Version) & " head tail msg all enlight-sources clean"); Begin Spawn(Locate_Exec_On_Path("make").all, Args.all, Success); End; Errno := 0; return errno; end Update; procedure Remove_Name(Project : in out Project_Record; Lib_Num : in Natural) is begin if Lib_Num = 0 then return; end if; if Lib_Num < Project.Lib_Last then for Iter in Lib_Num..Project.Lib_Last - 1 loop Project.Libs(Iter) := Project.Libs(Iter + 1); Project.Libs(Project.Lib_last) := Null_Component; Project.Lib_Last := Project.Lib_Last - 1; end loop; else Project.Libs(Project.Lib_last) := Null_Component; Project.Lib_Last := Project.Lib_Last - 1; end if; end Remove_Name; type Project_Manager_Record is new Creator_Record; use Abstract_Vectors; procedure Highlight_Program_Draw (Obj : Abstract_Access; Line : in Positive;Width : in Positive; Top : in Natural) is Win : Window_Record := (Line, Top+2, 6, Width, Cyan, The_Window); begin Initialize(Win, Line, Top+2, 6, Width, Magenta, White); Enlight_Window(Win); Text_Io.Put(Normal_Mode); Draw_Text(Win, 1, 1, White, "Name : " & Obj.Info.Name.all); Draw_Text(Win, 2, 1, White, "Date : " & Handling.To_Wide_String(Formatting.Image(Obj.Date))); Draw_Text(Win, 3, 1, White, "Locality : " & Obj.Locality.all); Draw_Text(Win, 4, 1, White, "define : " & Obj.Define.all); end Highlight_Program_Draw; procedure Program_Draw (Obj : Abstract_Access; Line : in Positive;Width : in Positive; Top : in Natural) is Win : Window_Record := (Line, Top+2, 6, Width, Cyan, The_Window); begin Initialize(Win, Line, Top+2, 6, Width, Green, White); Draw_Window(Win); Draw_Text(Win, 1, 1, White, "Name : " & Obj.Info.Name.all); Draw_Text(Win, 2, 1, White, "Date : " & Handling.To_Wide_String(Formatting.Image(Obj.Date))); Draw_Text(Win, 3, 1, White, "Locality : " & Obj.Locality.all); Draw_Text(Win, 4, 1, White, "define : " & Obj.Define.all); end Program_Draw; procedure Highlight_Plan_Draw (Obj : Abstract_Access; Line : in Positive;Width : in Positive; Top : in Natural) is Win : Window_Record := (Line, Top+2, 6, Width, Blue, The_Window); begin Initialize(Win, Line, Top+2, 6, Width, Yellow, White); Enlight_Window(Win); Text_Io.Put(Normal_Mode); Draw_Text(Win, 1, 1, White, "Name : " & Obj.Info.Name.all); Draw_Text(Win, 2, 1, White, "Date : " & Handling.To_Wide_String(Formatting.Image(Obj.Date))); Draw_Text(Win, 3, 1, White, "Locality : " & Obj.Locality.all); Draw_Text(Win, 4, 1, White, "define : " & Obj.Define.all); end Highlight_Plan_Draw; procedure Plan_Draw (Obj : Abstract_Access; Line : in Positive;Width : in Positive; Top : in Natural) is Win : Window_Record := (Line, Top+2, 6, Width, Blue, The_Window); begin Initialize(Win, Line, Top+2, 6, Width, Blue, White); Draw_Window(Win); Draw_Text(Win, 1, 1, White, "Name : " & Obj.Info.Name.all); Draw_Text(Win, 2, 1, White, "Date : " & Handling.To_Wide_String(Formatting.Image(Obj.Date))); Draw_Text(Win, 3, 1, White, "Locality : " & Obj.Locality.all); Draw_Text(Win, 4, 1, White, "define : " & Obj.Define.all); end Plan_Draw; procedure Planning_Draw (Planning : in Abstract_Vectors.Vector;Index : in Natural; Width : in Positive; Top : in Natural) is Count : Natural := 1; begin if Abstract_Vectors.Is_empty(Planning) then return; end if; for Plan in Index+1..natural'Min(Index + (App.Lines-5) / 6, Integer(Abstract_Vectors.Length(Planning))) loop declare E : Abstract_Access := Abstract_Vectors.Element(Planning, Abstract_Index(Plan)); begin if E.Tag = M.Program then if Clock - (86400.0 * 90.0) < E.Date and then E.Date + E.Period < Clock + (86400.0 * 90.0) then Highlight_Program_Draw(E, Count+1, width, Top); else Program_Draw(E, Count+1, width, Top); end if; Count := Count + 6; else if Clock - (86400.0 * 90.0) < E.Date and then E.Date + E.Period < Clock + (86400.0 * 90.0) then Highlight_Plan_Draw(E, Count+1, width, Top); else Plan_Draw(E, Count+1, width, Top); end if; Count := Count + 6; end if; end; end loop; end Planning_Draw; procedure To_Planning (Obj : in Abstract_Access;Vector : in out Abstract_Vectors.Vector) is begin if Obj = null then return; end if; if Obj.all in Classes.Program_Class | Event_Class | Rendezvous_Class | Meeting_Class | Job_Class then Vector := Vector & Obj; end if; if Abstract_Vectors.Length(Obj.Childs) /= 0 then for Child in 1..Abstract_Vectors.Length(Obj.Childs) loop declare E : constant Abstract_Access := Abstract_Vectors.Element(Obj.Childs, Abstract_Index(Child)); begin To_Planning(E, Vector); end; end loop; end if; end To_Planning; Project_Index : Project_Num_Range := 0; Project_Count : Natural := 0; Curs : Projects_Dll.Cursor; Creator : Creator_Record; Project_Manager : Project_Manager_Record; Project_Num : Project_Num_Range := 0; task body Planning_Process is Main_Win : Window_Record := (1, 1, App.Lines-3, App.Columns/2, White, The_Window); Planning : Abstract_Vectors.Vector; Plan_Index : Natural := 0; begin Main_Loop: loop loop select accept Receive (Wchar : in Wide_Character) do case Wchar is when Wide_Character'Val(10) => App.Desktop(2) := App.Desktop(1); App.Desktop(1) := Functions(4); App.Mode := Manager; when others => null; end case; end Receive; if App.Mode = Manager then if Is_Regular_File("Projects.lst") then App.Projects.List := Projects_Manager.Projects_Dll.Empty_List; Text_Io.Put_Line("Loading Projects.lst.."); Projects_Manager.Manager_Load(App.Projects, "Projects.lst"); App.Projects.Projects_Num := App.Projects.Projects_Num + 1; Projects_Manager.Projects_Dll.Append(App.Projects.List, new Project_Record ' (Null_Project)); if Project_Manager.New_Project /= null then Project.Close(Project_Manager.New_Project.all, Clock); end if; Project_Count := 0; Project_Index := 0; Curs := First(App.Projects.List); Project_Num := First_Element(App.Projects.List).Project_Num; --Project_Manager.New_Project := Get_Project(App.Projects, Project_Num); Text_Io.Put_Line("Done."); end if; Manager_Record(App.Desktop(1).all).Proc.Suspend; Manager_Record(App.Desktop(1).all).Proc.Wake_up(0); end if; exit; or accept Halt; exit Main_Loop; or accept Wake_Up(Top : in Natural) do Initialize(Main_Win, 1, TOP+1, App.Lines-3, App.Columns/2, White, Cyan); Enlight_Window(Main_Win); Text_Io.Put(Normal_Mode); Planning := Abstract_Vectors.Empty_Vector; To_Planning(App.Terminal.Root, Planning); Plan_Index := 0; if Abstract_Vectors.Length(Planning) /= 0 then Date_Sorting.Sort(Planning); for I in 1..Abstract_Vectors.Length(Planning) loop declare E : constant Abstract_Access := Element(Planning, Abstract_Index(I)); begin if E.date+E.Period + (86400.0 * 3.0) < clock then Plan_Index := Plan_Index + 1; end if; end; end loop; Planning_Draw(Planning, Plan_Index, App.Columns/2-2, Top); end if; end Wake_Up; or accept Suspend; exit; or accept Page_Down; or accept Page_Up; or accept Up_Arrow do If Plan_Index > 0 then Plan_Index := Plan_Index - 1; Enlight_Window(Main_Win); Text_Io.Put(Normal_Mode); Planning_Draw(Planning, Plan_Index, App.Columns/2-2, 0); end if; end Up_Arrow; or accept Down_Arrow do if Abstract_Vectors.Length(Planning) /= 0 then if Plan_Index + 1 < Integer(Abstract_Vectors.Length(Planning)) then Plan_Index := Plan_Index + 1; Enlight_Window(Main_Win); Text_Io.Put(Normal_Mode); Planning_Draw(Planning, Plan_Index, App.Columns/2-2, 0); end if; end if; end Down_Arrow; or accept Left_Arrow; or accept Right_Arrow; or accept Begin_Of; or accept End_Of; or accept Del; or accept Overwrite; end select; end loop; loop select accept Halt; exit Main_Loop; or accept Suspend; or accept Wake_Up(Top : in Natural) do Initialize(Main_Win, 1, TOP+1, App.Lines-3, App.Columns/2, White, Cyan); Enlight_Window(Main_Win); Text_Io.Put(Normal_Mode); Planning := Abstract_Vectors.Empty_Vector; To_Planning(App.Terminal.Root, Planning); Plan_Index := 0; if Abstract_Vectors.Length(Planning) /= 0 then Date_Sorting.Sort(Planning); for I in 1..Abstract_Vectors.Length(Planning) loop declare E : constant Abstract_Access := Element(Planning, Abstract_Index(I)); begin if E.date+E.Period + (86400.0 * 3.0) < clock then Plan_Index := Plan_Index + 1; end if; end; end loop; Planning_Draw(Planning, Plan_Index, App.Columns/2-2, Top); end if; end Wake_Up; exit; end select; end loop; end loop Main_Loop; --W_Io.Put_Line("Planning process halted"); end Planning_Process; --------------------------------------------------------------------------------------------------------------- -- -- -- Ada projects manager -- -- -- --------------------------------------------------------------------------------------------------------------- task body Manager_Process is Creator_Abs : Window_Record := (1, 1, 3, App.Columns/2, Blue, The_Window); Creator_N : Window_Record := (4, 1, 3, App.Columns/2, Blue, The_Window); Creator_Ver : Window_Record := (App.Lines-8, 1, 3, App.Columns/2, Blue, The_Window); Creator_Auth : Window_Record := (App.Lines-5, 1, 3, App.Columns/2, Blue, The_Window); Creator_List : Window_Record := (7, 1, App.Lines-15, App.Columns/2, Blue, The_Window); Creator_Lib : Window_Record := (App.Lines-2, 1, 3, App.Columns/2, Blue, The_Window); Manager_Abs : Window_Record := (1, 1, 3, App.Columns/2, Blue, The_Window); Manager_N : Window_Record := (4, 1, 3, App.Columns/2, Blue, The_Window); Manager_Ver : Window_Record := (App.Lines-8, 1, 3, App.Columns/2, Blue, The_Window); Manager_Auth : Window_Record := (App.Lines-5, 1, 3, App.Columns/2, Blue, The_Window); Manager_List : Window_Record := (7, 1, App.Lines-15, App.Columns/2, Blue, The_Window); Manager_Cmd : Window_Record := (App.Lines-2, 1, 3, App.Columns/2, Blue, The_Window); Project_Info : Project_Info_Record; Project_Header : Window_Record := (1, 1, 5, App.Columns/2, Blue, The_Window); Project_Selector : Window_Record := (6, 1, App.Lines - 5, App.Columns/2, Blue, The_Window); Components_Win : Window_Record := (6, 1, (App.Lines - 8)/2, App.Columns/2, Blue, The_Window); Make_Win : Window_Record := (6 + (App.Lines - 8)/2+1, 1, (App.Lines - 8)/2, App.Columns/2, White, The_Window); type Step_Enum is (Prj_None, Prj_Selector, Prj_Archives, Prj_Components, Prj_Creator, Prj_Manager, Prj_Editor, Prj_Lib_Remove, Prj_Upgrade, Prj_help); type Upgrade_Cmd_Enum is (None, Remove, Add, Make, Upgrade, quit, help); function Value (Line : in String) return Upgrade_Cmd_Enum is begin if Index(Line, " ") /= 0 then return Upgrade_Cmd_Enum'Value(Line(Line'First..Index(Line, " ")-1)); else return Upgrade_Cmd_Enum'Value(Line); end if; exception when Constraint_Error => return None; end Value; type Lang_Enum is (En, Fr, C); Lang : Lang_Enum := En; Color : constant String := Character'Val(27) & "[01;36m"; Normal : constant String := Character'Val(27) & "[00m"; En_Msg : constant String := "Hello"; Fr_Msg : constant String := "Salut"; C_Msg : constant String := "Error"; User_Val : constant String := "USER"; Lang_Val : constant String := "LANG"; The_World : constant String := "world"; The_Msg : constant String := "Hello"; The_User : Os_Lib.String_Access; The_Lang : Os_Lib.String_Access; procedure Draw_Header(Project : in Project_Record; Project_Header : in Window_Record) is begin if Project /= Null_Project then if The_User /= null then case Lang is when Fr => Draw_Text(Project_Header, 1, 1, White, Wide_Fixed."*"((The_User'Length+Fr_Msg'Length+10), '-')); Draw_Text(Project_Header, 2, 1, White, Handling.To_Wide_String("-- " & Fr_Msg & ' ' & Color & The_User.all & Normal & " ! " & " --")); Draw_Text(Project_Header, 3, 1, White, Wide_Fixed."*"((The_User'Length+fr_Msg'Length+10), '-')); Draw_Text(Project_Header, 1, (The_User'Length+fr_Msg'Length+10)+2, White, "Project name : " & Handling.To_Wide_String(Project.Project_Name.all)); Draw_Text(Project_Header, 2, (The_User'Length+fr_Msg'Length+10)+2, White, "Elapsed : " & Handling.To_Wide_String(Long_Integer'Image(Long_Integer(Project.Days) * 86400 + Long_Integer(Project.Elapsed) / 3600)) & " hours"); when En => Draw_Text(Project_Header, 1, 1, White, Wide_Fixed."*"((The_User'Length+En_Msg'Length+10), '-')); Draw_Text(Project_Header, 2, 1, White, Handling.To_Wide_String("-- " & En_Msg & ' ' & Color & The_User.all & Normal & " ! " & " --")); Draw_Text(Project_Header, 3, 1, White, Wide_Fixed."*"((The_User'Length+En_Msg'Length+10), '-')); Draw_Text(Project_Header, 1, (The_User'Length+En_Msg'Length+10)+2, White, "Project name : " & Handling.To_Wide_String(Project.Project_Name.all)); Draw_Text(Project_Header, 2, (The_User'Length+En_Msg'Length+10)+2, White, "Elapsed : " & Handling.To_Wide_String(Long_Integer'Image((Long_Integer(Project.Days) * 86400 + Long_Integer(Project.Elapsed)) / 3600)) & " hours"); when C => Draw_Text(Project_Header, 1, 1, White, Wide_Fixed."*"((The_User'Length+C_Msg'Length+10), '-')); Draw_Text(Project_Header, 2, 1, White, Handling.To_Wide_String("-- " & C_Msg & ' ' & Color & The_User.all & Normal & " ! " & " --")); Draw_Text(Project_Header, 3, 1, White, Wide_Fixed."*"((The_User'Length+C_Msg'Length+10), '-')); Draw_Text(Project_Header, 1, (The_User'Length+C_Msg'Length+10)+2, White, "Project name : " & Handling.To_Wide_String(Project.Project_Name.all)); Draw_Text(Project_Header, 2, (The_User'Length+C_Msg'Length+10)+2, White, "Elapsed : " & Handling.To_Wide_String(Long_Integer'Image((Long_Integer(Project.Days) * 86400 + Long_Integer(Project.Elapsed)) / 3600)) & " hours"); end case; else Draw_Text(Project_Header, 1, 1, White, Wide_Fixed."*"((The_World'Length+The_Msg'Length+10), '-')); Draw_Text(Project_Header, 2, 1, White, Handling.To_Wide_String("-- " & The_Msg & ' ' & Color & The_world & Normal & " ! " & " --")); Draw_Text(Project_Header, 3, 1, White, Wide_Fixed."*"((The_World'Length+The_Msg'Length+10), '-')); Draw_Text(Project_Header, 1, (The_World'Length+The_Msg'Length+10)+2, White, "Project name : " & Handling.To_Wide_String(Project.Project_Name.all)); Draw_Text(Project_Header, 2, (The_World'Length+The_Msg'Length+10)+2, White, "Elapsed : " & Handling.To_Wide_String(Long_Integer'Image((Long_Integer(Project.Days) * 86400 + Long_Integer(Project.Elapsed)) / 3600)) & " hours"); end if; end if; end Draw_Header; Arch_Num : Project_Num_Range := 1; Arch_Index : Project_Num_Range := 0; Arch_Count : Natural := 0; Arch_Curs : Projects_Dll.Cursor; Component_Cur : Natural := 0; Component_Index : Natural := 0; Step_Cur : Step_Enum := Prj_Selector; Upgraded : Project.Project_Access; Lib_Index : Natural := 0; Lib_Name : Wide_String(1..3) := (others => Wide_Character'Val(32)); Lib_Name_Last : Natural := 0; Line_Remove : Boolean := False; Line_Num : Natural := 0; Cmd_line : Wide_String(1..256) := (others => Wide_Character'Val(0)); Cmd_Last : Natural := 0; Cmd : Upgrade_Cmd_Enum := None; Make_On_Bin : constant Os_Lib.String_Access := Locate_Exec_On_Path("make"); Args : Argument_List_Access := Argument_String_To_List("all"); Outfilename : constant String := "sky-spawn.stdout"; File_Set : Wide_Set(65536); File_Index : Natural := 0; Line_Last : Natural := 0; Success : Boolean := False; Total_Lines : Natural := 0; Gnose_Context : constant access Gnos_Projects.Projects_Context_Record := new gnos_Projects.Projects_Context_Record; Project_Context : constant access Agnose_Projects.Projects_Context_Record := new Agnose_Projects.Projects_Context_Record; Top : Natural := 0; Pid : Process_Id; Errno : Integer := 0; begin Initialize(Creator_Abs, 1, 1, 3, App.Columns/2, Blue, White); Initialize(Creator_N, 4, 1, 3, App.Columns/2, Blue, White); Initialize(Creator_Ver, App.Lines-8, 1, 3, App.Columns/2, Blue, White); Initialize(Creator_Auth, App.Lines-5, 1, 3, App.Columns/2, Blue, White); Initialize(Creator_List, 7, 1, App.Lines-15, App.Columns/2, Blue, White); Initialize(Creator_Lib, App.Lines-2, 1, 3, App.Columns/2, Blue, white); Initialize(Manager_Abs, 1, 1, 3, App.Columns/2, Blue, White); Initialize(Manager_N, 4, 1, 3, App.Columns/2, Blue, White); Initialize(Manager_Ver, App.Lines-8, 1, 3, App.Columns/2, Blue, White); Initialize(Manager_Auth, App.Lines-5, 1, 3, App.Columns/2, Blue, White); Initialize(Manager_List, 7, 1, App.Lines-15, App.Columns/2, Blue, White); Initialize(Manager_cmd, App.Lines-2, 1, 3, App.Columns/2, Blue, white); Initialize(Project_Header, 1, 1, 5, App.Columns/2, Blue, White); Initialize(Project_Selector, 6, 1, App.Lines - 5, App.Columns/2, Blue, White); Initialize(Components_Win, 6, 1, (App.Lines - 8)/2+1, App.Columns/2, Blue, Red); Initialize(Make_Win, 6 + (App.Lines - 8)/2+1, 1, (App.Lines - 8)/2, App.Columns/2, White, Magenta); declare begin The_User := Getenv(User_Val); The_Lang := Getenv(Lang_Val); if The_Lang /= null then begin Lang := Lang_Enum'Value(The_Lang.all(1..2)); exception when Constraint_Error => W_Io.Put_Line("Uncknow language ; "); end; end if; Main_Loop: loop loop select accept Halt do null; end Halt; exit Main_Loop; or accept Suspend; or accept Wake_Up(Top : in Natural) do Manager_Process.Top := Top; Initialize(Creator_Abs, 1, Top+1, 3, App.Columns/2, Blue, White); Initialize(Creator_N, 4, Top+1, 3, App.Columns/2, Blue, White); Initialize(Creator_Ver, App.Lines-8, Top+1, 3, App.Columns/2, Blue, White); Initialize(Creator_Auth, App.Lines-5, Top+1, 3, App.Columns/2, Blue, White); Initialize(Creator_List, 7, Top+1, App.Lines-15, App.Columns/2, Blue, White); Initialize(Creator_Lib, App.Lines-2, Top+1, 3, App.Columns/2, Blue, white); Initialize(Manager_Abs, 1, Top+1, 3, App.Columns/2, Blue, White); Initialize(Manager_N, 4, Top+1, 3, App.Columns/2, Blue, White); Initialize(Manager_Ver, App.Lines-8, Top+1, 3, App.Columns/2, Blue, White); Initialize(Manager_Auth, App.Lines-5, Top+1, 3, App.Columns/2, Blue, White); Initialize(Manager_List, 7, 1, App.Lines-15, App.Columns/2, Blue, White); Initialize(Manager_cmd, App.Lines-2, Top+1, 3, App.Columns/2, Blue, white); Initialize(Project_Header, 1, Top+1, 5, App.Columns/2, Blue, White); Initialize(Project_Selector, 6, Top+1, App.Lines - 5, App.Columns/2, Blue, White); Initialize(Components_Win, 6, Top+1, (App.Lines - 8)/2+1, App.Columns/2, Blue, Red); Initialize(Make_Win, 6 + (App.Lines - 8)/2+1, Top+1, (App.Lines - 8)/2, App.Columns/2, White, Magenta); ----------------------------------------------- --Errno := System("clear" & Character'Val(0)); ----------------------------------------------- if Curs = Projects_Dll.No_Element then Project_Num := 0; if Projects_Dll.Length(App.Projects.List) = 1 then Curs := first(App.Projects.List); Project_Num := First_Element(App.Projects.List).Project_Num; Project_Manager.New_Project := Get_Project(App.Projects, Project_Num); elsif Projects_Dll.Length(App.Projects.List) > 1 then Curs := First(App.Projects.List); Project_Num := First_Element(App.Projects.List).Project_Num; Project_Manager.New_Project := Get_Project(App.Projects, Project_Num); end if; end if; if Arch_Curs = Projects_Dll.No_Element then if Length(App.Archives.List) > 0 then Arch_Curs := First(App.Archives.List); end if; end if; end Wake_Up; case Step_Cur is when Prj_Archives => Draw_Window(Project_Header); Draw_Window(Project_Selector); if Length(App.Archives.List) /= 0 then Archives_Print(App.Archives, Arch_Index, Arch_Num, App.Lines, App.Columns, top); end if; when Prj_Components => null; when Prj_Selector => Draw_Window(Project_Header); if Project_Manager.New_Project /= null then Draw_Header(Project_Manager.New_Project.all, Project_Header); else Draw_Header(Null_Project, Project_Header); end if; Draw_Window(Project_Selector); Projects_Print(App.Projects, Project_Index, Project_Num, App.Lines, App.Columns, top); when Prj_Creator => Draw_Window(Creator_Abs); Draw_Text(Creator_Abs, 1, 1, White, "Abstract : "); Draw_Window(Creator_N); Draw_Text(Creator_N, 1, 1, White, "Name : "); Draw_Window(Creator_Ver); Draw_Text(Creator_Ver, 1, 1, White, "Version : "); Draw_Window(Creator_Auth); Draw_Text(Creator_Auth, 1, 1, White, "Author : "); Draw_Window(Creator_List); if Creator.New_Project /= null then List_Print(Creator.New_Project.all, Creator_List, Lib_Index); end if; Draw_Window(Creator_Lib); Draw_Text(Creator_Lib, 1, 1, White, "Library : "); Page_Print(Creator.Curs); Draw_Text( Creator.Curs.Parts(Creator.Curs.Part_Cur).Win, Creator.Curs.Parts(Creator.Curs.Part_Cur).Line_Pos, Creator.Curs.Parts(Creator.Curs.Part_Cur).Column_Pos, White, Creator.Curs.Parts (Creator.Curs.Part_Cur).Line(1..Creator.Curs.Parts(Creator.Curs.Part_Cur).Last) ); when Prj_Lib_Remove => Draw_Window(Creator_Abs); Draw_Text(Creator_Abs, 1, 1, White, "Abstract : "); Draw_Window(Creator_N); Draw_Text(Creator_N, 1, 1, White, "Name : "); Draw_Window(Creator_Ver); Draw_Text(Creator_Ver, 1, 1, White, "Version : "); Draw_Window(Creator_Auth); Draw_Text(Creator_Auth, 1, 1, White, "Author : "); Draw_Window(Creator_List); List_Print(Creator.New_Project.all, Creator_List, Lib_Index); Draw_Window(Creator_Lib); Draw_Text(Creator_Lib, 1, 1, White, "Library : "); Page_Print(Creator.Curs); Draw_Text( Creator.Curs.Parts(Creator.Curs.Part_Cur).Win, Creator.Curs.Parts(Creator.Curs.Part_Cur).Line_Pos, Creator.Curs.Parts(Creator.Curs.Part_Cur).Column_Pos, White, Creator.Curs.Parts (Creator.Curs.Part_Cur).Line(1..Creator.Curs.Parts(Creator.Curs.Part_Cur).Last) ); if Lib_Name_Last > 0 then Draw_Text(Creator_Lib, 1, 1, White, "Line num : " & Lib_Name(1..Lib_Name_last)); else Draw_Text(Creator_Lib, 1, 1, White, "Line num : "); end if; when Prj_Manager => Draw_Window(Manager_Abs); Draw_Text(Manager_Abs, 1, 1, White, "Abstract : "); Draw_Window(Manager_N); Draw_Text(Manager_N, 1, 1, White, "Name : " & Handling.To_Wide_String(Project_Manager.New_Project.Project_Name.all)); Draw_Window(Manager_Ver); Draw_Text(Manager_Ver, 1, 1, White, "Version : " & Handling.To_Wide_String(Version_Io.To_String(Project_Manager.New_Project.Version))); Draw_Window(Manager_Auth); Draw_Text(Manager_Auth, 1, 1, White, "Author : " & Handling.To_Wide_String(Project_Manager.New_Project.Copyright.all)); Draw_Window(Manager_List); List_Print(Project_Manager.New_Project.all, Manager_List, Lib_Index); Draw_Window(Manager_cmd); Draw_Text(Manager_cmd, 1, 1, White, "Command : "); Page_Print(Project_Manager.Curs); Draw_Text( Project_Manager.Curs.Parts(Project_Manager.Curs.Part_Cur).Win, Project_Manager.Curs.Parts(Project_Manager.Curs.Part_Cur).Line_Pos, Project_Manager.Curs.Parts(Project_Manager.Curs.Part_Cur).Column_Pos, White, Project_Manager.Curs.Parts (Project_Manager.Curs.Part_Cur).Line(1..Project_Manager.Curs.Parts(Project_Manager.Curs.Part_Cur).Last) ); if Line_Remove then if Lib_Name_Last > 0 then Draw_Text(Manager_cmd, 1, 1, White, "Line num : " & Lib_Name(1..Lib_Name_last)); else Draw_Text(Manager_cmd, 1, 1, White, "Line num : "); end if; elsif Cmd_Last > 0 then Draw_Window(Manager_cmd); Draw_Text(Manager_cmd, 1, 1, White, "Command : " & Cmd_Line(Cmd_Line'First..Cmd_Last)); else Draw_Window(Manager_cmd); Draw_Text(Manager_cmd, 1, 1, White, "Command : "); end if; when Prj_Upgrade => Draw_Window(Components_Win); Component_Cur := 0; Components_Print(Project_Manager.New_Project.all, Component_Index , Component_cur, (App.Lines-8)/2-2, App.Columns, Top); Draw_Window(Make_Win); if not Print_Set(File_Set, Make_Win, File_Index, Total_Lines) then raise Program_Error; end if; if Cmd_Last > 0 then Draw_Window(Manager_cmd); Draw_Text(Manager_cmd, 1, 1, White, "Command : " & Cmd_Line(Cmd_Line'First..Cmd_Last)); else Draw_Window(Manager_cmd); Draw_Text(Manager_cmd, 1, 1, White, "Command : "); end if; when others => null; end case; exit; or accept Refresh do null; end Refresh; end select; end loop; loop select accept Halt; exit Main_Loop; or accept Suspend; exit; or accept Wake_Up(Top : in Natural) do Manager_Process.Top := Top; Initialize(Creator_Abs, 1, Top+1, 3, App.Columns/2, Blue, White); Initialize(Creator_N, 4, Top+1, 3, App.Columns/2, Blue, White); Initialize(Creator_Ver, App.Lines-8, Top+1, 3, App.Columns/2, Blue, White); Initialize(Creator_Auth, App.Lines-5, Top+1, 3, App.Columns/2, Blue, White); Initialize(Creator_List, 7, Top+1, App.Lines-15, App.Columns/2, Blue, White); Initialize(Creator_Lib, App.Lines-2, Top+1, 3, App.Columns/2, Blue, white); Initialize(Manager_Abs, 1, Top+1, 3, App.Columns/2, Blue, White); Initialize(Manager_N, 4, Top+1, 3, App.Columns/2, Blue, White); Initialize(Manager_Ver, App.Lines-8, Top+1, 3, App.Columns/2, Blue, White); Initialize(Manager_Auth, App.Lines-5, Top+1, 3, App.Columns/2, Blue, White); Initialize(Manager_List, 7, 1, App.Lines-15, App.Columns/2, Blue, White); Initialize(Manager_cmd, App.Lines-2, Top+1, 3, App.Columns/2, Blue, white); Initialize(Project_Header, 1, Top+1, 5, App.Columns/2, Blue, White); Initialize(Project_Selector, 6, Top+1, App.Lines - 5, App.Columns/2, Blue, White); Initialize(Components_Win, 6, Top+1, (App.Lines - 8)/2+1, App.Columns/2, Blue, Red); Initialize(Make_Win, 6 + (App.Lines - 8)/2+1, Top+1, (App.Lines - 8)/2, App.Columns/2, White, Magenta); ----------------------------------------------- --Errno := System("clear" & Character'Val(0)); ----------------------------------------------- if Curs = Projects_Dll.No_Element then Project_Num := 0; if Projects_Dll.Length(App.Projects.List) = 1 then Curs := first(App.Projects.List); Project_Num := First_Element(App.Projects.List).Project_Num; Project_Manager.New_Project := Get_Project(App.Projects, Project_Num); elsif Projects_Dll.Length(App.Projects.List) > 1 then Curs := First(App.Projects.List); Project_Num := First_Element(App.Projects.List).Project_Num; Project_Manager.New_Project := Get_Project(App.Projects, Project_Num); end if; end if; if Arch_Curs = Projects_Dll.No_Element then if Length(App.Archives.List) > 0 then Arch_Curs := First(App.Archives.List); end if; end if; end Wake_Up; case Step_Cur is when Prj_Archives => Draw_Window(Project_Header); Draw_Window(Project_Selector); if Length(App.Archives.List) /= 0 then Archives_Print(App.Archives, Arch_Index, Arch_Num, App.Lines, App.Columns, top); end if; when Prj_Components => null; when Prj_Selector => Draw_Window(Project_Header); if Project_Manager.New_Project /= null then Draw_Header(Project_Manager.New_Project.all, Project_Header); else Draw_Header(Null_Project, Project_Header); end if; Draw_Window(Project_Selector); Projects_Print(App.Projects, Project_Index, Project_Num, App.Lines, App.Columns, top); when Prj_Creator => Draw_Window(Creator_Abs); Draw_Text(Creator_Abs, 1, 1, White, "Abstract : "); Draw_Window(Creator_N); Draw_Text(Creator_N, 1, 1, White, "Name : "); Draw_Window(Creator_Ver); Draw_Text(Creator_Ver, 1, 1, White, "Version : "); Draw_Window(Creator_Auth); Draw_Text(Creator_Auth, 1, 1, White, "Author : "); Draw_Window(Creator_List); if Creator.New_Project /= null then List_Print(Creator.New_Project.all, Creator_List, Lib_Index); end if; Draw_Window(Creator_Lib); Draw_Text(Creator_Lib, 1, 1, White, "Library : "); Page_Print(Creator.Curs); Draw_Text( Creator.Curs.Parts(Creator.Curs.Part_Cur).Win, Creator.Curs.Parts(Creator.Curs.Part_Cur).Line_Pos, Creator.Curs.Parts(Creator.Curs.Part_Cur).Column_Pos, White, Creator.Curs.Parts (Creator.Curs.Part_Cur).Line(1..Creator.Curs.Parts(Creator.Curs.Part_Cur).Last) ); when Prj_Lib_Remove => Draw_Window(Creator_Abs); Draw_Text(Creator_Abs, 1, 1, White, "Abstract : "); Draw_Window(Creator_N); Draw_Text(Creator_N, 1, 1, White, "Name : "); Draw_Window(Creator_Ver); Draw_Text(Creator_Ver, 1, 1, White, "Version : "); Draw_Window(Creator_Auth); Draw_Text(Creator_Auth, 1, 1, White, "Author : "); Draw_Window(Creator_List); List_Print(Creator.New_Project.all, Creator_List, Lib_Index); Draw_Window(Creator_Lib); Draw_Text(Creator_Lib, 1, 1, White, "Library : "); Page_Print(Creator.Curs); Draw_Text( Creator.Curs.Parts(Creator.Curs.Part_Cur).Win, Creator.Curs.Parts(Creator.Curs.Part_Cur).Line_Pos, Creator.Curs.Parts(Creator.Curs.Part_Cur).Column_Pos, White, Creator.Curs.Parts (Creator.Curs.Part_Cur).Line(1..Creator.Curs.Parts(Creator.Curs.Part_Cur).Last) ); if Lib_Name_Last > 0 then Draw_Text(Creator_Lib, 1, 1, White, "Line num : " & Lib_Name(1..Lib_Name_last)); else Draw_Text(Creator_Lib, 1, 1, White, "Line num : "); end if; when Prj_Manager => Draw_Window(Manager_Abs); Draw_Text(Manager_Abs, 1, 1, White, "Abstract : "); Draw_Window(Manager_N); Draw_Text(Manager_N, 1, 1, White, "Name : " & Handling.To_Wide_String(Project_Manager.New_Project.Project_Name.all)); Draw_Window(Manager_Ver); Draw_Text(Manager_Ver, 1, 1, White, "Version : " & Handling.To_Wide_String(Version_Io.To_String(Project_Manager.New_Project.Version))); Draw_Window(Manager_Auth); Draw_Text(Manager_Auth, 1, 1, White, "Author : " & Handling.To_Wide_String(Project_Manager.New_Project.Copyright.all)); Draw_Window(Manager_List); List_Print(Project_Manager.New_Project.all, Manager_List, Lib_Index); Draw_Window(Manager_cmd); Draw_Text(Manager_cmd, 1, 1, White, "Command : "); Page_Print(Project_Manager.Curs); Draw_Text( Project_Manager.Curs.Parts(Project_Manager.Curs.Part_Cur).Win, Project_Manager.Curs.Parts(Project_Manager.Curs.Part_Cur).Line_Pos, Project_Manager.Curs.Parts(Project_Manager.Curs.Part_Cur).Column_Pos, White, Project_Manager.Curs.Parts (Project_Manager.Curs.Part_Cur).Line(1..Project_Manager.Curs.Parts(Project_Manager.Curs.Part_Cur).Last) ); if Line_Remove then if Lib_Name_Last > 0 then Draw_Text(Manager_cmd, 1, 1, White, "Line num : " & Lib_Name(1..Lib_Name_last)); else Draw_Text(Manager_cmd, 1, 1, White, "Line num : "); end if; elsif Cmd_Last > 0 then Draw_Window(Manager_cmd); Draw_Text(Manager_cmd, 1, 1, White, "Command : " & Cmd_Line(Cmd_Line'First..Cmd_Last)); else Draw_Window(Manager_cmd); Draw_Text(Manager_cmd, 1, 1, White, "Command : "); end if; when Prj_Upgrade => Draw_Window(Components_Win); Component_Cur := 0; Components_Print(Project_Manager.New_Project.all, Component_Index , Component_cur, (App.Lines-8)/2-2, App.Columns, Top); Draw_Window(Make_Win); if not Print_Set(File_Set, Make_Win, File_Index, Total_Lines) then raise Program_Error; end if; if Cmd_Last > 0 then Draw_Window(Manager_cmd); Draw_Text(Manager_cmd, 1, 1, White, "Command : " & Cmd_Line(Cmd_Line'First..Cmd_Last)); else Draw_Window(Manager_cmd); Draw_Text(Manager_cmd, 1, 1, White, "Command : "); end if; when others => null; end case; or when Step_Cur = Prj_Selector => accept Receive(Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(9) => Project_Num := Projects_Dll.Element(Curs).Project_Num; if Project_Num = 0 then null; -- open archives; Arch_Count := 0; Arch_Index := 0; if Length(App.Archives.List) > 0 then Arch_Curs := First(App.Archives.List); end if; Step_Cur := Prj_Archives; else Project_Manager.New_Project := Get_Project(App.Projects, Project_Num); if Project_Manager.New_Project /= null then Gnos_Projects.Initialize(Gnose_Context.all, Projects_Params); Project_Context.Project := new Agnose_Projects.Project_Record_Type(With_Ada); Agnose_Projects.Load_project(Project_Context.Project.all, Project_Manager.New_Project.Project_Name.all & '-' & Version_Io.To_String(Project_Manager.New_Project.Version)); Set_Start_Time; Calendar.Split(Clock, Gnos.Versions.Start_Date.Year, Gnos.Versions.Start_Date.Month, Gnos.Versions.Start_Date.Day, Gnos.Versions.Start_Date.Hours); Open(App.Sessions(M.Logs.Project)); Project_Manager.Curs := Initialize((Manager_Abs, Manager_N, Manager_Ver, Manager_Auth, Manager_Cmd)); Step_Cur := Prj_Upgrade; Component_Cur := 0; Project.Open(Project_Manager.New_Project.all, clock); ----------------------------------------------- --Errno := System("clear" & Character'Val(0)); ----------------------------------------------- end if; end if; when Wide_Character'Val(10) => Project_Num := Element(Curs).Project_Num; if Project_Num = 0 then ---------------------------------------------- --Errno := System("clear" & Character'Val(0)); ---------------------------------------------- Creator.Curs := Initialize((Creator_Abs, Creator_N, Creator_Ver, Creator_Auth, Creator_Lib)); Project_Free(Creator.New_Project); Creator.New_Project := new Project_Record(256); Step_Cur := Prj_Creator; else Project_Manager.Curs := Initialize((Manager_Abs, Manager_N, Manager_Ver, Manager_Auth, Manager_Cmd)); Project_Manager.New_Project := Get_Project(App.Projects, Project_Num); Gnos_Projects.Initialize(Gnose_Context.all, Projects_Params); Project_Context.Project := new Agnose_Projects.Project_Record_Type(With_Ada); Agnose_Projects.Load_project(Project_Context.Project.all, Project_Manager.New_Project.Project_Name.all & '-' & Version_Io.To_String(Project_Manager.New_Project.Version)); Set_Start_Time; Calendar.Split(Clock, Gnos.Versions.Start_Date.Year, Gnos.Versions.Start_Date.Month, Gnos.Versions.Start_Date.Day, Gnos.Versions.Start_Date.Hours); Open(App.Sessions(M.Logs.Project)); Project.Open(Project_Manager.New_Project.all, Clock); Cursor_Set(Project_Manager.Curs, From => Project_Manager.New_Project.all); if Project_Manager.New_Project /= null then Step_Cur := Prj_Manager; end if; end if; when Wide_Character'Val(127) => if App.Archives.Projects_Num + 1 <= Project_Num_Range'Last then if Project_Num /= 0 then null;-- move archive to projects.List; Arch_Curs := Projects_Dll.last(App.Archives.List); declare El : constant Project.Project_Access := Get_Project(App.Projects, Project_Num); begin if El.Project_Name /= null and then El.Project_Name'Length /= 0 then Errno := System("mv " & El.Project_Name.all & '-' & Versions.Version_Io.To_String(El.Version) & " Archives/" & Character'Val(0)); if Errno = 0 then App.Archives.Projects_Num := App.Archives.Projects_Num + 1; El.Project_Num := App.Archives.Projects_Num; Projects_Dll.Append(App.Archives.List, El); Delete(App.Projects.List, Curs); if Length(App.Projects.List) > 0 then Curs := First(App.Projects.List); Project_Num := First_Element(App.Projects.List).Project_Num; Project_Manager.New_Project := Get_Project(App.Projects, Project_Num); Project_Count := 0; Project_Index := 0; end if; Projects_Manager.Archives_Save(App.Archives, "Archives/Projects.lst"); Projects_Manager.Manager_Save(App.Projects, "Projects.lst"); end if; end if; end; end if; end if; when others => null; end case; else null; end if; end Receive; case Step_Cur is when Prj_None => null; when Prj_Archives => Draw_Window(Project_Header); Draw_Window(Project_Selector); if Length(App.Archives.List) /= 0 then Archives_Print(App.Archives, Arch_Index, Arch_Num, App.Lines, App.Columns, top); end if; when prj_Components => null; when Prj_Selector => Draw_Window(Project_Header); if Project_Manager.New_Project /= null then Draw_Header(Project_Manager.New_Project.all, Project_Header); end if; Draw_Window(Project_Selector); Projects_Print(App.Projects, Project_Index, Project_Num, App.Lines, App.Columns, top); when Prj_Creator => Draw_Window(Creator_Abs); Draw_Text(Creator_Abs, 1, 1, White, "Abstract : "); Draw_Window(Creator_N); Draw_Text(Creator_N, 1, 1, White, "Name : "); Draw_Window(Creator_Ver); Draw_Text(Creator_Ver, 1, 1, White, "Version : "); Draw_Window(Creator_Auth); Draw_Text(Creator_Auth, 1, 1, White, "Author : "); Draw_Window(Creator_List); Draw_Window(Creator_Lib); Draw_Text(Creator_Lib, 1, 1, White, "Library : "); Page_Print(Creator.Curs); Draw_Text( Creator.Curs.Parts(Creator.Curs.Part_Cur).Win, Creator.Curs.Parts(Creator.Curs.Part_Cur).Line_Pos, Creator.Curs.Parts(Creator.Curs.Part_Cur).Column_Pos, White, Creator.Curs.Parts (Creator.Curs.Part_Cur).Line(1..Creator.Curs.Parts(Creator.Curs.Part_Cur).Last) ); when Prj_Manager => Draw_Window(Manager_Abs); Draw_Text(Manager_Abs, 1, 1, White, "Abstract : "); Draw_Window(Manager_N); Draw_Text(Manager_N, 1, 1, White, "Name : " & Handling.To_Wide_String(Project_Manager.New_Project.Project_Name.all)); Draw_Window(Manager_Ver); Draw_Text(Manager_Ver, 1, 1, White, "Version : " & Handling.To_Wide_String(Version_Io.To_String(Project_Manager.New_Project.Version))); Draw_Window(Manager_Auth); Draw_Text(Manager_Auth, 1, 1, White, "Author : " & Handling.To_Wide_String(Project_Manager.New_Project.Copyright.all)); Draw_Window(Manager_List); List_Print(Project_Manager.New_Project.all, Manager_List, Lib_Index); Draw_Window(Manager_cmd); Draw_Text(Manager_cmd, 1, 1, White, "Command : "); Page_Print(Project_Manager.Curs); Draw_Text( Project_Manager.Curs.Parts(Project_Manager.Curs.Part_Cur).Win, Project_Manager.Curs.Parts(Project_Manager.Curs.Part_Cur).Line_Pos, Project_Manager.Curs.Parts(Project_Manager.Curs.Part_Cur).Column_Pos, White, Project_Manager.Curs.Parts (Project_Manager.Curs.Part_Cur).Line(1..Project_Manager.Curs.Parts(Project_Manager.Curs.Part_Cur).Last) ); if Line_Remove then if Lib_Name_Last > 0 then Draw_Text(Manager_cmd, 1, 1, White, "Line num : " & Lib_Name(1..Lib_Name_last)); else Draw_Text(Manager_cmd, 1, 1, White, "Line num : "); end if; elsif Cmd_Last > 0 then Draw_Window(Manager_cmd); Draw_Text(Manager_cmd, 1, 1, White, "Command : " & Cmd_Line(Cmd_Line'First..Cmd_Last)); else Draw_Window(Manager_cmd); Draw_Text(Manager_cmd, 1, 1, White, "Command : "); end if; when Prj_Upgrade => Draw_Window(Components_Win); Components_Print(Project_Manager.New_Project.all, Component_Index , Component_cur, (App.Lines-8)/2-2, App.Columns, top); Draw_Window(Make_Win); if Cmd_Last > 0 then Draw_Window(Manager_cmd); Draw_Text(Manager_cmd, 1, 1, White, "Command : " & Cmd_Line(Cmd_Line'First..Cmd_Last)); else Draw_Window(Manager_cmd); Draw_Text(Manager_cmd, 1, 1, White, "Command : "); end if; when others => null; end case; or when Step_Cur = Prj_creator => accept Receive(Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(1) => Creator.Curs := Initialize((Creator_Abs, Creator_N, Creator_Ver, Creator_Auth, Creator_Lib)); Project_Free(Creator.New_Project); Creator.New_Project := new Project_Record(256); when Wide_Character'Val(5) => Step_Cur := Prj_Lib_Remove; when Wide_Character'Val(10) => if Creator.Curs.Part_Cur = Creator_Library then if Creator.Curs.Parts(Creator.Curs.Part_Cur).Last /= 0 then Lib_Add (Creator.New_Project.all, Handling.To_String (Creator.Curs.Parts(Creator.Curs.Part_Cur).Line(1..Creator.Curs.Parts(Creator.Curs.Part_Cur).Last))); Creator.Curs.Parts(Creator.Curs.Part_Cur).Line := (others => ' '); Creator.Curs.Parts(Creator.Curs.Part_Cur).Last := 0; end if; else Creator.Curs.Part_Cur := Part_Enum'Succ(Creator.Curs.Part_Cur); end if; when Wide_Character'Val(12) => ---------------------------------------------- --Errno := System("clear" & Character'Val(0)); null; ---------------------------------------------- when Wide_Character'Val(18) => Close(App.Sessions(M.Logs.Project)); Statistic(App.Sessions, App.Logs); Step_Cur := Prj_Selector; ---------------------------------------------- --Errno := System("clear" & Character'Val(0)); ---------------------------------------------- if Curs = Projects_Dll.No_Element then Project_Num := 0; if Projects_Dll.Length(App.Projects.List) = 1 then Curs := first(App.Projects.List); Project_Num := First_Element(App.Projects.List).Project_Num; Project_Manager.New_Project := Get_Project(App.Projects, Project_Num); elsif Projects_Dll.Length(App.Projects.List) > 1 then Curs := First(App.Projects.List); Project_Num := First_Element(App.Projects.List).Project_Num; Project_Manager.New_Project := Get_Project(App.Projects, Project_Num); end if; end if; if Arch_Curs = Projects_Dll.No_Element then if Length(App.Archives.List) > 0 then Arch_Curs := First(App.Archives.List); end if; end if; when Wide_Character'Val(20) => Creator.New_Project := To_Project(Creator, App.Projects.Projects_Num + 1); Make_Project(Creator); Curs := Last(App.Projects.List); Insert(App.Projects.List, Curs, Creator.New_Project); App.Projects.Projects_Num := App.Projects.Projects_Num + 1; Project_Num := App.Projects.Projects_Num; Creator.Curs := Initialize((Creator_Abs, Creator_N, Creator_Ver, Creator_Auth, Creator_Lib)); Project_Num := First_Element(App.Projects.List).Project_Num; Project_Manager.New_Project := Get_Project(App.Projects, Project_Num); Curs := Previous(Curs); Close(App.Sessions(M.Logs.Project)); Statistic(App.Sessions, App.Logs); Step_Cur := Prj_Selector; when Wide_Character'Val(127) => if Creator.Curs.Parts(Creator.Curs.Part_Cur).Last > 0 then Creator.Curs.Parts(Creator.Curs.Part_Cur).Line(Creator.Curs.Parts(Creator.Curs.Part_Cur).Last) := Wide_Character'Val(32); Creator.Curs.Parts(Creator.Curs.Part_Cur).Last := Creator.Curs.Parts(Creator.Curs.Part_Cur).Last - 1; else Text_Io.Put(Character'Val(7)); end if; when others => null; end case; case Step_Cur is when Prj_None => null; when Prj_Selector => Draw_Window(Project_Header); if Project_Manager.New_Project /= null then Draw_Header(Project_Manager.New_Project.all, Project_Header); end if; Draw_Window(Project_Selector); Projects_Print(App.Projects, Project_Index, Project_Num, App.Lines, App.Columns, top); when Prj_Creator => Draw_Window(Creator_Abs); Draw_Text(Creator_Abs, 1, 1, White, "Abstract : "); Draw_Window(Creator_N); Draw_Text(Creator_N, 1, 1, White, "Name : "); Draw_Window(Creator_Ver); Draw_Text(Creator_Ver, 1, 1, White, "Version : "); Draw_Window(Creator_Auth); Draw_Text(Creator_Auth, 1, 1, White, "Author : "); Draw_Window(Creator_List); List_Print(Creator.New_Project.all, Creator_List, Lib_Index); Draw_Window(Creator_Lib); Draw_Text(Creator_Lib, 1, 1, White, "Library : "); Page_Print(Creator.Curs); Draw_Text( Creator.Curs.Parts(Creator.Curs.Part_Cur).Win, Creator.Curs.Parts(Creator.Curs.Part_Cur).Line_Pos, Creator.Curs.Parts(Creator.Curs.Part_Cur).Column_Pos, White, Creator.Curs.Parts (Creator.Curs.Part_Cur).Line(1..Creator.Curs.Parts(Creator.Curs.Part_Cur).Last) ); when Prj_Lib_Remove => if Lib_Name_Last > 0 then Draw_Text(Creator_Lib, 1, 1, White, "Line num : " & Lib_Name(1..Lib_Name_last)); else Draw_Text(Creator_Lib, 1, 1, White, "Line num : "); end if; when others => null; end case; elsif Creator.Curs.Parts(Creator.Curs.Part_Cur).Last + 1 <= Creator.Curs.Parts(Creator.Curs.Part_Cur).Line'Length then Creator.Curs.Parts(Creator.Curs.Part_Cur).Line(Creator.Curs.Parts(Creator.Curs.Part_Cur).Last + 1) := Wchar; Creator.Curs.Parts(Creator.Curs.Part_Cur).Last := Creator.Curs.Parts(Creator.Curs.Part_Cur).Last + 1; Draw_Window(Creator.Curs.Parts(Creator.Curs.Part_Cur).Win); Page_Print(Creator.Curs); Draw_Text( Creator.Curs.Parts(Creator.Curs.Part_Cur).Win, Creator.Curs.Parts(Creator.Curs.Part_Cur).Line_Pos, Creator.Curs.Parts(Creator.Curs.Part_Cur).Column_Pos, White, Creator.Curs.Parts (Creator.Curs.Part_Cur).Line(1..Creator.Curs.Parts(Creator.Curs.Part_Cur).Last) ); else Text_Io.Put(Character ' Val (7)); end if; end Receive; or when Step_Cur = Prj_Manager => accept Receive(Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(10) => begin Cmd := Value(Handling.To_String(Cmd_Line(Cmd_Line'First..Cmd_Last))); case Cmd is when None => null; when Help => null; when Make => if Cmd_Last = 4 then Errno := System("make" & Character'Val(0)); else Change_Dir(Project_Manager.New_Project.Project_Name.all & "-" & Version_Io.To_String(Project_Manager.New_Project.Version)); Free(Args); Args := Argument_String_To_List(Handling.To_String(Cmd_Line(6..Cmd_Last)) & Character'Val(0)); ------------------------------------------------------------------- -- Spawn(Make_On_Bin.all, Args.all, Outfilename, Success, errno); -- replaced by Pid := Non_Blocking_Spawn(Make_On_Bin.all, Args.all, Outfilename); Wait_Process(Pid, Success); ------------------------------------------------------------------- --Errno := System("make " & Handling.To_String(Cmd_Line(6..Cmd_Last)) & Character'Val(0)); Load_File(File_Set, Outfilename, Line_Last); Change_Dir(".."); end if; when Add => if Cmd_Last > 4 then Lib_Add(Project_Manager.New_Project.all, Handling.To_String(Cmd_Line(5..Cmd_Last))); List_Save(Project_Manager.New_Project.all); else Put(Character'Val(7)); end if; when Remove => begin Line_Num := Natural'Value(Handling.To_String(Cmd_Line(Cmd_Line'First+7..Cmd_Last))); Remove_Name(Project_Manager.New_Project.all, Line_Num); List_Save(Project_Manager.New_Project.all); exception when others => null; end; when Upgrade => ---------------------------------------------------------------------------------------------------------- -- -- -- -- -- -- Upgraded := new Project_Record ' (Project_Manager.New_project.all); Text_Io.Put_Line("Update version..."); Text_Io.Put_Line("-- check for New Specifications..."); Versions.New_Description := Environment.Check_Modification_To_New_Description(Project_Context.all); Put_Line("New Description : " & Boolean'Image(Versions.New_Description)); Text_Io.Put_Line("-- check for New Implementation..."); Versions.New_Action := Environment.Check_Modification_To_New_Action(Project_Context.all); Put_Line("New Implementation : " & Boolean'Image(Versions.New_Action)); Text_Io.Put_Line("-- Version Update..."); -- update Version ! if Project_Context.Project.Project_Prefix /= null then Text_Io.Put_Line("Project prefix : " & Project_Context.Project.Project_Prefix.all); Text_Io.Put_Line("Project name : " & Project_Context.Project.Project_Name.all); declare Node_Name : access String := new String ' (Project_Context.Project.Project_Name(Project_Context.Project.Project_Prefix'Length+1..Project_Context.Project.Project_Name'Last)); begin if Versions.New_Description then Put_Line("Current version is : " & Versions.Version_Io.To_String(Upgraded.Version)); Upgraded.Version := Version_Update(Upgraded.Version); Put_Line("version is updated :" & Versions.Version_Io.To_String(Upgraded.Version)); Text_Io.Put_Line("-- Editting minor version..."); Main_Description(Project_Context.Project.Project_Name.all, Project_Context.Project.Project_Prefix.all, "Date", Formatting.Image(Clock), Node_Name.all); Main_Description(Project_Context.Project.Project_Name.all, Project_Context.Project.Project_Prefix.all, "Version", Versions.Version_Io.To_String(Upgraded.Version), Node_Name.all); for File_Id in Specifications_Filenames_Search.File_Content'Range loop Update(Handling.To_String(Gnos.Results."-"(Specifications_Filenames_Search.File_Content(File_Id))), "Date", Formatting.Image(Clock)); Update(Handling.To_String(Gnos.Results."-"(Specifications_Filenames_Search.File_Content(File_Id))), "Version", Versions.Version_Io.To_String(Upgraded.Version)); end loop; end if; if Versions.New_Action then Put_Line("Current version is : " & Versions.Version_Io.To_String(Upgraded.Version)); Upgraded.Version := Version_Update(Upgraded.Version); Put_Line("version is updated :" & Versions.Version_Io.To_String(Upgraded.Version)); Text_Io.Put_Line("-- Editting revision version..."); Main_Description(Project_Context.Project.Project_Name.all, Project_Context.Project.Project_Prefix.all, "Date", Formatting.Image(Clock), Node_Name.all); Main_Description(Project_Context.Project.Project_Name.all, Project_Context.Project.Project_Prefix.all, "Version", Versions.Version_Io.To_String(Upgraded.Version), Node_Name.all); for File_Id in Implementations_Filenames_Search.File_Content'Range loop Update(Handling.To_String(Gnos.Results."-"(Implementations_Filenames_Search.File_Content(File_Id))), "Date", Formatting.Image(Clock)); Update(Handling.To_String(Gnos.Results."-"(Implementations_Filenames_Search.File_Content(File_Id))), "Version", Versions.Version_Io.To_String(Upgraded.Version)); end loop; end if; if Versions.New_Action or Versions.New_Description then Put_Line("Current version is : " & Versions.Version_Io.To_String(Upgraded.Version)); Upgraded.Version := Version_Update(Upgraded.Version); Put_Line("version is updated :" & Versions.Version_Io.To_String(Upgraded.Version)); Text_Io.Put_Line("-- Editting major version..."); To_Major(Project_Context.Project.Project_Name.all, Project_Context.Project.Project_Prefix.all); To_Minor(Project_Context.Project.Project_Name.all, Project_Context.Project.Project_Prefix.all); To_Revision(Project_Context.Project.Project_Name.all, Project_Context.Project.Project_Prefix.all); else Upgraded.Version := Version_Update(Upgraded.Version); Text_Io.Put_Line("-- Editting release version..."); To_Release(Project_Context.Project.Project_Name.all, Project_Context.Project.Project_Prefix.all); end if; Versions.New_Action := False; Versions.New_Description := False; end; else Text_Io.Put_Line("Project name : " & Project_Context.Project.Project_Name.all); declare Node_Name : access String := new String ' (""); begin if Versions.New_Description then Put_Line("Current version is : " & Versions.Version_Io.To_String(Upgraded.Version)); Upgraded.Version := Version_Update(Upgraded.Version); Put_Line("version is updated :" & Versions.Version_Io.To_String(Upgraded.Version)); Main_Description(Project_Context.Project.Project_Name.all, "", "Date", Formatting.Image(Clock), Node_Name.all); Main_Description(Project_Context.Project.Project_Name.all, "", "Version", Versions.Version_Io.To_String(Upgraded.Version), Node_Name.all); for File_Id in Specifications_Filenames_Search.File_Content'Range loop Update(Handling.To_String(Gnos.Results."-"(Specifications_Filenames_Search.File_Content(File_Id))), "Date", Formatting.Image(Clock)); Update(Handling.To_String(Gnos.Results."-"(Specifications_Filenames_Search.File_Content(File_Id))), "Version", Versions.Version_Io.To_String(Upgraded.Version)); end loop; end if; if Versions.New_Action then Put_Line("Current version is : " & Versions.Version_Io.To_String(Upgraded.Version)); Upgraded.Version := Version_Update(Upgraded.Version); Put_Line("version is updated :" & Versions.Version_Io.To_String(Upgraded.Version)); Main_Description(Project_Context.Project.Project_Name.all, "", "Date", Formatting.Image(Clock), Node_Name.all); Main_Description(Project_Context.Project.Project_Name.all, "", "Version", Versions.Version_Io.To_String(Upgraded.Version), Node_Name.all); for File_Id in Implementations_Filenames_Search.File_Content'Range loop Update(Handling.To_String(Gnos.Results."-"(Implementations_Filenames_Search.File_Content(File_Id))), "Date", Formatting.Image(Clock)); Update(Handling.To_String(Gnos.Results."-"(Implementations_Filenames_Search.File_Content(File_Id))), "Version", Versions.Version_Io.To_String(Upgraded.Version)); end loop; end if; if Versions.New_Action or Versions.New_Description then Text_Io.Put_Line("-- Editting revision version..."); To_Revision(Project_Context.Project.Project_Name.all, ""); Text_Io.Put_Line("-- Editting minor version..."); To_Minor(Project_Context.Project.Project_Name.all, ""); Text_Io.Put_Line("-- Editting major version..."); To_Major(Project_Context.Project.Project_Name.all, ""); else if Environment.Version_Update /= 0 then raise Program_Error; end if; Text_Io.Put_Line("-- Editting release version..."); To_Release(Project_Context.Project.Project_Name.all, ""); end if; Versions.New_Action := False; Versions.New_Description := False; end; end if; -- -- -- -- -- -- -- ----------------------------------------------------------------------------------------------------------- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- ----------------------------------------------------------------------------------------------------------- if Upgraded /= null then App.Projects.Projects_Num := App.Projects.Projects_Num + 1; Upgraded.Project_Num := App.Projects.Projects_Num; Curs := Last(App.Projects.List); Projects_DLL.Delete(App.Projects.List, Curs); if Upgraded.Version.Revision_Version + 1 < M.Versions.Revision_Version_Type'Last then Upgraded.Version.Revision_Version := Upgraded.Version.Revision_Version + 1; end if; Replace_Description("Current_Major", Tools.Integer_Image(Upgraded.Version.Major_Version), Project_Context.Project.Project_Name.all & "-" & Version_Io.To_String(Versions.Version) & "/" & Project_Context.Project.Project_Name.all & "/" & Project_Context.Project.Project_Prefix.all & "-versions/src/lib/" & Project_Context.Project.Project_Prefix.all & "-versions.ads"); Replace_Description ("Current_Minor", Tools.Integer_Image(Upgraded.Version.Minor_Version), Project_Context.Project.Project_Name.all & "-" & Version_Io.To_String(Versions.Version) & "/" & Project_Context.Project.Project_Name.all & "/" & Project_Context.Project.Project_Prefix.all & "-versions/src/lib/" & Project_Context.Project.Project_Prefix.all & "-versions.ads"); Replace_Description ("Current_Revision", Tools.Integer_Image(Upgraded.Version.Revision_Version), Project_Context.Project.Project_Name.all & "-" & Version_Io.To_String(Versions.Version) & "/" & Project_Context.Project.Project_Name.all & "/" & Project_Context.Project.Project_Prefix.all & "-versions/src/lib/" & Project_Context.Project.Project_Prefix.all & "-versions.ads"); Replace_Description ("Current_Release", Character'image(Upgraded.Version.Release_Version), Project_Context.Project.Project_Name.all & "-" & Version_Io.To_String(Versions.Version) & "/" & Project_Context.Project.Project_Name.all & "/" & Project_Context.Project.Project_Prefix.all & "-versions/src/lib/" & Project_Context.Project.Project_Prefix.all & "-versions.ads"); Append(App.Projects.List, Upgraded); Projects_Manager.Manager_Save(App.Projects, "./Projects.lst"); if Update(Get_Info(App.Projects, Project_Manager.New_Project.Project_Num), Upgraded.Version, App.Sessions, App.Logs) = 0 then Projects_Dll.Clear(App.Projects.List); Projects_Manager.Manager_Load(App.Projects, "./Projects.lst"); end if; App.Projects.Projects_Num := App.Projects.Projects_Num + 1; Append(App.Projects.List, new Project_Record ' (Null_Project)); end if; Project.Close(Project_Manager.New_Project.all, Clock); Project_Count := 0; Project_Index := 0; Curs := First(App.Projects.List); Project_Num := First_Element(App.Projects.List).Project_Num; Project_Manager.New_Project := Get_Project(App.Projects, Project_Num); Close(App.Sessions(M.Logs.Project)); Statistic(App.Sessions, App.Logs); Step_Cur := Prj_Selector; when Quit => null; end case; Cmd_Last := 0; Cmd_Line := (others => Wide_Character'Val(32)); exception when others => null; end; when Wide_Character'Val(18) => Project.Close(Project_Manager.New_Project.all, Clock); Close(App.Sessions(M.Logs.Project)); Statistic(App.Sessions, App.Logs); Step_Cur := Prj_Selector; Draw_Window(Project_Header); Draw_Window(Project_Selector); Projects_Print(App.Projects, Project_Index, Project_Num, App.Lines, App.Columns, top); when Wide_Character'Val(21) => ---------------------------------------------------------------------------------------------------------- -- -- -- -- -- -- Upgraded := new Project_Record ' (Project_Manager.New_project.all); Text_Io.Put_Line("Update version..."); Text_Io.Put_Line("-- check for New Specifications..."); Versions.New_Description := Environment.Check_Modification_To_New_Description(Project_Context.all); Text_Io.Put_Line("-- check for New Implementation..."); Versions.New_Action := Environment.Check_Modification_To_New_Action(Project_Context.all); Text_Io.Put_Line("-- Version Update..."); -- update Version ! if Project_Context.Project.Project_Prefix /= null then Text_Io.Put_Line("Project prefix : " & Project_Context.Project.Project_Prefix.all); Text_Io.Put_Line("Project name : " & Project_Context.Project.Project_Name.all); declare Node_Name : access String := new String ' (Project_Context.Project.Project_Name(Project_Context.Project.Project_Prefix'Length+1..Project_Context.Project.Project_Name'Last)); begin if Versions.New_Description then Put_Line("Current version is : " & Versions.Version_Io.To_String(Upgraded.Version)); Upgraded.Version := Version_Update(Upgraded.Version); Put_Line("version is updated :" & Versions.Version_Io.To_String(Upgraded.Version)); Text_Io.Put_Line("-- Editting minor version..."); Main_Description(Project_Context.Project.Project_Name.all, Project_Context.Project.Project_Prefix.all, "Date", Formatting.Image(Clock), Node_Name.all); Main_Description(Project_Context.Project.Project_Name.all, Project_Context.Project.Project_Prefix.all, "Version", Versions.Version_Io.To_String(Project_Manager.New_Project.Version), Node_Name.all); for File_Id in Specifications_Filenames_Search.File_Content'Range loop Update(Handling.To_String(Gnos.Results."-"(Specifications_Filenames_Search.File_Content(File_Id))), "Date", Formatting.Image(Clock)); Update(Handling.To_String(Gnos.Results."-"(Specifications_Filenames_Search.File_Content(File_Id))), "Version", Versions.Version_Io.To_String(Project_Manager.New_Project.Version)); end loop; end if; if Versions.New_Action then Put_Line("Current version is : " & Versions.Version_Io.To_String(Upgraded.Version)); Upgraded.Version := Version_Update(Upgraded.Version); Put_Line("version is updated :" & Versions.Version_Io.To_String(Upgraded.Version)); Text_Io.Put_Line("-- Editting revision version..."); Main_Description(Project_Context.Project.Project_Name.all, Project_Context.Project.Project_Prefix.all, "Date", Formatting.Image(Clock), Node_Name.all); Main_Description(Project_Context.Project.Project_Name.all, Project_Context.Project.Project_Prefix.all, "Version", Versions.Version_Io.To_String(Project_Manager.New_Project.Version), Node_Name.all); for File_Id in Implementations_Filenames_Search.File_Content'Range loop Update(Handling.To_String(Gnos.Results."-"(Implementations_Filenames_Search.File_Content(File_Id))), "Date", Formatting.Image(Clock)); Update(Handling.To_String(Gnos.Results."-"(Implementations_Filenames_Search.File_Content(File_Id))), "Version", Versions.Version_Io.To_String(Project_Manager.New_Project.Version)); end loop; end if; if Versions.New_Action or Versions.New_Description then Put_Line("Current version is : " & Versions.Version_Io.To_String(Upgraded.Version)); Upgraded.Version := Version_Update(Upgraded.Version); Put_Line("version is updated :" & Versions.Version_Io.To_String(Upgraded.Version)); Text_Io.Put_Line("-- Editting major version..."); To_Major(Project_Context.Project.Project_Name.all, Project_Context.Project.Project_Prefix.all); To_Minor(Project_Context.Project.Project_Name.all, Project_Context.Project.Project_Prefix.all); To_Revision(Project_Context.Project.Project_Name.all, Project_Context.Project.Project_Prefix.all); else Put_Line("Current version is : " & Versions.Version_Io.To_String(Upgraded.Version)); Upgraded.Version := Version_Update(Upgraded.Version); Put_Line("version is updated :" & Versions.Version_Io.To_String(Upgraded.Version)); Text_Io.Put_Line("-- Editting release version..."); To_Release(Project_Context.Project.Project_Name.all, Project_Context.Project.Project_Prefix.all); end if; Versions.New_Action := False; Versions.New_Description := False; end; else Text_Io.Put_Line("Project name : " & Project_Context.Project.Project_Name.all); declare Node_Name : access String := new String ' (""); begin if Versions.New_Description then Put_Line("Current version is : " & Versions.Version_Io.To_String(Upgraded.Version)); Upgraded.Version := Version_Update(Upgraded.Version); Put_Line("version is updated :" & Versions.Version_Io.To_String(Upgraded.Version)); -- if Environment.Version_Update /= 0 then -- raise Program_Error; -- end if;  Main_Description(Project_Context.Project.Project_Name.all, "", "Date", Formatting.Image(Clock), Node_Name.all); Main_Description(Project_Context.Project.Project_Name.all, "", "Version", Versions.Version_Io.To_String(Project_Manager.New_Project.Version), Node_Name.all); for File_Id in Specifications_Filenames_Search.File_Content'Range loop Update(Handling.To_String(Gnos.Results."-"(Specifications_Filenames_Search.File_Content(File_Id))), "Date", Formatting.Image(Clock)); Update(Handling.To_String(Gnos.Results."-"(Specifications_Filenames_Search.File_Content(File_Id))), "Version", Versions.Version_Io.To_String(Project_Manager.New_Project.Version)); end loop; end if; if Versions.New_Action then Put_Line("Current version is : " & Versions.Version_Io.To_String(Upgraded.Version)); Upgraded.Version := Version_Update(Upgraded.Version); Put_Line("version is updated :" & Versions.Version_Io.To_String(Upgraded.Version)); -- if Environment.Version_Update /= 0 then -- raise Program_Error; -- end if;  Main_Description(Project_Context.Project.Project_Name.all, "", "Date", Formatting.Image(Clock), Node_Name.all); Main_Description(Project_Context.Project.Project_Name.all, "", "Version", Versions.Version_Io.To_String(Project_Manager.New_Project.Version), Node_Name.all); for File_Id in Implementations_Filenames_Search.File_Content'Range loop Update(Handling.To_String(Gnos.Results."-"(Implementations_Filenames_Search.File_Content(File_Id))), "Date", Formatting.Image(Clock)); Update(Handling.To_String(Gnos.Results."-"(Implementations_Filenames_Search.File_Content(File_Id))), "Version", Versions.Version_Io.To_String(Project_Manager.New_Project.Version)); end loop; end if; if Versions.New_Action or Versions.New_Description then Text_Io.Put_Line("-- Editting revision version..."); To_Revision(Project_Context.Project.Project_Name.all, ""); Text_Io.Put_Line("-- Editting minor version..."); To_Minor(Project_Context.Project.Project_Name.all, ""); Text_Io.Put_Line("-- Editting major version..."); To_Major(Project_Context.Project.Project_Name.all, ""); else Put_Line("Current version is : " & Versions.Version_Io.To_String(Upgraded.Version)); Upgraded.Version := Version_Update(Upgraded.Version); Put_Line("version is updated :" & Versions.Version_Io.To_String(Upgraded.Version)); -- if Environment.Version_Update /= 0 then -- raise Program_Error; -- end if;  Text_Io.Put_Line("-- Editting release version..."); To_Release(Project_Context.Project.Project_Name.all, ""); end if; Versions.New_Action := False; Versions.New_Description := False; end; end if; -- -- -- -- -- -- -- ----------------------------------------------------------------------------------------------------------- if Upgraded /= null then App.Projects.Projects_Num := App.Projects.Projects_Num + 1; Upgraded.Project_Num := App.Projects.Projects_Num; Curs := Last(App.Projects.List); Projects_DLL.Delete(App.Projects.List, Curs); if Upgraded.Version.Revision_Version + 1 < M.Versions.Revision_Version_Type'Last then Upgraded.Version.Revision_Version := Upgraded.Version.Revision_Version + 1; end if; Replace_Description("Current_Major", Tools.Integer_Image(Upgraded.Version.Major_Version), Project_Context.Project.Project_Name.all & "-" & Version_Io.To_String(Versions.Version) & "/" & Project_Context.Project.Project_Name.all & "/" & Project_Context.Project.Project_Prefix.all & "-versions/src/lib/" & Project_Context.Project.Project_Prefix.all & "-versions.ads"); Replace_Description ("Current_Minor", Tools.Integer_Image(Upgraded.Version.Minor_Version), Project_Context.Project.Project_Name.all & "-" & Version_Io.To_String(Versions.Version) & "/" & Project_Context.Project.Project_Name.all & "/" & Project_Context.Project.Project_Prefix.all & "-versions/src/lib/" & Project_Context.Project.Project_Prefix.all & "-versions.ads"); Replace_Description ("Current_Revision", Tools.Integer_Image(Upgraded.Version.Revision_Version), Project_Context.Project.Project_Name.all & "-" & Version_Io.To_String(Versions.Version) & "/" & Project_Context.Project.Project_Name.all & "/" & Project_Context.Project.Project_Prefix.all & "-versions/src/lib/" & Project_Context.Project.Project_Prefix.all & "-versions.ads"); Replace_Description ("Current_Release", Character'image(Upgraded.Version.Release_Version), Project_Context.Project.Project_Name.all & "-" & Version_Io.To_String(Versions.Version) & "/" & Project_Context.Project.Project_Name.all & "/" & Project_Context.Project.Project_Prefix.all & "-versions/src/lib/" & Project_Context.Project.Project_Prefix.all & "-versions.ads"); Append(App.Projects.List, Upgraded); Projects_Manager.Manager_Save(App.Projects, "./Projects.lst"); if Update(Get_Info(App.Projects, Project_Manager.New_Project.Project_Num), Upgraded.Version, App.Sessions, App.Logs) = 0 then Projects_Dll.Clear(App.Projects.List); Projects_Manager.Manager_Load(App.Projects, "./Projects.lst"); end if; App.Projects.Projects_Num := App.Projects.Projects_Num + 1; Append(App.Projects.List, new Project_Record ' (Null_Project)); end if; Project.Close(Project_Manager.New_Project.all, Clock); Project_Count := 0; Project_Index := 0; Curs := First(App.Projects.List); Project_Num := First_Element(App.Projects.List).Project_Num; Project_Manager.New_Project := Get_Project(App.Projects, Project_Num); Close(App.Sessions(M.Logs.Project)); Statistic(App.Sessions, App.Logs); Step_Cur := Prj_Selector; when Wide_Character'Val(127) => if Cmd_Last > 0 then Cmd_Line(Cmd_Last) := Wide_Character'Val(32); Cmd_Last := Cmd_Last - 1; else Put(Character'Val(7)); end if; when others => null; end case; elsif Cmd_Last < Cmd_Line'Length then Cmd_Line(Cmd_Last + 1) := Wchar; Cmd_Last := Cmd_Last + 1; else Put(Character'Val(7)); end if; end Receive; case Step_Cur is when Prj_Selector => Draw_Window(Project_Header); if Project_Manager.New_Project /= null then Draw_Header(Project_Manager.New_Project.all, Project_Header); end if; Draw_Window(Project_Selector); Projects_Print(App.Projects, Project_Index, Project_Num, App.Lines, App.Columns, top); when Prj_Creator => Draw_Window(Creator_Abs); Draw_Text(Creator_Abs, 1, 1, White, "Abstract : "); Draw_Window(Creator_N); Draw_Text(Creator_N, 1, 1, White, "Name : "); Draw_Window(Creator_Ver); Draw_Text(Creator_Ver, 1, 1, White, "Version : "); Draw_Window(Creator_Auth); Draw_Text(Creator_Auth, 1, 1, White, "Author : "); Draw_Window(Creator_List); Draw_Window(Creator_Lib); Draw_Text(Creator_Lib, 1, 1, White, "Library : "); Page_Print(Creator.Curs); Draw_Text( Creator.Curs.Parts(Creator.Curs.Part_Cur).Win, Creator.Curs.Parts(Creator.Curs.Part_Cur).Line_Pos, Creator.Curs.Parts(Creator.Curs.Part_Cur).Column_Pos, White, Creator.Curs.Parts (Creator.Curs.Part_Cur).Line(1..Creator.Curs.Parts(Creator.Curs.Part_Cur).Last) ); when Prj_Lib_Remove => Draw_Window(Creator_Abs); Draw_Text(Creator_Abs, 1, 1, White, "Abstract : "); Draw_Window(Creator_N); Draw_Text(Creator_N, 1, 1, White, "Name : "); Draw_Window(Creator_Ver); Draw_Text(Creator_Ver, 1, 1, White, "Version : "); Draw_Window(Creator_Auth); Draw_Text(Creator_Auth, 1, 1, White, "Author : "); Draw_Window(Creator_List); List_Print(Creator.New_Project.all, Creator_List, Lib_Index); Draw_Window(Creator_Lib); Draw_Text(Creator_Lib, 1, 1, White, "Library : "); Page_Print(Creator.Curs); Draw_Text( Creator.Curs.Parts(Creator.Curs.Part_Cur).Win, Creator.Curs.Parts(Creator.Curs.Part_Cur).Line_Pos, Creator.Curs.Parts(Creator.Curs.Part_Cur).Column_Pos, White, Creator.Curs.Parts (Creator.Curs.Part_Cur).Line(1..Creator.Curs.Parts(Creator.Curs.Part_Cur).Last) ); if Lib_Name_Last > 0 then Draw_Text(Creator_Lib, 1, 1, White, "Line num : " & Lib_Name(1..Lib_Name_last)); else Draw_Text(Creator_Lib, 1, 1, White, "Line num : "); end if; when Prj_Manager => Draw_Window(Manager_Abs); Draw_Text(Manager_Abs, 1, 1, White, "Abstract : "); Draw_Window(Manager_N); Draw_Text(Manager_N, 1, 1, White, "Name : " & Handling.To_Wide_String(Project_Manager.New_Project.Project_Name.all)); Draw_Window(Manager_Ver); Draw_Text(Manager_Ver, 1, 1, White, "Version : " & Handling.To_Wide_String(Version_Io.To_String(Project_Manager.New_Project.Version))); Draw_Window(Manager_Auth); Draw_Text(Manager_Auth, 1, 1, White, "Author : " & Handling.To_Wide_String(Project_Manager.New_Project.Copyright.all)); Draw_Window(Manager_List); List_Print(Project_Manager.New_Project.all, Manager_List, Lib_Index); Draw_Window(Manager_cmd); Draw_Text(Manager_cmd, 1, 1, White, "Command : "); Page_Print(Project_Manager.Curs); Draw_Text( Project_Manager.Curs.Parts(Project_Manager.Curs.Part_Cur).Win, Project_Manager.Curs.Parts(Project_Manager.Curs.Part_Cur).Line_Pos, Project_Manager.Curs.Parts(Project_Manager.Curs.Part_Cur).Column_Pos, White, Project_Manager.Curs.Parts (Project_Manager.Curs.Part_Cur).Line(1..Project_Manager.Curs.Parts(Project_Manager.Curs.Part_Cur).Last) ); if Line_Remove then if Lib_Name_Last > 0 then Draw_Text(Manager_cmd, 1, 1, White, "Line num : " & Lib_Name(1..Lib_Name_last)); else Draw_Text(Manager_cmd, 1, 1, White, "Line num : "); end if; elsif Cmd_Last > 0 then Draw_Window(Manager_cmd); Draw_Text(Manager_cmd, 1, 1, White, "Command : " & Cmd_Line(Cmd_Line'First..Cmd_Last)); else Draw_Window(Manager_cmd); Draw_Text(Manager_cmd, 1, 1, White, "Command : "); end if; when Prj_Upgrade => Draw_Window(Components_Win); Components_Print(Project_Manager.New_Project.all, Component_Index , Component_cur, (App.Lines-8)/2-2, App.Columns, top); Draw_Window(Make_Win); if Cmd_Last > 0 then Draw_Window(Manager_cmd); Draw_Text(Manager_cmd, 1, 1, White, "Command : " & Cmd_Line(Cmd_Line'First..Cmd_Last)); else Draw_Window(Manager_cmd); Draw_Text(Manager_cmd, 1, 1, White, "Command : "); end if; when others => null; end case; or when Step_Cur = Prj_archives => accept Receive(Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(9) => if Length(App.Archives.List) > 0 then Arch_Num := Element(Arch_Curs).Project_Num; Put_Line("Arch_Num : " & Integer'Image(Integer(Arch_Num))); if App.Projects.Projects_Num + 1 <= Project_Num_Range'Last then if Arch_Num /= 0 then null;-- move archive to projects.List; Curs := Projects_Dll.First(App.Projects.List); Project_Count := 0; Project_Index := 0; declare El : constant Project.Project_Access := Get_Project(App.Archives, Arch_Num); begin if El.Project_Name /= null and then El.Project_Name'Length /= 0 then Errno := System("mv Archives/" & El.Project_Name.all & '-' & Versions.Version_Io.To_String(El.Version) & " ." & Character'Val(0)); if Errno = 0 then El.Project_Num := App.Projects.Projects_Num + 1; App.Projects.Projects_Num := App.Projects.Projects_Num + 1; Insert(App.Projects.List, Curs, El, Curs); Delete(App.Archives.List, Arch_Curs); Projects_Manager.Archives_Save(App.Archives, "Archives/Projects.lst"); Projects_Manager.Manager_Save(App.Archives, "Projects.lst"); end if; end if; end; end if; end if; end if; if Length(App.Archives.List) > 0 then Arch_Curs := First(App.Archives.List); end if; Close(App.Sessions(M.Logs.Project)); Statistic(App.Sessions, App.Logs); Step_Cur := Prj_Selector; when Wide_Character'Val(10) => null; -- nothing to be done. when Wide_Character'Val(127) => Project.Close(Project_Manager.New_Project.all, Clock); Close(App.Sessions(M.Logs.Project)); Statistic(App.Sessions, App.Logs); Step_Cur := Prj_Selector; when others => null; end case; else null; end if; end Receive; case Step_Cur is when Prj_Archives => Draw_Window(Project_Selector); Archives_Print(App.Archives, Arch_Index, Arch_Num, App.Lines, App.Columns, top); when Prj_None => null; when Prj_Manager => null; when Prj_Selector => Draw_Window(Project_Header); if Project_Manager.New_Project /= null then Draw_Header(Project_Manager.New_Project.all, Project_Header); end if; Draw_Window(Project_Selector); Projects_Print(App.Projects, Project_Index, Project_Num, App.Lines, App.Columns, top); when others => null; end case; or when Step_Cur = Prj_Components => accept Receive(Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(10) => null; when Wide_Character'Val(18) => Step_Cur := Prj_Manager; when others => null; end case; else null; end if; end Receive; case Step_Cur is when Prj_None => null; when Prj_Manager => null; when Prj_Selector => Draw_Window(Project_Header); if Project_Manager.New_Project /= null then Draw_Header(Project_Manager.New_Project.all, Project_Header); end if; Draw_Window(Project_Selector); Projects_Print(App.Projects, Project_Index, Project_Num, App.Lines, App.Columns, top); when others => null; end case; or when Step_Cur = Prj_Editor => accept Receive(Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(10) => null; when Wide_Character'Val(18) => Step_Cur := Prj_Manager; when others => null; end case; else null; end if; end Receive; case Step_Cur is when Prj_None => null; when Prj_Manager => null; when Prj_Selector => Draw_Window(Project_Header); if Project_Manager.New_Project /= null then Draw_Header(Project_Manager.New_Project.all, Project_Header); end if; Draw_Window(Project_Selector); Projects_Print(App.Projects, Project_Index, Project_Num, App.Lines, App.Columns, top); when others => null; end case; or when Step_Cur = Prj_Lib_Remove => accept Receive(Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(10) => declare Line_Num : Natural := 0; begin Line_Num := Natural'Value(Handling.To_String(Lib_Name(1..Lib_Name_Last))); Remove_Name(Creator.New_Project.all, Line_Num); exception when others => null; end; Step_Cur := Prj_Creator; Lib_Name := (others => Wide_Character'Val(32)); Lib_Name_Last := 0; when Wide_Character'Val(12) => ----------------------------------------------- --Errno := System("clear" & Character'Val(0)); ----------------------------------------------- null; when Wide_Character'Val(127) => if Lib_Name_Last > 0 then Lib_Name(Lib_Name_Last) := Wide_Character'Val(32); Lib_Name_Last := Lib_Name_Last - 1; else Put(Character'Val(7)); end if; when others => null; end case; case Step_Cur is when Prj_None => null; when Prj_Selector => Draw_Window(Project_Header); if Project_Manager.New_Project /= null then Draw_Header(Project_Manager.New_Project.all, Project_Header); end if; Draw_Window(Project_Selector); Projects_Print(App.Projects, Project_Index, Project_Num, App.Lines, App.Columns, top); when Prj_Creator => Draw_Window(Creator_Abs); Draw_Text(Creator_Abs, 1, 1, White, "Abstract : "); Draw_Window(Creator_N); Draw_Text(Creator_N, 1, 1, White, "Name : "); Draw_Window(Creator_Ver); Draw_Text(Creator_Ver, 1, 1, White, "Version : "); Draw_Window(Creator_Auth); Draw_Text(Creator_Auth, 1, 1, White, "Author : "); Draw_Window(Creator_List); List_Print(Creator.New_Project.all, Creator_List, Lib_Index); Draw_Window(Creator_Lib); Draw_Text(Creator_Lib, 1, 1, White, "Library : "); Page_Print(Creator.Curs); Draw_Text( Creator.Curs.Parts(Creator.Curs.Part_Cur).Win, Creator.Curs.Parts(Creator.Curs.Part_Cur).Line_Pos, Creator.Curs.Parts(Creator.Curs.Part_Cur).Column_Pos, White, Creator.Curs.Parts (Creator.Curs.Part_Cur).Line(1..Creator.Curs.Parts(Creator.Curs.Part_Cur).Last) ); when Prj_Lib_Remove => Draw_Window(Creator_Lib); if Lib_Name_Last > 0 then Draw_Text(Creator_Lib, 1, 1, White, "Line num : " & Lib_Name(1..Lib_Name_last)); else Draw_Text(Creator_Lib, 1, 1, White, "Line num : "); end if; when others => null; end case; elsif Lib_Name_Last < Lib_Name'Length then Draw_Window(Creator_Lib); Lib_Name(Lib_Name_Last + 1) := Wchar; Lib_Name_Last := Lib_Name_Last + 1; if Lib_Name_Last > 0 then Draw_Text(Creator_Lib, 1, 1, White, "Line num : " & Lib_Name(1..Lib_Name_last)); else Draw_Text(Creator_Lib, 1, 1, White, "Line num : " & Lib_Name(1..Lib_Name_Last)); end if; else Put(Character'Val(7)); end if; end Receive; or when Step_Cur = Prj_help => accept Receive(Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(10) => null; when Wide_Character'Val(18) => Step_Cur := Prj_Manager; when others => null; end case; else null; end if; end Receive; case Step_Cur is when Prj_None => null; when Prj_Manager => null; when Prj_Selector => Draw_Window(Project_Header); if Project_Manager.New_Project /= null then Draw_Header(Project_Manager.New_Project.all, Project_Header); end if; Draw_Window(Project_Selector); Projects_Print(App.Projects, Project_Index, Project_Num, App.Lines, App.Columns, top); when others => null; end case; or when Step_Cur = Prj_Upgrade => accept Receive(Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(10) => if Cmd_Last = 0 then if Component_Cur > 0 then -- Text_Io.Put_Line("Open : " & Project_Manager.New_Project.Project_Name.all & '-' &  -- Versions.Version_Io.To_String(Project_Manager.New_Project.Version) & Directory_Separator &  -- Project_Manager.New_Project.Project_Name.all &  -- Directory_Separator & Project_Manager.New_Project.Libs(Component_Cur).Unit_Name.all & Directory_Separator); -- Text_Io.Skip_Line; Args := Argument_String_To_List(Project_Manager.New_Project.Project_Name.all & '-' & Versions.Version_Io.To_String(Project_Manager.New_Project.Version) & Directory_Separator & Project_Manager.New_Project.Project_Name.all & Directory_Separator & Project_Manager.New_Project.Libs(Component_Cur).Unit_Name.all & Directory_Separator); -- Text_Io.Put_Line("Args ok !"); -- Text_Io.Skip_Line; Open(App.Sessions(M.Logs.Project)); -- Text_Io.Put_Line("Session openned !"); -- Text_Io.Skip_Line; -- Text_Io.Put_Line("Exec on path : " & Locate_Exec_On_Path("emacs").all); -- Text_Io.Skip_Line; Spawn(Locate_Exec_On_Path("emacs").all, Args.all, Outfilename, Success, errno); Close(App.Sessions(M.Logs.Project)); Statistic(App.Sessions, App.Logs); Put(Ansi_Tty_Control.Clear_Screen); --Errno := System("clear" & Character'Val(0)); if App.Desktop(2) /= null then case App.Desktop(2).Name is when None => null; when Log => Logs_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when MoneyBox => Moneybox_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when Activity => Activity_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when Stocks => Stocks_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when Bank => bank_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when Planning => planning_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when Library => Library_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when Manager => null; when Contacts => Contacts_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when Menu => null; when Organizer => organizer_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when Dialog => Vbrain_Record(App.Desktop(2).all).Proc.Wake_Up(0); when others => null; end case; end if; Load_File(File_Set, Outfilename, Line_Last); end if; else begin Cmd := Value(Handling.To_String(Cmd_Line(Cmd_Line'First..Cmd_Last))); case Cmd is when None => null; when Help => null; when Make => if Cmd_Last = 4 then Free(Args); Args := new Argument_List(1..0); ------------------------------------------------------------------- -- Spawn(Make_On_Bin.all, Args.all, Outfilename, Success, errno); -- replaced by Pid := Non_Blocking_Spawn(Make_On_Bin.all, Args.all, Outfilename); Wait_Process(Pid, Success); -------------------------------------------------------------------- Load_File(File_Set, Outfilename, Line_Last); elsif Cmd_Last > 5 then begin Change_Dir(Project_Manager.New_Project.Project_Name.all & "-" & Version_Io.To_String(Project_manager.New_Project.Version)); Free(Args); Args := Argument_String_To_List(Handling.To_String(Cmd_Line(6..Cmd_Last)) & Character'Val(0)); ----------------------------------------------------------------- -- Spawn(Make_On_Bin.all, Args.all, Outfilename, Success, errno);  -- replaced by Pid := Non_Blocking_Spawn(Make_On_Bin.all, Args.all, Outfilename); Wait_Process(Pid, Success); -------------------------------------------------------------------- Load_File(File_Set, Outfilename, Line_Last); Change_Dir(".."); exception when Name_Error => Put_Line("name error"); when Constraint_Error => Put_Line("constraint error"); when others => Put_Line("others error"); end ; end if; when Add => if Cmd_Last > 4 then Lib_Add(Project_Manager.New_Project.all, Handling.To_String(Cmd_Line(5..Cmd_Last))); List_Save(Project_Manager.New_Project.all); else Put(Character'Val(7)); end if; when Remove => begin Line_Num := Natural'Value(Handling.To_String(Cmd_Line(Cmd_Line'First+7..Cmd_Last))); Remove_Name(Project_Manager.New_Project.all, Line_Num); List_Save(Project_Manager.New_Project.all); exception when others => null; end; when Upgrade => ---------------------------------------------------------------------------------------------------------- -- -- -- -- -- -- Upgraded := new Project_Record ' (Project_Manager.New_project.all); Text_Io.Put_Line("Update version..."); Text_Io.Put_Line("-- check for New Specifications..."); Versions.New_Description := Environment.Check_Modification_To_New_Description(Project_Context.all); Text_Io.Put_Line("-- check for New Implementation..."); Versions.New_Action := Environment.Check_Modification_To_New_Action(Project_Context.all); Text_Io.Put_Line("-- Version Update..."); -- update Version ! if Project_Context.Project.Project_Prefix /= null then Text_Io.Put_Line("Project prefix : " & Project_Context.Project.Project_Prefix.all); Text_Io.Put_Line("Project name : " & Project_Context.Project.Project_Name.all); declare Node_Name : access String := new String ' (Project_Context.Project.Project_Name(Project_Context.Project.Project_Prefix'Length+1..Project_Context.Project.Project_Name'Last)); begin if Versions.New_Description then Upgraded.Version := Version_Update(Upgraded.Version); Text_Io.Put_Line("-- Editting minor version..."); Main_Description(Project_Context.Project.Project_Name.all, Project_Context.Project.Project_Prefix.all, "Date", Formatting.Image(Clock), Node_Name.all); Main_Description(Project_Context.Project.Project_Name.all, Project_Context.Project.Project_Prefix.all, "Version", Versions.Version_Io.To_String(Upgraded.Version), Node_Name.all); for File_Id in Specifications_Filenames_Search.File_Content'Range loop Update(Handling.To_String(Gnos.Results."-"(Specifications_Filenames_Search.File_Content(File_Id))), "Date", Formatting.Image(Clock)); Update(Handling.To_String(Gnos.Results."-"(Specifications_Filenames_Search.File_Content(File_Id))), "Version", Versions.Version_Io.To_String(Upgraded.Version)); end loop; end if; if Versions.New_Action then Upgraded.Version := Version_Update(Upgraded.Version); Text_Io.Put_Line("-- Editting revision version..."); Main_Description(Project_Context.Project.Project_Name.all, Project_Context.Project.Project_Prefix.all, "Date", Formatting.Image(Clock), Node_Name.all); Main_Description(Project_Context.Project.Project_Name.all, Project_Context.Project.Project_Prefix.all, "Version", Versions.Version_Io.To_String(Upgraded.Version), Node_Name.all); for File_Id in Implementations_Filenames_Search.File_Content'Range loop Update(Handling.To_String(Gnos.Results."-"(Implementations_Filenames_Search.File_Content(File_Id))), "Date", Formatting.Image(Clock)); Update(Handling.To_String(Gnos.Results."-"(Implementations_Filenames_Search.File_Content(File_Id))), "Version", Versions.Version_Io.To_String(Upgraded.Version)); end loop; end if; if Versions.New_Action or Versions.New_Description then Upgraded.Version := Version_Update(Upgraded.Version); Text_Io.Put_Line("-- Editting major version..."); To_Major(Project_Context.Project.Project_Name.all, Project_Context.Project.Project_Prefix.all); To_Minor(Project_Context.Project.Project_Name.all, Project_Context.Project.Project_Prefix.all); To_Revision(Project_Context.Project.Project_Name.all, Project_Context.Project.Project_Prefix.all); else Upgraded.Version := Version_Update(Upgraded.Version); Text_Io.Put_Line("-- Editting release version..."); To_Release(Project_Context.Project.Project_Name.all, Project_Context.Project.Project_Prefix.all); end if; Versions.New_Action := False; Versions.New_Description := False; end; else Text_Io.Put_Line("Project name : " & Project_Context.Project.Project_Name.all); declare Node_Name : access String := new String ' (""); begin if Versions.New_Description then Upgraded.Version := Version_Update(Upgraded.Version); Main_Description(Project_Context.Project.Project_Name.all, "", "Date", Formatting.Image(Clock), Node_Name.all); Main_Description(Project_Context.Project.Project_Name.all, "", "Version", Versions.Version_Io.To_String(Upgraded.Version), Node_Name.all); for File_Id in Specifications_Filenames_Search.File_Content'Range loop Update(Handling.To_String(Gnos.Results."-"(Specifications_Filenames_Search.File_Content(File_Id))), "Date", Formatting.Image(Clock)); Update(Handling.To_String(Gnos.Results."-"(Specifications_Filenames_Search.File_Content(File_Id))), "Version", Versions.Version_Io.To_String(Upgraded.Version)); end loop; end if; if Versions.New_Action then Upgraded.Version := Version_Update(Upgraded.Version); Main_Description(Project_Context.Project.Project_Name.all, "", "Date", Formatting.Image(Clock), Node_Name.all); Main_Description(Project_Context.Project.Project_Name.all, "", "Version", Versions.Version_Io.To_String(Upgraded.Version), Node_Name.all); for File_Id in Implementations_Filenames_Search.File_Content'Range loop Update(Handling.To_String(Gnos.Results."-"(Implementations_Filenames_Search.File_Content(File_Id))), "Date", Formatting.Image(Clock)); Update(Handling.To_String(Gnos.Results."-"(Implementations_Filenames_Search.File_Content(File_Id))), "Version", Versions.Version_Io.To_String(Upgraded.Version)); end loop; end if; if Versions.New_Action or Versions.New_Description then Text_Io.Put_Line("-- Editting revision version..."); To_Revision(Project_Context.Project.Project_Name.all, ""); Text_Io.Put_Line("-- Editting minor version..."); To_Minor(Project_Context.Project.Project_Name.all, ""); Text_Io.Put_Line("-- Editting major version..."); To_Major(Project_Context.Project.Project_Name.all, ""); else Upgraded.Version := Version_Update(Upgraded.Version); Text_Io.Put_Line("-- Editting release version..."); To_Release(Project_Context.Project.Project_Name.all, ""); end if; Versions.New_Action := False; Versions.New_Description := False; end; end if; -- -- -- -- -- -- -- ----------------------------------------------------------------------------------------------------------- if Upgraded /= null then App.Projects.Projects_Num := App.Projects.Projects_Num + 1; Upgraded.Project_Num := App.Projects.Projects_Num; Curs := Last(App.Projects.List); Projects_DLL.Delete(App.Projects.List, Curs); if Upgraded.Version.Revision_Version + 1 < M.Versions.Revision_Version_Type'Last then Upgraded.Version.Revision_Version := Upgraded.Version.Revision_Version + 1; end if; Replace_Description("Current_Major", Tools.Integer_Image(Upgraded.Version.Major_Version), Project_Context.Project.Project_Name.all & "-" & Version_Io.To_String(Versions.Version) & "/" & Project_Context.Project.Project_Name.all & "/" & Project_Context.Project.Project_Prefix.all & "-versions/src/lib/" & Project_Context.Project.Project_Prefix.all & "-versions.ads"); Replace_Description ("Current_Minor", Tools.Integer_Image(Upgraded.Version.Minor_Version), Project_Context.Project.Project_Name.all & "-" & Version_Io.To_String(Versions.Version) & "/" & Project_Context.Project.Project_Name.all & "/" & Project_Context.Project.Project_Prefix.all & "-versions/src/lib/" & Project_Context.Project.Project_Prefix.all & "-versions.ads"); Replace_Description ("Current_Revision", Tools.Integer_Image(Upgraded.Version.Revision_Version), Project_Context.Project.Project_Name.all & "-" & Version_Io.To_String(Versions.Version) & "/" & Project_Context.Project.Project_Name.all & "/" & Project_Context.Project.Project_Prefix.all & "-versions/src/lib/" & Project_Context.Project.Project_Prefix.all & "-versions.ads"); Replace_Description ("Current_Release", Character'image(Upgraded.Version.Release_Version), Project_Context.Project.Project_Name.all & "-" & Version_Io.To_String(Versions.Version) & "/" & Project_Context.Project.Project_Name.all & "/" & Project_Context.Project.Project_Prefix.all & "-versions/src/lib/" & Project_Context.Project.Project_Prefix.all & "-versions.ads"); Append(App.Projects.List, Upgraded); Projects_Manager.Manager_Save(App.Projects, "./Projects.lst"); if Update(Get_Info(App.Projects, Project_Manager.New_Project.Project_Num), Upgraded.Version, App.Sessions, App.Logs) = 0 then Projects_Dll.Clear(App.Projects.List); Projects_Manager.Manager_Load(App.Projects, "./Projects.lst"); end if; App.Projects.Projects_Num := App.Projects.Projects_Num + 1; Append(App.Projects.List, new Project_Record ' (Null_Project)); end if; Project.Close(Project_Manager.New_Project.all, Clock); Project_Count := 0; Project_Index := 0; Curs := First(App.Projects.List); Project_Num := First_Element(App.Projects.List).Project_Num; Project_Manager.New_Project := Get_Project(App.Projects, Project_Num); Step_Cur := Prj_Selector; Close(App.Sessions(M.Logs.Project)); Statistic(App.Sessions, App.Logs); Put(Ansi_Tty_Control.Clear_Screen); --Errno := System("clear" & Character'Val(0)); if App.Desktop(2) /= null then case App.Desktop(2).Name is when None => null; when Log => Logs_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when MoneyBox => Moneybox_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when Activity => Activity_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when Stocks => Stocks_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when Bank => bank_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when Planning => planning_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when Library => Library_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when Manager => null; when Contacts => Contacts_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when Menu => null; when Organizer => organizer_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when Dialog => Vbrain_Record(App.Desktop(2).all).Proc.Wake_Up(0); when others => null; end case; end if; when Quit => null; end case; Cmd_Last := 0; Cmd_Line := (others => Wide_Character'Val(32)); exception when others => null; end; end if; if Cmd_Last = 0 then null; else null; end if; when Wide_Character'Val(12) => ---------------------------------------------- --Errno := System("clear" & Character'Val(0)); --------------------------------------------- null; when Wide_Character'Val(18) => Step_Cur := Prj_manager; Cursor_Set(Project_Manager.Curs, From => Project_Manager.New_Project.all); Project.Close(Project_Manager.New_Project.all, Clock); when Wide_Character'Val(21) => ---------------------------------------------------------------------------------------------------------- -- -- -- -- -- -- Upgraded := new Project_Record ' (Project_Manager.New_project.all); Text_Io.Put_Line("Update version..."); Text_Io.Put_Line("-- check for New Specifications..."); Versions.New_Description := Environment.Check_Modification_To_New_Description(Project_Context.all); Text_Io.Put_Line("-- check for New Implementation..."); Versions.New_Action := Environment.Check_Modification_To_New_Action(Project_Context.all); Text_Io.Put_Line("-- Version Update..."); -- update Version ! if Project_Context.Project.Project_Prefix /= null then Text_Io.Put_Line("Project prefix : " & Project_Context.Project.Project_Prefix.all); Text_Io.Put_Line("Project name : " & Project_Context.Project.Project_Name.all); declare Node_Name : access String := new String ' (Project_Context.Project.Project_Name(Project_Context.Project.Project_Prefix'Length+1..Project_Context.Project.Project_Name'Last)); begin if Versions.New_Description then Put_Line("Current version is : " & Versions.Version_Io.To_String(Upgraded.Version)); Upgraded.Version := Version_Update(Upgraded.Version); Put_Line("version is updated :" & Versions.Version_Io.To_String(Upgraded.Version)); Text_Io.Put_Line("-- Editting minor version..."); Main_Description(Project_Context.Project.Project_Name.all, Project_Context.Project.Project_Prefix.all, "Date", Formatting.Image(Clock), Node_Name.all); Main_Description(Project_Context.Project.Project_Name.all, Project_Context.Project.Project_Prefix.all, "Version", Versions.Version_Io.To_String(Upgraded.Version), Node_Name.all); for File_Id in Specifications_Filenames_Search.File_Content'Range loop Update(Handling.To_String(Gnos.Results."-"(Specifications_Filenames_Search.File_Content(File_Id))), "Date", Formatting.Image(Clock)); Update(Handling.To_String(Gnos.Results."-"(Specifications_Filenames_Search.File_Content(File_Id))), "Version", Versions.Version_Io.To_String(Upgraded.Version)); end loop; end if; if Versions.New_Action then Put_Line("Current version is : " & Versions.Version_Io.To_String(Upgraded.Version)); Upgraded.Version := Version_Update(Upgraded.Version); Put_Line("version is updated :" & Versions.Version_Io.To_String(Upgraded.Version)); Text_Io.Put_Line("-- Editting revision version..."); Main_Description(Project_Context.Project.Project_Name.all, Project_Context.Project.Project_Prefix.all, "Date", Formatting.Image(Clock), Node_Name.all); Main_Description(Project_Context.Project.Project_Name.all, Project_Context.Project.Project_Prefix.all, "Version", Versions.Version_Io.To_String(Upgraded.Version), Node_Name.all); for File_Id in Implementations_Filenames_Search.File_Content'Range loop Update(Handling.To_String(Gnos.Results."-"(Implementations_Filenames_Search.File_Content(File_Id))), "Date", Formatting.Image(Clock)); Update(Handling.To_String(Gnos.Results."-"(Implementations_Filenames_Search.File_Content(File_Id))), "Version", Versions.Version_Io.To_String(Upgraded.Version)); end loop; end if; if Versions.New_Action or Versions.New_Description then Put_Line("Current version is : " & Versions.Version_Io.To_String(Upgraded.Version)); Upgraded.Version := Version_Update(Upgraded.Version); Put_Line("version is updated :" & Versions.Version_Io.To_String(Upgraded.Version)); Text_Io.Put_Line("-- Editting major version..."); To_Major(Project_Context.Project.Project_Name.all, Project_Context.Project.Project_Prefix.all); To_Minor(Project_Context.Project.Project_Name.all, Project_Context.Project.Project_Prefix.all); To_Revision(Project_Context.Project.Project_Name.all, Project_Context.Project.Project_Prefix.all); else Upgraded.Version := Version_Update(Upgraded.Version); Text_Io.Put_Line("-- Editting release version..."); To_Release(Project_Context.Project.Project_Name.all, Project_Context.Project.Project_Prefix.all); end if; Versions.New_Action := False; Versions.New_Description := False; end; else Text_Io.Put_Line("Project name : " & Project_Context.Project.Project_Name.all); declare Node_Name : access String := new String ' (""); begin if Versions.New_Description then Put_Line("Current version is : " & Versions.Version_Io.To_String(Upgraded.Version)); Upgraded.Version := Version_Update(Upgraded.Version); Put_Line("version is updated :" & Versions.Version_Io.To_String(Upgraded.Version)); Main_Description(Project_Context.Project.Project_Name.all, "", "Date", Formatting.Image(Clock), Node_Name.all); Main_Description(Project_Context.Project.Project_Name.all, "", "Version", Versions.Version_Io.To_String(Upgraded.Version), Node_Name.all); for File_Id in Specifications_Filenames_Search.File_Content'Range loop Update(Handling.To_String(Gnos.Results."-"(Specifications_Filenames_Search.File_Content(File_Id))), "Date", Formatting.Image(Clock)); Update(Handling.To_String(Gnos.Results."-"(Specifications_Filenames_Search.File_Content(File_Id))), "Version", Versions.Version_Io.To_String(Upgraded.Version)); end loop; end if; if Versions.New_Action then Put_Line("Current version is : " & Versions.Version_Io.To_String(Upgraded.Version)); Upgraded.Version := Version_Update(Upgraded.Version); Put_Line("version is updated :" & Versions.Version_Io.To_String(Upgraded.Version)); Main_Description(Project_Context.Project.Project_Name.all, "", "Date", Formatting.Image(Clock), Node_Name.all); Main_Description(Project_Context.Project.Project_Name.all, "", "Version", Versions.Version_Io.To_String(Upgraded.Version), Node_Name.all); for File_Id in Implementations_Filenames_Search.File_Content'Range loop Update(Handling.To_String(Gnos.Results."-"(Implementations_Filenames_Search.File_Content(File_Id))), "Date", Formatting.Image(Clock)); Update(Handling.To_String(Gnos.Results."-"(Implementations_Filenames_Search.File_Content(File_Id))), "Version", Versions.Version_Io.To_String(Upgraded.Version)); end loop; end if; if Versions.New_Action or Versions.New_Description then Text_Io.Put_Line("-- Editting revision version..."); To_Revision(Project_Context.Project.Project_Name.all, ""); Text_Io.Put_Line("-- Editting minor version..."); To_Minor(Project_Context.Project.Project_Name.all, ""); Text_Io.Put_Line("-- Editting major version..."); To_Major(Project_Context.Project.Project_Name.all, ""); else if Environment.Version_Update /= 0 then raise Program_Error; end if; Text_Io.Put_Line("-- Editting release version..."); To_Release(Project_Context.Project.Project_Name.all, ""); end if; Versions.New_Action := False; Versions.New_Description := False; end; end if; -- -- -- -- -- -- -- ----------------------------------------------------------------------------------------------------------- if Upgraded /= null then App.Projects.Projects_Num := App.Projects.Projects_Num + 1; Upgraded.Project_Num := App.Projects.Projects_Num; Curs := Last(App.Projects.List); Projects_DLL.Delete(App.Projects.List, Curs); if Upgraded.Version.Revision_Version + 1 < M.Versions.Revision_Version_Type'Last then Upgraded.Version.Revision_Version := Upgraded.Version.Revision_Version + 1; end if; Replace_Description("Current_Major", Tools.Integer_Image(Upgraded.Version.Major_Version), Project_Context.Project.Project_Name.all & "-" & Version_Io.To_String(Versions.Version) & "/" & Project_Context.Project.Project_Name.all & "/" & Project_Context.Project.Project_Prefix.all & "-versions/src/lib/" & Project_Context.Project.Project_Prefix.all & "-versions.ads"); Replace_Description ("Current_Minor", Tools.Integer_Image(Upgraded.Version.Minor_Version), Project_Context.Project.Project_Name.all & "-" & Version_Io.To_String(Versions.Version) & "/" & Project_Context.Project.Project_Name.all & "/" & Project_Context.Project.Project_Prefix.all & "-versions/src/lib/" & Project_Context.Project.Project_Prefix.all & "-versions.ads"); Replace_Description ("Current_Revision", Tools.Integer_Image(Upgraded.Version.Revision_Version), Project_Context.Project.Project_Name.all & "-" & Version_Io.To_String(Versions.Version) & "/" & Project_Context.Project.Project_Name.all & "/" & Project_Context.Project.Project_Prefix.all & "-versions/src/lib/" & Project_Context.Project.Project_Prefix.all & "-versions.ads"); Replace_Description ("Current_Release", Character'image(Upgraded.Version.Release_Version), Project_Context.Project.Project_Name.all & "-" & Version_Io.To_String(Versions.Version) & "/" & Project_Context.Project.Project_Name.all & "/" & Project_Context.Project.Project_Prefix.all & "-versions/src/lib/" & Project_Context.Project.Project_Prefix.all & "-versions.ads"); Append(App.Projects.List, Upgraded); Projects_Manager.Manager_Save(App.Projects, "./Projects.lst"); if Update(Get_Info(App.Projects, Project_Manager.New_Project.Project_Num), Upgraded.Version, App.Sessions, App.Logs) = 0 then Projects_Dll.Clear(App.Projects.List); Projects_Manager.Manager_Load(App.Projects, "./Projects.lst"); end if; App.Projects.Projects_Num := App.Projects.Projects_Num + 1; Append(App.Projects.List, new Project_Record ' (Null_Project)); Projects_Manager.Manager_Save(App.Projects, "./Projects.lst"); end if; Project.Close(Project_Manager.New_Project.all, Clock); Project_Count := 0; Project_Index := 0; Curs := First(App.Projects.List); Project_Num := First_Element(App.Projects.List).Project_Num; Project_Manager.New_Project := Get_Project(App.Projects, Project_Num); Close(App.Sessions(M.Logs.Project)); Statistic(App.Sessions, App.Logs); Step_Cur := Prj_Selector; Put(Ansi_Tty_Control.Clear_Screen); --Errno := System("clear" & Character'Val(0)); if App.Desktop(2) /= null then case App.Desktop(2).Name is when None => null; when Log => Logs_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when MoneyBox => Moneybox_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when Activity => Activity_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when Stocks => Stocks_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when Bank => bank_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when Planning => planning_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when Library => Library_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when Manager => null; when Contacts => Contacts_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when Menu => null; when Organizer => organizer_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); when Dialog => Vbrain_Record(App.Desktop(2).all).Proc.Wake_Up(0); when others => null; end case; end if; when Wide_Character'Val(127) => if Cmd_Last > 0 then Cmd_Line(Cmd_Last) := Wide_Character'Val(32); Cmd_Last := Cmd_Last - 1; else Project.Close(Project_Manager.New_Project.all, Clock); Close(App.Sessions(M.Logs.Project)); Statistic(App.Sessions, App.Logs); Step_Cur := Prj_Selector; end if; when others => null; end case; elsif Cmd_Last < Cmd_Line'Length then Cmd_Line(Cmd_Last + 1) := Wchar; Cmd_Last := Cmd_Last + 1; else Put(Character'Val(7)); end if; end Receive; case Step_Cur is when Prj_None => null; when Prj_Selector => Draw_Window(Project_Header); if Project_Manager.New_Project /= null then Draw_Header(Project_Manager.New_Project.all, Project_Header); end if; Draw_Window(Project_Selector); Projects_Print(App.Projects, Project_Index, Project_Num, App.Lines, App.Columns, top); when Prj_Manager => Draw_Window(Manager_Abs); Draw_Text(Manager_Abs, 1, 1, White, "Abstract : "); Draw_Window(Manager_N); Draw_Text(Manager_N, 1, 1, White, "Name : " & Handling.To_Wide_String(Project_Manager.New_Project.Project_Name.all)); Draw_Window(Manager_Ver); Draw_Text(Manager_Ver, 1, 1, White, "Version : " & Handling.To_Wide_String(Version_Io.To_String(Project_Manager.New_Project.Version))); Draw_Window(Manager_Auth); Draw_Text(Manager_Auth, 1, 1, White, "Author : " & Handling.To_Wide_String(Project_Manager.New_Project.Copyright.all)); Draw_Window(Manager_List); List_Print(Project_Manager.New_Project.all, Manager_List, Lib_Index); Draw_Window(Manager_cmd); Draw_Text(Manager_cmd, 1, 1, White, "Command : "); Draw_Text( Project_Manager.Curs.Parts(Project_Manager.Curs.Part_Cur).Win, Project_Manager.Curs.Parts(Project_Manager.Curs.Part_Cur).Line_Pos, Project_Manager.Curs.Parts(Project_Manager.Curs.Part_Cur).Column_Pos, White, Project_Manager.Curs.Parts (Project_Manager.Curs.Part_Cur).Line(1..Project_Manager.Curs.Parts(Project_Manager.Curs.Part_Cur).Last) ); if Line_Remove then if Lib_Name_Last > 0 then Draw_Text(Manager_cmd, 1, 1, White, "Line num : " & Lib_Name(1..Lib_Name_last)); else Draw_Text(Manager_cmd, 1, 1, White, "Line num : "); end if; elsif Cmd_Last > 0 then Draw_Window(Manager_cmd); Draw_Text(Manager_cmd, 1, 1, White, "Command : " & Cmd_Line(Cmd_Line'First..Cmd_Last)); else Draw_Window(Manager_cmd); Draw_Text(Manager_cmd, 1, 1, White, "Command : "); end if; when Prj_Upgrade => Draw_Window(Components_Win); Components_Print(Project_Manager.New_Project.all, Component_Index , Component_cur, (App.Lines-8)/2-2, App.Columns, top); Draw_Window(Make_Win); if not Print_Set(File_Set, Make_Win, File_Index, Total_lines) then raise Program_Error; end if; if Cmd_Last > 0 then Draw_Window(Manager_cmd); Draw_Text(Manager_cmd, 1, 1, White, "Command : " & Cmd_Line(Cmd_Line'First..Cmd_Last)); else Draw_Window(Manager_cmd); Draw_Text(Manager_cmd, 1, 1, White, "Command : "); end if; when others => null; end case; or accept Refresh do null; end Refresh; or accept Page_Down do case Step_Cur is when Prj_Selector => null; when Prj_Creator => if Lib_Index + (Creator_List.Win.H-2) < Creator.New_Project.Lib_Last then Lib_Index := Lib_Index + (Creator_List.Win.H-2); Draw_Window(Creator_List); List_Print(Creator.New_Project.all, Creator_List, Lib_Index); else Put(character'Val(0)); end if; when Prj_Manager => if Lib_Index + (Manager_List.Win.H-2) < Project_Manager.New_Project.Lib_Last then Lib_Index := Lib_Index + (Manager_List.Win.H-2); Draw_Window(Manager_List); List_Print(Project_Manager.New_Project.all, Manager_List, Lib_Index); else Put(character'Val(0)); end if; when Prj_Upgrade => if File_Index < Integer'Min(File_Index + (App.Lines-8)/2-3, Line_Last) then File_Index := Integer'Min(File_Index + (App.Lines-8)/2-3, Line_Last); end if; Draw_Window(Make_Win); if not Print_Set(File_Set, Make_Win, File_Index, Total_lines) then raise Program_Error; end if; when others => null; end case; end Page_Down; or accept Page_Up do case Step_Cur is when Prj_Selector => null; when Prj_Creator => if Lib_Index - (Creator_List.Win.H-2) >= 0 then Lib_Index := Lib_Index - (Creator_List.Win.H-2); Draw_Window(Creator_List); List_Print(Creator.New_Project.all, Creator_List, Lib_Index); elsif Lib_Index /= 0 then Lib_Index := 0; Draw_Window(Creator_List); List_Print(Creator.New_Project.all, Creator_List, Lib_Index); else Put(character'Val(0)); end if; when Prj_Manager => if Lib_Index - (Creator_List.Win.H-2) >= 0 then Lib_Index := Lib_Index - (Manager_List.Win.H-2); Draw_Window(Creator_List); List_Print(Project_Manager.New_Project.all, Manager_List, Lib_Index); elsif Lib_Index /= 0 then Lib_Index := 0; Draw_Window(Manager_List); List_Print(Project_manager.New_Project.all, Manager_List, Lib_Index); else Put(character'Val(0)); end if; when Prj_Upgrade => if File_Index - (App.Lines-8)/2-2 >= 0 then File_Index := File_Index - (App.Lines-8)/2-2; else File_Index := 0; end if; Draw_Window(Make_Win); if not Print_Set(File_Set, Make_Win, File_Index, Total_lines) then raise Program_Error; end if; when others => null; end case; end Page_Up; or accept Up_Arrow do case Step_Cur is when Prj_Archives => if Arch_Curs /= First(App.Archives.List) then Previous(Arch_Curs); if Arch_Count > 0 then Arch_Count := Arch_Count - 1; elsif Arch_Index > 0 then Arch_Index := Arch_Index - 1; end if; end if; Arch_Num := Projects_dll.Element(Arch_Curs).Project_Num; Draw_Window(Project_Selector); Archives_Print(App.Archives, Arch_Index, Arch_Num, App.Lines, App.Columns, top); when Prj_Selector => if Curs /= First(App.Projects.List) then Previous(Curs); if Project_Count > 0 then Project_Count := Project_Count - 1; elsif Project_Index > 0 then Project_Index := Project_Index - 1; end if; declare Current : constant Project.Project_Access := Element(Curs); begin if Current /= null then Project_Num := Current.Project_Num; end if; end; end if; Project_Manager.New_Project := Get_Project(App.Projects, Project_Num); Draw_Window(Project_Header); if Project_Manager.New_Project /= null then Draw_Header(Project_Manager.New_Project.all, Project_Header); else Draw_Header(Null_Project, Project_Header); end if; Draw_Window(Project_Selector); Projects_Print(App.Projects, Project_Index, Project_Num, App.Lines, App.Columns, top); when Prj_Creator => null; when Prj_Manager => null; when Prj_Upgrade => if Project_Manager.New_Project /= null and then Component_Cur - 1 >= 0 then Component_Cur := Component_Cur - 1; Component_Index := Integer'Max(0, Component_Cur - ((App.Lines-8)/2-2)/3); Draw_Window(Components_Win); Components_Print(Project_Manager.New_Project.all, Component_Index , Component_cur, (App.Lines-8)/2-2, App.Columns, top); if Cmd_Last > 0 then Draw_Window(Manager_cmd); Draw_Text(Manager_cmd, 1, 1, White, "Command : " & Cmd_Line(Cmd_Line'First..Cmd_Last)); else Draw_Window(Manager_cmd); Draw_Text(Manager_cmd, 1, 1, White, "Command : "); end if; else Put(Character'Val(7)); end if; when others => null; end case; end up_arrow; or accept Down_Arrow do case Step_Cur is when Prj_Archives => if Arch_Curs /= Last(App.Archives.List) then Arch_Curs := Next(Arch_Curs); if Arch_Count < (App.Lines-7)/5-1 then Arch_Count := Arch_Count + 1; elsif Arch_Index < Natural(Projects_Dll.Length(App.Archives.List)) then Arch_Index := Arch_Index + 1; end if; Arch_Num := Projects_dll.Element(Arch_Curs).Project_Num; end if; Draw_Window(Project_Selector); Archives_Print(App.Archives, Arch_Index, Arch_Num, App.Lines, App.Columns, top); when Prj_Selector => if Curs /= Last(App.Projects.List) then Curs := Next(Curs); if Project_Count < (App.Lines-7)/5-1 then Project_Count := Project_Count + 1; elsif Project_Index < Natural(Projects_Dll.Length(App.Projects.List)) then Project_Index := Project_Index + 1; end if; declare Current : constant Project.Project_Access := Element(Curs); begin Project_Num := Current.Project_Num; end; end if; Project_Manager.New_Project := Get_Project(App.Projects, Project_Num); Draw_Window(Project_Header); if Project_Manager.New_Project /= null then Draw_Header(Project_Manager.New_Project.all, Project_Header); else Draw_Header(Null_Project, Project_Header); end if; Draw_Window(Project_Selector); Projects_Print(App.Projects, Project_Index, Project_Num, App.Lines, App.Columns, top); when Prj_Creator => null; when Prj_Manager => null; when Prj_Upgrade => if Project_Manager.New_Project /= null and then Component_Cur + 1 <= Project_Manager.New_Project.Lib_Last then Component_Cur := Component_Cur + 1; Component_Index := Integer'Max(0, Component_Cur - ((App.Lines-8)/2-2)/3); Draw_Window(Components_Win); Components_Print(Project_Manager.New_Project.all, Component_Index , Component_cur, (App.Lines-8)/2-2, App.Columns, top); if Cmd_Last > 0 then Draw_Window(Manager_cmd); Draw_Text(Manager_cmd, 1, 1, White, "Command : " & Cmd_Line(Cmd_Line'First..Cmd_Last)); else Draw_Window(Manager_cmd); Draw_Text(Manager_cmd, 1, 1, White, "Command : "); end if; end if; when others => null; end case; end Down_Arrow; or accept Left_Arrow; or accept Right_Arrow; or accept Full_Screen; or accept Del; or accept Begin_Of do case Step_Cur is when Prj_Selector => Curs := First(App.Projects.List); Project_Num := Element(Curs).Project_Num; Project_Manager.New_Project := Get_Project(App.Projects, Project_Num); Draw_Window(Project_Header); if Project_Manager.New_Project /= null then Draw_Header(Project_Manager.New_Project.all, Project_Header); else Draw_Header(Null_Project, Project_Header); end if; Project_Count := 0; Project_Index := 0; Draw_Window(Project_Selector); Projects_Print(App.Projects, Project_Index, Project_Num, App.Lines, App.Columns, top); when Prj_Archives => Arch_Curs := First(App.Archives.List); Arch_Num := Element(Arch_Curs).Project_Num; Draw_Window(Project_Selector); Archives_Print(App.Archives, Arch_Index, Arch_Num, App.Lines, App.Columns, top); Arch_Count := 0; Arch_Index := 0; when Prj_Components => null; when others => null; end case; end Begin_Of; or accept End_Of do case Step_Cur is when Prj_Selector => Curs := Last(App.Projects.List); Project_Num := Element(Curs).Project_Num; Project_Manager.New_Project := Get_Project(App.Projects, Project_Num); Draw_Window(Project_Header); if Project_Manager.New_Project /= null then Draw_Header(Project_Manager.New_Project.all, Project_Header); else Draw_Header(Null_Project, Project_Header); end if; Project_Count := Integer(Length(App.Projects.List) - 1); Project_Index := Integer'max(0, Integer(Length(App.Projects.List)) - ((App.Lines-7)/5)-1); Draw_Window(Project_Selector); Projects_Print(App.Projects, Project_Index, Project_Num, App.Lines, App.Columns, top); when Prj_Archives => Arch_Curs := Last(App.Archives.List); Arch_Num := Element(Arch_Curs).Project_Num; Draw_Window(Project_Selector); Archives_Print(App.Archives, Arch_Index, Arch_Num, App.Lines, App.Columns, top); Arch_Count := Integer(Length(App.Archives.List) - 1); Arch_Index := Integer'max(0, Integer(Length(App.Archives.List)) - ((App.Lines-7)/5)-1); when Prj_Components => null; when others => null; end case; end End_Of; or accept Overwrite; or accept Full_Screen; end select; end loop; end loop Main_Loop; end; --W_Io.Put_Line("Manager process halted"); end Manager_Process; ------------------------------------------------------------------------------------------------------------- -- -- -- Money Box -- -- -- ------------------------------------------------------------------------------------------------------------- type Value_Enum is (None_Value, Name_Value, Price_Ht_Value, Quantity_Value, Tva_Rate_Value, Total_Ht_Value, Total_Tva_Value, Total_Ttc_Value, Delete_value); type Value_Type is record Name : Value_Enum := None_Value; Line : Wstring_45 := (others => ' '); Line_Last : Natural := 0; Line_Pos : Line_Range := 1; Column_Pos : Column_Range := 1; end record; type Value_Array is array (Value_Enum) of Value_Type; type Line_Cursor_Type is record Values : Value_Array; Val_Cur : Value_Enum := name_Value; end record; function Initialize return Line_Cursor_Type is Curs : Line_Cursor_Type; begin Curs.Values(Name_value) := (Name_Value, (others => ' '), 0, 3, 13 ); Curs.Values(Price_Ht_value) := (Price_Ht_Value, (others => ' '), 0, 5, 13 ); Curs.Values(Quantity_value) := (Quantity_Value, (others => ' '), 0, 7, 13 ); Curs.Values(TVA_Rate_value) := (TVA_Rate_Value, (others => ' '), 0, 9, 13 ); Curs.Values(Total_Ht_value) := (Total_Ht_Value, (others => ' '), 0, 11, 13 ); Curs.Values(Total_Tva_value) := (Total_Tva_Value, (others => ' '), 0, 13, 13 ); Curs.Values(Total_ttc_value) := (Total_Ttc_Value, (others => ' '), 0, 15, 13 ); Curs.Val_Cur := Name_Value; return Curs; end Initialize; function To_Account_Line (Curs : in Line_Cursor_Type;Account_Num : in Account_Num_Range;Line_Num : in Account_Line_Range) return Account_Line_Type is Line : Account_Line_Type := Null_Line; begin Line.Line_Num := Line_Num; Line.Description(1..Curs.Values(Name_Value).Line_Last) := Curs.Values(Name_Value).Line(1..Curs.Values(Name_Value).Line_Last); Line.Account_num := Account_Num; Line.Unit_Ht_Price := Fixed_Unit_Ht'Value(Handling.To_String(Curs.Values(Price_Ht_Value).Line(1..Curs.Values(Price_Ht_Value).Line_Last))); Line.Tva_Rate := Fixed_Factor'Value(Handling.To_String(Curs.Values(Tva_Rate_Value).Line(1..Curs.Values(Tva_Rate_Value).Line_Last))); Line.Quantity := Quantity_Range'Value(Handling.To_String(Curs.Values(Quantity_Value).Line(1..Curs.Values(Quantity_Value).Line_Last))); Line.Total_Ht := Fixed_Total(Line.Unit_Ht_Price * Fixed_Unit_Ht(Line.Quantity)); Line.Total_Tva := Fixed_total(Line.Total_Ht / Fixed_Total(100.0)) * Fixed_Total(Line.Tva_Rate); Line.Total_Ttc := Line.Total_Ht + Line.Total_Tva; return Line; exception when others => raise Spec_Error; end To_Account_Line; function To_String (Line : in Account_Line_Type) return Wide_String is begin return Handling.To_Wide_String ( Natural'Image(Line.Line_Num) & Character'Val(9) & " " & Handling.To_String(Line.Description(1..16)) & " " & Quantity_Range'Image(Line.Quantity) & Character'Val(9) & Fixed_Factor'Image(Line.Tva_Rate) & Character'Val(9) & Fixed_total'Image(Line.total_ht) & Character'Val(9) & Fixed_total'Image(Line.total_TVA) & Character'Val(9) & Fixed_total'Image(Line.total_TTC) ); end To_String; procedure Initialize(Wins : out Ticket_Windows_Type; Space_Left : in Line_Range; Width : in Column_Range; L : in Line_Range; C : in Column_Range; Top : in Natural := 0) is begin Wins.Line_Num_Win := (L+2, C, Space_Left-2, 8, Cyan, The_Window); Wins.Description_Win := (L+2, C+8, Space_Left-2, 18, Cyan, The_Window); Wins.unit_Ht_Win := (L+2, C+26, Space_Left-2, 12, Cyan, The_Window); Wins.Quantity_Win := (L+2, C+38, Space_Left-2, 14, Cyan, The_Window); Wins.Total_Ht_Win := (L+2, C+52, Space_Left-2, 16, Cyan, The_Window); Wins.TVA_Win := (L+2, C+68, Space_Left-2, 10, Cyan, The_Window); Wins.Total_TVA_Win := (L+2, C+78, Space_Left-2, 16, Cyan, The_Window); Wins.Total_TTC_Win := (L+2, C+94, Space_Left-2, 16, Cyan, The_Window); Initialize(Wins.Line_Num_Win, L+2, Top+C, Space_Left-2, 8, Cyan, Red); Initialize(Wins.Description_Win, L+2, Top+C+8, Space_Left-2, 18, Cyan, Red); Initialize(Wins.unit_Ht_Win, L+2, Top+C+26, Space_Left-2, 12, Cyan, Red); Initialize(Wins.quantity_Win, L+2, Top+C+38, Space_Left-2, 14, Cyan, Red); Initialize(Wins.Total_Ht_Win, L+2, Top+C+52, Space_Left-2, 16, Cyan, Red); Initialize(Wins.TVA_Win, L+2, Top+C+68, Space_Left-2, 10, Cyan, Red); Initialize(Wins.Total_TVA_Win, L+2, Top+C+78, Space_Left-2, 16, Cyan, Red); Initialize(Wins.Total_TTC_Win, L+2, Top+C+94, Space_Left-2, 16, Cyan, Red); null; end Initialize; procedure Ticket_Wins_Draw(Wins : Ticket_Windows_Type) is begin Draw_Window(Wins.Line_Num_Win); Draw_Window(Wins.Description_Win); Draw_Window(Wins.Unit_Ht_Win); Draw_Window(Wins.Quantity_Win); Draw_Window(Wins.Total_Ht_Win); Draw_Window(Wins.TVA_Win); Draw_Window(Wins.Total_TVA_Win); Draw_Window(Wins.Total_Ttc_Win); end Ticket_Wins_Draw; procedure Ticket_Line_Draw(Wins : Ticket_Windows_Type; Line : in Line_Range; Account_Line : in Account_Line_Type) is begin Draw_Text(Wins.Line_Num_Win, Line, 1, White, Handling.To_Wide_String(Voice_Num_Range'Image(Account_Line.Line_Num))); Draw_Text(Wins.Description_Win, Line, 1, White, Account_Line.Description(1..16)); Draw_Text(Wins.unit_Ht_Win, Line, 1, White, Handling.To_Wide_String(Fixed_Unit_ht'Image(Account_Line.Unit_Ht_price))); Draw_Text(Wins.Quantity_win, Line, 1, White, Handling.To_Wide_String(Quantity_Range'Image(Account_Line.Quantity))); Draw_Text(Wins.Total_Ht_Win, Line, 1, White, Handling.To_Wide_String(Fixed_Total'Image(Account_Line.Total_Ht))); Draw_Text(Wins.TVA_Win, Line, 1, White, Handling.To_Wide_String(Fixed_Factor'Image(Account_Line.TVA_Rate))); Draw_Text(Wins.Total_TVA_Win, Line, 1, White, Handling.To_Wide_String(Fixed_Total'Image(Account_Line.Total_TVA))); Draw_Text(Wins.Total_Ttc_Win, Line, 1, White, Handling.To_Wide_String(Fixed_Total'Image(Account_Line.Total_TTC))); end ticket_Line_Draw; procedure Voice_Print (Voice : in Abstracted_Voice'Class; Win : in Ticket_Windows_Type; Line_Index : in Account_Line_Range; Line_Max : in Positive) is Line_Count : natural := 0; begin if Voice.Line_Last = 0 then return; end if; for Line in Line_Index+1..Natural'Min(Line_Index+Line_Max, Voice.Line_Last) loop Ticket_Line_Draw(Win, Line_Count+1, Voice.Accounting(Line)); Line_Count := Line_Count + 1; exit when Line_Count = Line_Max; end loop; end Voice_Print; task body MoneyBox_Process is Removed_Line_Num : Wide_String(1..4) := (others => Wide_Character ' Val (32)); Line_Num : Account_Line_Range; Line_Num_Last : Natural := 0; Remove_Case : Boolean := False; Account_Line_Index : Account_Line_Range := 0; Text : constant M.Strings.Wide_String_Access := new Wide_String ' (""); Line_Curs : Line_Cursor_Type := Initialize; Deal_Name : Deal_Enum := Deal_In; Outvoice : Outvoice_Record := Null_Outvoice; invoice : Invoice_Record := Null_Invoice; Payed : Boolean := False; Validated : Boolean := False; Top : Natural := 0; Box_Dealin : Window_Record := (1, 1, 17, App.Columns/2, Red, The_Window); Box_Dealout : Window_Record := (1, 1, 17, App.Columns/2, Green, The_Window); Voice : Window_Record := (18, 1, App.Lines-28, App.Columns/2, Blue, The_Window); Ticket : Window_Record := (App.Lines-10, 1, 5, App.Columns/2, white, The_Window); Balance : Window_Record := (App.Lines-5, 1, 3, App.Columns/2, Yellow, The_Window); Cmd_Win : Window_Record := (App.Lines-2, 1, 3, App.Columns/2, White, The_Window); begin Initialize(Box_Dealin, 1, Top+1, 17, App.Columns/2, Red, White); Initialize(Box_Dealout, 1, Top+1, 17, App.Columns/2, Green, White); Initialize(Voice, 18, Top+1, App.Lines-28, App.Columns/2, Blue, White); Initialize(Ticket, App.Lines-10, Top+1, 5, App.Columns/2, white, Blue); Initialize(Balance, App.Lines-5, Top+1, 3, App.Columns/2, Yellow, Blue); Initialize(Cmd_Win, App.Lines-2, Top+1, 3, App.Columns/2, White, Red); Initialize(App.Ticket_Wins, App.Lines-30, Top+App.Columns/2-2, 19, 2, 0); begin Main_Loop: loop loop select accept Halt do null; end Halt; exit Main_Loop; or accept Suspend; or accept Wake_Up (Top : in Natural) do Moneybox_Process.Top := Top; Initialize(Box_Dealin, 1, Top+1, 17, App.Columns/2, Red, White); Initialize(Box_Dealout, 1, Top+1, 17, App.Columns/2, Green, White); Initialize(Voice, 18, Top+1, App.Lines-28, App.Columns/2, Blue, White); Initialize(Ticket, App.Lines-10, Top+1, 5, App.Columns/2, white, Blue); Initialize(Balance, App.Lines-5, Top+1, 3, App.Columns/2, Yellow, Blue); Initialize(Cmd_Win, App.Lines-2, Top+1, 3, App.Columns/2, White, Red); Initialize(App.Ticket_Wins, App.Lines-30, Top+App.Columns/2-2, 19, 2, Top); ----------------------------------------------- --Errno := System("clear" & Character'Val(0)); ----------------------------------------------- if Deal_Name = Deal_Out then Draw_Window(Box_Dealout); Draw_Text(Box_Dealout, 1, App.Columns/4-10, White, "Moneybox DealOut"); Draw_Text(Box_Dealout, 3, 1, White, "Name : "); Draw_Text(Box_Dealout, 5, 1, White, "Price HT : "); Draw_Text(Box_Dealout, 7, 1, White, "Quantity : "); Draw_Text(Box_Dealout, 9, 1, White, "TVA rate : "); Draw_Text(Box_Dealout, 11, 1, White, "Total HT : "); Draw_Text(Box_Dealout, 13, 1, White, "Total TVA : "); Draw_Text(Box_Dealout, 15, 1, White, "Total TTC : "); Draw_Window(Ticket); Draw_Text(Ticket, 1, 1, White, "Total HT : " & Handling.To_Wide_String(Fixed_Total'image(Outvoice.Total_ht))); Draw_Text(Ticket, 2, 1, White, "Total TVA : " & Handling.To_Wide_String(Fixed_Total'Image(Outvoice.Total_Tva))); Draw_Text(Ticket, 3, 1, White, "Total TTC : " & Handling.To_Wide_String(Fixed_Total'Image(Outvoice.Total_TTC))); else Draw_Window(Box_Dealin); Draw_Text(Box_Dealin, 1, App.Columns/4-10, White, "Moneybox DealIn"); Draw_Text(Box_Dealin, 3, 1, White, "Name : "); Draw_Text(Box_Dealin, 5, 1, White, "Price HT : "); Draw_Text(Box_Dealin, 7, 1, White, "Quantity : "); Draw_Text(Box_Dealin, 9, 1, White, "TVA rate : "); Draw_Text(Box_Dealout, 11, 1, White, "Total HT : "); Draw_Text(Box_Dealout, 13, 1, White, "Total TVA : "); Draw_Text(Box_Dealout, 15, 1, White, "Total TTC : "); Draw_Window(Ticket); Draw_Text(Ticket, 1, 1, White, "Total HT : " & Handling.To_Wide_String(Fixed_Total'Image(Invoice.Total_ht))); Draw_Text(Ticket, 2, 1, White, "Total TVA : " & Handling.To_Wide_String(Fixed_Total'Image(Invoice.Total_Tva))); Draw_Text(Ticket, 3, 1, White, "Total TTC : " & Handling.To_Wide_String(Fixed_Total'Image(Invoice.Total_TTC))); end if; Draw_Window(Voice); Draw_Window(Balance); Draw_Text(Balance, 1, 1, White, " Capital : " & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.Capital)) & ", Material :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.Material)) & ", TVA In :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.TVA_In)) & ", TVA Out :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.TVA_Out)) & "" ); Draw_Window(Cmd_Win); Draw_Text(Voice, 1, 1, White, "N , Name , Unit HT , Quantity , Total HT , TVA % , Total TVA , Total Price TTC"); Draw_Text(Voice, 2, 1, Blue, Handling.To_Wide_String(((App.Columns/2-2) * '-'))); Ticket_Wins_Draw(App.Ticket_Wins); if Deal_Name = Deal_Out then Voice_Print(Outvoice, App.Ticket_Wins, Account_Line_Index, App.Lines-34); Draw_Text(Box_Dealout , Line_Curs.values(Line_Curs.Val_Cur).Line_Pos, Line_Curs.values(Line_Curs.Val_Cur).Column_Pos, White, Line_Curs.values(Line_Curs.Val_Cur).Line(1..Line_Curs.values(Line_Curs.Val_Cur).Line_Last)); else Voice_Print(Invoice, App.Ticket_Wins, Account_Line_Index, App.Lines-34); Draw_Text(Box_Dealin, Line_Curs.values(Line_Curs.Val_Cur).Line_Pos, Line_Curs.values(Line_Curs.Val_Cur).Column_Pos, White, Line_Curs.values(Line_Curs.Val_Cur).Line(1..Line_Curs.values(Line_Curs.Val_Cur).Line_Last)); end if; end Wake_Up; exit; or accept Refresh do if Deal_Name = Deal_Out then Draw_Window(Box_Dealout); Draw_Text(Box_Dealout, 1, App.Columns/4-10, White, "Moneybox DealOut"); Draw_Text(Box_Dealout, 3, 1, White, "Name : "); Draw_Text(Box_Dealout, 5, 1, White, "Price HT : "); Draw_Text(Box_Dealout, 7, 1, White, "Quantity : "); Draw_Text(Box_Dealout, 9, 1, White, "TVA rate : "); Draw_Text(Box_Dealout, 11, 1, White, "Total HT : "); Draw_Text(Box_Dealout, 13, 1, White, "Total TVA : "); Draw_Text(Box_Dealout, 15, 1, White, "Total TTC : "); Draw_Window(Ticket); Draw_Text(Ticket, 1, 1, White, "Total HT : " & Handling.To_Wide_String(Fixed_Total'Image(Outvoice.Total_ht))); Draw_Text(Ticket, 2, 1, White, "Total TVA : " & Handling.To_Wide_String(Fixed_Total'Image(Outvoice.Total_Tva))); Draw_Text(Ticket, 3, 1, White, "Total TTC : " & Handling.To_Wide_String(Fixed_Total'Image(Outvoice.Total_TTC))); else Draw_Window(Box_Dealin); Draw_Text(Box_Dealin, 1, App.Columns/4-10, White, "Moneybox DealIn"); Draw_Text(Box_Dealin, 3, 1, White, "Name : "); Draw_Text(Box_Dealin, 5, 1, White, "Price HT : "); Draw_Text(Box_Dealin, 7, 1, White, "Quantity : "); Draw_Text(Box_Dealin, 9, 1, White, "TVA rate : "); Draw_Text(Box_Dealout, 11, 1, White, "Total HT : "); Draw_Text(Box_Dealout, 13, 1, White, "Total TVA : "); Draw_Text(Box_Dealout, 15, 1, White, "Total TTC : "); Draw_Window(Ticket); Draw_Text(Ticket, 1, 1, White, "Total HT : " & Handling.To_Wide_String(Fixed_Total'Image(Invoice.Total_ht))); Draw_Text(Ticket, 2, 1, White, "Total TVA : " & Handling.To_Wide_String(Fixed_Total'Image(Invoice.Total_Tva))); Draw_Text(Ticket, 3, 1, White, "Total TTC : " & Handling.To_Wide_String(Fixed_Total'Image(Invoice.Total_TTC))); end if; Draw_Window(Voice); Draw_Window(Balance); Draw_Text(Balance, 1, 1, White, " Capital : " & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.Capital)) & ", Material :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.Material)) & ", TVA In :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.TVA_In)) & ", TVA Out :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.TVA_Out)) & "" ); Draw_Window(Cmd_Win); Draw_Text(Voice, 1, 1, White, "N , Name , Unit HT , Quantity , Total HT , TVA % , Total TVA , Total Price TTC"); Draw_Text(Voice, 2, 1, Blue, Handling.To_Wide_String(((App.Columns/2-2) * '-'))); Ticket_Wins_Draw(App.Ticket_Wins); if Deal_Name = Deal_Out then Voice_Print(Outvoice, App.Ticket_Wins, Account_Line_Index, App.Lines-34); Draw_Text(Box_Dealout , Line_Curs.values(Line_Curs.Val_Cur).Line_Pos, Line_Curs.values(Line_Curs.Val_Cur).Column_Pos, White, Line_Curs.values(Line_Curs.Val_Cur).Line(1..Line_Curs.values(Line_Curs.Val_Cur).Line_Last)); else Voice_Print(Invoice, App.Ticket_Wins, Account_Line_Index, App.Lines-34); Draw_Text(Box_Dealin, Line_Curs.values(Line_Curs.Val_Cur).Line_Pos, Line_Curs.values(Line_Curs.Val_Cur).Column_Pos, White, Line_Curs.values(Line_Curs.Val_Cur).Line(1..Line_Curs.values(Line_Curs.Val_Cur).Line_Last)); end if; end Refresh; end select; end loop; loop select accept Halt; exit Main_Loop; or accept Suspend do null; end Suspend; exit; or accept Wake_Up(Top : in Natural) do Moneybox_Process.Top := Top; Initialize(Box_Dealin, 1, Top+1, 17, App.Columns/2, Red, White); Initialize(Box_Dealout, 1, Top+1, 17, App.Columns/2, Green, White); Initialize(Voice, 18, Top+1, App.Lines-28, App.Columns/2, Blue, White); Initialize(Ticket, App.Lines-10, Top+1, 5, App.Columns/2, white, Blue); Initialize(Balance, App.Lines-5, Top+1, 3, App.Columns/2, Yellow, Blue); Initialize(Cmd_Win, App.Lines-2, Top+1, 3, App.Columns/2, White, Red); Initialize(App.Ticket_Wins, App.Lines-30, Top+App.Columns/2-2, 19, 2, Top); ----------------------------------------------- --Errno := System("clear" & Character'Val(0)); ----------------------------------------------- if Deal_Name = Deal_Out then Draw_Window(Box_Dealout); Draw_Text(Box_Dealout, 1, App.Columns/4-10, White, "Moneybox DealOut"); Draw_Text(Box_Dealout, 3, 1, White, "Name : "); Draw_Text(Box_Dealout, 5, 1, White, "Price HT : "); Draw_Text(Box_Dealout, 7, 1, White, "Quantity : "); Draw_Text(Box_Dealout, 9, 1, White, "TVA rate : "); Draw_Text(Box_Dealout, 11, 1, White, "Total HT : "); Draw_Text(Box_Dealout, 13, 1, White, "Total TVA : "); Draw_Text(Box_Dealout, 15, 1, White, "Total TTC : "); Draw_Window(Ticket); Draw_Text(Ticket, 1, 1, White, "Total HT : " & Handling.To_Wide_String(Fixed_Total'Image(Outvoice.Total_ht))); Draw_Text(Ticket, 2, 1, White, "Total TVA : " & Handling.To_Wide_String(Fixed_Total'Image(Outvoice.Total_Tva))); Draw_Text(Ticket, 3, 1, White, "Total TTC : " & Handling.To_Wide_String(Fixed_Total'Image(Outvoice.Total_TTC))); else Draw_Window(Box_Dealin); Draw_Text(Box_Dealin, 1, App.Columns/4-10, White, "Moneybox DealIn"); Draw_Text(Box_Dealin, 3, 1, White, "Name : "); Draw_Text(Box_Dealin, 5, 1, White, "Price HT : "); Draw_Text(Box_Dealin, 7, 1, White, "Quantity : "); Draw_Text(Box_Dealin, 9, 1, White, "TVA rate : "); Draw_Text(Box_Dealout, 11, 1, White, "Total HT : "); Draw_Text(Box_Dealout, 13, 1, White, "Total TVA : "); Draw_Text(Box_Dealout, 15, 1, White, "Total TTC : "); Draw_Window(Ticket); Draw_Text(Ticket, 1, 1, White, "Total HT : " & Handling.To_Wide_String(Fixed_Total'Image(Invoice.Total_ht))); Draw_Text(Ticket, 2, 1, White, "Total TVA : " & Handling.To_Wide_String(Fixed_Total'Image(Invoice.Total_Tva))); Draw_Text(Ticket, 3, 1, White, "Total TTC : " & Handling.To_Wide_String(Fixed_Total'Image(Invoice.Total_TTC))); end if; Draw_Window(Voice); Draw_Window(Balance); Draw_Text(Balance, 1, 1, White, " Capital : " & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.Capital)) & ", Material :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.Material)) & ", TVA In :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.TVA_In)) & ", TVA Out :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.TVA_Out)) & "" ); Draw_Window(Cmd_Win); Draw_Text(Voice, 1, 1, White, "N , Name , Unit HT , Quantity , Total HT , TVA % , Total TVA , Total Price TTC"); Draw_Text(Voice, 2, 1, Blue, Handling.To_Wide_String(((App.Columns/2-2) * '-'))); Ticket_Wins_Draw(App.Ticket_Wins); if Deal_Name = Deal_Out then Voice_Print(Outvoice, App.Ticket_Wins, Account_Line_Index, App.Lines-34); Draw_Text(Box_Dealout , Line_Curs.values(Line_Curs.Val_Cur).Line_Pos, Line_Curs.values(Line_Curs.Val_Cur).Column_Pos, White, Line_Curs.values(Line_Curs.Val_Cur).Line(1..Line_Curs.values(Line_Curs.Val_Cur).Line_Last)); else Voice_Print(Invoice, App.Ticket_Wins, Account_Line_Index, App.Lines-34); Draw_Text(Box_Dealin, Line_Curs.values(Line_Curs.Val_Cur).Line_Pos, Line_Curs.values(Line_Curs.Val_Cur).Column_Pos, White, Line_Curs.values(Line_Curs.Val_Cur).Line(1..Line_Curs.values(Line_Curs.Val_Cur).Line_Last)); end if; end Wake_Up; or when Remove_Case => accept Receive(Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(1) => Line_Curs := Initialize; Invoice := Null_Invoice; Outvoice := Null_Outvoice; when Wide_Character'Val(9) => if (Text = null) or else Text'Length = 0 then if Deal_Name = Deal_Out then Deal_Name := Deal_In; else Deal_Name := Deal_out; end if; end if; when Wide_Character'Val(10) => if Line_Num_Last > 0 then begin Line_Num := Account_Line_Range'Value ( Handling.To_String(Removed_Line_Num(1..Line_Num_Last)) ); exception when Constraint_Error => null; end; end if; if Line_Num /= 0 then if Deal_Name = Deal_Out then Line_Remove(Abstracted_Voice(Outvoice), Line_Num); else Line_Remove(Abstracted_Voice(Invoice), Line_Num); end if; end if; Line_Num := 0; Removed_Line_Num := (others => Wide_Character'Val(32)); Line_Num_Last := 0; Remove_Case := False; when Wide_Character'Val(127) => if Line_Num_Last > 0 then Removed_Line_Num(Line_Num_Last) := ' '; Line_Num_Last := Line_Num_Last - 1; end if; when others => null; end case; if Deal_Name = Deal_Out then Draw_Window(Box_Dealout); Draw_Text(Box_Dealout, 1, App.Columns/4-10, White, "Moneybox DealOut"); Draw_Text(Box_Dealout, 3, 1, White, "Name : "); Draw_Text(Box_Dealout, 5, 1, White, "Price HT : "); Draw_Text(Box_Dealout, 7, 1, White, "Quantity : "); Draw_Text(Box_Dealout, 9, 1, White, "TVA rate : "); Draw_Text(Box_Dealout, 11, 1, White, "Total HT : "); Draw_Text(Box_Dealout, 13, 1, White, "Total TVA : "); Draw_Text(Box_Dealout, 15, 1, White, "Total TTC : "); Draw_Window(Ticket); Draw_Text(Ticket, 1, 1, White, "Total HT : " & Handling.To_Wide_String(Fixed_Total'Image(Outvoice.Total_ht))); Draw_Text(Ticket, 2, 1, White, "Total TVA : " & Handling.To_Wide_String(Fixed_Total'Image(Outvoice.Total_Tva))); Draw_Text(Ticket, 3, 1, White, "Total TTC : " & Handling.To_Wide_String(Fixed_Total'Image(Outvoice.Total_TTC))); else Draw_Window(Box_Dealin); Draw_Text(Box_Dealin, 1, App.Columns/4-10, White, "Moneybox DealIn"); Draw_Text(Box_Dealin, 3, 1, White, "Name : "); Draw_Text(Box_Dealin, 5, 1, White, "Price HT : "); Draw_Text(Box_Dealin, 7, 1, White, "Quantity : "); Draw_Text(Box_Dealin, 9, 1, White, "TVA rate : "); Draw_Text(Box_Dealout, 11, 1, White, "Total HT : "); Draw_Text(Box_Dealout, 13, 1, White, "Total TVA : "); Draw_Text(Box_Dealout, 15, 1, White, "Total TTC : "); Draw_Window(Ticket); Draw_Text(Ticket, 1, 1, White, "Total HT : " & Handling.To_Wide_String(Fixed_Total'Image(Invoice.Total_ht))); Draw_Text(Ticket, 2, 1, White, "Total TVA : " & Handling.To_Wide_String(Fixed_Total'Image(Invoice.Total_Tva))); Draw_Text(Ticket, 3, 1, White, "Total TTC : " & Handling.To_Wide_String(Fixed_Total'Image(Invoice.Total_TTC))); end if; Draw_Window(Voice); Draw_Window(Balance); Draw_Window(Cmd_Win); Draw_Text(Balance, 1, 1, White, " Capital : " & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.Capital)) & ", Material :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.Material)) & ", TVA In :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.TVA_In)) & ", TVA Out :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.TVA_Out)) & "" ); --Draw_Window(Cmd_Win); Draw_Text(Voice, 1, 1, White, "N , Name , Unit HT , Quantity , Total HT , TVA % , Total TVA , Total Price TTC"); Draw_Text(Voice, 2, 1, Blue, Handling.To_Wide_String(((App.Columns/2-2) * '-'))); Ticket_Wins_Draw(App.Ticket_Wins); if Deal_Name = Deal_Out then for Val in Name_Value..Total_Ttc_Value loop Draw_Text(Box_Dealout , Line_Curs.values(Val).Line_Pos, Line_Curs.values(Val).Column_Pos, White, Line_Curs.values(Val).Line(1..Line_Curs.values(Val).Line_Last)); end loop; Voice_Print(Outvoice, App.Ticket_Wins, Account_Line_Index, App.Lines-34); Draw_Text(Box_Dealout, Line_Curs.Values(Line_Curs.Val_Cur).Line_Pos, Line_Curs.Values(Line_Curs.Val_Cur).Column_Pos, White, Line_Curs.Values(Line_Curs.Val_Cur).Line(1..Line_Curs.Values(Line_Curs.Val_Cur).Line_Last)); else for Val in Name_Value..Total_Ttc_Value loop Draw_Text(Box_Dealin , Line_Curs.values(Val).Line_Pos, Line_Curs.values(Val).Column_Pos, White, Line_Curs.values(Val).Line(1..Line_Curs.values(Val).Line_Last)); end loop; Voice_Print(Invoice, App.Ticket_Wins, Account_Line_Index, App.Lines-34); Draw_Text(Box_Dealin, Line_Curs.Values(Line_Curs.Val_Cur).Line_Pos, Line_Curs.Values(Line_Curs.Val_Cur).Column_Pos, White, Line_Curs.Values(Line_Curs.Val_Cur).Line(1..Line_Curs.Values(Line_Curs.Val_Cur).Line_Last)); end if; elsif Is_digit(Wchar) and then Line_Num_Last < Removed_Line_Num'Length then Removed_Line_Num(Line_Num_Last + 1) := Wchar; Line_Num_Last := Line_Num_Last + 1; Draw_Window(Cmd_Win); Draw_Text(Cmd_Win, 1, 1, White, "Line num : " & Removed_Line_Num(1..Line_Num_Last)); else Put(Character'Val(7)); end if; end Receive; or when not Remove_Case and App.Initialized => accept Receive(Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(1) => Line_Curs := Initialize; Invoice := Null_Invoice; Outvoice := Null_Outvoice; when Wide_Character'Val(9) => if (Text = null) or else Text'Length = 0 then if Deal_Name = Deal_Out then Deal_Name := Deal_In; else Deal_Name := Deal_out; end if; end if; when Wide_Character'Val(10) => if Line_Curs.Values(Line_Curs.Val_Cur).Line_Last /= 0 then case Line_Curs.Val_Cur is when None_Value => null; when TVA_Rate_Value => if Deal_Name = Deal_Out then begin Line_Add(Abstracted_Voice(Outvoice), To_Account_Line(Line_Curs, 707, Outvoice.Line_count + 1)); Outvoice.Line_Count := Outvoice.Line_Count + 1; if Outvoice.Line_Last >= (App.Lines-34) then Account_Line_Index := Account_Line_Index + 1; end if; exception when Spec_Error => Put(Ansi_Tty_Control.Clear_Screen); --Errno := System("clear" & Character'Val(0)); Put_Line("Outvoice error"); declare Char : Character; begin Text_Io.Put_Line("Press any key to continue"); Get_Immediate(Char); end; end; else begin Line_Add(Abstracted_Voice(Invoice), To_Account_Line(Line_Curs, 607, Invoice.Line_Count + 1)); Invoice.Line_Count := Invoice.Line_Count + 1; if Invoice.Line_Last >= (App.Lines-34) then Account_Line_Index := Account_Line_Index + 1; end if; exception when Spec_Error => Put(Ansi_Tty_Control.Clear_Screen); --Errno := System("clear" & Character'Val(0)); Put_Line("Invoice error"); declare Char : Character; begin Text_Io.Put_Line("Press any key to continue"); Get_Immediate(Char); end; end; end if; Line_Curs := Initialize; when others => Line_Curs.Val_Cur := Value_Enum'Succ(Line_Curs.Val_Cur); end case; Validated := True; else Put(Character'Val(7)); end if; when Wide_Character ' Val (127) => if Line_Curs.Values(Line_Curs.Val_Cur).Line_Last > 0 then Line_Curs.Values(Line_Curs.Val_Cur).Line(Line_Curs.Values(Line_Curs.Val_Cur).Line_Last) := ' '; Line_Curs.Values(Line_Curs.Val_Cur).Line_Last := Line_Curs.Values(Line_Curs.Val_Cur).Line_Last - 1; end if; when Wide_Character'Val(18) => Remove_Case := True; when Wide_Character'Val(20) => -- Ctrl+T : charge and billed. if Deal_Name = Deal_Out then Charge(M.Balance.Balance, Outvoice, Payed); if Payed then Outvoice.Date := Clock; Outvoice.Account_Num := Outvoice.Accounting(1).Account_Num; Outvoice.voice_Num := M.Balance.Outvoice_Num + 1; M.Balance.Outvoice_Num := M.Balance.Outvoice_Num + 1; if Save(Outvoice, "charged.txt") then Add(Accounts, Outvoice); for Iter in 1..Outvoice.Line_Last loop declare Line : constant Account_Line_Type := Outvoice.Accounting(Iter); begin if not Sky.Stocks_Manager.In_Stocks(Sky.Stocks_Manager.Hardware, Line.Description) then raise Spec_Error; else declare Stock : constant Stock_Record := (0, Line.Description, Line.Quantity, Line.Unit_Ht_Price, Line.TVA_Rate); begin Sky.Stocks_Manager.Remove_From_stock(Sky.Stocks_Manager.Hardware, Stock.Name, Stock.Quantity); end; end if; end; end loop; Outvoice := Null_Outvoice; end if; end if; else billed(M.Balance.Balance, invoice, Payed); if Payed then Invoice.Date := Clock; Invoice.Account_Num := Invoice.Accounting(1).Account_Num; Invoice.voice_Num := M.Balance.Invoice_Num + 1; M.Balance.Invoice_Num := M.Balance.Invoice_Num + 1; if Save(Invoice, "billed.txt") then Add(Accounts, Invoice); for Iter in 1..Invoice.Line_Last loop declare Line : constant Account_Line_Type := Invoice.Accounting(Iter); begin if not Sky.Stocks_Manager.In_Stocks(Sky.Stocks_Manager.Hardware, Line.Description) then declare Stock : constant Stock_Record := (Sky.Stocks_Manager.Hard_Num + 1, Line.Description, Line.Quantity, Line.Unit_Ht_Price, Line.TVA_Rate); begin Sky.Stocks_Manager.Hard_Num := Sky.Stocks_Manager.Hard_Num + 1; Sky.Stocks_Manager.Stock_Add(Sky.Stocks_Manager.Hardware, Stock); end; else declare Stock : constant Stock_Record := (0, Line.Description, (Line.Quantity), Line.Unit_Ht_Price, Line.TVA_Rate); begin Sky.Stocks_Manager.Update_Stock(Sky.Stocks_Manager.Hardware, Stock); end; end if; end; end loop; Invoice := Null_Invoice; end if; end if; if App.Desktop(2).Name = Activity then Activity_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); elsif App.Desktop(2).Name = Stocks then Stocks_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); end if; end if; when others => null; end case; if Deal_Name = Deal_Out then Draw_Window(Box_Dealout); Draw_Text(Box_Dealout, 1, App.Columns/4-10, White, "Moneybox DealOut"); Draw_Text(Box_Dealout, 3, 1, White, "Name : "); Draw_Text(Box_Dealout, 5, 1, White, "Price HT : "); Draw_Text(Box_Dealout, 7, 1, White, "Quantity : "); Draw_Text(Box_Dealout, 9, 1, White, "TVA rate : "); Draw_Text(Box_Dealout, 11, 1, White, "Total HT : "); Draw_Text(Box_Dealout, 13, 1, White, "Total TVA : "); Draw_Text(Box_Dealout, 15, 1, White, "Total TTC : "); Draw_Window(Ticket); Draw_Text(Ticket, 1, 1, White, "Total HT : " & Handling.To_Wide_String(Fixed_Total'Image(Outvoice.Total_ht))); Draw_Text(Ticket, 2, 1, White, "Total TVA : " & Handling.To_Wide_String(Fixed_Total'Image(Outvoice.Total_Tva))); Draw_Text(Ticket, 3, 1, White, "Total TTC : " & Handling.To_Wide_String(Fixed_Total'Image(Outvoice.Total_TTC))); else Draw_Window(Box_Dealin); Draw_Text(Box_Dealin, 1, App.Columns/4-10, White, "Moneybox DealIn"); Draw_Text(Box_Dealin, 3, 1, White, "Name : "); Draw_Text(Box_Dealin, 5, 1, White, "Price HT : "); Draw_Text(Box_Dealin, 7, 1, White, "Quantity : "); Draw_Text(Box_Dealin, 9, 1, White, "TVA rate : "); Draw_Text(Box_Dealout, 11, 1, White, "Total HT : "); Draw_Text(Box_Dealout, 13, 1, White, "Total TVA : "); Draw_Text(Box_Dealout, 15, 1, White, "Total TTC : "); Draw_Window(Ticket); Draw_Text(Ticket, 1, 1, White, "Total HT : " & Handling.To_Wide_String(Fixed_Total'Image(Invoice.Total_ht))); Draw_Text(Ticket, 2, 1, White, "Total TVA : " & Handling.To_Wide_String(Fixed_Total'Image(Invoice.Total_Tva))); Draw_Text(Ticket, 3, 1, White, "Total TTC : " & Handling.To_Wide_String(Fixed_Total'Image(Invoice.Total_TTC))); end if; Draw_Window(Voice); Draw_Window(Balance); Draw_Text(Balance, 1, 1, White, " Capital : " & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.Capital)) & ", Material :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.Material)) & ", TVA In :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.TVA_In)) & ", TVA Out :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.TVA_Out)) & "" ); --Draw_Window(Cmd_Win); Draw_Text(Voice, 1, 1, White, "N , Name , Unit HT , Quantity , Total HT , TVA % , Total TVA , Total Price TTC"); Draw_Text(Voice, 2, 1, Blue, Handling.To_Wide_String(((App.Columns/2-2) * '-'))); Ticket_Wins_Draw(App.Ticket_Wins); if Deal_Name = Deal_Out then for Val in Name_Value..Total_Ttc_Value loop Draw_Text(Box_Dealout , Line_Curs.values(Val).Line_Pos, Line_Curs.values(Val).Column_Pos, White, Line_Curs.values(Val).Line(1..Line_Curs.values(Val).Line_Last)); end loop; Voice_Print(Outvoice, App.Ticket_Wins, Account_Line_Index, App.Lines-34); Draw_Text(Box_Dealout, Line_Curs.Values(Line_Curs.Val_Cur).Line_Pos, Line_Curs.Values(Line_Curs.Val_Cur).Column_Pos, White, Line_Curs.Values(Line_Curs.Val_Cur).Line(1..Line_Curs.Values(Line_Curs.Val_Cur).Line_Last)); else for Val in Name_Value..Total_Ttc_Value loop Draw_Text(Box_Dealin , Line_Curs.values(Val).Line_Pos, Line_Curs.values(Val).Column_Pos, White, Line_Curs.values(Val).Line(1..Line_Curs.values(Val).Line_Last)); end loop; Voice_Print(Invoice, App.Ticket_Wins, Account_Line_Index, App.Lines-34); Draw_Text(Box_Dealin, Line_Curs.Values(Line_Curs.Val_Cur).Line_Pos, Line_Curs.Values(Line_Curs.Val_Cur).Column_Pos, White, Line_Curs.Values(Line_Curs.Val_Cur).Line(1..Line_Curs.Values(Line_Curs.Val_Cur).Line_Last)); end if; if Remove_Case then Draw_Window(Cmd_Win); Draw_Text(Cmd_Win, 1, 1, White, "Line num : "); end if; elsif Line_Curs.Values(Line_Curs.Val_Cur).Line_Last < 32 then Line_Curs.Values(Line_Curs.Val_Cur).Line(Line_Curs.Values(Line_Curs.Val_Cur).Line_Last + 1) := Wchar; Line_Curs.Values(Line_Curs.Val_Cur).Line_Last := Line_Curs.Values(Line_Curs.Val_Cur).Line_Last + 1; if Deal_Name = Deal_Out then for Val in Name_Value..Total_Ttc_Value loop Draw_Text(Box_Dealout , Line_Curs.values(Val).Line_Pos, Line_Curs.values(Val).Column_Pos, White, Line_Curs.values(Val).Line(1..Line_Curs.values(Val).Line_Last)); end loop; Draw_Text(Box_Dealout, Line_Curs.Values(Line_Curs.Val_Cur).Line_Pos, Line_Curs.Values(Line_Curs.Val_Cur).Column_Pos, White, Line_Curs.Values(Line_Curs.Val_Cur).Line(1..Line_Curs.Values(Line_Curs.Val_Cur).Line_Last)); else for Val in Name_Value..Total_Ttc_Value loop Draw_Text(Box_Dealin , Line_Curs.values(Val).Line_Pos, Line_Curs.values(Val).Column_Pos, White, Line_Curs.values(Val).Line(1..Line_Curs.values(Val).Line_Last)); end loop; Draw_Text(Box_Dealin, Line_Curs.Values(Line_Curs.Val_Cur).Line_Pos, Line_Curs.Values(Line_Curs.Val_Cur).Column_Pos, White, Line_Curs.Values(Line_Curs.Val_Cur).Line(1..Line_Curs.Values(Line_Curs.Val_Cur).Line_Last)); end if; else Put(Character'Val(7)); end if; end Receive; or when (not Remove_Case) and (not App.Initialized) => accept Receive(Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(1) => Line_Curs := Initialize; Invoice := Null_Invoice; Outvoice := Null_Outvoice; when Wide_Character'Val(9) => if (Text = null) or else Text'Length = 0 then if Deal_Name = Deal_Out then Deal_Name := Deal_In; else Deal_Name := Deal_out; end if; end if; when Wide_Character'Val(10) => if Line_Curs.Values(Line_Curs.Val_Cur).Line_Last /= 0 then case Line_Curs.Val_Cur is when None_Value => null; when TVA_Rate_Value => if Deal_Name = Deal_Out then begin Line_Add(Abstracted_Voice(Outvoice), To_Account_Line(Line_Curs, 10, Outvoice.Line_Count + 1)); Outvoice.Line_Count := Outvoice.Line_Count + 1; if Outvoice.Line_Last >= (App.Lines-34) then Account_Line_Index := Account_Line_Index + 1; end if; exception when Spec_Error => Put(Ansi_Tty_Control.Clear_Screen); --Errno := System("clear" & Character'Val(0)); Put_Line("Outvoice error"); declare Char : Character; begin Text_Io.Put_Line("Press any key to continue"); Get_Immediate(Char); end; end; else begin Line_Add(Abstracted_Voice(Invoice), To_Account_Line(Line_Curs, 607, Invoice.Line_Count + 1)); Invoice.Line_Count := Invoice.Line_Count + 1; if Invoice.Line_Last >= (App.Lines-34) then Account_Line_Index := Account_Line_Index + 1; end if; exception when Spec_Error => Put(Ansi_Tty_Control.Clear_Screen); --Errno := System("clear" & Character'Val(0)); Put_Line("Invoice error"); declare Char : Character; begin Text_Io.Put_Line("Press any key to continue"); Get_Immediate(Char); end; end; end if; Line_Curs := Initialize; when others => Line_Curs.Val_Cur := Value_Enum'Succ(Line_Curs.Val_Cur); end case; Validated := True; else Put(Character'Val(7)); end if; when Wide_Character ' Val (127) => if Line_Curs.Values(Line_Curs.Val_Cur).Line_Last > 0 then Line_Curs.Values(Line_Curs.Val_Cur).Line(Line_Curs.Values(Line_Curs.Val_Cur).Line_Last) := ' '; Line_Curs.Values(Line_Curs.Val_Cur).Line_Last := Line_Curs.Values(Line_Curs.Val_Cur).Line_Last - 1; end if; when Wide_Character'Val(18) => Remove_Case := True; when Wide_Character'Val(20) => -- Ctrl+T : charge and billed. if Deal_Name = Deal_Out then if Outvoice.Line_Last > 0 then Open(M.Balance.Balance, Accountant.Accounts); Charge(M.Balance.Balance, Outvoice, Payed); if Payed then Outvoice.Date := Clock; Outvoice.Account_Num := Outvoice.Accounting(1).Account_Num; Outvoice.voice_Num := M.Balance.Outvoice_Num + 1; M.Balance.Outvoice_Num := M.Balance.Outvoice_Num + 1; if Save(Outvoice, "charged.txt") then Add(Accounts, Outvoice); for Iter in 1..Outvoice.Line_Last loop declare Line : constant Account_Line_Type := Outvoice.Accounting(Iter); begin if not Sky.Stocks_Manager.In_Stocks(Sky.Stocks_Manager.Software, Line.Description) then declare Stock : constant Stock_Record := (Sky.Stocks_Manager.soft_Num + 1, Line.Description, Line.Quantity, Line.Unit_Ht_Price, Line.TVA_Rate); begin Sky.Stocks_Manager.Soft_Num := Sky.Stocks_Manager.Soft_Num + 1; Sky.Stocks_Manager.Stock_Add(Sky.Stocks_Manager.Software, Stock); end; else declare Stock : constant Stock_Record := (0, Line.Description, Line.Quantity, Line.Unit_Ht_Price, Line.TVA_Rate); begin Sky.Stocks_Manager.Add_To_stock(Sky.Stocks_Manager.Software, Stock.Name, Stock.Quantity); end; end if; end; end loop; Outvoice := Null_Outvoice; end if; close(M.Balance.Balance, Accountant.Accounts); end if; Open(M.Balance.Balance, Accountant.Accounts); Outvoice := Null_Outvoice; App.Initialized := True; end if; else billed(M.Balance.Balance, invoice, Payed); if Payed then Invoice.Date := Clock; Invoice.Account_Num := Invoice.Accounting(1).Account_Num; Invoice.voice_Num := M.Balance.Invoice_Num + 1; M.Balance.Invoice_Num := M.Balance.Invoice_Num + 1; if Save(Invoice, "billed.txt") then Add(Accounts, Invoice); invoice := Null_invoice; end if; end if; invoice := Null_invoice; end if; if App.Desktop(2).Name = Activity then Activity_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); elsif App.Desktop(2).Name = Stocks then Stocks_Record(App.Desktop(2).all).Proc.Wake_Up(App.Columns/2); end if; when others => null; end case; if Deal_Name = Deal_Out then Draw_Window(Box_Dealout); Draw_Text(Box_Dealout, 1, App.Columns/4-10, White, "Moneybox DealOut"); Draw_Text(Box_Dealout, 3, 1, White, "Name : "); Draw_Text(Box_Dealout, 5, 1, White, "Price HT : "); Draw_Text(Box_Dealout, 7, 1, White, "Quantity : "); Draw_Text(Box_Dealout, 9, 1, White, "TVA rate : "); Draw_Text(Box_Dealout, 11, 1, White, "Total HT : "); Draw_Text(Box_Dealout, 13, 1, White, "Total TVA : "); Draw_Text(Box_Dealout, 15, 1, White, "Total TTC : "); Draw_Window(Ticket); Draw_Text(Ticket, 1, 1, White, "Total HT : " & Handling.To_Wide_String(Fixed_Total'Image(Outvoice.Total_ht))); Draw_Text(Ticket, 2, 1, White, "Total TVA : " & Handling.To_Wide_String(Fixed_Total'Image(Outvoice.Total_Tva))); Draw_Text(Ticket, 3, 1, White, "Total TTC : " & Handling.To_Wide_String(Fixed_Total'Image(Outvoice.Total_TTC))); else Draw_Window(Box_Dealin); Draw_Text(Box_Dealin, 1, App.Columns/4-10, White, "Moneybox DealIn"); Draw_Text(Box_Dealin, 3, 1, White, "Name : "); Draw_Text(Box_Dealin, 5, 1, White, "Price HT : "); Draw_Text(Box_Dealin, 7, 1, White, "Quantity : "); Draw_Text(Box_Dealin, 9, 1, White, "TVA rate : "); Draw_Text(Box_Dealout, 11, 1, White, "Total HT : "); Draw_Text(Box_Dealout, 13, 1, White, "Total TVA : "); Draw_Text(Box_Dealout, 15, 1, White, "Total TTC : "); Draw_Window(Ticket); Draw_Text(Ticket, 1, 1, White, "Total HT : " & Handling.To_Wide_String(Fixed_Total'Image(Invoice.Total_ht))); Draw_Text(Ticket, 2, 1, White, "Total TVA : " & Handling.To_Wide_String(Fixed_Total'Image(Invoice.Total_Tva))); Draw_Text(Ticket, 3, 1, White, "Total TTC : " & Handling.To_Wide_String(Fixed_Total'Image(Invoice.Total_TTC))); end if; Draw_Window(Voice); Draw_Window(Balance); Draw_Text(Balance, 1, 1, White, " Capital : " & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.Capital)) & ", Material :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.Material)) & ", TVA In :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.TVA_In)) & ", TVA Out :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.TVA_Out)) & "" ); --Draw_Window(Cmd_Win); Draw_Text(Voice, 1, 1, White, "N , Name , Unit HT , Quantity , Total HT , TVA % , Total TVA , Total Price TTC"); Draw_Text(Voice, 2, 1, Blue, Handling.To_Wide_String(((App.Columns/2-2) * '-'))); Ticket_Wins_Draw(App.Ticket_Wins); if Deal_Name = Deal_Out then for Val in Name_Value..Total_Ttc_Value loop Draw_Text(Box_Dealout , Line_Curs.values(Val).Line_Pos, Line_Curs.values(Val).Column_Pos, White, Line_Curs.values(Val).Line(1..Line_Curs.values(Val).Line_Last)); end loop; Voice_Print(Outvoice, App.Ticket_Wins, Account_Line_Index, App.Lines-34); Draw_Text(Box_Dealout, Line_Curs.Values(Line_Curs.Val_Cur).Line_Pos, Line_Curs.Values(Line_Curs.Val_Cur).Column_Pos, White, Line_Curs.Values(Line_Curs.Val_Cur).Line(1..Line_Curs.Values(Line_Curs.Val_Cur).Line_Last)); else for Val in Name_Value..Total_Ttc_Value loop Draw_Text(Box_Dealin , Line_Curs.values(Val).Line_Pos, Line_Curs.values(Val).Column_Pos, White, Line_Curs.values(Val).Line(1..Line_Curs.values(Val).Line_Last)); end loop; Voice_Print(Invoice, App.Ticket_Wins, Account_Line_Index, App.Lines-34); Draw_Text(Box_Dealin, Line_Curs.Values(Line_Curs.Val_Cur).Line_Pos, Line_Curs.Values(Line_Curs.Val_Cur).Column_Pos, White, Line_Curs.Values(Line_Curs.Val_Cur).Line(1..Line_Curs.Values(Line_Curs.Val_Cur).Line_Last)); end if; if Remove_Case then Draw_Window(Cmd_Win); Draw_Text(Cmd_Win, 1, 1, White, "Line num : "); end if; elsif Line_Curs.Values(Line_Curs.Val_Cur).Line_Last < 32 then Line_Curs.Values(Line_Curs.Val_Cur).Line(Line_Curs.Values(Line_Curs.Val_Cur).Line_Last + 1) := Wchar; Line_Curs.Values(Line_Curs.Val_Cur).Line_Last := Line_Curs.Values(Line_Curs.Val_Cur).Line_Last + 1; if Deal_Name = Deal_Out then for Val in Name_Value..Total_Ttc_Value loop Draw_Text(Box_Dealout , Line_Curs.values(Val).Line_Pos, Line_Curs.values(Val).Column_Pos, White, Line_Curs.values(Val).Line(1..Line_Curs.values(Val).Line_Last)); end loop; Draw_Text(Box_Dealout, Line_Curs.Values(Line_Curs.Val_Cur).Line_Pos, Line_Curs.Values(Line_Curs.Val_Cur).Column_Pos, White, Line_Curs.Values(Line_Curs.Val_Cur).Line(1..Line_Curs.Values(Line_Curs.Val_Cur).Line_Last)); else for Val in Name_Value..Total_Ttc_Value loop Draw_Text(Box_Dealin , Line_Curs.values(Val).Line_Pos, Line_Curs.values(Val).Column_Pos, White, Line_Curs.values(Val).Line(1..Line_Curs.values(Val).Line_Last)); end loop; Draw_Text(Box_Dealin, Line_Curs.Values(Line_Curs.Val_Cur).Line_Pos, Line_Curs.Values(Line_Curs.Val_Cur).Column_Pos, White, Line_Curs.Values(Line_Curs.Val_Cur).Line(1..Line_Curs.Values(Line_Curs.Val_Cur).Line_Last)); end if; else Put(Character'Val(7)); end if; end Receive; --if Validated then -- exit;  --end if; or accept Refresh do null; end Refresh; or accept Page_Down do if Deal_Name = Deal_Out then if Outvoice.Line_Last >= (App.Lines-34) then if Account_Line_Index + (App.Lines-34) < Outvoice.Line_Last then Account_Line_Index := Account_Line_Index + (App.Lines-34); else Account_Line_Index := Outvoice.Line_Last - (App.Lines-34); end if; end if; else if Invoice.Line_Last >= (App.Lines-34) then if Account_Line_Index + (App.Lines-34) < Invoice.Line_Last then Account_Line_Index := Account_Line_Index + (App.Lines-34); else Account_Line_Index := Invoice.Line_Last - (App.Lines-34); end if; end if; end if; Ticket_Wins_Draw(App.Ticket_Wins); if Deal_Name = Deal_Out then for Val in Name_Value..Total_Ttc_Value loop Draw_Text(Box_Dealout , Line_Curs.values(Val).Line_Pos, Line_Curs.values(Val).Column_Pos, White, Line_Curs.values(Val).Line(1..Line_Curs.values(Val).Line_Last)); end loop; Voice_Print(Outvoice, App.Ticket_Wins, Account_Line_Index, App.Lines-34); Draw_Text(Box_Dealout, Line_Curs.Values(Line_Curs.Val_Cur).Line_Pos, Line_Curs.Values(Line_Curs.Val_Cur).Column_Pos, White, Line_Curs.Values(Line_Curs.Val_Cur).Line(1..Line_Curs.Values(Line_Curs.Val_Cur).Line_Last)); else for Val in Name_Value..Total_Ttc_Value loop Draw_Text(Box_Dealin , Line_Curs.values(Val).Line_Pos, Line_Curs.values(Val).Column_Pos, White, Line_Curs.values(Val).Line(1..Line_Curs.values(Val).Line_Last)); end loop; Voice_Print(Invoice, App.Ticket_Wins, Account_Line_Index, App.Lines-34); Draw_Text(Box_Dealin, Line_Curs.Values(Line_Curs.Val_Cur).Line_Pos, Line_Curs.Values(Line_Curs.Val_Cur).Column_Pos, White, Line_Curs.Values(Line_Curs.Val_Cur).Line(1..Line_Curs.Values(Line_Curs.Val_Cur).Line_Last)); end if; if Remove_Case then Draw_Window(Cmd_Win); Draw_Text(Cmd_Win, 1, 1, White, "Line num : "); end if; end Page_Down; or accept Page_Up do if Deal_Name = Deal_Out then if Outvoice.Line_Last >= (App.Lines-34) then if Account_Line_Index - (App.Lines-34) >= 0 then Account_Line_Index := Account_Line_Range'Max(Account_Line_Index - (App.Lines-34), 0); else Account_Line_Index := 0; end if; end if; else if Invoice.Line_Last >= (App.Lines-34) then if Account_Line_Index - (App.Lines-34) >= 0 then Account_Line_Index := Account_Line_Range'Max(Account_Line_Index - (App.Lines-34), 0); else Account_Line_Index := 0; end if; end if; end if; Ticket_Wins_Draw(App.Ticket_Wins); if Deal_Name = Deal_Out then for Val in Name_Value..Total_Ttc_Value loop Draw_Text(Box_Dealout , Line_Curs.values(Val).Line_Pos, Line_Curs.values(Val).Column_Pos, White, Line_Curs.values(Val).Line(1..Line_Curs.values(Val).Line_Last)); end loop; Voice_Print(Outvoice, App.Ticket_Wins, Account_Line_Index, App.Lines-34); Draw_Text(Box_Dealout, Line_Curs.Values(Line_Curs.Val_Cur).Line_Pos, Line_Curs.Values(Line_Curs.Val_Cur).Column_Pos, White, Line_Curs.Values(Line_Curs.Val_Cur).Line(1..Line_Curs.Values(Line_Curs.Val_Cur).Line_Last)); else for Val in Name_Value..Total_Ttc_Value loop Draw_Text(Box_Dealin , Line_Curs.values(Val).Line_Pos, Line_Curs.values(Val).Column_Pos, White, Line_Curs.values(Val).Line(1..Line_Curs.values(Val).Line_Last)); end loop; Voice_Print(Invoice, App.Ticket_Wins, Account_Line_Index, App.Lines-34); Draw_Text(Box_Dealin, Line_Curs.Values(Line_Curs.Val_Cur).Line_Pos, Line_Curs.Values(Line_Curs.Val_Cur).Column_Pos, White, Line_Curs.Values(Line_Curs.Val_Cur).Line(1..Line_Curs.Values(Line_Curs.Val_Cur).Line_Last)); end if; if Remove_Case then Draw_Window(Cmd_Win); Draw_Text(Cmd_Win, 1, 1, White, "Line num : "); end if; end Page_Up; or accept Up_Arrow do null; end up_arrow; or accept Down_Arrow do null; end Down_Arrow; or accept Left_Arrow; or accept Right_Arrow; or accept Full_Screen; or accept Del; or accept Begin_Of do Account_Line_Index := 0; Ticket_Wins_Draw(App.Ticket_Wins); if Deal_Name = Deal_Out then for Val in Name_Value..Total_Ttc_Value loop Draw_Text(Box_Dealout , Line_Curs.values(Val).Line_Pos, Line_Curs.values(Val).Column_Pos, White, Line_Curs.values(Val).Line(1..Line_Curs.values(Val).Line_Last)); end loop; Voice_Print(Outvoice, App.Ticket_Wins, Account_Line_Index, App.Lines-34); Draw_Text(Box_Dealout, Line_Curs.Values(Line_Curs.Val_Cur).Line_Pos, Line_Curs.Values(Line_Curs.Val_Cur).Column_Pos, White, Line_Curs.Values(Line_Curs.Val_Cur).Line(1..Line_Curs.Values(Line_Curs.Val_Cur).Line_Last)); else for Val in Name_Value..Total_Ttc_Value loop Draw_Text(Box_Dealin , Line_Curs.values(Val).Line_Pos, Line_Curs.values(Val).Column_Pos, White, Line_Curs.values(Val).Line(1..Line_Curs.values(Val).Line_Last)); end loop; Voice_Print(Invoice, App.Ticket_Wins, Account_Line_Index, App.Lines-34); Draw_Text(Box_Dealin, Line_Curs.Values(Line_Curs.Val_Cur).Line_Pos, Line_Curs.Values(Line_Curs.Val_Cur).Column_Pos, White, Line_Curs.Values(Line_Curs.Val_Cur).Line(1..Line_Curs.Values(Line_Curs.Val_Cur).Line_Last)); end if; if Remove_Case then Draw_Window(Cmd_Win); Draw_Text(Cmd_Win, 1, 1, White, "Line num : "); end if; end Begin_Of; or accept end_Of; or accept Overwrite; or accept Full_Screen; end select; end loop; if Validated then Validated := False; end if; end loop Main_Loop; end; --W_Io.Put_Line("Moneybox process halted"); end MoneyBox_Process; ------------------------------------------------------------------------------------------------------------- -- -- -- Activity -- -- -- ------------------------------------------------------------------------------------------------------------- procedure Initialize(Wins : out Accounting_Windows_Type; Space_Left : in Line_Range; Width : in Column_Range; L : in Line_Range; C : in Column_Range; Top : in Natural := 0); procedure Accounting_Wins_Draw(Wins : Accounting_Windows_Type) is begin Draw_Window(Wins.Voice_Num_Win); Draw_Window(Wins.Acc_Num_Win); Draw_Window(Wins.Total_Ht_Win); Draw_Window(Wins.Total_TVA_Win); Draw_Window(Wins.Total_Ttc_Win); Draw_Window(Wins.Date_Win); Draw_Window(Wins.Peer_Win); end Accounting_Wins_Draw; procedure Accounting_Line_Draw(Wins : Accounting_Windows_Type; Line : in Line_Range; Voice : in Abstracted_Voice) is begin Draw_Text(Wins.Voice_Num_Win, Line, 1, White, Handling.To_Wide_String(Voice_Num_Range'Image(Voice.Voice_Num))); Draw_Text(Wins.Acc_Num_Win, Line, 1, White, Handling.To_Wide_String(Account_Num_Range'Image(Voice.Account_Num))); Draw_Text(Wins.Total_Ht_Win, Line, 1, White, Handling.To_Wide_String(Fixed_Total'Image(Voice.Total_Ht))); Draw_Text(Wins.Total_TVA_Win, Line, 1, White, Handling.To_Wide_String(Fixed_Total'Image(Voice.Total_TVA))); Draw_Text(Wins.Total_Ttc_Win, Line, 1, White, Handling.To_Wide_String(Fixed_Total'Image(Voice.Total_TTC))); Draw_Text(Wins.Date_Win, Line, 1, White, Handling.To_Wide_String(Formatting.Image(Voice.Date))); Draw_Text(Wins.Peer_Win, Line, 1, White, Voice.Peer_Name(1..16)); end Accounting_Line_Draw; subtype Voice_Index_Range is Positive range 1..Positive'Last; type Voice_Access is access all Abstracted_Voice; function Same(Left, Right : in Voice_Access) return Boolean is begin return Left.all = Right.all; end Same; package Voice_Vectors is new Ada.Containers.Vectors (Voice_Index_Range, Voice_Access, Same); function "<"(Left, Right : in Voice_Access) return Boolean is begin return Left.Date < Right.Date; end "<"; package Sorting is new Voice_Vectors.Generic_Sorting("<"); use Voice_Vectors; type State_Type is record Date : Time := Time_Of(1970, 1, 1, 0.0); Deal_In_HT : Fixed_Total := 0.0; Deal_In_Ttc : Fixed_Total := 0.0; Tva_Out : Fixed_Total := 0.0; Deal_Out_HT : Fixed_Total := 0.0; Deal_Out_Ttc : Fixed_Total := 0.0; Tva_in : Fixed_Total := 0.0; Result : Fixed_Total := 0.0; end record; procedure Make_State (Voices : in Voice_Vectors.Vector; From : in Time; To : in Time; State : out State_Type) is begin if not Is_Empty(Voices) then for Iter in 1..Length(Voices) loop declare Voice : constant Voice_Access := Voice_Vectors.Element(Voices, Integer(Iter)); begin case Voice.Account_Num is when 607 => State.Deal_In_Ht := State.Deal_In_Ht + Voice.Total_Ht; State.Deal_In_TTC := State.Deal_In_TTC + Voice.Total_TTC; State.Tva_Out := State.Tva_Out + Voice.Total_Tva; when 707 => State.Deal_Out_Ht := State.Deal_Out_Ht + Voice.Total_Ht; State.Deal_Out_TTC := State.Deal_Out_TTC + Voice.Total_TTC; State.Tva_In := State.Tva_In + Voice.Total_Tva; when 10 => State.Result := State.Result + Voice.Total_Ht; when others => null; end case; exit when Voice.Date > To; end; end loop; State.Result := State.Result - State.Deal_In_Ttc; State.Result := State.Result + State.Deal_Out_Ttc; State.Result := State.Result - State.Tva_In; State.Result := State.Result + State.Tva_Out; end if; end Make_State; procedure Initialize(Wins : out Accounting_Windows_Type; Space_Left : in Line_Range; Width : in Column_Range; L : in Line_Range; C : in Column_Range; Top : in Natural := 0) is begin Wins.Voice_Num_Win := (L+2, C, Space_Left-2, 10, Cyan, The_Window); Wins.Acc_Num_Win := (L+2, C+10, Space_Left-2, 8, Cyan, The_Window); Wins.Total_Ht_Win := (L+2, C+18, Space_Left-2, 16, Cyan, The_Window); Wins.Total_TVA_Win := (L+2, C+34, Space_Left-2, 16, Cyan, The_Window); Wins.Total_TTC_Win := (L+2, C+50, Space_Left-2, 16, Cyan, The_Window); Wins.Date_Win := (L+2, C+66, Space_Left-2, 22, Cyan, The_Window); Wins.Peer_Win := (L+2, C+88, Space_Left-2, Width-(C+88+2), Cyan, The_Window); Initialize(Wins.Voice_Num_Win, L+2, Top+C, Space_Left-2, 10, Cyan, Red); Initialize(Wins.Acc_Num_Win, L+2, Top+C+10, Space_Left-2, 8, Cyan, Red); Initialize(Wins.Total_Ht_Win, L+2, Top+C+18, Space_Left-2, 16, Cyan, Red); Initialize(Wins.Total_TVA_Win, L+2, Top+C+34, Space_Left-2, 16, Cyan, Red); Initialize(Wins.Total_TTC_Win, L+2, Top+C+50, Space_Left-2, 16, Cyan, Red); Initialize(Wins.Date_Win, L+2, Top+C+66, Space_Left-2, 22, Cyan, Red); Initialize(Wins.Peer_Win, L+2, Top+C+88, Space_Left-2, Width-(C+88+2), Cyan, Red); end Initialize; task body Activity_Process is Activity_From : Window_Record := (3, 1, 10, App.Columns/4, Blue, The_Window); Activity_To : Window_Record := (3, (App.Columns/4)+1, 10, App.Columns/4, Blue, The_Window); Activity_Compta : Window_Record := (13, App.Columns/2+1, (App.Lines-20), App.Columns/2, Cyan, The_Window); Activity_Balance : Window_Record := (App.Lines-5, App.Columns/2+1, 3, App.Columns/2, Yellow, The_Window); Activity_Cmd : Window_Record := (App.Lines-2, 1, 3, App.Columns/2, White, The_Window); procedure State_Print(Date : in Time; Line_Max : in Line_Range) is State : Voice_Vectors.Vector; Page : Voice_Vectors.Vector; From : State_Type; To : State_Type; From_Line : Abstracted_Voice(256); To_Line : Abstracted_Voice(256); begin for Invoice in 1..Accounts.Invoice_Last loop Append(State, new Abstracted_Voice ' (abstracted_voice(Accounts.Billed(Invoice)))); end loop; for outvoice in 1..Accounts.Outvoice_Last loop Append(State, new Abstracted_Voice ' (abstracted_voice(Accounts.Charges(outvoice)))); end loop; Sorting.Sort(State); if not Is_Empty(State) then for Iter in 1..Length(State) loop declare Voice : constant Abstracted_Voice := Element(State, Voice_Index_Range(Iter)).all; begin if Voice.Date >= Date then Append(Page, new Abstracted_Voice ' (Voice)); end if; exit when Length(Page) = Count_Type(Line_Max); end; end loop; end if; Make_State(State, Time_Of(1970, 1, 1, 0.0), Date, From); if not Is_Empty(Page) then From_Line := First_Element(Page).all; From.Date := From_Line.date; end if; Draw_Window(Activity_From); Draw_Text(Activity_From, 1, 1, White, "From : " & Handling.To_Wide_String(Formatting.Image(From.Date))); Draw_Text(Activity_From, 2, 1, White, "Deal in HT : " & Handling.To_Wide_String(Fixed_Total'Image(From.Deal_In_Ht))); Draw_Text(Activity_From, 3, 1, White, "Deal in TTC : " & Handling.To_Wide_String(Fixed_Total'Image(From.Deal_In_TTC))); Draw_Text(Activity_From, 4, 1, White, "TVA out : " & Handling.To_Wide_String(Fixed_Total'Image(From.TVA_Out))); Draw_Text(Activity_From, 5, 1, White, "Deal out HT : " & Handling.To_Wide_String(Fixed_Total'Image(From.Deal_Out_Ht))); Draw_Text(Activity_From, 6, 1, White, "Deal out TTC : " & Handling.To_Wide_String(Fixed_Total'Image(From.Deal_Out_Ht))); Draw_Text(Activity_From, 7, 1, White, "TVA in : " & Handling.To_Wide_String(Fixed_Total'Image(From.TVA_In))); Draw_Text(Activity_From, 8, 1, White, "Result : " & Handling.To_Wide_String(Fixed_Total'Image(From.Result))); if not Is_Empty(Page) then Make_State(State, Time_Of(1970, 1, 1, 0.0), Last_Element(Page).Date, To); end if; if not Is_Empty(Page) then To_Line := Last_Element(Page).all; To.Date := To_Line.date; end if; Draw_Window(Activity_To); Draw_Text(Activity_To, 1, 1, White, "To : " & Handling.To_Wide_String(Formatting.Image(To.Date))); Draw_Text(Activity_To, 2, 1, White, "Deal in HT : " & Handling.To_Wide_String(Fixed_Total'Image(To.Deal_In_Ht))); Draw_Text(Activity_To, 3, 1, White, "Deal in TTC : " & Handling.To_Wide_String(Fixed_Total'Image(To.Deal_In_TTC))); Draw_Text(Activity_To, 4, 1, White, "TVA out : " & Handling.To_Wide_String(Fixed_Total'Image(To.TVA_Out))); Draw_Text(Activity_To, 5, 1, White, "Deal out HT : " & Handling.To_Wide_String(Fixed_Total'Image(To.Deal_Out_Ht))); Draw_Text(Activity_To, 6, 1, White, "Deal out TTC : " & Handling.To_Wide_String(Fixed_Total'Image(To.Deal_Out_Ht))); Draw_Text(Activity_To, 7, 1, White, "TVA in : " & Handling.To_Wide_String(Fixed_Total'Image(To.TVA_In))); Draw_Text(Activity_To, 8, 1, White, "Result : " & Handling.To_Wide_String(Fixed_Total'Image(To.Result))); Draw_Window(Activity_Compta); Draw_Text(Activity_Compta, 1, 1, White, "Voice Num, Acc N , Total HT , Total TVA , Total TTC , date , Peer Name"); Accounting_Wins_Draw(App.Activity_Wins); if not Is_Empty(Page) then for Iter in 1..Length(Page) loop declare Voice : constant Abstracted_Voice := Element(Page, Voice_Index_Range(Iter)).all; begin Accounting_Line_Draw(App.Activity_Wins, Line_Range(Iter), Voice); end; end loop; end if; end State_Print; begin Initialize(Activity_From , 3, 1, 10, (App.Columns)/4, Blue, White); Initialize(Activity_To , 3, App.Columns/4+1, 10, App.Columns/4, Blue, White); Initialize(Activity_Compta, 13, 1, (App.Lines-20), App.Columns/2, Cyan, White); Initialize(Activity_Balance ,App.Lines-5, 1, 3, App.Columns/2, Yellow, White); Initialize(Activity_Cmd, App.Lines-2, 1, 3, App.Columns/2, White, White); Initialize(App.Activity_Wins, App.Lines-23, App.Columns/2, 13, 2, 0); declare Date : Time := Clock; Line : Wide_String(1..App.Columns/2-2); Line_Last : Natural := 0; begin Main_Loop: loop loop select accept Halt do null; end Halt; exit Main_Loop; or accept Suspend; or accept Wake_Up(Top : in Natural) do Initialize(Activity_From , 3, Top+1, 10, (App.Columns)/4, Blue, White); Initialize(Activity_To , 3, Top+App.Columns/4+1, 10, App.Columns/4, Blue, White); Initialize(Activity_Compta, 13, Top+1, (App.Lines-20), App.Columns/2, Cyan, White); Initialize(Activity_Balance ,App.Lines-5, Top+1, 3, App.Columns/2, Yellow, White); Initialize(Activity_Cmd, App.Lines-2, Top+1, 3, App.Columns/2, White, White); Initialize(App.Activity_Wins, App.Lines-23, App.Columns/2, 13, 2, Top); ---------------------------------------------- --Errno := System("clear" & Character'Val(0)); ---------------------------------------------- State_Print(Date-86400.0, App.Lines-25); Draw_Window(Activity_Balance); Draw_Text(Activity_Balance, 1, 1, White, " Capital : " & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.Capital)) & ", Material :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.Material)) & ", TVA In :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.TVA_In)) & ", TVA Out :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.TVA_Out)) & "" ); Draw_Window(Activity_Cmd); if Line_Last > 0 then Draw_text(Activity_Cmd, 1, 1, White, "Date : " & Line(Line'First..Line_Last)); else Draw_text(Activity_Cmd, 1, 1, White, "Date : "); end if; end Wake_Up; exit; end select; end loop; loop select accept Halt; exit Main_Loop; or accept Suspend; exit; or accept Wake_Up(Top : in Natural) do Initialize(Activity_From , 3, Top+1, 10, (App.Columns)/4, Blue, White); Initialize(Activity_To , 3, Top+App.Columns/4+1, 10, App.Columns/4, Blue, White); Initialize(Activity_Compta, 13, Top+1, (App.Lines-20), App.Columns/2, Cyan, White); Initialize(Activity_Balance ,App.Lines-5, Top+1, 3, App.Columns/2, Yellow, White); Initialize(Activity_Cmd, App.Lines-2, Top+1, 3, App.Columns/2, White, White); Initialize(App.Activity_Wins, App.Lines-23, App.Columns/2, 13, 2, Top); ---------------------------------------------- --Errno := System("clear" & Character'Val(0)); ---------------------------------------------- State_Print(Date-86400.0, App.Lines-25); Draw_Window(Activity_Balance); Draw_Text(Activity_Balance, 1, 1, White, " Capital : " & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.Capital)) & ", Material :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.Material)) & ", TVA In :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.TVA_In)) & ", TVA Out :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.TVA_Out)) & "" ); Draw_Window(Activity_Cmd); if Line_Last > 0 then Draw_text(Activity_Cmd, 1, 1, White, "Date : " & Line(Line'First..Line_Last)); else Draw_text(Activity_Cmd, 1, 1, White, "Date : "); end if; end Wake_Up; or accept Receive(Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character ' Val (10) => begin Date := Formatting.Value(Handling.To_String(Line(1..Line_Last))); Line := (others => Wide_Character'Val(0)); Line_Last := 0; exception when Constraint_Error => null; end; when Wide_Character'Val (20) => Accountant.Close(M.Balance.Balance, Accountant.Accounts); when Wide_Character'Val(127) => if Line_Last > 0 then Line(Line_Last) := Wide_Character'Val(32); Line_Last := Line_Last - 1; end if; when others => null; end case; ---------------------------------------------- --Errno := System("clear" & Character'Val(0)); ---------------------------------------------- State_Print(Date-86400.0, App.Lines-25); Draw_Window(Activity_Balance); Draw_Text(Activity_Balance, 1, 1, White, " Capital : " & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.Capital)) & ", Material :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.Material)) & ", TVA In :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.TVA_In)) & ", TVA Out :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.TVA_Out)) & "" ); Draw_Window(Activity_Cmd); if Line_Last > 0 then Draw_text(Activity_Cmd, 1, 1, White, "Date : " & Line(Line'First..Line_Last)); else Draw_text(Activity_Cmd, 1, 1, White, "Date : "); end if; elsif Line_Last < App.Columns/2-2 then Line(Line_Last + 1) := Wchar; Line_Last := Line_Last + 1; Draw_Window(Activity_Cmd); if Line_Last > 0 then Draw_text(Activity_Cmd, 1, 1, White, "Date : " & Line(Line'First..Line_Last)); else Draw_text(Activity_Cmd, 1, 1, White, "Date : "); end if; else Put(Character'Val(7)); end if; end Receive; or accept Refresh; or accept Page_Down; or accept Page_Up; or accept Up_Arrow do null; end up_arrow; or accept Down_Arrow do null; end Down_Arrow; or accept Left_Arrow; or accept Right_Arrow; or accept Del; or accept Begin_Of; or accept End_Of; or accept Overwrite; or accept Full_Screen; end select; end loop; end loop Main_Loop; end; --W_Io.Put_Line("Activity process halted"); end Activity_Process; ------------------------------------------------------------------------------------------------------------- -- -- -- ------------------------------------------------------------------------------------------------------------- type Stock_enum is (Stock_None, Stock_Name, Stock_Quantity); type Stock_Type is record Name : Stock_Enum := Stock_None; Line : Wstring_45 := (others => ' '); Line_Last : Natural := 0; Line_Pos : Line_Range := 1; Column_Pos : Column_Range := 1; end record; type Curs_Set is array (Stock_Enum) of Stock_Type; type Stock_Cursor_Type is record Values : Curs_Set; Val_Cur : Stock_Enum := Stock_Name; end record; function Initialize return Stock_Cursor_Type is Curs : Stock_Cursor_Type; begin Curs.Values(Stock_Name) := (Stock_name, (others => ' '), 0, 2, 13 ); Curs.Values(Stock_Quantity) := (Stock_quantity, (others => ' '), 0, 4, 13 ); Curs.Val_Cur := Stock_name; return Curs; end Initialize; function To_Stock (Curs : in stock_Cursor_Type;Line_Num : in Stock_Num_Range;Stock_Num : in Stock_Num_Range) return Stock_Record is Stock : Stock_Record := Null_Stock; begin Stock.Num := Stock_Num; Stock.Name(1..Curs.Values(Stock_Name).Line_Last) := Curs.Values(Stock_Name).Line(1..Curs.Values(Stock_Name).Line_Last); Stock.Quantity := Quantity_Range'Value(Handling.To_String(Curs.Values(Stock_Quantity).Line(1..Curs.Values(Stock_Quantity).Line_Last))); return stock; exception when others => raise Spec_Error; end To_Stock; procedure Initialize(Wins : out Stock_Windows_Type; Space_Left : in Line_Range; Width : in Column_Range; L : in Line_Range; C : in Column_Range; Top : in Natural := 0) is begin Wins.Stock_Num_Win := (L+2, C, Space_Left-2, 8, Cyan, The_Window); Wins.Name_Win := (L+2, C+8, Space_Left-2, 26, Cyan, The_Window); Wins.Quantity_Win := (L+2, C+36, Space_Left-2, 16, Cyan, The_Window); Wins.Unit_Ht_Win := (L+2, C+52, Space_Left-2, 16, Cyan, The_Window); Wins.TVA_Win := (L+2, C+68, Space_Left-2, 10, Cyan, The_Window); Initialize(Wins.Stock_Num_Win, L+2, Top+C, Space_Left-2, 8, Cyan, Red); Initialize(Wins.Name_Win, L+2, Top+C+8, Space_Left-2, 26, Cyan, Red); Initialize(Wins.quantity_Win, L+2, Top+C+36, Space_Left-2, 16, Cyan, Red); Initialize(Wins.Unit_Ht_Win, L+2, Top+C+52, Space_Left-2, 16, Cyan, Red); Initialize(Wins.TVA_Win, L+2, Top+C+68, Space_Left-2, 10, Cyan, Red); null; end Initialize; procedure Stock_Wins_Draw(Wins : Stock_Windows_Type) is begin Draw_Window(Wins.Stock_Num_Win); Draw_Window(Wins.Name_Win); Draw_Window(Wins.Quantity_Win); Draw_Window(Wins.Unit_Ht_Win); Draw_Window(Wins.TVA_Win); end Stock_Wins_Draw; procedure Stock_Line_Draw(Wins : Stock_Windows_Type; Line : in Line_Range; Stock : in Stock_Record) is begin Draw_Text(Wins.stock_Num_Win, Line, 1, White, Handling.To_Wide_String(stock_Num_Range'Image(Stock.Num))); Draw_Text(Wins.Name_Win, Line, 1, White, Stock.name(1..24)); Draw_Text(Wins.Quantity_win, Line, 1, White, Handling.To_Wide_String(Quantity_Range'Image(Stock.Quantity))); Draw_Text(Wins.Unit_Ht_Win, Line, 1, White, Handling.To_Wide_String(Fixed_Unit_Ht'Image(Stock.Unit_Ht))); Draw_Text(Wins.TVA_Win, Line, 1, White, Handling.To_Wide_String(Fixed_Factor'Image(Stock.TVA_Rate))); end stock_Line_Draw; procedure Stocks_Print (Stocks : in Sky.Stocks_Manager.Stocks_manager; Wins : in Stock_Windows_Type; Line_Index : in Stock_num_Range; Line_Max : in Positive) is Line_Count : natural := 0; begin if Stocks.Stock_Last = 0 then return; end if; for Line in Line_Index+1..Natural'Min(Line_Index+Line_Max, Stocks.Stock_Last) loop Stock_Line_Draw(Wins, Line_Count+1, Stocks.stocks(Line)); Line_Count := Line_Count + 1; exit when Line_Count = Line_Max; end loop; end Stocks_Print; task body Stocks_Process is type Stocks_Enum is (None, Hardware, Software); Stocks_cur : Stocks_Enum := Software; function Format (Stock : in Stock_Record) return Wide_String is Line : Wide_String(1..App.Columns/2-2) := (others => Wide_Character'Val(32)); begin Wide_Fixed.Move(Handling.To_Wide_String(Natural'Image(Stock.Num)), Line, Error, Left); Wide_Fixed.Replace_Slice(Line, 9, Line'Last, Stock.name); Wide_Fixed.Replace_Slice(Line, 42, Line'Last, Handling.To_Wide_String(Quantity_Range'Image(Stock.Quantity))); Wide_Fixed.Replace_Slice(Line, 55, Line'Last, Handling.To_Wide_String(Fixed_Unit_Ht'Image(Stock.Unit_Ht))); Wide_Fixed.Replace_Slice(Line, 62, Line'Last, Handling.To_Wide_String(Fixed_Factor'Image(Stock.TVA_Rate))); return Line; end Format; Soft_win : Window_Record := (2, 1, 10, App.Columns/2, Cyan, The_Window); Hard_win : Window_Record := (2, 1, 10, App.Columns/2, yellow, The_Window); Stocks_Win : Window_Record := (11, 1, App.Lines-13, App.Columns/2, Blue, The_Window); Cmd_Win : Window_Record := (App.Lines-2, 1, 3, App.Columns/2, White, The_Window); --Stocks_index : Natural := 0; Stock_Line_Index : Natural := 0; Remove_Case : Boolean := False; Stock_Num : Stock_Num_Range := 0; Line_num : Wide_String(1..10) := (others => ' '); Line_Last : Natural := 0; Stock_Curs : Stock_Cursor_Type := Initialize; begin Initialize(Stocks_Win, 11, 1, App.Lines-13, App.Columns/2, Blue, white); Initialize(Soft_Win, 2, 1, 10, App.Columns/2, Cyan, White); Initialize(Hard_Win, 2, 1, 10, App.Columns/2, yellow, White); Initialize(Cmd_Win, App.Lines-2, 1, 3, App.Columns/2, White, Red); Initialize(App.Stocks_Wins, App.Lines-15, App.Columns/2-4, 12, 2); declare Num : Stock_Num_Range := 1; Name : Wide_String := "inconito.net"; Line : Wide_String(1..32) := (others => Wide_Character'Val(32)); Qt : Quantity_Range := 0.0; Ht_Price : Fixed_Unit_Ht := 0.0; TVA : Fixed_Factor := 0.0; Stock : Stock_Record; begin Main_Loop: loop loop select accept Halt; exit Main_Loop; or accept Suspend; exit; or accept Wake_Up(Top : in Natural) do Initialize(Stocks_Win, 11, Top+1, App.Lines-13, App.Columns/2, Blue, white); Initialize(Soft_Win, 2, Top+1, 10, App.Columns/2, Cyan, White); Initialize(Hard_Win, 2, Top+1, 10, App.Columns/2, yellow, White); Initialize(Cmd_Win, App.Lines-2, Top+1, 3, App.Columns/2, White, Red); Initialize(App.Stocks_Wins, App.Lines-15, App.Columns/2-4, 12, 2, top); ----------------------------------------------- --Errno := System("clear" & Character'Val(0)); ----------------------------------------------- Draw_Window(Stocks_Win); Draw_Text(Stocks_Win, 1, 1, White, "N , Name , " & "Quantity , Unit HT , TVA rate"); Draw_Text(Stocks_Win, 2, 1, Blue, Handling.To_Wide_String(((App.Columns/2)-2) * '-')); Draw_Window(Cmd_Win); Stock_Wins_Draw(App.Stocks_Wins); case Stocks_Cur is when None => null; when Software => Draw_Window(Soft_Win); Draw_Text(Soft_Win, 1, App.Columns/4-10, White, "Software Stocks : Update stock"); Draw_Text(Soft_Win, 2, 1, White, "Name : "); Draw_Text(Soft_Win, 4, 1, White, "Quantity : "); for Val in Stock_Name..Stock_Quantity loop Draw_Text(Soft_Win , Stock_Curs.values(Val).Line_Pos, Stock_Curs.values(Val).Column_Pos, White, Stock_Curs.values(Val).Line(1..Stock_Curs.values(Val).Line_Last)); end loop; Stocks_Print(Sky.Stocks_Manager.Software, App.Stocks_Wins, stock_Line_Index, App.Lines-19); Draw_Text(Soft_Win, Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Pos, Stock_Curs.Values(Stock_Curs.Val_Cur).Column_Pos, White, Stock_Curs.Values(Stock_Curs.Val_Cur).Line(1..Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Last)); when Hardware => Draw_Window(Hard_Win); Draw_Text(hard_Win, 1, App.Columns/4-10, White, "Hardware Stocks : update stock"); Draw_Text(hard_Win, 2, 1, White, "Name : "); Draw_Text(hard_Win, 4, 1, White, "Quantity : "); for Val in Stock_Name..Stock_Quantity loop Draw_Text(Hard_Win , Stock_Curs.values(Val).Line_Pos, Stock_Curs.values(Val).Column_Pos, White, Stock_Curs.values(Val).Line(1..Stock_Curs.values(Val).Line_Last)); end loop; Stocks_Print(Sky.Stocks_Manager.Hardware, App.Stocks_Wins, stock_Line_Index, App.Lines-19); Draw_Text(Hard_Win, Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Pos, Stock_Curs.Values(Stock_Curs.Val_Cur).Column_Pos, White, Stock_Curs.Values(Stock_Curs.Val_Cur).Line(1..Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Last)); end case; if Remove_Case then Draw_Text(Cmd_Win, 1, 1, White, "Line num : "); end if; end Wake_Up; or when not Remove_Case => accept Receive(Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character ' Val (9) => case Stocks_Cur is when None => Stocks_Cur := Software; when Hardware => Stocks_Cur := Software; when Software => Stocks_Cur := Hardware; end case; when Wide_Character'Val(5) => Remove_Case := True; when Wide_Character'Val(10) => if Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Last /= 0 then case Stock_Curs.Val_Cur is when Stock_None => null; when Stock_Quantity => if Stocks_Cur = Software then declare Stock : Stock_Record; begin Stock := To_Stock(Stock_Curs, Sky.Stocks_Manager.Software.Stock_Last + 1, Sky.Stocks_Manager.Soft_Num); Sky.Stocks_Manager.Add_To_Stock(Sky.Stocks_Manager.Software, Stock.Name, Stock.Quantity); exception when Spec_Error => Put(Ansi_Tty_Control.Clear_Screen); Put_Line("Stocks Error"); declare Char : Character; begin Put_Line("Press any key to continue"); Get_Immediate(Char); end; end; Stock_Curs := Initialize; elsif Stocks_Cur = Hardware then declare Stock : Stock_Record; begin --if Stock.Quantity > 0.0 then Stock := To_Stock(Stock_Curs, Sky.Stocks_Manager.Hardware.Stock_Last + 1, Sky.Stocks_Manager.Hard_Num); Sky.Stocks_Manager.Add_To_Stock(Sky.Stocks_Manager.Hardware, Stock.Name, Stock.Quantity); exception when Spec_Error => Put(Ansi_Tty_Control.Clear_Screen); Put_Line("Stocks Error"); declare Char : Character; begin Put_Line("Press any key to continue"); Get_Immediate(Char); end; end; Stock_Curs := Initialize; end if; when others => Stock_Curs.Val_Cur := Stock_Enum'Succ(Stock_Curs.Val_Cur); end case; else Put(Character'Val(7)); end if; when Wide_Character ' Val (127) => if Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Last > 0 then Stock_Curs.Values(Stock_Curs.Val_Cur).Line(Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Last) := ' '; Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Last := Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Last - 1; end if; when Wide_Character'Val(18) => Remove_Case := False; when others => null; end case; elsif Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Last < 32 then Stock_Curs.Values(Stock_Curs.Val_Cur).Line(Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Last + 1) := Wchar; Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Last := Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Last + 1; if Stocks_cur = software then for Val in Stock_Name..Stock_Quantity loop Draw_Text(Soft_Win , Stock_Curs.values(Val).Line_Pos, Stock_Curs.values(Val).Column_Pos, White, Stock_Curs.values(Val).Line(1..Stock_Curs.values(Val).Line_Last)); end loop; Draw_Text(Soft_Win, Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Pos, Stock_Curs.Values(Stock_Curs.Val_Cur).Column_Pos, White, Stock_Curs.Values(Stock_Curs.Val_Cur).Line(1..Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Last)); elsif Stocks_Cur = Hardware then for Val in Stock_Name..Stock_Quantity loop Draw_Text(Hard_Win , Stock_Curs.values(Val).Line_Pos, Stock_Curs.values(Val).Column_Pos, White, Stock_Curs.values(Val).Line(1..Stock_Curs.values(Val).Line_Last)); end loop; Draw_Text(Hard_Win, Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Pos, Stock_Curs.Values(Stock_Curs.Val_Cur).Column_Pos, White, Stock_Curs.Values(Stock_Curs.Val_Cur).Line(1..Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Last)); end if; else Put(Character'Val(7)); end if; Draw_Window(Stocks_Win); Draw_Text(Stocks_Win, 1, 1, White, "N , Name , " & "Quantity , Unit HT , TVA rate"); Draw_Text(Stocks_Win, 2, 1, Blue, Handling.To_Wide_String(((App.Columns/2)-2) * '-')); Draw_Window(Cmd_Win); Stock_Wins_Draw(App.Stocks_Wins); case Stocks_Cur is when None => null; when Software => Draw_Window(Soft_Win); Draw_Text(Soft_Win, 1, App.Columns/4-10, White, "Software Stocks : Update stock"); Draw_Text(Soft_Win, 2, 1, White, "Name : "); Draw_Text(Soft_Win, 4, 1, White, "Quantity : "); for Val in Stock_Name..Stock_Quantity Loop Draw_Text(Soft_Win , Stock_Curs.values(Val).Line_Pos, Stock_Curs.values(Val).Column_Pos, White, Stock_Curs.values(Val).Line(1..Stock_Curs.values(Val).Line_Last)); end loop; Stocks_Print(Sky.Stocks_Manager.Software, App.Stocks_Wins, stock_Line_Index, App.Lines-19); Draw_Text(Soft_Win, Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Pos, Stock_Curs.Values(Stock_Curs.Val_Cur).Column_Pos, White, Stock_Curs.Values(Stock_Curs.Val_Cur).Line(1..Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Last)); when Hardware => Draw_Window(Hard_Win); Draw_Text(Hard_Win, 1, App.Columns/4-10, White, "Hardware Stocks : Update stock"); Draw_Text(Hard_Win, 2, 1, White, "Name : "); Draw_Text(Hard_Win, 4, 1, White, "Quantity : "); for Val in Stock_Name..Stock_quantity loop Draw_Text(Hard_Win , Stock_Curs.values(Val).Line_Pos, Stock_Curs.values(Val).Column_Pos, White, Stock_Curs.values(Val).Line(1..Stock_Curs.values(Val).Line_Last)); end loop; Stocks_Print(Sky.Stocks_Manager.Hardware, App.Stocks_Wins, stock_Line_Index, App.Lines-19); Draw_Text(Hard_Win, Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Pos, Stock_Curs.Values(Stock_Curs.Val_Cur).Column_Pos, White, Stock_Curs.Values(Stock_Curs.Val_Cur).Line(1..Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Last)); end case; if Remove_Case then Draw_Text(Cmd_Win, 1, 1, White, "Line num : "); end if; end Receive; or when Remove_Case => accept Receive(Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character ' Val (9) => case Stocks_Cur is when None => Stocks_Cur := Software; when Hardware => Stocks_Cur := Software; when Software => Stocks_Cur := Hardware; end case; when Wide_Character'Val(10) => if Line_Last > 0 then begin Stock_Num := Stock_Num_Range'Value(Handling.To_String(Line_num(Line'First..Line_Last))); if Stock_Num /= 0 then begin case Stocks_Cur is when None => null; when Software => Sky.Stocks_Manager.Stock_Remove(Sky.Stocks_Manager.Software, Stock_Num); when Hardware => Sky.Stocks_Manager.Stock_Remove(Sky.Stocks_Manager.Hardware, Stock_Num); end case; exception when others => null; end; end if; exception when others => null; end; end if; Line_Num := (others => ' '); Line_Last := 0; Remove_Case := False; when Wide_Character'Val(127) => if Line_Last > 0 then Line(Line_Last) := Wide_Character'Val(32); Line_Last := Line_Last - 1; else Put(Character'Val(7)); end if; when others => null; end case; Draw_Window(Stocks_Win); Draw_Text(Stocks_Win, 1, 1, White, "N , Name , " & "Quantity , Unit HT , TVA rate"); Draw_Text(Stocks_Win, 2, 1, Blue, Handling.To_Wide_String(((App.Columns/2)-2) * '-')); Stock_Wins_Draw(App.Stocks_Wins); Draw_Window(Cmd_Win); case Stocks_Cur is when None => null; when Software => Draw_Window(Soft_Win); Draw_Text(Soft_Win, 1, App.Columns/4-10, White, "Software Stocks : Update stock"); Draw_Text(Soft_Win, 2, 1, White, "Name : "); Draw_Text(Soft_Win, 4, 1, White, "Quantity : "); for Val in Stock_Name..Stock_quantity loop Draw_Text(Soft_Win , Stock_Curs.values(Val).Line_Pos, Stock_Curs.values(Val).Column_Pos, White, Stock_Curs.values(Val).Line(1..Stock_Curs.values(Val).Line_Last)); end loop; Stocks_Print(Sky.Stocks_Manager.Software, App.Stocks_Wins, stock_Line_Index, App.Lines-19); Draw_Text(Soft_Win, Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Pos, Stock_Curs.Values(Stock_Curs.Val_Cur).Column_Pos, White, Stock_Curs.Values(Stock_Curs.Val_Cur).Line(1..Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Last)); when Hardware => Draw_Window(Hard_Win); Draw_Text(hard_Win, 1, App.Columns/4-10, White, "Hardware Stocks : update stock"); Draw_Text(hard_Win, 2, 1, White, "Name : "); Draw_Text(hard_Win, 4, 1, White, "Quantity : "); for Val in Stock_Name..Stock_quantity loop Draw_Text(Hard_Win , Stock_Curs.values(Val).Line_Pos, Stock_Curs.values(Val).Column_Pos, White, Stock_Curs.values(Val).Line(1..Stock_Curs.values(Val).Line_Last)); end loop; Stocks_Print(Sky.Stocks_Manager.Hardware, App.Stocks_Wins, stock_Line_Index, App.Lines-19); Draw_Text(Hard_Win, Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Pos, Stock_Curs.Values(Stock_Curs.Val_Cur).Column_Pos, White, Stock_Curs.Values(Stock_Curs.Val_Cur).Line(1..Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Last)); end case; if Remove_Case then if Line_Last > 0 then Draw_Text(Cmd_Win, 1, 1, White, "Line num : " & Line_num(Line'First..Line_last)); else Draw_Text(Cmd_Win, 1, 1, White, "Line num : "); end if; end if; elsif Line_Last < Line_num'Length then Line_Num(Line_Last + 1) := Wchar; Line_Last := Line_Last + 1; Draw_Window(Cmd_Win); if Line_Last > 0 then Draw_Text(Cmd_Win, 1, 1, White, "Line num : " & Line_num(Line'First..Line_last)); else Draw_Text(Cmd_Win, 1, 1, White, "Line num : "); end if; else Put(Character'Val(7)); end if; end Receive; or accept Refresh do Draw_Window(Stocks_Win); Draw_Text(Stocks_Win, 1, 1, White, "N , Name , " & "Quantity , Unit HT , TVA rate"); Draw_Text(Stocks_Win, 2, 1, Blue, Handling.To_Wide_String(((App.Columns/2)-2) * '-')); Stock_Wins_Draw(App.Stocks_Wins); Draw_Window(Cmd_Win); case Stocks_Cur is when None => null; when Software => Draw_Window(Soft_Win); Draw_Text(Soft_Win, 1, App.Columns/4-10, White, "Software Stocks : Update stock"); Draw_Text(Soft_Win, 2, 1, White, "Name : "); Draw_Text(Soft_Win, 4, 1, White, "Quantity : "); for Val in Stock_Name..Stock_quantity loop Draw_Text(Soft_Win , Stock_Curs.values(Val).Line_Pos, Stock_Curs.values(Val).Column_Pos, White, Stock_Curs.values(Val).Line(1..Stock_Curs.values(Val).Line_Last)); end loop; Stocks_Print(Sky.Stocks_Manager.Software, App.Stocks_Wins, stock_Line_Index, App.Lines-19); Draw_Text(Soft_Win, Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Pos, Stock_Curs.Values(Stock_Curs.Val_Cur).Column_Pos, White, Stock_Curs.Values(Stock_Curs.Val_Cur).Line(1..Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Last)); when Hardware => Draw_Window(Hard_Win); Draw_Text(hard_Win, 1, App.Columns/4-10, White, "Hardware Stocks : update stock"); Draw_Text(hard_Win, 2, 1, White, "Name : "); Draw_Text(hard_Win, 4, 1, White, "Quantity : "); for Val in Stock_Name..Stock_quantity loop Draw_Text(Hard_Win , Stock_Curs.values(Val).Line_Pos, Stock_Curs.values(Val).Column_Pos, White, Stock_Curs.values(Val).Line(1..Stock_Curs.values(Val).Line_Last)); end loop; Stocks_Print(Sky.Stocks_Manager.Hardware, App.Stocks_Wins, stock_Line_Index, App.Lines-19); Draw_Text(Hard_Win, Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Pos, Stock_Curs.Values(Stock_Curs.Val_Cur).Column_Pos, White, Stock_Curs.Values(Stock_Curs.Val_Cur).Line(1..Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Last)); end case; if Remove_Case then Draw_Text(Cmd_Win, 1, 1, White, "Line num : "); end if; end Refresh; or accept Page_Down do Stock_Wins_Draw(App.Stocks_Wins); case Stocks_Cur is when None => null; when Software => if Stock_Line_Index < Sky.Stocks_Manager.Software.Stock_Last then Stock_Line_Index := Stock_Line_Index + Stock_Num_Range'Min (Stock_Line_Index+(App.Lines-19), Sky.Stocks_Manager.Software.Stock_Last); else Put(Character'Val(7)); end if; Draw_Window(Soft_Win); Draw_Text(Soft_Win, 1, App.Columns/4-10, White, "Software Stocks : Update stock"); Draw_Text(Soft_Win, 2, 1, White, "Name : "); Draw_Text(Soft_Win, 4, 1, White, "Quantity : "); for Val in Stock_Name..Stock_Quantity Loop Draw_Text(Soft_Win , Stock_Curs.values(Val).Line_Pos, Stock_Curs.values(Val).Column_Pos, White, Stock_Curs.values(Val).Line(1..Stock_Curs.values(Val).Line_Last)); end loop; Stocks_Print(Sky.Stocks_Manager.Software, App.Stocks_Wins, stock_Line_Index, App.Lines-19); Draw_Text(Soft_Win, Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Pos, Stock_Curs.Values(Stock_Curs.Val_Cur).Column_Pos, White, Stock_Curs.Values(Stock_Curs.Val_Cur).Line(1..Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Last)); when Hardware => if Stock_Line_Index < Sky.Stocks_Manager.hardware.Stock_Last then Stock_Line_Index := Stock_Line_Index + Stock_Num_Range'Min (Stock_Line_Index+(App.Lines-19), Sky.Stocks_Manager.hardware.Stock_Last); else Put(Character'Val(7)); end if; Draw_Window(Hard_Win); Draw_Text(Hard_Win, 1, App.Columns/4-10, White, "Hardware Stocks : Update stock"); Draw_Text(Hard_Win, 2, 1, White, "Name : "); Draw_Text(Hard_Win, 4, 1, White, "Quantity : "); for Val in Stock_Name..Stock_quantity loop Draw_Text(Hard_Win , Stock_Curs.values(Val).Line_Pos, Stock_Curs.values(Val).Column_Pos, White, Stock_Curs.values(Val).Line(1..Stock_Curs.values(Val).Line_Last)); end loop; Stocks_Print(Sky.Stocks_Manager.Hardware, App.Stocks_Wins, stock_Line_Index, App.Lines-19); Draw_Text(Hard_Win, Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Pos, Stock_Curs.Values(Stock_Curs.Val_Cur).Column_Pos, White, Stock_Curs.Values(Stock_Curs.Val_Cur).Line(1..Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Last)); end case; end Page_Down; or accept Page_Up do Stock_Wins_Draw(App.Stocks_Wins); case Stocks_Cur is when None => null; when Software => if Stock_Line_Index - (App.Lines-19) > 0 then Stock_Line_Index := Stock_Line_Index + Stock_Line_Index - (App.Lines-19); else Stock_Line_Index := 0; end if; Draw_Window(Soft_Win); Draw_Text(Soft_Win, 1, App.Columns/4-10, White, "Software Stocks : Update stock"); Draw_Text(Soft_Win, 2, 1, White, "Name : "); Draw_Text(Soft_Win, 4, 1, White, "Quantity : "); for Val in Stock_Name..Stock_Quantity Loop Draw_Text(Soft_Win , Stock_Curs.values(Val).Line_Pos, Stock_Curs.values(Val).Column_Pos, White, Stock_Curs.values(Val).Line(1..Stock_Curs.values(Val).Line_Last)); end loop; Stocks_Print(Sky.Stocks_Manager.Software, App.Stocks_Wins, stock_Line_Index, App.Lines-19); Draw_Text(Soft_Win, Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Pos, Stock_Curs.Values(Stock_Curs.Val_Cur).Column_Pos, White, Stock_Curs.Values(Stock_Curs.Val_Cur).Line(1..Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Last)); when Hardware => if Stock_Line_Index - (App.Lines-19) > 0 then Stock_Line_Index := Stock_Line_Index + Stock_Line_Index - (App.Lines-19); else Stock_Line_Index := 0; end if; Draw_Window(Hard_Win); Draw_Text(Hard_Win, 1, App.Columns/4-10, White, "Hardware Stocks : Update stock"); Draw_Text(Hard_Win, 2, 1, White, "Name : "); Draw_Text(Hard_Win, 4, 1, White, "Quantity : "); for Val in Stock_Name..Stock_quantity loop Draw_Text(Hard_Win , Stock_Curs.values(Val).Line_Pos, Stock_Curs.values(Val).Column_Pos, White, Stock_Curs.values(Val).Line(1..Stock_Curs.values(Val).Line_Last)); end loop; Stocks_Print(Sky.Stocks_Manager.Hardware, App.Stocks_Wins, stock_Line_Index, App.Lines-19); Draw_Text(Hard_Win, Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Pos, Stock_Curs.Values(Stock_Curs.Val_Cur).Column_Pos, White, Stock_Curs.Values(Stock_Curs.Val_Cur).Line(1..Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Last)); end case; end Page_Up; or accept Up_Arrow do null; end up_arrow; or accept Down_Arrow do null; end Down_Arrow; or accept Left_Arrow; or accept Right_Arrow; or accept Full_Screen; or accept Del; or accept Begin_Of; or accept End_Of; or accept Overwrite; or accept Full_Screen; end select; end loop; loop select accept Halt do null; end Halt; exit Main_Loop; or accept Suspend; or accept Wake_Up (Top : in Natural) do Initialize(Stocks_Win, 11, Top+1, App.Lines-13, App.Columns/2, Blue, white); Initialize(Soft_Win, 2, Top+1, 10, App.Columns/2, Cyan, White); Initialize(Hard_Win, 2, Top+1, 10, App.Columns/2, yellow, White); Initialize(Cmd_Win, App.Lines-2, Top+1, 3, App.Columns/2, White, Red); Initialize(App.Stocks_Wins, App.Lines-15, App.Columns/2-4, 12, 2, top); ----------------------------------------------- --Errno := System("clear" & Character'Val(0)); ----------------------------------------------- Draw_Window(Stocks_Win); Draw_Text(Stocks_Win, 1, 1, White, "N , Name , " & "Quantity , Unit HT , TVA rate"); Draw_Text(Stocks_Win, 2, 1, Blue, Handling.To_Wide_String(((App.Columns/2)-2) * '-')); Draw_Window(Cmd_Win); Stock_Wins_Draw(App.Stocks_Wins); case Stocks_Cur is when None => null; when Software => Draw_Window(Soft_Win); Draw_Text(Soft_Win, 1, App.Columns/4-10, White, "Software Stocks : Update stock"); Draw_Text(Soft_Win, 2, 1, White, "Name : "); Draw_Text(Soft_Win, 4, 1, White, "Quantity : "); for Val in Stock_Name..Stock_Quantity loop Draw_Text(Soft_Win , Stock_Curs.values(Val).Line_Pos, Stock_Curs.values(Val).Column_Pos, White, Stock_Curs.values(Val).Line(1..Stock_Curs.values(Val).Line_Last)); end loop; Stocks_Print(Sky.Stocks_Manager.Software, App.Stocks_Wins, stock_Line_Index, App.Lines-19); Draw_Text(Soft_Win, Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Pos, Stock_Curs.Values(Stock_Curs.Val_Cur).Column_Pos, White, Stock_Curs.Values(Stock_Curs.Val_Cur).Line(1..Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Last)); when Hardware => Draw_Window(Hard_Win); Draw_Text(hard_Win, 1, App.Columns/4-10, White, "Hardware Stocks : update stock"); Draw_Text(hard_Win, 2, 1, White, "Name : "); Draw_Text(hard_Win, 4, 1, White, "Quantity : "); for Val in Stock_Name..Stock_Quantity loop Draw_Text(Hard_Win , Stock_Curs.values(Val).Line_Pos, Stock_Curs.values(Val).Column_Pos, White, Stock_Curs.values(Val).Line(1..Stock_Curs.values(Val).Line_Last)); end loop; Stocks_Print(Sky.Stocks_Manager.Hardware, App.Stocks_Wins, stock_Line_Index, App.Lines-19); Draw_Text(Hard_Win, Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Pos, Stock_Curs.Values(Stock_Curs.Val_Cur).Column_Pos, White, Stock_Curs.Values(Stock_Curs.Val_Cur).Line(1..Stock_Curs.Values(Stock_Curs.Val_Cur).Line_Last)); end case; if Remove_Case then Draw_Text(Cmd_Win, 1, 1, White, "Line num : "); end if; end Wake_Up; exit; end select; end loop; end loop Main_Loop; end; --W_Io.Put_Line("Stocks process halted"); end Stocks_Process; type Object_Array is array (Positive range <>) of My_Classes.Object_Access; function Successor (O : in My_Classes.Object_Access) return Object_Array; function "=" (Left, Right : Object_Class'class) return Boolean; function "<" (Left, Right : Object_Class'class) return Boolean; function Copy (Object : My_Classes.Object_Access) return My_Classes.Object_Access; type Path_Finding is access function (Start, Goal : in Object_Class'class) return Object_Vectors.Vector; function Successor (O : in My_Classes.Object_Access) return Object_Array is begin case O.Class_Name is when Universe => declare T : access Object_Array := new Object_Array (1..16); begin --T(1) := new Universe_Class.Universe_Class; T(1) := Copy(O); T(2) := new My_Profile.Profile_Obj; T(3) := new My_Machine.Machine_Obj; T(4) := new My_Component.Component_Obj; T(5) := new My_Job.Job_Obj; T(6) := new My_House.House_Obj; T(7) := new My_Content.Content_Obj; T(8) := new My_Contact.Contact_Obj; T(9) := new My_Account.Account_Obj; T(10) := new My_Activity.Activity_Obj; T(11) := new My_Account_Line.Account_Line_Obj; T(12) := new My_Compta_Line.Compta_Line_Obj; T(13) := new My_Event.Event_Obj; T(14) := new My_Planning.Planning_Obj; T(15) := new My_Car.Car_Obj; T(16) := new My_Note.Note_Obj; return T.all; end; when Profile => declare T : access Object_Array := new Object_Array (1..16); begin T(1) := new My_Universe.Universe_Obj; T(2) := Copy(O); T(3) := new My_Machine.Machine_Obj; T(4) := new My_Component.Component_Obj; T(5) := new My_Job.Job_Obj; T(6) := new My_House.House_Obj; T(7) := new My_Content.Content_Obj; T(8) := new My_Contact.Contact_Obj; T(9) := new My_Account.Account_Obj; T(10) := new My_Activity.Activity_Obj; T(11) := new My_Account_Line.Account_Line_Obj; T(12) := new My_Compta_Line.Compta_Line_Obj; T(13) := new My_Event.Event_Obj; T(14) := new My_Planning.Planning_Obj; T(15) := new My_Car.Car_Obj; T(16) := new My_Note.Note_Obj; return T.all; end; when Planning => declare T : access Object_Array := new Object_Array (1..16); begin T(1) := new My_Universe.Universe_Obj; T(2) := new My_Profile.Profile_Obj; T(3) := new My_Machine.Machine_Obj; T(4) := new My_Component.Component_Obj; T(5) := new My_Job.Job_Obj; T(6) := new My_House.House_Obj; T(7) := new My_Content.Content_Obj; T(8) := new My_Contact.Contact_Obj; T(9) := new My_Account.Account_Obj; T(10) := new My_Activity.Activity_Obj; T(11) := new My_Account_Line.Account_Line_Obj; T(12) := new My_Compta_Line.Compta_Line_Obj; T(13) := new My_Event.Event_Obj; T(14) := new My_Planning.Planning_Obj ' (My_Planning.Planning_Obj(O.all)); T(15) := new My_Car.Car_Obj; T(16) := new My_Note.Note_Obj; return T.all; end; when Job => declare T : access Object_Array := new Object_Array (1..16); begin T(1) := new My_Universe.Universe_Obj; T(2) := new My_Profile.Profile_Obj; T(3) := new My_Machine.Machine_Obj; T(4) := new My_Component.Component_Obj; T(5) := Copy(O); T(6) := new My_House.House_Obj; T(7) := new My_Content.Content_Obj; T(8) := new My_Contact.Contact_Obj; T(9) := new My_Account.Account_Obj; T(10) := new My_Activity.Activity_Obj; T(11) := new My_Account_Line.Account_Line_Obj; T(12) := new My_Compta_Line.Compta_Line_Obj; T(13) := new My_Event.Event_Obj; T(14) := new My_Planning.Planning_Obj; T(15) := new My_Car.Car_Obj; T(16) := new My_Note.Note_Obj; return T.all; end; when Event => declare T : access Object_Array := new Object_Array (1..16); begin T(1) := new My_Universe.Universe_Obj; T(2) := new My_Profile.Profile_Obj; T(3) := new My_Machine.Machine_Obj; T(4) := new My_Component.Component_Obj; T(5) := new My_Job.Job_Obj; T(6) := new My_House.House_Obj; T(7) := new My_Content.Content_Obj; T(8) := new My_Contact.Contact_Obj; T(9) := new My_Account.Account_Obj; T(10) := new My_Activity.Activity_Obj; T(11) := new My_Account_Line.Account_Line_Obj; T(12) := new My_Compta_Line.Compta_Line_Obj; T(13) := Copy(O); T(14) := new My_Planning.Planning_Obj; T(15) := new My_Car.Car_Obj; T(16) := new My_Note.Note_Obj; return T.all; end; when Machine => declare T : access Object_Array := new Object_Array (1..16); begin T(1) := new My_Universe.Universe_Obj; T(2) := new My_Profile.Profile_Obj; T(3) := Copy(O); T(4) := new My_Component.Component_Obj; T(5) := new My_Job.Job_Obj; T(6) := new My_House.House_Obj; T(7) := new My_Content.Content_Obj; T(8) := new My_Contact.Contact_Obj; T(9) := new My_Account.Account_Obj; T(10) := new My_Activity.Activity_Obj; T(11) := new My_Account_Line.Account_Line_Obj; T(12) := new My_Compta_Line.Compta_Line_Obj; T(13) := new My_Event.Event_Obj; T(14) := new My_Planning.Planning_Obj; T(15) := new My_Car.Car_Obj; T(16) := new My_Note.Note_Obj; return T.all; end; when Acc => declare T : access Object_Array := new Object_Array (1..16); begin T(1) := new My_Universe.Universe_Obj; T(2) := new My_Profile.Profile_Obj; T(3) := new My_Machine.Machine_Obj; T(4) := new My_Component.Component_Obj; T(5) := new My_Job.Job_Obj; T(6) := new My_House.House_Obj; T(7) := new My_Content.Content_Obj; T(8) := new My_Contact.Contact_Obj; T(9) := Copy(O); T(10) := new My_Activity.Activity_Obj; T(11) := new My_Account_Line.Account_Line_Obj; T(12) := new My_Compta_Line.Compta_Line_Obj; T(13) := new My_Event.Event_Obj; T(14) := new My_Planning.Planning_Obj; T(15) := new My_Car.Car_Obj; T(16) := new My_Note.Note_Obj; return T.all; end; when Account_Line => declare T : access Object_Array := new Object_Array (1..16); begin T(1) := new My_Universe.Universe_Obj; T(2) := new My_Profile.Profile_Obj; T(3) := new My_Machine.Machine_Obj; T(4) := new My_Component.Component_Obj; T(5) := new My_Job.Job_Obj; T(6) := new My_House.House_Obj; T(7) := new My_Content.Content_Obj; T(8) := new My_Contact.Contact_Obj; T(9) := new My_Account.Account_Obj; T(10) := new My_Activity.Activity_Obj; T(11) := Copy(O); T(12) := new My_Compta_Line.Compta_Line_Obj; T(13) := new My_Event.Event_Obj; T(14) := new My_Planning.Planning_Obj; T(15) := new My_Car.Car_Obj; T(16) := new My_Note.Note_Obj; return T.all; end; when Activity => declare T : access Object_Array := new Object_Array (1..16); begin T(1) := new My_Universe.Universe_Obj; T(2) := new My_Profile.Profile_Obj; T(3) := new My_Machine.Machine_Obj; T(4) := new My_Component.Component_Obj; T(5) := new My_Job.Job_Obj; T(6) := new My_House.House_Obj; T(7) := new My_Content.Content_Obj; T(8) := new My_Contact.Contact_Obj; T(9) := new My_Account.Account_Obj; T(10) := Copy(O); T(11) := new My_Account_Line.Account_Line_Obj; T(12) := new My_Compta_Line.Compta_Line_Obj; T(13) := new My_Event.Event_Obj; T(14) := new My_Planning.Planning_Obj; T(15) := new My_Car.Car_Obj; T(16) := new My_Note.Note_Obj; return T.all; end; when Compta_Line => declare T : access Object_Array := new Object_Array (1..16); begin T(1) := new My_Universe.Universe_Obj; T(2) := new My_Profile.Profile_Obj; T(3) := new My_Machine.Machine_Obj; T(4) := new My_Component.Component_Obj; T(5) := new My_Job.Job_Obj; T(6) := new My_House.House_Obj; T(7) := new My_Content.Content_Obj; T(8) := new My_Contact.Contact_Obj; T(9) := new My_Account.Account_Obj; T(10) := new My_Activity.Activity_Obj; T(11) := new My_Account_Line.Account_Line_Obj; T(12) := Copy(O); T(13) := new My_Event.Event_Obj; T(14) := new My_Planning.Planning_Obj; T(15) := new My_Car.Car_Obj; T(16) := new My_Note.Note_Obj; return T.all; end; when Note => declare T : access Object_Array := new Object_Array (1..16); begin T(1) := new My_Universe.Universe_Obj; T(2) := new My_Profile.Profile_Obj; T(3) := new My_Machine.Machine_Obj; T(4) := new My_Component.Component_Obj; T(5) := new My_Job.Job_Obj; T(6) := new My_House.House_Obj; T(7) := new My_Content.Content_Obj; T(8) := new My_Contact.Contact_Obj; T(9) := new My_Account.Account_Obj; T(10) := new My_Activity.Activity_Obj; T(11) := new My_Account_Line.Account_Line_Obj; T(12) := new My_Compta_Line.Compta_Line_Obj; T(13) := new My_Event.Event_Obj; T(14) := new My_Planning.Planning_Obj; T(15) := new My_Car.Car_Obj; T(16) := Copy(O); return T.all; end; when Component => declare T : access Object_Array := new Object_Array (1..16); begin T(1) := new My_Universe.Universe_Obj; T(2) := new My_Profile.Profile_Obj; T(3) := new My_Machine.Machine_Obj; T(4) := new My_Component.Component_Obj; T(5) := new My_Job.Job_Obj; T(6) := new My_House.House_Obj; T(7) := new My_Content.Content_Obj; T(8) := new My_Contact.Contact_Obj; T(9) := new My_Account.Account_Obj; T(10) := new My_Activity.Activity_Obj; T(11) := new My_Account_Line.Account_Line_Obj; T(12) := new My_Compta_Line.Compta_Line_Obj; T(13) := new My_Event.Event_Obj; T(14) := new My_Planning.Planning_Obj; T(15) := new My_Car.Car_Obj; T(16) := new My_Note.Note_Obj; return T.all; end; when Contact => declare T : access Object_Array := new Object_Array (1..16); begin T(1) := new My_Universe.Universe_Obj; T(2) := new My_Profile.Profile_Obj; T(3) := new My_Machine.Machine_Obj; T(4) := Copy(O); T(5) := new My_Job.Job_Obj; T(6) := new My_House.House_Obj; T(7) := new My_Content.Content_Obj; T(8) := new My_Contact.Contact_Obj; T(9) := new My_Account.Account_Obj; T(10) := new My_Activity.Activity_Obj; T(11) := new My_Account_Line.Account_Line_Obj; T(12) := new My_Compta_Line.Compta_Line_Obj; T(13) := new My_Event.Event_Obj; T(14) := new My_Planning.Planning_Obj; T(15) := new My_Car.Car_Obj; T(16) := new My_Note.Note_Obj; return T.all; end; when Content => declare T : access Object_Array := new Object_Array (1..16); begin T(1) := new My_Universe.Universe_Obj; T(2) := new My_Profile.Profile_Obj; T(3) := new My_Machine.Machine_Obj; T(4) := new My_Component.Component_Obj; T(5) := new My_Job.Job_Obj; T(6) := new My_House.House_Obj; T(7) := Copy(O); T(8) := new My_Contact.Contact_Obj; T(9) := new My_Account.Account_Obj; T(10) := new My_Activity.Activity_Obj; T(11) := new My_Account_Line.Account_Line_Obj; T(12) := new My_Compta_Line.Compta_Line_Obj; T(13) := new My_Event.Event_Obj; T(14) := new My_Planning.Planning_Obj; T(15) := new My_Car.Car_Obj; T(16) := new My_Note.Note_Obj; return T.all; end; when House => declare T : access Object_Array := new Object_Array (1..16); begin T(1) := new My_Universe.Universe_Obj; T(2) := new My_Profile.Profile_Obj; T(3) := new My_Machine.Machine_Obj; T(4) := new My_Component.Component_Obj; T(5) := new My_Job.Job_Obj; T(6) := Copy(O); T(7) := new My_Content.Content_Obj; T(8) := new My_Contact.Contact_Obj; T(9) := new My_Account.Account_Obj; T(10) := new My_Activity.Activity_Obj; T(11) := new My_Account_Line.Account_Line_Obj; T(12) := new My_Compta_Line.Compta_Line_Obj; T(13) := new My_Event.Event_Obj; T(14) := new My_Planning.Planning_Obj; T(15) := new My_Car.Car_Obj; T(16) := new My_Note.Note_Obj; return T.all; end; when Car => declare T : access Object_Array := new Object_Array (1..16); begin T(1) := new My_Universe.Universe_Obj; T(2) := new My_Profile.Profile_Obj; T(3) := new My_Machine.Machine_Obj; T(4) := new My_Component.Component_Obj; T(5) := new My_Job.Job_Obj; T(6) := new My_House.House_Obj; T(7) := new My_Content.Content_Obj; T(8) := new My_Contact.Contact_Obj; T(9) := new My_Account.Account_Obj; T(10) := new My_Activity.Activity_Obj; T(11) := new My_Account_Line.Account_Line_Obj; T(12) := new My_Compta_Line.Compta_Line_Obj; T(13) := new My_Event.Event_Obj; T(14) := new My_Planning.Planning_Obj; T(15) := Copy(O); T(16) := new My_Note.Note_Obj; return T.all; end; end case; end Successor; function Copy (Object : My_Classes.Object_Access) return My_Classes.Object_Access is Target : My_Classes.Object_Access; begin --if Object /= null then case Object.Class_Name is when My_Classes.Universe => Target := new My_Universe.Universe_Obj ' (My_Universe.Universe_Obj(Object.all)); when My_Classes.Profile => Target := new My_Profile.Profile_Obj ' (My_Profile.Profile_Obj(Object.all)); when My_Classes.Planning => Target := new My_Planning.Planning_Obj ' (My_Planning.Planning_Obj(Object.all)); when My_Classes.Job => Target := new My_Job.Job_Obj ' (My_Job.Job_Obj(Object.all)); when My_Classes.Event => Target := new My_Event.Event_Obj ' (My_Event.Event_Obj(Object.all)); when My_Classes.Machine => Target := new My_Machine.Machine_Obj ' (My_Machine.Machine_Obj(Object.all)); when My_Classes.Acc => target := new My_Account.Account_Obj ' (My_Account.Account_Obj(Object.all)); when My_Classes.Account_Line => Target := new My_Account_Line.Account_Line_Obj ' (My_Account_Line.Account_Line_Obj(Object.all)); when My_Classes.Activity => Target := new My_Activity.Activity_Obj ' (My_Activity.Activity_Obj(Object.all)); when My_Classes.Compta_Line => Target := new My_Compta_Line.Compta_Line_Obj ' (My_Compta_Line.Compta_Line_Obj(Object.all)); when My_Classes.Note => target := new My_Note.Note_Obj ' (My_Note.Note_Obj(Object.all)); when My_Classes.Component => Target := new My_Component.Component_Obj ' (My_Component.Component_Obj(Object.all)); when My_Classes.Contact => target := new My_Contact.Contact_Obj ' (My_Contact.Contact_Obj(Object.all)); when My_Classes.Content => Target := new My_Content.Content_Obj ' (My_Content.Content_Obj(Object.all)); when My_Classes.House => target := new My_House.House_Obj ' (My_House.House_Obj(Object.all)); when My_Classes.Car => Target := new My_Car.Car_Obj ' (My_Car.Car_Obj(Object.all)); end case; return Target; end Copy; use Abstracted_Vectors; function "=" (Left, Right : Object_Class'class) return Boolean is begin if (Left.Class_Name = Right.Class_Name) then case Left.Class_Name is when Universe => if Left.Universe.X = Right.Universe.X and then Left.Universe.Y = Right.Universe.Y and then Left.Universe.Z = Right.Universe.Z then return True; end if; when Profile => if Left.Profile = Right.Profile then return True; end if; when Planning => if Left.Planning = Right.Planning then return True; end if; when Job => if Left.Job = Right.Job then return True; end if; when Event => return True; when Machine => if Left.Machine = Right.Machine then return True; end if; when Acc => if Left.Account = Right.Account then return True; end if; when Account_Line => if Left.Account_Line = Right.Account_Line then return True; end if; when Activity => if Left.Activity = Right.Activity then return True; end if; when Compta_Line => if Left.Compta_Line = Right.Compta_Line then return True; end if; when Note => if Left.Note = Right.note then return True; end if; when Component => if Left.Component = Right.Component then return True; end if; when Contact => if Left.Contact = Right.Contact then return True; end if; when Content => if Left.Content.Price = Right.Content.Price then return True; end if; when House => if Left.House = Right.House then return True; end if; when Car => if Left.Car = Right.Car then return True; end if; end case; end if; return False; end "="; function "<" (Left, Right : Object_Class'class) return Boolean is begin return Fit (Left) < Fit(Right); end "<"; function "=" (Left, Right : My_Classes.Object_Access) return Boolean is begin return "="(Left.all, Right.all); end "="; function compare (Left, Right : in My_Classes.Object_Access) return Boolean is begin return Left.all < Right.all; end compare; function Heuristic (O : in My_Classes.Object_Access) return Float is begin return 1.0; end Heuristic; function Uniform (O : in My_Classes.Object_Access) return Float is begin return -0.1; end Uniform; package Optimal_Path is new Work.Wargame.Search.Path_Finding (My_Classes.Object_Access, Heuristic, Uniform, "=", Compare, Object_Array, Successor); use Ada.Containers; use Optimal_Path; use Optimal_Path.Element_Lists; procedure Find (O : My_Classes.Object_Access; Target : My_Classes.Object_Access; Goal_Path : out Optimal_Path.Element_List) is Open : Element_List; begin --Text_Io.Put_Line("appenninng start node"); append(Open, O, Count_Type(Integer(Length(Open))+1)); --Text_Io.Put_Line("appenninng target node"); append(Open, Target, Count_Type(Integer(Length(Open))+1)); --Text_Io.Put_Line("Astar process..."); Optimal_Path.Astar(Open, Goal_Path); end Find; Station_Lock : Binary_Semaphore(True, Default_Ceiling); task body Workstation_Process is Planning_Win : Window_Record; Work_Win : Window_Record; Win : Window_Record; Work : Object_Vectors.Vector; station : Window_Record; Path : Object_Vectors.Vector; task Plan_process is entry Receive(Work : in Object_Vectors.Vector); entry Halt; end Plan_Process; task body Plan_Process is Win_Index : Natural := 0; Errno : Integer := 0; begin Planning_Win.Win.L := 3; Planning_Win.Win.C := 120; Planning_Win.Win.H := 20; Planning_Win.Win.W := 60; Planning_Win.Win.Frame_Type := Single_Line_Frame; Planning_Win.Win.frame_Color := Blue; Planning_Win.Win.Close_Box_Color := Red; loop select accept Receive(Work : in Object_Vectors.Vector) do Station_Lock.Seize; Draw_Window(Planning_Win); for I in 1..Length (Work) loop declare E : constant My_Classes.Object_Access := Element(Work, Integer(I)); begin E.Print(Planning_Win, Win_Index); end; end loop; Station_Lock.Release; Win_Index := 0; --Text_Io.Put(Character'Val(7)); Errno := System("/usr/bin/espeak i" & Character'Val(0)); end Receive; or accept Halt; exit; end select; end loop; end Plan_Process; task Station_process is entry Init; entry Create_Planning (start : in Time; Stop : in Time); entry Create_Event(Date : in Time;D : in Duration); entry Create_Object (Object: in My_Classes.Object_Access); entry Start; entry Stop; entry Halt; end Station_process; task Work_Process is entry Init; entry Add (O : My_Classes.Object_Access); entry Halt; end Work_Process; task body Work_Process is Win_Index : Natural := 0; begin accept Init; Work_Win.Win.L := 23; Work_Win.Win.C := 120; Work_Win.Win.H := 20; Work_Win.Win.W := 60; Work_Win.Win.Frame_Type := Single_Line_Frame; Work_Win.Win.frame_Color := Blue; Work_Win.Win.Close_Box_Color := Red; Draw_Window(Work_Win); loop select accept Add (O : My_Classes.Object_Access) do if O.Class_Name = Event then for I in 1..Length (Work) loop declare E : constant My_Classes.Object_Access := Element(Work, Integer(I)); begin if E.Class_Name = planning then if (My_Event.Event_Obj(O.all).Event.Date >= My_Planning.Planning_Obj(E.all).planning.Start) and (My_Event.Event_Obj(O.all).Event.Date <= My_Planning.Planning_Obj(E.all).planning.Stop) then declare Done : Boolean := False; begin for J in 1..Length (Work) loop declare E : constant My_Classes.Object_Access := Element(Work, Integer(J)); begin if E.Class_Name = Event then Object_Vectors.Delete(Work, Object_Vectors.Extended_Index(J)); Append(Work, O); Done := True; exit; end if; end; end loop; if not Done then Append(Work, O); end if; end; Plan_process.Receive(Work); Object_Vectors.Clear(Work); end if; exit; end if; end; end loop; else declare Done : Boolean := False; Tag : Obj_Enum := O.Class_Name; begin for I in 1..Length (Work) loop declare E : constant My_Classes.Object_Access := Element(Work, Integer(I)); begin if E.Class_Name = Tag then Object_Vectors.Delete(Work, Object_Vectors.Extended_Index(I)); Append(Work, O); Done := True; exit; end if; end; end loop; if not Done then Append(Work, O); end if; end; end if; end Add; or accept Halt; exit; end select; end loop; end Work_Process; task body Station_process is Win_Index : Natural := 0; subtype Plan_Step_Range is Natural range 0..60; Universe : My_Classes.Object_Access := new My_Universe.Universe_Obj; Plan : Abstracted_Access := new Abstracted_Class ' (Abstracted_Class(Universe.all)); Goal_Path : Optimal_Path.Element_List; Path : Object_Vectors.Vector; Curs : Element_Lists.Cursor; begin Main_Loop : loop loop select accept Init do Station.Win.L := 3; Station.Win.C := 180; Station.Win.H := 40; Station.Win.W := 60; Station.Win.Frame_Type := Single_Line_Frame; Station.Win.Frame_Color := Blue; Station.Win.Close_Box_Color := Red; text_io.new_line; Station_Lock.Seize; text_io.new_line; Draw_Window(Station); text_io.new_line; Station_Lock.Release; text_io.new_line; end Init; or accept Start; exit; or accept Stop; or accept Halt; exit Main_Loop; or accept Create_Object (Object: in My_Classes.Object_Access) do declare Target : My_Classes.Object_Access := Copy(Object); begin Find(Object, Target, Goal_Path); if Integer(Length(Goal_Path)) >= 2 then Curs := First(Goal_Path); declare E : constant My_Classes.Object_Access := Element(curs); begin Work_Process.Add(E); null; end; Next(Curs); for I in 1..Integer(Length(Goal_Path))-1 loop declare E : constant My_Classes.Object_Access := Element(curs); Target : Abstracted_Access; begin Append(Path, E); end; Next(Curs); end loop; elsif Length(Goal_Path) /= 0 then Curs := First(Goal_Path); declare E : constant My_Classes.Object_Access := Element(curs); begin Append(Path, E); Work_Process.Add(E); end; end if; Element_Lists.Clear(Goal_Path); end; end Create_Object; or accept Create_Planning (start : in Time; Stop : in Time) do declare O : My_Classes.Object_Access; Target : My_Classes.Object_Access; begin O := new My_Planning.Planning_Obj; Target := new My_Planning.Planning_Obj; My_Planning.Planning_Obj(Target.all).Planning.start := start; My_Planning.Planning_Obj(O.all).Planning.Start := Start; My_Planning.Planning_Obj(Target.all).Planning.Stop := Stop; My_Planning.Planning_Obj(O.all).Planning.Stop := Stop; Work_Process.Add(Target); Find(O, Target, Goal_Path); if Integer(Length(Goal_Path)) >= 2 then Curs := First(Goal_Path); Next(Curs); for I in 1..Integer(Length(Goal_Path))-1 loop declare E : constant My_Classes.Object_Access := Element(curs); Target : Abstracted_Access; begin Append(Path, E); end; Next(Curs); end loop; elsif Length(Goal_Path) /= 0 then Curs := First(Goal_Path); declare E : constant My_Classes.Object_Access := Element(curs); begin Append(Path, E); end; end if; Element_Lists.Clear(Goal_Path); end; end Create_Planning; or accept Create_Event (Date : in Time;D : in Duration) do declare O : My_Classes.Object_Access; Target : My_Classes.Object_Access; begin O := new My_Event.Event_Obj; Target := new My_Event.Event_Obj; My_Event.Event_Obj(Target.all).Event.Date := Date; My_Event.Event_Obj(O.all).Event.Date := Date; My_Event.Event_Obj(Target.all).Event.D := D; My_Event.Event_Obj(O.all).Event.D := D; Work_Process.Add(Target); Find(O, Target, Goal_Path); if Integer(Length(Goal_Path)) >= 2 then Curs := First(Goal_Path); declare E : constant My_Classes.Object_Access := Element(curs); begin Work_Process.Add(E); null; end; Next(Curs); for I in 1..Integer(Length(Goal_Path))-1 loop declare E : constant My_Classes.Object_Access := Element(curs); Target : Abstracted_Access; begin Append(Path, E); end; Next(Curs); end loop; elsif Length(Goal_Path) /= 0 then Curs := First(Goal_Path); declare E : constant My_Classes.Object_Access := Element(curs); begin Append(Path, E); Work_Process.Add(E); end; end if; Element_Lists.Clear(Goal_Path); end; end Create_Event; end select; end loop; loop select accept Create_Object (Object: in My_Classes.Object_Access) do declare Target : My_Classes.Object_Access := Copy(Object); begin Find(Object, Target, Goal_Path); if Integer(Length(Goal_Path)) >= 2 then Curs := First(Goal_Path); declare E : constant My_Classes.Object_Access := Element(curs); begin Work_Process.Add(E); null; end; Next(Curs); for I in 1..Integer(Length(Goal_Path))-1 loop declare E : constant My_Classes.Object_Access := Element(curs); Target : Abstracted_Access; begin Append(Path, E); end; Next(Curs); end loop; elsif Length(Goal_Path) /= 0 then Curs := First(Goal_Path); declare E : constant My_Classes.Object_Access := Element(curs); begin Append(Path, E); Work_Process.Add(E); end; end if; Element_Lists.Clear(Goal_Path); end; end Create_Object; or accept Create_Planning (start : in Time; Stop : in Time) do declare O : My_Classes.Object_Access; Target : My_Classes.Object_Access; begin O := new My_Planning.Planning_Obj; Target := new My_Planning.Planning_Obj; My_Planning.Planning_Obj(Target.all).Planning.start := start; My_Planning.Planning_Obj(O.all).Planning.Start := Start; My_Planning.Planning_Obj(Target.all).Planning.Stop := Stop; My_Planning.Planning_Obj(O.all).Planning.Stop := Stop; Work_Process.Add(Target); Find(O, Target, Goal_Path); if Integer(Length(Goal_Path)) >= 2 then Curs := First(Goal_Path); Next(Curs); for I in 1..Integer(Length(Goal_Path))-1 loop declare E : constant My_Classes.Object_Access := Element(curs); Target : Abstracted_Access; begin Append(Path, E); end; Next(Curs); end loop; elsif Length(Goal_Path) /= 0 then Curs := First(Goal_Path); declare E : constant My_Classes.Object_Access := Element(curs); begin Append(Path, E); end; end if; Element_Lists.Clear(Goal_Path); end; end Create_Planning; or accept Create_Event (Date : in Time;D : in Duration) do declare O : My_Classes.Object_Access; Target : My_Classes.Object_Access; begin O := new My_Event.Event_Obj; Target := new My_Event.Event_Obj; My_Event.Event_Obj(Target.all).Event.Date := Date; My_Event.Event_Obj(O.all).Event.Date := Date; My_Event.Event_Obj(Target.all).Event.D := D; My_Event.Event_Obj(O.all).Event.D := D; Work_Process.Add(Target); Find(O, Target, Goal_Path); if Integer(Length(Goal_Path)) >= 2 then Curs := First(Goal_Path); declare E : constant My_Classes.Object_Access := Element(curs); begin Work_Process.Add(E); null; end; Next(Curs); for I in 1..Integer(Length(Goal_Path))-1 loop declare E : constant My_Classes.Object_Access := Element(curs); Target : Abstracted_Access; begin Append(Path, E); end; Next(Curs); end loop; elsif Length(Goal_Path) /= 0 then Curs := First(Goal_Path); declare E : constant My_Classes.Object_Access := Element(curs); begin Append(Path, E); Work_Process.Add(E); end; end if; Element_Lists.Clear(Goal_Path); end; end Create_Event; or accept Halt; exit Main_Loop; or accept Start; or accept Stop; exit; or accept Init; or delay 0.25; declare O : My_Classes.Object_Access; Target : My_Classes.Object_Access; begin O := Object_Rand.Random; Target := Object_Rand.Random; if Target.Class_name /= Planning and Target.Class_name /= content then Element_Lists.Clear(Goal_Path); Find(O, Target, Goal_Path); if Integer(Length(Goal_Path)) > 2 then Curs := First(Goal_Path); declare E : constant My_Classes.Object_Access := Element(curs); begin null; end; Next(Curs); for I in 1..Integer(Length(Goal_Path))-2 loop declare E : constant My_Classes.Object_Access := Element(curs); Target : Abstracted_Access; begin Target := new abstracted_Class ' (Abstracted_Class(E.all)); Append(Path, E); end; Next(Curs); end loop; elsif Length(Goal_Path) /= 0 then Curs := First(Goal_Path); declare E : constant My_Classes.Object_Access := Element(curs); begin Append(Path, E); Work_Process.Add(E); end; end if; end if; end; Station_Lock.Seize; Win_Index := 0; for I in 1 .. 38 loop Draw_Text(Station, I, 1, White, To_Wide_string((58 * ' '))); end loop; for I in 1..Length(Path) loop declare E : constant My_Classes.Object_Access := Element(Path, Integer(I)); begin E.Print(Station, Win_Index); end; end loop; Win_Index := 0; Station_Lock.Release; if Length(Path) > 20 then for I in 1..Length(Path)-20 loop Delete_First(Path); end loop; end if; end select; end loop; end loop Main_Loop; end Station_process; task Selector is entry Init; entry Halt; entry Stop; entry Start; end Selector; task body selector is Set : Object_Vectors.Vector; Step : Natural := 0; Wait : Natural := 0; begin Load_File("data/sets/content.txt", Content, Set); Load_File("data/sets/event.txt", Event, Set); Load_File("data/sets/job.txt", job, Set); declare subtype Set_Index is Positive range 1 .. Positive(Object_Vectors.Length(Set)); package Index_Rand is new Discrete_Random (Set_Index); Gen : Index_Rand.Generator; Object : My_Classes.Object_Access; O_Index : Set_Index; begin Index_Rand.Reset(Gen); Main_Loop : loop loop select accept Init; exit; or accept Halt; exit Main_Loop; or accept Stop; or accept Start; exit; end select; end loop; loop O_Index := Index_Rand.Random(Gen); Object := Element(Set, O_Index); Station_Process.Create_Object(Object); select accept Halt; exit Main_Loop; or accept Stop; exit; or accept Start; or delay 0.25; Reset(G); loop begin D := Random(G); if Integer(D * 100.0) > 0 then Choice := Integer(D * 100.0); exit; end if; end; end loop; if Choice > 0 and Choice <= Stock'Length then Ten_Choices (1) := Stock(Choice); Step := 1; begin Wait := Integer'Value(Ten_Choices(Step).all); exception when Constraint_Error => null; end; if Wait /= 0 then Station_Process.Create_Event(Date => Clock+(86400.0 * Wait), D => 43200.0); elsif Ten_Choices(Step).all = "janv" then if Ada.Calendar.Month(Clock) > 1 then Station_Process.Create_Planning (Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock)+1, 1, 1, 0.0), Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock)+1, 1, 28, 0.0)); else Station_Process.Create_Planning(Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock), 1, 1, 0.0), Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock), 1, 28, 0.0)); end if; elsif Ten_Choices(Step).all = "fev" then if Ada.Calendar.Month(Clock) > 2 then Station_Process.Create_Planning (Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock)+1, 2, 1, 0.0), Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock)+1, 2, 28, 0.0)); else Station_Process.Create_Planning(Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock), 2, 1, 0.0), Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock), 2, 28, 0.0)); end if; elsif Ten_Choices(Step).all = "mars" then if Ada.Calendar.Month(Clock) > 3 then Station_Process.Create_Planning (Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock)+1, 3, 1, 0.0), Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock)+1, 3, 28, 0.0)); else Station_Process.Create_Planning(Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock), 3, 1, 0.0), Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock), 3, 28, 0.0)); end if; elsif Ten_Choices(Step).all = "avril" then if Ada.Calendar.Month(Clock) > 4 then Station_Process.Create_Planning (Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock)+1, 4, 1, 0.0), Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock)+1, 4, 28, 0.0)); else Station_Process.Create_Planning(Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock), 4, 1, 0.0), Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock), 4, 28, 0.0)); end if; elsif Ten_Choices(Step).all = "mai" then if Ada.Calendar.Month(Clock) > 5 then Station_Process.Create_Planning (Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock)+1, 5, 1, 0.0), Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock)+1, 5, 28, 0.0)); else Station_Process.Create_Planning(Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock), 5, 1, 0.0), Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock), 5, 28, 0.0)); end if; elsif Ten_Choices(Step).all = "juin" then if Ada.Calendar.Month(Clock) > 6 then Station_Process.Create_Planning (Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock)+1, 6, 1, 0.0), Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock)+1, 6, 28, 0.0)); else Station_Process.Create_Planning(Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock), 6, 1, 0.0), Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock), 6, 28, 0.0)); end if; elsif Ten_Choices(Step).all = "juillet" then if Ada.Calendar.Month(Clock) > 7 then Station_Process.Create_Planning (Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock)+1, 7, 1, 0.0), Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock)+1, 7, 28, 0.0)); else Station_Process.Create_Planning(Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock), 7, 1, 0.0), Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock), 7, 28, 0.0)); end if; elsif Ten_Choices(Step).all = "aout" then if Ada.Calendar.Month(Clock) > 8 then Station_Process.Create_Planning (Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock)+1, 8, 1, 0.0), Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock)+1, 8, 28, 0.0)); else Station_Process.Create_Planning(Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock), 8, 1, 0.0), Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock), 8, 28, 0.0)); end if; elsif Ten_Choices(Step).all = "sept" then if Ada.Calendar.Month(Clock) > 9 then Station_Process.Create_Planning (Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock)+1, 9, 1, 0.0), Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock)+1, 9, 28, 0.0)); else Station_Process.Create_Planning(Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock), 9, 1, 0.0), Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock), 9, 28, 0.0)); end if; elsif Ten_Choices(Step).all = "oct" then if Ada.Calendar.Month(Clock) > 10 then Station_Process.Create_Planning (Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock)+1, 10, 1, 0.0), Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock)+1, 10, 28, 0.0)); else Station_Process.Create_Planning(Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock), 10, 1, 0.0), Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock), 10, 28, 0.0)); end if; elsif Ten_Choices(Step).all = "nov" then if Ada.Calendar.Month(Clock) > 11 then Station_Process.Create_Planning (Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock)+1, 11, 1, 0.0), Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock)+1, 11, 28, 0.0)); else Station_Process.Create_Planning(Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock), 11, 1, 0.0), Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock), 11, 28, 0.0)); end if; elsif Ten_Choices(Step).all = "dec" then if Ada.Calendar.Month(Clock) < 12 then Station_Process.Create_Planning(Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock), 12, 1, 0.0), Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock), 12, 28, 0.0)); else Station_Process.Create_Planning (Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock)+1, 12, 1, 0.0), Ada.Calendar.Time_Of(Ada.Calendar.Year(Clock)+1, 12, 28, 0.0)); end if; end if; end if; end select; end loop; end loop Main_Loop; end; end Selector; Win_Index : Natural := 0; begin Selector.Init; Work_Process.Init; Station_Process.Init; Planning_Win.Win.L := 3; Planning_Win.Win.C := 120; Planning_Win.Win.H := 20; Planning_Win.Win.W := 60; Planning_Win.Win.Frame_Type := Single_Line_Frame; Planning_Win.Win.frame_Color := Blue; Planning_Win.Win.Close_Box_Color := Red; Main_Loop: loop loop select accept Receive (Wchar : in Wide_Character); or accept Halt do Text_Io.Put_Line("Halting Workstation... Ah"); Selector.Halt; Text_Io.Put_Line("Selector halting"); Station_Process.Halt; Text_Io.Put_Line("Station halting"); Work_Process.Halt; Text_Io.Put_Line("Work halting"); Optimal_Path.Astar_task.Halt; Text_Io.Put_Line("Astart halting"); Plan_process.Halt; Text_Io.Put_Line("Planning halting"); end Halt; exit Main_loop; or accept Wake_Up(Top : in Natural) do Selector.Start; Put(Ansi_Tty_Control.Clear_Screen); W_Io.Put_Line("Workstation"); end Wake_Up; or accept Suspend; Selector.Stop; Station_Process.Stop; exit; or accept Page_Down; or accept Page_Up; or accept Up_Arrow do null; end Up_Arrow; or accept Down_Arrow do null; end Down_Arrow; or accept Left_Arrow; or accept Right_Arrow; or accept Begin_Of; or accept End_Of; or accept Del; or accept Overwrite; or delay 0.5; Station_Lock.Seize; Draw_Window(Work_Win); Win_Index := 0; for I in 1 .. 38 loop Draw_Text(Station, I, 1, White, To_Wide_string((58 * ' '))); end loop; for I in 1..Length(Path) loop declare E : constant My_Classes.Object_Access := Element(Path, Integer(I)); begin E.Print(Station, Win_Index); end; end loop; Win_Index := 0; for I in 1..Length (Work) loop declare E : constant My_Classes.Object_Access := Element(Work, Integer(I)); begin E.Print(Work_Win, Win_Index); if E.Class_Name = Event then if E.Event.Date < Clock then Object_Vectors.Clear(Work); Draw_Window(Work_Win); exit; end if; end if; end; end loop; Win_Index := 0; Station_Lock.Release; end select; end loop; loop select accept Halt do Text_Io.Put_Line("Halting Workstation... Arf"); Selector.Halt; Text_Io.Put_Line("Selector halting"); Station_Process.Halt; Text_Io.Put_Line("Station halting"); Work_Process.Halt; Text_Io.Put_Line("Work halting"); Optimal_Path.Astar_task.Halt; Text_Io.Put_Line("Astart halting"); Plan_process.Halt; Text_Io.Put_Line("Planning halting"); end Halt; exit Main_Loop; or accept Suspend; or accept Wake_Up(Top : in Natural) do Put(Ansi_Tty_Control.Clear_Screen); W_Io.Put_Line("Workstation"); Text_Io.Put_Line("Greetings " & Getenv("USER").all & "!"); Selector.Start; Station_Process.Start; end Wake_Up; exit; end select; end loop; end loop Main_Loop; W_Io.Put_Line("Workstation process halted"); end Workstation_Process; task body Space_Fighter_Process is subtype Space_X_Range is Positive range 1..App.Columns-4; package Space_X_Wrapping is new PragmARC.Wrapping(Space_X_Range); subtype Space_Y_Range is Positive range 1..App.Lines; package Space_Y_Wrapping is new PragmARC.Wrapping(Space_Y_Range); type Invider_Record; task type Invider_Process(Invider : access Invider_Record;Value : Natural) is entry Halt; end Invider_Process; type Invider_Record(Point : Positive) is limited record X : Space_X_Range := Columns-4; Y : Space_Y_Range := 3; Proc : Invider_Process(Invider_Record'Access, Point); end record; task body Invider_Process is begin loop select accept Halt; exit; or delay 0.1; Invider.X := Space_X_wrapping.Wrap_Pred(Invider.X); end select; end loop; end Invider_Process; type Weapon_Record; task type Weapon_Process (Weapon : access Weapon_Record) is entry Halt; end Weapon_Process; type Weapon_Record is limited record X : Space_X_Range := 5; Y : Space_Y_Range := 3; Launched : Boolean := False; Point : Natural := 0; Proc : Weapon_Process(Weapon_Record'Access); end record; task body Weapon_Process is begin loop select accept Halt; exit; or delay 0.05; if Weapon.Launched then Weapon.X := Space_X_Wrapping.Wrap_Succ(Weapon.X); end if; end select; end loop; end Weapon_Process; type Weapon_Array is array (Positive range <>) of access Weapon_Record; type Fighter_Record; task type Fighter_Process(Fighter : access Fighter_Record) is entry Up; entry Down; entry Speed(Factor : in Natural); entry Shot; entry Halt; entry Stop; entry Start; entry Refresh; end Fighter_Process; type Fighter_Record is limited record X : Space_X_Range := 4; Y : Space_Y_Range := App.Lines/2; Speed : Natural := 0; Charge : Natural := 250; Weapons : Weapon_Array(1..250); Weapon_Last : Natural := 0; Proc : Fighter_Process(Fighter_Record'Access); end record; task body Fighter_Process is begin Main_Loop : loop loop select accept Start; or accept Stop; exit; or accept Up do if Fighter.Y - 1 >= 4 then Fighter.Y := Fighter.Y - 1; end if; end Up; or accept Down do if (Fighter.Y + 1) < (App.Lines - 2) then Fighter.Y := Fighter.Y + 1; end if; end Down; or accept Speed(Factor : in Natural) do Fighter.Speed := Factor; end Speed; or accept Shot do if Fighter.Charge > 0 then if Fighter.Weapon_Last < Fighter.Weapons'Last then Fighter.Charge := Fighter.Charge - 1; Fighter.Weapons(Fighter.Weapon_Last+1) := new Weapon_Record; Fighter.Weapons(Fighter.Weapon_Last+1).Launched := True; Fighter.Weapons(Fighter.Weapon_Last+1).X := Fighter.X + 4; Fighter.Weapons(Fighter.Weapon_Last+1).Y := Fighter.Y; Fighter.Weapon_Last := Fighter.Weapon_Last + 1; end if; end if; end Shot; or accept Halt; exit Main_Loop; or accept Refresh do for Weapon in 1..Fighter.Weapon_Last loop if Fighter.Weapons(Weapon) /= null then if Fighter.Weapons(Weapon).Launched then Put(Position(Fighter.Weapons(Weapon).Y, Fighter.Weapons(Weapon).X) & '-'); if Fighter.Weapons(Weapon).X >= Space_X_Range'Last-1 then Fighter.Weapons(Weapon).Proc.Halt; Fighter.Weapons(Weapon) := null; for Last in Weapon+1..Fighter.Weapon_Last loop Fighter.Weapons(Last-1) := Fighter.Weapons(Last); end loop; Fighter.Weapon_Last := Fighter.Weapon_Last - 1; end if; end if; end if; end loop; end Refresh; end select; end loop; loop select accept Start; exit; or accept Stop; or accept Halt; exit Main_Loop; or accept Refresh; end select; end loop; end loop Main_Loop; end Fighter_Process; type Invider_Access is access Invider_Record; type Invider_Array is array (Positive range <>) of Invider_Access; Inviders : Invider_Array(1..10); Invider_Last : Natural := 0; Fighter : Fighter_Record; type Point_Array is array (1..10) of Natural; Points : constant Point_Array := (10, 20, 30, 40, 45, 50, 60, 65, 70, 80); subtype Point_Range is Positive range 1..10; subtype Valid_Line is Positive range 3..App.Lines-4; package Line_Rand is new Ada.Numerics.Discrete_Random(Valid_Line); package Point_Rand is new Ada.Numerics.Discrete_Random(Point_range); task Gen_Process is entry Halt; entry Start; entry Stop; end Gen_Process; task body Gen_Process is Line_Gen : Line_Rand.Generator; Point_Gen : Point_Rand.Generator; begin Line_Rand.Reset(Line_Gen); Point_Rand.Reset(Point_Gen); Main_Loop : loop loop select accept Halt; exit Main_Loop; or accept Start; exit; or accept Stop; end select; end loop; loop select accept Halt; exit Main_Loop; or accept Start; or accept Stop; exit; or delay 5.0; if Invider_Last < Inviders'Last then Inviders(Invider_Last + 1) := new Invider_Record(Points(Point_Rand.Random(Point_Gen))); Inviders(Invider_Last + 1).Y := Line_Rand.Random(Line_Gen); Invider_Last := Invider_Last + 1; end if; end select; end loop; end loop Main_Loop; end Gen_Process; task Ground_Process is entry Speed(Factor : in Natural); entry Up; entry Down; entry Weapon; entry Halt; entry Start; entry Stop; entry Refresh; end Ground_Process; task body Ground_Process is Charge : Natural := 0; begin Main_Loop : loop loop select accept Speed(Factor : in Natural); accept Weapon; or accept Halt; exit Main_Loop; or accept Start do Gen_Process.Start; end Start; exit; or accept Stop; or accept Up; or accept Down; or accept Refresh; end select; end loop; loop select accept Speed(Factor : in Natural) do Fighter.Speed := Factor; end Speed; or accept Up do Fighter.Proc.Up; end Up; or accept Down do Fighter.Proc.Down; end Down; or accept Weapon do Fighter.Proc.Shot; end Weapon; or accept Halt; exit Main_Loop; or accept Start; or accept Stop do Gen_Process.Stop; end Stop; exit; or accept Refresh do Put(Ansi_Tty_Control.Clear_Screen); for Invider in 1..Invider_Last loop for Weapon in 1..Fighter.Weapon_Last loop if Inviders(Invider) /= null then if Fighter.Weapons(Weapon) /= null then if Inviders(Invider).X = Fighter.Weapons(Weapon).X and Inviders(Invider).Y = Fighter.Weapons(Weapon).Y then Fighter.Charge := Fighter.Charge + Fighter.Weapons(Weapon).Point; if Fighter.Weapons(Weapon) /= null then Fighter.Weapons(Weapon).Proc.Halt; Fighter.Weapons(Weapon) := null; end if; if Inviders(Invider) /= null then Inviders(Invider).Proc.Halt; Inviders(Invider) := null; end if; for Last in Invider+1 .. Invider_Last loop Inviders(Last-1) := Inviders(Last); end loop; Invider_Last := Invider_Last - 1; end if; end if; end if; end loop; end loop; for Invider in 1..Invider_Last loop if Inviders(Invider) /= null then Inviders(invider).X := Space_X_Wrapping.Wrap_Pred(Inviders(invider).X); end if; end loop; Put(Position(Fighter.Y, Fighter.X) & "|-\-"); for Invider in 1..Invider_Last loop if Inviders(Invider) /= null then Put(Position(Inviders(Invider).Y-1, Inviders(Invider).X) & " __ "); Put(Position(Inviders(Invider).Y, Inviders(Invider).X) & '|' & Integer'Image(Inviders(Invider).Point) & '|'); Put(Position(Inviders(Invider).Y+1, Inviders(Invider).X) & " --"); end if; end loop; end Refresh; end select; end loop; end loop Main_Loop; end Ground_Process; Factor : Natural := 0; begin Main_Loop: loop loop select accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then null; else case Wchar is when '+' => Factor := Factor + 1; Ground_Process.Speed(Factor); when '-' => Factor := Factor - 1; Ground_Process.Speed(Factor); when ' ' => Ground_Process.Weapon; when others => null; end case; end if; end Receive; or accept Halt do null; end Halt; exit Main_loop; or accept Wake_Up(Top : in Natural) do Put(Ansi_Tty_Control.Clear_Screen); Ground_Process.Start; Fighter.Proc.Start; end Wake_Up; or accept Suspend do Ground_Process.Stop; Fighter.Proc.Stop; end Suspend; exit; or accept Page_Down; or accept Page_Up; or accept Up_Arrow do Ground_Process.Up; end Up_Arrow; or accept Down_Arrow do Ground_Process.Down; end Down_Arrow; or accept Left_Arrow; or accept Right_Arrow; or accept Begin_Of; or accept End_Of; or accept Del; or accept Overwrite; or delay 0.05; Ground_Process.Refresh; Fighter.Proc.Refresh; end select; end loop; loop select accept Halt do null; end Halt; exit Main_Loop; or accept Suspend do null; end Suspend; or accept Wake_Up(Top : in Natural) do Put(Ansi_Tty_Control.Clear_Screen); Ground_Process.Start; Fighter.Proc.Start; end Wake_Up; exit; end select; end loop; end loop Main_Loop; Gen_Process.Halt; Put_Line("Halting Ground"); Ground_Process.Halt; Put_Line("Halting Fighter"); Fighter.Proc.Halt; Put_Line("Halting inviders"); for Invider in 1..Invider_Last loop if Inviders(Invider) /= null then Inviders(Invider).Proc.Halt; end if; end loop; for Weapon in Fighter.Weapons'Range loop if Fighter.Weapons(Weapon) /= null then Fighter.Weapons(Weapon).Proc.Halt; end if; end loop; W_Io.Put_Line("Space Fighter process halted"); end Space_fighter_Process; use M.Accounts_Manager.Operation_Vectors; task body Bank_Process is Main_Win : Window_Record := (1, 1, App.Lines-3, App.Columns/2, White, The_Window); Top : Natural := 1; Line_Index : Natural := 0; Operation : Operation_Record; Buffer : M.Strings.Wide_String_Access; Line : M.Strings.Wide_String_Access := new Wide_String ' (""); Last : Natural := 0; Next : Natural := 0; begin Main_Loop: loop loop select accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(10) => declare Op : Operation_Record; Step : Step_Range := 0; begin Next := Wide_Fixed.Index(Line.all, ", "); Op.Label := new Wide_String ' (Line(Line'First..Next-1)); Last := Next + 2; Op.Date_Op := Clock; Next := Wide_Fixed.Index(Line.all, ":", Last); Step := Step_Range'Value(Handling.To_String(Line(Last..Next-1))); Op.Date_Val := Op.Date_Op + (86400.0 * Duration(Step)); Last := Next + 1; Op.sum := Sum_Range'Value(Handling.To_String(Line(Last..Line'last))); App.Bank.List := App.Bank.List & Op; App.Bank.Total := App.Bank.Total + Op.Sum; Wide_Free(Line); Line := new Wide_String ' (""); end; Put(Ansi_Tty_Control.Clear_Screen); Draw_Window(Main_Win); Draw_Text(Main_Win, 1, 1, White, "Num op, Label, Date op, Date val, Sum"); Draw_Text(Main_Win, 2, 1, White, "-------------------------------------------------------------------------------------------"); W_Io.New_Line; if Integer(Length(App.Bank.List)) > 0 then for I in Integer'Max(Line_Index-(App.Lines-5),1)..Integer(Length(App.Bank.List)) loop declare Op : Operation_Record := Element(App.Bank.List, Integer(I)); begin W_Io.Put_Line(Handling.To_Wide_String(Natural'Image(I)) & Wide_Character'Val(9) & Op.Label.all & Handling.To_Wide_String(((20-Op.Label'Length) * ' ')) & Wide_Character'Val(9) & Handling.To_Wide_string(Formatting.Image(Op.Date_Op)) & Wide_Character'Val(9) & Handling.To_Wide_String(Formatting.Image(Op.Date_val)) & Wide_Character'Val(9) & Handling.To_Wide_String(Float'Image(Op.Sum))); end; end loop; end if; when Wide_Character'Val(12) => Put(Ansi_Tty_Control.Clear_Screen); Draw_Window(Main_Win); Draw_Text(Main_Win, 1, 1, White, "Num op, Label, Date op, Date val, Sum"); Draw_Text(Main_Win, 2, 1, White, "-------------------------------------------------------------------------------------------"); W_Io.New_Line; if Integer(Length(App.Bank.List)) > 0 then for I in Integer'Max(Line_Index-(App.Lines-5),1)..Integer(Length(App.Bank.List)) loop declare Op : Operation_Record := Element(App.Bank.List, Integer(I)); begin W_Io.Put_Line(Handling.To_Wide_String(Natural'Image(I)) & Wide_Character'Val(9) & Op.Label.all & Handling.To_Wide_String(((20-Op.Label'Length) * ' ')) & Wide_Character'Val(9) & Handling.To_Wide_string(Formatting.Image(Op.Date_Op)) & Wide_Character'Val(9) & Handling.To_Wide_String(Formatting.Image(Op.Date_val)) & Wide_Character'Val(9) & Handling.To_Wide_String(Float'Image(Op.Sum))); end; end loop; end if; when Wide_Character'Val(127) => W_Io.Put(Handling.To_Wide_String(Position(App.Lines-1, Line'Length+7)) & ' ' & Wide_Character'Val(8)); Buffer := new Wide_String ' (Line(Line'First..Line'Last-1)); Wide_Free(Line); Line := new Wide_String ' (Buffer.all); Wide_Free(Buffer); when others => null; end case; else Buffer := new Wide_String ' (Line.all & Wchar); Wide_Free(Line); Line := new Wide_String ' (Buffer.all); Wide_Free(Buffer); end if; W_io.Put(Handling.To_Wide_String(Position(App.Lines-2, 80)) & "Total : " & Handling.To_Wide_String(Float'Image(App.Bank.Total))); W_io.Put(Handling.To_Wide_String(Position(App.Lines-1, 1)) & "Line : " & Line.all); end Receive; or accept Halt do null; end Halt; exit Main_loop; or accept Wake_Up(Top : in Natural) do Bank_Process.Top := Top; Initialize(Main_Win, 1, TOP+1, App.Lines-3, App.Columns/2, White, Cyan); Draw_Window(Main_Win); Draw_Text(Main_Win, 1, 1, White, "Num op, Label, Date op, Date val, Sum"); Draw_Text(Main_Win, 2, 1, White, "-------------------------------------------------------------------------------------------"); if Integer(Length(App.Bank.List)) > 0 then Line_Index := Integer'Min(Integer(Length(App.Bank.List)), App.Lines-5); for I in Integer'Max(Line_Index-(App.Lines-5), 1) ..Integer(Length(App.Bank.List)) loop declare Op : Operation_Record := Element(App.Bank.List, Integer(I)); begin W_Io.Put_Line(Handling.To_Wide_String(Position(Integer(I+3), Top+1)) & Handling.To_Wide_String(Natural'Image(I)) & Wide_Character'Val(9) & Op.Label.all & Handling.To_Wide_String(((20-Op.Label'Length) * ' ')) & Wide_Character'Val(9) & Handling.To_Wide_String(Formatting.Image(Op.Date_Op)) & Wide_Character'Val(9) & Handling.To_Wide_String(Formatting.Image(Op.Date_Val)) & Wide_Character'Val(9) & Handling.To_Wide_String(Float'Image(Op.Sum))); end; end loop; end if; W_io.Put(Handling.To_Wide_String(Position(App.Lines-3, Top+80)) & "Total : " & Handling.To_Wide_String(Float'Image(App.Bank.Total))); W_Io.Put(Handling.To_Wide_String(Position(App.Lines-1, Top+1)) & "Line : " & Line.all); end Wake_Up; or accept Suspend; exit; or accept Page_Down do if Line_Index + ((App.Lines - 5) / 2) <= Integer(Length(App.Bank.List)) then Line_Index := Integer'Min(Integer(Length(App.Bank.List)), Line_Index + ((App.Lines - 5) / 2)); end if; Put_Line(Position(1, Top+1) & "Num op, Label, Date op, Date val, Sum"); Put_Line(Position(2, Top+1) & "-------------------------------------------------------------------------------------------"); if Integer(Length(App.Bank.List)) > 0 then for I in Integer'Max(Line_Index-(App.Lines-5), 1)..Integer(Length(App.Bank.List)) loop declare Op : Operation_Record := Element(App.Bank.List, Integer(I)); begin W_Io.Put_Line(Handling.To_Wide_String(Position(Integer(I+3), Top+1)) & Handling.To_Wide_String(Natural'Image(I)) & Wide_Character'Val(9) & Op.Label.all & Handling.To_Wide_String(((20-Op.Label'Length) * ' ')) & Wide_Character'Val(9) & Handling.To_Wide_String(Formatting.Image(Op.Date_Op)) & Wide_Character'Val(9) & Handling.To_Wide_String(Formatting.Image(Op.Date_val)) & Wide_Character'Val(9) & Handling.To_Wide_String(Float'Image(Op.Sum))); end; end loop; end if; W_io.Put(Handling.To_Wide_String(Position(App.Lines-3, Top+80)) & "Total : " & Handling.To_Wide_String(Float'Image(App.Bank.Total))); W_Io.Put(Handling.To_Wide_String(Position(App.Lines-1, Top+1)) & "Line : " & Line.all); end Page_Down; or accept Page_Up do if Line_Index - ((App.Lines - 5) / 2) > 0 then Line_Index := Line_Index - ((App.Lines - 5) / 2); else Line_Index := 0; end if; Put_Line(Position(1, Top+1) & "Num op, Label, Date op, Date val, Sum"); Put_Line(Position(2, Top+1) & "-------------------------------------------------------------------------------------------"); if Integer(Length(App.Bank.List)) > 0 then for I in Integer'Max(Line_Index-(App.Lines-5), 1)..Integer(Length(App.Bank.List)) loop declare Op : Operation_Record := Element(App.Bank.List, Integer(I)); begin W_Io.Put_Line(Handling.To_Wide_String(Position(Integer(I+3), Top+1)) & Handling.To_Wide_String(Natural'Image(I)) & Wide_Character'Val(9) & Op.Label.all & Handling.To_Wide_String(((20-Op.Label'Length) * ' ')) & Wide_Character'Val(9) & Handling.To_Wide_String(Formatting.Image(Op.Date_Op)) & Wide_Character'Val(9) & Handling.To_Wide_String(Formatting.Image(Op.Date_val)) & Wide_Character'Val(9) & Handling.To_Wide_String(Float'Image(Op.Sum))); end; end loop; end if; W_io.Put(Handling.To_Wide_String(Position(App.Lines-3, Top+80)) & "Total : " & Handling.To_Wide_String(Float'Image(App.Bank.Total))); W_Io.Put(Handling.To_Wide_String(Position(App.Lines-1, Top+1)) & "Line : " & Line.all); end Page_Up; or accept Up_Arrow do null; end Up_Arrow; or accept Down_Arrow do null; end Down_Arrow; or accept Left_Arrow; or accept Right_Arrow; or accept Begin_Of; or accept End_Of; or accept Del; or accept Overwrite; end select; end loop; loop select accept Halt; exit Main_Loop; or accept Suspend; or accept Wake_Up(Top : in Natural) do Bank_Process.Top := Top; Initialize(Main_Win, 1, TOP+1, App.Lines-3, App.Columns/2, White, Cyan); Draw_Window(Main_Win); Draw_Text(Main_Win, 1, 1, White, "Num op, Label, Date op, Date val, Sum"); Draw_Text(Main_Win, 2, 1, White, "-------------------------------------------------------------------------------------------"); if Integer(Length(App.Bank.List)) > 0 then Line_Index := Integer'Min(Integer(Length(App.Bank.List)), App.Lines-5); for I in Integer'Max(Line_Index-(App.Lines-5),1)..Integer(Length(App.Bank.List)) loop declare Op : Operation_Record := Element(App.Bank.List, Integer(I)); begin W_Io.Put_Line(Handling.To_Wide_String(Position(Integer(I+3), Top+1)) & Handling.To_Wide_String(Natural'Image(I)) & Wide_Character'Val(9) & Op.Label.all & Handling.To_Wide_String(((20-Op.Label'Length) * ' ')) & Wide_Character'Val(9) & Handling.To_Wide_String(Formatting.Image(Op.Date_Op)) & Wide_Character'Val(9) & Handling.To_Wide_String(Formatting.Image(Op.Date_val)) & Wide_Character'Val(9) & Handling.To_Wide_String(Float'Image(Op.Sum))); end; end loop; end if; W_io.Put(Handling.To_Wide_String(Position(App.Lines-3, Top+80)) & "Total : " & Handling.To_Wide_String(Float'Image(App.Bank.Total))); W_Io.Put(Handling.To_Wide_String(Position(App.Lines-1, Top+1)) & "Line : " & Line.all); end Wake_Up; exit; end select; end loop; end loop Main_Loop; --W_Io.Put_Line("Bank process halted"); end Bank_Process; subtype Menu_Range is Positive range 1..21; type Menu_List is array (Menu_Range) of Os_Lib.String_Access; Main_Menu : constant Menu_List := (new String ' ("Projects menu"), new String ' (Mode_Enum'Image(Mode_Enum'Val(1))), new String ' (Mode_Enum'Image(Mode_Enum'Val(2))), new String ' (Mode_Enum'Image(Mode_Enum'Val(3))), new String ' (Mode_Enum'Image(Mode_Enum'Val(4))), new String ' (Mode_Enum'Image(Mode_Enum'Val(5))), new String ' (Mode_Enum'Image(Mode_Enum'Val(6))), new String ' (Mode_Enum'Image(Mode_Enum'Val(7))), new String ' (Mode_Enum'Image(Mode_Enum'Val(8))), new String ' (Mode_Enum'Image(Mode_Enum'Val(9))), new String ' (Mode_Enum'Image(Mode_Enum'Val(10))), new String ' (Mode_Enum'Image(Mode_Enum'Val(11))), new String ' (Mode_Enum'Image(Mode_Enum'Val(12))), new String ' (Mode_Enum'Image(Mode_Enum'Val(13))), new String ' (Mode_Enum'Image(Mode_Enum'Val(14))), new String ' (Mode_Enum'Image(Mode_Enum'Val(15))), new String ' (Mode_Enum'Image(Mode_Enum'Val(16))), new String ' (Mode_Enum'Image(Mode_Enum'Val(17))), new String ' (Mode_Enum'Image(Mode_Enum'Val(18))), new String ' (Mode_Enum'Image(Mode_Enum'Val(19))), new String ' (Mode_Enum'Image(Mode_Enum'Val(20)))); task body Menu_Process is Menu_Index : Menu_Range := 1; subtype Line_Type is String(1..48); Title : Line_Type := (others => Character'Val(32)); Item : Line_Type := (others => Character'Val(32)); Menu_Win : Window_Record := (1, 1, App.Lines, App.Columns/2, Blue, The_Window); type Project_List is array (Positive range 1..App.Lines-8) of Os_Lib.String_Access; Project_Last : natural := 0; Projects_Menu : Project_List := (1 => new String ' ("Main menu"), others => null); procedure Menu_Print(Win : in Window_Record; Selected : in Menu_Range) is begin Draw_Window(Win); Fixed.Move("Main menu", Title, Error, Left); Draw_Text(Win, 3, App.Columns/4-8, White, Handling.To_Wide_String(Title)); for Iter in Main_Menu'Range loop Item := (others => Character'Val(32)); Fixed.Move(Main_Menu(Iter).all, Item, Error, Left); if Iter /= Selected then Draw_Text(Win, Iter*2+5, App.Columns/4-8, White, Handling.To_Wide_String(Item)); else Enlight_Draw_Text(Win, Iter*2+5, App.Columns/4-8, White, Handling.To_Wide_String(Item)); Text_Io.Put(Normal_Mode); end if; end loop; end Menu_Print; procedure Projects_Print(Win : in Window_Record; Selected : in Positive) is begin Draw_Window(Win); Fixed.Move("Projects menu", Title, Error, Left); Draw_Text(Win, 3, App.Columns/4-8, White, Handling.To_Wide_String(Title)); for Iter in 1..Project_Last loop Item := (others => Character'Val(32)); Fixed.Move(Projects_Menu(Iter).all, Item, Error, Left); if Iter /= Selected then Draw_Text(Win, Iter*2+5, App.Columns/4-8, White, Handling.To_Wide_String(Item)); else Enlight_Draw_Text(Win, Iter*2+5, App.Columns/4-8, White, Handling.To_Wide_String(Item)); Text_Io.Put(Normal_Mode); end if; end loop; end Projects_Print; Is_Projects : Boolean := False; begin Initialize(Menu_Win, 1, 1, App.Lines, App.Columns/2, Blue, White); Main_Loop: loop loop select when not Is_Projects => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(10) => if Menu_Index = 1 then Projects_Print(Menu_Win, Menu_Index); Is_Projects := True; elsif Menu_Index /= 11 then App.Desktop(2) := App.Desktop(1); App.Desktop(1) := Functions(Menu_Index-1); App.Mode := Mode_Enum'Val(Menu_Index-1); end if; when others => null; end case; end if; end Receive; if App.Desktop(1) /= null then case App.Desktop(1).Name is when None => None_Record(App.Desktop(1).all).Proc.Wake_Up(0); when Log => Logs_Record(App.Desktop(1).all).Proc.Wake_Up(0); when MoneyBox => Moneybox_Record(App.Desktop(1).all).Proc.Wake_up(0); when Activity => Activity_Record(App.Desktop(1).all).Proc.Wake_up(0); when Stocks => Stocks_Record(App.Desktop(1).all).Proc.Wake_up(0); when Bank => bank_Record(App.Desktop(1).all).Proc.Wake_up(0); when Planning => Planning_Record(App.Desktop(1).all).Proc.Wake_up(0); when Library => Library_Record(App.Desktop(1).all).Proc.Wake_up(0); when Manager => Manager_Record(App.Desktop(1).all).Proc.Wake_up(0); when Contacts => Contacts_Record(App.Desktop(1).all).Proc.Wake_up(0); when Organizer => Organizer_Record(App.Desktop(1).all).Proc.Wake_up(0); when Dialog => Vbrain_Record(App.Desktop(1).all).Proc.Wake_up(0); when Navigation => Master_Record(App.Desktop(1).all).Proc.Wake_up(0); when Engineer => Engine_Record(App.Desktop(1).all).Proc.Wake_up(0); when Devel => Devel_Record(App.Desktop(1).all).Proc.Wake_up(0); when Admin=> WOPR_Record(App.Desktop(1).all).Proc.Wake_up(0); when Terminator => Workstation_Record(App.Desktop(1).all).Proc.Wake_up(0); when Joshua => Space_Fighter_Record(App.Desktop(1).all).Proc.Wake_up(0); when Entreprise => Person_Record(App.Desktop(1).all).Proc.Wake_up(0); when Process => World_Record(App.Desktop(1).all).Proc.Wake_up(0); when others => null; end case; end if; or when Is_Projects => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(10) => if Menu_Index = 1 then Menu_Print(Menu_Win, Menu_Index); Is_Projects := False; else declare Project_Name : String := Projects_Menu(Menu_Index).all(1..Index(Projects_Menu(Menu_Index).all, "-", Backward)-1); Success : Boolean := False; Args : Argument_List_Access; Args_String : Os_Lib.String_Access; begin Text_Io.New_Line; Text_Io.Put_Line("Program name : " & Projects_Menu(Menu_Index).all & "/bin/" & Project_Name); Text_Io.Put("Arguments :"); begin Args_String := new String ' (Text_Io.Get_Line); begin Args := Argument_String_To_List(Args_String.all); Normalize_Arguments(Args.all); Change_Dir(Projects_Menu(Menu_Index).all); Put(Ansi_Tty_Control.Clear_Screen); Spawn("bin/" & Project_Name, Args.all, Success); Change_Dir(".."); end; exception when others => null; end; Projects_Print(Menu_Win, Menu_Index); end; end if; when others => null; end case; end if; end Receive; or accept Halt; exit Main_loop; or accept Wake_Up(Top : in Natural) do Project_Last := 1; Menu_Index := 1; Menu_Print(Menu_Win, Menu_index); Is_Projects := False; declare Curs : Projects_Dll.Cursor := First(App.Projects.List); begin if not Projects_Dll.Is_Empty(App.Projects.List) then Project_Last := Natural(Projects_Dll.Length(App.Projects.List)); for Project in 1..Projects_Dll.Length(App.Projects.List)-1 loop declare E : M.Project.Project_Access := Projects_Dll.Element(curs); begin if E /= null then Projects_Menu(Integer(Project)+1) := new String ' (E.Project_Name.all & '-' & To_String(E.Version)); end if; end; Projects_Dll.Next(Curs); end loop; end if; end; end Wake_Up; or accept Suspend; exit; or accept Page_Down; or accept Page_Up; or when not Is_Projects => accept Up_Arrow do if Menu_Index > 1 then Menu_Index := Menu_Index - 1; end if; end Up_Arrow; Menu_Print(Menu_Win, Menu_Index); or when not Is_Projects => accept Down_Arrow do if Menu_Index < Menu_Range'Last then Menu_Index := Menu_Index + 1; end if; end Down_Arrow; Menu_Print(Menu_Win, Menu_Index); or when Is_Projects => accept Up_Arrow do if Menu_Index > 1 then Menu_Index := Menu_Index - 1; end if; end Up_Arrow; Projects_Print(Menu_Win, Menu_Index); or when Is_Projects => accept Down_Arrow do if Menu_Index < Project_Last then Menu_Index := Menu_Index + 1; end if; end Down_Arrow; Projects_Print(Menu_Win, Menu_Index); or accept Left_Arrow; or accept Right_Arrow; or accept Begin_Of; or accept End_Of; or accept Del; or accept Overwrite; end select; end loop; loop select accept Halt; exit Main_Loop; or accept Suspend; or accept Wake_Up(Top : in Natural) do Project_Last := 1; Menu_Index := 1; Menu_Print(Menu_Win, Menu_index); Is_Projects := False; declare Curs : Projects_Dll.Cursor := First(App.Projects.List); begin if not Projects_Dll.Is_Empty(App.Projects.List) then Project_Last := Natural(Projects_Dll.Length(App.Projects.List)); for Project in 1..Projects_Dll.Length(App.Projects.List)-1 loop declare E : M.Project.Project_Access := Projects_Dll.Element(Curs); begin if E /= null then Projects_Menu(Integer(Project)+1) := new String ' (E.Project_Name.all & '-' & To_String(E.Version)); end if; end; Projects_Dll.Next(Curs); end loop; end if; end; end Wake_Up; exit; end select; end loop; end loop Main_Loop; --W_Io.Put_Line("Menu process halted"); end Menu_Process; procedure Highlight_Contact_Draw (Obj : in Profile_Class; Line : in Positive;Width : in Positive; Top : in Natural) is Win : Window_Record := (Line, Top+2, 7, Width, Blue, The_Window); begin Initialize(Win, Line, Top+2, 7, Width, Blue, White); Enlight_Window(Win); Text_Io.Put(Normal_Mode); Draw_Text(Win, 1, 1, White, "Name : " & Obj.Info.Name.all); Draw_Text(Win, 2, 1, White, "Born : " & Handling.To_Wide_String(Formatting.Image(Obj.Born))); Draw_Text(Win, 3, 1, White, "Addr : " & Obj.Addr.all); Draw_Text(Win, 4, 1, White, "Phone : " & Obj.Phone.all); Draw_Text(Win, 5, 1, White, "Email : " & Obj.Email.all); end Highlight_Contact_Draw; procedure Contact_Draw (Obj : in Profile_Class; Line : in Positive;Width : in Positive; Top : in Natural) is Win : Window_Record := (Line, Top+2, 7, Width, Blue, The_Window); begin Initialize(Win, Line, Top+2, 7, Width, Blue, White); Draw_Window(Win); Draw_Text(Win, 1, 1, White, "Name : " & Obj.Info.Name.all); Draw_Text(Win, 2, 1, White, "Born : " & Handling.To_Wide_String(Formatting.Image(Obj.Born))); Draw_Text(Win, 3, 1, White, "Addr : " & Obj.Addr.all); Draw_Text(Win, 4, 1, White, "Phone : " & Obj.Phone.all); Draw_Text(Win, 5, 1, White, "Email : " & Obj.Email.all); end Contact_Draw; procedure Contacts_Draw (Contacts : in Abstract_Vectors.Vector;Index : in Natural; Width : in Positive; Top : in Natural) is Count : Natural := 1; begin if Abstract_Vectors.Is_empty(Contacts) then return; end if; for Contact in Index..natural'Min(Index + (App.Lines-5) / 7, Integer(Abstract_Vectors.Length(Contacts))) loop declare E : Abstract_Access := Abstract_Vectors.Element(Contacts, Abstract_Index(Contact)); begin Contact_Draw(Profile_Class(E.all), Count+1, width, Top); Count := Count + 7; end; end loop; end Contacts_Draw; procedure To_contacts (Obj : in Abstract_Access;Vector : in out Abstract_Vectors.Vector) is begin if Obj = null then return; end if; if Obj.all in Profile_Class then Vector := Vector & Obj; end if; if Abstract_Vectors.Length(Obj.Childs) /= 0 then for Child in 1..Abstract_Vectors.Length(Obj.Childs) loop declare E : constant Abstract_Access := Abstract_Vectors.Element(Obj.Childs, Abstract_Index(Child)); begin To_Contacts(E, Vector); end; end loop; end if; end To_Contacts; function Name_Inf (Left, Right : in Abstract_Access) return Boolean is begin if Left = null or Right = null then raise Program_Error; end if; if Left.Info.Name = null or Right.Info.Name = null then raise Program_Error; end if; return Left.Info.Name.all < Right.Info.Name.all; end Name_inf; package Name_Sorting is new Abstract_Vectors.Generic_Sorting(Name_inf); task body Contacts_Process is Main_Win : Window_Record := (1, 1, App.Lines-3, App.Columns/2, White, The_Window); Contacts : Abstract_Vectors.Vector; Contact_Index : Natural := 1; begin Main_Loop: loop loop select accept Receive (Wchar : in Wide_Character); or accept Halt; exit Main_Loop; or accept Wake_Up(Top : in Natural) do Initialize(Main_Win, 1, TOP+1, App.Lines-3, App.Columns/2, White, Cyan); Enlight_Window(Main_Win); Text_Io.Put(Normal_Mode); Contacts := Abstract_Vectors.Empty_Vector; To_Contacts(App.Terminal.Root, Contacts); Contact_Index := 1; if Abstract_Vectors.Length(Contacts) /= 0 then Name_Sorting.Sort(Contacts); Contacts_Draw(Contacts, Contact_Index, App.Columns/2-2, Top); end if; end Wake_Up; or accept Suspend; exit; or accept Page_Down; or accept Page_Up; or accept Up_Arrow do If Contact_Index > 1 then Contact_Index := Contact_Index - 1; Enlight_Window(Main_Win); Text_Io.Put(Normal_Mode); Contacts_Draw(Contacts, Contact_Index, App.Columns/2-2, 0); end if; end Up_Arrow; or accept Down_Arrow do if Abstract_Vectors.Length(Contacts) /= 0 then if Contact_Index + 1 < Integer(Abstract_Vectors.Length(Contacts)) then Contact_Index := Contact_Index + 1; Enlight_Window(Main_Win); Text_Io.Put(Normal_Mode); Contacts_Draw(Contacts, Contact_Index, App.Columns/2-2, 0); end if; end if; end Down_Arrow; or accept Left_Arrow; or accept Right_Arrow; or accept Begin_Of; or accept End_Of; or accept Del; or accept Overwrite; end select; end loop; loop select accept Halt; exit Main_Loop; or accept Suspend; or accept Wake_Up(Top : in Natural) do Initialize(Main_Win, 1, TOP+1, App.Lines-3, App.Columns/2, White, Cyan); Enlight_Window(Main_Win); Text_Io.Put(Normal_Mode); Contacts := Abstract_Vectors.Empty_Vector; To_Contacts(App.Terminal.Root, Contacts); Contact_Index := 1; if Abstract_Vectors.Length(Contacts) /= 0 then Name_Sorting.Sort(Contacts); Contacts_Draw(Contacts, Contact_Index, App.Columns/2-2, Top); end if; end Wake_Up; exit; end select; end loop; end loop Main_Loop; --W_Io.Put_Line("Contacts process halted"); end Contacts_Process; --------------------------------------------------------- -- Menu library -- type Library_Step_Enum is (Menu, Rent, Back, List); subtype Line_Type is String(1..48); Title : Line_Type := (others => Character'Val(32)); Item : Line_Type := (others => Character'Val(32)); Menu_Win : Window_Record := (1, 1, App.Lines, App.Columns/2, Blue, The_Window); procedure Menu_Print(Win : in Window_Record; Selected : in Library_step_Enum) is begin Draw_Window(Win); Fixed.Move("Library menu", Title, Error, Left); Draw_Text(Win, 3, App.Columns/4-8, White, Handling.To_Wide_String(Title)); for Iter in Library_step_Enum'Val(1) .. Library_Step_Enum'Last loop Item := (others => Character'Val(32)); Fixed.Move(Library_Step_Enum'Image(Iter), Item, Error, Left); if Iter /= Selected then Draw_Text(Win, Library_step_Enum'Pos(Iter)*2+5, App.Columns/4-8, White, Handling.To_Wide_String(Item)); else Enlight_Draw_Text(Win, Library_step_Enum'Pos(Iter)*2+5, App.Columns/4-8, White, Handling.To_Wide_String(Item)); Text_Io.Put(Normal_Mode); end if; end loop; end Menu_Print; ------------------------------------------------------------------------------------------------------------------ -- -- procedure Highlight_Media_Draw (Obj : Abstract_Access; Line : in Positive;Width : in Positive; Top : in Natural) is Win : Window_Record := (Line, Top+2, 4, Width, Blue, The_Window); begin Initialize(Win, Line, Top+2, 6, Width, Blue, White); Enlight_Window(Win); Text_Io.Put(Normal_Mode); Draw_Text(Win, 1, 1, White, "Title : " & Obj.Info.Name.all); Draw_Text(Win, 2, 1, White, "Author : " & Obj.Author.all); Draw_Text(Win, 3, 1, White, "Editor : " & Obj.Editor.all); end Highlight_Media_Draw; procedure Media_Draw (Obj : Abstract_Access; Line : in Positive;Width : in Positive; Top : in Natural) is Win : Window_Record := (Line, Top+2, 4, Width, Blue, The_Window); begin Initialize(Win, Line, Top+2, 6, Width, Blue, White); Draw_Window(Win); Draw_Text(Win, 1, 1, White, "Title : " & Obj.Info.Name.all); Draw_Text(Win, 2, 1, White, "Author : " & Obj.Author.all); Draw_Text(Win, 3, 1, White, "Editor : " & Obj.Editor.all); end Media_Draw; procedure Library_Draw (Library : in Abstract_Vectors.Vector;Line : in Positive; Index : in Natural; Width : in Positive; Top : in Natural) is Count : Natural := 1; begin if Abstract_Vectors.Is_empty(Library) then return; end if; for Media in Index..natural'Min(Index + (App.Lines-5) / 5, Integer(Abstract_Vectors.Length(Library))) loop declare E : Abstract_Access := Abstract_Vectors.Element(Library, Abstract_Index(Media)); begin if Media = line then Highlight_Media_Draw(E, Count+1, width, Top); else Media_Draw(E, Count+1, width, Top); end if; Count := Count + 5; end; end loop; end Library_Draw; procedure List_Draw (Library : in Abstract_Vectors.Vector;Line : in Positive; Index : in Natural; Width : in Positive; Top : in Natural) is Count : Natural := 1; begin if Abstract_Vectors.Is_empty(Library) then return; end if; for Media in Index..natural'Min(Index + (App.Lines-5) / 5, Integer(Abstract_Vectors.Length(Library))) loop declare E : Abstract_Access := Abstract_Vectors.Element(Library, Abstract_Index(Media)); begin if Media = line then Highlight_Media_Draw(E, Count+1, width, Top); else Media_Draw(E, Count+1, width, Top); end if; Count := Count + 5; end; end loop; end List_Draw; procedure To_Library (Obj : in Abstract_Access;Vector : in out Abstract_Vectors.Vector) is begin if Obj = null then return; end if; if Obj.all in DVD_Class | CDROM_Class | Book_Class then if Obj.Owner = 0 then Vector := Vector & Obj; end if; end if; if Abstract_Vectors.Length(Obj.Childs) >= 1 then for Child in 1..Abstract_Vectors.Length(Obj.Childs) loop declare E : constant Abstract_Access := Abstract_Vectors.Element(Obj.Childs, Abstract_Index(Child)); begin To_Library(E, Vector); end; end loop; end if; end To_Library; procedure To_List (Obj : in Abstract_Access;Vector : in out Abstract_Vectors.Vector) is begin if Obj = null then return; end if; if Obj.all in DVD_Class | CDROM_Class | Book_Class then if Obj.Owner /= 0 then Vector := Vector & Obj; end if; end if; if Abstract_Vectors.Length(Obj.Childs) >= 1 then for Child in 1..Abstract_Vectors.Length(Obj.Childs) loop declare E : constant Abstract_Access := Abstract_Vectors.Element(Obj.Childs, Abstract_Index(Child)); begin To_List(E, Vector); end; end loop; end if; end To_List; function New_Wide_String (Title : in Wide_String; Label : in Wide_String; Length : in Positive; Line, Col : in Positive; Print : in Boolean) return Wide_String is Line_Win : Ansi_Windows.Window_Type := (Line, Col, 5, Label'Length+3+Length+4, Ansi_Windows.Single_Line_Frame, Cyan, Yellow); Wline : M.Strings.Wide_String_Access := new Wide_String ' (""); Buff : M.Strings.Wide_String_Access; Wchar : Wide_Character := Wide_Character'Val(32); begin loop Ansi_Windows.Draw_Window(line_Win); Ansi_Windows.Draw(line_Win, 1, Line_Win.W/2-Title'length/2, yellow, Title); Ansi_Windows.Draw(line_Win, 2, 2, cyan, Label); if Wline /= null and then Wline'Length > 0 then if Print then Ansi_Windows.Draw(line_Win, 2, 2+Label'Length, white, Wline.all); else Ansi_Windows.Draw(line_Win, 2, 2+Label'Length, red, Handling.To_Wide_String((Wline'Length * '*'))); end if; end if; W_Io.Get_Immediate(Wchar); if Is_control(Wchar) then case Wchar is when Wide_Character'Val(10) => exit; when Wide_Character'Val(12) => null; when Wide_Character'Val(27) => raise W_Io.End_Error; when Wide_Character'Val(127) => if Wline /= null and then Wline'Length > 0 then Buff := new Wide_String ' (Wline(Wline'First..Wline'Last-1)); Wide_Free(Wline); Wline := new Wide_String ' (Buff.all); Wide_Free(Buff); else W_Io.Put(Wide_Character'Val(7)); end if; when others => null; end case; else if Wline /= null and then Wline'Length >= Length then W_Io.Put(Wide_Character'Val(7)); else Buff := new Wide_String ' (Wline.all & Wchar); Wide_Free(Wline); Wline := new Wide_String ' (Buff.all); Wide_Free(Buff); end if; end if; end loop; return Wline.all; end New_Wide_String; type Library_Mode_Enum is (None, Contact, Media); task body Library_Process is Main_Win : Window_Record := (1, 1, App.Lines-3, App.Columns/2, White, The_Window); Library : Abstract_Vectors.Vector; Media_Index : Natural := 1; Line : Natural := 1; Top : natural := 1; Step : Library_Step_Enum := Menu; Menu_Index : Natural := 1; Contacts : Abstract_Vectors.Vector; Contact_Index : Natural := 1; Library_Mode : Library_Mode_Enum := None; begin Main_Loop: loop loop select when Step = Menu => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(10) => case Menu_Index is when 1 => Initialize(Main_Win, 1, TOP+1, App.Lines-3, App.Columns/2, White, Cyan); Enlight_Window(Main_Win); Text_Io.Put(Normal_Mode); Library := Abstract_Vectors.Empty_Vector; To_Library(App.Terminal.Root, Library); Media_Index := 1; if Abstract_Vectors.Length(Library) /= 0 then Library_Draw(Library, Line, Media_Index, App.Columns/2-2, Top); end if; Step := Rent; Library_Mode := Media; when 2 => Initialize(Main_Win, 1, TOP+1, App.Lines-3, App.Columns/2, White, Cyan); Enlight_Window(Main_Win); Text_Io.Put(Normal_Mode); Contact_Index := 1; if Abstract_Vectors.Length(Contacts) /= 0 then Name_Sorting.Sort(Contacts); Contacts_Draw(Contacts, Contact_Index, App.Columns/2-2, Top); end if; Step := Back; Library_Mode := Contact; when 3 => Initialize(Main_Win, 1, TOP+1, App.Lines-3, App.Columns/2, White, Cyan); Enlight_Window(Main_Win); Text_Io.Put(Normal_Mode); Library := Abstract_Vectors.Empty_Vector; To_List(App.Terminal.Root, Library); Media_Index := 1; Step := List; Library_Mode := Media; if Abstract_Vectors.Length(Library) /= 0 then List_Draw(Library, Line, Media_Index, App.Columns/2-2, Top); end if; when others => null; end case; when others => null; end case; end if; end Receive; or when Step = Rent and Library_Mode = Media => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(10) => App.Rented := Abstract_Vectors.Element(Library, Abstract_Index(line)); if App.Rented.Owner = 0 then Initialize(Main_Win, 1, TOP+1, App.Lines-3, App.Columns/2, White, Cyan); Enlight_Window(Main_Win); Text_Io.Put(Normal_Mode); Contacts := Abstract_Vectors.Empty_Vector; To_Contacts(App.Terminal.Root, Contacts); Contact_Index := 1; if Abstract_Vectors.Length(Contacts) /= 0 then Name_Sorting.Sort(Contacts); Contacts_Draw(Contacts, Contact_Index, App.Columns/2-2, Top); end if; Library_Mode := Contact; else declare Seq : Wide_String := New_Wide_String (Title => "Media not avaible", Label => "Press ""enter"" to continue", Length => 2, Line => 3, Col => 3, Print => True); begin Initialize(Main_Win, 1, TOP+1, App.Lines-3, App.Columns/2, White, Cyan); Enlight_Window(Main_Win); Text_Io.Put(Normal_Mode); Library := Abstract_Vectors.Empty_Vector; To_Library(App.Terminal.Root, Library); Media_Index := 1; if Abstract_Vectors.Length(Library) /= 0 then Library_Draw(Library, Line, Media_Index, App.Columns/2-2, Top); end if; end; end if; when others => null; end case; end if; end Receive; or when Step = Rent and Library_Mode = Contact => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(10) => App.Owner := Abstract_Vectors.Element(Contacts, Abstract_Index(Contact_Index)); App.Rented.Owner := App.Owner.Id; Save(App.Terminal.root, Organizer_Filename); Library_Mode := None; Step := Menu; when others => null; end case; end if; end Receive; Put(Ansi_Tty_Control.Clear_Screen); Menu_Print(Menu_Win, Library_Step_Enum'Val(Menu_Index)); or when Step = Back and Library_Mode = Contact => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(10) => App.Owner := Element(Contacts, Abstract_Index(Contact_Index)); Library_Mode := Media; when others => null; end case; end if; end Receive; Initialize(Main_Win, 1, TOP+1, App.Lines-3, App.Columns/2, White, Cyan); Enlight_Window(Main_Win); Text_Io.Put(Normal_Mode); Library := Abstract_Vectors.Empty_Vector; To_List(App.Terminal.Root, Library); Media_Index := 1; if Abstract_Vectors.Length(Library) /= 0 then List_Draw(Library, Line, Media_Index, App.Columns/2-2, Top); end if; or when Step = Back and Library_Mode = Media => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(10) => App.Rented := Abstract_Vectors.Element(Library, Abstract_Index(line)); if App.Rented.Owner = App.Owner.Id then App.Rented.owner := 0; Save(App.Terminal.root, Organizer_Filename); end if; Library_Mode := None; Step := Menu; when others => null; end case; end if; end Receive; Put(Ansi_Tty_Control.Clear_Screen); Menu_Print(Menu_Win, Library_Step_Enum'Val(Menu_Index)); or when Step = List => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(10) => App.Rented := Abstract_Vectors.Element(Library, Abstract_Index(line)); if not (Abstract_Vectors.length(Library) = 0) then for Owner in 1..Abstract_Vectors.Length(Contacts) loop declare E : Abstract_Access := Abstract_Vectors.Element(Contacts, Abstract_Index(Owner)); begin if App.Rented.Owner = E.Id then Enlight_Window(Main_Win); Text_Io.Put(Normal_Mode); Contacts_Draw(Contacts, Integer(Owner), App.Columns/2-2, 0); exit; end if; end; end loop; end if; Library_Mode := None; Step := Menu; when others => null; end case; end if; end Receive; or accept Halt; exit Main_loop; or accept Wake_Up(Top : in Natural) do Initialize(Menu_Win, 1, Top+1, App.Lines, App.Columns/2, Blue, White); Library_Process.Top := Top; Contacts := Abstract_Vectors.Empty_Vector; To_Contacts(App.Terminal.Root, Contacts); Menu_Print(Menu_Win, Library_step_Enum'Val(Menu_Index)); Step := Menu; end Wake_Up; or accept Suspend; exit; or accept Refresh; or accept Page_Down; or accept Page_Up; or when Library_Mode = Contact => accept Up_Arrow do If Contact_Index > 1 then Contact_Index := Contact_Index - 1; Enlight_Window(Main_Win); Text_Io.Put(Normal_Mode); Contacts_Draw(Contacts, Contact_Index, App.Columns/2-2, 0); end if; end Up_Arrow; or when Library_Mode = Contact => accept Down_Arrow do if Abstract_Vectors.Length(Contacts) /= 0 then if Contact_Index + 1 <= Integer(Abstract_Vectors.Length(Contacts)) then Contact_Index := Contact_Index + 1; Enlight_Window(Main_Win); Text_Io.Put(Normal_Mode); Contacts_Draw(Contacts, Contact_Index, App.Columns/2-2, 0); end if; end if; end Down_Arrow; or when Step = Menu => accept Up_Arrow do if Menu_Index > 0 then Menu_Index := Menu_Index - 1; end if; Put(Ansi_Tty_Control.Clear_Screen); Menu_Print(Menu_Win, Library_Step_Enum'Val(Menu_Index)); end up_arrow; or when Step = Menu => accept Down_Arrow do if Menu_Index < Library_Step_Enum'Pos(Library_step_Enum'Last) then Menu_Index := Menu_Index + 1; end if; Put(Ansi_Tty_Control.Clear_Screen); Menu_Print(Menu_Win, Library_Step_Enum'Val(Menu_Index)); end Down_Arrow; or when Step /= List and Library_Mode = Media => accept Up_Arrow do if Line - Media_Index > 1 then Line := Line - 1; elsif Media_Index > 1 then Line := Line - 1; Media_Index := Media_Index - 1; end if; Enlight_Window(Main_Win); Text_Io.Put(Normal_Mode); Library_Draw(Library, Line, Media_Index, App.Columns/2-2, Top); end Up_Arrow; or when Step /= List and Library_Mode = Media => accept Down_Arrow do if Line + 1 <= Integer(Abstract_Vectors.Length(Library)) and then (Media_Index + ((App.Lines-5) / 5)) - Line < Integer(Abstract_Vectors.Length(Library)) then Line := Line + 1; elsif Media_Index + ((App.Lines-5) / 5) <= Integer(Abstract_Vectors.Length(Library)) then Line := Line + 1; Media_Index := Media_Index + 1; end if; Enlight_Window(Main_Win); Text_Io.Put(Normal_Mode); Library_Draw(Library, Line, Media_Index, App.Columns/2-2, Top); end Down_Arrow; or when Step = List => accept Up_Arrow do if Line > 1 then Line := Line - 1; else Media_Index := Media_Index - 1; end if; Enlight_Window(Main_Win); Text_Io.Put(Normal_Mode); List_Draw(App.List, Line, Media_Index, App.Columns/2-2, 0); end Up_Arrow; or when Step = List => accept Down_Arrow do if Line < ((App.Lines-5) / 5) then Line := Line + 1; else Media_Index := Media_Index + 1; end if; Enlight_Window(Main_Win); Text_Io.Put(Normal_Mode); List_Draw(App.List, Line, Media_Index, App.Columns/2-2, 0); end Down_Arrow; or accept Left_Arrow; or accept Right_Arrow; or accept Del; or accept Begin_Of; or accept End_Of; or accept Overwrite; or accept Full_Screen; end select; end loop; loop select accept Halt; exit Main_Loop; or accept Suspend; or accept Wake_Up(Top : in Natural) do Initialize(Menu_Win, 1, Top+1, App.Lines, App.Columns/2, Blue, White); Library_Process.Top := Top; Contacts := Abstract_Vectors.Empty_Vector; To_Contacts(App.Terminal.Root, Contacts); Menu_Print(Menu_Win, Library_Step_Enum'Val(Menu_Index)); Step := Menu; end Wake_Up; exit; end select; end loop; end loop Main_Loop; --W_Io.Put_Line("Library process halted"); end Library_Process; use Element_Vectors; type Element_Cmd_Enum is (Null_Cmd, Make, List, Switch, Root, Parent, Print, Search, Tree, Attribute, Remove, Create, Load); function Id (Name : in Element_Enum) return Element_Access is begin if Name = Program then return new Engine.Program_Class; elsif Name = Description then return new Description_Class; elsif Name = Main then return new Main_Class; elsif Name = License then return new License_Class; elsif Name = Library then return new Library_Class; elsif Name = Axiomatic then return new Axiomatic_Class; elsif Name = Precondition then return new Precondition_Class; elsif Name = Axiom then return new Axiom_Class; elsif Name = Predicate then return new Predicate_Class; elsif Name = Condition then return new Condition_Class; elsif Name = Component then return new Component_Class; elsif Name = Action then return new Action_Class; elsif Name = Class then return new Class_Class; elsif Name = Machine then return new Machine_Class; elsif Name = m.System then return new System_Class; else return null; end if; end Id; type Element_Counter is array (Element_Enum'Range) of Natural; procedure Global_Content_Print (Object : Element_Access; Win : in Window_Type) is Objects : Element_Vectors.Vector; Counter : Element_Counter := (others => 0); Win_Index : Natural := 0; begin if Object /= null then Objects := Object.Childs; for I in 1..Object.Info.Childs_num loop declare E : constant Element_Access := Element_Vectors.Element(Objects, Element_Index(I)); begin for J in Element_Enum'Succ(None)..Element_Enum'Last loop if E.Tag = J then Counter(J) := Counter(J) + 1; end if; end loop; end; end loop; for I in Element_Enum'Succ(None)..Element_Enum'Last loop Draw(Win, Win_Index+1, 3, White, Handling.To_Wide_String(Element_Enum'Image(I)) & Wide_Fixed."*"((16 - Element_Enum'Image(I)'Length),' ') & " : Total = " & Handling.To_Wide_String(Natural'Image(Counter(I))) & " " & Handling.To_Wide_String(Element_Enum'Image((i)))); Win_Index := Win_Index + 1; end loop; else Draw(Win, Win_Index+1, 3, White, "el = null"); end if; end Global_Content_Print; procedure Global_Read(File : W_Io.File_Type; End_Of_File : out Boolean; Object : out Element_Access) is Tag : Element_Enum := None; Name : Wide_String(1..8) := (others => Wide_Character'Val(32)); Name_Last : Natural := 0; Index : Natural := 0; begin End_Of_File := False; while not W_Io.End_Of_File(File) loop declare Name : Wide_String := W_Io.Get_Line(File); begin Index := Wide_Fixed.Index_Non_Blank(Name, backward); if index = 0 then raise Constraint_Error; else if Wide_Characters.Handling.Is_Control(Name(Index)) then raise Constraint_Error; end if; end if; Tag := Element_Enum'Value(Handling.To_String(Name)); exit; exception when Constraint_Error => W_Io.Get_Line(File, Name, Name_Last); begin Tag := Element_Enum'Value(Handling.To_String(Name(Name'First..Name_Last))); exit; end; end; end loop; Object := Id(Tag); End_Of_File := W_Io.End_Of_File(File); if not End_Of_File then Object.Read(File); end if; exception when Constraint_Error => raise; when others => null; end Global_Read; procedure Global_Print(Object : Element_Access; Header : in Window_Type; Win : in Window_Type) is begin if Object = null then return; end if; if Object.all'Tag = Engine.Program_Class'Tag then Engine.Program_Class(Object.all).Print(Header, Win); elsif Object.all'Tag = Description_Class'Tag then Description_Class(Object.all).Print(Header, Win); elsif Object.all'Tag = License_Class'Tag then License_Class(Object.all).Print(Header, Win); elsif Object.all'Tag = Main_Class'Tag then Main_Class(Object.all).Print(Header, Win); elsif Object.all'Tag = Library_Class'Tag then Library_Class(Object.all).Print(Header, Win); elsif Object.all'Tag = Axiomatic_Class'Tag then Axiomatic_Class(Object.all).Print(Header, Win); elsif Object.all'Tag = Axiom_Class'Tag then Axiom_Class(Object.all).Print(Header, Win); elsif Object.all'Tag = Predicate_Class'Tag then Predicate_Class(Object.all).Print(Header, Win); elsif Object.all'Tag = Predicate_Class'Tag then Predicate_Class(Object.all).Print(Header, Win); elsif Object.all'Tag = Precondition_Class'Tag then Precondition_Class(Object.all).Print(Header, Win); elsif Object.all'Tag = Condition_Class'Tag then Condition_Class(Object.all).Print(Header, Win); elsif Object.all'Tag = Condition_Class'Tag then Component_Class(Object.all).Print(Header, Win); elsif Object.all'Tag = Action_Class'Tag then Action_Class(Object.all).Print(Header, Win); elsif Object.all'Tag = Class_Class'Tag then Class_Class(Object.all).Print(Header, Win); elsif Object.all'Tag = Machine_Class'Tag then Machine_Class(Object.all).Print(Header, Win); elsif Object.all'Tag = System_Class'Tag then System_Class(Object.all).Print(Header, Win); end if; end Global_Print; procedure Parent(T : in out Project_Type) is V : Element_Vectors.Vector := T.Path; begin if not Is_Empty(V) then if Last_Index(V) >= 1 then T.Cur := Last_Element(V); if Last_Index(V) > 1 then Delete(V, Last_Index(V)); end if; end if; end if; T.Path := V; end Parent; procedure Switch(T : in out Project_Type; Num : in Element_Index; Success : out boolean) is Vector : Element_Vectors.Vector; begin Success := False; if T.Cur /= null then Vector := T.Cur.Childs; if not Is_Empty(Vector) then if Num <= Element_Index(T.Cur.Info.Childs_Num) then T.Path := T.Path & T.Cur; T.Cur := Element_Vectors.Element(Vector, Num); if T.Cur /= null then Success := True; else raise Program_Error; end if; end if; end if; end if; end Switch; procedure Restore_Vector(T : in out Project_Type; File : W_Io.File_Type) is Success : Boolean := False; N, O : Element_Access; Child_Childs, Child_Numb : Natural := 0; End_Of_File : Boolean := False; begin if T.Root = null then Global_Read(File, End_Of_File, T.Root); T.Cur := T.Root; if T.Cur /= null and then T.Cur.Info.Childs_Num /= 0 then for Child in 1..T.Cur.Info.Childs_Num loop if not W_Io.End_Of_File(File) then Restore_Vector(T, File); end if; Parent(T); end loop; end if; else for Child in 1..T.Cur.Info.Childs_Num loop Global_Read(File, End_Of_File, N); T.Cur.Childs := T.Cur.Childs & N; if not W_Io.End_Of_File(File) then if N.Info.Childs_num /= 0 then Switch(T, Element_Index(T.Cur.Info.Childs_Num), Success); Restore_Vector(T, File); Parent(T); end if; end if; end loop; end if; end Restore_Vector; procedure Restore(T : in out Project_Type; Filename : in String) is End_Of_File : Boolean := False; File : W_Io.File_Type; begin W_Io.Open(File, W_Io.in_File, Filename); if not W_Io.End_Of_File(File) then Restore_Vector(T, File); end if; W_Io.Close(File); end Restore; procedure Search(T : in out Project_Type; name : in Wide_String; Path_Index : in out Natural; Success : out boolean) is Vector : Element_Vectors.Vector := T.Cur.Childs; begin Success := False; if not Is_Empty(Vector) then for I in 1..Last_Index(Vector) loop declare E : constant Element_Access := Element_Vectors.Element(Vector, I); Term : Project_Type := T; begin if E /= null then if E.Info.Name.all = Name then Switch(Term, I, success); if Success then T := Term; exit; end if; else Switch(Term, I, success); Path_Index := Path_Index + 1; if Success then Search(Term, Name, Path_Index, Success); if Success then T := Term; exit; end if; end if; end if; else raise Program_Error; end if; end; end loop; end if; end Search; procedure Save_Object (Object : Element_Access; File : W_Io.File_Type; Index : Natural := 0) is O : constant Element_Access := Object; New_Index : Natural := Index; begin O.all.Write(File); if not Is_Empty(O.Childs) then for I in 1..Last_Index(O.Childs) loop declare E : constant Element_Access := Element_Vectors.Element(O.Childs, I); begin Save_Object(E, File, New_Index+1); end; end loop; end if; end Save_Object; procedure Save (Object : in Element_Access; Filename : in String) is File : W_Io.File_Type; begin W_Io.Create(File, W_Io.Out_File, Filename); Save_Object(Object, File); W_Io.Close(File); end Save; type Single_enum is (Single_None, Single_Name, Single_line); type Single_Type is record Name : Single_Enum := Single_None; Line : Wstring_45 := (others => ' '); Line_Last : Natural := 0; Line_Pos : Line_Range := 1; Column_Pos : Column_Range := 1; end record; type Single_Curs_Set is array (Single_Enum) of Single_Type; type Single_Cursor_Type is record Values : Single_Curs_Set; Val_Cur : Single_Enum := Single_Name; end record; function Initialize return Single_Cursor_Type is Curs : Single_Cursor_Type; begin Curs.Values(Single_Name) := (Single_name, (others => ' '), 0, 1, 8 ); Curs.Values(Single_Line) := (Single_Line, (others => ' '), 0, 2, 8 ); Curs.Val_Cur := Single_name; return Curs; end Initialize; function To_Single (Curs : in Single_Cursor_Type; Index : in Element_Index;Tag : in Element_enum) return Element_Access is El : Element_Access := Id(Tag); begin El.info.Index := Index; El.Info.Created := Clock; El.info.Name := new Wide_String ' (Curs.Values(Single_Name).Line(1..Curs.Values(Single_Name).Line_Last)); El.Line := new Wide_String ' (Curs.Values(Single_Line).Line(1..Curs.Values(Single_Line).Line_Last)); return El; exception when others => raise Spec_Error; end To_Single; type Engine_Type is limited record Main_Win : Window_Record := (1, 1, App.lines, App.Columns/2, Blue, The_Window); Header_Win : Window_Record := (2, 2, 5, (App.Columns-2)/4, white, The_Window); content_Win : Window_Record := (7, 2, 17, (App.Columns-2)/4, white, The_Window); Cmd_Win : Window_Record := (24, 2, 3, (App.Columns-2)/4, Blue, The_Window); Obj_Header : Window_Record := (2, (App.Columns-2)/4+2, 6, (App.Columns-2)/4, Blue, The_Window); Obj_Main : Window_Record := (27, 2, 15, (App.Columns/2)-2, white, The_Window); Attr : Window_Record := (8, (App.Columns-2)/4+2, 4, (App.Columns-2)/4, Blue, The_Window); Obj_Attr : Window_Record := (12, (App.Columns-2)/4+2, 15, (App.Columns-2)/4, Blue, The_Window); List_Win : Window_Record := (42, 2, App.Lines-47, (App.Columns/2)-2, white, The_Window); buffer_Win : Window_Record := (App.Lines-5, 2, 5, (App.Columns/2)-2, white, The_Window); File_Win : Window_Record := (1, App.columns/2+1, App.Lines, App.Columns/2, Blue, The_Window); end record; procedure Initialize (Engine : out Engine_Type; Top : Natural := 0) is begin Initialize(Engine.Main_Win, 1, Top+1, App.lines, App.Columns/2, Blue, white); Initialize(Engine.Header_Win, 2, Top+2, 5, (App.Columns-2)/4, white, Cyan); Initialize(Engine.Content_Win, 7, Top+2, 17, (App.Columns-2)/4, white, Cyan); Initialize(Engine.Cmd_Win, 24, Top+2, 3, (App.Columns-2)/4, Blue, White); Initialize(Engine.Obj_Header, 2, Top+(App.Columns-2)/4+2, 6, (App.Columns-2)/4, Blue, White); Initialize(Engine.Obj_Main, 27, Top+2, 15, (App.Columns/2)-2, white, Cyan); Initialize(Engine.Attr, 8, Top+(App.Columns-2)/4+2, 4, (App.Columns-2)/4, Blue, White); Initialize(Engine.Obj_Attr, 12, Top+(App.Columns-2)/4+2, 15, (App.Columns-2)/4, Blue, White); Initialize(Engine.List_Win, 42, Top+2, App.Lines-47, (App.Columns-2)/2, white, Red); Initialize(Engine.Buffer_Win, App.Lines-5 , 2, 5, (App.Columns-2)/2, blue, White); Initialize(Engine.File_Win, 1, Top+(App.Columns/2)+1, App.Lines, (App.Columns/2), white, Red); end Initialize; procedure Draw (Engine : in Engine_Type; Project : in Project_Type) is begin Enlight_Window(Engine.Main_Win); Enlight_Window(Engine.Header_win); Enlight_Window(Engine.Content_Win); Enlight_Window(Engine.cmd_Win); Enlight_Window(Engine.Obj_Header); Enlight_Window(Engine.Obj_Main); Enlight_Window(Engine.Attr); Enlight_Window(Engine.Obj_Attr); Enlight_Window(Engine.List_Win); Enlight_Window(Engine.Buffer_Win); Enlight_Window(Engine.File_Win); Text_Io.Put(Normal_Mode); end Draw; function El_Cmd_Value (Line : in Wide_String) return Element_Cmd_Enum is Cmd : Element_Cmd_Enum := Null_Cmd; First_Space : constant Natural := Wide_Fixed.Index(Line, " "); begin if First_Space /= 0 then begin Cmd := Element_Cmd_Enum'Value(Handling.To_String(Line(Line'First..First_Space-1))); exception when others => Cmd := Null_Cmd; end; elsif Wide_Fixed.Index_Non_Blank(Line) /= 0 then begin Cmd := Element_Cmd_Enum'Value(Handling.To_String(Line(Wide_Fixed.Index_Non_Blank(Line)..Wide_Fixed.Index_Non_Blank(Line, Backward)))); exception when others => Cmd := Null_Cmd; end; end if; return Cmd; end El_Cmd_Value; function Child (Cur : in Element_Access;Index : in Natural) return Element_Access is begin if Index = 0 then return Cur; end if; if Cur = null then return null; end if; return Element_Vectors.Element(Cur.Childs, Element_Index(Index)); exception when others => return null; end Child; function Child (Cur : in Element_Access;Name : in Wide_String) return Element_Access is Obj : Element_Access; begin if Cur = null then return null; end if; if Cur.Info.Name.all = Name then return Cur; end if; if not Element_Vectors.Is_Empty(Cur.Childs) then for Child in 1..Element_Vectors.Length(Cur.Childs) loop declare E : constant Element_Access := Element_Vectors.Element(Cur.Childs, Element_Index(Child)); begin if E.Info.Name /= null and then E.Info.Name.all = Name then return E; end if; end; end loop; end if; return null; end Child; function To_String(Info : in Element_Info) return Wide_String is begin if Info.Name = null then raise Program_Error; end if; return Handling.To_Wide_String(Element_Index'Image(Info.Index)) & " " & Handling.To_Wide_String(Element_Enum'Image(Info.Tag)) & " " & Info.Name.all & " " & Handling.To_Wide_String(Formatting.Image(Info.Created)); end To_String; function To_Tree(Info : in Element_Info; Level : in Natural) return Wide_String is begin if Info.Name = null then raise Program_Error; end if; return Wide_Fixed."*"(Level, ' ') & '+' & ' ' & Handling.To_Wide_String(Element_Index'Image(Info.Index)) & " " & Handling.To_Wide_String(Element_Enum'Image(Info.Tag)) & " " & Info.Name.all & " " & Handling.To_Wide_String(Formatting.Image(Info.Created)); end To_Tree; procedure Listing (Obj : in Element_Access; Set : in out Wide_Set;Last : in out Natural) is begin if Obj /= null then if not Element_Vectors.Is_Empty(Obj.Childs) then for Child in 1..Obj.Info.Childs_num loop declare E : Element_Access := Element_Vectors.Element(Obj.Childs, Element_Index(Child)); begin case E.Tag is when None => null; when License => for Line in 1..E.License.Line_Last loop Add_Line(Set, Last, E.License.Lines(Line).all); end loop; if E.Info.Childs_Num /= 0 then Listing(E, Set, Last); end if; when others => Add_Line(Set, Last, E.Line.all); if E.Info.Childs_Num /= 0 then Listing(E, Set, Last); end if; end case; end; end loop; end if; end if; end Listing; procedure Tree (Obj : in Element_Access; Level : in Natural; Set : in out Wide_Set; Last : in out Natural) is begin if Obj /= null then if Level = 0 then Add_Line(Set, Last, To_tree(Obj.Info, Level+1)); end if; if not Element_Vectors.Is_Empty(Obj.Childs) then Add_Line(Set, Last, Wide_Fixed."*"(Level+1, ' ') & "| "); for Child in 1..Obj.Info.Childs_Num loop declare E : Element_Access := Element_Vectors.Element(Obj.Childs, Element_Index(Child)); begin Add_Line(Set, Last, To_tree(E.Info, Level+2)); if E.Info.Childs_Num /= 0 then Tree(E, Level+3, Set, Last); end if; end; end loop; end if; end if; end Tree; procedure Tree_Free (O : in out Element_Access) is begin if O = null then return; end if; if Element_Vectors.Length(O.Childs) /= 0 then for Child in 1 .. Element_Index(Element_Vectors.Length(O.Childs)) loop declare E : Element_Access := Element_Vectors.Element(O.Childs, Child); begin Tree_Free(E); end; end loop; end if; Obj_free(O); end Tree_Free; procedure Remove (T : in out Project_Type; Index : in Element_Index) is begin if Index > Element_Index(Element_Vectors.Length(T.Cur.Childs)) then return; end if; declare E : Element_Access := Element_Vectors.Element(T.Cur.Childs, Index); begin Tree_Free(E); end; Element_Vectors.Delete(T.Cur.Childs, Index); T.Cur.Info.Childs_Num := T.Cur.Info.Childs_Num - 1; if not Element_Vectors.Is_empty(T.Cur.Childs)and then Index <= Element_Index(Element_Vectors.Length(T.Cur.Childs)) then for Child in Index .. Element_Index(Element_Vectors.Length(T.Cur.Childs)) loop declare E : constant Element_Access := Element_Vectors.Element(T.Cur.Childs, Index); begin E.Info.Index := E.Info.Index - 1; end; end loop; end if; end Remove; procedure Add_To (Project : in out Project_Type; Obj : Element_Access) is begin if Project.Root = null then Obj.Info.Index := 1; Project.Root := Obj; Project.Cur := Obj; Project.Path := Project.Path & Obj; else Obj.Info.Index := Element_Index(Element_Vectors.Length(Project.Cur.Childs) + 1); Project.Cur.Childs := Project.Cur.Childs & Obj; Project.Cur.Info.Childs_Num := Project.Cur.Info.Childs_Num + 1; end if; end Add_To; procedure Add_License (Project : in out Project_Type) is Index : Element_Index := Element_Index(Element_Vectors.Length(Project.Cur.Childs) + 1); O : Element_Access := Id(License); File : Text_Io.File_Type; begin O.info.Index := Index; O.Info.Created := Clock; O.info.Name := new Wide_String ' ("License"); Open(File, In_File, "gpl.txt"); for I in 1..295 loop declare Line : String := Get_Line(File); begin null; end; end loop; O.License := new Wide_Set(13); O.License.Line_Last := 13; for iter in 1..13 loop declare Line : String := Get_Line(File); begin O.License.Lines(Iter) := new Wide_String ' (Handling.To_Wide_String(Line)); end; end loop; Add_To(Project, O); Close(File); end Add_License; task body Engine_Process is Single_Curs : Single_Cursor_Type; Attribute_Curs : Attribute_Cursor_Type; Filename : Os_Lib.String_Access; The_Engine : Engine_Type; Level : Natural := 0; Cmd : Element_Cmd_Enum := Null_cmd; Is_Initialized : Boolean := False; Verax : Boolean := False; Top : Natural := 0; Cmd_Line : Wide_String (1..App.Columns/2-6); Line_Last : Natural := 0; Child_Index : Element_Index := 1; On_List : Boolean := False; On_Tree : Boolean := False; Obj_Tag : Element_Enum := None; In_Print : Boolean := False; Print_Index : Natural := 0; Printed : Element_Access; Success : Boolean := False; Childs_Set : Wide_Set(4096); Line_Index : Natural := 0; Last : Natural := 0; Total_Line : Natural := 0; Path_Index : Natural := 0; Name : Os_Lib.String_Access; File : Wide_Set(1024); File_Index : Natural := 0; List_Last : Natural := 0; List_Index : Natural := 0; begin Main_Loop: loop loop select when Obj_Tag = None and Cmd /= Attribute => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'val(10) => if Line_Last /= 0 then In_Print := False; Cmd := El_Cmd_Value(Cmd_Line(1..Line_Last)); case Cmd is when Null_Cmd => null; when Make => declare Tag_Name : Os_Lib.String_Access; begin if Wide_Fixed.Index(Cmd_Line(Cmd_Line'First..Line_Last), " ") /= 0 then Tag_Name := new String ' (Handling.To_String(Cmd_Line(Wide_Fixed.Index(Cmd_Line, " ")+1..Line_Last))); Obj_Tag := Element_Enum'Value(Tag_Name.all); case Obj_Tag is when None => null; when License => Add_License(App.Project); Save(App.Project.root, Filename.all); Obj_Tag := None; when others => Single_Curs := Initialize; end case; end if; exception when others => null; end; when Attribute => Attribute_Curs := Initialize; when Parent => Parent(App.Project); when Load => if Wide_Fixed.Index(Cmd_Line(Cmd_Line'First..Line_Last), " ") /= 0 then Filename := new String ' (Handling.To_String(Cmd_Line(Wide_Fixed.Index(Cmd_Line, " ")+1..Line_Last)) & ".txt"); if Is_Regular_File(Filename.all) then Restore(App.Project, Filename.all); Set_Free(File); List_Last := 0; Listing(App.Project.Root, File, List_Last); end if; end if; when Switch => if App.Project.Cur /= null then if Wide_Fixed.Index(Cmd_Line(Cmd_Line'First..Line_Last), " ") /= 0 then declare Index_name : M.Strings.Wide_String_Access; Index : Element_Index := 1; begin Index_Name := new Wide_String ' (Cmd_Line(Wide_Fixed.Index(Cmd_Line, " ")+1..Line_Last)); Index := Element_Index'Value(Handling.To_String(Index_Name.all)); Switch(App.Project, Index, Verax); exception when others => null; end; end if; end if; when Root => App.Project.Cur := App.Project.Root; App.Project.Path := Element_Vectors.Empty_Vector; App.Project.Path := App.Project.Path & App.Project.Root; when Print => if App.Project.Cur /= null then if Wide_Fixed.Index(Cmd_Line(Cmd_Line'First..Line_Last), " ") /= 0 then declare Index_name : M.Strings.Wide_String_Access; Index : Natural := 0; begin Index_name := new Wide_String ' (Cmd_Line(Wide_Fixed.Index(Cmd_Line, " ")+1..Line_Last)); Print_Index := Natural'Value(Handling.To_String(Index_Name.all)); Printed := Child(App.Project.Cur, Print_Index); case Printed.Tag is when None => null; when License => In_Print := True; Enlight_Window(The_Engine.Obj_Header); Enlight_Window(The_Engine.Attr); Text_Io.Put(Normal_Mode); Enlight_Window(The_Engine.Obj_Main); Text_Io.Put(Normal_Mode); Printed.Print(The_Engine.Obj_Header.Win, The_Engine.Obj_Main.Win); when others => In_Print := True; Enlight_Window(The_Engine.Obj_Header); Text_Io.Put(Normal_Mode); Enlight_Window(The_Engine.Attr); Text_Io.Put(Normal_Mode); Printed.Print(The_Engine.Obj_Header.Win, The_Engine.Attr.Win); end case; Enlight_Window(The_Engine.Obj_Attr); Text_Io.Put(Normal_Mode); Classes.Print(Printed.definition, The_Engine.Obj_Attr.Win); exception when others => declare Name : M.Strings.Wide_String_Access; Index : Element_Index := 1; begin Index_name := new Wide_String ' (Cmd_Line(Wide_Fixed.Index(Cmd_Line, " ")+1..Line_Last)); Printed := Child(App.Project.Cur, Index_Name.all); case Printed.Tag is when None => null; when License => In_Print := True; Enlight_Window(The_Engine.Obj_Header); Enlight_Window(The_Engine.Attr); Text_Io.Put(Normal_Mode); Enlight_Window(The_Engine.Obj_Main); Text_Io.Put(Normal_Mode); Printed.Print(The_Engine.Obj_Header.Win, The_Engine.Obj_Main.Win); when others => In_Print := True; Enlight_Window(The_Engine.Obj_Header); Text_Io.Put(Normal_Mode); Enlight_Window(The_Engine.Attr); Text_Io.Put(Normal_Mode); Printed.Print(The_Engine.Obj_Header.Win, The_Engine.Attr.Win); end case; Printed.Print(The_Engine.Obj_Header.Win, The_Engine.Attr.Win); Enlight_Window(The_Engine.Attr); Text_Io.Put(Normal_Mode); Classes.Print(Printed.definition, The_Engine.Attr.Win); exception when others => null; end; end; else Classes.Print(App.Project.Root.Definition, The_Engine.Obj_Attr.Win); case App.Project.Root.Tag is when None => null; when License => In_Print := True; Enlight_Window(The_Engine.Obj_Header); Text_Io.Put(Normal_Mode); Enlight_Window(The_Engine.Obj_Main); Text_Io.Put(Normal_Mode); App.Project.Root.Print(The_Engine.Obj_Header.Win, The_Engine.Obj_Main.Win); when others => In_Print := True; Enlight_Window(The_Engine.Obj_Header); Text_Io.Put(Normal_Mode); Enlight_Window(The_Engine.Attr); Text_Io.Put(Normal_Mode); App.Project.Root.Print(The_Engine.Obj_Header.Win, The_Engine.Attr.Win); end case; Print_Index := 0; Printed := null; end if; end if; when Search => if App.Project.Cur /= null then if Wide_Fixed.Index(Cmd_Line(Cmd_Line'First..Line_Last), " ") /= 0 then declare Index_name : M.Strings.Wide_String_Access; Index : Element_Index := 1; begin Index_name := new Wide_String ' (Cmd_Line(Wide_Fixed.Index(Cmd_Line, " ")+1..Line_Last)); Search(App.Project, Index_Name.all, Path_Index, Success); if Success then Enlight_Window(The_Engine.Obj_Header); Text_Io.Put(Normal_Mode); Enlight_Window(The_Engine.Attr); Enlight_Window(The_Engine.Obj_Main); Text_Io.Put(Normal_Mode); case Printed.Tag is when None => null; when License => In_Print := True; Enlight_Window(The_Engine.Obj_Header); Text_Io.Put(Normal_Mode); Enlight_Window(The_Engine.Obj_Main); Text_Io.Put(Normal_Mode); App.Project.Cur.Print(The_Engine.Obj_Header.Win, The_Engine.Obj_Main.Win); when others => In_Print := True; Enlight_Window(The_Engine.Obj_Header); Text_Io.Put(Normal_Mode); Enlight_Window(The_Engine.Attr); Text_Io.Put(Normal_Mode); App.Project.Cur.Print(The_Engine.Obj_Header.Win, The_Engine.Attr.Win); end case; Enlight_Window(The_Engine.Obj_Attr); Text_Io.Put(Normal_Mode); Classes.Print(App.Project.Cur.definition, The_Engine.Obj_Attr.Win); In_Print := True; end if; Success := False; Path_Index := 0; exception when Constraint_Error => null; end; end if; end if; when List => Set_Free(Childs_Set); Enlight_Window(The_Engine.List_Win); Enlight_Window(The_Engine.Obj_Main); Text_Io.Put(Normal_Mode); Last := 0; Total_Line := 0; Line_Index := 0; On_List := True; On_Tree := False; if App.Project.Cur /= null then if not Element_Vectors.Is_Empty(App.Project.Cur.Childs) then for Child in 1..App.Project.Cur.Info.Childs_Num loop declare E : constant Element_Access := Element_Vectors.Element(App.Project.Cur.Childs, Element_Index(Child)); begin Add_Line(Childs_Set, Last, To_String(E.Info)); end; end loop; end if; end if; Success := Print_Set(Childs_Set, The_Engine.List_Win, Line_Index, Total_Line); when Tree => On_Tree := True; On_List := False; Enlight_Window(The_Engine.Obj_Main); Text_Io.Put(Normal_Mode); Total_Line := 0; Line_Index := 0; Set_Free(Childs_Set); if App.Project.Cur /= null then Tree(App.Project.Cur, Level, Childs_Set, Last); Success := Print_Set(Childs_Set, The_Engine.List_Win, Line_Index, Total_Line); end if; when Remove => declare Name : M.Strings.Wide_String_Access; Index : Element_Index := 1; begin if Wide_Fixed.Index(Cmd_Line, " ") /= 0 then name := new Wide_String ' (Cmd_Line(Wide_Fixed.Index(Cmd_Line, " ")+1..Line_Last)); if Wide_Fixed.Index_Non_Blank(Name.all) /= 0 then Index := Element_Index'Value(Handling.To_String(Name.all)); Remove(App.Project, Index); --Save(App.Project.root, _Filename); end if; end if; if On_List then Set_Free(Childs_Set); Enlight_Window(The_Engine.List_Win); Enlight_Window(The_Engine.Obj_Main); Text_Io.Put(Normal_Mode); Last := 0; Total_Line := 0; Line_Index := 0; if App.Project.Cur /= null then if not Element_Vectors.Is_Empty(App.Project.Cur.Childs) then for Child in 1..App.Project.Cur.Info.Childs_Num loop declare E : constant Element_Access := Element_Vectors.Element(App.Project.Cur.Childs, Element_Index(Child)); begin Add_Line(Childs_Set, Last, To_String(E.Info)); end; end loop; end if; end if; Success := Print_Set(Childs_Set, The_Engine.List_Win, Line_Index, Total_Line); elsif On_Tree then Total_Line := 0; Line_Index := 0; Enlight_Window(The_Engine.Obj_Main); Text_Io.Put(Normal_Mode); Set_Free(Childs_Set); if App.Project.Cur /= null then Tree(App.Project.Cur, Level, Childs_Set, Last); Success := Print_Set(Childs_Set, The_Engine.List_Win, Line_Index, Total_Line); end if; end if; Success := Print_Set(Childs_Set, The_Engine.List_Win, Line_Index, Total_Line); exception when others => null; end; when others => null; end case; end if; Line_Last := 0; when Wide_Character'Val(12) => Last := 0; Printed := null; Print_Index := 0; Initialize(The_Engine, Top); Draw(The_Engine, App.Project); Enlight_Window(The_Engine.Content_Win); Text_Io.Put(Normal_Mode); Global_Content_Print(App.Project.Cur, The_Engine.Content_Win.win); Enlight_Window(The_Engine.cmd_Win); Text_Io.Put(Normal_Mode); if App.Project.Cur = null then Draw_Text(The_Engine.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Project.Cur.Info.Name /= null then Draw_Text(The_Engine.Cmd_Win, 1, 1, White, App.Project.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(The_Engine.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; when Wide_Character'Val(127) => if Line_Last > 0 then Cmd_Line(Line_Last) := Wide_Character'Val(32); Line_Last := Line_Last - 1; else Text_Io.Put(Character'Val(7)); end if; when others => null; end case; else if App.Project.Root /= null and then App.Project.cur.Info.Name /= null then if Line_Last + 1 <= (Cmd_Line'Length-App.Project.cur.Info.Name'Length) then Cmd_Line(Line_Last + 1) := Wchar; Line_Last := Line_Last + 1; else Text_Io.Put(Character'Val(7)); end if; elsif Line_Last + 1 <= Cmd_Line'Length then Cmd_Line(Line_Last + 1) := Wchar; Line_Last := Line_Last + 1; else Text_Io.Put(Character'Val(7)); end if; end if; end Receive; Enlight_Window(The_Engine.Content_Win); Text_Io.Put(Normal_Mode); Global_Content_Print(App.Project.Cur, The_Engine.Content_Win.win); Enlight_Window(The_Engine.cmd_Win); Text_Io.Put(Normal_Mode); Enlight_Window(The_Engine.File_win); if List_Last /= 0 then Success := Print_Set(File, The_Engine.File_Win, List_Index, Total_Line); end if; case Obj_Tag is when None => case Cmd is when Attribute => Enlight_Window(The_Engine.Attr); Text_Io.Put(Normal_Mode); Draw_Text(The_Engine.Attr, 2, 1, White, "Image : "); Draw_Text(The_Engine.Attr, 1, 1, White, "Name : "); for Val in Attribute_Name..Attribute_Image loop Draw_Text(The_Engine.Attr, Attribute_Curs.values(Val).Line_Pos, Attribute_Curs.values(Val).Column_Pos, White, Attribute_Curs.values(Val).Line(1..Attribute_Curs.values(Val).Line_Last)); end loop; Draw_Text(The_Engine.Attr, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Pos, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Column_Pos, White, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line(1..Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last)); when others => null; end case; when License => null; when others => Enlight_Window(The_Engine.Attr); Text_Io.Put(Normal_Mode); Draw_Text(The_Engine.Attr, 2, 1, White, "Line : "); Draw_Text(The_Engine.Attr, 1, 1, White, "Name : "); end case; if App.Project.Root /= null then Child_Index := Element_Index(Element_Vectors.Length(App.Project.Cur.childs)+1); else Child_Index := 1; end if; if App.Project.Cur = null then Draw_Text(The_Engine.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Project.Cur.Info.Name /= null then Draw_Text(The_Engine.Cmd_Win, 1, 1, White, App.Project.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(The_Engine.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; or when cmd = attribute => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(1) => Attribute_Curs := Initialize; Enlight_Window(The_Engine.Obj_Header); Enlight_Window(The_Engine.Obj_Main); Enlight_Window(The_Engine.Obj_Attr); Text_Io.Put(Normal_Mode); Obj_Tag := None; when Wide_Character'Val(10) => if Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last /= 0 then case Attribute_Curs.Val_Cur is when Attribute_None => null; when Attribute_Name => Name := new String ' (Handling.To_String(Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line(1..Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last))); Attribute_Curs.Val_Cur := Attribute_Enum'Succ(Attribute_Curs.Val_Cur); when Attribute_Image => if App.Project.Cur /= null then if App.Project.Cur.Definition.Index < App.Project.Cur.Definition.List'Last then App.Project.Cur.Definition.List(App.Project.Cur.Definition.Index + 1) := Make(Name.all, Handling.To_String(Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line(1..Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last))); App.Project.Cur.Definition.Index := App.Project.Cur.Definition.Index + 1; end if; end if; attribute_Curs := Initialize; Enlight_Window(The_Engine.Obj_Main); Text_Io.Put(Normal_Mode); Free(Name); Attribute_Curs.Val_Cur := Attribute_None; Cmd := Null_cmd; Save(App.Project.root, Filename.all); end case; else Put(Character'Val(7)); end if; when Wide_Character ' Val (127) => if Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last > 0 then Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line(Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last) := ' '; Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last := Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last - 1; end if; when others => null; end case; elsif Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last < 45 then Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line(Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last + 1) := Wchar; Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last := Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last + 1; for Val in Attribute_Name..Attribute_image loop Draw_Text(The_Engine.Attr, Attribute_Curs.values(Val).Line_Pos, Attribute_Curs.values(Val).Column_Pos, White, Attribute_Curs.values(Val).Line(1..Attribute_Curs.values(Val).Line_Last)); end loop; Draw_Text(The_Engine.Attr, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Pos, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Column_Pos, White, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line(1..Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; end Receive; case Attribute_Curs.Val_Cur is when Attribute_none => Draw(The_Engine, App.Project); Global_Content_Print(App.Project.Cur, The_Engine.Content_Win.win); Enlight_Window(The_Engine.Attr); Enlight_Window(The_Engine.Obj_Attr); Text_Io.Put(Normal_Mode); if App.Project.Cur /= null then for I in 1..App.Project.Cur.Definition.Index loop Draw_Text(The_Engine.Obj_Attr, I, 1, white, Handling.To_Wide_String(App.Project.Cur.Definition.List(I).Name.all)); Draw_Text(The_Engine.Obj_Attr, I, App.Project.Cur.Definition.List(I).Name'Length+1, Red, "="); Draw_Text(The_Engine.Obj_Attr, I, App.Project.Cur.Definition.List(I).Name'Length+2, white, Handling.To_Wide_String(App.Project.Cur.Definition.List(I).Value.all)); end loop; end if; Enlight_Window(The_Engine.cmd_Win); Text_Io.Put(Normal_Mode); if App.Project.Cur = null then Draw_Text(The_Engine.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Project.Cur.Info.Name /= null then Draw_Text(The_Engine.Cmd_Win, 1, 1, White, App.Project.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(The_Engine.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; when others => Draw(The_Engine, App.Project); Global_Content_Print(App.Project.Cur, The_Engine.Content_Win.win); Enlight_Window(The_Engine.Attr); Enlight_Window(The_Engine.cmd_Win); Enlight_Window(The_Engine.Obj_Attr); Text_Io.Put(Normal_Mode); if App.Project.Cur /= null then for I in 1..App.Project.Cur.Definition.Index loop Draw_Text(The_Engine.Obj_Attr, I, 1, white, Handling.To_Wide_String(App.Project.Cur.Definition.List(I).Name.all)); Draw_Text(The_Engine.Obj_Attr, I, App.Project.Cur.Definition.List(I).Name'Length+1, Red, "="); Draw_Text(The_Engine.Obj_Attr, I, App.Project.Cur.Definition.List(I).Name'Length+2, white, Handling.To_Wide_String(App.Project.Cur.Definition.List(I).Value.all)); end loop; end if; if App.Project.Cur = null then Draw_Text(The_Engine.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Project.Cur.Info.Name /= null then Draw_Text(The_Engine.Cmd_Win, 1, 1, White, App.Project.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(The_Engine.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; Draw_Text(The_Engine.Attr, 2, 1, White, "Image : "); Draw_Text(The_Engine.Attr, 1, 1, White, "Name : "); for Val in Attribute_Name..Attribute_Image loop Draw_Text(The_Engine.Attr, Attribute_Curs.values(Val).Line_Pos, Attribute_Curs.values(Val).Column_Pos, White, Attribute_Curs.values(Val).Line(1..Attribute_Curs.values(Val).Line_Last)); end loop; Draw_Text(The_Engine.Attr, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Pos, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Column_Pos, White, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line(1..Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last)); null; end case; or when Obj_Tag = License => accept Receive (Wchar : in Wide_Character) do Set_Free(File); List_Last := 0; Listing(App.Project.Root, File, List_Last); if List_Last /= 0 then Success := Print_Set(File, The_Engine.File_Win, List_Index, Total_Line); end if; end Receive; or when Obj_Tag /= None and Obj_Tag /= License => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(1) => Single_Curs := Initialize; Enlight_Window(The_Engine.Obj_Header); Enlight_Window(The_Engine.Attr); Text_Io.Put(Normal_Mode); Obj_Tag := None; when Wide_Character'Val(10) => if Single_Curs.Values(Single_Curs.Val_Cur).Line_Last /= 0 then case Single_Curs.Val_Cur is when Single_None => null; when Single_Line => declare Obj : constant Element_Access := To_single(Single_Curs, Child_Index, Obj_Tag); begin Add_To(App.Project, Obj); case Obj_tag is when Program => Filename := new String ' (Handling.To_String(Engine.Program_Class(App.Project.Root.all).Line.all & ".txt")); Save(App.Project.root, Filename.all); when others => Save(App.Project.root, Filename.all); end case; end; Single_Curs := Initialize; Enlight_Window(The_Engine.Attr); Text_Io.Put(Normal_Mode); Obj_Tag := None; when others => Single_Curs.Val_Cur := Single_Enum'Succ(Single_Curs.Val_Cur); end case; Draw_Text(The_Engine.Attr, Single_Curs.Values(Single_Curs.Val_Cur).Line_Pos, Single_Curs.Values(Single_Curs.Val_Cur).Column_Pos, White, Single_Curs.Values(Single_Curs.Val_Cur).Line(1..Single_Curs.Values(Single_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; when Wide_Character ' Val (127) => if Single_Curs.Values(Single_Curs.Val_Cur).Line_Last > 0 then Single_Curs.Values(Single_Curs.Val_Cur).Line(Single_Curs.Values(Single_Curs.Val_Cur).Line_Last) := ' '; Single_Curs.Values(Single_Curs.Val_Cur).Line_Last := Single_Curs.Values(Single_Curs.Val_Cur).Line_Last - 1; end if; Enlight_Window(The_Engine.Attr); Text_Io.Put(Normal_Mode); Draw_Text(The_Engine.Attr, 1, 1, White, "Name : "); for Val in Single_Name..Single_Line loop Draw_Text(The_Engine.Attr, Single_Curs.values(Val).Line_Pos, Single_Curs.values(Val).Column_Pos, White, Single_Curs.values(Val).Line(1..Single_Curs.values(Val).Line_Last)); end loop; Draw_Text(The_Engine.Attr, Single_Curs.Values(Single_Curs.Val_Cur).Line_Pos, Single_Curs.Values(Single_Curs.Val_Cur).Column_Pos, White, Single_Curs.Values(Single_Curs.Val_Cur).Line(1..Single_Curs.Values(Single_Curs.Val_Cur).Line_Last)); when others => null; end case; elsif Single_Curs.Values(Single_Curs.Val_Cur).Line_Last < 45 then Single_Curs.Values(Single_Curs.Val_Cur).Line(Single_Curs.Values(Single_Curs.Val_Cur).Line_Last + 1) := Wchar; Single_Curs.Values(Single_Curs.Val_Cur).Line_Last := Single_Curs.Values(Single_Curs.Val_Cur).Line_Last + 1; for Val in Single_Name..Single_Line loop Draw_Text(The_Engine.Attr, Single_Curs.values(Val).Line_Pos, Single_Curs.values(Val).Column_Pos, White, Single_Curs.values(Val).Line(1..Single_Curs.values(Val).Line_Last)); end loop; Draw_Text(The_Engine.Attr, Single_Curs.Values(Single_Curs.Val_Cur).Line_Pos, Single_Curs.Values(Single_Curs.Val_Cur).Column_Pos, White, Single_Curs.Values(Single_Curs.Val_Cur).Line(1..Single_Curs.Values(Single_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; end Receive; Set_Free(File); List_Last := 0; Listing(App.Project.Root, File, List_Last); if List_Last /= 0 then Success := Print_Set(Childs_Set, The_Engine.File_Win, List_Index, Total_Line); end if; case Obj_Tag is when None => Draw(The_Engine, App.Project); Global_Content_Print(App.Project.Cur, The_Engine.Content_Win.win); Enlight_Window(The_Engine.cmd_Win); Text_Io.Put(Normal_Mode); if App.Project.Cur = null then Draw_Text(The_Engine.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Project.Cur.Info.Name /= null then Draw_Text(The_Engine.Cmd_Win, 1, 1, White, App.Project.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(The_Engine.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; when others => null; end case; or accept Halt; exit Main_loop; or accept Wake_Up(Top : in Natural) do Engine_Process.Top := Top; Initialize(The_Engine, Top); Draw(The_Engine, App.Project); Global_Content_Print(App.Project.Cur, The_Engine.Content_Win.win); if In_Print then if Print_Index /= 0 then if Printed /= null then case Printed.Tag is when None => null; when License => Enlight_Window(The_Engine.Obj_Main); Text_Io.Put(Normal_Mode); Printed.Print(The_Engine.Obj_Header.Win, The_Engine.Obj_Main.Win); when others => Enlight_Window(The_Engine.Attr); Text_Io.Put(Normal_Mode); Printed.Print(The_Engine.Obj_Header.Win, The_Engine.Attr.Win); end case; Printed.Print(The_Engine.Obj_Header.Win, The_Engine.Obj_Main.Win); end if; else if Printed /= null then case Printed.Tag is when None => null; when License => Enlight_Window(The_Engine.Obj_Main); Text_Io.Put(Normal_Mode); Printed.Print(The_Engine.Obj_Header.Win, The_Engine.Obj_Main.Win); when others => Enlight_Window(The_Engine.Attr); Text_Io.Put(Normal_Mode); Printed.Print(The_Engine.Obj_Header.Win, The_Engine.Attr.Win); end case; else case App.Project.Cur.Tag is when None => null; when License => Enlight_Window(The_Engine.Obj_Main); Text_Io.Put(Normal_Mode); App.Project.Cur.Print(The_Engine.Obj_Header.Win, The_Engine.Obj_Main.Win); when others => Enlight_Window(The_Engine.Attr); Text_Io.Put(Normal_Mode); App.Project.Cur.Print(The_Engine.Obj_Header.Win, The_Engine.Attr.Win); end case; end if; end if; end if; if Last /= 0 then Success := Print_Set(File, The_Engine.File_Win, File_Index, Total_Line); end if; if App.Project.Root = null then Draw_Text(The_Engine.Cmd_Win, 1, 1, White, "# "); elsif App.Project.Cur.Info.Name /= null then Draw_Text(The_Engine.Cmd_Win, 1, 1, White, App.Project.Cur.Info.Name.all & "# "); else Draw_Text(The_Engine.Cmd_Win, 1, 1, White, "null# "); end if; end Wake_Up; or accept Suspend; exit; or accept Refresh; or accept Page_Down; or accept Page_Up; or accept Up_Arrow do null; end up_arrow; or accept Down_Arrow do null; end Down_Arrow; or accept Left_Arrow; or accept Right_Arrow; or accept Del; or accept Begin_Of; or accept End_Of; or accept Overwrite; or accept Full_Screen; end select; end loop; loop select accept Halt; exit Main_Loop; or accept Suspend; or accept Wake_Up(Top : in Natural) do Engine_Process.Top := Top; Initialize(The_Engine, Top); Draw(The_Engine, App.Project); Obj_Tag := None; Global_Content_Print(App.Project.Cur, The_Engine.Content_Win.win); if In_Print then if Print_Index /= 0 then if Printed /= null then Printed.Print(The_Engine.Obj_Header.Win, The_Engine.Obj_Main.Win); end if; else if Printed /= null then Printed.Print(The_Engine.Obj_Header.Win, The_Engine.Obj_Main.Win); else App.Project.Cur.Print(The_Engine.Obj_Header.Win, The_Engine.Obj_Main.Win); end if; end if; end if; if Last /= 0 then Success := Print_Set(File, The_Engine.File_Win, File_Index, Total_Line); end if; if App.Project.Root = null then Draw_Text(The_Engine.Cmd_Win, 1, 1, White, "# "); elsif App.Project.Cur.Info.Name /= null then Draw_Text(The_Engine.Cmd_Win, 1, 1, White, App.Project.Cur.Info.Name.all & "# "); else Draw_Text(The_Engine.Cmd_Win, 1, 1, White, "null# "); end if; end Wake_Up; exit; end select; end loop; end loop Main_Loop; --W_Io.Put_Line("Engine process halted"); end Engine_Process; task body Person_Process is Attribute_Curs : Attribute_Cursor_Type; Universe_Curs : Universe_Cursor_Type; Profile_Curs : Profile_Cursor_Type; Event_Curs : Event_Cursor_Type; Job_Curs : Job_Cursor_Type; Meeting_Curs : Meeting_Cursor_Type; Rendezvous_Curs : Rendezvous_Cursor_Type; Content_Curs : Content_Cursor_Type; Planning_Curs : Planning_Cursor_Type; Media_Curs : Media_Cursor_Type; Car_Curs : Car_Cursor_Type; House_Curs : House_Cursor_Type; Obj_Tag : Class_Enum := None; Cmd_Line : Wide_String (1..App.Columns/2-6); Line_Last : Natural := 0; Cmd : Class_Cmd_Enum := Null_cmd; Entreprise : Organizer_Type; Win_Index : Natural := 1; Verax : Boolean := False; Top : Natural := 0; In_Print : Boolean := False; Print_Index : Natural := 0; Printed : Abstract_Access; Path_Index : Natural := 0; Success : Boolean := False; Childs_Set : Wide_Set(4096); Line_Index : Natural := 0; Last : Natural := 0; Total_Line : Natural := 0; Level : Natural := 0; Is_Initialized : Boolean := False; Child_Index : Abstract_Index := 1; On_List : Boolean := False; On_Tree : Boolean := False; Name : Os_Lib.String_Access; --------------------------------------------------- -- View -- --------------------------------------------------- Activity_From : Window_Record := (3, 1, 10, App.Columns/4, Blue, The_Window); Activity_To : Window_Record := (3, (App.Columns/4)+1, 10, App.Columns/4, Blue, The_Window); Activity_Compta : Window_Record := (13, App.Columns/2+1, (App.Lines-20), App.Columns/2, Cyan, The_Window); Activity_Balance : Window_Record := (App.Lines-5, App.Columns/2+1, 3, App.Columns/2, Yellow, The_Window); Activity_Cmd : Window_Record := (App.Lines-2, 1, 3, App.Columns/2, White, The_Window); Date : Time := Clock; Line : Wide_String(1..App.Columns/2-2); Last_Line : Natural := 0; procedure State_Print(Date : in Time; Line_Max : in Line_Range) is State : Voice_Vectors.Vector; Page : Voice_Vectors.Vector; From : State_Type; To : State_Type; From_Line : Abstracted_Voice(256); To_Line : Abstracted_Voice(256); begin for Invoice in 1..Main_Accounts.Invoice_Last loop Append(State, new Abstracted_Voice ' (abstracted_voice(Main_Accounts.Billed(Invoice)))); end loop; for outvoice in 1..Main_Accounts.Outvoice_Last loop Append(State, new Abstracted_Voice ' (abstracted_voice(Main_Accounts.Charges(outvoice)))); end loop; Sorting.Sort(State); if not Is_Empty(State) then for Iter in 1..Length(State) loop declare Voice : constant Abstracted_Voice := Element(State, Voice_Index_Range(Iter)).all; begin if Voice.Date >= Date then Append(Page, new Abstracted_Voice ' (Voice)); end if; exit when Length(Page) = Count_Type(Line_Max); end; end loop; end if; Make_State(State, Time_Of(1970, 1, 1, 0.0), Date, From); if not Is_Empty(Page) then From_Line := First_Element(Page).all; From.Date := From_Line.date; end if; Draw_Window(Activity_From); Draw_Text(Activity_From, 1, 1, White, "From : " & Handling.To_Wide_String(Formatting.Image(From.Date))); Draw_Text(Activity_From, 2, 1, White, "Deal in HT : " & Handling.To_Wide_String(Fixed_Total'Image(From.Deal_In_Ht))); Draw_Text(Activity_From, 3, 1, White, "Deal in TTC : " & Handling.To_Wide_String(Fixed_Total'Image(From.Deal_In_TTC))); Draw_Text(Activity_From, 4, 1, White, "TVA out : " & Handling.To_Wide_String(Fixed_Total'Image(From.TVA_Out))); Draw_Text(Activity_From, 5, 1, White, "Deal out HT : " & Handling.To_Wide_String(Fixed_Total'Image(From.Deal_Out_Ht))); Draw_Text(Activity_From, 6, 1, White, "Deal out TTC : " & Handling.To_Wide_String(Fixed_Total'Image(From.Deal_Out_Ht))); Draw_Text(Activity_From, 7, 1, White, "TVA in : " & Handling.To_Wide_String(Fixed_Total'Image(From.TVA_In))); Draw_Text(Activity_From, 8, 1, White, "Result : " & Handling.To_Wide_String(Fixed_Total'Image(From.Result))); if not Is_Empty(Page) then Make_State(State, Time_Of(1970, 1, 1, 0.0), Last_Element(Page).Date, To); end if; if not Is_Empty(Page) then To_Line := Last_Element(Page).all; To.Date := To_Line.date; end if; Draw_Window(Activity_To); Draw_Text(Activity_To, 1, 1, White, "To : " & Handling.To_Wide_String(Formatting.Image(To.Date))); Draw_Text(Activity_To, 2, 1, White, "Deal in HT : " & Handling.To_Wide_String(Fixed_Total'Image(To.Deal_In_Ht))); Draw_Text(Activity_To, 3, 1, White, "Deal in TTC : " & Handling.To_Wide_String(Fixed_Total'Image(To.Deal_In_TTC))); Draw_Text(Activity_To, 4, 1, White, "TVA out : " & Handling.To_Wide_String(Fixed_Total'Image(To.TVA_Out))); Draw_Text(Activity_To, 5, 1, White, "Deal out HT : " & Handling.To_Wide_String(Fixed_Total'Image(To.Deal_Out_Ht))); Draw_Text(Activity_To, 6, 1, White, "Deal out TTC : " & Handling.To_Wide_String(Fixed_Total'Image(To.Deal_Out_Ht))); Draw_Text(Activity_To, 7, 1, White, "TVA in : " & Handling.To_Wide_String(Fixed_Total'Image(To.TVA_In))); Draw_Text(Activity_To, 8, 1, White, "Result : " & Handling.To_Wide_String(Fixed_Total'Image(To.Result))); Draw_Window(Activity_Compta); Draw_Text(Activity_Compta, 1, 1, White, "Voice Num, Acc N , Total HT , Total TVA , Total TTC , date , Peer Name"); Accounting_Wins_Draw(App.View_Wins); if not Is_Empty(Page) then for Iter in 1..Length(Page) loop declare Voice : constant Abstracted_Voice := Element(Page, Voice_Index_Range(Iter)).all; begin Accounting_Line_Draw(App.View_Wins, Line_Range(Iter), Voice); end; end loop; end if; end State_Print; Is_View : Boolean := False; begin Initialize(Entreprise, 0); Initialize(Activity_From , 3, 1, 10, (App.Columns)/4, Blue, White); Initialize(Activity_To , 3, App.Columns/4+1, 10, App.Columns/4, Blue, White); Initialize(Activity_Compta, 13, 1, (App.Lines-20), App.Columns/2, Cyan, White); Initialize(Activity_Balance ,App.Lines-5, 1, 3, App.Columns/2, Yellow, White); Initialize(Activity_Cmd, App.Lines-2, 1, 3, App.Columns/2, White, White); Initialize(App.Activity_Wins, App.Lines-23, App.Columns/2, 13, 2, 0); Main_Loop: loop loop select when Is_View => accept Receive(Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(9) => Is_View := False; Initialize(Activity_From , 3, App.Columns/2+1, 10, (App.Columns)/4, Blue, White); Initialize(Activity_To , 3, App.Columns/2+App.Columns/4+1, 10, App.Columns/4, Blue, White); Initialize(Activity_Compta, 13, App.Columns/2+1, (App.Lines-20), App.Columns/2, Cyan, White); Initialize(Activity_Balance ,App.Lines-5, App.Columns/2+1, 3, App.Columns/2, Yellow, White); Initialize(Activity_Cmd, App.Lines-2, App.Columns/2+1, 3, App.Columns/2, White, White); Initialize(App.View_Wins, App.Lines-23, App.Columns/2, 13, 2, App.Columns/2); ---------------------------------------------- --Errno := System("clear" & Character'Val(0)); ---------------------------------------------- State_Print(Date-86400.0, App.Lines-25); Draw_Window(Activity_Balance); Draw_Text(Activity_Balance, 1, 1, White, " Capital : " & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Main_Balance.Capital)) & ", Material :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Main_Balance.Material)) & ", TVA In :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Main_Balance.TVA_In)) & ", TVA Out :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Main_Balance.TVA_Out)) & "" ); Draw_Window(Activity_Cmd); if Last_Line > 0 then Draw_text(Activity_Cmd, 1, 1, White, "Date : " & Line(Line'First..Last_Line)); else Draw_text(Activity_Cmd, 1, 1, White, "Date : "); end if; Initialize(Entreprise, 0); Person_Process.Top := 0; Draw(Entreprise, App.Self); Obj_Tag := None; if Top = 0 then Entreprise.Proc.Start; end if; Global_Content_Print(App.Self.Cur, Entreprise.Content_Win.win); if In_Print then if Print_Index /= 0 then if Printed /= null then Printed.Print(Entreprise.Obj_Header.Win, Entreprise.Obj_Main.Win); end if; else if Printed /= null then Printed.Print(Entreprise.Obj_Header.Win, Entreprise.Obj_Main.Win); else App.Self.Cur.Print(Entreprise.Obj_Header.Win, Entreprise.Obj_Main.Win); end if; end if; end if; if Last /= 0 then Success := Print_Set(Childs_Set, Entreprise.List_Win, Line_Index, Total_Line); end if; if App.Self.Root = null then Draw_Text(Entreprise.Cmd_Win, 1, 1, White, "# "); elsif App.Self.Cur.Info.Name /= null then Draw_Text(Entreprise.Cmd_Win, 1, 1, White, App.Self.Cur.Info.Name.all & "# "); else Draw_Text(Entreprise.Cmd_Win, 1, 1, White, "null# "); end if; when Wide_Character ' Val (10) => begin Date := Formatting.Value(Handling.To_String(Line(1..Last_Line))); Line := (others => Wide_Character'Val(0)); Last_Line := 0; exception when Constraint_Error => null; end; when Wide_Character'Val (20) => Accountant.Close(M.Balance.Main_Balance, Accountant.Accounts); when Wide_Character'Val(127) => if Last_Line > 0 then Line(Last_Line) := Wide_Character'Val(32); Last_Line := Last_Line - 1; end if; when others => null; end case; ---------------------------------------------- --Errno := System("clear" & Character'Val(0)); ---------------------------------------------- if Is_View then State_Print(Date-86400.0, App.Lines-25); Draw_Window(Activity_Balance); Draw_Text(Activity_Balance, 1, 1, White, " Capital : " & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Main_Balance.Capital)) & ", Material :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Main_Balance.Material)) & ", TVA In :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Main_Balance.TVA_In)) & ", TVA Out :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Main_Balance.TVA_Out)) & "" ); Draw_Window(Activity_Cmd); if Last_Line > 0 then Draw_text(Activity_Cmd, 1, 1, White, "Date : " & Line(Line'First..Last_Line)); else Draw_text(Activity_Cmd, 1, 1, White, "Date : "); end if; end if; elsif Last_Line < App.Columns/2-2 then Line(Last_Line + 1) := Wchar; Last_Line := Last_Line + 1; Draw_Window(Activity_Cmd); if Last_Line > 0 then Draw_text(Activity_Cmd, 1, 1, White, "Date : " & Line(Line'First..Last_Line)); else Draw_text(Activity_Cmd, 1, 1, White, "Date : "); end if; else Put(Character'Val(7)); end if; end Receive; or when Obj_Tag = None and Cmd /= Attribute => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(1) => null; when Wide_Character'Val(9) => Initialize(Entreprise, App.Columns/2); Person_Process.Top := App.Columns/2; Draw(Entreprise, App.Self); Obj_Tag := None; if Top = 0 then Entreprise.Proc.Start; end if; Global_Content_Print(App.Self.Cur, Entreprise.Content_Win.win); if In_Print then if Print_Index /= 0 then if Printed /= null then Printed.Print(Entreprise.Obj_Header.Win, Entreprise.Obj_Main.Win); end if; else if Printed /= null then Printed.Print(Entreprise.Obj_Header.Win, Entreprise.Obj_Main.Win); else App.Self.Cur.Print(Entreprise.Obj_Header.Win, Entreprise.Obj_Main.Win); end if; end if; end if; if Last /= 0 then Success := Print_Set(Childs_Set, Entreprise.List_Win, Line_Index, Total_Line); end if; if App.Self.Root = null then Draw_Text(Entreprise.Cmd_Win, 1, 1, White, "# "); elsif App.Self.Cur.Info.Name /= null then Draw_Text(Entreprise.Cmd_Win, 1, 1, White, App.Self.Cur.Info.Name.all & "# "); else Draw_Text(Entreprise.Cmd_Win, 1, 1, White, "null# "); end if; Is_View := True; Top := 0; Initialize(Activity_From , 3, Top+1, 10, (App.Columns)/4, Blue, White); Initialize(Activity_To , 3, Top+App.Columns/4+1, 10, App.Columns/4, Blue, White); Initialize(Activity_Compta, 13, Top+1, (App.Lines-20), App.Columns/2, Cyan, White); Initialize(Activity_Balance ,App.Lines-5, Top+1, 3, App.Columns/2, Yellow, White); Initialize(Activity_Cmd, App.Lines-2, Top+1, 3, App.Columns/2, White, White); Initialize(App.View_Wins, App.Lines-23, App.Columns/2, 13, 2, Top); ---------------------------------------------- --Errno := System("clear" & Character'Val(0)); ---------------------------------------------- State_Print(Date-86400.0, App.Lines-25); Draw_Window(Activity_Balance); Draw_Text(Activity_Balance, 1, 1, White, " Capital : " & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Main_Balance.Capital)) & ", Material :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Main_Balance.Material)) & ", TVA In :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Main_Balance.TVA_In)) & ", TVA Out :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Main_Balance.TVA_Out)) & "" ); Draw_Window(Activity_Cmd); if Last_Line > 0 then Draw_text(Activity_Cmd, 1, 1, White, "Date : " & Line(Line'First..Last_Line)); else Draw_text(Activity_Cmd, 1, 1, White, "Date : "); end if; when Wide_Character'Val(10) => if Line_Last /= 0 then In_Print := False; Cmd := Class_Cmd_Value(Cmd_Line(1..Line_Last)); case Cmd is when Null_Cmd => null; when Help => Enlight_Window(Entreprise.List_Win); Object_Help(Entreprise.List_Win, Win_Index); Win_Index := 1; when Make => declare Tag_Name : Os_Lib.String_Access; begin if Wide_Fixed.Index(Cmd_Line(Cmd_Line'First..Line_Last), " ") /= 0 then Tag_Name := new String ' (Handling.To_String(Cmd_Line(Wide_Fixed.Index(Cmd_Line, " ")+1..Line_Last))); Obj_Tag := Class_Enum'Value(Tag_Name.all); case Obj_Tag is when None => null; when universe => Universe_Curs := Initialize; when Profile => Profile_Curs := Initialize; when Event => Event_Curs := Initialize; when Meeting => Meeting_Curs := Initialize; when Job => Job_Curs := Initialize; when Rendezvous => Rendezvous_Curs := Initialize; when Content => Content_Curs := Initialize; when Planning => Planning_Curs := Initialize; when Book..DVD => Media_Curs := Initialize; when Car => Car_Curs := Initialize; when House => House_Curs := Initialize; when others => null; end case; end if; exception when others => null; end; when Attribute => Attribute_Curs := Initialize; when Parent => Parent(App.Self); when Switch => if App.Self.Cur /= null then if Wide_Fixed.Index(Cmd_Line(Cmd_Line'First..Line_Last), " ") /= 0 then declare Index_name : M.Strings.Wide_String_Access; Index : Abstract_Index := 1; begin Index_name := new Wide_String ' (Cmd_Line(Wide_Fixed.Index(Cmd_Line, " ")+1..Line_Last)); Index := Abstract_Index'Value(Handling.To_String(Index_Name.all)); Switch(App.Self, Index, Verax); exception when others => null; end; end if; end if; when Root => App.Self.Cur := App.Self.Root; App.Self.Path := Abstract_Vectors.Empty_Vector; App.Self.Path := App.Self.Path & App.Self.Root; when Print => if App.Self.Cur /= null then if Wide_Fixed.Index(Cmd_Line(Cmd_Line'First..Line_Last), " ") /= 0 then declare Index_name : M.Strings.Wide_String_Access; Index : Natural := 0; begin Index_name := new Wide_String ' (Cmd_Line(Wide_Fixed.Index(Cmd_Line, " ")+1..Line_Last)); Print_Index := Natural'Value(Handling.To_String(Index_Name.all)); Printed := Child(App.Self.Cur, Print_Index); In_Print := True; Enlight_Window(Entreprise.Obj_Header); Text_Io.Put(Normal_Mode); Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Printed.Print(Entreprise.Obj_Header.Win, Entreprise.Obj_Main.Win); Enlight_Window(Entreprise.Obj_Attr); Text_Io.Put(Normal_Mode); Classes.Print(Printed.definition, Entreprise.Obj_Attr.Win); exception when others => declare Name : M.Strings.Wide_String_Access; Index : Abstract_Index := 1; begin Index_name := new Wide_String ' (Cmd_Line(Wide_Fixed.Index(Cmd_Line, " ")+1..Line_Last)); Printed := Child(App.Self.Cur, Index_Name.all); In_Print := True; Enlight_Window(Entreprise.Obj_Header); Text_Io.Put(Normal_Mode); Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Printed.Print(Entreprise.Obj_Header.Win, Entreprise.Obj_Main.Win); Enlight_Window(Entreprise.Obj_Attr); Text_Io.Put(Normal_Mode); Classes.Print(Printed.definition, Entreprise.Obj_Attr.Win); exception when others => null; end; end; else In_Print := True; Enlight_Window(Entreprise.Obj_Header); Text_Io.Put(Normal_Mode); Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); App.Self.Cur.Print(Entreprise.Obj_Header.Win, Entreprise.Obj_Main.Win); Enlight_Window(Entreprise.Obj_Attr); Text_Io.Put(Normal_Mode); Classes.Print(App.Self.Cur.Definition, Entreprise.Obj_Attr.Win); Print_Index := 0; Printed := null; end if; end if; when Search => if App.Self.Cur /= null then if Wide_Fixed.Index(Cmd_Line(Cmd_Line'First..Line_Last), " ") /= 0 then declare Index_name : M.Strings.Wide_String_Access; Index : Abstract_Index := 1; begin Index_name := new Wide_String ' (Cmd_Line(Wide_Fixed.Index(Cmd_Line, " ")+1..Line_Last)); Search(App.Self, Index_Name.all, Path_Index, Success); if Success then Enlight_Window(Entreprise.Obj_Header); Text_Io.Put(Normal_Mode); Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); App.Self.Cur.Print(Entreprise.Obj_Header.Win, Entreprise.Obj_Main.Win); Enlight_Window(Entreprise.Obj_Attr); Text_Io.Put(Normal_Mode); Classes.Print(Printed.definition, Entreprise.Obj_Attr.Win); In_Print := True; end if; Success := False; Path_Index := 0; exception when Constraint_Error => null; end; end if; end if; when List => Set_Free(Childs_Set); Enlight_Window(Entreprise.List_Win); Text_Io.Put(Normal_Mode); Last := 0; Total_Line := 0; Line_Index := 0; On_List := True; On_Tree := False; if App.Self.Cur /= null then if not Abstract_Vectors.Is_Empty(App.Self.Cur.Childs) then for Child in 1..Abstract_Vectors.Length(App.Self.Cur.Childs) loop declare E : constant Abstract_Access := Abstract_Vectors.Element(App.Self.Cur.Childs, Abstract_Index(Child)); begin Add_Line(Childs_Set, Last, To_String(E.Info)); end; end loop; end if; end if; Success := Print_Set(Childs_Set, Entreprise.List_Win, Line_Index, Total_Line); when Tree => On_Tree := True; On_List := False; Enlight_Window(Entreprise.List_Win); Text_Io.Put(Normal_Mode); Total_Line := 0; Line_Index := 0; Set_Free(Childs_Set); if App.Self.Cur /= null then Tree(App.Self.Cur, Level, Childs_Set, Last); Success := Print_Set(Childs_Set, Entreprise.List_Win, Line_Index, Total_Line); end if; when Remove => declare Name : M.Strings.Wide_String_Access; Index : Abstract_Index := 1; begin if Wide_Fixed.Index(Cmd_Line, " ") /= 0 then name := new Wide_String ' (Cmd_Line(Wide_Fixed.Index(Cmd_Line, " ")+1..Line_Last)); if Wide_Fixed.Index_Non_Blank(Name.all) /= 0 then Index := Abstract_Index'Value(Handling.To_String(Name.all)); Remove(App.terminal, Index); Save(App.Self.root, Person_Filename); end if; end if; if On_List then Set_Free(Childs_Set); Enlight_Window(Entreprise.List_Win); Text_Io.Put(Normal_Mode); Last := 0; Total_Line := 0; Line_Index := 0; if App.Self.Cur /= null then if not Abstract_Vectors.Is_Empty(App.Self.Cur.Childs) then for Child in 1..Abstract_Vectors.Length(App.Self.Cur.Childs) loop declare E : constant Abstract_Access := Abstract_Vectors.Element(App.Self.Cur.Childs, Abstract_Index(Child)); begin Add_Line(Childs_Set, Last, To_String(E.Info)); end; end loop; end if; end if; Success := Print_Set(Childs_Set, Entreprise.List_Win, Line_Index, Total_Line); elsif On_Tree then Total_Line := 0; Line_Index := 0; Enlight_Window(Entreprise.List_Win); Text_Io.Put(Normal_Mode); Set_Free(Childs_Set); if App.Self.Cur /= null then Tree(App.Self.Cur, Level, Childs_Set, Last); Success := Print_Set(Childs_Set, Entreprise.List_Win, Line_Index, Total_Line); end if; end if; Success := Print_Set(Childs_Set, Entreprise.List_Win, Line_Index, Total_Line); exception when others => null; end; end case; end if; Line_Last := 0; when Wide_Character'Val(12) => Last := 0; Printed := null; Print_Index := 0; Initialize(Entreprise, Top); Draw(Entreprise, App.Self); Enlight_Window(Entreprise.Content_Win); Text_Io.Put(Normal_Mode); Global_Content_Print(App.Self.Cur, Entreprise.Content_Win.win); Enlight_Window(Entreprise.cmd_Win); Text_Io.Put(Normal_Mode); if App.Self.Cur = null then Draw_Text(Entreprise.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Self.Cur.Info.Name /= null then Draw_Text(Entreprise.Cmd_Win, 1, 1, White, App.Self.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(Entreprise.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; when Wide_Character'Val(127) => if Line_Last > 0 then Cmd_Line(Line_Last) := Wide_Character'Val(32); Line_Last := Line_Last - 1; else Text_Io.Put(Character'Val(7)); end if; when others => null; end case; else if App.Self.Root /= null and then App.Self.cur.Info.Name /= null then if Line_Last + 1 <= (Cmd_Line'Length-App.Self.cur.Info.Name'Length) then Cmd_Line(Line_Last + 1) := Wchar; Line_Last := Line_Last + 1; else Text_Io.Put(Character'Val(7)); end if; elsif Line_Last + 1 <= Cmd_Line'Length then Cmd_Line(Line_Last + 1) := Wchar; Line_Last := Line_Last + 1; else Text_Io.Put(Character'Val(7)); end if; end if; end Receive; if not Is_View then Enlight_Window(Entreprise.Content_Win); Text_Io.Put(Normal_Mode); Global_Content_Print(App.Self.Cur, Entreprise.Content_Win.win); Enlight_Window(Entreprise.cmd_Win); Text_Io.Put(Normal_Mode); if App.Self.Cur = null then Draw_Text(Entreprise.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Self.Cur.Info.Name /= null then Draw_Text(Entreprise.Cmd_Win, 1, 1, White, App.Self.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(Entreprise.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; case Obj_Tag is when None => case Cmd is when Attribute => Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Entreprise.Obj_Main, 2, 1, White, "Image : "); Draw_Text(Entreprise.Obj_Main, 1, 1, White, "Name : "); for Val in Attribute_Name..Attribute_Image loop Draw_Text(Entreprise.Obj_Main, Attribute_Curs.values(Val).Line_Pos, Attribute_Curs.values(Val).Column_Pos, White, Attribute_Curs.values(Val).Line(1..Attribute_Curs.values(Val).Line_Last)); end loop; Draw_Text(Entreprise.Obj_Main, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Pos, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Column_Pos, White, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line(1..Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last)); when others => null; end case; when Profile => Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Entreprise.Obj_Main, 2, 1, White, "Born : "); Draw_Text(Entreprise.Obj_Main, 3, 1, White, "Addr : "); Draw_Text(Entreprise.Obj_Main, 4, 1, White, "Phone : "); Draw_Text(Entreprise.Obj_Main, 5, 1, White, "Email : "); Draw_Text(Entreprise.Obj_Main, 1, 1, White, "Name : "); when Content => Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Entreprise.Obj_Main, 2, 1, White, "Define : "); Draw_Text(Entreprise.Obj_Main, 3, 1, White, "Price : "); Draw_Text(Entreprise.Obj_Main, 1, 1, White, "Name : "); when Planning => Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Entreprise.Obj_Main, 2, 1, White, "From : "); Draw_Text(Entreprise.Obj_Main, 3, 1, White, "To : "); Draw_Text(Entreprise.Obj_Main, 1, 1, White, "Name : "); when Universe => Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Entreprise.Obj_Main, 1, 1, White, "Name : "); when Event .. Rendezvous => Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Entreprise.Obj_Main, 2, 1, White, "Date : "); Draw_Text(Entreprise.Obj_Main, 3, 1, White, "Period : "); Draw_Text(Entreprise.Obj_Main, 4, 1, White, "Locality : "); Draw_Text(Entreprise.Obj_Main, 5, 1, White, "Define : "); Draw_Text(Entreprise.Obj_Main, 1, 1, White, "Name : "); when Book..CDROM => Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Entreprise.Obj_Main, 2, 1, White, "Author : "); Draw_Text(Entreprise.Obj_Main, 3, 1, White, "Editor : "); Draw_Text(Entreprise.Obj_Main, 1, 1, White, "Title : "); when Car => Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Entreprise.Obj_Main, 2, 1, White, "Mark : "); Draw_Text(Entreprise.Obj_Main, 3, 1, White, "Model : "); Draw_Text(Entreprise.Obj_Main, 4, 1, White, "Mat : "); Draw_Text(Entreprise.Obj_Main, 1, 1, White, "Name : "); when House => Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Entreprise.Obj_Main, 2, 1, White, "Addr : "); Draw_Text(Entreprise.Obj_Main, 3, 1, White, "Surf : "); Draw_Text(Entreprise.Obj_Main, 1, 1, White, "Name : "); when others => Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Entreprise.Obj_Main, 1, 1, White, "Name : "); end case; if App.Self.Root /= null then Child_Index := Abstract_Index(Abstract_Vectors.Length(App.Self.Cur.childs)+1); else Child_Index := 1; end if; end if; or when Cmd = attribute => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(1) => Attribute_Curs := Initialize; Enlight_Window(Entreprise.Obj_Header); Enlight_Window(Entreprise.Obj_Main); Enlight_Window(Entreprise.Obj_Attr); Text_Io.Put(Normal_Mode); Obj_Tag := None; when Wide_Character'Val(10) => if Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last /= 0 then case Attribute_Curs.Val_Cur is when Attribute_None => null; when Attribute_Name => Name := new String ' (Handling.To_String(Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line(1..Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last))); Attribute_Curs.Val_Cur := Attribute_Enum'Succ(Attribute_Curs.Val_Cur); when Attribute_Image => if App.Self.Cur /= null then if App.Self.Cur.Definition.Index < App.Self.Cur.Definition.List'Last then App.Self.Cur.Definition.List(App.Self.Cur.Definition.Index + 1) := Make(Name.all, Handling.To_String(Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line(1..Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last))); App.Self.Cur.Definition.Index := App.Self.Cur.Definition.Index + 1; end if; end if; attribute_Curs := Initialize; Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Free(Name); Attribute_Curs.Val_Cur := Attribute_None; Cmd := Null_cmd; Save(App.Self.root, Person_Filename); end case; else Put(Character'Val(7)); end if; when Wide_Character ' Val (127) => if Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last > 0 then Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line(Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last) := ' '; Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last := Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last - 1; end if; when others => null; end case; elsif Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last < 45 then Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line(Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last + 1) := Wchar; Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last := Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last + 1; for Val in Attribute_Name..Attribute_image loop Draw_Text(Entreprise.Obj_Main, Attribute_Curs.values(Val).Line_Pos, Attribute_Curs.values(Val).Column_Pos, White, Attribute_Curs.values(Val).Line(1..Attribute_Curs.values(Val).Line_Last)); end loop; Draw_Text(Entreprise.Obj_Main, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Pos, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Column_Pos, White, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line(1..Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; end Receive; case Attribute_Curs.Val_Cur is when Attribute_none => Draw(Entreprise, App.Self); Global_Content_Print(App.Self.Cur, Entreprise.Content_Win.win); Enlight_Window(Entreprise.Obj_Main); Enlight_Window(Entreprise.Obj_Attr); Text_Io.Put(Normal_Mode); if App.Self.Cur /= null then for I in 1..App.Self.Cur.Definition.Index loop Draw_Text(Entreprise.Obj_Attr, I, 1, white, Handling.To_Wide_String(App.Self.Cur.Definition.List(I).Name.all)); Draw_Text(Entreprise.Obj_Attr, I, App.Self.Cur.Definition.List(I).Name'Length+1, Red, "="); Draw_Text(Entreprise.Obj_Attr, I, App.Self.Cur.Definition.List(I).Name'Length+2, white, Handling.To_Wide_String(App.Self.Cur.Definition.List(I).Value.all)); end loop; end if; Enlight_Window(Entreprise.cmd_Win); Text_Io.Put(Normal_Mode); if App.Self.Cur = null then Draw_Text(Entreprise.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Self.Cur.Info.Name /= null then Draw_Text(Entreprise.Cmd_Win, 1, 1, White, App.Self.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(Entreprise.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; when others => Draw(Entreprise, App.Self); Global_Content_Print(App.Self.Cur, Entreprise.Content_Win.win); Enlight_Window(Entreprise.Obj_Main); Enlight_Window(Entreprise.cmd_Win); Enlight_Window(Entreprise.Obj_Attr); Text_Io.Put(Normal_Mode); if App.Self.Cur /= null then for I in 1..App.Self.Cur.Definition.Index loop Draw_Text(Entreprise.Obj_Attr, I, 1, white, Handling.To_Wide_String(App.Self.Cur.Definition.List(I).Name.all)); Draw_Text(Entreprise.Obj_Attr, I, App.Self.Cur.Definition.List(I).Name'Length+1, Red, "="); Draw_Text(Entreprise.Obj_Attr, I, App.Self.Cur.Definition.List(I).Name'Length+2, white, Handling.To_Wide_String(App.Self.Cur.Definition.List(I).Value.all)); end loop; end if; if App.Self.Cur = null then Draw_Text(Entreprise.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Self.Cur.Info.Name /= null then Draw_Text(Entreprise.Cmd_Win, 1, 1, White, App.Self.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(Entreprise.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; Draw_Text(Entreprise.Obj_Main, 2, 1, White, "Image : "); Draw_Text(Entreprise.Obj_Main, 1, 1, White, "Name : "); for Val in Attribute_Name..Attribute_Image loop Draw_Text(Entreprise.Obj_Main, Attribute_Curs.values(Val).Line_Pos, Attribute_Curs.values(Val).Column_Pos, White, Attribute_Curs.values(Val).Line(1..Attribute_Curs.values(Val).Line_Last)); end loop; Draw_Text(Entreprise.Obj_Main, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Pos, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Column_Pos, White, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line(1..Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last)); null; end case; or when Obj_Tag = Profile => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(1) => Profile_Curs := Initialize; Enlight_Window(Entreprise.Obj_Header); Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Obj_Tag := None; when Wide_Character'Val(10) => if Profile_Curs.Values(Profile_Curs.Val_Cur).Line_Last /= 0 then case Profile_Curs.Val_Cur is when Profile_None => null; when Profile_Email => declare Profile : constant Profile_Class := To_Profile(Profile_Curs, Child_Index); begin Add_To(App.Self, new Profile_Class '(Profile)); Save(App.Self.root, Person_Filename); end; Profile_Curs := Initialize; Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Obj_Tag := None; when others => Profile_Curs.Val_Cur := Profile_Enum'Succ(Profile_Curs.Val_Cur); end case; Draw_Text(Entreprise.Obj_Main, Profile_Curs.Values(Profile_Curs.Val_Cur).Line_Pos, Profile_Curs.Values(Profile_Curs.Val_Cur).Column_Pos, White, Profile_Curs.Values(Profile_Curs.Val_Cur).Line(1..Profile_Curs.Values(Profile_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; when Wide_Character ' Val (127) => if Profile_Curs.Values(Profile_Curs.Val_Cur).Line_Last > 0 then Profile_Curs.Values(Profile_Curs.Val_Cur).Line(Profile_Curs.Values(Profile_Curs.Val_Cur).Line_Last) := ' '; Profile_Curs.Values(Profile_Curs.Val_Cur).Line_Last := Profile_Curs.Values(Profile_Curs.Val_Cur).Line_Last - 1; end if; Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Entreprise.Obj_Main, 2, 1, White, "Born : "); Draw_Text(Entreprise.Obj_Main, 3, 1, White, "Addr : "); Draw_Text(Entreprise.Obj_Main, 4, 1, White, "Phone : "); Draw_Text(Entreprise.Obj_Main, 5, 1, White, "Email : "); Draw_Text(Entreprise.Obj_Main, 1, 1, White, "Name : "); for Val in Profile_Full_Name..Profile_Email loop Draw_Text(Entreprise.Obj_Main, Profile_Curs.values(Val).Line_Pos, Profile_Curs.values(Val).Column_Pos, White, Profile_Curs.values(Val).Line(1..Profile_Curs.values(Val).Line_Last)); end loop; Draw_Text(Entreprise.Obj_Main, Profile_Curs.Values(Profile_Curs.Val_Cur).Line_Pos, Profile_Curs.Values(Profile_Curs.Val_Cur).Column_Pos, White, Profile_Curs.Values(Profile_Curs.Val_Cur).Line(1..Profile_Curs.Values(Profile_Curs.Val_Cur).Line_Last)); when others => null; end case; elsif Profile_Curs.Values(Profile_Curs.Val_Cur).Line_Last < 45 then Profile_Curs.Values(Profile_Curs.Val_Cur).Line(Profile_Curs.Values(Profile_Curs.Val_Cur).Line_Last + 1) := Wchar; Profile_Curs.Values(Profile_Curs.Val_Cur).Line_Last := Profile_Curs.Values(Profile_Curs.Val_Cur).Line_Last + 1; else Put(Character'Val(7)); end if; end Receive; Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Entreprise.Obj_Main, 2, 1, White, "Born : "); Draw_Text(Entreprise.Obj_Main, 3, 1, White, "Addr : "); Draw_Text(Entreprise.Obj_Main, 4, 1, White, "Phone : "); Draw_Text(Entreprise.Obj_Main, 5, 1, White, "Email : "); Draw_Text(Entreprise.Obj_Main, 1, 1, White, "Name : "); for Val in Profile_Full_Name..Profile_Email loop Draw_Text(Entreprise.Obj_Main, Profile_Curs.values(Val).Line_Pos, Profile_Curs.values(Val).Column_Pos, White, Profile_Curs.values(Val).Line(1..Profile_Curs.values(Val).Line_Last)); end loop; Draw_Text(Entreprise.Obj_Main, Profile_Curs.Values(Profile_Curs.Val_Cur).Line_Pos, Profile_Curs.Values(Profile_Curs.Val_Cur).Column_Pos, White, Profile_Curs.Values(Profile_Curs.Val_Cur).Line(1..Profile_Curs.Values(Profile_Curs.Val_Cur).Line_Last)); case Obj_Tag is when None => Draw(Entreprise, App.Self); Global_Content_Print(App.Self.Cur, Entreprise.Content_Win.win); Enlight_Window(Entreprise.cmd_Win); Text_Io.Put(Normal_Mode); if App.Self.Root = null then Draw_Text(Entreprise.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Self.Cur.Info.Name /= null then Draw_Text(Entreprise.Cmd_Win, 1, 1, White, App.Self.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(Entreprise.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; when others => null; end case; or when Obj_Tag = Content => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(1) => Content_Curs := Initialize; Enlight_Window(Entreprise.Obj_Header); Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Obj_Tag := None; when Wide_Character'Val(10) => if Content_Curs.Values(Content_Curs.Val_Cur).Line_Last /= 0 then case Content_Curs.Val_Cur is when Content_None => null; when Content_Price => declare Content : constant Content_Class := To_Content(Content_Curs, Child_Index); begin Add_To(App.Self, new Content_Class '(Content)); Save(App.Self.root, Person_Filename); end; Content_Curs := Initialize; Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Obj_Tag := None; when others => Content_Curs.Val_Cur := Content_Enum'Succ(Content_Curs.Val_Cur); end case; Draw_Text(Entreprise.Obj_Main, Content_Curs.Values(Content_Curs.Val_Cur).Line_Pos, Content_Curs.Values(Content_Curs.Val_Cur).Column_Pos, White, Content_Curs.Values(Content_Curs.Val_Cur).Line(1..Content_Curs.Values(Content_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; when Wide_Character ' Val (127) => if Content_Curs.Values(Content_Curs.Val_Cur).Line_Last > 0 then Content_Curs.Values(Content_Curs.Val_Cur).Line(Content_Curs.Values(Content_Curs.Val_Cur).Line_Last) := ' '; Content_Curs.Values(Content_Curs.Val_Cur).Line_Last := Content_Curs.Values(Content_Curs.Val_Cur).Line_Last - 1; end if; Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Entreprise.Obj_Main, 2, 1, White, "Define : "); Draw_Text(Entreprise.Obj_Main, 3, 1, White, "Price : "); Draw_Text(Entreprise.Obj_Main, 1, 1, White, "Name : "); for Val in Content_Name..Content_Price loop Draw_Text(Entreprise.Obj_Main, Content_Curs.values(Val).Line_Pos, Content_Curs.values(Val).Column_Pos, White, Content_Curs.values(Val).Line(1..Content_Curs.values(Val).Line_Last)); end loop; Draw_Text(Entreprise.Obj_Main, Content_Curs.Values(Content_Curs.Val_Cur).Line_Pos, Content_Curs.Values(Content_Curs.Val_Cur).Column_Pos, White, Content_Curs.Values(Content_Curs.Val_Cur).Line(1..Content_Curs.Values(Content_Curs.Val_Cur).Line_Last)); when others => null; end case; elsif Content_Curs.Values(Content_Curs.Val_Cur).Line_Last < 45 then Content_Curs.Values(Content_Curs.Val_Cur).Line(Content_Curs.Values(Content_Curs.Val_Cur).Line_Last + 1) := Wchar; Content_Curs.Values(Content_Curs.Val_Cur).Line_Last := Content_Curs.Values(Content_Curs.Val_Cur).Line_Last + 1; for Val in Content_Name..Content_Price loop Draw_Text(Entreprise.Obj_Main, Content_Curs.values(Val).Line_Pos, Content_Curs.values(Val).Column_Pos, White, Content_Curs.values(Val).Line(1..Content_Curs.values(Val).Line_Last)); end loop; Draw_Text(Entreprise.Obj_Main, Content_Curs.Values(Content_Curs.Val_Cur).Line_Pos, Content_Curs.Values(Content_Curs.Val_Cur).Column_Pos, White, Content_Curs.Values(Content_Curs.Val_Cur).Line(1..Content_Curs.Values(Content_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; end Receive; case Obj_Tag is when None => Draw(Entreprise, App.Self); Global_Content_Print(App.Self.Cur, Entreprise.Content_Win.win); Enlight_Window(Entreprise.cmd_Win); Text_Io.Put(Normal_Mode); if App.Self.Cur = null then Draw_Text(Entreprise.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Self.Cur.Info.Name /= null then Draw_Text(Entreprise.Cmd_Win, 1, 1, White, App.Self.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(Entreprise.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; when others => null; end case; or when Obj_Tag = Planning => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(1) => Planning_Curs := Initialize; Enlight_Window(Entreprise.Obj_Header); Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Obj_Tag := None; when Wide_Character'Val(10) => if Planning_Curs.Values(Planning_Curs.Val_Cur).Line_Last /= 0 then case Planning_Curs.Val_Cur is when Planning_None => null; when Planning_To => declare Planning : constant Planning_Class := To_Planning(Planning_Curs, Child_Index); begin Add_To(App.Self, new Planning_Class '(Planning)); Save(App.Self.root, Person_Filename); end; Planning_Curs := Initialize; Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Obj_Tag := None; when others => Planning_Curs.Val_Cur := Planning_Enum'Succ(Planning_Curs.Val_Cur); end case; Draw_Text(Entreprise.Obj_Main, Planning_Curs.Values(Planning_Curs.Val_Cur).Line_Pos, Planning_Curs.Values(Planning_Curs.Val_Cur).Column_Pos, White, Planning_Curs.Values(Planning_Curs.Val_Cur).Line(1..Planning_Curs.Values(Planning_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; when Wide_Character ' Val (127) => if Planning_Curs.Values(Planning_Curs.Val_Cur).Line_Last > 0 then Planning_Curs.Values(Planning_Curs.Val_Cur).Line(Planning_Curs.Values(Planning_Curs.Val_Cur).Line_Last) := ' '; Planning_Curs.Values(Planning_Curs.Val_Cur).Line_Last := Planning_Curs.Values(Planning_Curs.Val_Cur).Line_Last - 1; end if; Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Entreprise.Obj_Main, 2, 1, White, "From : "); Draw_Text(Entreprise.Obj_Main, 3, 1, White, "To : "); Draw_Text(Entreprise.Obj_Main, 1, 1, White, "Name : "); for Val in Planning_Name..Planning_To loop Draw_Text(Entreprise.Obj_Main, Planning_Curs.values(Val).Line_Pos, Planning_Curs.values(Val).Column_Pos, White, Planning_Curs.values(Val).Line(1..Planning_Curs.values(Val).Line_Last)); end loop; Draw_Text(Entreprise.Obj_Main, Planning_Curs.Values(Planning_Curs.Val_Cur).Line_Pos, Planning_Curs.Values(Planning_Curs.Val_Cur).Column_Pos, White, Planning_Curs.Values(Planning_Curs.Val_Cur).Line(1..Planning_Curs.Values(Planning_Curs.Val_Cur).Line_Last)); when others => null; end case; elsif Planning_Curs.Values(Planning_Curs.Val_Cur).Line_Last < 45 then Planning_Curs.Values(Planning_Curs.Val_Cur).Line(Planning_Curs.Values(Planning_Curs.Val_Cur).Line_Last + 1) := Wchar; Planning_Curs.Values(Planning_Curs.Val_Cur).Line_Last := Planning_Curs.Values(Planning_Curs.Val_Cur).Line_Last + 1; for Val in Planning_Name..Planning_To loop Draw_Text(Entreprise.Obj_Main, Planning_Curs.values(Val).Line_Pos, Planning_Curs.values(Val).Column_Pos, White, Planning_Curs.values(Val).Line(1..Planning_Curs.values(Val).Line_Last)); end loop; Draw_Text(Entreprise.Obj_Main, Planning_Curs.Values(Planning_Curs.Val_Cur).Line_Pos, Planning_Curs.Values(Planning_Curs.Val_Cur).Column_Pos, White, Planning_Curs.Values(Planning_Curs.Val_Cur).Line(1..Planning_Curs.Values(Planning_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; end Receive; case Obj_Tag is when None => Draw(Entreprise, App.Self); Global_Content_Print(App.Self.Cur, Entreprise.Content_Win.win); Enlight_Window(Entreprise.cmd_Win); Text_Io.Put(Normal_Mode); if App.Self.Cur = null then Draw_Text(Entreprise.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Self.Cur.Info.Name /= null then Draw_Text(Entreprise.Cmd_Win, 1, 1, White, App.Self.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(Entreprise.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; when others => null; end case; or when Obj_Tag = Event => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(1) => Event_Curs := Initialize; Enlight_Window(Entreprise.Obj_Header); Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Obj_Tag := None; when Wide_Character'Val(10) => if Event_Curs.Values(Event_Curs.Val_Cur).Line_Last /= 0 then case Event_Curs.Val_Cur is when Event_None => null; when Event_Define => declare Event : constant Event_Class := To_Event(Event_Curs, Child_Index); begin Add_To(App.Self, new Event_Class '(Event)); Save(App.Self.root, Person_Filename); end; Event_Curs := Initialize; Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Obj_Tag := None; when others => Event_Curs.Val_Cur := Event_Enum'Succ(Event_Curs.Val_Cur); end case; Draw_Text(Entreprise.Obj_Main, Event_Curs.Values(Event_Curs.Val_Cur).Line_Pos, Event_Curs.Values(Event_Curs.Val_Cur).Column_Pos, White, Event_Curs.Values(Event_Curs.Val_Cur).Line(1..Event_Curs.Values(Event_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; when Wide_Character ' Val (127) => if Event_Curs.Values(Event_Curs.Val_Cur).Line_Last > 0 then Event_Curs.Values(Event_Curs.Val_Cur).Line(Event_Curs.Values(Event_Curs.Val_Cur).Line_Last) := ' '; Event_Curs.Values(Event_Curs.Val_Cur).Line_Last := Event_Curs.Values(Event_Curs.Val_Cur).Line_Last - 1; end if; Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Entreprise.Obj_Main, 2, 1, White, "Date : "); Draw_Text(Entreprise.Obj_Main, 3, 1, White, "Period : "); Draw_Text(Entreprise.Obj_Main, 4, 1, White, "Locality : "); Draw_Text(Entreprise.Obj_Main, 5, 1, White, "Define : "); Draw_Text(Entreprise.Obj_Main, 1, 1, White, "Name : "); for Val in Event_Name..Event_Define loop Draw_Text(Entreprise.Obj_Main, Event_Curs.values(Val).Line_Pos, Event_Curs.values(Val).Column_Pos, White, Event_Curs.values(Val).Line(1..Event_Curs.values(Val).Line_Last)); end loop; Draw_Text(Entreprise.Obj_Main, Event_Curs.Values(Event_Curs.Val_Cur).Line_Pos, Event_Curs.Values(Event_Curs.Val_Cur).Column_Pos, White, Event_Curs.Values(Event_Curs.Val_Cur).Line(1..Event_Curs.Values(Event_Curs.Val_Cur).Line_Last)); when others => null; end case; elsif Event_Curs.Values(Event_Curs.Val_Cur).Line_Last < 45 then Event_Curs.Values(Event_Curs.Val_Cur).Line(Event_Curs.Values(Event_Curs.Val_Cur).Line_Last + 1) := Wchar; Event_Curs.Values(Event_Curs.Val_Cur).Line_Last := Event_Curs.Values(Event_Curs.Val_Cur).Line_Last + 1; for Val in Event_Name..Event_Define loop Draw_Text(Entreprise.Obj_Main, Event_Curs.values(Val).Line_Pos, Event_Curs.values(Val).Column_Pos, White, Event_Curs.values(Val).Line(1..Event_Curs.values(Val).Line_Last)); end loop; Draw_Text(Entreprise.Obj_Main, Event_Curs.Values(Event_Curs.Val_Cur).Line_Pos, Event_Curs.Values(Event_Curs.Val_Cur).Column_Pos, White, Event_Curs.Values(Event_Curs.Val_Cur).Line(1..Event_Curs.Values(Event_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; end Receive; case Obj_Tag is when None => Draw(Entreprise, App.Self); Global_Content_Print(App.Self.Cur, Entreprise.Content_Win.win); Enlight_Window(Entreprise.cmd_Win); Text_Io.Put(Normal_Mode); if App.Self.Cur = null then Draw_Text(Entreprise.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Self.Cur.Info.Name /= null then Draw_Text(Entreprise.Cmd_Win, 1, 1, White, App.Self.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(Entreprise.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; when others => null; end case; or when Obj_Tag = Job => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(1) => Job_Curs := Initialize; Enlight_Window(Entreprise.Obj_Header); Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Obj_Tag := None; when Wide_Character'Val(10) => if Job_Curs.Values(Job_Curs.Val_Cur).Line_Last /= 0 then case Job_Curs.Val_Cur is when Job_None => null; when Job_Define => declare Job : constant Job_Class := To_Job(Job_Curs, Child_Index); begin Add_To(App.Self, new Job_Class '(Job)); Save(App.Self.root, Person_Filename); end; Job_Curs := Initialize; Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Obj_Tag := None; when others => Job_Curs.Val_Cur := Job_Enum'Succ(Job_Curs.Val_Cur); end case; Draw_Text(Entreprise.Obj_Main, Job_Curs.Values(Job_Curs.Val_Cur).Line_Pos, Job_Curs.Values(Job_Curs.Val_Cur).Column_Pos, White, Job_Curs.Values(Job_Curs.Val_Cur).Line(1..Job_Curs.Values(Job_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; when Wide_Character ' Val (127) => if Job_Curs.Values(Job_Curs.Val_Cur).Line_Last > 0 then Job_Curs.Values(Job_Curs.Val_Cur).Line(Job_Curs.Values(Job_Curs.Val_Cur).Line_Last) := ' '; Job_Curs.Values(Job_Curs.Val_Cur).Line_Last := Job_Curs.Values(Job_Curs.Val_Cur).Line_Last - 1; end if; Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Entreprise.Obj_Main, 2, 1, White, "Date : "); Draw_Text(Entreprise.Obj_Main, 3, 1, White, "Period : "); Draw_Text(Entreprise.Obj_Main, 4, 1, White, "Locality : "); Draw_Text(Entreprise.Obj_Main, 5, 1, White, "Define : "); Draw_Text(Entreprise.Obj_Main, 1, 1, White, "Name : "); for Val in Job_Name..Job_Define loop Draw_Text(Entreprise.Obj_Main, Job_Curs.values(Val).Line_Pos, Job_Curs.values(Val).Column_Pos, White, Job_Curs.values(Val).Line(1..Job_Curs.values(Val).Line_Last)); end loop; Draw_Text(Entreprise.Obj_Main, Job_Curs.Values(Job_Curs.Val_Cur).Line_Pos, Job_Curs.Values(Job_Curs.Val_Cur).Column_Pos, White, Job_Curs.Values(Job_Curs.Val_Cur).Line(1..Job_Curs.Values(Job_Curs.Val_Cur).Line_Last)); when others => null; end case; elsif Job_Curs.Values(Job_Curs.Val_Cur).Line_Last < 45 then Job_Curs.Values(Job_Curs.Val_Cur).Line(Job_Curs.Values(Job_Curs.Val_Cur).Line_Last + 1) := Wchar; Job_Curs.Values(Job_Curs.Val_Cur).Line_Last := Job_Curs.Values(Job_Curs.Val_Cur).Line_Last + 1; for Val in Job_Name..Job_Define loop Draw_Text(Entreprise.Obj_Main, Job_Curs.values(Val).Line_Pos, Job_Curs.values(Val).Column_Pos, White, Job_Curs.values(Val).Line(1..Job_Curs.values(Val).Line_Last)); end loop; Draw_Text(Entreprise.Obj_Main, Job_Curs.Values(Job_Curs.Val_Cur).Line_Pos, Job_Curs.Values(Job_Curs.Val_Cur).Column_Pos, White, Job_Curs.Values(Job_Curs.Val_Cur).Line(1..Job_Curs.Values(Job_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; end Receive; case Obj_Tag is when None => Draw(Entreprise, App.Self); Global_Content_Print(App.Self.Cur, Entreprise.Content_Win.win); Enlight_Window(Entreprise.cmd_Win); Text_Io.Put(Normal_Mode); if App.Self.Cur = null then Draw_Text(Entreprise.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Self.Cur.Info.Name /= null then Draw_Text(Entreprise.Cmd_Win, 1, 1, White, App.Self.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(Entreprise.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; when others => null; end case; or when Obj_Tag = Meeting => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(1) => Meeting_Curs := Initialize; Enlight_Window(Entreprise.Obj_Header); Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Obj_Tag := None; when Wide_Character'Val(10) => if Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line_Last /= 0 then case Meeting_Curs.Val_Cur is when Meeting_None => null; when Meeting_Define => declare Meeting : constant Meeting_Class := To_Meeting(Meeting_Curs, Child_index); begin Add_To(App.Self, new Meeting_Class '(Meeting)); Save(App.Self.root, Person_Filename); end; Meeting_Curs := Initialize; Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Obj_Tag := None; when others => Meeting_Curs.Val_Cur := Meeting_Enum'Succ(Meeting_Curs.Val_Cur); end case; Draw_Text(Entreprise.Obj_Main, Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line_Pos, Meeting_Curs.Values(Meeting_Curs.Val_Cur).Column_Pos, White, Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line(1..Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; when Wide_Character ' Val (127) => if Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line_Last > 0 then Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line(Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line_Last) := ' '; Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line_Last := Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line_Last - 1; end if; Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Entreprise.Obj_Main, 2, 1, White, "Date : "); Draw_Text(Entreprise.Obj_Main, 3, 1, White, "Period : "); Draw_Text(Entreprise.Obj_Main, 4, 1, White, "Locality : "); Draw_Text(Entreprise.Obj_Main, 5, 1, White, "Define : "); Draw_Text(Entreprise.Obj_Main, 1, 1, White, "Name : "); for Val in Meeting_Name..Meeting_Define loop Draw_Text(Entreprise.Obj_Main, Meeting_Curs.values(Val).Line_Pos, Meeting_Curs.values(Val).Column_Pos, White, Meeting_Curs.values(Val).Line(1..Meeting_Curs.values(Val).Line_Last)); end loop; Draw_Text(Entreprise.Obj_Main, Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line_Pos, Meeting_Curs.Values(Meeting_Curs.Val_Cur).Column_Pos, White, Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line(1..Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line_Last)); when others => null; end case; elsif Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line_Last < 45 then Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line(Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line_Last + 1) := Wchar; Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line_Last := Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line_Last + 1; for Val in Meeting_Name..Meeting_Define loop Draw_Text(Entreprise.Obj_Main, Meeting_Curs.values(Val).Line_Pos, Meeting_Curs.values(Val).Column_Pos, White, Meeting_Curs.values(Val).Line(1..Meeting_Curs.values(Val).Line_Last)); end loop; Draw_Text(Entreprise.Obj_Main, Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line_Pos, Meeting_Curs.Values(Meeting_Curs.Val_Cur).Column_Pos, White, Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line(1..Meeting_Curs.Values(Meeting_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; end Receive; case Obj_Tag is when None => Draw(Entreprise, App.Self); Global_Content_Print(App.Self.Cur, Entreprise.Content_Win.win); Enlight_Window(Entreprise.cmd_Win); Text_Io.Put(Normal_Mode); if App.Self.Cur = null then Draw_Text(Entreprise.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Self.Cur.Info.Name /= null then Draw_Text(Entreprise.Cmd_Win, 1, 1, White, App.Self.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(Entreprise.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; when others => null; end case; or when Obj_Tag = Rendezvous => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(1) => Rendezvous_Curs := Initialize; Enlight_Window(Entreprise.Obj_Header); Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Obj_Tag := None; when Wide_Character'Val(10) => if Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line_Last /= 0 then case Rendezvous_Curs.Val_Cur is when Rendezvous_None => null; when Rendezvous_Define => declare Rendezvous : constant Rendezvous_Class := To_Rendezvous(Rendezvous_Curs, Child_Index); begin Add_To(App.Self, new Rendezvous_Class '(Rendezvous)); Save(App.Self.root, Person_Filename); end; Rendezvous_Curs := Initialize; Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Obj_Tag := None; when others => Rendezvous_Curs.Val_Cur := Rendezvous_Enum'Succ(Rendezvous_Curs.Val_Cur); end case; Draw_Text(Entreprise.Obj_Main, Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line_Pos, Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Column_Pos, White, Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line(1..Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; when Wide_Character ' Val (127) => if Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line_Last > 0 then Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line(Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line_Last) := ' '; Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line_Last := Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line_Last - 1; end if; Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Entreprise.Obj_Main, 2, 1, White, "Date : "); Draw_Text(Entreprise.Obj_Main, 3, 1, White, "Period : "); Draw_Text(Entreprise.Obj_Main, 4, 1, White, "Locality : "); Draw_Text(Entreprise.Obj_Main, 5, 1, White, "Define : "); Draw_Text(Entreprise.Obj_Main, 1, 1, White, "Name : "); for Val in Rendezvous_Name..Rendezvous_Define loop Draw_Text(Entreprise.Obj_Main, Rendezvous_Curs.values(Val).Line_Pos, Rendezvous_Curs.values(Val).Column_Pos, White, Rendezvous_Curs.values(Val).Line(1..Rendezvous_Curs.values(Val).Line_Last)); end loop; Draw_Text(Entreprise.Obj_Main, Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line_Pos, Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Column_Pos, White, Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line(1..Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line_Last)); when others => null; end case; elsif Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line_Last < 45 then Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line(Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line_Last + 1) := Wchar; Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line_Last := Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line_Last + 1; for Val in Rendezvous_Name..Rendezvous_Define loop Draw_Text(Entreprise.Obj_Main, Rendezvous_Curs.values(Val).Line_Pos, Rendezvous_Curs.values(Val).Column_Pos, White, Rendezvous_Curs.values(Val).Line(1..Rendezvous_Curs.values(Val).Line_Last)); end loop; Draw_Text(Entreprise.Obj_Main, Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line_Pos, Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Column_Pos, White, Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line(1..Rendezvous_Curs.Values(Rendezvous_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; end Receive; case Obj_Tag is when None => Draw(Entreprise, App.Self); Global_Content_Print(App.Self.Cur, Entreprise.Content_Win.win); Enlight_Window(Entreprise.cmd_Win); Text_Io.Put(Normal_Mode); if App.Self.Cur = null then Draw_Text(Entreprise.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Self.Cur.Info.Name /= null then Draw_Text(Entreprise.Cmd_Win, 1, 1, White, App.Self.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(Entreprise.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; when others => null; end case; or when Obj_Tag = Universe => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(1) => Content_Curs := Initialize; Enlight_Window(Entreprise.Obj_Header); Enlight_Window(Entreprise.Obj_Main); Enlight_Window(Entreprise.Obj_Attr); Text_Io.Put(Normal_Mode); Obj_Tag := None; when Wide_Character'Val(10) => if Universe_Curs.Values(Universe_Curs.Val_Cur).Line_Last /= 0 then case Universe_Curs.Val_Cur is when Universe_None => null; when Universe_Name => declare Universe : constant Universe_Class := To_Universe(Universe_Curs, Child_index); begin Add_To(App.Self, new Universe_Class '(Universe)); Save(App.Self.root, Person_Filename); end; -------------------------------- Universe_Curs := Initialize; -------------------------------- Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Obj_Tag := None; when others => Universe_Curs.Val_Cur := Universe_Enum'Succ(Universe_Curs.Val_Cur); end case; else Put(Character'Val(7)); end if; when Wide_Character ' Val (127) => if Universe_Curs.Values(Universe_Curs.Val_Cur).Line_Last > 0 then Universe_Curs.Values(Universe_Curs.Val_Cur).Line(Universe_Curs.Values(Universe_Curs.Val_Cur).Line_Last) := ' '; Universe_Curs.Values(Universe_Curs.Val_Cur).Line_Last := Universe_Curs.Values(Universe_Curs.Val_Cur).Line_Last - 1; end if; Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Entreprise.Obj_Main, 1, 1, White, "Name : "); for Val in Universe_Name..Universe_Name loop Draw_Text(Entreprise.Obj_Main, Universe_Curs.values(Val).Line_Pos, Universe_Curs.values(Val).Column_Pos, White, Universe_Curs.values(Val).Line(1..Universe_Curs.values(Val).Line_Last)); end loop; Draw_Text(Entreprise.Obj_Main, Universe_Curs.Values(Universe_Curs.Val_Cur).Line_Pos, Universe_Curs.Values(Universe_Curs.Val_Cur).Column_Pos, White, Universe_Curs.Values(Universe_Curs.Val_Cur).Line(1..Universe_Curs.Values(Universe_Curs.Val_Cur).Line_Last)); when others => null; end case; elsif Universe_Curs.Values(Universe_Curs.Val_Cur).Line_Last < 45 then Universe_Curs.Values(Universe_Curs.Val_Cur).Line(Universe_Curs.Values(Universe_Curs.Val_Cur).Line_Last + 1) := Wchar; Universe_Curs.Values(Universe_Curs.Val_Cur).Line_Last := Universe_Curs.Values(Universe_Curs.Val_Cur).Line_Last + 1; for Val in Universe_Name..Universe_name loop Draw_Text(Entreprise.Obj_Main, Universe_Curs.values(Val).Line_Pos, Universe_Curs.values(Val).Column_Pos, White, Universe_Curs.values(Val).Line(1..Universe_Curs.values(Val).Line_Last)); end loop; Draw_Text(Entreprise.Obj_Main, Universe_Curs.Values(Universe_Curs.Val_Cur).Line_Pos, Universe_Curs.Values(Universe_Curs.Val_Cur).Column_Pos, White, Universe_Curs.Values(Universe_Curs.Val_Cur).Line(1..Universe_Curs.Values(Universe_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; end Receive; Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Entreprise.Obj_Main, 1, 1, White, "Name : "); for Val in Universe_Name..Universe_Name loop Draw_Text(Entreprise.Obj_Main, Universe_Curs.values(Val).Line_Pos, Universe_Curs.values(Val).Column_Pos, White, Universe_Curs.values(Val).Line(1..Universe_Curs.values(Val).Line_Last)); end loop; Draw_Text(Entreprise.Obj_Main, Universe_Curs.Values(Universe_Curs.Val_Cur).Line_Pos, Universe_Curs.Values(Universe_Curs.Val_Cur).Column_Pos, White, Universe_Curs.Values(Universe_Curs.Val_Cur).Line(1..Universe_Curs.Values(Universe_Curs.Val_Cur).Line_Last)); case Obj_Tag is when None => Draw(Entreprise, App.Self); Text_Io.Put(Normal_Mode); Global_Content_Print(App.Self.Cur, Entreprise.Content_Win.win); Enlight_Window(Entreprise.cmd_Win); Text_Io.Put(Normal_Mode); if App.Self.Cur = null then Draw_Text(Entreprise.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Self.Cur.Info.Name /= null then Draw_Text(Entreprise.Cmd_Win, 1, 1, White, App.Self.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(Entreprise.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; when others => null; end case; or when Obj_Tag = Book or Obj_Tag = CDROM or Obj_Tag = DVD => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(1) => Content_Curs := Initialize; Enlight_Window(Entreprise.Obj_Header); Enlight_Window(Entreprise.Obj_Main); Enlight_Window(Entreprise.Obj_Attr); Text_Io.Put(Normal_Mode); Obj_Tag := None; when Wide_Character'Val(10) => if Media_Curs.Values(Media_Curs.Val_Cur).Line_Last /= 0 then case Media_Curs.Val_Cur is when Media_None => null; when Media_Editor => case Obj_Tag is when Book => declare Book : constant Book_Class := To_Book(Media_Curs, Child_index); begin Add_To(App.Self, new Book_Class '(Book)); Save(App.Self.root, Person_Filename); end; when CDROM => declare CDROM : constant CDROM_Class := To_CDROM(Media_Curs, Child_index); begin Add_To(App.Self, new CDROM_Class '(CDROM)); Save(App.Self.root, Person_Filename); end; when DVD => declare DVD : constant DVD_Class := To_DVD(Media_Curs, Child_index); begin Add_To(App.Self, new DVD_Class '(DVD)); Save(App.Self.root, Person_Filename); end; when others => null; end case; -------------------------------- Media_Curs := Initialize; -------------------------------- Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Obj_Tag := None; when others => Media_Curs.Val_Cur := Media_Enum'Succ(Media_Curs.Val_Cur); end case; else Put(Character'Val(7)); end if; when Wide_Character ' Val (127) => if Media_Curs.Values(Media_Curs.Val_Cur).Line_Last > 0 then Media_Curs.Values(Media_Curs.Val_Cur).Line(Media_Curs.Values(Media_Curs.Val_Cur).Line_Last) := ' '; Media_Curs.Values(Media_Curs.Val_Cur).Line_Last := Media_Curs.Values(Media_Curs.Val_Cur).Line_Last - 1; end if; Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); Draw_Text(Entreprise.Obj_Main, 2, 1, White, "Author : "); Draw_Text(Entreprise.Obj_Main, 3, 1, White, "Editor : "); Draw_Text(Entreprise.Obj_Main, 1, 1, White, "Title : "); for Val in Media_title..Media_Editor loop Draw_Text(Entreprise.Obj_Main, Media_Curs.values(Val).Line_Pos, Media_Curs.values(Val).Column_Pos, White, Media_Curs.values(Val).Line(1..Media_Curs.values(Val).Line_Last)); end loop; Draw_Text(Entreprise.Obj_Main, Media_Curs.Values(Media_Curs.Val_Cur).Line_Pos, Media_Curs.Values(Media_Curs.Val_Cur).Column_Pos, White, Media_Curs.Values(Media_Curs.Val_Cur).Line(1..Media_Curs.Values(Media_Curs.Val_Cur).Line_Last)); when others => null; end case; elsif Media_Curs.Values(Media_Curs.Val_Cur).Line_Last < 45 then Media_Curs.Values(Media_Curs.Val_Cur).Line(Media_Curs.Values(Media_Curs.Val_Cur).Line_Last + 1) := Wchar; Media_Curs.Values(Media_Curs.Val_Cur).Line_Last := Media_Curs.Values(Media_Curs.Val_Cur).Line_Last + 1; for Val in Media_Title..Media_Editor loop Draw_Text(Entreprise.Obj_Main, Media_Curs.values(Val).Line_Pos, Media_Curs.values(Val).Column_Pos, White, Media_Curs.values(Val).Line(1..Media_Curs.values(Val).Line_Last)); end loop; Draw_Text(Entreprise.Obj_Main, Media_Curs.Values(Media_Curs.Val_Cur).Line_Pos, Media_Curs.Values(Media_Curs.Val_Cur).Column_Pos, White, Media_Curs.Values(Media_Curs.Val_Cur).Line(1..Media_Curs.Values(Media_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; end Receive; Enlight_Window(Entreprise.Obj_Main); Text_Io.Put(Normal_Mode); case Obj_Tag is when None => Draw(Entreprise, App.Self); Text_Io.Put(Normal_Mode); Global_Content_Print(App.Self.Cur, Entreprise.Content_Win.win); Enlight_Window(Entreprise.cmd_Win); Text_Io.Put(Normal_Mode); if App.Self.Cur = null then Draw_Text(Entreprise.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Self.Cur.Info.Name /= null then Draw_Text(Entreprise.Cmd_Win, 1, 1, White, App.Self.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(Entreprise.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; when Book .. DVD => Draw_Text(Entreprise.Obj_Main, 2, 1, White, "Author : "); Draw_Text(Entreprise.Obj_Main, 3, 1, White, "Editor : "); Draw_Text(Entreprise.Obj_Main, 1, 1, White, "Title : "); for Val in Media_Title..Media_Editor loop Draw_Text(Entreprise.Obj_Main, Media_Curs.values(Val).Line_Pos, Media_Curs.values(Val).Column_Pos, White, Media_Curs.values(Val).Line(1..Media_Curs.values(Val).Line_Last)); end loop; Draw_Text(Entreprise.Obj_Main, Media_Curs.Values(Media_Curs.Val_Cur).Line_Pos, Media_Curs.Values(Media_Curs.Val_Cur).Column_Pos, White, Media_Curs.Values(Media_Curs.Val_Cur).Line(1..Media_Curs.Values(Media_Curs.Val_Cur).Line_Last)); when others => null; end case; or accept Halt do Entreprise.Proc.Halt; end Halt; exit Main_loop; or accept Wake_Up(Top : in Natural) do Initialize(Activity_From , 3, App.Columns / 2 + 1, 10, (App.Columns)/4, Blue, White); Initialize(Activity_To , 3, App.Columns / 2+App.Columns/4+1, 10, App.Columns/4, Blue, White); Initialize(Activity_Compta, 13, App.Columns / 2+1, (App.Lines-20), App.Columns/2, Cyan, White); Initialize(Activity_Balance ,App.Lines-5, App.Columns / 2+1, 3, App.Columns/2, Yellow, White); Initialize(Activity_Cmd, App.Lines-2, App.Columns / 2+1, 3, App.Columns/2, White, White); Initialize(App.View_Wins, App.Lines-23, App.Columns/2, 13, 2, App.Columns / 2); ---------------------------------------------- --Errno := System("clear" & Character'Val(0)); ---------------------------------------------- State_Print(Date-86400.0, App.Lines-25); Draw_Window(Activity_Balance); Draw_Text(Activity_Balance, 1, 1, White, " Capital : " & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.Capital)) & ", Material :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.Material)) & ", TVA In :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.TVA_In)) & ", TVA Out :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.TVA_Out)) & "" ); Draw_Window(Activity_Cmd); if Line_Last > 0 then Draw_text(Activity_Cmd, 1, 1, White, "Date : " & Line(Line'First..Line_Last)); else Draw_text(Activity_Cmd, 1, 1, White, "Date : "); end if; Person_Process.Top := Top; Initialize(Entreprise, Top); Draw(Entreprise, App.Self); Obj_Tag := None; if Top = 0 then Entreprise.Proc.Start; end if; Global_Content_Print(App.Self.Cur, Entreprise.Content_Win.win); if In_Print then if Print_Index /= 0 then if Printed /= null then Printed.Print(Entreprise.Obj_Header.Win, Entreprise.Obj_Main.Win); end if; else if Printed /= null then Printed.Print(Entreprise.Obj_Header.Win, Entreprise.Obj_Main.Win); else App.Self.Cur.Print(Entreprise.Obj_Header.Win, Entreprise.Obj_Main.Win); end if; end if; end if; if Last /= 0 then Success := Print_Set(Childs_Set, Entreprise.List_Win, Line_Index, Total_Line); end if; if App.Self.Root = null then Draw_Text(Entreprise.Cmd_Win, 1, 1, White, "# "); elsif App.Self.Cur.Info.Name /= null then Draw_Text(Entreprise.Cmd_Win, 1, 1, White, App.Self.Cur.Info.Name.all & "# "); else Draw_Text(Entreprise.Cmd_Win, 1, 1, White, "null# "); end if; end Wake_Up; or accept Suspend do Entreprise.Proc.Stop; end Suspend; exit; or accept Page_Down do if Line_Index + (Entreprise.List_Win.H-2) <= Last then Line_Index := Line_Index + (Entreprise.List_Win.H-2); Success := Print_Set(Childs_Set, Entreprise.List_Win, Line_Index, Total_Line); else Text_Io.Put(Character'Val(7)); end if; end Page_Down; or accept Page_Up do if Line_Index > 0 then Line_Index := Line_Index - (Entreprise.List_Win.H-2); Success := Print_Set(Childs_Set, Entreprise.List_Win, Line_Index, Total_Line); else Text_Io.Put(Character'Val(7)); end if; end Page_Up; or accept Up_Arrow do null; end Up_Arrow; or accept Down_Arrow do null; end Down_Arrow; or accept Left_Arrow; or accept Right_Arrow; or accept Begin_Of; or accept End_Of; or accept Del; or accept Overwrite; end select; end loop; loop select accept Halt do Entreprise.Proc.Halt; end Halt; exit Main_Loop; or accept Suspend do Entreprise.Proc.Stop; end Suspend; or accept Wake_Up(Top : in Natural) do Initialize(Activity_From , 3, App.Columns / 2 + 1, 10, (App.Columns)/4, Blue, White); Initialize(Activity_To , 3, App.Columns / 2+App.Columns/4+1, 10, App.Columns/4, Blue, White); Initialize(Activity_Compta, 13, App.Columns / 2+1, (App.Lines-20), App.Columns/2, Cyan, White); Initialize(Activity_Balance ,App.Lines-5, App.Columns / 2+1, 3, App.Columns/2, Yellow, White); Initialize(Activity_Cmd, App.Lines-2, App.Columns / 2+1, 3, App.Columns/2, White, White); Initialize(App.View_Wins, App.Lines-23, App.Columns/2, 13, 2, App.Columns / 2); ---------------------------------------------- --Errno := System("clear" & Character'Val(0)); ---------------------------------------------- State_Print(Date-86400.0, App.Lines-25); Draw_Window(Activity_Balance); Draw_Text(Activity_Balance, 1, 1, White, " Capital : " & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.Capital)) & ", Material :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.Material)) & ", TVA In :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.TVA_In)) & ", TVA Out :" & Handling.To_Wide_String(Fixed_Total'Image(M.Balance.Balance.TVA_Out)) & "" ); Draw_Window(Activity_Cmd); if Line_Last > 0 then Draw_text(Activity_Cmd, 1, 1, White, "Date : " & Line(Line'First..Line_Last)); else Draw_text(Activity_Cmd, 1, 1, White, "Date : "); end if; Initialize(Entreprise, Top); Person_Process.Top := Top; Draw(Entreprise, App.Self); if Top = 0 then Entreprise.Proc.Start; end if; Obj_Tag := None; Global_Content_Print(App.Self.Cur, Entreprise.Content_Win.win); if In_Print then if Print_Index /= 0 then if Printed /= null then Printed.Print(Entreprise.Obj_Header.Win, Entreprise.Obj_Main.Win); end if; else if Printed /= null then Printed.Print(Entreprise.Obj_Header.Win, Entreprise.Obj_Main.Win); else App.Self.Cur.Print(Entreprise.Obj_Header.Win, Entreprise.Obj_Main.Win); end if; end if; end if; if Last /= 0 then Success := Print_Set(Childs_Set, Entreprise.List_Win, Line_Index, Total_Line); end if; if App.Self.Root = null then Draw_Text(Entreprise.Cmd_Win, 1, 1, White, "# "); elsif App.Self.Cur.Info.Name /= null then Draw_Text(Entreprise.Cmd_Win, 1, 1, White, App.Self.Cur.Info.Name.all & "# "); else Draw_Text(Entreprise.Cmd_Win, 1, 1, White, "null# "); end if; end Wake_Up; exit; end select; end loop; end loop Main_Loop; W_Io.Put_Line("Person process halted"); end Person_Process; -- task body Person_Process is  -- begin -- Main_Loop: -- loop -- loop -- select -- accept Receive (Wchar : in Wide_Character); -- or -- accept Halt do -- null; -- end Halt; -- exit Main_loop; -- or -- accept Wake_Up(Top : in Natural) do -- W_Io.Put_Line("World"); -- end Wake_Up; -- or -- accept Suspend; -- exit; -- or -- accept Page_Down; -- or -- accept Page_Up; -- or -- accept Up_Arrow do -- null; -- end Up_Arrow; -- or -- accept Down_Arrow do -- null; -- end Down_Arrow; -- or -- accept Left_Arrow; -- or -- accept Right_Arrow; -- or -- accept Begin_Of; -- or -- accept End_Of; -- or -- accept Del; -- or -- accept Overwrite;  -- end select; -- end loop; -- loop -- select -- accept Halt; -- exit Main_Loop; -- or -- accept Suspend; -- or -- accept Wake_Up(Top : in Natural) do -- W_Io.Put_Line("Person"); -- Text_Io.Put_Line("Greetings " & Getenv("USER").all & "!"); -- end Wake_Up; -- exit; -- end select; -- end loop; -- end loop Main_Loop; -- --W_Io.Put_Line("Bank process halted"); -- end Person_Process; task body Conductor_Process is begin Main_Loop: loop loop select accept Receive (Wchar : in Wide_Character); or accept Halt do null; end Halt; exit Main_loop; or accept Wake_Up(Top : in Natural) do W_Io.Put_Line("World"); end Wake_Up; or accept Suspend; exit; or accept Page_Down; or accept Page_Up; or accept Up_Arrow do null; end Up_Arrow; or accept Down_Arrow do null; end Down_Arrow; or accept Left_Arrow; or accept Right_Arrow; or accept Begin_Of; or accept End_Of; or accept Del; or accept Overwrite; end select; end loop; loop select accept Halt; exit Main_Loop; or accept Suspend; or accept Wake_Up(Top : in Natural) do W_Io.Put_Line("World"); Text_Io.Put_Line("Greetings " & Getenv("USER").all & "!"); end Wake_Up; exit; end select; end loop; end loop Main_Loop; --W_Io.Put_Line("Bank process halted"); end Conductor_Process; ------------------------------------------------------------------------------- -- Master -- ------------------------------------------------------------------------------- task body Master_Process is Single_Curs : Single_Cursor_Type; Attribute_Curs : Attribute_Cursor_Type; Filename : Os_Lib.String_Access; The_Engine : Engine_Type; Level : Natural := 0; Cmd : Element_Cmd_Enum := Null_cmd; Is_Initialized : Boolean := False; Verax : Boolean := False; Top : Natural := 0; Cmd_Line : Wide_String (1..App.Columns/2-6); Line_Last : Natural := 0; Child_Index : Element_Index := 1; On_List : Boolean := False; On_Tree : Boolean := False; Obj_Tag : Element_Enum := None; In_Print : Boolean := False; Print_Index : Natural := 0; Printed : Element_Access; Success : Boolean := False; Childs_Set : Wide_Set(4096); Line_Index : Natural := 0; Last : Natural := 0; Total_Line : Natural := 0; Path_Index : Natural := 0; Name : Os_Lib.String_Access; File : Wide_Set(1024); File_Index : Natural := 0; List_Last : Natural := 0; List_Index : Natural := 0; begin Main_Loop: loop loop select when Obj_Tag = None and Cmd /= Attribute => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'val(10) => if Line_Last /= 0 then In_Print := False; Cmd := El_Cmd_Value(Cmd_Line(1..Line_Last)); case Cmd is when Null_Cmd => null; when Make => declare Tag_Name : Os_Lib.String_Access; begin if Wide_Fixed.Index(Cmd_Line(Cmd_Line'First..Line_Last), " ") /= 0 then Tag_Name := new String ' (Handling.To_String(Cmd_Line(Wide_Fixed.Index(Cmd_Line, " ")+1..Line_Last))); Obj_Tag := Element_Enum'Value(Tag_Name.all); case[m Obj_Tag is when None => null; when License => Add_License(App.Borg); Save(App.Borg.root, Filename.all); Obj_Tag := None; when others => Single_Curs := Initialize; end case; end if; exception when others => null; end; when Attribute => Attribute_Curs := Initialize; when Parent => Parent(App.Borg); when Load => if Wide_Fixed.Index(Cmd_Line(Cmd_Line'First..Line_Last), " ") /= 0 then Filename := new String ' (Handling.To_String(Cmd_Line(Wide_Fixed.Index(Cmd_Line, " ")+1..Line_Last)) & ".txt"); if Is_Regular_File(Filename.all) then Restore(App.Borg, Filename.all); Set_Free(File); List_Last := 0; Listing(App.Borg.Root, File, List_Last); end if; end if; when Switch => if App.Borg.Cur /= null then if Wide_Fixed.Index(Cmd_Line(Cmd_Line'First..Line_Last), " ") /= 0 then declare Index_name : M.Strings.Wide_String_Access; Index : Element_Index := 1; begin Index_Name := new Wide_String ' (Cmd_Line(Wide_Fixed.Index(Cmd_Line, " ")+1..Line_Last)); Index := Element_Index'Value(Handling.To_String(Index_Name.all)); Switch(App.Borg, Index, Verax); exception when others => null; end; end if; end if; when Root => App.Borg.Cur := App.Borg.Root; App.Borg.Path := Element_Vectors.Empty_Vector; App.Borg.Path := App.Borg.Path & App.Borg.Root; when Print => if App.Borg.Cur /= null then if Wide_Fixed.Index(Cmd_Line(Cmd_Line'First..Line_Last), " ") /= 0 then declare Index_name : M.Strings.Wide_String_Access; Index : Natural := 0; begin Index_name := new Wide_String ' (Cmd_Line(Wide_Fixed.Index(Cmd_Line, " ")+1..Line_Last)); Print_Index := Natural'Value(Handling.To_String(Index_Name.all)); Printed := Child(App.Borg.Cur, Print_Index); case Printed.Tag is when None => null; when License => In_Print := True; Enlight_Window(The_Engine.Obj_Header); Enlight_Window(The_Engine.Attr); Text_Io.Put(Normal_Mode); Enlight_Window(The_Engine.Obj_Main); Text_Io.Put(Normal_Mode); Printed.Print(The_Engine.Obj_Header.Win, The_Engine.Obj_Main.Win); when others => In_Print := True; Enlight_Window(The_Engine.Obj_Header); Text_Io.Put(Normal_Mode); Enlight_Window(The_Engine.Attr); Text_Io.Put(Normal_Mode); Printed.Print(The_Engine.Obj_Header.Win, The_Engine.Attr.Win); end case; Enlight_Window(The_Engine.Obj_Attr); Text_Io.Put(Normal_Mode); Classes.Print(Printed.definition, The_Engine.Obj_Attr.Win); exception when others => declare Name : M.Strings.Wide_String_Access; Index : Element_Index := 1; begin Index_name := new Wide_String ' (Cmd_Line(Wide_Fixed.Index(Cmd_Line, " ")+1..Line_Last)); Printed := Child(App.Borg.Cur, Index_Name.all); case Printed.Tag is when None => null; when License => In_Print := True; Enlight_Window(The_Engine.Obj_Header); Enlight_Window(The_Engine.Attr); Text_Io.Put(Normal_Mode); Enlight_Window(The_Engine.Obj_Main); Text_Io.Put(Normal_Mode); Printed.Print(The_Engine.Obj_Header.Win, The_Engine.Obj_Main.Win); when others => In_Print := True; Enlight_Window(The_Engine.Obj_Header); Text_Io.Put(Normal_Mode); Enlight_Window(The_Engine.Attr); Text_Io.Put(Normal_Mode); Printed.Print(The_Engine.Obj_Header.Win, The_Engine.Attr.Win); end case; Printed.Print(The_Engine.Obj_Header.Win, The_Engine.Attr.Win); Enlight_Window(The_Engine.Attr); Text_Io.Put(Normal_Mode); Classes.Print(Printed.definition, The_Engine.Attr.Win); exception when others => null; end; end; else Classes.Print(App.Borg.cur.Definition, The_Engine.Obj_Attr.Win); case App.Borg.Root.Tag is when None => null; when License => In_Print := True; Enlight_Window(The_Engine.Obj_Header); Text_Io.Put(Normal_Mode); Enlight_Window(The_Engine.Obj_Main); Text_Io.Put(Normal_Mode); App.Borg.Cur.Print(The_Engine.Obj_Header.Win, The_Engine.Obj_Main.Win); when others => In_Print := True; Enlight_Window(The_Engine.Obj_Header); Text_Io.Put(Normal_Mode); Enlight_Window(The_Engine.Attr); Text_Io.Put(Normal_Mode); App.Borg.Cur.Print(The_Engine.Obj_Header.Win, The_Engine.Attr.Win); end case; Print_Index := 0; Printed := null; end if; end if; when Search => if App.Borg.Cur /= null then if Wide_Fixed.Index(Cmd_Line(Cmd_Line'First..Line_Last), " ") /= 0 then declare Index_name : M.Strings.Wide_String_Access; Index : Element_Index := 1; begin Index_name := new Wide_String ' (Cmd_Line(Wide_Fixed.Index(Cmd_Line, " ")+1..Line_Last)); Search(App.Borg, Index_Name.all, Path_Index, Success); if Success then Enlight_Window(The_Engine.Obj_Header); Text_Io.Put(Normal_Mode); Enlight_Window(The_Engine.Attr); Enlight_Window(The_Engine.Obj_Main); Text_Io.Put(Normal_Mode); case Printed.Tag is when None => null; when License => In_Print := True; Enlight_Window(The_Engine.Obj_Header); Text_Io.Put(Normal_Mode); Enlight_Window(The_Engine.Obj_Main); Text_Io.Put(Normal_Mode); App.Borg.Cur.Print(The_Engine.Obj_Header.Win, The_Engine.Obj_Main.Win); when others => In_Print := True; Enlight_Window(The_Engine.Obj_Header); Text_Io.Put(Normal_Mode); Enlight_Window(The_Engine.Attr); Text_Io.Put(Normal_Mode); App.Borg.Cur.Print(The_Engine.Obj_Header.Win, The_Engine.Attr.Win); end case; Enlight_Window(The_Engine.Obj_Attr); Text_Io.Put(Normal_Mode); Classes.Print(App.Borg.Cur.definition, The_Engine.Obj_Attr.Win); In_Print := True; end if; Success := False; Path_Index := 0; exception when Constraint_Error => null; end; end if; end if; when List => Set_Free(Childs_Set); Enlight_Window(The_Engine.Obj_Main); Enlight_Window(The_Engine.List_win); Text_Io.Put(Normal_Mode); Last := 0; Total_Line := 0; Line_Index := 0; On_List := True; On_Tree := False; if App.Borg.Cur /= null then if not Element_Vectors.Is_Empty(App.Borg.Cur.Childs) then for Child in 1..Element_Vectors.Length(App.Borg.Cur.Childs) loop declare E : constant Element_Access := Element_Vectors.Element(App.Borg.Cur.Childs, Element_Index(Child)); begin Add_Line(Childs_Set, Last, To_String(E.Info)); end; end loop; end if; end if; Success := Print_Set(Childs_Set, The_Engine.List_Win, Line_Index, Total_Line); when Tree => On_Tree := True; On_List := False; Enlight_Window(The_Engine.Obj_Main); Text_Io.Put(Normal_Mode); Total_Line := 0; Line_Index := 0; Set_Free(Childs_Set); if App.Borg.Cur /= null then Tree(App.Borg.Cur, Level, Childs_Set, Last); Success := Print_Set(Childs_Set, The_Engine.List_Win, Line_Index, Total_Line); end if; when Remove => declare Name : M.Strings.Wide_String_Access; Index : Element_Index := 1; begin if Wide_Fixed.Index(Cmd_Line, " ") /= 0 then name := new Wide_String ' (Cmd_Line(Wide_Fixed.Index(Cmd_Line, " ")+1..Line_Last)); if Wide_Fixed.Index_Non_Blank(Name.all) /= 0 then Index := Element_Index'Value(Handling.To_String(Name.all)); Remove(App.Borg, Index); --Save(App.Borg.root, _Filename); end if; end if; if On_List then Set_Free(Childs_Set); Enlight_Window(The_Engine.Obj_Main); Enlight_Window(The_Engine.List_win); Text_Io.Put(Normal_Mode); Last := 0; Total_Line := 0; Line_Index := 0; if App.Borg.Cur /= null then if not Element_Vectors.Is_Empty(App.Borg.Cur.Childs) then for Child in 1..Element_Vectors.Length(App.Borg.Cur.Childs) loop declare E : constant Element_Access := Element_Vectors.Element(App.Borg.Cur.Childs, Element_Index(Child)); begin Add_Line(Childs_Set, Last, To_String(E.Info)); end; end loop; end if; end if; Success := Print_Set(Childs_Set, The_Engine.List_Win, Line_Index, Total_Line); elsif On_Tree then Total_Line := 0; Line_Index := 0; Enlight_Window(The_Engine.Obj_Main); Text_Io.Put(Normal_Mode); Set_Free(Childs_Set); if App.Borg.Cur /= null then Tree(App.Borg.Cur, Level, Childs_Set, Last); Success := Print_Set(Childs_Set, The_Engine.List_Win, Line_Index, Total_Line); end if; end if; Success := Print_Set(Childs_Set, The_Engine.List_Win, Line_Index, Total_Line); exception when others => null; end; when others => null; end case; end if; Line_Last := 0; when Wide_Character'Val(12) => Last := 0; Printed := null; Print_Index := 0; Initialize(The_Engine, Top); Draw(The_Engine, App.Borg); Enlight_Window(The_Engine.Content_Win); Text_Io.Put(Normal_Mode); Global_Content_Print(App.Borg.Cur, The_Engine.Content_Win.win); Enlight_Window(The_Engine.cmd_Win); Text_Io.Put(Normal_Mode); if App.Borg.Cur = null then Draw_Text(The_Engine.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Borg.Cur.Info.Name /= null then Draw_Text(The_Engine.Cmd_Win, 1, 1, White, App.Borg.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(The_Engine.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; when Wide_Character'Val(127) => if Line_Last > 0 then Cmd_Line(Line_Last) := Wide_Character'Val(32); Line_Last := Line_Last - 1; else Text_Io.Put(Character'Val(7)); end if; when others => null; end case; else if App.Borg.Root /= null and then App.Borg.cur.Info.Name /= null then if Line_Last + 1 <= (Cmd_Line'Length-App.Borg.cur.Info.Name'Length) then Cmd_Line(Line_Last + 1) := Wchar; Line_Last := Line_Last + 1; else Text_Io.Put(Character'Val(7)); end if; elsif Line_Last + 1 <= Cmd_Line'Length then Cmd_Line(Line_Last + 1) := Wchar; Line_Last := Line_Last + 1; else Text_Io.Put(Character'Val(7)); end if; end if; end Receive; Enlight_Window(The_Engine.Content_Win); Text_Io.Put(Normal_Mode); Global_Content_Print(App.Borg.Cur, The_Engine.Content_Win.win); Enlight_Window(The_Engine.cmd_Win); Text_Io.Put(Normal_Mode); Enlight_Window(The_Engine.File_win); if List_Last /= 0 then Success := Print_Set(File, The_Engine.File_Win, List_Index, Total_Line); end if; case Obj_Tag is when None => case Cmd is when Attribute => Enlight_Window(The_Engine.Attr); Text_Io.Put(Normal_Mode); Draw_Text(The_Engine.Attr, 2, 1, White, "Image : "); Draw_Text(The_Engine.Attr, 1, 1, White, "Name : "); for Val in Attribute_Name..Attribute_Image loop Draw_Text(The_Engine.Attr, Attribute_Curs.values(Val).Line_Pos, Attribute_Curs.values(Val).Column_Pos, White, Attribute_Curs.values(Val).Line(1..Attribute_Curs.values(Val).Line_Last)); end loop; Draw_Text(The_Engine.Attr, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Pos, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Column_Pos, White, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line(1..Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last)); when others => null; end case; when License => null; when others => Enlight_Window(The_Engine.Attr); Text_Io.Put(Normal_Mode); Draw_Text(The_Engine.Attr, 2, 1, White, "Line : "); Draw_Text(The_Engine.Attr, 1, 1, White, "Name : "); end case; if App.Borg.Root /= null then Child_Index := Element_Index(Element_Vectors.Length(App.Borg.Cur.childs)+1); else Child_Index := 1; end if; if App.Borg.Cur = null then Draw_Text(The_Engine.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Borg.Cur.Info.Name /= null then Draw_Text(The_Engine.Cmd_Win, 1, 1, White, App.Borg.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(The_Engine.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; or when cmd = attribute => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(1) => Attribute_Curs := Initialize; Enlight_Window(The_Engine.Obj_Header); Enlight_Window(The_Engine.Obj_Main); Enlight_Window(The_Engine.Obj_Attr); Text_Io.Put(Normal_Mode); Obj_Tag := None; when Wide_Character'Val(10) => if Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last /= 0 then case Attribute_Curs.Val_Cur is when Attribute_None => null; when Attribute_Name => Name := new String ' (Handling.To_String(Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line(1..Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last))); Attribute_Curs.Val_Cur := Attribute_Enum'Succ(Attribute_Curs.Val_Cur); when Attribute_Image => if App.Borg.Cur /= null then if App.Borg.Cur.Definition.Index < App.Borg.Cur.Definition.List'Last then App.Borg.Cur.Definition.List(App.Borg.Cur.Definition.Index + 1) := Make(Name.all, Handling.To_String(Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line(1..Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last))); App.Borg.Cur.Definition.Index := App.Borg.Cur.Definition.Index + 1; end if; end if; attribute_Curs := Initialize; Enlight_Window(The_Engine.Obj_Main); Text_Io.Put(Normal_Mode); Free(Name); Attribute_Curs.Val_Cur := Attribute_None; Cmd := Null_cmd; Save(App.Borg.root, Filename.all); end case; else Put(Character'Val(7)); end if; when Wide_Character ' Val (127) => if Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last > 0 then Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line(Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last) := ' '; Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last := Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last - 1; end if; when others => null; end case; elsif Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last < 45 then Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line(Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last + 1) := Wchar; Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last := Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last + 1; for Val in Attribute_Name..Attribute_image loop Draw_Text(The_Engine.Attr, Attribute_Curs.values(Val).Line_Pos, Attribute_Curs.values(Val).Column_Pos, White, Attribute_Curs.values(Val).Line(1..Attribute_Curs.values(Val).Line_Last)); end loop; Draw_Text(The_Engine.Attr, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Pos, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Column_Pos, White, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line(1..Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; end Receive; case Attribute_Curs.Val_Cur is when Attribute_none => Draw(The_Engine, App.Borg); Global_Content_Print(App.Borg.Cur, The_Engine.Content_Win.win); Enlight_Window(The_Engine.Attr); Enlight_Window(The_Engine.Obj_Attr); Text_Io.Put(Normal_Mode); if App.Borg.Cur /= null then for I in 1..App.Borg.Cur.Definition.Index loop Draw_Text(The_Engine.Obj_Attr, I, 1, white, Handling.To_Wide_String(App.Borg.Cur.Definition.List(I).Name.all)); Draw_Text(The_Engine.Obj_Attr, I, App.Borg.Cur.Definition.List(I).Name'Length+1, Red, "="); Draw_Text(The_Engine.Obj_Attr, I, App.Borg.Cur.Definition.List(I).Name'Length+2, white, Handling.To_Wide_String(App.Borg.Cur.Definition.List(I).Value.all)); end loop; end if; Enlight_Window(The_Engine.cmd_Win); Text_Io.Put(Normal_Mode); if App.Borg.Cur = null then Draw_Text(The_Engine.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Borg.Cur.Info.Name /= null then Draw_Text(The_Engine.Cmd_Win, 1, 1, White, App.Borg.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(The_Engine.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; when others => Draw(The_Engine, App.Borg); Global_Content_Print(App.Borg.Cur, The_Engine.Content_Win.win); Enlight_Window(The_Engine.Attr); Enlight_Window(The_Engine.cmd_Win); Enlight_Window(The_Engine.Obj_Attr); Text_Io.Put(Normal_Mode); if App.Borg.Cur /= null then for I in 1..App.Borg.Cur.Definition.Index loop Draw_Text(The_Engine.Obj_Attr, I, 1, white, Handling.To_Wide_String(App.Borg.Cur.Definition.List(I).Name.all)); Draw_Text(The_Engine.Obj_Attr, I, App.Borg.Cur.Definition.List(I).Name'Length+1, Red, "="); Draw_Text(The_Engine.Obj_Attr, I, App.Borg.Cur.Definition.List(I).Name'Length+2, white, Handling.To_Wide_String(App.Borg.Cur.Definition.List(I).Value.all)); end loop; end if; if App.Borg.Cur = null then Draw_Text(The_Engine.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Borg.Cur.Info.Name /= null then Draw_Text(The_Engine.Cmd_Win, 1, 1, White, App.Borg.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(The_Engine.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; Draw_Text(The_Engine.Attr, 2, 1, White, "Image : "); Draw_Text(The_Engine.Attr, 1, 1, White, "Name : "); for Val in Attribute_Name..Attribute_Image loop Draw_Text(The_Engine.Attr, Attribute_Curs.values(Val).Line_Pos, Attribute_Curs.values(Val).Column_Pos, White, Attribute_Curs.values(Val).Line(1..Attribute_Curs.values(Val).Line_Last)); end loop; Draw_Text(The_Engine.Attr, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Pos, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Column_Pos, White, Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line(1..Attribute_Curs.Values(Attribute_Curs.Val_Cur).Line_Last)); null; end case; or when Obj_Tag = License => accept Receive (Wchar : in Wide_Character) do Set_Free(File); List_Last := 0; Listing(App.Borg.Root, File, List_Last); if List_Last /= 0 then Success := Print_Set(File, The_Engine.File_Win, List_Index, Total_Line); end if; end Receive; or when Obj_Tag /= None and Obj_Tag /= License => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(1) => Single_Curs := Initialize; Enlight_Window(The_Engine.Obj_Header); Enlight_Window(The_Engine.Attr); Text_Io.Put(Normal_Mode); Obj_Tag := None; when Wide_Character'Val(10) => if Single_Curs.Values(Single_Curs.Val_Cur).Line_Last /= 0 then case Single_Curs.Val_Cur is when Single_None => null; when Single_Line => declare Obj : constant Element_Access := To_single(Single_Curs, Child_Index, Obj_Tag); begin Add_To(App.Borg, Obj); case Obj_tag is when Program => Filename := new String ' (Handling.To_String(Engine.Program_Class(App.Borg.Root.all).Line.all & ".txt")); Save(App.Borg.root, Filename.all); when others => Save(App.Borg.root, Filename.all); end case; end; Single_Curs := Initialize; Enlight_Window(The_Engine.Attr); Text_Io.Put(Normal_Mode); Obj_Tag := None; when others => Single_Curs.Val_Cur := Single_Enum'Succ(Single_Curs.Val_Cur); end case; Draw_Text(The_Engine.Attr, Single_Curs.Values(Single_Curs.Val_Cur).Line_Pos, Single_Curs.Values(Single_Curs.Val_Cur).Column_Pos, White, Single_Curs.Values(Single_Curs.Val_Cur).Line(1..Single_Curs.Values(Single_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; when Wide_Character ' Val (127) => if Single_Curs.Values(Single_Curs.Val_Cur).Line_Last > 0 then Single_Curs.Values(Single_Curs.Val_Cur).Line(Single_Curs.Values(Single_Curs.Val_Cur).Line_Last) := ' '; Single_Curs.Values(Single_Curs.Val_Cur).Line_Last := Single_Curs.Values(Single_Curs.Val_Cur).Line_Last - 1; end if; Enlight_Window(The_Engine.Attr); Text_Io.Put(Normal_Mode); Draw_Text(The_Engine.Attr, 1, 1, White, "Name : "); for Val in Single_Name..Single_Line loop Draw_Text(The_Engine.Attr, Single_Curs.values(Val).Line_Pos, Single_Curs.values(Val).Column_Pos, White, Single_Curs.values(Val).Line(1..Single_Curs.values(Val).Line_Last)); end loop; Draw_Text(The_Engine.Attr, Single_Curs.Values(Single_Curs.Val_Cur).Line_Pos, Single_Curs.Values(Single_Curs.Val_Cur).Column_Pos, White, Single_Curs.Values(Single_Curs.Val_Cur).Line(1..Single_Curs.Values(Single_Curs.Val_Cur).Line_Last)); when others => null; end case; elsif Single_Curs.Values(Single_Curs.Val_Cur).Line_Last < 45 then Single_Curs.Values(Single_Curs.Val_Cur).Line(Single_Curs.Values(Single_Curs.Val_Cur).Line_Last + 1) := Wchar; Single_Curs.Values(Single_Curs.Val_Cur).Line_Last := Single_Curs.Values(Single_Curs.Val_Cur).Line_Last + 1; for Val in Single_Name..Single_Line loop Draw_Text(The_Engine.Attr, Single_Curs.values(Val).Line_Pos, Single_Curs.values(Val).Column_Pos, White, Single_Curs.values(Val).Line(1..Single_Curs.values(Val).Line_Last)); end loop; Draw_Text(The_Engine.Attr, Single_Curs.Values(Single_Curs.Val_Cur).Line_Pos, Single_Curs.Values(Single_Curs.Val_Cur).Column_Pos, White, Single_Curs.Values(Single_Curs.Val_Cur).Line(1..Single_Curs.Values(Single_Curs.Val_Cur).Line_Last)); else Put(Character'Val(7)); end if; end Receive; Set_Free(File); List_Last := 0; Listing(App.Borg.Root, File, List_Last); if List_Last /= 0 then Success := Print_Set(file, The_Engine.File_Win, List_Index, Total_Line); end if; case Obj_Tag is when None => Draw(The_Engine, App.Borg); Global_Content_Print(App.Borg.Cur, The_Engine.Content_Win.win); Enlight_Window(The_Engine.cmd_Win); Text_Io.Put(Normal_Mode); if App.Borg.Cur = null then Draw_Text(The_Engine.Cmd_Win, 1, 1, White, "# " & Cmd_Line(Cmd_Line'First..Line_Last)); elsif App.Borg.Cur.Info.Name /= null then Draw_Text(The_Engine.Cmd_Win, 1, 1, White, App.Borg.Cur.Info.Name.all & "# " & Cmd_Line(Cmd_Line'First..Line_Last)); else Draw_Text(The_Engine.Cmd_Win, 1, 1, White, "null# " & Cmd_Line(Cmd_Line'First..Line_Last)); end if; when others => null; end case; or accept Halt; exit Main_loop; or accept Wake_Up(Top : in Natural) do Master_Process.Top := Top; Initialize(The_Engine, Top); Draw(The_Engine, App.Borg); Global_Content_Print(App.Borg.Cur, The_Engine.Content_Win.win); if In_Print then if Print_Index /= 0 then if Printed /= null then case Printed.Tag is when None => null; when License => Enlight_Window(The_Engine.Obj_Main); Text_Io.Put(Normal_Mode); Printed.Print(The_Engine.Obj_Header.Win, The_Engine.Obj_Main.Win); when others => Enlight_Window(The_Engine.Attr); Text_Io.Put(Normal_Mode); Printed.Print(The_Engine.Obj_Header.Win, The_Engine.Attr.Win); end case; Printed.Print(The_Engine.Obj_Header.Win, The_Engine.Obj_Main.Win); end if; else if Printed /= null then case Printed.Tag is when None => null; when License => Enlight_Window(The_Engine.Obj_Main); Text_Io.Put(Normal_Mode); Printed.Print(The_Engine.Obj_Header.Win, The_Engine.Obj_Main.Win); when others => Enlight_Window(The_Engine.Attr); Text_Io.Put(Normal_Mode); Printed.Print(The_Engine.Obj_Header.Win, The_Engine.Attr.Win); end case; else case App.Borg.Cur.Tag is when None => null; when License => Enlight_Window(The_Engine.Obj_Main); Text_Io.Put(Normal_Mode); App.Borg.Cur.Print(The_Engine.Obj_Header.Win, The_Engine.Obj_Main.Win); when others => Enlight_Window(The_Engine.Attr); Text_Io.Put(Normal_Mode); App.Borg.Cur.Print(The_Engine.Obj_Header.Win, The_Engine.Attr.Win); end case; end if; end if; end if; if App.Borg.Cur /= null then On_Tree := True; On_List := False; Enlight_Window(The_Engine.Obj_Main); Text_Io.Put(Normal_Mode); Total_Line := 0; Line_Index := 0; Set_Free(Childs_Set); if App.Borg.Cur /= null then Tree(App.Borg.Cur, Level, Childs_Set, Last); Success := Print_Set(Childs_Set, The_Engine.List_Win, Line_Index, Total_Line); end if; for Item in reverse 1..2 loop Printed := Child(App.Borg.Cur, Item); if Printed /= null then case Printed.Tag is when None => null; when License => In_Print := True; Enlight_Window(The_Engine.Obj_Header); Enlight_Window(The_Engine.Attr); Text_Io.Put(Normal_Mode); Enlight_Window(The_Engine.Obj_Main); Text_Io.Put(Normal_Mode); Printed.Print(The_Engine.Obj_Header.Win, The_Engine.Obj_Main.Win); when others => In_Print := True; Enlight_Window(The_Engine.Obj_Header); Text_Io.Put(Normal_Mode); Enlight_Window(The_Engine.Attr); Text_Io.Put(Normal_Mode); Printed.Print(The_Engine.Obj_Header.Win, The_Engine.Attr.Win); end case; end if; end loop; Classes.Print(App.Borg.Cur.definition, The_Engine.Obj_Attr.Win); end if; if Last /= 0 then Success := Print_Set(File, The_Engine.File_Win, File_Index, Total_Line); end if; if App.Borg.Root = null then Draw_Text(The_Engine.Cmd_Win, 1, 1, White, "# "); elsif App.Borg.Cur.Info.Name /= null then Draw_Text(The_Engine.Cmd_Win, 1, 1, White, App.Borg.Cur.Info.Name.all & "# "); else Draw_Text(The_Engine.Cmd_Win, 1, 1, White, "null# "); end if; end Wake_Up; or accept Suspend; exit; or accept Refresh; or accept Page_Down; or accept Page_Up; or accept Up_Arrow do null; end up_arrow; or accept Down_Arrow do null; end Down_Arrow; or accept Left_Arrow; or accept Right_Arrow; or accept Del; or accept Begin_Of; or accept End_Of; or accept Overwrite; or accept Full_Screen; end select; end loop; loop select accept Halt; exit Main_Loop; or accept Suspend; or accept Wake_Up(Top : in Natural) do Master_Process.Top := Top; Initialize(The_Engine, Top); Draw(The_Engine, App.Borg); Obj_Tag := None; Global_Content_Print(App.Borg.Cur, The_Engine.Content_Win.win); if In_Print then if Print_Index /= 0 then if Printed /= null then Printed.Print(The_Engine.Obj_Header.Win, The_Engine.Obj_Main.Win); end if; else if Printed /= null then Printed.Print(The_Engine.Obj_Header.Win, The_Engine.Obj_Main.Win); else App.Borg.Cur.Print(The_Engine.Obj_Header.Win, The_Engine.Obj_Main.Win); end if; end if; end if; if Last /= 0 then Success := Print_Set(File, The_Engine.File_Win, File_Index, Total_Line); end if; On_Tree := True; On_List := False; Enlight_Window(The_Engine.Obj_Main); Text_Io.Put(Normal_Mode); Total_Line := 0; Line_Index := 0; Set_Free(Childs_Set); if App.Borg.Cur /= null then Tree(App.Borg.Cur, Level, Childs_Set, Last); Success := Print_Set(Childs_Set, The_Engine.List_Win, Line_Index, Total_Line); end if; if App.Borg.Cur /= null then for Item in reverse 1..2 loop Printed := Child(App.Borg.Cur, Item); if Printed /= null then case Printed.Tag is when None => null; when License => In_Print := True; Enlight_Window(The_Engine.Obj_Header); Enlight_Window(The_Engine.Attr); Text_Io.Put(Normal_Mode); Enlight_Window(The_Engine.Obj_Main); Text_Io.Put(Normal_Mode); Printed.Print(The_Engine.Obj_Header.Win, The_Engine.Obj_Main.Win); when others => In_Print := True; Enlight_Window(The_Engine.Obj_Header); Text_Io.Put(Normal_Mode); Enlight_Window(The_Engine.Attr); Text_Io.Put(Normal_Mode); Printed.Print(The_Engine.Obj_Header.Win, The_Engine.Attr.Win); end case; end if; end loop; Classes.Print(App.Borg.Cur.definition, The_Engine.Obj_Attr.Win); end if; if App.Borg.Root = null then Draw_Text(The_Engine.Cmd_Win, 1, 1, White, "# "); elsif App.Borg.Cur.Info.Name /= null then Draw_Text(The_Engine.Cmd_Win, 1, 1, White, App.Borg.Cur.Info.Name.all & "# "); else Draw_Text(The_Engine.Cmd_Win, 1, 1, White, "null# "); end if; end Wake_Up; exit; end select; end loop; end loop Main_Loop; --W_Io.Put_Line("Master process halted"); end Master_Process; subtype Seg_Type is Natural range 1..9; package Seg_Rand is new Ada.Numerics.Discrete_Random(Seg_Type); Seg_Gen : Seg_Rand.Generator; type Code_Type is record Prefix : Ada.Strings.Unbounded.Unbounded_String; Radix : Ada.Strings.Unbounded.Unbounded_String; Suffix : Ada.Strings.Unbounded.Unbounded_String; end record; package Code_Random is function Random(Length : in Positive) return String; procedure Reset; end Code_Random; package body Code_Random is Alphabet : constant String := "0123456789-abcdefghijklmnopqrstuvwxyz."; subtype Digit_Type is Positive range 1..Alphabet'Length; package Digit_Random is new Ada.Numerics.Discrete_Random(Digit_Type); use Digit_Random; Digit_Gen : Digit_Random.Generator; procedure Reset is begin Reset(Digit_Gen); end Reset; function Random(Length : in Positive) return String is Code : String(1..Length); Lock : Boolean := True; Char : Character; Index : natural := 0; begin while Index + 1 <= Length loop char := Alphabet(Random(Digit_Gen)); if Index + 1 = Length then Lock := True; end if; if not Lock then if char = '.' or char = '-' then Lock := True; end if; Code(Index + 1) := Char; Index := Index + 1; elsif char /= '.' and char /= '-' then Code(Index + 1) := Char; Index := Index + 1; Lock := False; end if; end loop; return Code; end Random; end Code_Random; use Code_Random; type Top_Level_Type is (Fr, En, Us, Ca, org); package Top_Level_Rand is new Ada.Numerics.Discrete_Random(Top_Level_Type); Top_Level_Gen : Top_Level_Rand.Generator; -- task type Web_Search_Type (Window : access Ansi_Windows.Window_Type; Search_Result : access Search_Result_Record; Pattern : access Wide_String; Errno : access Integer) is  -- entry Id(T_Id : out Task_Id);  -- entry Send(Result : out Search_Result_Record); -- entry Suspend; -- entry Start; -- entry Halt; -- end Web_Search_Type; -- task body Web_Search_Type is -- End_Of_Task, Done, Suspended : Boolean := False; -- Current_Address : OS_Lib.String_Access := new String ' ("localhost"); -- Current_Path : OS_Lib.String_Access := new String ' (""); -- Buffer_Path : OS_Lib.String_Access := new String ' (""); -- protocol : OS_Lib.String_Access := new String ' ("http://"); -- Current_Document_Name : M.Strings.Wide_String_Access := new Wide_String ' (""); -- Regular_Exp : Regexp.Regexp; -- Sub_Regular_Exp : Regexp.Regexp; -- -- HTTP 1.1. -- Code : Code_Type; -- Timeouts : Duration := 10.0; -- IP_Address : Sockets.Inet_Addr_Type; -- Sub_Top : Natural := Pattern'First; -- Sub_Index : Natural := Wide_Fixed.Index(Pattern.all, "*", Sub_Top + 1);  -- Matched_Error : Regexp.Regexp := Regexp.Compile(Handling.To_String("*CONNECTION_ERROR*"), True, True); -- Error : Integer := 0; -- begin  -- accept Id(T_Id : out Task_Id) do -- T_Id := Current_Task; -- end Id; -- First_Loop : -- loop -- declare -- Host_Entry : constant Sockets.Host_Entry_Type := Sockets.Get_Host_By_Name(Current_Address.all); -- begin  -- Regular_Exp := Regexp.Compile(Handling.To_String(Pattern.all), True, True); -- Wide_Free(Search_Result.Pattern); -- Search_Result.Pattern := new Wide_String ' ((Pattern.all)); -- IP_Address := Sockets.Addresses(Host_Entry); -- Sub_Regular_Exp := Regexp.Compile(Handling.To_String(Pattern(Sub_Top..Sub_Index)), True, True); -- Web.Web_Search(Current_Address.all, Protocol.all & Gnat.Sockets.Image(Ip_Address) & Current_Path.All, Timeouts, Search_Result.all); -- Os_Lib.Free(Search_Result.Address); -- Search_Result.Address := new String ' (Protocol.all & Current_Address.all & Current_Path.all); -- Wide_Free(Current_Document_Name); -- Current_Document_Name := new Wide_String ' (Search_Result.Doc_Name.all);  -- Ansi_Windows.Draw_Window (Window.all); -- Ansi_Windows.Draw (Window.all, 1, 2, White, "Searching for : " & (Pattern.all)); -- Ansi_Windows.Draw (Window.all, 2, 2, White, "look at : " &  -- Handling.To_Wide_String(Search_Result.Address.all)); -- Ansi_Windows.Draw (Window.all, 3, 2, White, "Document name : " & (Current_Document_Name.all)); -- for Line_Index in Search_Result.Wlines'Range loop -- declare -- Line : constant String := Handling.To_String(Gnos.Results."-"(Search_Result.Wlines(Line_Index)));  -- begin -- if Regexp.Match(Line, Regular_Exp) then -- Error := System("espeak "" pattern matching.""" & Character'Val(0)); -- --Ada.Text_Io.Put(Character'Val(7)); -- Errno.all := 0; -- Done := True; -- exit First_Loop; -- elsif Regexp.Match(Line, Sub_Regular_Exp) then -- Error := System("espeak "" pattern matching.""" & Character'Val(0)); -- --Ada.Text_Io.Put(Character'Val(7)); -- Errno.all := 0;  -- Wide_Free(Search_Result.Pattern); -- Search_Result.Pattern := new Wide_String ' (Pattern(Sub_Top..Sub_Index)); -- Done := True; -- declare -- Top_Href : constant Natural := Fixed.Index(Line, "href=") + 6; -- Href_Index : constant Natural := Fixed.Index(Line, """", Top_Href+1) - 1; -- Protocol_Index : constant Natural := Fixed.Index(Line, "http", Top_Href); -- begin  -- if Top_Href > 6 then -- if Protocol_Index /= 0 then -- Os_Lib.Free(protocol);  -- Protocol := new String ' (Line(Protocol_Index..Fixed.Index(Line, ":", Protocol_Index)) & "//"); -- declare -- Top_Domain : constant Natural := Fixed.Index(Line, "//", Protocol_Index + 1) + 2; -- Domain_Index : constant Natural := Fixed.Index(Line, "/", Top_domain + 1) - 1; -- begin -- if Top_Domain > 2 and then (Domain_Index > 0 and Domain_Index <= Href_Index) then -- Os_Lib.Free(Current_Address); -- Current_Address := new String ' (Line(Top_Domain .. Domain_Index)); -- if Domain_Index + 1 < Href_Index then -- Os_Lib.Free(Current_Path); -- Current_Path := new String ' (Line(Domain_Index + 1 .. Href_index)); -- end if; -- Done := False; -- elsif Top_Domain > 2 then -- Os_Lib.Free(Current_Address); -- Current_Address := new String ' (Line(Top_domain .. Href_index)); -- Os_Lib.Free(Current_Path); -- Current_Path := new String ' (""); -- Done := False; -- else -- Done := True; -- end if; -- exit First_Loop; -- end; -- else -- Os_Lib.Free(Buffer_Path); -- --Buffer_Path := new String ' (Current_Address.all); -- Buffer_Path := new String ' (Line(Top_Href..Href_Index)); -- --Buffer_Path := new String ' (Current_Path.all & '/' & Line(Top_Href..Href_Index)); -- --Buffer_Path := new String ' (Current_Path.all); -- --Buffer_Path := new String ' (Protocol.all & Line(Top_Href..Href_Index)); -- Os_Lib.Free(Current_Path); -- Current_Path := new String ' (Buffer_Path.all); -- Done := True; -- end if; -- exit; -- else -- Done := True; -- exit First_Loop; -- end if; -- end; -- end if; -- end; -- end loop;  -- Sub_Top := Sub_Index; -- Sub_Index := Wide_Fixed.Index(Pattern.all, "*", Sub_Top + 1);  -- if Sub_Index <= Sub_Top then  -- Done := false; -- end if;  -- exit when Sub_Index <= Sub_Top; -- exception -- when others => -- exit; -- end; -- end loop First_Loop; -- Put(Ansi_Tty_Control.Clear_Screen); -- loop -- select -- accept Halt; -- End_Of_Task := True; -- or -- accept Start; -- Suspended := False; -- exit; -- or -- accept Send(Result : out Search_Result_Record) do -- Result := Search_Result.all; -- end Send;  -- end select; -- end loop; -- loop -- select -- accept Halt; -- End_Of_Task := True; -- or -- accept Start; -- Suspended := False; -- exit; -- or -- accept Send(Result : out Search_Result_Record) do -- Result := Search_Result.all; -- end Send;  -- end select; -- end loop; -- Code_Random.Reset; -- Top_Level_Rand.Reset(Top_Level_Gen); -- protocol := new String ' ("https://"); -- if not Done then -- Main_Loop : -- loop -- begin -- begin -- Main_Search :  -- while not Done loop  -- Search_Result.Address := new String ' (Protocol.all & Current_Address.all & Current_Path.all); -- begin -- loop -- select -- accept Halt; -- End_Of_Task := True; -- exit Main_Search;  -- or -- accept Start; -- Suspended := False; -- exit; -- or -- accept Send(Result : out Search_Result_Record) do -- Result := Search_Result.all; -- end Send;  -- end select; -- end loop; -- loop -- select -- accept Halt; -- End_Of_Task := True; -- exit Main_Search;  -- or -- accept Start; -- Suspended := False; -- exit; -- or -- accept Send(Result : out Search_Result_Record) do -- Result := Search_Result.all; -- end Send;  -- end select; -- end loop; -- Second_Loop : -- loop  -- Search_Result.Address := new String ' (Protocol.all & Current_Address.all & Current_Path.all); -- loop -- select -- accept Halt; -- End_Of_Task := True; -- exit Main_Search;  -- or -- accept Start; -- Suspended := False; -- exit; -- or -- accept Send(Result : out Search_Result_Record) do -- Result := Search_Result.all; -- end Send;  -- end select; -- end loop; -- loop -- select -- accept Halt; -- End_Of_Task := True; -- exit Main_Search;  -- or -- accept Start; -- Suspended := False; -- exit; -- or -- accept Send(Result : out Search_Result_Record) do -- Result := Search_Result.all; -- end Send;  -- end select; -- end loop; -- delay 0.1; -- declare -- Host_Entry : constant Sockets.Host_Entry_Type := Sockets.Get_Host_By_Name(Current_Address.all); -- begin Domain : -- for I in 1..Sockets.Addresses_Length(Host_Entry) loop -- begin -- IP_Address := Sockets.Addresses(Host_Entry, I); -- ------------------- -- -- Random timeouts : -- Timeouts := 10.0; -- U_Array_Free(Search_Result.Wlines); -- Web.Web_Search(Current_Address.all, Protocol.all & Gnat.Sockets.Image(Ip_Address) & Current_Path.all, Timeouts, Search_Result.all); -- OS_Lib.Free(Search_Result.Address); -- Wide_Free(Current_Document_Name); -- Search_Result.Address := new String ' (Protocol.all & Current_Address.all & Current_Path.all); -- Current_Document_Name := new Wide_String ' (Search_Result.Doc_Name.all);  -- Put(Ansi_Tty_Control.Clear_Screen); -- Ansi_Windows.Draw_Window (Window.all); -- Ansi_Windows.Draw (Window.all, 1, 2, White, "Searching for : " & (Pattern.all)); -- Ansi_Windows.Draw (Window.all, 2, 2, White, "look at : " &  -- Handling.To_Wide_String(Search_Result.Address.all)); -- Ansi_Windows.Draw (Window.all, 3, 2, White, "Document name : " & (Current_Document_Name.all)); -- for Line_Index in Search_Result.Wlines'Range loop -- declare -- Line : constant String := Handling.To_String(Gnos.Results."-"(Search_Result.Wlines(Line_Index)));  -- begin -- if Regexp.Match(Line, Matched_Error) then -- raise Aws.Client.Connection_Error; -- end if; -- end; -- end loop; -- for Line_Index in Search_Result.Wlines'Range loop -- declare -- Line : constant String := Handling.To_String(Gnos.Results."-"(Search_Result.Wlines(Line_Index))); -- begin  -- if Regexp.Match(Line, Regular_Exp) then -- Error := System("espeak "" pattern matching.""" & Character'Val(0)); -- --Ada.Text_Io.Put(Character'Val(7)); -- Errno.all := 0; -- Done := True; -- exit domain; -- elsif Regexp.Match(Line, Sub_Regular_Exp) then -- Error := System("espeak "" pattern matching.""" & Character'Val(0)); -- --Ada.Text_Io.Put(Character'Val(7)); -- Errno.all := 0; -- Done := True; -- Wide_Free(Search_Result.Pattern); -- Search_Result.Pattern := new Wide_String ' (Pattern(Sub_Top..Sub_Index)); -- declare -- Top_Href : constant Natural := Fixed.Index(Line, "href=") + 6; -- Href_Index : constant Natural := Fixed.Index(Line, """", Top_Href + 1) - 1; -- Protocol_Index : constant Natural := Fixed.Index(Line, "http", Top_Href);  -- begin -- if Top_Href > 6 then -- if Protocol_Index /= 0 then -- Os_Lib.Free(protocol); -- Protocol := new String ' (Line(Protocol_Index..Fixed.Index(Line, ":", Protocol_Index)) & "//"); -- declare -- Top_Domain : constant Natural := Fixed.Index(Line, "//", Protocol_Index + 1) + 2; -- Domain_Index : constant Natural := Fixed.Index(Line, "/", Top_domain + 1) - 1; -- begin -- if Top_Domain > 2 and then (Domain_Index > 0 and Domain_Index <= Href_Index) then -- Os_Lib.Free(Current_Address); -- Current_Address := new String ' (Line(Top_Domain .. Domain_Index)); -- if Domain_Index + 1 < Href_Index then -- Os_Lib.Free(Current_Path); -- Current_Path := new String ' (Line(Domain_Index + 1 .. Href_index)); -- end if; -- Done := False; -- elsif Top_Domain > 2 then -- Os_Lib.Free(Current_Address); -- Current_Address := new String ' (Line(Top_domain .. Href_index)); -- Os_Lib.Free(Current_Path); -- Current_Path := new String ' (""); -- Done := False; -- else -- Done := false; -- -- Sub_Top := Sub_Index; -- -- Sub_Index := Wide_Fixed.Index(Pattern.all, "*", Sub_Top + 1);  -- -- exit when Sub_Index <= Sub_Top; -- exit Second_Loop; -- end if; -- end; -- else -- Os_Lib.Free(Buffer_Path); -- --Buffer_Path := new String ' (Current_Address.all); -- Buffer_Path := new String ' (Line(Top_Href..Href_Index)); -- --Buffer_Path := new String ' (Current_Path.all & '/' & Line(Top_Href..Href_Index)); -- --Buffer_Path := new String ' (Current_Path.all); -- --Buffer_Path := new String ' (Protocol.all & Line(Top_Href..Href_Index)); -- Os_Lib.Free(Current_Path); -- Current_Path := new String ' (Buffer_Path.all); -- Done := True; -- end if; -- -- Sub_Top := Sub_Index; -- -- Sub_Index := Wide_Fixed.Index(Pattern.all, "*", Sub_Top + 1);  -- -- exit when Sub_Index <= Sub_Top; -- exit domain; -- else -- Done := True; -- loop -- select -- accept Halt; -- End_Of_Task := True; -- or -- accept Start; -- Suspended := False; -- exit; -- or -- accept Send(Result : out Search_Result_Record) do -- Result := Search_Result.all; -- end Send;  -- or -- delay 0.05; -- end select; -- end loop; -- -- Sub_Top := Sub_Index; -- -- Sub_Index := Wide_Fixed.Index(Pattern.all, "*", Sub_Top + 1);  -- -- exit when Sub_Index <= Sub_Top; -- exit Second_loop; -- end if; -- end;  -- end if; -- end;  -- end loop; -- loop -- select -- accept Halt; -- exit Main_Search; -- or -- accept Suspend;  -- Suspended := True;  -- --Ansi_Windows.Clear_Screen; -- exit Second_loop; -- or -- accept Start; -- Suspended := False; -- exit; -- or -- accept Send(Result : out Search_Result_Record) do -- Result := Search_Result.all; -- end Send;  -- or  -- delay 0.05; -- end select; -- end loop; -- exception -- when Aws.Client.Connection_Error => -- protocol := new String ' ("http://"); -- Search_Result.Address := new String ' (Protocol.all & Current_Address.all & Current_Path.all); -- exit; -- when Aws.Client.Protocol_Error => -- null; -- when others => -- null; -- end; -- end loop Domain;  -- select -- accept Send(Result : out Search_Result_Record) do -- Result := Search_Result.all; -- end Send; -- or -- accept Halt; -- exit Main_Search; -- or -- accept Suspend; -- --Ansi_Windows.Clear_Screen; -- Suspended := True;  -- or -- delay 0.05; -- end select;  -- select -- accept Send(Result : out Search_Result_Record) do -- Result := Search_Result.all; -- end Send; -- or -- accept Halt; -- exit Main_Search; -- or -- accept Suspend; -- --Ansi_Windows.Clear_Screen; -- Suspended := True;  -- or -- delay 0.05; -- end select;  -- exception -- when others => -- exit; -- end;  -- Sub_Top := Sub_Index; -- Sub_Index := Wide_Fixed.Index(Pattern.all, "*", Sub_Top + 1);  -- exit when Sub_Index <= Sub_Top; -- end loop Second_Loop; -- loop -- select -- accept Suspend; -- or -- accept Start;  -- exit; -- or -- accept Halt; -- exit Main_Search; -- or -- accept Send(Result : out Search_Result_Record) do -- Result := Search_Result.all; -- end Send;  -- or -- delay 0.05; -- end select; -- end loop; -- exception  -- when Sockets.Host_Error => -- select -- accept Halt; -- exit Main_Search; -- or -- accept Suspend; -- Suspended := True;  -- or -- delay 0.05; -- end select;  -- when others => -- select -- accept Halt; -- exit Main_Search; -- or -- accept Suspend; -- Suspended := True;  -- or -- delay 0.05; -- end select;  -- end; -- --Code.Prefix := Strings.Unbounded.To_Unbounded_String(Random(Seg_Rand.Random(Seg_Gen))); -- Code.Radix := Ada.Strings.Unbounded.To_Unbounded_String(Random(Seg_Rand.Random(Seg_Gen))); -- Code.suffix := Ada.Strings.Unbounded.To_Unbounded_String(Handling.To_Lower(Top_Level_Type'Image(Top_Level_Rand.Random(Top_Level_Gen)))); -- OS_Lib.Free(Current_Address); -- Current_Address := new String ' ("www." & --Strings.Unbounded.To_String(Code.Prefix) & '-' & -- Ada.Strings.Unbounded.To_String(Code.Radix) & '.' & -- Ada.Strings.Unbounded.To_String(Code.Suffix));  -- Os_Lib.Free(Current_Path); -- Current_Path := new String ' (""); -- Sub_Top := Pattern'First; -- Sub_Index := Wide_Fixed.Index(Pattern.all, "*", Sub_Top + 1);  -- protocol := new String ' ("https://"); -- end loop Main_Search; -- if Done then -- exit Main_Loop; -- end if; -- exception -- when Sockets.Socket_Error => -- Errno.all := 128; -- loop -- select -- accept Suspend; -- or -- accept Start;  -- or -- accept Halt; -- exit; -- or -- delay 0.05; -- Ansi_Windows.Draw_Window (Window.all); -- Ansi_Windows.Draw (Window.all, 1, 2, White, "Socket error"); -- end select;  -- end loop; -- when Sockets.Host_Error => -- Errno.all := 128; -- loop -- select -- accept Suspend; -- or -- accept Start;  -- or -- accept Halt; -- exit; -- or -- delay 0.05; -- Ansi_Windows.Draw_Window (Window.all); -- Ansi_Windows.Draw (Window.all, 1, 2, White, Handling.To_Wide_String("Host error :" & Current_Address.all)); -- end select;  -- end loop; -- when others => -- Errno.all := 128; -- loop -- select -- accept Suspend; -- or -- accept Start;  -- or -- accept Halt; -- exit; -- or -- delay 0.05; -- Ansi_Windows.Draw_Window (Window.all); -- Ansi_Windows.Draw (Window.all, 1, 2, White, "Others error"); -- raise; -- end select;  -- end loop; -- end; -- exception -- when others => -- null; -- end; -- end loop Main_Loop; -- end if;  -- end Web_Search_Type; task type Web_Search_Type (Window : access Ansi_Windows.Window_Type; Search_Result : access Search_Result_Record; Pattern : access Wide_String; Errno : access Integer) is entry Id(T_Id : out Task_Id); entry Send(Result : out Search_Result_Record); entry Suspend; entry Start; entry Halt; end Web_Search_Type; task body Web_Search_Type is End_Of_Task, Done, Suspended : Boolean := False; Current_Address : OS_Lib.String_Access := new String ' ("localhost"); Current_Path : OS_Lib.String_Access := new String ' (""); Buffer_Path : OS_Lib.String_Access := new String ' (""); protocol : OS_Lib.String_Access := new String ' ("http://"); Current_Document_Name : M.Strings.Wide_String_Access := new Wide_String ' (""); Regular_Exp : Regexp.Regexp; Sub_Regular_Exp : Regexp.Regexp; -- HTTP 1.1. Code : Code_Type; Timeouts : Duration := 10.0; IP_Address : Sockets.Inet_Addr_Type; Sub_Top : Natural := Pattern'First; Sub_Index : Natural := Wide_Fixed.Index(Pattern.all, "*", Sub_Top + 1); Matched_Error : Regexp.Regexp := Regexp.Compile(Handling.To_String("*CONNECTION_ERROR*"), True, True); Error : Integer := 0; begin accept Id(T_Id : out Task_Id) do T_Id := Current_Task; end Id; First_Loop : loop declare Host_Entry : constant Sockets.Host_Entry_Type := Sockets.Get_Host_By_Name(Current_Address.all); begin Regular_Exp := Regexp.Compile(Handling.To_String(Pattern.all), True, True); --Adam.Results.Free(Search_Result.Pattern); Wide_Free(Search_Result.Pattern); Search_Result.Pattern := new Wide_String ' ((Pattern.all)); IP_Address := Sockets.Addresses(Host_Entry); Sub_Regular_Exp := Regexp.Compile(Handling.To_String(Pattern(Sub_Top..Sub_Index)), True, True); Web.Web_Search(Current_Address.all, Protocol.all & Gnat.Sockets.Image(Ip_Address) & Current_Path.All, Timeouts, Search_Result.all); Os_Lib.Free(Search_Result.Address); Search_Result.Address := new String ' (Protocol.all & Current_Address.all & Current_Path.all); Wide_Free(Current_Document_Name); Current_Document_Name := new Wide_String ' (Search_Result.Doc_Name.all); Ansi_Windows.Draw_Window (Window.all); Ansi_Windows.Draw (Window.all, 1, 2, White, "Searching for : " & (Pattern.all)); Ansi_Windows.Draw (Window.all, 2, 2, White, "look at : " & Handling.To_Wide_String(Search_Result.Address.all)); Ansi_Windows.Draw (Window.all, 3, 2, White, "Document name : " & (Current_Document_Name.all)); for Line_Index in Search_Result.wlines'Range loop declare Line : constant String := Handling.To_String("-"(Search_Result.wlines(Line_Index))); begin if Regexp.Match(Line, Regular_Exp) then Error := System("espeak "" pattern matching.""" & Character'Val(0)); --Ada.Text_Io.Put(Character'Val(7)); Errno.all := 0; Done := True; exit First_Loop; elsif Regexp.Match(Line, Sub_Regular_Exp) then Error := System("espeak "" pattern matching.""" & Character'Val(0)); --Ada.Text_Io.Put(Character'Val(7)); Errno.all := 0; Wide_Free(Search_Result.Pattern); Search_Result.Pattern := new Wide_String ' (Pattern(Sub_Top..Sub_Index)); Done := True; declare Top_Href : constant Natural := Fixed.Index(Line, "href=") + 6; Href_Index : constant Natural := Fixed.Index(Line, """", Top_Href+1) - 1; Protocol_Index : constant Natural := Fixed.Index(Line, "http", Top_Href); begin if Top_Href > 6 then if Protocol_Index /= 0 then Os_Lib.Free(protocol); Protocol := new String ' (Line(Protocol_Index..Fixed.Index(Line, ":", Protocol_Index)) & "//"); declare Top_Domain : constant Natural := Fixed.Index(Line, "//", Protocol_Index + 1) + 2; Domain_Index : constant Natural := Fixed.Index(Line, "/", Top_domain + 1) - 1; begin if Top_Domain > 2 and then (Domain_Index > 0 and Domain_Index <= Href_Index) then Os_Lib.Free(Current_Address); Current_Address := new String ' (Line(Top_Domain .. Domain_Index)); if Domain_Index + 1 < Href_Index then Os_Lib.Free(Current_Path); Current_Path := new String ' (Line(Domain_Index + 1 .. Href_index)); end if; Done := False; elsif Top_Domain > 2 then Os_Lib.Free(Current_Address); Current_Address := new String ' (Line(Top_domain .. Href_index)); Os_Lib.Free(Current_Path); Current_Path := new String ' (""); Done := False; else Done := True; end if; exit First_Loop; end; else Os_Lib.Free(Buffer_Path); --Buffer_Path := new String ' (Current_Address.all); Buffer_Path := new String ' (Line(Top_Href..Href_Index)); --Buffer_Path := new String ' (Current_Path.all & '/' & Line(Top_Href..Href_Index)); --Buffer_Path := new String ' (Current_Path.all); --Buffer_Path := new String ' (Protocol.all & Line(Top_Href..Href_Index)); Os_Lib.Free(Current_Path); Current_Path := new String ' (Buffer_Path.all); Done := True; end if; exit; else Done := True; exit First_Loop; end if; end; end if; end; end loop; Sub_Top := Sub_Index; Sub_Index := Wide_Fixed.Index(Pattern.all, "*", Sub_Top + 1); if Sub_Index <= Sub_Top then Done := false; end if; exit when Sub_Index <= Sub_Top; exception when others => exit; end; end loop First_Loop; Put(Ansi_Tty_Control.Clear_Screen); loop select accept Halt; End_Of_Task := True; or accept Start; Suspended := False; exit; or accept Send(Result : out Search_Result_Record) do Result := Search_Result.all; end Send; end select; end loop; loop select accept Halt; End_Of_Task := True; or accept Start; Suspended := False; exit; or accept Send(Result : out Search_Result_Record) do Result := Search_Result.all; end Send; end select; end loop; Code_Random.Reset; Top_Level_Rand.Reset(Top_Level_Gen); protocol := new String ' ("https://"); if not Done then Main_Loop : while not End_Of_Task loop begin begin Main_Search : while not Done loop Search_Result.Address := new String ' (Protocol.all & Current_Address.all & Current_Path.all); begin loop select accept Halt; End_Of_Task := True; exit Main_loop; or accept Start; Suspended := False; exit; or accept Send(Result : out Search_Result_Record) do Result := Search_Result.all; end Send; end select; end loop; loop select accept Halt; End_Of_Task := True; exit Main_loop; or accept Start; Suspended := False; exit; or accept Send(Result : out Search_Result_Record) do Result := Search_Result.all; end Send; end select; end loop; Second_Loop : loop Search_Result.Address := new String ' (Protocol.all & Current_Address.all & Current_Path.all); loop select accept Halt; End_Of_Task := True; exit Main_loop; or accept Start; Suspended := False; exit; or accept Send(Result : out Search_Result_Record) do Result := Search_Result.all; end Send; end select; end loop; loop select accept Halt; End_Of_Task := True; exit Main_loop; or accept Start; Suspended := False; exit; or accept Send(Result : out Search_Result_Record) do Result := Search_Result.all; end Send; end select; end loop; delay 0.1; declare Host_Entry : constant Sockets.Host_Entry_Type := Sockets.Get_Host_By_Name(Current_Address.all); begin Domain : for I in 1..Sockets.Addresses_Length(Host_Entry) loop begin IP_Address := Sockets.Addresses(Host_Entry, I); Timeouts := 10.0; U_Array_Free(Search_Result.wlines); Web.Web_Search(Current_Address.all, Protocol.all & Gnat.Sockets.Image(Ip_Address) & Current_Path.all, Timeouts, Search_Result.all); OS_Lib.Free(Search_Result.Address); Wide_Free(Current_Document_Name); Search_Result.Address := new String ' (Protocol.all & Current_Address.all & Current_Path.all); Current_Document_Name := new Wide_String ' (Search_Result.Doc_Name.all); Put(Ansi_Tty_Control.Clear_Screen); Ansi_Windows.Draw_Window (Window.all); Ansi_Windows.Draw (Window.all, 1, 2, White, "Searching for : " & (Pattern.all)); Ansi_Windows.Draw (Window.all, 2, 2, White, "look at : " & Handling.To_Wide_String(Search_Result.Address.all)); Ansi_Windows.Draw (Window.all, 3, 2, White, "Document name : " & (Current_Document_Name.all)); for Line_Index in Search_Result.Wlines'Range loop declare Line : constant String := Handling.To_String("-"(Search_Result.Wlines(Line_Index))); begin if Regexp.Match(Line, Matched_Error) then raise Aws.Client.Connection_Error; end if; end; end loop; for Line_Index in Search_Result.wlines'Range loop declare Line : constant String := Handling.To_String("-"(Search_Result.wlines(Line_Index))); begin if Regexp.Match(Line, Regular_Exp) then Error := System("espeak "" pattern matching.""" & Character'Val(0)); Ada.Text_Io.Put(Character'Val(7)); Errno.all := 0; Done := True; exit domain; elsif Regexp.Match(Line, Sub_Regular_Exp) then Error := System("espeak "" pattern matching.""" & Character'Val(0)); Ada.Text_Io.Put(Character'Val(7)); Errno.all := 0; Done := True; Wide_Free(Search_Result.Pattern); Search_Result.Pattern := new Wide_String ' (Pattern(Sub_Top..Sub_Index)); declare Top_Href : constant Natural := Fixed.Index(Line, "href=") + 6; Href_Index : constant Natural := Fixed.Index(Line, """", Top_Href + 1) - 1; Protocol_Index : constant Natural := Fixed.Index(Line, "http", Top_Href); begin if Top_Href > 6 then if Protocol_Index /= 0 then Os_Lib.Free(protocol); Protocol := new String ' (Line(Protocol_Index..Fixed.Index(Line, ":", Protocol_Index)) & "//"); declare Top_Domain : constant Natural := Fixed.Index(Line, "//", Protocol_Index + 1) + 2; Domain_Index : constant Natural := Fixed.Index(Line, "/", Top_domain + 1) - 1; begin if Top_Domain > 2 and then (Domain_Index > 0 and Domain_Index <= Href_Index) then Os_Lib.Free(Current_Address); Current_Address := new String ' (Line(Top_Domain .. Domain_Index)); if Domain_Index + 1 < Href_Index then Os_Lib.Free(Current_Path); Current_Path := new String ' (Line(Domain_Index + 1 .. Href_index)); end if; Done := False; elsif Top_Domain > 2 then Os_Lib.Free(Current_Address); Current_Address := new String ' (Line(Top_domain .. Href_index)); Os_Lib.Free(Current_Path); Current_Path := new String ' (""); Done := False; else Done := false; Sub_Top := Sub_Index; Sub_Index := Wide_Fixed.Index(Pattern.all, "*", Sub_Top + 1); exit when Sub_Index <= Sub_Top; exit Second_Loop; end if; end; else Os_Lib.Free(Buffer_Path); Buffer_Path := new String ' (Current_Address.all); Buffer_Path := new String ' (Line(Top_Href..Href_Index)); Buffer_Path := new String ' (Current_Path.all & '/' & Line(Top_Href..Href_Index)); Buffer_Path := new String ' (Current_Path.all); Buffer_Path := new String ' (Protocol.all & Line(Top_Href..Href_Index)); Os_Lib.Free(Current_Path); Current_Path := new String ' (Buffer_Path.all); Done := True; end if; Sub_Top := Sub_Index; Sub_Index := Wide_Fixed.Index(Pattern.all, "*", Sub_Top + 1); exit when Sub_Index <= Sub_Top; exit domain; else Done := True; loop select accept Halt; End_Of_Task := True; exit Main_Loop; or accept Start; Suspended := False; exit; or accept Send(Result : out Search_Result_Record) do Result := Search_Result.all; end Send; or delay 0.05; end select; end loop; Sub_Top := Sub_Index; Sub_Index := Wide_Fixed.Index(Pattern.all, "*", Sub_Top + 1); exit when Sub_Index <= Sub_Top; exit Second_loop; end if; end; end if; end; end loop; loop select accept Halt; exit Main_loop; or accept Suspend; Suspended := True; Ansi_Windows.Clear_Screen; exit Second_loop; or accept Start; Suspended := False; exit; or accept Send(Result : out Search_Result_Record) do Result := Search_Result.all; end Send; or delay 0.05; end select; end loop; exception when Aws.Client.Connection_Error => protocol := new String ' ("http://"); Search_Result.Address := new String ' (Protocol.all & Current_Address.all & Current_Path.all); exit; when Aws.Client.Protocol_Error => null; when others => null; end; end loop Domain; select accept Send(Result : out Search_Result_Record) do Result := Search_Result.all; end Send; or accept Halt; exit Main_loop; or accept Suspend; Ansi_Windows.Clear_Screen; Suspended := True; or delay 0.05; end select; select accept Send(Result : out Search_Result_Record) do Result := Search_Result.all; end Send; or accept Halt; exit Main_loop; or accept Suspend; --Ansi_Windows.Clear_Screen; Suspended := True; or delay 0.05; end select; exception when others => exit; end; Sub_Top := Sub_Index; Sub_Index := Wide_Fixed.Index(Pattern.all, "*", Sub_Top + 1); exit when Sub_Index <= Sub_Top; end loop Second_Loop; loop select accept Suspend; or accept Start; exit; or accept Halt; exit Main_loop; or accept Send(Result : out Search_Result_Record) do Result := Search_Result.all; end Send; or delay 0.05; end select; end loop; exception when Sockets.Host_Error => select accept Halt; exit Main_loop; or accept Suspend; Suspended := True; or delay 0.05; end select; when others => select accept Halt; exit Main_loop; or accept Suspend; Suspended := True; or delay 0.05; end select; end; --Code.Prefix := Strings.Unbounded.To_Unbounded_String(Random(Seg_Rand.Random(Seg_Gen))); Code.Radix := Ada.Strings.Unbounded.To_Unbounded_String(Random(Seg_Rand.Random(Seg_Gen))); Code.suffix := Ada.Strings.Unbounded.To_Unbounded_String(Handling.To_Lower(Top_Level_Type'Image(Top_Level_Rand.Random(Top_Level_Gen)))); OS_Lib.Free(Current_Address); Current_Address := new String ' ("www." & --Strings.Unbounded.To_String(Code.Prefix) & '-' & Ada.Strings.Unbounded.To_String(Code.Radix) & '.' & Ada.Strings.Unbounded.To_String(Code.Suffix)); Os_Lib.Free(Current_Path); Current_Path := new String ' (""); Sub_Top := Pattern'First; Sub_Index := Wide_Fixed.Index(Pattern.all, "*", Sub_Top + 1); protocol := new String ' ("https://"); end loop Main_Search; if Done then exit Main_Loop; end if; exception when Sockets.Socket_Error => Errno.all := 128; loop select accept Suspend; or accept Start; or accept Halt; exit Main_loop; or delay 0.05; Ansi_Windows.Draw_Window (Window.all); Ansi_Windows.Draw (Window.all, 1, 2, White, "Socket error"); end select; end loop; when Sockets.Host_Error => Errno.all := 128; loop select accept Suspend; or accept Start; or accept Halt; exit Main_loop; or delay 0.05; Ansi_Windows.Draw_Window (Window.all); Ansi_Windows.Draw (Window.all, 1, 2, White, Handling.To_Wide_String("Host error :" & Current_Address.all)); end select; end loop; when others => Errno.all := 128; loop select accept Suspend; or accept Start; or accept Halt; exit Main_loop; or delay 0.05; Ansi_Windows.Draw_Window (Window.all); Ansi_Windows.Draw (Window.all, 1, 2, White, "Others error"); raise; end select; end loop; end; exception when others => null; end; end loop Main_Loop; end if; end Web_Search_Type; -- procedure Search_Result_Info (Window : in Ansi_Windows.Window_Type; Shell_Interface : in Main_Interface_Access; Errno : out Integer) is -- begin -- Ansi_Windows.Draw_Window (Window);  -- Ansi_Windows.Draw (Window, 1, 2, White, "Search result for " & Shell_Interface.Search_Result.Pattern.all); -- Ansi_Windows.Draw (Window, 2, 2, White, "Address : " & Handling.To_Wide_String(Shell_Interface.Search_Result.Address.all)); -- Ansi_Windows.Draw (Window, 3, 2, White, "Document name : " & (Shell_Interface.Search_Result.Doc_Name.all)); -- Errno := 0; -- end Search_Result_Info; procedure Search_Result_Info (Window : in Ansi_Windows.Window_Type; Web_result : in Search_Result_record; Errno : out Integer) is begin Ansi_Windows.Draw_Window (Window); Ansi_Windows.Draw (Window, 1, 2, White, "Search result for " & Web_Result.Pattern.all); Ansi_Windows.Draw (Window, 2, 2, White, "Address : " & Handling.To_Wide_String(Web_Result.Address.all)); Ansi_Windows.Draw (Window, 3, 2, White, "Document name : " & (Web_Result.Doc_Name.all)); Errno := 0; end Search_Result_Info; procedure Mode_Info_Status (Window : in Ansi_Windows.Window_Type; Mode : in Command_Type) is begin case Mode is when Null_Item .. Adamanborg_Call => Ansi_Windows.Draw_Window (Window); --Ansi_Windows.Draw_Centered (Window, 1, White, (Header_Lines(Command_Type'Pos(Mode)).all)); when Gnushell => Ansi_Windows.Draw_Window (Window); Ansi_Windows.Draw_Centered (Window, 1, White, "GnuShell mode : "); when others => Ansi_Windows.Draw_Window (Window); Ansi_Windows.Draw_Centered (Window, 1, White, Handling.To_Wide_String(Command_Type'Image(Mode))); null; end case; end Mode_Info_Status; -- Messages pour que l'utilisateur(rice) ne se sente pas perdu(e). -- procedure Main_Quit_Info_Status(Window : in Ansi_Windows.Window_Type; On_Esc : Boolean) is -- begin -- if On_Esc then -- Ansi_Windows.Draw_Window (Window);  -- Ansi_Windows.Draw_Centered (Window, 1, White, "press one Escape character to Quit !"); -- else -- Ansi_Windows.Draw_Window (Window);  -- Ansi_Windows.Draw_Centered (Window, 1, White, "press two Escape character to Quit !"); -- end if; -- end Main_Quit_Info_Status; procedure GnuShell_Command (Window : in Ansi_Windows.Window_Type; Shell_Interface : in Main_Interface_Access; Pattern : in Wide_String; Errno : out Integer) is begin if Wide_Fixed.Index(Pattern, " ") /= 0 and then Wide_Fixed.Index(Pattern, " ") < Pattern'last then declare Expanded_Line : constant Wide_String := Pattern(Wide_Fixed.Index(Pattern, " ")+1..Pattern'Last); begin --Text_Io.Put_Line("Expanded line : " & Expanded_Line); declare Command_Line : constant Wide_String := Pattern(Pattern'First..Wide_Fixed.Index(Pattern, " ")-1) & ' ' & Expanded_Line; begin Text_Io.Put_Line("Ok !"); Shell_Interface.Spawn_Result := shell_Spawn(UTF_Encoding.Wide_Strings.Encode((Command_Line))); Text_Io.Put_Line("Ok !"); end; end; else Shell_Interface.Spawn_Result := Shell_Spawn(UTF_Encoding.Wide_Strings.Encode(Pattern)); end if; Errno := Shell_Interface.Spawn_Result.Return_Code; end GnuShell_Command; -- procedure GnuShell_Command (Window : in Ansi_Windows.Window_Type; Spawn_Result : out Spawn_Result_Record; Pattern : in Wide_String; Errno : out Integer) is -- begin -- if Wide_Fixed.Index(Pattern, " ") /= 0 and then Wide_Fixed.Index(Pattern, " ") < Pattern'last then -- declare -- Expanded_Line : constant Wide_String := Pattern(Wide_Fixed.Index(Pattern, " ")+1..Pattern'Last); -- begin  -- --Text_Io.Put_Line("Expanded line : " & Expanded_Line); -- declare -- Command_Line : constant Wide_String := Pattern(Pattern'First..Wide_Fixed.Index(Pattern, " ")-1) & ' ' & Expanded_Line; -- begin -- Text_Io.Put_Line("Ok !"); -- Spawn_Result := shell_Spawn(UTF_Encoding.Wide_Strings.Encode((Command_Line))); -- Text_Io.Put_Line("Ok !"); -- end; -- end; -- else -- Spawn_Result := Shell_Spawn(UTF_Encoding.Wide_Strings.Encode(Pattern));  -- end if; -- Errno := Shell_Interface.Spawn_Result.Return_Code; -- end GnuShell_Command; Term_Width : constant Positive := Columns - 2; Command_Max_Lines : constant Positive := Lines - (11 + 9); -- instead 11 + 8 Result_Max_Lines : constant Positive := Lines - (9 + 9);-- instead 9 + 8 W1 : constant Ansi_Windows.Window_Type := ( -- Header of Program. L => 1, C => 2, H => 3, W => Term_Width, Frame_Type => Ansi_Windows.Single_Line_Frame, Frame_Color => Yellow, Close_Box_Color => Red); W10 : constant Ansi_Windows.Window_Type := ( -- Command result : out_file.txt. L => 9, C => 2, H => Result_Max_lines, W => Term_Width, Frame_Type => Ansi_Windows.Single_Line_Frame, Frame_Color => M.Ansi.Console.Yellow, Close_Box_Color => M.Ansi.Console.Red); W2 : constant Ansi_Windows.Window_Type := ( -- Command_line and text. L => 11, C => 2, H => Command_Max_Lines, W => Term_Width, Frame_Type => Ansi_Windows.Double_Line_Frame, Frame_Color => M.Ansi.Console.Yellow, Close_Box_Color => M.Ansi.Console.Red); W11 : constant Ansi_Windows.Window_Type := ( -- Command info status L => 4, C => 2, H => 5, W => Term_Width, Frame_Type => Ansi_Windows.Single_Line_Frame, Frame_Color => M.Ansi.Console.Yellow, Close_Box_Color => M.Ansi.Console.Red); procedure Mode_Initialization (Main_Window : in Ansi_Windows.Window_Type; Mode : in Command_Type;On_Esc : in Boolean; Message : in Wide_string) is begin --Ada.Text_Io.Put(PragmARC.Ansi_Tty_Control.Clear_Screen); Mode_Info_Status(W1, Mode); Ansi_windows.Draw_Window (Main_Window); --Main_Quit_Info_Status(W3, On_Esc);  Ansi_windows.Draw_Centered (Main_Window, 1, M.Ansi.Console.White, Message); end Mode_Initialization; procedure Command_Info_Status (Window : in Ansi_Windows.Window_Type; Shell_Interface : in Main_Interface_Access) is begin Ansi_Windows.Draw_Window (Window); Ansi_Windows.Draw (Window, 1, 2, Ansi.Console.White, "Program Name : " & (-Shell_Interface.Spawn_Result.Program_Name)); Ansi_Windows.Draw (Window, 2, 2, Ansi.Console.White, "Success : " & To_Wide_String(Boolean'Image(Shell_Interface.Spawn_Result.success))); Ansi_Windows.Draw (Window, 3, 2, Ansi.Console.White, "Errno : " & To_Wide_String(Integer'Image(Shell_Interface.Spawn_Result.Return_Code))); end Command_Info_Status; Current_Command : Sub_Command_Type := None; task body Shell_Process is use Adam.Results; procedure Internal_Help (Line : in Wide_string; Result : in out Adam.Results.Spawn_Result_Type) is Command : Gnat.Command_Line.Command_Line; Cmd : Sub_Command_Type := None; Args_List : Os_Lib.Argument_List_Access; Buffer : Adam.Results.Variadic_Access; Last : Natural := 0; begin if Result.File_Content = null then Result.File_Content := new Variadic_Array(1..5); end if; Buffer := Result.File_content; Gnat.Command_Line.Set_Command_Line(Command, Handling.To_String(Line)); Gnat.Command_Line.Build(Command, Args_List, False); if Args_List'Last > 1 then if not OS_Lib."="(Args_List(2), null) and then Args_List(2).all /= "" then begin Cmd := Sub_Command_Type'Value(Args_list(2).all); exception when Constraint_Error => Buffer(1) := (Adam.Results."+"(Handling.To_Wide_String(Args_List(2).all) & " is not an internal command.")); Buffer(2) := (Adam.Results."+"("Command help : help COMMAND")); Buffer(3) := (Adam.Results."+"(" -- help ? print command help for ? --")); Result.File_Content := Buffer; --Result.Count := 3; return; end; else Cmd := None; end if; else Cmd := None; end if; --Result.Count := 0; if Cmd = None then for Iter in Sub_Command_Type'Range loop case Cmd is when None => Buffer(1) := (Adam.Results."+"("Command help : help COMMAND")); Buffer(2) := (Adam.Results."+"(" -- help ? print command help for ? --")); --Result.Count := Result.Count + 2; -- when Clear => -- Buffer(1) := (Adam.Results."+"( "Command help : clear")); -- Buffer(1) := (Adam.Results."+"( " -- Erase the shell file named ""$HOME/.buffer.txt"" --")); --Result.Count := Result.Count + 2; when Alias => Buffer(1) := (Adam.Results."+"( "Command help : alias")); Buffer(2) := (Adam.Results."+"( " -- Create an alias to any command --")); Buffer(3) := (Adam.Results."+"( " -- Ex : alias name=value --")); --Result.Count := Result.Count + 3; when Unalias => Buffer(1) := (Adam.Results."+"( "Command help : unalias")); Buffer(2) := (Adam.Results."+"( " -- Delete an alias --")); Buffer(3) := (Adam.Results."+"( " -- Ex : unalias name --")); --Result.Count := Result.Count + 3; when Cd => Buffer(1) := (Adam.Results."+"( "Command help : cd")); Buffer(2) := (Adam.Results."+"( " -- Change current working directory --")); Buffer(3) := (Adam.Results."+"( " -- Ex : cd Documents [ Enter ] --")); Buffer(4) := (Adam.Results."+"( " -- Ex : cd - [ Enter ] (Change current dir to OLD_PWD --")); Buffer(5) := (Adam.Results."+"( " -- Ex : cd [ Enter ] (Change current dir to $HOME directory --")); --Result.Count := Result.Count + 5; -- when Logout => -- Buffer(1) := (+( "Command help : logout")); -- Buffer(1) := (+( " -- Quit the program --")); -- when Pwd => -- Buffer(1) := (+( "Command help : pwd")); -- Buffer(1) := (+( " -- Return the current working directory --")); when Help => null; when others => null; end case; end loop; else case Cmd is when None => Buffer(1) := (Adam.Results."+"("Command help : help COMMAND")); Buffer(2) := (Adam.Results."+"(" -- help ? print command help for ? --")); --Result.Count := Result.Count + 2; -- when Clear => -- Buffer(1) := (Adam.Results."+"( "Command help : clear")); -- Buffer(1) := (Adam.Results."+"( " -- Erase the shell file named ""$HOME/.buffer.txt"" --")); --Result.Count := Result.Count + 2; when Alias => Buffer(1) := (Adam.Results."+"( "Command help : alias")); Buffer(2) := (Adam.Results."+"( " -- Create an alias to any command --")); Buffer(3) := (Adam.Results."+"( " -- Ex : alias name=value --")); --Result.Count := Result.Count + 3; when Unalias => Buffer(1) := (Adam.Results."+"( "Command help : unalias")); Buffer(2) := (Adam.Results."+"( " -- Delete an alias --")); Buffer(3) := (Adam.Results."+"( " -- Ex : unalias name --")); --Result.Count := Result.Count + 3; when Cd => Buffer(1) := (Adam.Results."+"( "Command help : cd")); Buffer(2) := (Adam.Results."+"( " -- Change current working directory --")); Buffer(3) := (Adam.Results."+"( " -- Ex : cd Documents [ Enter ] --")); Buffer(4) := (Adam.Results."+"( " -- Ex : cd - [ Enter ] (Change current dir to OLD_PWD --")); Buffer(5) := (Adam.Results."+"( " -- Ex : cd [ Enter ] (Change current dir to $HOME directory --")); --Result.Count := Result.Count + 5; -- when Logout => -- Buffer(1) := (+( "Command help : logout")); -- Buffer(1) := (+( " -- Quit the program --")); -- when Pwd => -- Buffer(1) := (+( "Command help : pwd")); -- Buffer(1) := (+( " -- Return the current working directory --")); when Help => null; when others => null; end case; end if; Result.File_content := Buffer; end Internal_Help; On_Esc : Boolean := False; Current_Mode : Command_Type := Gnushell; File_Index : natural := 0; Line_Index : Natural := 0; GnuShell_Prompt_Line : Positive := 1; Line : M.Strings.Wide_String_Access := new Wide_String ' (""); buffer : M.Strings.Wide_String_Access := new Wide_String ' (""); Chars_Max : constant Positive := Term_Width-7; Lines_Max : constant Positive := Command_Max_Lines-2; Line_Count : Natural := 0; Done : Boolean := True; Args_Index : Natural := 0; Arguments : Wide_Access; Var_Set : Attributs(2048); Alias_Set : Attributs(2048); Is_Internal_Cmd : Boolean := True; Success : Boolean := False; xls_index : Natural := 0; Total : Natural := 0; Old_Text : Wide_Access; begin Alias_Set.List(1) := Make("ls", "ls -C -p --color -w " & Integer'Image(Columns-4)); Alias_Set.Index := 1; Alias_Set.List(2) := Make("clear", "rm -f " & OS_Lib.Getenv("HOME").all & "/.buffer.txt"); Alias_Set.Index := 2; Main_Loop: loop loop select accept Receive (Wchar : in Wide_Character) do case WChar is when Wide_Character'Val(127) => if Line /= null and then Line'Length > 0 then Buffer := new Wide_String ' (Line(Line'First..Line'Last-1)); Wide_Free(Line); Line := new Wide_String ' (Buffer.all); Wide_Free(Buffer); end if; when Wide_Character'Val(10) => declare Echo_Error : Integer := 0; begin if Line /= null then if Line'Length > 0 and Wide_Fixed.Index_Non_Blank(Line.all) /= 0 then Current_Command := Values.Sub_Value(Adam.None, Handling.To_String(Line.all)); else Line := new Wide_String ' ("sh -c ""echo Hello World!"""); end if; case Current_command is when Help => Internal_Help(Line.all, Shell_Interface.Spawn_Result); --New_Line; Print_Buffer(Result, 0); when none => Is_Internal_Cmd := False; when Alias => Alias(Handling.To_String(Line.all), Alias_Set); when Unalias => Unalias(Handling.To_String(Line.all), Alias_Set); when Cd => begin M.Tools.Change_Directory(Handling.To_String(Line.all), Old_Pwd); exception when Directory_Error => Text_Io.Put("Directory not found"); Text_Io.New_Line; end; when Set => Set(Handling.To_String(Line.all), Var_Set); when Unset => Unset(Handling.To_String(Line.all), Var_Set); when Put => Args_Index := Index(Handling.To_String(Line.all), " "); if Args_Index /= 0 then Arguments := new Wide_String ' (Line(Args_Index+1..Line'Length)); Put(Handling.To_String(Arguments.all), Var_Set); end if; Text_Io.New_Line; when Put_Line => Args_Index := Index(Handling.To_String(Line.all), " "); if Args_Index /= 0 then Arguments := new Wide_String ' (Line(Args_Index+1..Line'length)); Put_Line(Handling.To_String(Arguments.all), Var_Set); end if; -- when Xls => -- Xls_Index := 0; -- Internal.xls(Handling.To_String(Line.all), App.Cmd_Result.Win, Xls_Index, Total, False); -- Total := 0; -- Wide_Free(Old_Text); -- Old_Text := new Wide_String ' (Line.all); end case; --Last_Cmd := Internal_Cmd; --Line_Cur := Line_Cur + 1; if not Is_Internal_Cmd then --New_Line; declare Alias_Ptr : Os_Lib.String_Access; Buffer : Os_Lib.String_Access; Normal : Os_Lib.String_Access; begin for Iter in 1..Alias_Set.Index loop declare Alias : constant Attribut_Record := Alias_Set.List(Iter); First_Space : Natural := Index(Handling.To_String(Line.all), " "); Non_Blank : constant Natural := Index_Non_Blank(Handling.To_String(Line.all), Backward); begin if Non_Blank < First_Space then First_Space := 0; end if; if First_Space /= 0 then if Names(Alias) = Handling.To_String(Line(Line'First..First_Space - 1)) then Alias_Ptr := new String ' (Images(Alias)); exit; end if; else if Names(Alias) = Handling.To_String(Line(Line'First..Index_Non_Blank(Handling.To_String(Line.all), Backward))) then Alias_Ptr := new String ' (Images(Alias)); exit; end if; end if; end; end loop; if Alias_Ptr /= null then declare First_Space : constant Natural := Index(Handling.To_String(Line.all), " "); begin if First_Space /= 0 then Buffer := new String ' (Alias_Ptr.all & ' ' & Handling.To_String(Line(First_Space+1..Line ' Last))); else Buffer := new String ' (Alias_Ptr.all); end if; end; Wide_Free(Line); Normal := new String ' (M.Tools.Normalize_Quoted_Argument(Buffer.all)); Line := new Wide_String ' (Handling.To_Wide_String(Normal.all)); end if; end; Gnushell_command(W3, Shell_Interface, "sh -c """ & (Handling.To_Wide_String(M.Tools.Normalize_Quoted_Argument(Handling.To_String(Line.all)))) & """", Echo_Error); --Ansi.Console.Clear_screen; if Echo_Error = 0 then if Shell_Interface.Spawn_Result.Args /= null then for Arg in Shell_Interface.Spawn_Result.Args'Range loop Free(Shell_Interface.Spawn_Result.Args(Arg)); end loop; end if; end if; if Shell_Interface.Spawn_Result.File_content'Length > Result_Max_Lines-4 then File_Index := (Shell_Interface.Spawn_Result.File_content'Length-((Result_Max_Lines-4)-Line'Length/Chars_Max) + 1); else File_Index := 0; end if; Line_Index := 0; end if; -- Line := new Wide_String ' ("sh -c ""echo Hello World : """); -- Gnushell_command(W3, Shell_Interface, Line.all, errno); -- Ansi.Console.Clear_screen;  -- if Errno = 0 then -- if Shell_Interface.Spawn_Result.Args /= null then -- for Arg in Shell_Interface.Spawn_Result.Args'Range loop -- Free(Shell_Interface.Spawn_Result.Args(Arg)); -- end loop; -- end if; -- end if;  if Echo_Error = 0 then Wide_Free(Line); Line := new Wide_String ' (""); end if; Is_Internal_Cmd := True; end if; end; when Wide_Character'Val(12) => Wide_Free(line); Line := new Wide_String ' (""); when Wide_Character'Val(20) => Ansi.Console.Clear_screen; Current_Mode := Null_Item; when others => if Is_Control(To_Character(WChar)) then null; else case Current_Mode is when others => if Line /= null then if Line'Length < (columns-10)*(Lines_Max-3) then Buffer := new Wide_String ' (Line.all & WChar); Wide_Free(Line); Line := new Wide_String ' (Buffer.all); Wide_Free(Buffer); end if; else Line := new Wide_String ' ("" & WChar); end if; end case; end if; end case; end Receive; case Current_Mode is when Gnushell => Mode_Initialization(W10, Current_Mode, On_Esc, Message => ""); Command_Info_Status(W11, Shell_Interface); when others => null; end case; or accept Halt do null; end Halt; exit Main_loop; or accept Wake_Up(Top : in Natural) do W_Io.Put_Line("World"); end Wake_Up; or accept Suspend; exit; or accept Page_Down do if File_Index+(Result_Max_Lines-1) < Shell_Interface.Spawn_Result.File_Content'Length then File_Index := Positive'Min(File_Index+(Result_Max_Lines-1), Shell_Interface.Spawn_Result.File_Content'Length ); end if; end Page_Down; Mode_Initialization(W10, Current_Mode, On_Esc, Message => ""); Command_Info_Status(W11, Shell_Interface); or accept Page_Up do if File_Index > (Result_Max_Lines-1) then File_Index := File_Index - (Result_Max_Lines-1); else File_Index := 0; end if; end Page_Up; Mode_Initialization(W10, Current_Mode, On_Esc, Message => ""); Command_Info_Status(W11, Shell_Interface); or accept Up_Arrow do if File_Index > 0 then File_Index := File_Index - 1; end if; end Up_Arrow; Mode_Initialization(W10, Current_Mode, On_Esc, Message => ""); Command_Info_Status(W11, Shell_Interface); or accept Down_Arrow do if File_Index + 1 < Shell_Interface.Spawn_Result.File_Content'Length then File_Index := Positive'Min(File_Index+1, Shell_Interface.Spawn_Result.File_Content'Length ); end if; end Down_Arrow; Mode_Initialization(W10, Current_Mode, On_Esc, Message => ""); Command_Info_Status(W11, Shell_Interface); or accept Left_Arrow; or accept Right_Arrow; or accept Begin_Of; or accept End_Of; or accept Del; or accept Overwrite; end select; --Command_Info_Status(W11, Shell_Interface); Line_Count := 0; ---------------------------------------- -- Printing GnuShell Spawn buffer. if Shell_Interface.Spawn_Result.File_Content /= null then GnuShell_Loop: for I in File_Index+1..Positive'min(File_Index+((Result_Max_Lines-2)), Shell_Interface.Spawn_Result.File_Content'Length) loop declare tmp : constant Wide_String := (Adam.Results."-"(Shell_Interface.Spawn_Result.File_Content(I))); Line : constant Wide_String := Tmp(Tmp'First..Wide_Fixed.Index_Non_Blank((Tmp), Backward)); Chars_Max : constant Positive := Term_Width-5; Lines_Max : constant Positive := (Result_Max_Lines-2); begin if Real_Length(Line) > 0 and Real_Length(Line) < (Chars_Max * Lines_Max) then for Line_Window in Line_Index..Integer'min(Real_Length((Line))/Chars_Max, Lines_Max) loop declare B_Inf : constant Positive := Line_Window*Chars_Max + 1; B_Sup : constant Positive := Integer'min((Line_Window + 1)*Chars_Max, Real_Length((Line))); begin if Real_length((Line)) < Chars_max then Ansi_Windows.Draw (W10, Line_Count + 1, 2, M.Ansi.Console.White, (Line)); else Ansi_Windows.Draw (W10, Line_count + 1, 2, M.Ansi.Console.White, (Line(B_inf..B_sup)) ); end if; end; Line_Count := Line_Count + 1; exit GnuShell_Loop When Line_Count > (Result_Max_lines - 6 - Integer'min(Real_Length(Line)/Chars_Max, Lines_Max)); end loop; else Line_Count := Line_Count + 1; end if; exit GnuShell_Loop when Line_Count > (Result_Max_lines - 6 - Integer'min(Real_Length(Line)/Chars_Max, Lines_Max)); end; end loop GnuShell_Loop; end if; --Move_Cursor_To(W10, 1, 2); ------------------------------------------- -- Printing the user command line. -- if Shell_Interface.Spawn_Result.File_Content /= null then GnuShell_Prompt_Line := Integer'Min (Line_Count + 1, (Command_Max_Lines - 5))+1; end if; if Line /= null then declare Command_Line : constant Wide_String := Line.all; Local_Line_Count : Natural := 0; Total_Lines_Of_Command : constant Natural := Real_Length(Command_Line)/Chars_Max; begin if Real_Length(Command_Line) > 0 then for Line_Window in 0..Integer'min(Real_Length(Command_Line)/Chars_Max, Lines_Max) loop if Local_Line_Count + (Local_Line_Count+Line_Window+2) >= (Command_Max_Lines - 4) then GnuShell_Prompt_Line := (Command_Max_Lines - Total_Lines_Of_Command) - (Local_Line_Count + 4); end if; declare B_Inf : constant Positive := Line_Window*Chars_Max+1; B_Sup : constant Positive := Integer'min((Line_Window+1)*Chars_max, Command_Line'last); begin if Command_Line'last <= Chars_Max then Ansi_Windows.Draw (W2, GnuShell_Prompt_Line, 2, M.Ansi.Console.White, "# " & (Command_Line)); Ansi_Windows.Move_Cursor_To(W2, GnuShell_Prompt_Line, Command_Line'Last+4); elsif Line_Window = 0 then Ansi_Windows.Draw (W2, GnuShell_Prompt_Line, 2, M.Ansi.Console.White, "# " & (Command_Line(B_inf..B_sup)) ); Ansi_Windows.Move_Cursor_To(W2, GnuShell_Prompt_Line, B_Sup+4); Local_Line_Count := Local_Line_Count + 1; else Ansi_Windows.Draw (W2, GnuShell_Prompt_Line + (Line_Window) + 1 + (Local_Line_Count - 1), 2, M.Ansi.Console.White, (Command_Line(B_inf..B_sup)) ); Ansi_Windows.Move_Cursor_To(W2, GnuShell_Prompt_Line + (Line_Window) + 1 + (Local_Line_Count -1), (B_Sup-B_Inf)+3); Local_Line_Count := Local_Line_Count + 1; end if; end; exit when Local_Line_Count > (Lines_Max-1); end loop; else Ansi_Windows.Draw (W2, GnuShell_Prompt_Line, 2, M.Ansi.Console.White, "# "); Ansi_Windows.Move_Cursor_To(W2, GnuShell_Prompt_Line, 4); end if; end; else Ansi_Windows.Draw (W2, GnuShell_Prompt_Line, 2, M.Ansi.Console.White, "# "); Ansi_Windows.Move_Cursor_To(W2, GnuShell_Prompt_Line, 4); end if; Mode_Info_Status(W1, Null_Item); end loop; loop select accept Halt; exit Main_Loop; or accept Suspend; or accept Wake_Up(Top : in Natural) do --W_Io.Put_Line("World"); --Text_Io.Put_Line("Greetings " & Getenv("USER").all & "!"); Mode_Initialization(W10, Current_Mode, On_Esc, Message => ""); Ansi_Windows.Draw (W2, GnuShell_Prompt_Line, 2, M.Ansi.Console.White, "# "); Ansi_Windows.Move_Cursor_To(W2, GnuShell_Prompt_Line, 4); end Wake_Up; exit; end select; end loop; end loop Main_Loop; --W_Io.Put_Line("Bank process halted"); end Shell_Process; subtype WOPR_Menu_Range is Positive range 1..13; type WOPR_Menu_List is array (WOPR_Menu_Range) of Os_Lib.String_Access; WOPR_Menu : WOPR_Menu_List := (new String ' ("Administration"), new String ' ("Add product"), new String ' ("Del product"), new String ' ("Set product"), new String ' ("Web search"), new String ' ("Web index"), new String ' ("Procuct server start"), new String ' ("Product server stop"), new String ' ("Upgrade version"), new String ' ("Make all"), new String ' ("Make clean"), new String ' ("Make arch"), new String ' ("Restart")); task type Web_Index_Type (Window : access Ansi_Windows.Window_Type; Search_Result : access Search_Result_Record; Pattern : access Wide_String; Errno : access Integer) is entry Id(T_Id : out Task_Id); entry Send(Result : out Search_Result_Record); entry Suspend; entry Start; entry Halt; end Web_Index_Type; task body Web_Index_Type is End_Of_Task, Done, Suspended : Boolean := False; Current_Address : OS_Lib.String_Access := new String ' ("localhost"); Current_Path : OS_Lib.String_Access := new String ' (""); Buffer_Path : OS_Lib.String_Access := new String ' (""); protocol : OS_Lib.String_Access := new String ' ("http://"); Current_Document_Name : Wide_String_Access := new Wide_String ' (""); Regular_Exp : Regexp.Regexp; Sub_Regular_Exp : Regexp.Regexp; -- HTTP 1.1. Code : Code_Type; Timeouts : Duration := 10.0; IP_Address : Sockets.Inet_Addr_Type; Sub_Top : Natural := Pattern'First; Sub_Index : Natural := Wide_Fixed.Index(Pattern.all, "*", Sub_Top + 1); File_set : Wide_set(4096); file_last : natural := 0; web_file : w_io.file_type; Matched_Error : Regexp.Regexp := Regexp.Compile(Handling.To_String("*CONNECTION_ERROR*"), True, True); begin accept Id(T_Id : out Task_Id) do T_Id := Current_Task; end Id; First_Loop : loop begin declare Host_Entry : constant Sockets.Host_Entry_Type := Sockets.Get_Host_By_Name(Current_Address.all); begin Regular_Exp := Regexp.Compile(Handling.To_String(Pattern.all), True, True); Wide_Free(Search_Result.Pattern); Search_Result.Pattern := new Wide_String ' ((Pattern.all)); IP_Address := Sockets.Addresses(Host_Entry); Sub_Regular_Exp := Regexp.Compile(Handling.To_String(Pattern(Sub_Top..Sub_Index)), True, True); Web.Web_Search(Current_Address.all, Protocol.all & Gnat.Sockets.Image(Ip_Address) & Current_Path.All, Timeouts, Search_Result.all); Os_Lib.Free(Search_Result.Address); Search_Result.Address := new String ' (Protocol.all & Current_Address.all & Current_Path.all); Wide_Free(Current_Document_Name); Current_Document_Name := new Wide_String ' (Search_Result.Doc_Name.all); --Ansi_Windows.Draw_Window (Window.all); --Ansi_Windows.Draw (Window.all, 1, 2, White, "Searching for : " & (Pattern.all)); --Ansi_Windows.Draw (Window.all, 2, 2, White, "look at : " &  -- Handling.To_Wide_String(Search_Result.Address.all)); -- Ansi_Windows.Draw (Window.all, 3, 2, White, "Document name : " & (Current_Document_Name.all)); for Line_Index in Search_Result.Wlines'Range loop declare Line : constant String := Handling.To_String(-Search_Result.Wlines(Line_Index)); begin if Regexp.Match(Line, Regular_Exp) then Ada.Text_Io.Put(Character'Val(7)); Errno.all := 0; Done := True; exit First_Loop; elsif Regexp.Match(Line, Sub_Regular_Exp) then Ada.Text_Io.Put(Character'Val(7)); Errno.all := 0; Wide_Free(Search_Result.Pattern); Search_Result.Pattern := new Wide_String ' (Pattern(Sub_Top..Sub_Index)); Done := True; declare Top_Href : constant Natural := Fixed.Index(Line, "href=") + 6; Href_Index : constant Natural := Fixed.Index(Line, """", Top_Href+1) - 1; Protocol_Index : constant Natural := Fixed.Index(Line, "http", Top_Href); begin if Top_Href > 6 then if Protocol_Index /= 0 then Os_Lib.Free(protocol); Protocol := new String ' (Line(Protocol_Index..Fixed.Index(Line, ":", Protocol_Index)) & "//"); declare Top_Domain : constant Natural := Fixed.Index(Line, "//", Protocol_Index + 1) + 2; Domain_Index : constant Natural := Fixed.Index(Line, "/", Top_domain + 1) - 1; begin if Top_Domain > 2 and then (Domain_Index > 0 and Domain_Index <= Href_Index) then Os_Lib.Free(Current_Address); Current_Address := new String ' (Line(Top_Domain .. Domain_Index)); if Domain_Index + 1 < Href_Index then Os_Lib.Free(Current_Path); Current_Path := new String ' (Line(Domain_Index + 1 .. Href_index)); end if; Done := False; elsif Top_Domain > 2 then Os_Lib.Free(Current_Address); Current_Address := new String ' (Line(Top_domain .. Href_index)); Os_Lib.Free(Current_Path); Current_Path := new String ' (""); Done := False; else Done := True; end if; exit First_Loop; end; else Os_Lib.Free(Buffer_Path); --Buffer_Path := new String ' (Current_Address.all); Buffer_Path := new String ' (Line(Top_Href..Href_Index)); --Buffer_Path := new String ' (Current_Path.all & '/' & Line(Top_Href..Href_Index)); --Buffer_Path := new String ' (Current_Path.all); --Buffer_Path := new String ' (Protocol.all & Line(Top_Href..Href_Index)); Os_Lib.Free(Current_Path); Current_Path := new String ' (Buffer_Path.all); Done := True; end if; exit; else Done := True; exit First_Loop; end if; end; end if; end; end loop; Sub_Top := Sub_Index; Sub_Index := Wide_Fixed.Index(Pattern.all, "*", Sub_Top + 1); if Sub_Index <= Sub_Top then Done := false; end if; exit when Sub_Index <= Sub_Top; exception when others => exit; end; exception when others => exit; end; end loop First_Loop; if done then load_file(file_set, "/var/www/html/repository/web_index.html", file_last); for i in reverse file_last-1..file_last loop file_set.lines(i+1) := new wide_string ' (file_set.lines(i).all); end loop; file_set.lines(file_last-1) := new wide_string ' ("" & handling.to_wide_string(Search_Result.address.all) & "
"); file_set.Line_last := file_set.Line_Last + 1; w_io.create(web_file, w_io.out_file, "/var/www/html/repository/web_index.html", Form => "WCEM=8"); for i in 1..file_set.line_last loop w_io.put_line(web_file, file_set.lines(i).all); end loop; w_io.close(web_file); set_free(file_set); done := false; file_last := 0; end if; Put(Ansi_Tty_Control.Clear_Screen); loop select accept Halt; End_Of_Task := True; or accept Start; Suspended := False; exit; or accept Send(Result : out Search_Result_Record) do Result := Search_Result.all; end Send; end select; end loop; Code_Random.Reset; Top_Level_Rand.Reset(Top_Level_Gen); Top_Loop : while not End_Of_Task loop begin Main_Search : while not Done loop protocol := new String ' ("https://"); Search_Result.Address := new String ' (Protocol.all & Current_Address.all & Current_Path.all); begin loop select accept Halt; End_Of_Task := True; exit Top_Loop; or accept Start; Suspended := False; exit; or accept Send(Result : out Search_Result_Record) do Put(Ansi_Tty_Control.Clear_Screen); Result := Search_Result.all; end Send; end select; end loop; loop select accept Halt; End_Of_Task := True; exit Top_Loop; or accept Start; Suspended := False; exit; or accept Send(Result : out Search_Result_Record) do Put(Ansi_Tty_Control.Clear_Screen); Result := Search_Result.all; end Send; end select; end loop; Second_Loop : loop begin Search_Result.Address := new String ' (Protocol.all & Current_Address.all & Current_Path.all); loop select accept Halt; End_Of_Task := True; exit Top_Loop; or accept Start; Suspended := False; exit; or accept Send(Result : out Search_Result_Record) do Result := Search_Result.all; end Send; end select; end loop; loop select accept Halt; End_Of_Task := True; exit Top_Loop; or accept Start; Suspended := False; exit; or accept Send(Result : out Search_Result_Record) do Result := Search_Result.all; end Send; end select; end loop; delay 0.05; declare Host_Entry : constant Sockets.Host_Entry_Type := Sockets.Get_Host_By_Name(Current_Address.all); begin Domain : for I in 1..Sockets.Addresses_Length(Host_Entry) loop begin IP_Address := Sockets.Addresses(Host_Entry, I); ------------------- -- Random timeouts : Timeouts := 10.0; U_Array_Free(Search_Result.Wlines); Web.Web_Search(Current_Address.all, Protocol.all & Gnat.Sockets.Image(Ip_Address) & Current_Path.all, Timeouts, Search_Result.all); OS_Lib.Free(Search_Result.Address); Wide_Free(Current_Document_Name); Search_Result.Address := new String ' (Protocol.all & Current_Address.all & Current_Path.all); Current_Document_Name := new Wide_String ' (Search_Result.Doc_Name.all); -- Put(Ansi_Tty_Control.Clear_Screen); -- Ansi_Windows.Draw_Window (Window.all); -- Ansi_Windows.Draw (Window.all, 1, 2, White, "Searching for : " & (Pattern.all)); -- Ansi_Windows.Draw (Window.all, 2, 2, White, "look at : " &  -- Handling.To_Wide_String(Search_Result.Address.all)); -- Ansi_Windows.Draw (Window.all, 3, 2, White, "Document name : " & (Current_Document_Name.all)); for Line_Index in Search_Result.Wlines'Range loop declare Line : constant String := Handling.To_String(Gnos.Results."-"(Search_Result.Wlines(Line_Index))); begin if Regexp.Match(Line, Matched_Error) then raise Aws.Client.Connection_Error; end if; end; end loop; for Line_Index in Search_Result.Wlines'Range loop declare Line : constant String := Handling.To_String(-Search_Result.Wlines(Line_Index)); begin if Regexp.Match(Line, Regular_Exp) then Ada.Text_Io.Put(Character'Val(7)); Errno.all := 0; Done := True; ----------------------------- -- -- load_file(file_set, "/var/www/html/repository/web_index.html", file_last); if File_Last > 0 then for i in reverse file_last-1..file_last loop file_set.lines(i+1) := new wide_string ' (file_set.lines(i).all); end loop; end if; file_set.lines(file_last-1) := new wide_string ' ("" & handling.to_wide_string(Search_Result.address.all) & "
"); file_set.Line_last := file_set.Line_Last + 1; w_io.create(web_file, w_io.out_file, "/var/www/html/repository/web_index.html", Form => "WCEM=8"); for i in 1..file_set.line_last loop w_io.put_line(web_file, file_set.lines(i).all); end loop; w_io.close(web_file); set_free(file_set); done := false; file_last := 0; -- -- ----------------------------- exit domain; elsif Regexp.Match(Line, Sub_Regular_Exp) then Ada.Text_Io.Put(Character'Val(7)); Errno.all := 0; Done := True; ----------------------------- -- -- load_file(file_set, "/var/www/html/repository/web_index.html", file_last); if File_Last > 0 then for i in reverse file_last-1..file_last loop file_set.lines(i+1) := new wide_string ' (file_set.lines(i).all); end loop; end if; file_set.lines(file_last-1) := new wide_string ' ("" & handling.to_wide_string(Search_Result.address.all) & "
"); file_set.Line_last := file_set.Line_Last + 1; w_io.create(web_file, w_io.out_file, "/var/www/html/repository/web_index.html", Form => "WCEM=8"); for i in 1..file_set.line_last loop w_io.put_line(web_file, file_set.lines(i).all); end loop; w_io.close(web_file); set_free(file_set); done := false; file_last := 0; -- -- ----------------------------- Wide_Free(Search_Result.Pattern); Search_Result.Pattern := new Wide_String ' (Pattern(Sub_Top..Sub_Index)); declare Top_Href : constant Natural := Fixed.Index(Line, "href=") + 6; Href_Index : constant Natural := Fixed.Index(Line, """", Top_Href + 1) - 1; Protocol_Index : constant Natural := Fixed.Index(Line, "http", Top_Href); begin if Top_Href > 6 then if Protocol_Index /= 0 then Os_Lib.Free(protocol); Protocol := new String ' (Line(Protocol_Index..Fixed.Index(Line, ":", Protocol_Index)) & "//"); declare Top_Domain : constant Natural := Fixed.Index(Line, "//", Protocol_Index + 1) + 2; Domain_Index : constant Natural := Fixed.Index(Line, "/", Top_domain + 1) - 1; begin if Top_Domain > 2 and then (Domain_Index > 0 and Domain_Index <= Href_Index) then Os_Lib.Free(Current_Address); Current_Address := new String ' (Line(Top_Domain .. Domain_Index)); if Domain_Index + 1 < Href_Index then Os_Lib.Free(Current_Path); Current_Path := new String ' (Line(Domain_Index + 1 .. Href_index)); end if; Done := False; elsif Top_Domain > 2 then Os_Lib.Free(Current_Address); Current_Address := new String ' (Line(Top_domain .. Href_index)); Os_Lib.Free(Current_Path); Current_Path := new String ' (""); Done := False; else Done := false; -- Sub_Top := Sub_Index; -- Sub_Index := Wide_Fixed.Index(Pattern.all, "*", Sub_Top + 1);  -- exit when Sub_Index <= Sub_Top; exit Second_Loop; end if; end; else Os_Lib.Free(Buffer_Path); --Buffer_Path := new String ' (Current_Address.all); Buffer_Path := new String ' (Line(Top_Href..Href_Index)); --Buffer_Path := new String ' (Current_Path.all & '/' & Line(Top_Href..Href_Index)); --Buffer_Path := new String ' (Current_Path.all); --Buffer_Path := new String ' (Protocol.all & Line(Top_Href..Href_Index)); Os_Lib.Free(Current_Path); Current_Path := new String ' (Buffer_Path.all); Done := True; end if; -- Sub_Top := Sub_Index; -- Sub_Index := Wide_Fixed.Index(Pattern.all, "*", Sub_Top + 1);  -- exit when Sub_Index <= Sub_Top; exit domain; else Done := True; loop select accept Halt; End_Of_Task := True; or accept Start; Suspended := False; exit; or accept Send(Result : out Search_Result_Record) do Result := Search_Result.all; end Send; or delay 0.05; end select; end loop; -- Sub_Top := Sub_Index; -- Sub_Index := Wide_Fixed.Index(Pattern.all, "*", Sub_Top + 1);  -- exit when Sub_Index <= Sub_Top; exit Second_loop; end if; end; end if; end; end loop; loop select accept Halt; exit Top_Loop; or accept Suspend; Suspended := True; --Ansi_Windows.Clear_Screen; exit Second_loop; or accept Start; Suspended := False; exit; or accept Send(Result : out Search_Result_Record) do Result := Search_Result.all; end Send; or delay 0.05; end select; end loop; exception when Aws.Client.Connection_Error => protocol := new String ' ("http://"); Search_Result.Address := new String ' (Protocol.all & Current_Address.all & Current_Path.all); exit; when Aws.Client.Protocol_Error => null; when others => null; end; end loop Domain; loop select accept Suspend; or accept Start; exit; or accept Halt; exit Main_Search; or accept Send(Result : out Search_Result_Record) do Put(Ansi_Tty_Control.Clear_Screen); Result := Search_Result.all; end Send; or delay 0.05; end select; end loop; select accept Halt; exit Top_Loop; or accept Suspend; --Ansi_Windows.Clear_Screen; Suspended := True; or accept Send(Result : out Search_Result_Record) do Put(Ansi_Tty_Control.Clear_Screen); Result := Search_Result.all; end Send; or delay 0.05; end select; exception when others => exit; end; Sub_Top := Sub_Index; Sub_Index := Wide_Fixed.Index(Pattern.all, "*", Sub_Top + 1); delay 0.05; exit when Sub_Index <= Sub_Top; if Done then exit; end if; exception when others => exit; end; end loop Second_Loop; loop select accept Suspend; or accept Start; exit; or accept Halt; exit Top_Loop; or accept Send(Result : out Search_Result_Record) do Result := Search_Result.all; end Send; or delay 0.05; end select; end loop; exception when Sockets.Host_Error => select accept Halt; exit Top_Loop; or accept Suspend; Suspended := True; or delay 0.05; end select; when others => select accept Halt; exit Top_Loop; or accept Suspend; Suspended := True; or delay 0.05; end select; end; if done then load_file(file_set, "/var/www/html/repository/web_index.html", file_last); for i in reverse file_last-1..file_last loop file_set.lines(i+1) := new wide_string ' (file_set.lines(i).all); end loop; file_set.lines(file_last-1) := new wide_string ' ("" & handling.to_wide_string(Search_Result.address.all) & "
"); file_set.Line_last := file_set.Line_Last + 1; w_io.create(web_file, w_io.out_file, "/var/www/html/repository/web_index.html", Form => "WCEM=8"); for i in 1..file_set.line_last loop w_io.put_line(web_file, file_set.lines(i).all); end loop; w_io.close(web_file); set_free(file_set); done := false; file_last := 0; end if; --Code.Prefix := Strings.Unbounded.To_Unbounded_String(Random(Seg_Rand.Random(Seg_Gen))); Code.Radix := Ada.Strings.Unbounded.To_Unbounded_String(Random(Seg_Rand.Random(Seg_Gen))); Code.suffix := Ada.Strings.Unbounded.To_Unbounded_String(Handling.To_Lower(Top_Level_Type'Image(Top_Level_Rand.Random(Top_Level_Gen)))); OS_Lib.Free(Current_Address); Current_Address := new String ' ("www." & --Strings.Unbounded.To_String(Code.Prefix) & '-' & Ada.Strings.Unbounded.To_String(Code.Radix) & '.' & Ada.Strings.Unbounded.To_String(Code.Suffix)); Os_Lib.Free(Current_Path); Current_Path := new String ' (""); Sub_Top := Pattern'First; Sub_Index := Wide_Fixed.Index(Pattern.all, "*", Sub_Top + 1); protocol := new String ' ("https://"); end loop Main_Search; -- exit; exception when others => null; end; Done := False; --Code.Prefix := Strings.Unbounded.To_Unbounded_String(Random(Seg_Rand.Random(Seg_Gen))); Code.Radix := Ada.Strings.Unbounded.To_Unbounded_String(Random(Seg_Rand.Random(Seg_Gen))); Code.suffix := Ada.Strings.Unbounded.To_Unbounded_String(Handling.To_Lower(Top_Level_Type'Image(Top_Level_Rand.Random(Top_Level_Gen)))); OS_Lib.Free(Current_Address); Current_Address := new String ' ("www." & --Strings.Unbounded.To_String(Code.Prefix) & '-' & Ada.Strings.Unbounded.To_String(Code.Radix) & '.' & Ada.Strings.Unbounded.To_String(Code.Suffix)); Os_Lib.Free(Current_Path); Current_Path := new String ' (""); Sub_Top := Pattern'First; Sub_Index := Wide_Fixed.Index(Pattern.all, "*", Sub_Top + 1); protocol := new String ' ("https://"); end loop Top_loop; exception when Sockets.Socket_Error => Errno.all := 128; loop select accept Suspend; or accept Start; or accept Halt; exit; or delay 0.05; Ansi_Windows.Draw_Window (Window.all); Ansi_Windows.Draw (Window.all, 1, 2, White, "Socket error"); end select; end loop; when Sockets.Host_Error => Errno.all := 128; loop select accept Suspend; or accept Start; or accept Halt; exit; or delay 0.05; Ansi_Windows.Draw_Window (Window.all); Ansi_Windows.Draw (Window.all, 1, 2, White, Handling.To_Wide_String("Host error~ :" & Current_Address.all)); end select; end loop; when others => Errno.all := 128; loop select accept Suspend; or accept Start; or accept Halt; exit; or delay 0.05; Ansi_Windows.Draw_Window (Window.all); Ansi_Windows.Draw (Window.all, 1, 2, White, "Others error"); end select; end loop; end Web_Index_Type; -- Account line type -- -- Line_Num : Account_Line_Range := 0; -- Date : Time := Clock; -- Elaps : Time := Clock; -- Description : Wstring_32 := (others => ' '); -- Account_num : Account_Num_Range := 10; -- Unit_Ht_Price : Fixed_Unit_Ht := 0.0;  -- TVA_Rate : Fixed_Factor := 0.0; -- Quantity : Quantity_Range := 0.0; -- Total_Ht : Fixed_Total := 0.0; -- Total_TVA : Fixed_Total := 0.0; -- Total_Ttc : Fixed_Total := 0.0; -- Delays : Payment_Delay := 0; -- Peer_name : Wstring_32 := (others => ' ');  -- Abstract Voice -- Accounting : Account_Line_Array(1..Lines_Max) := (others => Null_Line);  -- Line_Last : Account_Line_Range := 0; -- Account_Num : Account_Num_Range := 10; -- Voice_Num : Voice_Num_Range := 0; -- Total_Ht : Fixed_Total := 0.0; -- Total_TVA : Fixed_Total := 0.0; -- Total_TTC : Fixed_Total := 0.0; -- Peer_Name : Wstring_32 := (others => ' '); -- Date : Time := Time_Of(1970, 1, 1, 0.0); -- Line_Count : Account_Line_Range := 0; -- task body WOPR_Process is -- Web_Id : Task_Id; -- Term_Width : constant Positive := App.Columns - 2; -- Result_Max_Lines : constant Positive := App.Lines - (7 + 9); -- File_Index : natural := 0;  -- Line_Index : Natural := 0; -- On_Esc : Boolean := False; -- Line_Count : Natural := 0; -- Current_Command : Command_Type := Search; -- Previsious_Mode : Command_Type := Search; -- Current_Mode : Command_Type := Search;  -- Chars_Max : constant Positive := Term_Width-10; -- Errno : Integer := 0; -- W3 : constant Ansi_Windows.Window_Type := ( -- Quit (exit program) window information. -- L => Lines-5, -- C => 2, -- H => 3, -- W => Term_Width, -- Frame_Type => Ansi_Windows.Single_Line_Frame, -- Frame_Color => Yellow, -- Close_Box_Color => Red); -- W4 : constant Ansi_Windows.Window_Type := ( -- Status message Window. -- L => 4, -- C => 2, -- H => 7, -- W => Term_Width, -- Frame_Type => Ansi_Windows.Single_Line_Frame, -- Frame_Color => Yellow, -- Close_Box_Color => Red); -- W6 : constant Ansi_Windows.Window_Type := ( -- Search window -- L => 4, -- C => 2, -- H => 5, -- W => Term_Width, -- Frame_Type => Ansi_Windows.Single_Line_Frame, -- Frame_Color => Yellow, -- Close_Box_Color => Red); -- W7 : constant Ansi_Windows.Window_Type := ( -- Search result info Window -- L => 4, -- C => 2, -- H => 5, -- W => Term_Width, -- Frame_Type => Ansi_Windows.Single_Line_Frame, -- Frame_Color => Yellow, -- Close_Box_Color => Red); -- W10 : constant Ansi_Windows.Window_Type := ( -- Command result : out_file.txt. -- L => 9, -- C => 2, -- H => Result_Max_Lines+2, -- W => Term_Width, -- Frame_Type => Ansi_Windows.Single_Line_Frame, -- Frame_Color => Yellow, -- Close_Box_Color => Red); -- Web_Search : access Web_Search_Type; -- Web_Index : access Web_Index_Type; -- Done : Boolean := False; -- procedure Add_Product(Name : in String;Path : in String;Unit_HT : in Fixed_Unit_Ht;TVA_Rate : in Fixed_Factor; Total_TVA : in Fixed_Total;Unit_TTC : in Fixed_Unit_TTC) is -- File : W_Io.File_Type; -- Product : constant Product_Access := new Product_Class; -- begin -- W_Io.Open(File, W_Io.In_File, Path & '/' & "Abstract.txt", Form => "WCEM=8"); -- Product.Name := new String ' (Name); -- Product.Description := new Wide_String ' (W_Io.Get_Line(File)); -- W_Io.Close(File); -- Product.Documentation := new String ' (Name & ".html"); -- Product.Unit_Ht := Unit_Ht; -- Product.TVA_Rate := TVA_Rate; -- Product.TVA := Total_TVA; -- Product.Unit_TTC := Unit_TTC; -- Current_Game.Products(Current_Game.Count+1) := Product; -- Current_Game.Count := Current_Game.Count+1; -- end Add_Product; -- Payed : Boolean := False; -- procedure Add_Name(Path : in String;Rate : in float) is -- Price : Sai.Price_Type := 0.0; -- Curs : Projects_DLL.Cursor := Projects_Dll.First(App.Projects.List); -- Start : Projects_DLL.Cursor := Projects_Dll.First(App.Projects.List); -- Project : M.Project.Project_Access := Projects_Dll.First_Element(App.Projects.List); -- Line : Account_Line_Type; -- Version : M.Versions.Version_Type; -- invoice : invoice_Record; -- Done : Boolean := False; -- begin -- Text_Io.Put("Enter name : "); -- declare -- Name : constant String := Text_Io.Get_Line; -- begin -- Text_Io.Put("Version : "); -- Version := To_Version(Get_Line); -- Sai.Editting.Add(name); -- Project := Projects_Dll.Element(Curs); -- if Project.Project_Name.all /= name then -- Curs := Projects_DLL.Next(Curs); -- Project := Projects_Dll.Element(Curs); -- Curs := Projects_DLL.Next(Curs); -- for I in 2 .. Projects_Dll.length(App.Projects.list) - 1 loop -- Project := Projects_Dll.Element(Curs); -- if Project.Project_Name.all = name then -- Done := True; -- exit; -- end if; -- Curs := Projects_DLL.Next(Curs); -- end loop; -- if Done then -- Price := Sai.Price_Type(float(Float(Project.Elapsed / 3600.0) + (Float(Project.Days) * 24.0)) * Float(Rate)) / 1000.0; -- end if; -- else -- Price := Sai.Price_Type((Float(Project.Elapsed / 3600.0) + (Float(Project.Days) * 24.0)) * Float(Rate)) / 1000.0; -- Done := True; -- end if; -- if Done then -- line := -- (0, -- Clock, -- Clock, -- (others => Wide_Character'Val(32)), -- 10, -- Fixed_Unit_Ht(Price), -- 10.0, -- 1000.0, -- Fixed_Total(Price * 1000.0), -- Fixed_total(Fixed_total(Fixed_Total(Fixed_Total(Price) * 1000.0 ) /100.0) * 10.0), -- Fixed_total(Fixed_total(Fixed_Total((Price) * 1000.0) + Fixed_Total(Fixed_Total(Fixed_Total((Fixed_Total(Price) * 1000.0))/100.0) * 10.0))), -- 0, -- (others => Wide_Character'Val(32)) -- ); -- Wide_Fixed.Move(Handling.To_Wide_String(name), Line.Description); -- Wide_Fixed.Move("Manuel De Girardi", Line.Peer_Name); -- invoice := (256, -- (1 => Line, others => Null_Line), -- 1, -- 607,  -- invoice_num+1,  -- 0.0, -- Fixed_Total(Price) * 1000.0, -- 0.0, -- Fixed_Total(Fixed_Total(Fixed_total(Fixed_total(Price) * 1000.0)/100.0) * 10.0), -- 0.0, -- Fixed_Total(Fixed_Total(Fixed_total(Fixed_total(Price) * 1000.0)) + (Fixed_total(Fixed_total(Fixed_Total(Price) * 1000.0)/100.0) * 10.0)), -- Line.Peer_Name,  -- clock, -- 1 -- ); -- Text_Io.Put("Price is :" & Sai.Price_Type'Image(Price) & "$");  -- Text_Io.Put_Line("Set price...");  -- Add_Edit(Path, name, Price); -- billed(M.Balance.Balance, invoice, Payed); -- if Payed then -- Invoice.Date := Clock; -- Invoice.Account_Num := Invoice.Accounting(1).Account_Num; -- Invoice.voice_Num := M.Balance.Invoice_Num + 1; -- M.Balance.Invoice_Num := M.Balance.Invoice_Num + 1; -- if Save(Invoice, "billed.txt") then -- Add(Accounts, Invoice); -- for Iter in 1..Invoice.Line_Last loop -- declare -- Line : constant Account_Line_Type := Invoice.Accounting(Iter); -- begin -- if not Sky.Stocks_Manager.In_Stocks(Sky.Stocks_Manager.Hardware, Line.Description) then -- declare -- Stock : constant Stock_Record := (Sky.Stocks_Manager.Hard_Num + 1, Line.Description, Line.Quantity, Line.Unit_Ht_Price, Line.TVA_Rate); -- begin -- Sky.Stocks_Manager.Hard_Num :=  -- Sky.Stocks_Manager.Hard_Num + 1; -- Sky.Stocks_Manager.Stock_Add(Sky.Stocks_Manager.Hardware, Stock); -- end; -- else -- declare -- Stock : constant Stock_Record := (0, Line.Description, (Line.Quantity), Line.Unit_Ht_Price, Line.TVA_Rate); -- begin -- Sky.Stocks_Manager.Update_Stock(Sky.Stocks_Manager.Hardware, Stock); -- end; -- end if; -- end; -- end loop; -- end if; -- Add_Product(Name, Name & "-" & To_String(Version), Fixed_Unit_Ht(Price), 10.0, Fixed_Total((Fixed_Total(Price/100.0))*10.0), Fixed_Unit_Ttc(Fixed_Unit_Ttc(Price)+((Fixed_Unit_Ttc(Price/100.0))*10.0))); -- end if; -- end if; -- end; -- end Add_Name; -- procedure Delete_Name(Path : in String) is -- Id : Product_Id := Id_Count+4; -- begin -- loop -- begin -- for Id in 1..Id_Count loop -- Text_Io.Put_Line(Positive'Image((ID-1)+5) & ' ' & Sai.Editting.Name((Id-1)+5).all); -- end loop; -- Text_Io.New_Line; -- Text_Io.Put("Enter numb : "); -- Id := Product_id'Value(Get_Line); -- Del(Id); -- Del_Edit(Path, Id); -- exception -- when Text_Io.End_Error => -- exit; -- when others => -- null; -- end; -- end loop; -- end Delete_Name; -- Menu_Index : WOPR_Menu_Range := 1; -- Title : Line_Type := (others => Character'Val(32)); -- Item : Line_Type := (others => Character'Val(32)); -- Menu_Win : Window_Record := (1, 1, App.Lines, App.Columns/2, Blue, The_Window); -- type Action_List is array (Positive range 1..App.Lines-8) of Os_Lib.String_Access; -- Action_Last : natural := 0; -- Actions_Menu : Action_List := (1 => new String ' ("W. O. P. R. menu"), others => null); -- procedure Menu_Print(Win : in Window_Record; Selected : in WOPR_Menu_Range) is -- begin -- Draw_Window(Win); -- Fixed.Move("W. O. P. R. menu", Title, Error, Left); -- Draw_Text(Win, 3, App.Columns/4-8, White, Handling.To_Wide_String(Title)); -- for Iter in WOPR_Menu'Range loop -- Item := (others => Character'Val(32)); -- Fixed.Move(WOPR_Menu(Iter).all, Item, Error, Left); -- if Iter /= Selected then -- Draw_Text(Win, Iter*2+5, App.Columns/4-8, White, Handling.To_Wide_String(Item)); -- else -- Enlight_Draw_Text(Win, Iter*2+5, App.Columns/4-8, Cyan, Handling.To_Wide_String(Item)); -- Text_Io.Put(Normal_Mode); -- end if; -- end loop; -- end Menu_Print; -- procedure Actions_Print(Win : in Window_Record; Selected : in Positive) is -- begin -- Draw_Window(Win); -- Fixed.Move("Administration", Title, Error, Left); -- Draw_Text(Win, 3, App.Columns/4-8, White, Handling.To_Wide_String(Title)); -- for Iter in 1..Action_Last loop -- Item := (others => Character'Val(32)); -- Fixed.Move(Actions_Menu(Iter).all, Item, Error, Left); -- if Iter /= Selected then -- Draw_Text(Win, Iter*2+5, App.Columns/4-8, White, Handling.To_Wide_String(Item)); -- else -- Enlight_Draw_Text(Win, Iter*2+5, App.Columns/4-8, White, Handling.To_Wide_String(Item)); -- Text_Io.Put(Normal_Mode); -- end if; -- end loop; -- end Actions_Print; -- Line : M.Strings.Wide_String_Access := new Wide_String ' ("" & Wide_Character'Val(0)); -- Is_Actions : Boolean := False; -- Profile : Profile_Class; -- Rate : Float := 160.0; -- Motif : Wide_String(1..256) := (others => ' '); -- Motif_Last : Natural := 0; -- End_Of_Section : Boolean := False; -- Data_Available : Boolean := False; -- Search_Section : Boolean := False; -- begin -- Initialize(Menu_Win, 1, 1, App.Lines, App.Columns/2, Blue, White); -- if Length(App.Borg.Path) /= 0 then -- if Element(App.Borg.Path, 1).Definition.list(1).Name.all /= "Rate" then -- for I in Element(App.Borg.Path, 1).Definition.List'range loop -- begin -- if Element(App.Borg.Path, 1).Definition.list(1).Name.all /= "Rate" then -- case Element(App.Borg.Path, 1).Definition.list(1).enum is -- when Flt => -- Rate := Element(App.Borg.Path, 1).Definition.list(1).Flt; -- when others => -- null; -- end case; -- exit; -- end if; -- end; -- end loop; -- end if; -- end if; -- Sai.Editting.Init; -- Main_Loop: -- loop -- Search_Section := False; -- Menu_Loop : -- loop -- select -- when Search_Section and not Is_Actions => -- accept Receive(Wchar : in Wide_Character) do -- if Wchar = Wide_Character'Val(10) then -- Put_Line(App.Web_Result.Address.all); -- declare -- Success : Boolean; -- Args : Argument_List_Access := Argument_String_To_List(App.Web_Result.Address.all); -- begin -- Spawn(Locate_Exec_On_Path("lynx").all, Args.all, Success); -- end; -- Put_Line(Ansi_Tty_Control.Clear_Screen); -- if Web_Search /= null then -- abort Web_Search.All; -- Web_Search := null; -- end if; -- Action_Last := 1; -- Menu_Index := 5; -- Is_Actions := False; -- Menu_Print(Menu_Win, Menu_index); -- Done := False; -- End_Of_Section := True; -- elsif Wchar = Wide_Character'Val(127) then -- if Web_Search /= null then -- Web_Search.halt; -- end if; -- if Web_index /= null then -- Web_index.halt; -- end if; -- Put_Line(Ansi_Tty_Control.Clear_Screen); -- Action_Last := 1; -- Menu_Index := 5; -- Is_Actions := False; -- Menu_Print(Menu_Win, Menu_index); -- Done := False; -- End_Of_Section := True; -- elsif Wchar = Wide_Character'Val(18) then -- if Web_Search /= null then -- Web_Search.halt; -- end if; -- if Web_index /= null then -- Web_index.halt; -- end if; -- Put_Line(Ansi_Tty_Control.Clear_Screen); -- Action_Last := 1; -- Menu_Index := 1; -- Is_Actions := False; -- Menu_Print(Menu_Win, Menu_index); -- Done := False;  -- End_Of_Section := True; -- if Web_Search /= null then -- abort Web_Search.all; -- Web_Search := null; -- end if; -- if Web_Index /= null then -- abort Web_index.all; -- Web_index := null; -- end if; -- end if; -- end Receive; -- Search_Section := False; -- or -- when not Search_Section and not Is_Actions => -- accept Receive (Wchar : in Wide_Character) do -- begin -- if Is_Control(Wchar) then -- case Wchar is -- when Wide_Character'Val(10) => -- if Menu_Index = 1 then -- Actions_Print(Menu_Win, Menu_Index); -- Is_Actions := True; -- elsif Menu_Index = 11 then -- null; -- else -- case Menu_Index is -- when 2 => -- Add_Name("main-" & Versions.Version_Io.To_String(Versions.Version), rate); -- Menu_Print(Menu_Win, Menu_index); -- when 3 => -- null; -- Delete_Name("main-" & Versions.Version_Io.To_String(Versions.Version)); -- Menu_Print(Menu_Win, Menu_index); -- when 4 => -- null; -- when 5 => -- Put_Line(Ansi_Tty_Control.Clear_Screen); -- Text_Io.Put("Web search : "); -- if Web_Search /= null then -- Search_Section := True; -- Done := True; -- else -- W_Io.Get_Line(Motif, Motif_Last); -- Done := False; -- Wide_Free(Line); -- Line := new Wide_String ' (Motif(Wide_Fixed.Index_Non_Blank(Motif)..Wide_Fixed.Index_Non_Blank(Motif, Ada.Strings.Backward))); -- Motif := (others => ' '); -- Motif_Last := 0; -- if Wide_Fixed.Index((Line.all(Wide_Fixed.Index_Non_Blank((Line.all))..Line'Last)), " ") /= 0 and then -- Wide_Fixed.Index_Non_Blank((Line.all), Backward) /=  -- Wide_Fixed.Index((Line.all(Wide_Fixed.Index_Non_Blank((Line.all))..Line'Last)), " ") then -- declare -- Search_String : constant Wide_String :=  -- Line.all(Wide_Fixed.Index -- ((Line.all(Wide_Fixed.Index_Non_Blank -- ((Line.all))..Line'Last)), -- " ")+1..Wide_Fixed.Index_Non_Blank((Line.all), Backward)); -- begin -- if Search_String'Length /= 0 then  -- if Web_Search /= null then -- abort Web_Search.all; -- end if; -- Put(Ansi_Tty_Control.Clear_Screen); -- Mode_Info_Status(W1, Null_Item); -- Web_Search :=  -- new Web_Search_Type -- (new Ansi_Windows.Window_Type '(W6),  -- App.Web_Result'access,  -- new Wide_String ' (Search_String), new Integer ' (Errno)); -- Web_Search.Id(Web_Id); -- Data_Available := False; -- Previsious_mode := Current_Mode; -- Current_Mode := Current_Command; -- File_Index := 0; -- Line_Index := 0; -- Done := True; -- else -- if Web_Search /= null then -- Previsious_mode := Current_Mode; -- Current_Mode := Current_Command; -- Done := True; -- end if; -- end if; -- end; -- else -- if Web_Search /= null then -- Previsious_mode := Current_Mode; -- Current_Mode := Current_Command; -- Done := True; -- end if; -- end if; -- Search_Section := True; -- end if; -- Put_Line(Ansi_Tty_Control.Clear_Screen); -- when 6 => -- Put_Line(Ansi_Tty_Control.Clear_Screen); -- Text_Io.Put("Web index : "); -- if Web_Index /= null then -- Search_Section := True; -- Done := True; -- else -- W_Io.Get_Line(Motif, Motif_Last); -- Done := False; -- Wide_Free(Line); -- Line := new Wide_String ' (Motif(Wide_Fixed.Index_Non_Blank(Motif)..Wide_Fixed.Index_Non_Blank(Motif, Ada.Strings.Backward))); -- Motif := (others => ' '); -- Motif_Last := 0; -- if Wide_Fixed.Index((Line.all(Wide_Fixed.Index_Non_Blank((Line.all))..Line'Last)), " ") /= 0 and then -- Wide_Fixed.Index_Non_Blank((Line.all), Backward) /=  -- Wide_Fixed.Index((Line.all(Wide_Fixed.Index_Non_Blank((Line.all))..Line'Last)), " ") then -- declare -- Search_String : constant Wide_String :=  -- Line.all(Wide_Fixed.Index -- ((Line.all(Wide_Fixed.Index_Non_Blank -- ((Line.all))..Line'Last)), -- " ")+1..Wide_Fixed.Index_Non_Blank((Line.all), Backward)); -- begin -- if Search_String'Length /= 0 then  -- if Web_Index /= null then -- abort Web_Index.all; -- end if; -- Put(Ansi_Tty_Control.Clear_Screen); -- Mode_Info_Status(W1, Null_Item); -- Web_Index :=  -- new Web_Index_Type -- (new Ansi_Windows.Window_Type '(W6),  -- App.Web_Result'access,  -- new Wide_String ' (Search_String), new Integer ' (Errno)); -- Web_Index.Id(Web_Id); -- Data_Available := False; -- Previsious_mode := Current_Mode; -- Current_Mode := Current_Command; -- File_Index := 0; -- Line_Index := 0; -- Done := True; -- else -- if Web_Index /= null then -- Previsious_mode := Current_Mode; -- Current_Mode := Current_Command; -- Done := True; -- end if; -- end if; -- end; -- else -- if Web_Index /= null then -- Previsious_mode := Current_Mode; -- Current_Mode := Current_Command; -- Done := True; -- end if; -- end if; -- Search_Section := True; -- end if; -- Put_Line(Ansi_Tty_Control.Clear_Screen); -- -- Put_Line(Ansi_Tty_Control.Clear_Screen); -- -- Text_Io.Put("Web index : "); -- -- if Web_Index /= null then -- -- Search_Section := True; -- -- Done := True; -- -- else -- -- W_Io.Get_Line(Motif, Motif_Last); -- -- Done := False; -- -- Wide_Free(Line); -- -- Line := new Wide_String ' (Motif(Wide_Fixed.Index_Non_Blank(Motif)..Wide_Fixed.Index_Non_Blank(Motif, Ada.Strings.Backward))); -- -- Motif := (others => ' '); -- -- Motif_Last := 0; -- -- if Wide_Fixed.Index((Line.all(Wide_Fixed.Index_Non_Blank((Line.all))..Line'Last)), " ") /= 0 and then -- -- Wide_Fixed.Index_Non_Blank((Line.all), Backward) /=  -- -- Wide_Fixed.Index((Line.all(Wide_Fixed.Index_Non_Blank((Line.all))..Line'Last)), " ") then -- -- declare -- -- Search_String : constant Wide_String :=  -- -- Line.all(Wide_Fixed.Index -- -- ((Line.all(Wide_Fixed.Index_Non_Blank -- -- ((Line.all))..Line'Last)), -- -- " ")+1..Wide_Fixed.Index_Non_Blank((Line.all), Backward)); -- -- begin -- -- if Search_String'Length /= 0 then  -- -- if Web_Index /= null then -- -- abort Web_Index.all; -- -- end if; -- -- Put(Ansi_Tty_Control.Clear_Screen); -- -- Mode_Info_Status(W1, Null_Item); -- -- Web_Index :=  -- -- new Web_Index_Type -- -- (new Ansi_Windows.Window_Type '(W6),  -- -- Shell_Interface.Search_Result'access,  -- -- new Wide_String ' (Search_String), new Integer ' (Errno)); -- -- Web_Index.Id(Web_Id); -- -- Data_Available := False; -- -- Previsious_mode := Current_Mode; -- -- Current_Mode := Current_Command; -- -- File_Index := 0; -- -- Line_Index := 0; -- -- Done := True; -- -- else -- -- if Web_Index /= null then -- -- Previsious_mode := Current_Mode; -- -- Current_Mode := Current_Command; -- -- Done := True; -- -- end if; -- -- end if; -- -- end; -- -- else -- -- if Web_Index /= null then -- -- Previsious_mode := Current_Mode; -- -- Current_Mode := Current_Command; -- -- Done := True; -- -- end if; -- -- end if; -- -- Search_Section := True; -- -- end if; -- -- Put_Line(Ansi_Tty_Control.Clear_Screen); -- when 7 => -- if not App.Started then -- Servers.Server.Start; -- end if; -- App.Started := True; -- Free(WOPR_Menu(6)); -- Free(WOPR_Menu(7)); -- WOPR_Menu(6) := new String ' ("Procuct server started"); -- WOPR_Menu(7) := new String ' ("Procuct server stop"); -- Menu_Print(Menu_Win, Menu_index); -- when 8 => -- if App.Started then -- Servers.Server.Stop; -- end if; -- App.Started := False; -- Free(WOPR_Menu(6)); -- Free(WOPR_Menu(7)); -- WOPR_Menu(6) := new String ' ("Procuct server start"); -- WOPR_Menu(7) := new String ' ("Procuct server stopped"); -- Menu_Print(Menu_Win, Menu_index); -- when others => -- null; -- end case; -- end if; -- when others => -- null; -- end case;  -- end if; -- exception -- when End_Error => -- Put_Line(Ansi_Tty_Control.Clear_Screen); -- Action_Last := 1; -- Menu_Index := 1; -- Wide_Free(Line); -- Is_Actions := False; -- Done := False; -- Menu_Print(Menu_Win, Menu_index); -- when others => -- Menu_Print(Menu_Win, Menu_index); -- Errno := -1; -- end; -- end Receive; -- if Done then -- if Web_Search /= null then -- End_Of_Section := False; -- Web_Search.Start; -- elsif Web_Index /= null then -- End_Of_Section := False; -- Web_Index.Start; -- end if; -- else -- if Is_Actions then -- Actions_Print(Menu_Win, Menu_Index); -- else -- Menu_Print(Menu_Win, Menu_index); -- end if; -- end if; -- or -- when Is_Actions => -- accept Receive (Wchar : in Wide_Character) do -- if Is_Control(Wchar) then -- case Wchar is -- when Wide_Character'Val(10) => -- if Menu_Index = 1 then  -- Menu_Print(Menu_Win, Menu_Index); -- Is_Actions := False;  -- else -- declare -- Action_Name : String := Actions_Menu(Menu_Index).all(1..Index(Actions_Menu(Menu_Index).all, "-", Backward)-1); -- Success : Boolean := False; -- begin -- null; -- end; -- end if; -- when others => -- null; -- end case;  -- end if; -- end Receive; -- or -- accept Halt; -- if Web_Search /= null then -- if Is_Callable(Web_id) then -- Web_Search.Halt; -- end if; -- end if;  -- if Web_index /= null then -- if Is_Callable(Web_id) then -- Web_index.Halt; -- end if; -- end if;  -- exit Main_loop; -- or -- accept Wake_Up(Top : in Natural) do  -- Put_Line(Ansi_Tty_Control.Clear_Screen); -- if App.Started then -- Free(WOPR_Menu(7)); -- WOPR_Menu(7) := new String ' ("Procuct server started"); -- else -- Free(WOPR_Menu(8)); -- WOPR_Menu(8) := new String ' ("Procuct server started"); -- end if; -- Action_Last := 1; -- Menu_Index := 1; -- Menu_Print(Menu_Win, Menu_index); -- Is_Actions := False; -- Done := False; -- declare -- begin -- null; -- end; -- end Wake_Up; -- or -- accept Suspend do -- Done := False; -- --Put_Line(Ansi_Tty_Control.Clear_Screen); -- Put_Line(Ansi_Tty_Control.Clear_Screen); -- end Suspend; -- if Web_Search /= null then -- -- Text_Io.Put_Line("Suspend 1"); -- -- if Is_Callable(Web_id) then -- -- Text_Io.Put_Line("Suspend 2"); -- -- Web_Search.Halt; -- -- Text_Io.Put_Line("Suspend 16"); -- -- Search_Section := False; -- -- end if; -- Done := False; -- end if;  -- exit; -- or -- accept Page_Down do -- -- if not Adam.Results."="(Shell_Interface.Search_Result.File_Content, null) then -- -- if File_Index+(Result_Max_Lines/4-1) < Shell_Interface.Search_Result.File_Content'Length then -- -- File_Index := Positive'Min(File_Index+(Result_Max_Lines/4-1), Shell_Interface.Search_Result.File_Content'Length );  -- -- end if; -- -- end if; -- if not "="(App.Web_Result.Wlines, null) then -- if File_Index+(Result_Max_Lines/4-1) < App.Web_Result.Wlines'Length then -- File_Index := Positive'Min(File_Index+(Result_Max_Lines/4-1), App.Web_Result.Wlines'Length );  -- end if; -- end if; -- end Page_Down; -- Put_Line(Ansi_Tty_Control.Clear_Screen); -- Mode_Info_Status(W1, Null_Item); -- --Main_Quit_Info_Status(W3, On_Esc); -- --Search_Result_Info(W7, Shell_Interface, errno);  -- or -- accept Page_Up do -- if File_Index > (Result_Max_Lines/4-1) then -- File_Index := File_Index - (Result_Max_Lines/4-1); -- else -- File_Index := 0; -- end if; -- end Page_Up; -- Put_Line(Ansi_Tty_Control.Clear_Screen); -- Mode_Info_Status(W1, Null_Item); -- --Main_Quit_Info_Status(W3, On_Esc); -- --Search_Result_Info(W7, Shell_Interface, errno);  -- or -- when not Is_Actions => -- accept Up_Arrow do -- if Menu_Index > 1 then -- Menu_Index := Menu_Index - 1; -- end if; -- end Up_Arrow; -- Menu_Print(Menu_Win, Menu_Index); -- or -- when not Is_Actions => -- accept Down_Arrow do -- if Menu_Index < WOPR_Menu_Range'Last then -- Menu_Index := Menu_Index + 1; -- end if; -- end Down_Arrow; -- Menu_Print(Menu_Win, Menu_Index); -- or -- when Is_Actions => -- accept Up_Arrow do -- if Menu_Index > 1 then -- Menu_Index := Menu_Index - 1; -- end if; -- end Up_Arrow; -- Actions_Print(Menu_Win, Menu_Index); -- or -- when Is_Actions => -- accept Down_Arrow do -- if Menu_Index < Action_Last then -- Menu_Index := Menu_Index + 1; -- end if; -- end Down_Arrow; -- Actions_Print(Menu_Win, Menu_Index); -- or -- accept Left_Arrow; -- or -- accept Right_Arrow; -- or -- accept Begin_Of; -- or -- accept End_Of; -- or -- accept Del; -- or -- accept Overwrite;  -- or -- delay 0.05; -- if Done then -- -- if Web_Search /= null then -- -- if Is_Callable(Web_id) then -- -- select  -- Data_Available := True; -- -- or -- -- delay 0.1; -- -- end select; -- -- end if; -- -- end if; -- if Is_Callable(Web_id) then -- if Web_Search /= null then -- Web_Search.Send(App.Web_Result); -- Web_Search.start;  -- end if; -- if Web_index /= null then  -- Web_index.Send(App.Web_Result); -- Web_index.start; -- end if; -- end if; -- --delay 0.1; -- --Mode_Info_Status(W1, Null_Item); -- -- Main_Quit_Info_Status(W3, On_Esc); -- -- if Data_Available then -- -- --Search_Result_Info(W7, Shell_Interface, errno);  -- -- declare -- -- Pattern_Exp : constant Regexp.Regexp := Regexp.Compile -- -- (Handling.To_String(Shell_Interface.Search_Result.Pattern.all), -- -- True, True); -- -- begin -- -- Line_Count := 0; -- -- if not Adam.Results."="(Shell_Interface.Search_Result.File_Content, null) then -- -- Search_Loop: -- -- for I in File_Index+1..Positive'min(File_Index+((Result_Max_Lines-2)),  -- -- Shell_Interface.Search_Result.File_Content'Length) loop -- -- declare -- -- tmp : constant Wide_String :=  -- -- Ada.Strings.UTF_Encoding.Wide_Strings.Decode(Gnos.Results."-"(Shell_Interface.Search_Result.File_Content(I))); -- -- Line : constant Wide_String := Tmp(Tmp'First..Wide_Fixed.Index_Non_Blank((Tmp), Backward)); -- -- Chars_Max : constant Positive := Term_Width-5; -- -- Lines_Max : constant Positive := (Result_Max_Lines-3); -- -- begin -- -- if Real_Length(Line) > 0 and Real_Length(Line) < (Chars_Max * Lines_Max) then  -- -- for Line_Window in Line_Index..Integer'min(Real_Length(Line)/(Chars_Max+1), Lines_Max) loop -- -- declare -- -- B_Inf : constant Positive := Line_Window*Chars_Max + 1; -- -- B_Sup : constant Positive := Integer'min((Line_Window + 1)*Chars_Max, Real_Length(Line)); -- -- begin -- -- if Real_length(Line) < Chars_max then -- -- if Regexp.Match -- -- (Handling.To_String(Line),  -- -- Pattern_Exp) then -- -- Ansi_Windows.Draw (W10, Line_Count + 1, 2, Red, (Line)); -- -- else -- -- Ansi_Windows.Draw (W10, Line_Count + 1, 2, White, (Line)); -- -- end if; -- -- else -- -- if Regexp.Match -- -- (Handling.To_String(Line),  -- -- Pattern_Exp) then -- -- Ansi_Windows.Draw  -- -- (W10,  -- -- Line_count + 1, -- -- 2,  -- -- Red,  -- -- (Line(B_inf..B_sup)) -- -- ); -- -- else -- -- Ansi_Windows.Draw  -- -- (W10,  -- -- Line_count + 1, -- -- 2,  -- -- White,  -- -- (Line(B_inf..B_sup)) -- -- );  -- -- end if; -- -- end if;  -- -- end; -- -- Line_Count := Line_Count + 1; -- -- exit Search_Loop When Line_Count > (Result_Max_lines - 3);  -- -- end loop; -- -- else -- -- Line_Count := Line_Count + 1; -- -- end if;  -- -- end; -- -- exit Search_Loop when Line_Count > (Result_Max_Lines - 3); -- -- end loop Search_Loop; -- -- end if; -- if Data_Available then -- Search_Result_Info(W7, App.Web_Result, errno);  -- declare -- Pattern_Exp : constant Regexp.Regexp := Regexp.Compile -- (Handling.To_String(App.Web_Result.Pattern.all), -- True, True); -- begin -- Line_Count := 0; -- if not "="(App.Web_Result.wlines, null) then -- Search_Loop: -- for I in File_Index+1..Positive'min(File_Index+((Result_Max_Lines-2)),  -- App.Web_Result.wlines'Length) loop -- declare -- tmp : constant Wide_String :=  -- Ada.Strings.UTF_Encoding.Wide_Strings.Decode(Gnos.Results."-"(App.Web_Result.wlines(I))); -- Line : constant Wide_String := Tmp(Tmp'First..Wide_Fixed.Index_Non_Blank((Tmp), Backward)); -- Chars_Max : constant Positive := Term_Width-5; -- Lines_Max : constant Positive := (Result_Max_Lines-3); -- begin -- if Real_Length(Line) > 0 and Real_Length(Line) < (Chars_Max * Lines_Max) then  -- for Line_Window in Line_Index..Integer'min(Real_Length(Line)/(Chars_Max+1), Lines_Max) loop -- declare -- B_Inf : constant Positive := Line_Window*Chars_Max + 1; -- B_Sup : constant Positive := Integer'min((Line_Window + 1)*Chars_Max, Real_Length(Line)); -- begin -- if Real_length(Line) < Chars_max then -- if Regexp.Match -- (Handling.To_String(Line),  -- Pattern_Exp) then -- Ansi_Windows.Draw (W10, Line_Count + 1, 2, Red, (Line)); -- else -- Ansi_Windows.Draw (W10, Line_Count + 1, 2, White, (Line)); -- end if; -- else -- if Regexp.Match -- (Handling.To_String(Line),  -- Pattern_Exp) then -- Ansi_Windows.Draw  -- (W10,  -- Line_count + 1, -- 2,  -- Red,  -- (Line(B_inf..B_sup)) -- ); -- else -- Ansi_Windows.Draw  -- (W10,  -- Line_count + 1, -- 2,  -- White,  -- (Line(B_inf..B_sup)) -- );  -- end if; -- end if;  -- end; -- Line_Count := Line_Count + 1; -- exit Search_Loop When Line_Count > (Result_Max_lines - 3);  -- end loop; -- else -- Line_Count := Line_Count + 1; -- end if;  -- end; -- exit Search_Loop when Line_Count > (Result_Max_Lines - 3); -- end loop Search_Loop; -- end if; -- exception -- when others => -- null; -- end; -- end if; -- Mode_Initialization(W1, Current_Mode, On_Esc, Message => To_Wide_String(Formatting.Image(Clock))); -- if Is_Callable(Web_id) then -- if Web_Search /= null then -- Web_Search.Start; -- elsif Web_Index /= null then -- Web_index.Start; -- end if; -- end if; -- end if; -- end select; -- end loop Menu_Loop; -- loop -- select -- accept Left_Arrow; -- or -- accept Right_Arrow; -- or -- accept Del; -- or -- accept Begin_Of; -- or -- accept End_Of; -- or -- accept Overwrite; -- or -- accept Up_Arrow; -- or -- accept Down_Arrow; -- or -- accept Page_Down; -- or -- accept Page_Up; -- or -- accept Halt do -- Text_Io.Put_Line("Halting WOPR..."); -- end Halt; -- if Web_Search /= null then -- if Is_Callable(Web_id) then -- Web_Search.Halt; -- end if;  -- end if; -- if Web_index /= null then -- if Is_Callable(Web_id) then -- Web_index.Halt; -- end if;  -- end if; -- exit Main_Loop; -- or -- accept Suspend;-- do -- -- Done := False; -- -- Put_Line(Ansi_Tty_Control.Clear_Screen); -- -- end Suspend; -- if Web_search /= null then -- if Is_Callable(Web_id) then -- Web_Search.Halt; -- Search_Section := False; -- end if; -- end if;  -- or -- accept Wake_Up(Top : in Natural) do -- if App.Started then -- Free(WOPR_Menu(7)); -- WOPR_Menu(7) := new String ' ("Procuct server started"); -- else -- Free(WOPR_Menu(8)); -- WOPR_Menu(8) := new String ' ("Procuct server stopped"); -- end if; -- Done := False; -- Data_Available := False; -- Action_Last := 1; -- Menu_Index := 1; -- if Web_Search /= null then -- if Is_Callable(Web_id) then -- Previsious_mode := Current_Command; -- Current_Mode := search; -- File_Index := 0; -- Line_Index := 0;  -- Done := True; -- --Search_Section := True; -- else -- abort Web_Search.All; -- Web_Search := null; -- end if; -- elsif Web_index /= null then -- if Is_Callable(Web_id) then -- Previsious_mode := Current_Command; -- Current_Mode := search; -- File_Index := 0; -- Line_Index := 0;  -- Done := True; -- --Search_Section := True; -- else -- abort Web_index.All; -- Web_index := null; -- end if; -- end if; -- Menu_Print(Menu_Win, Menu_index); -- Is_Actions := False;  -- declare -- begin -- null; -- end; -- end Wake_Up;  -- exit;  -- end select; -- end loop; -- end loop Main_Loop;  -- Textual_Interface_Type(Shell_Interface.all).Textual_Thread.Halt; -- W_Io.Put_Line("WOPR process halted"); -- end WOPR_Process; task body WOPR_Process is Web_Id : Task_Id; Index_id : Task_Id; Term_Width : constant Positive := App.Columns - 2; Result_Max_Lines : constant Positive := App.Lines - (7 + 9); File_Index : natural := 0; Line_Index : Natural := 0; On_Esc : Boolean := False; Line_Count : Natural := 0; Current_Command : Command_Type := Search; Previsious_Mode : Command_Type := Search; Current_Mode : Command_Type := Search; Chars_Max : constant Positive := Term_Width-10; Errno : Integer := 0; W3 : constant Ansi_Windows.Window_Type := ( -- Quit (exit program) window information. L => Lines-5, C => 2, H => 3, W => Term_Width, Frame_Type => Ansi_Windows.Single_Line_Frame, Frame_Color => Yellow, Close_Box_Color => Red); W4 : constant Ansi_Windows.Window_Type := ( -- Status message Window. L => 4, C => 2, H => 7, W => Term_Width, Frame_Type => Ansi_Windows.Single_Line_Frame, Frame_Color => Yellow, Close_Box_Color => Red); W6 : constant Ansi_Windows.Window_Type := ( -- Search window L => 4, C => 2, H => 5, W => Term_Width, Frame_Type => Ansi_Windows.Single_Line_Frame, Frame_Color => Yellow, Close_Box_Color => Red); W7 : constant Ansi_Windows.Window_Type := ( -- Search result info Window L => 4, C => 2, H => 5, W => Term_Width, Frame_Type => Ansi_Windows.Single_Line_Frame, Frame_Color => Yellow, Close_Box_Color => Red); W10 : constant Ansi_Windows.Window_Type := ( -- Command result : out_file.txt. L => 9, C => 2, H => Result_Max_Lines+2, W => Term_Width, Frame_Type => Ansi_Windows.Single_Line_Frame, Frame_Color => Yellow, Close_Box_Color => Red); Web_Search : access Web_Search_Type; Web_Index : access Web_Index_Type; Done : Boolean := False; procedure Add_Product(Name : in String;Path : in String;Unit_HT : in Fixed_Unit_Ht;TVA_Rate : in Fixed_Factor; Total_TVA : in Fixed_Total;Unit_TTC : in Fixed_Unit_TTC) is File : W_Io.File_Type; Product : constant Product_Access := new Product_Class; begin W_Io.Open(File, W_Io.In_File, Path & '/' & "Abstract.txt", Form => "WCEM=8"); Product.Name := new String ' (Name); Product.Description := new Wide_String ' (W_Io.Get_Line(File)); W_Io.Close(File); Product.Documentation := new String ' (Name & ".html"); Product.Unit_Ht := Unit_Ht; Product.TVA_Rate := TVA_Rate; Product.TVA := Total_TVA; Product.Unit_TTC := Unit_TTC; Current_Game.Products(Current_Game.Count+1) := Product; Current_Game.Count := Current_Game.Count+1; end Add_Product; Payed : Boolean := False; procedure Add_Name(Path : in String;Rate : in float) is Price : Sai.Price_Type := 0.0; Curs : Projects_DLL.Cursor := Projects_Dll.First(App.Projects.List); Start : Projects_DLL.Cursor := Projects_Dll.First(App.Projects.List); Project : M.Project.Project_Access := Projects_Dll.First_Element(App.Projects.List); Line : Account_Line_Type; Version : M.Versions.Version_Type; invoice : invoice_Record; Done : Boolean := False; begin Text_Io.Put("Enter name : "); declare Name : constant String := Text_Io.Get_Line; begin Text_Io.Put("Version : "); Version := To_Version(Get_Line); Sai.Editting.Add(name); Project := Projects_Dll.Element(Curs); if Project.Project_Name.all /= name then Curs := Projects_DLL.Next(Curs); Project := Projects_Dll.Element(Curs); Curs := Projects_DLL.Next(Curs); for I in 2 .. Projects_Dll.length(App.Projects.list) - 1 loop Project := Projects_Dll.Element(Curs); if Project.Project_Name.all = name then Done := True; exit; end if; Curs := Projects_DLL.Next(Curs); end loop; if Done then Price := Sai.Price_Type(float(Float(Project.Elapsed / 3600.0) + (Float(Project.Days) * 24.0)) * Float(Rate)) / 1000.0; end if; else Price := Sai.Price_Type((Float(Project.Elapsed / 3600.0) + (Float(Project.Days) * 24.0)) * Float(Rate)) / 1000.0; Done := True; end if; if Done then line := (0, Clock, Clock, (others => Wide_Character'Val(32)), 10, Fixed_Unit_Ht(Price), 10.0, 1000.0, Fixed_Total(Price * 1000.0), Fixed_total(Fixed_total(Fixed_Total(Fixed_Total(Price) * 1000.0 ) /100.0) * 10.0), Fixed_total(Fixed_total(Fixed_Total((Price) * 1000.0) + Fixed_Total(Fixed_Total(Fixed_Total((Fixed_Total(Price) * 1000.0))/100.0) * 10.0))), 0, (others => Wide_Character'Val(32)) ); Wide_Fixed.Move(Handling.To_Wide_String(name), Line.Description); Wide_Fixed.Move("Manuel De Girardi", Line.Peer_Name); invoice := (256, (1 => Line, others => Null_Line), 1, 607, invoice_num+1, 0.0, -- Fixed_Total(Price) * 1000.0, 0.0, -- Fixed_Total(Fixed_Total(Fixed_total(Fixed_total(Price) * 1000.0)/100.0) * 10.0), 0.0, -- Fixed_Total(Fixed_Total(Fixed_total(Fixed_total(Price) * 1000.0)) + (Fixed_total(Fixed_total(Fixed_Total(Price) * 1000.0)/100.0) * 10.0)), Line.Peer_Name, clock, 1 ); Text_Io.Put("Price is :" & Sai.Price_Type'Image(Price) & "$"); Text_Io.Put_Line("Set price..."); Add_Edit(Path, name, Price); billed(M.Balance.Balance, invoice, Payed); if Payed then Invoice.Date := Clock; Invoice.Account_Num := Invoice.Accounting(1).Account_Num; Invoice.voice_Num := M.Balance.Invoice_Num + 1; M.Balance.Invoice_Num := M.Balance.Invoice_Num + 1; if Save(Invoice, "billed.txt") then Add(Accounts, Invoice); for Iter in 1..Invoice.Line_Last loop declare Line : constant Account_Line_Type := Invoice.Accounting(Iter); begin if not Sky.Stocks_Manager.In_Stocks(Sky.Stocks_Manager.Hardware, Line.Description) then declare Stock : constant Stock_Record := (Sky.Stocks_Manager.Hard_Num + 1, Line.Description, Line.Quantity, Line.Unit_Ht_Price, Line.TVA_Rate); begin Sky.Stocks_Manager.Hard_Num := Sky.Stocks_Manager.Hard_Num + 1; Sky.Stocks_Manager.Stock_Add(Sky.Stocks_Manager.Hardware, Stock); end; else declare Stock : constant Stock_Record := (0, Line.Description, (Line.Quantity), Line.Unit_Ht_Price, Line.TVA_Rate); begin Sky.Stocks_Manager.Update_Stock(Sky.Stocks_Manager.Hardware, Stock); end; end if; end; end loop; end if; Add_Product(Name, Name & "-" & To_String(Version), Fixed_Unit_Ht(Price), 10.0, Fixed_Total((Fixed_Total(Price/100.0))*10.0), Fixed_Unit_Ttc(Fixed_Unit_Ttc(Price)+((Fixed_Unit_Ttc(Price/100.0))*10.0))); end if; end if; end; end Add_Name; procedure Delete_Name(Path : in String) is Id : Product_Id := Id_Count+4; begin loop begin for Id in 1..Id_Count loop Text_Io.Put_Line(Positive'Image((ID-1)+5) & ' ' & Sai.Editting.Name((Id-1)+5).all); end loop; Text_Io.New_Line; Text_Io.Put("Enter numb : "); Id := Product_id'Value(Get_Line); Del(Id); Del_Edit(Path, Id); exception when Text_Io.End_Error => exit; when others => null; end; end loop; end Delete_Name; Menu_Index : WOPR_Menu_Range := 1; Title : Line_Type := (others => Character'Val(32)); Item : Line_Type := (others => Character'Val(32)); Menu_Win : Window_Record := (1, 1, App.Lines, App.Columns/2, Blue, The_Window); type Action_List is array (Positive range 1..App.Lines-8) of Os_Lib.String_Access; Action_Last : natural := 0; Actions_Menu : Action_List := (1 => new String ' ("W. O. P. R. menu"), others => null); procedure Menu_Print(Win : in Window_Record; Selected : in WOPR_Menu_Range) is begin Draw_Window(Win); Fixed.Move("W. O. P. R. menu", Title, Error, Left); Draw_Text(Win, 3, App.Columns/4-8, White, Handling.To_Wide_String(Title)); for Iter in WOPR_Menu'Range loop Item := (others => Character'Val(32)); Fixed.Move(WOPR_Menu(Iter).all, Item, Error, Left); if Iter /= Selected then Draw_Text(Win, Iter*2+5, App.Columns/4-8, White, Handling.To_Wide_String(Item)); else Enlight_Draw_Text(Win, Iter*2+5, App.Columns/4-8, Cyan, Handling.To_Wide_String(Item)); Text_Io.Put(Normal_Mode); end if; end loop; end Menu_Print; procedure Actions_Print(Win : in Window_Record; Selected : in Positive) is begin Draw_Window(Win); Fixed.Move("Administration", Title, Error, Left); Draw_Text(Win, 3, App.Columns/4-8, White, Handling.To_Wide_String(Title)); for Iter in 1..Action_Last loop Item := (others => Character'Val(32)); Fixed.Move(Actions_Menu(Iter).all, Item, Error, Left); if Iter /= Selected then Draw_Text(Win, Iter*2+5, App.Columns/4-8, White, Handling.To_Wide_String(Item)); else Enlight_Draw_Text(Win, Iter*2+5, App.Columns/4-8, White, Handling.To_Wide_String(Item)); Text_Io.Put(Normal_Mode); end if; end loop; end Actions_Print; Line : M.Strings.Wide_String_Access := new Wide_String ' ("" & Wide_Character'Val(0)); Is_Actions : Boolean := False; Profile : Profile_Class; Rate : Float := 160.0; Motif : Wide_String(1..256) := (others => ' '); Motif_Last : Natural := 0; End_Of_Section : Boolean := False; Data_Available : Boolean := False; Search_Section : Boolean := False; index_Section : Boolean := False; begin Initialize(Menu_Win, 1, 1, App.Lines, App.Columns/2, Blue, White); if Length(App.Borg.Path) /= 0 then if Element(App.Borg.Path, 1).Definition.list(1).Name.all /= "Rate" then for I in Element(App.Borg.Path, 1).Definition.List'range loop begin if Element(App.Borg.Path, 1).Definition.list(1).Name.all /= "Rate" then case Element(App.Borg.Path, 1).Definition.list(1).enum is when Flt => Rate := Element(App.Borg.Path, 1).Definition.list(1).Flt; when others => null; end case; exit; end if; end; end loop; end if; end if; Sai.Editting.Init; Main_Loop: loop Search_Section := False; Menu_Loop : loop select when Search_Section and not Is_Actions => accept Receive(Wchar : in Wide_Character) do if Wchar = Wide_Character'Val(10) then Put_Line(App.Web_Result.Address.all); declare Success : Boolean; Args : Argument_List_Access := Argument_String_To_List(App.Web_Result.Address.all); begin Spawn(Locate_Exec_On_Path("lynx").all, Args.all, Success); end; Put_Line(Ansi_Tty_Control.Clear_Screen); if Web_Search /= null then abort Web_Search.All; Web_Search := null; end if; Action_Last := 1; Menu_Index := 5; Is_Actions := False; Menu_Print(Menu_Win, Menu_index); Done := False; End_Of_Section := True; elsif Wchar = Wide_Character'Val(127) then if Web_Search /= null then Web_Search.halt; end if; if Web_index /= null then Web_index.halt; end if; Put_Line(Ansi_Tty_Control.Clear_Screen); Action_Last := 1; Menu_Index := 5; Is_Actions := False; Menu_Print(Menu_Win, Menu_index); Done := False; End_Of_Section := True; elsif Wchar = Wide_Character'Val(18) then if Web_Search /= null then Web_Search.halt; end if; if Web_index /= null then Web_index.halt; end if; Put_Line(Ansi_Tty_Control.Clear_Screen); Action_Last := 1; Menu_Index := 1; Is_Actions := False; Menu_Print(Menu_Win, Menu_index); Done := False; End_Of_Section := True; if Web_Search /= null then abort Web_Search.all; Web_Search := null; end if; if Web_Index /= null then abort Web_index.all; Web_index := null; end if; end if; end Receive; Search_Section := False; or when not Search_Section and not Is_Actions => accept Receive (Wchar : in Wide_Character) do begin if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(10) => if Menu_Index = 1 then Actions_Print(Menu_Win, Menu_Index); Is_Actions := True; elsif Menu_Index = 11 then null; else case Menu_Index is when 2 => Add_Name("main-" & Versions.Version_Io.To_String(Versions.Version), rate); Menu_Print(Menu_Win, Menu_index); when 3 => null; Delete_Name("main-" & Versions.Version_Io.To_String(Versions.Version)); Menu_Print(Menu_Win, Menu_index); when 4 => null; when 5 => Put_Line(Ansi_Tty_Control.Clear_Screen); Text_Io.Put("Web search : "); if Web_Search /= null then Search_Section := True; index_Section := False; Done := True; else W_Io.Get_Line(Motif, Motif_Last); Done := False; Wide_Free(Line); Line := new Wide_String ' (Motif(Wide_Fixed.Index_Non_Blank(Motif)..Wide_Fixed.Index_Non_Blank(Motif, Ada.Strings.Backward))); Motif := (others => ' '); Motif_Last := 0; if Wide_Fixed.Index((Line.all(Wide_Fixed.Index_Non_Blank((Line.all))..Line'Last)), " ") /= 0 and then Wide_Fixed.Index_Non_Blank((Line.all), Backward) /= Wide_Fixed.Index((Line.all(Wide_Fixed.Index_Non_Blank((Line.all))..Line'Last)), " ") then declare Search_String : constant Wide_String := Line.all(Wide_Fixed.Index ((Line.all(Wide_Fixed.Index_Non_Blank ((Line.all))..Line'Last)), " ")+1..Wide_Fixed.Index_Non_Blank((Line.all), Backward)); begin if Search_String'Length /= 0 then if Web_Search /= null then abort Web_Search.all; end if; Put(Ansi_Tty_Control.Clear_Screen); Mode_Info_Status(W1, Null_Item); Web_Search := new Web_Search_Type (new Ansi_Windows.Window_Type '(W6), App.Web_Result'access, new Wide_String ' (Search_String), new Integer ' (Errno)); Web_Search.Id(Web_Id); Data_Available := False; Previsious_mode := Current_Mode; Current_Mode := Current_Command; File_Index := 0; Line_Index := 0; Done := True; else if Web_Search /= null then Previsious_mode := Current_Mode; Current_Mode := Current_Command; Done := True; end if; end if; end; else if Web_Search /= null then Previsious_mode := Current_Mode; Current_Mode := Current_Command; Done := True; end if; end if; Search_Section := True; index_Section := False; end if; Put_Line(Ansi_Tty_Control.Clear_Screen); when 6 => Put_Line(Ansi_Tty_Control.Clear_Screen); Text_Io.Put("Web index : "); if Web_Index /= null then Search_Section := False; index_Section := True; Done := True; else W_Io.Get_Line(Motif, Motif_Last); Done := False; Wide_Free(Line); Line := new Wide_String ' (Motif(Wide_Fixed.Index_Non_Blank(Motif)..Wide_Fixed.Index_Non_Blank(Motif, Ada.Strings.Backward))); Motif := (others => ' '); Motif_Last := 0; if Wide_Fixed.Index((Line.all(Wide_Fixed.Index_Non_Blank((Line.all))..Line'Last)), " ") /= 0 and then Wide_Fixed.Index_Non_Blank((Line.all), Backward) /= Wide_Fixed.Index((Line.all(Wide_Fixed.Index_Non_Blank((Line.all))..Line'Last)), " ") then declare Search_String : constant Wide_String := Line.all(Wide_Fixed.Index ((Line.all(Wide_Fixed.Index_Non_Blank ((Line.all))..Line'Last)), " ")+1..Wide_Fixed.Index_Non_Blank((Line.all), Backward)); begin if Search_String'Length /= 0 then if Web_Index /= null then abort Web_Index.all; end if; Put(Ansi_Tty_Control.Clear_Screen); Mode_Info_Status(W1, Null_Item); Web_Index := new Web_Index_Type (new Ansi_Windows.Window_Type '(W6), App.index_Result'access, new Wide_String ' (Search_String), new Integer ' (Errno)); Web_Index.Id(index_Id); Data_Available := False; Previsious_mode := Current_Mode; Current_Mode := Current_Command; File_Index := 0; Line_Index := 0; Done := True; else if Web_Index /= null then Previsious_mode := Current_Mode; Current_Mode := Current_Command; Done := True; end if; end if; end; else if Web_Index /= null then Previsious_mode := Current_Mode; Current_Mode := Current_Command; Done := True; end if; end if; Search_Section := False; index_Section := True; end if; Put_Line(Ansi_Tty_Control.Clear_Screen); -- Put_Line(Ansi_Tty_Control.Clear_Screen); -- Text_Io.Put("Web index : "); -- if Web_Index /= null then -- Search_Section := True; -- Done := True; -- else -- W_Io.Get_Line(Motif, Motif_Last); -- Done := False; -- Wide_Free(Line); -- Line := new Wide_String ' (Motif(Wide_Fixed.Index_Non_Blank(Motif)..Wide_Fixed.Index_Non_Blank(Motif, Ada.Strings.Backward))); -- Motif := (others => ' '); -- Motif_Last := 0; -- if Wide_Fixed.Index((Line.all(Wide_Fixed.Index_Non_Blank((Line.all))..Line'Last)), " ") /= 0 and then -- Wide_Fixed.Index_Non_Blank((Line.all), Backward) /=  -- Wide_Fixed.Index((Line.all(Wide_Fixed.Index_Non_Blank((Line.all))..Line'Last)), " ") then -- declare -- Search_String : constant Wide_String :=  -- Line.all(Wide_Fixed.Index -- ((Line.all(Wide_Fixed.Index_Non_Blank -- ((Line.all))..Line'Last)), -- " ")+1..Wide_Fixed.Index_Non_Blank((Line.all), Backward)); -- begin -- if Search_String'Length /= 0 then  -- if Web_Index /= null then -- abort Web_Index.all; -- end if; -- Put(Ansi_Tty_Control.Clear_Screen); -- Mode_Info_Status(W1, Null_Item); -- Web_Index :=  -- new Web_Index_Type -- (new Ansi_Windows.Window_Type '(W6),  -- Shell_Interface.Search_Result'access,  -- new Wide_String ' (Search_String), new Integer ' (Errno)); -- Web_Index.Id(Web_Id); -- Data_Available := False; -- Previsious_mode := Current_Mode; -- Current_Mode := Current_Command; -- File_Index := 0; -- Line_Index := 0; -- Done := True; -- else -- if Web_Index /= null then -- Previsious_mode := Current_Mode; -- Current_Mode := Current_Command; -- Done := True; -- end if; -- end if; -- end; -- else -- if Web_Index /= null then -- Previsious_mode := Current_Mode; -- Current_Mode := Current_Command; -- Done := True; -- end if; -- end if; -- Search_Section := True; -- end if; -- Put_Line(Ansi_Tty_Control.Clear_Screen); when 7 => if not App.Started then Servers.Server.Start; end if; App.Started := True; Free(WOPR_Menu(6)); Free(WOPR_Menu(7)); WOPR_Menu(6) := new String ' ("Procuct server started"); WOPR_Menu(7) := new String ' ("Procuct server stop"); Menu_Print(Menu_Win, Menu_index); when 8 => if App.Started then Servers.Server.Stop; end if; App.Started := False; Free(WOPR_Menu(6)); Free(WOPR_Menu(7)); WOPR_Menu(6) := new String ' ("Procuct server start"); WOPR_Menu(7) := new String ' ("Procuct server stopped"); Menu_Print(Menu_Win, Menu_index); when others => null; end case; end if; when others => null; end case; end if; exception when End_Error => Put_Line(Ansi_Tty_Control.Clear_Screen); Action_Last := 1; Menu_Index := 1; Wide_Free(Line); Is_Actions := False; Done := False; Menu_Print(Menu_Win, Menu_index); when others => Menu_Print(Menu_Win, Menu_index); Errno := -1; end; end Receive; if Done then if Web_Search /= null then End_Of_Section := False; Web_Search.Start; elsif Web_Index /= null then End_Of_Section := False; Web_Index.Start; end if; else if Is_Actions then Actions_Print(Menu_Win, Menu_Index); else Menu_Print(Menu_Win, Menu_index); end if; end if; or when Is_Actions => accept Receive (Wchar : in Wide_Character) do if Is_Control(Wchar) then case Wchar is when Wide_Character'Val(10) => if Menu_Index = 1 then Menu_Print(Menu_Win, Menu_Index); Is_Actions := False; else declare Action_Name : String := Actions_Menu(Menu_Index).all(1..Index(Actions_Menu(Menu_Index).all, "-", Backward)-1); Success : Boolean := False; begin null; end; end if; when others => null; end case; end if; end Receive; or accept Halt; if Web_Search /= null then if Is_Callable(Web_id) then Web_Search.Halt; end if; end if; if Web_index /= null then if Is_Callable(index_id) then Web_index.Halt; end if; end if; exit Main_loop; or accept Wake_Up(Top : in Natural) do Put_Line(Ansi_Tty_Control.Clear_Screen); if App.Started then Free(WOPR_Menu(7)); WOPR_Menu(7) := new String ' ("Procuct server started"); else Free(WOPR_Menu(8)); WOPR_Menu(8) := new String ' ("Procuct server started"); end if; Action_Last := 1; Menu_Index := 1; Menu_Print(Menu_Win, Menu_index); Is_Actions := False; Done := False; declare begin null; end; end Wake_Up; or accept Suspend do Done := False; --Put_Line(Ansi_Tty_Control.Clear_Screen); Put_Line(Ansi_Tty_Control.Clear_Screen); Search_Section := False; Index_Section := False; Done := False; end Suspend; exit; or accept Page_Down do -- if not Adam.Results."="(Shell_Interface.Search_Result.Wlines, null) then -- if File_Index+(Result_Max_Lines/4-1) < Shell_Interface.Search_Result.Wlines'Length then -- File_Index := Positive'Min(File_Index+(Result_Max_Lines/4-1), Shell_Interface.Search_Result.Wlines'Length );  -- end if; -- end if; if not "="(App.Web_Result.Wlines, null) then if File_Index+(Result_Max_Lines/4-1) < App.Web_Result.Wlines'Length then File_Index := Positive'Min(File_Index+(Result_Max_Lines/4-1), App.Web_Result.Wlines'Length ); end if; end if; end Page_Down; Put_Line(Ansi_Tty_Control.Clear_Screen); Mode_Info_Status(W1, Null_Item); --Main_Quit_Info_Status(W3, On_Esc); --Search_Result_Info(W7, Shell_Interface, errno);  or accept Page_Up do if File_Index > (Result_Max_Lines/4-1) then File_Index := File_Index - (Result_Max_Lines/4-1); else File_Index := 0; end if; end Page_Up; Put_Line(Ansi_Tty_Control.Clear_Screen); Mode_Info_Status(W1, Null_Item); --Main_Quit_Info_Status(W3, On_Esc); --Search_Result_Info(W7, Shell_Interface, errno);  or when not Is_Actions => accept Up_Arrow do if Menu_Index > 1 then Menu_Index := Menu_Index - 1; end if; end Up_Arrow; Menu_Print(Menu_Win, Menu_Index); or when not Is_Actions => accept Down_Arrow do if Menu_Index < WOPR_Menu_Range'Last then Menu_Index := Menu_Index + 1; end if; end Down_Arrow; Menu_Print(Menu_Win, Menu_Index); or when Is_Actions => accept Up_Arrow do if Menu_Index > 1 then Menu_Index := Menu_Index - 1; end if; end Up_Arrow; Actions_Print(Menu_Win, Menu_Index); or when Is_Actions => accept Down_Arrow do if Menu_Index < Action_Last then Menu_Index := Menu_Index + 1; end if; end Down_Arrow; Actions_Print(Menu_Win, Menu_Index); or accept Left_Arrow; or accept Right_Arrow; or accept Begin_Of; or accept End_Of; or accept Del; or accept Overwrite; or delay 0.05; if Done then -- if Web_Search /= null then -- if Is_Callable(Web_id) then -- select  Data_Available := True; -- or -- delay 0.1; -- end select; -- end if; -- end if; if Web_Search /= null then if Is_Callable(Web_id) then Web_Search.Send(App.Web_Result); Web_Search.start; end if; end if; if Web_index /= null then if Is_Callable(index_id) then Web_index.Send(App.Index_Result); Web_index.start; end if; end if; --delay 0.1; --Mode_Info_Status(W1, Null_Item); -- Main_Quit_Info_Status(W3, On_Esc); -- if Data_Available then -- --Search_Result_Info(W7, Shell_Interface, errno);  -- declare -- Pattern_Exp : constant Regexp.Regexp := Regexp.Compile -- (Handling.To_String(Shell_Interface.Search_Result.Pattern.all), -- True, True); -- begin -- Line_Count := 0; -- if not Adam.Results."="(Shell_Interface.Search_Result.Wlines, null) then -- Search_Loop: -- for I in File_Index+1..Positive'min(File_Index+((Result_Max_Lines-2)),  -- Shell_Interface.Search_Result.Wlines'Length) loop -- declare -- tmp : constant Wide_String :=  -- Ada.Strings.UTF_Encoding.Wide_Strings.Decode(Gnos.Results."-"(Shell_Interface.Search_Result.Wlines(I))); -- Line : constant Wide_String := Tmp(Tmp'First..Wide_Fixed.Index_Non_Blank((Tmp), Backward)); -- Chars_Max : constant Positive := Term_Width-5; -- Lines_Max : constant Positive := (Result_Max_Lines-3); -- begin -- if Real_Length(Line) > 0 and Real_Length(Line) < (Chars_Max * Lines_Max) then  -- for Line_Window in Line_Index..Integer'min(Real_Length(Line)/(Chars_Max+1), Lines_Max) loop -- declare -- B_Inf : constant Positive := Line_Window*Chars_Max + 1; -- B_Sup : constant Positive := Integer'min((Line_Window + 1)*Chars_Max, Real_Length(Line)); -- begin -- if Real_length(Line) < Chars_max then -- if Regexp.Match -- (Handling.To_String(Line),  -- Pattern_Exp) then -- Ansi_Windows.Draw (W10, Line_Count + 1, 2, Red, (Line)); -- else -- Ansi_Windows.Draw (W10, Line_Count + 1, 2, White, (Line)); -- end if; -- else -- if Regexp.Match -- (Handling.To_String(Line),  -- Pattern_Exp) then -- Ansi_Windows.Draw  -- (W10,  -- Line_count + 1, -- 2,  -- Red,  -- (Line(B_inf..B_sup)) -- ); -- else -- Ansi_Windows.Draw  -- (W10,  -- Line_count + 1, -- 2,  -- White,  -- (Line(B_inf..B_sup)) -- );  -- end if; -- end if;  -- end; -- Line_Count := Line_Count + 1; -- exit Search_Loop When Line_Count > (Result_Max_lines - 3);  -- end loop; -- else -- Line_Count := Line_Count + 1; -- end if;  -- end; -- exit Search_Loop when Line_Count > (Result_Max_Lines - 3); -- end loop Search_Loop; -- end if; if Data_Available then if Index_Section then Search_Result_Info(W7, App.Index_Result, errno); declare Pattern_Exp : constant Regexp.Regexp := Regexp.Compile (Handling.To_String(App.Index_Result.Pattern.all), True, True); begin Line_Count := 0; if not "="(App.Index_Result.wlines, null) then Index_Loop: for I in File_Index+1..Positive'min(File_Index+((Result_Max_Lines-2)), App.Index_Result.wlines'Length) loop declare tmp : constant Wide_String := Ada.Strings.UTF_Encoding.Wide_Strings.Decode(Gnos.Results."-"(App.Index_Result.wlines(I))); Line : constant Wide_String := Tmp(Tmp'First..Wide_Fixed.Index_Non_Blank((Tmp), Backward)); Chars_Max : constant Positive := Term_Width-5; Lines_Max : constant Positive := (Result_Max_Lines-3); begin if Real_Length(Line) > 0 and Real_Length(Line) < (Chars_Max * Lines_Max) then for Line_Window in Line_Index..Integer'min(Real_Length(Line)/(Chars_Max+1), Lines_Max) loop declare B_Inf : constant Positive := Line_Window*Chars_Max + 1; B_Sup : constant Positive := Integer'min((Line_Window + 1)*Chars_Max, Real_Length(Line)); begin if Real_length(Line) < Chars_max then if Regexp.Match (Handling.To_String(Line), Pattern_Exp) then Ansi_Windows.Draw (W10, Line_Count + 1, 2, Red, (Line)); else Ansi_Windows.Draw (W10, Line_Count + 1, 2, White, (Line)); end if; else if Regexp.Match (Handling.To_String(Line), Pattern_Exp) then Ansi_Windows.Draw (W10, Line_count + 1, 2, Red, (Line(B_inf..B_sup)) ); else Ansi_Windows.Draw (W10, Line_count + 1, 2, White, (Line(B_inf..B_sup)) ); end if; end if; end; Line_Count := Line_Count + 1; exit Index_Loop When Line_Count > (Result_Max_lines - 3); end loop; else Line_Count := Line_Count + 1; end if; end; exit Index_Loop when Line_Count > (Result_Max_Lines - 3); end loop Index_Loop; end if; exception when others => null; end; end if; if Search_Section then Search_Result_Info(W7, App.Web_Result, errno); declare Pattern_Exp : constant Regexp.Regexp := Regexp.Compile (Handling.To_String(App.Web_Result.Pattern.all), True, True); begin Line_Count := 0; if not "="(App.Web_Result.wlines, null) then Search_Loop: for I in File_Index+1..Positive'min(File_Index+((Result_Max_Lines-2)), App.Web_Result.wlines'Length) loop declare tmp : constant Wide_String := Ada.Strings.UTF_Encoding.Wide_Strings.Decode(Gnos.Results."-"(App.Web_Result.wlines(I))); Line : constant Wide_String := Tmp(Tmp'First..Wide_Fixed.Index_Non_Blank((Tmp), Backward)); Chars_Max : constant Positive := Term_Width-5; Lines_Max : constant Positive := (Result_Max_Lines-3); begin if Real_Length(Line) > 0 and Real_Length(Line) < (Chars_Max * Lines_Max) then for Line_Window in Line_Index..Integer'min(Real_Length(Line)/(Chars_Max+1), Lines_Max) loop declare B_Inf : constant Positive := Line_Window*Chars_Max + 1; B_Sup : constant Positive := Integer'min((Line_Window + 1)*Chars_Max, Real_Length(Line)); begin if Real_length(Line) < Chars_max then if Regexp.Match (Handling.To_String(Line), Pattern_Exp) then Ansi_Windows.Draw (W10, Line_Count + 1, 2, Red, (Line)); else Ansi_Windows.Draw (W10, Line_Count + 1, 2, White, (Line)); end if; else if Regexp.Match (Handling.To_String(Line), Pattern_Exp) then Ansi_Windows.Draw (W10, Line_count + 1, 2, Red, (Line(B_inf..B_sup)) ); else Ansi_Windows.Draw (W10, Line_count + 1, 2, White, (Line(B_inf..B_sup)) ); end if; end if; end; Line_Count := Line_Count + 1; exit Search_Loop When Line_Count > (Result_Max_lines - 3); end loop; else Line_Count := Line_Count + 1; end if; end; exit Search_Loop when Line_Count > (Result_Max_Lines - 3); end loop Search_Loop; end if; exception when others => null; end; end if; end if; Mode_Initialization(W1, Current_Mode, On_Esc, Message => To_Wide_String(Formatting.Image(Clock))); if Web_Search /= null then if Is_Callable(Web_id) then Web_Search.Start; end if; elsif Web_Index /= null then if Is_Callable(index_id) then Web_index.Start; end if; end if; end if; end select; end loop Menu_Loop; loop select accept Left_Arrow; or accept Right_Arrow; or accept Del; or accept Begin_Of; or accept End_Of; or accept Overwrite; or accept Up_Arrow; or accept Down_Arrow; or accept Page_Down; or accept Page_Up; or accept Halt do Text_Io.Put_Line("Halting WOPR..."); end Halt; Text_Io.Put_Line("TOTO 1"); if Web_Search /= null then Text_Io.Put_Line("TOTO 2"); if Is_Callable(Web_id) then Text_Io.Put_Line("TOTO 3"); Web_Search.Halt; Text_Io.Put_Line("TOTO 4"); end if; end if; Text_Io.Put_Line("TOTO 5"); if Web_index /= null then Text_Io.Put_Line("TOTO 6"); if Is_Callable(index_id) then Text_Io.Put_Line("TOTO 7"); Web_index.Halt; Text_Io.Put_Line("TOTO 8"); end if; end if; exit Main_Loop; or accept Suspend;-- do -- Done := False; -- Put_Line(Ansi_Tty_Control.Clear_Screen); -- end Suspend; or accept Wake_Up(Top : in Natural) do if App.Started then Free(WOPR_Menu(7)); WOPR_Menu(7) := new String ' ("Procuct server started"); else Free(WOPR_Menu(8)); WOPR_Menu(8) := new String ' ("Procuct server stopped"); end if; Done := False; Data_Available := False; Action_Last := 1; Menu_Index := 1; if Web_Search /= null then if Is_Callable(Web_id) then Previsious_mode := Current_Command; Current_Mode := search; File_Index := 0; Line_Index := 0; Done := True; --Search_Section := True; else abort Web_Search.All; Web_Search := null; end if; elsif Web_index /= null then if Is_Callable(index_id) then Previsious_mode := Current_Command; Current_Mode := search; File_Index := 0; Line_Index := 0; Done := True; --Search_Section := True; else abort Web_index.All; Web_index := null; end if; end if; Menu_Print(Menu_Win, Menu_index); Is_Actions := False; declare begin null; end; end Wake_Up; exit; end select; end loop; end loop Main_Loop; Textual_Interface_Type(Shell_Interface.all).Textual_Thread.Halt; W_Io.Put_Line("WOPR process halted"); end WOPR_Process; use Gnos.Results; function Print_Set (Set : in Wide_Result_Access; Into : in Window_Record; Top : in Line_Index_Range; Total_Lines: out Natural) return Boolean is height : constant Positive := Into.Win.H-2; Width : constant Positive := Into.Win.W-2; Line_Count : Natural := 0; begin Total_Lines := 0; if Set.wlines'length = 0 then return True; end if; Print_Loop: for I in Top+1 .. Positive'min(Top+Height, Set.wlines'length) loop declare tmp : constant Wide_String := (Gnos.Results."-"(Set.wlines(I))); Line : constant Wide_String := Tmp(Tmp'First..Wide_Fixed.Index_Non_Blank((Tmp), Backward)); Chars_Max : constant Positive := Width-1; Lines_Max : constant Positive := Height; B_Inf : Positive := 1; B_Sup : Positive := Chars_Max; Bot : Natural := 0; begin if Real_Length(Line) > 0 and Real_Length(Line) < (Chars_Max * Lines_Max) then for Line_Window in 0 .. Integer'min(Real_Length(Line)/Chars_Max, Lines_Max) loop B_Inf := Line_Window*Chars_Max + 1; B_Sup := Integer'min((Line_Window + 1)*Chars_Max, Real_Length(Line)); begin if Real_length(Line) <= Chars_max then Draw_Text(Into, Line_Count + 1, 1, White, Line); else Draw_Text(Into, Line_Count + 1, 1, White, Line(B_Inf..B_Sup)); end if; end; Line_Count := Line_Count + 1; if Line_Count >= height then exit Print_Loop; end if; end loop; else Line_Count := Line_Count + 1; end if; end; if Line_Count > height then exit Print_Loop; end if; end loop Print_Loop; Total_Lines := Line_Count; return True; exception when others => return False; end Print_Set; procedure Open_Doc (Lines_Table : in out Wide_Set; Docume : out Docume_Access; Filename : in String) is File : W_Io.File_Type; Line_Last : Natural := 0; Dot_Index : Natural := 0; Owner_result : Wide_Result_Access; Success : Boolean := False; Errno : Integer := 0; begin Line_Last := 0; Set_Free(Lines_Table); if Os_Lib.Is_Regular_File(Filename) then W_Io.Open(File, W_Io.In_File, Filename, Form => "WCEM=8"); while not W_Io.End_Of_File(File) loop declare Wline : constant Wide_Access := new Wide_String ' (W_Io.Get_Line(File)); begin Lines_Table.Lines(Line_Last + 1) := Wline; Line_Last := Line_Last + 1; end; end loop; Lines_Table.Line_Last := Line_Last; W_Io.Close(File); Docume := new Docume_Record; Docume.Creation_Date := Time_Of(1970, 1, 1, 0.0); Docume.Last_Edition := Clock; Docume.Filename := new String ' (Filename); declare Dir : Dir_Name_Str := Dir_Name (Filename); begin case Os_Constants.Target_Os is when Os_Constants.Other_Os => Docume.Fullpath := new String ' (Dir & Dir_Separator & Base_Name(Filename)); Owner_Result := new Result_Record ' (M.Tools.Spawn("ls -l " & Docume.Filename.all, ".Out_File.txt")); if ( not ("="(Owner_Result, null)) and then (not "="(Owner_Result.Wlines, null))) then declare Line : constant Wide_String := (M.Results."-"(Owner_Result.Wlines(1))); Top : Natural := 0; Bot : Natural := 0; begin for I in 1..2 loop Top := Wide_Fixed.Index(Line(Top+1..Line'Last), " "); end loop; Bot := Wide_Fixed.Index(Line(Top+1..Line'Last), " "); Docume.Owner := new String ' (Handling.To_String(Line(Top+1..Bot-1))); end; end if; when Os_Constants.Windows => Docume.Fullpath := new String ' (Dir & Dir_Separator & Base_Name(Filename)); when others => null; end case; end; Dot_Index := Fixed.Index(Filename, "."); if Dot_Index /= 0 then Docume.Title := new String ' (Base_Name(Filename, Filename(Dot_Index..Filename'Last))); Docume.Unit := new String ' (Filename(Dot_Index+1..Filename'Last)); else Docume.Title := new String ' (Directories.Simple_Name(Filename)); Docume.Unit := new String ' (Directories.Simple_Name(Filename)); end if; Docume.Openned := True; Docume.Size := Set_Size(Lines_Table); else declare Not_Found : constant Wide_String := New_Wide_String("Open document : document not found.", "Press 'enter' to continue.", 30, lines/2-1, Columns/4-15, False); begin null; end; raise Spec_Error; end if; end Open_Doc; end M.Agence ;