⟦d062b98c4⟧

TextFile

-- Index --

package index is

type object is private;

procedure put (item : out object;index : in positive);
procedure show (item : in object);
function value(item : in object) return natural;
function image(item : in object) return string;

null_object : constant object;

private

type object is record
object : natural :=0;
end record;

null_object : constant object := 0

end;

package body index is

procedure put (item : out object;an_index : in positive) is

begin
	item.object := an_index;
end;

procedure show (item : in object) is

begin
	text_io.put_line("Index : Value : " & image(item.object));
end;


function value(item : in object) return natural is

begin
	return item.object;
end;

function image(item : in object) return string is

begin
	return natural'image(item.object);
end;

end;

-- index list --

with index,exclusive_list_generic;
package index_list is

type object is private;

procedure put(list: in out object;complement : in positive;ok : out boolean);
procedure show(list :in object);
procedure init(list : in out object);
procedure next(list : in out object);
function value(list : in object) return positive;
function done(list : in object) return boolean;

null_object : constant object; 

private

package i_list is new exclusive_list_generic (element => index.object,
null_element=>index.null_object,
show_element=>index.show,
element_image=>index.image);

null_iterator : i_list.iterator;

type object is record
object : i_list.list := i_list.null_object;
iterator : i_list.iterator := null_iterator;
end record;

null_object : constant object := (list => i_list.null_object,
iterator => null_iterator);
 
end;

with Text_Io;
package body index_list is

procedure put(list : in out object;complement : in positive;ok : out boolean) is

local_ok : boolean := false;
an_index := index.object;

begin
  index.put(an_index,complement);
  init(list);
  while not done(list) and not local_ok loop
  	local_ok := value(list) = an_index;
  	next(list);
  end loop;
  if not local_ok then    
    i_list.make(an_index,list.object);
  end if;
  ok:= not local_ok; 
end;
 
procedure show(list :in object) is

iterator : positive_list.iterator;

begin
 text_io.put_line("Index List : ");
 i_list.show(list.object);
end;

procedure init(list : in out object) is

begin
  i_list.init(list.iterator,list.object);
end;

procedure next(list : in out object) is

begin
  i_list.next(list.iterator);
end;

function value(list : in object) return positive is

begin
return index.value(i_list.value(list.iterator));
end;

function done(list : in object) return boolean is

begin
return i_list.done(list.iterator);
end;

end;

-- Animate List --

package Animate_list is

procedure put(animate_index : in positive;ok : out boolean);
procedure show;
procedure init;
procedure next;
function value return positive;
function done return boolean;

end;

with Text_Io,index_list;
                    
package body animate_list is

the_list : index_list.object := index_list.null_object;

procedure put(animate_index : in positive;ok : out boolean) is

begin
	index_list.put(the_list,animate_index,ok);
end;
 
procedure show is

begin
	text_io.put_line("Animate List :");
	index_list.show(the_list);
end;

procedure init is

begin
  index_list.init(the_list);
end;

procedure next is

begin
  index_list.next(the_list);
end;

function value return positive is

begin
return index_list.value(the_list);
end;

function done return boolean is

begin
return index_list.done(the_list);
end; 

end;

-- Total Actions --

package total_actions is

 procedure add_one;
 procedure show;
 function number return natural;
  
end;

with text_io;
                    
package body total_actions is

the_number_of_actions : natural := 0;

 procedure add_one is
 
 begin
   the_number_of_actions := the_number_of_actions + 1;
 end;
 
 procedure show is

 begin
 	 text_io.put_line("Total Actions : " & natural'image(the_number_of_actions));
 end;

 function number return natural is

 begin
   return the_number_of_actions; 
 end;

-- the hero --

package the_hero is

 procedure put(entity_index: in positive);
 procedure show;
 function index return natural;
  
end;

with text_io;
                    
package body the_hero is

the_hero_index : natural := 0;

 procedure put(entity_index: in positive) is
 
 begin
   the_hero_index := entity_index; 
 end;
 
 procedure show is

 begin
 	 text_io.put_line("The Hero : " & natural'image(the_hero_index));
 end;

 function index return natural is

 begin
   return the_hero_index; 
 end;

-- the place --

package the_place is

 procedure put(place_index: in positive);
 procedure show;
 function index return natural;
  
end;

with text_io;
                    
package body the_place is

the_place_index : natural := 0;

 procedure put(place_index: in positive) is
 
 begin
   the_place_index := place_index; 
 end;
 
 procedure show is

 begin
 	 text_io.put_line("The Place : " & natural'image(the_place_index));
 end;

 function index return natural is

 begin
   return the_place_index; 
 end;

end;

-- message array -- 

with identifier;
package Message_Array is

    procedure Put (message : in identifier.object;ok :out boolean);
    procedure Get (message : out identifier.object;key : in natural;ok :out boolean);
    function number_of return natural;
    procedure show;
    
end;

with generic_string_sort_array;
package body message_array is

package  mess_array is new Generic_String_Sort_Array
                  (Element => identifier.Object,
                   Max_Element_Number => 30,
                   Null_Element => identifier.Null_Object,
                   Get_Key => identifier.Name,
                   show_element => identifier.show;

    the_array : mess_array.object := mess_array.null_object;

    procedure Put (message : in identifier.object;ok :out boolean) is
   
     begin
      mess_array.put(the_array,message,ok);
    end;
    
    procedure Get (message : out identifier.object;key : in natural;ok :out boolean) is
    
    begin
      mess_array.get(the_array,message,key,ok);
    end;

    function number_of return natural;

    begin
      return mess_array.number_of(the_array);
    end;

    procedure show is
    
    begin
      text_io.put_line("Message Array :");
      mess_array.show(the_array);
    end;
        
end;

-- enumeration --

with Identifier, Generic_String_Sort_Array;
package Enumeration is

    type Object is private;

    procedure Put_name (item : in out Object; Name : in identifier.object);
    procedure Put_literal (item : in out Object;literal : in identifier.object;ok :out boolean);
--    procedure Get_literal (item : in Object;literal : out identifier.object;key : in natural;ok :out boolean);
    procedure show (item : in Object);

--procedure init(item : in out object);
--procedure next(item : in out object);
--function value(item : in object) return identifier;
--function done(item : in object) return boolean;

    function Name (item : in Object) return String;
    function literal_image(item : in Object;literal_index : in positive) return string;
    function literal (item: in object; literal : in string) return natural;
    function Belong(item : in object;literal : in string) return boolean;

    Null_Object : constant Object;
private
        package literal_Array is
           new Generic_String_Sort_Array
                  (Element => Identifier.Object,
                   Max_Element_Number => 20,
                   Null_Element => Identifier.Null_Object,
                   Get_Key => identifier.image,
                   show_element => Identifier.show);

    type Object is
        record
            Name : Identifier.Object := Identifier.Null_Object;
            The_Array : literal_Array.Object := literal_Array.Null_Object;

     --       iterator : literal_array.iterator;  --

        end record;

    Null_Object : constant Object :=
       (Name => Identifier.Null_Object,
        The_Array => literal_Array.Null_Object);

 --       iterator => literal_array.null_iterator); --

end Enumeration;

package enumeration is

    procedure Put_name (item : in out Object; Name : in identifier.object) is

    begin
      item.name:=name;
    end;
    
    procedure Put_literal (item : in out Object;literal : in identifier.object;ok :out boolean) is
   
    begin      
      literal_array.put(item.the_array,literal,ok);
    end;

--    procedure Get_literal (item : in Object;literal : out identifier.object;key : in natural;ok :out boolean) is
    
--    begin
--      literal_array.get(item.the_array,literal,key,ok);
--    end;
    
    procedure show (item : in Object)is
    
    begin
      text_io.put_line("Enumeration  : Name : " & name(item));
      literal_array.show(item.the_array);
    end;

--procedure init(item : in out object) is

--begin
--  literal_array.init(item.iterator,item.the_array);
--end;

--procedure next(item : in out object) is

--begin
--  literal_array.next(item.iterator);
--end;

--function value(item : in object) return identifier is

--begin
--return literal_array.value(item.iterator);
--end;

--function done(item : in object) return boolean is

--begin
--return literal_array.done(item.iterator);
--end; 
    
    function Name (item : in Object) return String is

    begin
			return identifier.image(item.name);    
		end;

    function literal(item : in Object;literal_index : in positive) return string;

		literal_identifier : identifier.object;
		exist : boolean;
		
	begin
    literal_array.get(item.the_array,literal_identifier,literal_index,exist);
		if exist then
			return identifier.image(literal_identifier);
		else
			return "";
		end;
	end;

    function literal (item: in object;literal : in string) return natural is
    
    begin
      return literal_array.index(item.the_array,literal);
    end;

    function Belong(item : in object;literal : in string) return boolean is

    begin
      return literal_array.belong(item.the_array,literal);
    end;

end;

-- enumeration array --

-- with identifier;
package Enumeration_Array is

    procedure Put_literal (enumeration_name,literal_name : in identifier.object;ok :out boolean);
--    procedure Get_literal (enumeration_name: in string;literal : out identifier.object;key : in positive;ok :out boolean);
--    procedure Get_literal (enumeration_index: in positive;literal : out identifier.object;key : in positive;ok :out boolean);
    procedure show;
    function literal_image(enumeration_index,literal_index : in positive) return string;
    function enumeration (enumeration_name : in string) return natural;
    function literal (enumeration_indexex : in natural;literal_name : in string) return natural;
    function enumeration_Belong (enumeration_name : in string) return boolean;
    function literal_Belong (enumeration_index : in natural;literal_name : in string) return boolean;

end;

with text_io,enumeration,generic_string_sort_array;
                    
package body enumeration_array is

package    enum_array is new Generic_String_Sort_Array
                  (Element => Enumeration.Object,
                   Max_Element_Number => 30,
                   Null_Element => Enumeration.Null_Object,
                   Get_Key => Enumeration.Name,
                   show_Element => Enumeration.show);

    the_array : enum_array.object := enum_array.null_object;
    
    procedure Put_literal (enumeration_name,literal_name : in identifier.object;ok : out boolean) is
    
    an_enumeration: enumeration.object;
    
    begin
      enum_array.get(the_array,an_enumeration,identifier.image(enumeration_name),ok);
      if not ok then
      	enumeration.put_name(an_enumeration,enumeration_name);
      end if;
      enumeration.put_literal(an_enumeration,literal_name,ok);
      if ok then
      	enum_array.put(the_array,an_enumeration);            	
      end if;
    end;
    
--   procedure Get_literal (enumeration_name : in string;literal : out identifier.object;key : in positive;ok : out boolean) is
   
--   an_enumeration: enumeration.object;
   
--   begin
--     enum_array.get(the_array,an_enumeration,enumeration_name,ok);
--   	 if ok then
--   		enumeration.get_literal(an_enumeration,literal,key,ok);
--   	end if;
--   end;

--   procedure Get_literal (enumeration_index: in positive;literal : out identifier.object;key : in positive;ok : out boolean) is
    
--   an_enumeration: enumeration.object;
   
--   begin
--     enum_array.get(the_array,an_enumeration,enumeration_index,ok);
--   	 if ok then
--   		enumeration.get_literal(an_enumeration,literal,key,ok);
--   	end if;
--   end;

  procedure show is

	begin
		text_io.put_line("Enumeration Array :");
		enum_array.show(the_array);
	end;

    function literal_image(enumeration_index,literal_index : in positive) return string is

    an_enumeration : enumeration.object;
    exist : boolean;
    
    begin
      enum_array.get(the_array,an_enumeration,enumeration_index,exist);
   	  if exist then
   		  return enumeration.literal_image(an_enumeration,literal_index);
   	  else
   	  	return "";
   	  end if;			   	
    end;

    function enumeration (enumeration_name : in string) return natural is
    
    begin
      return enum_array.index(the_array,enumeration_name); 
    end;

    function literal (enumeration_index : in natural;literal_name : in string) return natural is
    
   an_enumeration: enumeration.object;
   exist : boolean;

    begin
     enum_array.get(the_array,an_enumeration,enumeration_index,exist);
   	 if exist then
   		return enumeration.literal (an_enumeration,literal_name);
   	else
   	  return 0;
   	 end if;
    end;

    function enumeration_Belong (enumeration_name : in string) return boolean is

begin
   		 return enum_array.belong(the_array,enumeration_name);
end;
    
    function literal_Belong(enumeration_index : in natural;literal_name : in string) return boolean is

   an_enumeration: enumeration.object;
   exist : boolean;

   begin
     enum_array.get(the_array,an_enumeration,enumeration_index,exist);
   	 if exist then
   		 return enumeration.belong(an_enumeration,literal_name);
   	 else
   	   return false;
   	 end if;
	 end;

-- verb array --

package Verb_Array is

procedure Put (verb_name : in identifier.object;number : in positive;ok :out boolean);
procedure show;
function number(verb_name : in string) return natural;
    
end;

with text_io,verb,generic_string_sort_array;
                    
package body verb_array is

package    v_array is new Generic_String_Sort_Array
                  (Element => verb.Object,
                   Max_Element_Number => 100,
                   Null_Element => verb.Null_Object,
                   Get_Key => verb.Name,
                   show_element => verb.show;

    the_array : v_array.object := v_array.null_object;

    procedure Put (verb_name : in identifier.object;number : in positive;ok :out boolean) is
    
    begin
      v_array.put(the_array,verb_name,ok);
    end;
        
    procedure show is
    
    begin
      text_io.put_line("Verb Array :");
      v_array.show(the_array);
    end;

    function number(verb_name : in string) return natural is
        
    begin
      return v_array.index(the_array,verb_name); 
    end;
        
end;

-- group --

with identifier,index_list;
package group is

type object is private;

procedure put_name(item : in out object;name : in identifier.object);
procedure put_subject(item : in out object;subject_index : in positive;ok : out boolean);
procedure show(item :in object);
function name(item : in object) return string;

procedure list_init(item : in out object);
procedure list_next(item : in out object);
function list_value(item : in object) return positive;
function list_done(item : in object) return boolean;


null_object : constant object; 

private

type object is record
name : identifier.object := identifier.null_object; 
the_list : index_list.object := index_list.null_object;
end record;

null_object : constant object := (name => identifier.null_object,
the_list => index_list.null_object);
 
end;

with Text_Io;
package body group is

procedure put_name(item : in out object;name : in identifier.object) is

begin
 item.name:=name;
end;

procedure put_subject(item : in out object;subject_index : in positive;ok : out boolean) is

begin
	index_list.put(item.the_list,subject_index,ok);
end;

function name(item : in object) return string is

begin
  return identifier.image(item.name);
end;
 
procedure show(item :in object) is

begin
 text_io.put_line ("Group : Name : " & name(item));
 index_list.show(item.the_list);
end;

procedure list_init(item : in out object) is

begin
  index_list.init(item.the_list);
end;


procedure list_next(item : in out object) is

begin
  index_list.next(item.the_list);
end;

function list_value(item : in object) return positive is

begin
return index_list.value(item.the_list);
end;

function list_done(item : in object) return boolean is

begin
return index_list.done(item.the_list);
end; 

end;

package group_Array is

max_element : constant positive;

    procedure Put (group_name : in identififer.object;subject_index : in positive;ok :out boolean);
    procedure show;
		procedure list_init(group_name : in string);
		procedure list_next(group_name : in string);
		function list_value(group_name : in string) return natural;
		function list_done(group_name : in string) return boolean;
		function belong(group_name : in string) return boolean;
    
end;

with text_io,group,generic_string_sort_array;
package body group_array is

max_element : constant positive := 200;

package    g_array is new Generic_String_Sort_Array
                  (Element => group.Object,
                   Max_Element_Number => max_element,
                   Null_Element => group.Null_Object,
                   Get_Key => group.Name,
                   show_element => group.show;

    the_array : g_array.object := g_array.null_object;

    procedure Put (group_name : in identifier.object;subject_index : in positive;ok :out boolean) is
    
    a_group : group.object;
    local_ok:boolean;
    
    begin
      g_array.get(the_array,a_group,identifier.image(group_name),local_ok);
      if not local_ok then
      	group.put_name(a_group,group_name);
      end if;
  		group.put_complement(a_group,subject_index,local_ok);
      if local_ok then
      	g_array.put(the_array,a_group);            	
      end if;
      ok:=local_ok;
end;

    procedure show is
    
    begin
      text_io.put_line("Group Array :");
      g_array.show(the_array);
    end;
    
procedure list_init(group_name : in string) is

    a_group : group.object;
    local_ok : boolean;

begin
  g_array.get(the_array,a_group,group_name,local_ok);
  if local_ok then
    group.list_init(a_group);
  end if;
end;

procedure list_next(group_name : in string) is

    a_group : group.object;
    local_ok : boolean;

begin
  g_array.get(the_array,a_group,group_name,local_ok);
  if local_ok then
    group.list_next(a_group);
  end if;
end;

function list_value(group_name : in string) return natural is

    a_group : group.object;
    local_ok : boolean;

begin
  g_array.get(the_array,a_group,group_name,local_ok);
  if local_ok then
    return group.list_value(a_group);
  else
    return 0;
  end if;
end;

function list_done(group_name : in string) return boolean is

    a_group : group.object;
    local_ok : boolean;

begin
  g_array.get(the_array,a_group,group_name,local_ok);
  if local_ok then
    return group.list_done(a_group);
  else
    return true;
  end if;
end;

		function belong(group_name : in string) return boolean is
		
		begin
		return g_array.belong(the_array,group_name);
    end;
        
end;

-- Escape --

package Escape is

    type Object is private;

    procedure Put (Item : out Object;place,direction : in positive);
    procedure Show (Item : in Object);
    function Place (Item : in Object) return Natural;
    function Direction (Item : in Object) return Natural;

    Null_Object : constant Object;

private
    type Object is
        record
            Place : Natural := 0;
            Direction : Natural := 0;
        end record;

    Null_Object : constant Object := (place => 0, Direction => 0);

end Escape;

with text_io;
package body escape is

    procedure Put (Item : out Object;place,direction : in positive) is

    begin
item.place := place;
item.direction := direction;
    end;
    
    procedure show (Item : in Object) is

    begin
text_io.put_line("Escape : Place : " & natural'image(place(item)) & 
" Direction : " & natural'image(direction(item)));
    end;

    function place (Item : in Object) return Natural is

    begin
			return item.place;
    end;

    function Direction (Item : in Object) return Natural is

    begin
      return item.repeat;
    end;

end;

-- Link --

with escape;
package link is

	type Object is private;
    
    procedure Put (Item : in out Object;name,start_place,start_direction,
    next_place,next_direction : in positive);
--    procedure Put_enumerate (Item : in out Object;enumeration,literal : in positive);
--    procedure Put_start_escape (Item : in out Object;place,direction : in positive);
--    procedure Put_next_escape (Item : in out Object;place,direction : in positive);
    procedure show (Item : in Object);
    function key (Item : in Object) return string;
    function Name (Item : in Object) return Natural;
--    function Enumeration (Item : in Object) return Natural;
--    function Literal (Item : in Object) return Natural;
		function start_direction(item : in object) return natural;
		function next_direction(item : in object) return natural;
		function start_place(item : in object) return natural;
		function next_place(item : in object) return natural;

    Null_Object : constant Object;

private

    type Object is
        record
            Name : Natural := 0;
--            Enumeration : Natural := 0;
--            Literal : Natural := 0;
            start_Escape : Escape.Object := Escape.Null_Object;
            next_Escape : Escape.Object := Escape.Null_Object);
                    
end record;

    Null_Object : constant Object := (Name => 0,
          --                          Enumeration => 0,
            --                       Literal => 0,
                                      start_Escape => Escape.Null_Object,
                                   next_Escape => Escape.Null_Object);

end Link;

with text_io;
package body link is

    procedure Put (Item : in out Object;name,start_place,start_direction,
    next_place,next_direction : in positive) is
  
    begin
    item.name := name;    
   		escape.put_place(item.start_escape,start_place,start_direction);
   		escape.put_place(item.next_escape,next_place,next_direction);
    end;

--    procedure Put_enumerate (Item : in out Object;enumeration,literal : in positive) is

--    begin
--      item.enumeration := enumeration;
--      item.literal := literal;      
--    end;
    
    procedure Put_start_escape (Item : in out Object;place,direction : in positive) is
  
    begin
   		escape.put_place(item.start_escape,place,direction);
    end;

    procedure Put_next_escape (Item : in out Object;place,direction : in positive) is
  
    begin
    	escape.put(item.next_escape,place,direction);
    end;

    procedure show (Item : in Object) is
  
    begin
    text_io.put_line ("Link : Name : " & natural'image(name(item));
--    " Enumeration : " & natural'image(enumeration(item)) &
--    " Literal : " & natural'image(literal(item));
    escape.show(item.start_escape);
    escape.show(item.next_escape);
    end;

    function key (Item : in Object) return string is
    
    begin
		return natural'image(start_direction);
		end;
		
    function Name (Item : in Object) return Natural is
  
    begin
      return item.name;
    end;

--    function Enumeration (Item : in Object) return Natural is

--    begin
--      return item.enumeration;   
--    end;

--    function Literal (Item : in Object) return Natural is
  
--    begin
--      return item.literal;         
--    end;

		function start_direction(item : in object) return natural is

    begin
      return escape.direction(item.start_escape);
    end;

		function next_direction(item : in object) return natural is

    begin
      return escape.direction(item.next_escape);
    end;

		function start_place(item : in object) return natural is

    begin
      return escape.place(item.start_escape);        
    end;

		function next_place(item : in object) return natural is

    begin
      return escape.place(item.next_escape);        
    end;

end;

-- Field --

with Identifier;
package Field is

type Field_kind is (Number, Sentence, Enumerate, Unknown);  
   
    type Object (Kind : Field_kind := Unknown) is private;

--    procedure create_number(item : out object;name: in string);
--    procedure create_sentence(item : out object;name: in string);
--    procedure create_enumerate(item : out object;name: in string);

    procedure create_number(item : out object;index: in positive);
    procedure create_sentence(item : out object;index: in positive);
    procedure create_enumerate(item : out object;index: in positive);
    procedure Put_number (Item : in out Object;number : in integer; ok : out boolean);
    procedure Put_sentence (Item : in out Object;sentence : in string; ok : out boolean);
    procedure Put_enumerate (Item : in out Object;enumeration,literal : in positive; ok : out boolean);
    procedure show (Item : in Object);
    function index (Item : in Object) return natural;
    function index (Item : in Object) return String;
function field_is_a_number (item : in object) return boolean;
function field_is_a_sentence (item : in object) return boolean;
function field_is_an_enumerate (item : in object) return boolean;
    function number (Item : in Object) return Integer;
    function sentence (Item : in Object) return String;
    function Enumeration (Item : in Object) return Natural;
    function Literal (Item : in Object) return Natural;

    Null_Object : constant Object;

private

    type Object (Kind : Field_Kind := Unknown) is
        record
            case Kind is
                when Number =>
--                    Number_Name : Identifier.Object := Identifier.Null_Object;
number_index: natural :=0;
                    Number_Value : Integer := 0;
                when Sentence =>
--                    Sentence_Name : Identifier.Object := Identifier.Null_Object;
sentence_index:natural:=0;
                    Sentence_Value : Identifier.Object :=
                       Identifier.Null_Object;
                when Enumerate =>
--                    Enumerate_Name : Identifier.Object :=
--                        Identifier.Null_Object;
enumerate_index:natural:=0;
                    Enumeration : Natural := 0;
                    Literal : Natural := 0;
                when Unknown =>
                    null;
            end case;
        end record;

    Null_Object : constant Object := (Kind => Unknown);

end Field;

with text_io;
package body field is

--    procedure create_number(item : out object;name : in string) is
    
--    begin
--    	item := (kind =>number,number_name=>identifier.from_string(name),number_value=>0);
--    end;  
    
--    procedure create_sentence(item : out object;name: in string) is
    
--    begin
--    item := (kind =>sentence,sentence_name=>identifier.from_string(name),sentence_value=>identifier.null_object);    
 --   end;
    
--    procedure create_enumerate(item : out object;name: in string) is
    
--    begin
--    	item:=(kind=>enumerate,enumerate_name=>identifier.from_string(name),enumeration=>0,literal=>0);
--    end;

    procedure create_number(item : out object;index : in positive) is
    
    begin
    	item := (kind =>number,number_index=>index,number_value=>0);
    end;  
    
    procedure create_sentence(item : out object;index: in positive) is
    
    begin
    item := (kind =>sentence,sentence_index=>index,sentence_value=>identifier.null_object);    
    end;
    
    procedure create_enumerate(item : out object;index: in positive) is
    
    begin
    	item:=(kind=>enumerate,enumerate_index=>index,enumeration=>0,literal=>0);
    end;
    
    procedure Put_number (Item : in out Object;number : in integer; ok : out boolean) is
    
    begin
      if item.kind = number then
        item.number_value := number
        ok := true;
      else
        ok:=false;
      end if;
    end;
    
    procedure Put_sentence (Item : in out Object;sentence : in string; ok : out boolean) is

    begin
      if item.kind = sentence then
        identifier.put(item.sentence_value,sentence);
        ok := true;
      else
        ok:=false;
      end if;
    end;

    procedure Put_enumerate (Item : in out Object;enumeration,literal : in positive; ok : out boolean) is

    begin
      if item.kind = enumerate then
        item.enumeration := enumeration;
        item.literal := literal;
        ok := true;
      else
        ok:=false;
      end if;
    end;

    procedure show (Item : in Object) is
    
    begin
    text_io.put("Field : Kind : " & field_kind'image(item.kind));
    case item.kindis
    when nunber =>
    	text_io.put_line(" Name : " & name(item) & " Value : " & integer'image(number(item)));
    when sentence =>
    	text_io.put_line(" Name : " & name(item) & " Value : " & sentence(item));    
    when enumerate =>
    	text_io.put_line(" Name : " & name(item) & " Enumeration : " & 
    	natural'image(enumeration(item)) & " Literal : " & 
    	natural'image(literal(item)));
    when unknown=>
    	new_line;
    end case;
    end;
    

function index(Item : in Object) return natural is
    
    begin
     case item.kind is
     when number =>
       return number_index;
     when sentence =>
       return sentence_index;
     when enumerate =>
       return enumerate_index;
    when unknown =>
    return 0;
    end case;
    end;

function index (Item : in Object) return String is
    
    begin
    	return natural'image(index(item));
    end;

function field_is_a_number (item : in object) return boolean is

begin
	return item.kind = number;
end;
	
function field_is_a_sentence (item : in object) return boolean is

begin
	return item.kind = sentence;
end;

function field_is_an_enumerate (item : in object) return boolean is

begin
	return item.kind = enumerate;
end;
    
function number (Item : in Object) return Integer is

    begin
     if item.kind = number then
       return item.number_value;
     else
      return 0;
     end if;
    end;
    
function sentence (Item : in Object) return String is
    
    begin
     if item.kind = sentence then
       return identifier.image(item.sentence_value);
     else
       return "";
     end if;
   end;
    
function Enumeration (Item : in Object) return Natural is
    
 begin 
  if item.kind = enumerate then
  	return item.enumeration;
  else
    return 0;
  end if;

function literal (Item : in Object) return Natural is
    
 begin 
  if item.kind = enumerate then
  	return item.literal;
  else
    return 0;
  end if;
end;

end;

-- complement  --

with field,link,identifier,generic_string_sort_array,list_generic,
exclusive_generic_list;
package complement is

type complement_kind is (animate,place,entity,word,verb,unknown);

type object(kind : every_kind := unknown) is private;

procedure copy(input_item: in object;output_object : out object);
procedure put_name(item : in out object;name : in identifier.object;ok : out boolean); 
procedure put_word(item : out object;word : in identifier.object);
procedure put_verb(item : out object;verb : in identifier.object;number : in positive);

--procedure create_number_field(item : out object;field_name: in string; ok : out boolean);
--procedure create_sentence_field(item : out object;field_name: in string; ok : out boolean);
--procedure create_enumerate_field(item : out object;field_name: in string; ok : out boolean);
--procedure field_Put_number (Item : in out Object;field_name: in string;number : in integer; ok : out boolean);
--procedure field_Put_sentence (Item : in out Object;field_name: in string;sentence : in string; ok : out boolean);
--procedure field_Put_enumerate (Item : in out Object;field_name: in string;enumeration,literal : in positive; ok : out boolean);

procedure create_number_field(item : out object;field_index: in positive; ok : out boolean);
procedure create_sentence_field(item : out object;field_index: in positive; ok : out boolean);
procedure create_enumerate_field(item : out object;field_index: in positive; ok : out boolean);
procedure field_Put_number (Item : in out Object;field_index: in positive;number : in integer; ok : out boolean);
procedure field_Put_sentence (Item : in out Object;field_index: in positive;sentence : in string; ok : out boolean);
procedure field_Put_enumerate (Item : in out Object;field_index: in positive;enumeration,literal : in positive; ok : out boolean);

procedure put_movement(item : in out object;place : in positive); 
procedure movement_init(item : in out object); dans corps
procedure move(item : in out object); 

procedure put_exit(item : in out object;name,start_place,start_direction,
next_place,next_direction : in positive;ok : out boolean);
--procedure put_exit(item : in out object;name,start_place,start_direction,
--next_place,next_direction : in positive;ok : out boolean);
--procedure exit_put_enumerate(item : in out object;enumeration,literal: in positive;ok : out boolean);
function exit_exist(item : in out object;direction : in positive) return boolean;
function exits_exist(item : in object) return boolean;
--function exit_enumeration(item : in out object;direction : in positive) return natural;
--function exit_literal(item : in out object;direction : in positive) return natural;
function exit_name(item : in out object;direction : in positive) return natural;
function next_place(item : in out object;direction : in positive) return natural;
function next_direction(item : in out object;direction : in positive) return natural;

procedure put_place(item : in out object;place : in natural;ok : out boolean);
procedure show(item :in object);

procedure list_exits_init(item : in out object);
procedure list_exits_next(item : in out object);
function list_exits_name(item : in out object) return natural;
function list_exits_done(item : in out object) return boolean;

--function field_is_a_number (item : in object;field_name : in string) return boolean;
--function field_is_a_sentence (item : in object;field_name : in string) return boolean;
--function field_is_an_enumerate (item : in object;field_name : in string) return boolean;
--function field_exist (item : in object;field_name : in string) return boolean;

function field_is_a_number (item : in object;field_index : in positive) return boolean;
function field_is_a_sentence (item : in object;field_index : in positive) return boolean;
function field_is_an_enumerate (item : in object;field_index : in positive) return boolean;
function field_exist (item : in object;field_index : in positive) return boolean;

function is_a_subject(item : in object) return boolean;
function is_an_animate(item : in object) return boolean;
function is_a_place(item : in object) return boolean;
function is_an_entity(item : in object) return boolean;
function is_a_word(item : in object) return boolean;
function is_a_verb(item : in object) return boolean;

function name (item : in object) return string;
function place (item : in object) return natural; 
--function field_number (Item : in Object,field_name:in string) return Integer;
--function field_sentence (Item : in Object,field_name:in string) return String;
--function field_Enumeration (Item : in Object,field_name:in string) return Natural;
--function field_Literal (Item : in Object,field_name:in string) return Natural;

function field_number (Item : in Object,field_index:in positive) return Integer;
function field_sentence (Item : in Object,field_index:in positive) return String;
function field_Enumeration (Item : in Object,field_index:in positive) return Natural;
function field_Literal (Item : in Object,field_index:in positive) return Natural;
function verb_number (Item : in Object) return natural;

null_object : constant object;
animate_object : constant object;
place_object : constant object;
entity_object : constant object;

private
--package field_array is new generic_string_sort_array(
--				element =>field.object,
--				max_element_number =>10,
--				null_element => field.null_object,
--				element_image => field.image,
--				get_key =>field.name);

package field_list is new exclusive_list_generic (element => field.object,
null_element=>field.null_object,
show_element=>field.show,
get_key=>field.index);

package place_list is new list_generic (element => positive);

package link_list is new list_generic (element => link.object,
null_element=>link.null_object,
show_element=>link.show,
get_key=>link.key);

null_trip_iterator : place_list.iterator;  -- tester dans boucle
null_exits_iterator : link_list.iterator;

type object(kind : complement_kind := unknown) is record
case kind is
when animate =>
   animate_name : identifier.object := idenfitifier.null_object;
--    animate_fields : field_array.object := field_array.null_object;
    animate_fields : field_list.list := field_list.null_object;
		animate_place : natural :=0;
    trip : place_list.list := place_list.nil;
    trip_iterator : place_list.iterator := null_trip_iterator ;
when place =>
  place_name : identifier.object := idenfitifier.null_object;
--  place_fields : field_array.object := field_array.null_object;
  place_fields : field_list.list := field_list.nuLL_object;
 	exits : link_list.list :=link_list.nil;
  exits_iterator : link_list.iterator :=null_exits_iterator;
when entity =>
 entity_name : identifier.object := idenfitifier.null_object;
-- entity_fields : field_array.object := field_array.null_object;
 entity_fields : field_list.list := field_list.null_object;
 entity_place : natural :=0; 
 when word =>
 word_value : identifier.object := idenfitifier.null_object;
when verb =>
	verb_name : identifier.object := identifier.null_object;
	number : natural :=0;
when unknown =>
	null;
end case;
end record;

null_object : constant object := (kind => unknown);

animate_object : constant object, := (kind =>animate,
   animate_name =>idenfitifier.null_object,   
--    animate_fields => field_array.null_object,
    animate_fields => field_list.null_object,
		animate_place =>0,
    trip => place_list.nil,
    trip_iterator =>null_trip_iterator);

  place_object : constant object := (kind=>place,
  place_name => idenfitifier.null_object,
--  place_fields => field_array.null_object,
  place_fields => field_list.null_object,
 	exits =>link_list.null_object,
  exits_iterator =>null_exits_iterator);

 entity_object : constant object := (kind =>entity,
 entity_name =>idenfitifier.null_object,
-- entity_fields => field_array.null_object,
 entity_fields => field_list.null_object,
 entity_place =>0);

end;

with Text_Io;
                    
package body complement is

procedure copy(input_item: in object;output_item : out object) is

begin
  output_item:=input_item;
case item.kind is
	 when animate => 
--output_item := (kind =>animate,
--   animate_name =>input_item.animate_name,   
--    animate_fields => field_array.null_object,
--    animate_fields => field_list.null,
--		animate_place => input_item.animate_place,
--    trip => place_list.nil,
--    trip_iterator =>null_trip_iterator);

  field_list.free(output_item.animate_fields);
  field_list.copy(input_item.animate_fields,output_item.animate_fields);
  
	 when place => 
--  output_item := (kind=>place,
--  place_name => input_item.place_name,
--  place_fields => field_array.null_object,
--  place_fields => field_list.nil,
-- 	exits =>link_list.nil,
--  exits_iterator =>null_exits_iterator);

  field_list.free(output_item.place_fields);
  field_list.copy(input_item.place_fields,output_item.place_fields);

--  field_list.free(output_item.exist);
--  field_list.copy(input_item.exits,output_item.exits);

	 when entity => 
-- output_item := (kind =>entity,
-- entity_name =>input_item.entity_name,
-- entity_fields => field_array.null_object,
-- entity_fields => field_list.nil,
-- entity_place => input_item.entity_place);

  field_list.free(output_item.entity_fields);
  field_list.copy(input_item.entity_fields,output_item.entity_fields);

	 when word | verb | unknown =>
 	   null;
 	 end case;
 
end;

procedure put_name(item : in out object;name : in identifier.object;ok : boolean) is

begin
 	   ok := true;
case item.kind is
	 when animate => 
     item.animate_name:=name;
	 when place => 
     item.place_name:=name;
	 when entity => 
     item.entity_name:=name;
	 when word | verb | unknown =>
 	   ok := false;
 	 end case;
end;

procedure put_word(item : out object;word : in identifier.object) is

begin
  item := (kind=>word,word_value=>word);
end;

procedure put_verb(item : out object;verb : in identifier.object;number : in positive) is

begin
  item := (kind=>verb,verb_name=>verb,number=>number);
end;

--procedure get_field(item : in out object;a_field : out field.object;field_name:in string; ok : out boolean) is

--begin
-- case item.kind is
-- when animate =>
-- field_array.get(item.animate_fields,a_field,field_name,ok);
-- when place =>
-- field_array.get(item.place_fields,a_field,field_name,ok);
-- when entity=>
-- field_array.get(item.entity_fields,a_field,field_name,ok);
-- when word | verb | unknown=>
-- ok := false;
-- end case;
--end;

procedure get_fields(item : in object;list : out field_list;ok : out boolean) is

begin
 ok:=true;
 case item.kind is
 	when animate =>
 	list := item.animate_fields;
 	when place =>
 	list := item.place_fields;
 	when entity=>
 	list := item.entity_fields;
 	when word | verb | unknown=>
 	ok := false;
 end case;
end;
 
--procedure get_field(item : in object;a_field : out field.object;field_name: in string; ok : out boolean) is
procedure get_field(item : in object;a_field : out field.object;field_index: in positive; ok : out boolean) is

list : field_list;
local_ok : boolean;

begin
 get_fields(item,list,local_ok);
 if local_ok then 
		field_list.get(list,a_field,natural'image(field_index),ok);
 else
 	ok:=false;
 end if;
end;

procedure put_field(item : in object;a_field : out field.object) is

list : field_list;
local_ok : boolean;

begin
 			get_fields(item,list,local_ok);
 			if local_ok then
 				field_list.put(list,a_field);
 			end if;
end;

--procedure put_field(item : in out object;a_field : in field.object) is

--begin
-- case item.kind is
-- when animate =>
-- field_array.put(item.animate_fields,a_field);
-- when place =>
-- field_array.put(item.place_fields,a_field);
-- when entity=>
-- field_array.put(item.entity_fields,a_field);
-- when word | verb | unknown=>
-- null;
-- end case;
--end;


--    procedure create_number_field(item : out object;field_name: in string; ok : out boolean) is
    procedure create_number_field(item : out object;field_index: in positive; ok : out boolean) is
    
    a_field : field.object;
    
    begin
--      	 if is_a_subject(item) and not field_exist(item,field_name) then
      	 if is_a_subject(item) and not field_exist(item,field_index) then
--      	 field.create_number(a_field,field_name);
      	 field.create_number(a_field,field_index);
		 	   put_field(item,a_field);
		 	   ok:=true;
		 	   else
		 	   ok:=false;
		 	   end if;
    end;
    
--    procedure create_sentence_field(item : out object;field_name: in string; ok : out boolean);
    procedure create_sentence_field(item : out object;field_index: in positive; ok : out boolean);

    a_field : field.object;
 
    begin
--      	 if is_a_subject(item) and not field_exist(item,field_name) then
      	 if is_a_subject(item) and not field_exist(item,field_index) then
--      	   field.create_sentence(a_field,field_name);
      	   field.create_sentence(a_field,field_index);
		 	     put_field(item,a_field);
		 	   ok:=true;
		 	   else
		 	   ok:=false;
		 	   end if;
    end;

--    procedure create_enumerate_field(item : out object;field_name: in string; ok : out boolean);
    procedure create_enumerate_field(item : out object;field_index: in positive; ok : out boolean);

    a_field : field.object;
    
    begin
--      	 if is_a_subject(item) and not field_exist(item,field_name) then
      	 if is_a_subject(item) and not field_exist(item,field_name) then
--      	   field.create_enumerate(a_field,field_name);
      	   field.create_enumerate(a_field,field_index);
		 	     put_field(item,a_field);
		 	   ok:=true;
		 	   else
		 	   ok:=false;
		 	   end if;
    end;

--    procedure field_Put_number (Item : in out Object;field_name: in string;number : in integer; ok : out boolean);
    procedure field_Put_number (Item : in out Object;field_index: in positive;number : in integer; ok : out boolean);

    a_field : field.object;
 local_ok : boolean;

    begin
--			get_field(item,a_field,field_name,local_ok);
			get_field(item,a_field,field_index,local_ok);
 			if local_ok then
       field.put_number(a_field,number,local_ok);
       if local_ok then
		 	 	 put_field(item,a_field);
		   end if;
		  end if;
		  ok:=local_ok;
    end;

--    procedure field_Put_sentence (Item : in out Object;field_name: in string;sentence : in string; ok : out boolean);
    procedure field_Put_sentence (Item : in out Object;field_index: in positive;sentence : in string; ok : out boolean);

    a_field : field.object;
 local_ok : boolean;
    
    begin
--			 get_field(item,a_field,field_name,local_ok);
			 get_field(item,a_field,field_index,local_ok);
 			 if local_ok then
      	   field.put_sentence(a_field,sentence,local_ok);
      	   if local_ok then
		 	       put_field(item,a_field);
		   		 end if;
			end if;
			ok:=local_ok;
    end;

--    procedure field_Put_enumerate (Item : in out Object;field_name: in string;enumeration,literal : in positive; ok : out boolean);
    procedure field_Put_enumerate (Item : in out Object;field_index: in positive;enumeration,literal : in positive; ok : out boolean);

    a_field : field.object;
 local_ok : boolean;
    
    begin
--			 get_field(item,a_field,field_name,local_ok);
			 get_field(item,a_field,field_index,local_ok);
 			 if local_ok then
      	 field.put_enumerate(a_field,enumeration,literal,local_ok);
      	 if local_ok then
		 	     put_field(item,a_field);
		   	 end if;
		   end if;
 ok:=local_ok;
    end;


procedure put_movement(item : in out object;place : in positive) is

begin
  if item.kind = animate then
    place_list.make(place,item.trip);
	end if;
end;


procedure movement_init(item : in out object) is

-- utile  ?? -- 

begin
  if item.kind = animate then
    place_list.init(item.trip_iterator,item.trip);
  end if;
end;


procedure move(item : in out object) is

begin
  if item.kind = animate then
    if not place_list.done(item.trip_iterator);
      item.animate_place:=place_list.value(item.trip_iterator);
      place_list.next(item.trip_iterator);
		else
    	place_list.init(item.trip_iterator,item.trip);

--      item.animate_place:=place_list.value(item.trip_iterator);
	-- pb si liste vide !!

		end if;
  end if;
end;

function exit_exist(item: in object;direction : in positive) return boolean is

begin
  if item.kind = place then
return link_list.belong(item.exits,positive'image(direction));
   else
 return false;
end if;
end;

function exits_exist(item : in object) return boolean is

begin
  if item.kind = place then
return not link_list.is_empty(item.exits);
   else
 return false;
end if;
end;


procedure put_exit(item : in out object;name,start_place,start_direction,
next_place,next_direction : in positive;ok : out boolean) is

a_link : link.object;
local_ok : boolean;

begin
  if not exit_exist (item,start_direction) then
  	  link.put(a_link,name,start_place,start_direction,next_place,next_direction);
  	  link_list.put(item.exits,a_link);
 	  	ok := true;
  else
    ok := false;
  end if;
end;

--procedure put_exit(item : in out object;name,start_place,start_direction,
--next_place,next_direction : in positive;ok : out boolean);

--a_link : link.object;

--begin
--  if item.kind = place then
--  	  link.put_name(a_link,name);
--  	  link.put_start_escape(a_link,start_place,start_direction);
--  	  link.put_next_escape(a_link,next_place,next_direction);
-- link_list.put(item.exits,a_link,ok);
--  else
--  ok:=false;
--  end if;
--end;

--procedure exit_put_enumerate(item : in out object;direction,numeration,literal: in positive;ok : out boolean);

--a_link : link.object;
--local_ok : boolean;

--begin
-- found_link(item,a_link,direction,local_ok);
-- if local_ok then
--  	 link.put_enumerate(a_link,enumeration,literal);
--  	 link_list.put(item.exits,a_link);
--  	 ok:=true;
-- else
--	ok := false;
--end if;
--end;

function exit_enumeration(item : in out object;direction : in positive) return natural is

a_link : link.object;
local_ok : boolean;

begin
 found_link(item,a_link,direction,local_ok);
 if local_ok then
	 return link.enumeration(a_link);
 else
 	return 0;
 end if;
end;

function exit_literal(item : in out object;direction : in positive) return natural is

a_link : link.object;
local_ok : boolean;

begin
 found_link(item,a_link,direction,local_ok);
 if local_ok then
	 return link.literal(a_link);
 else
 	return 0;
end if;
end;

function exit_name(item : in out object;direction : in positive) return natural is

a_link : link.object;
local_ok : boolean;

begin
 if item.kind = place then
 link_list.get(item.exits,a_link,positive'image(direction),local_ok);
 if local_ok then
	 return link.name(a_link);
 else
 	return 0;
 end if;
 return 0;
 end if;
end;

function next_place(item : in out object;direction : in positive) return natural is

a_link : link.object;
local_ok : boolean;

begin
 if item.kind = place then
 link_list.get(item.exits,a_link,positive'image(direction),local_ok);
 if local_ok then
	 return link.next_place(a_link);
 end if;
 end if;
 return 0;
end;

function next_direction(item : in out object;direction : in positive) return natural is

a_link : link.object;
local_ok : boolean;

begin
 if item.kind = place then
 link_list.get(item.exits,a_link,positive'image(direction),local_ok);
 if local_ok then
	 return link.direction_place(a_link);
 else
 end if;
 end if;
	return 0;
end;

procedure put_place(item : in out object;place : in natural;ok : out boolean) is

begin
 	     if item.kind = animate  then
         item.animate_place:=place;
    	   ok:= true;
 	    elsif item.kind = entity then
 		    item.entity_place:=place;
        ok:=true;
 	   else
  	    ok := false;	
	   end if;
end; 

procedure show(item :in object) is

trip_iterator : place_list.iterator;

begin
	text_io.put("Complement : Kind : " & complement_kind'image(item.kind)); 
	case item.kind is
	when animate => 
	text_io.put_line (" Name : " & name(item) & " Place : " & natural'image(place(item));  
  field_list.show(item.animate_fields);
	place_list.init(trip_iterator,item.trip);
	while not place_list.done(trip_iterator) loop
		put(positive'image(place_list.value(trip_iterator)) & ", ");
		place_list.next(trip_iterator);
	end loop;
	new_line;
	when  place =>
	text_io.put_line (" Name : " & name(item)); 
	field_list.show(item.place_fields);
	link_list.show(item.exits);
	when entity => 
	text_io.put_line (" Name : " & name(item) & " Place : " & natural'image(place(item));  
	field_list.show(item.entity_fields);
  when word =>
	text_io.put_line (" Name : " & name(item)); 
  when verb =>
  text_io.put_line(" Name : " & name(item) & " Number : " & natural'image(number(item));
  when unknown =>
  new_line;
  end case;
end if;
end;

procedure list_exits_init(item : in out object) is

begin
	if item.kind = place then
  	link_list.init(item.exits_iterator,item.exits);	
	end if;
end;

procedure list_exits_next(item : in out object) is

begin
	if item.kind = place then
  	link_list.next(item.exits_iterator);	
	end if;
end;


function list_exits_name(item : in out object) return natural is

begin
	if item.kind = place then
  	return link.name(link_list.value(item.exits_iterator));	
	else
		return 0;
	end if;
end;

function list_exits_done(item : in out object) return boolean is

begin
	if item.kind = place then
  	return link_list.done(item.exits_iterator);
  else
  	return true;
	end if;
end;

--function field_is_a_number (item : in object;field_name : in string) return boolean is
function field_is_a_number (item : in object;field_index : in positive) return boolean is

a_field : field.object;
local_ok : boolean;

begin
-- get_field(item,a_field,field_name,local_ok);
 get_field(item,a_field,field_index,local_ok);
 if local_ok then
   return field.is_a_number(a_field);
 else
   return false;
 end if;
end;

--function field_is_a_sentence (item : in object;field_name : in string) return boolean is
function field_is_a_sentence (item : in object;field_index : in positive) return boolean is

a_field : field.object;
local_ok : boolean;

begin
-- get_field(item,a_field,field_name,local_ok);
 get_field(item,a_field,field_index,local_ok);
 if local_ok then
   return field.is_a_sentence(a_field);
 else
   return false;
 end if;
end;

--function field_is_an_enumerate (item : in object;field_name : in string) return boolean is
function field_is_an_enumerate (item : in object;field_index : in positive) return boolean is

a_field : field.object;
local_ok : boolean;

begin
-- get_field(item,a_field,field_name,local_ok);
 get_field(item,a_field,field_index,local_ok);
 if local_ok then
   return field.is_an_enumerate(a_field);
 else
   return false;
 end if;
end;

--function field_exist (item : in object;field_name : in string) return boolean is

--begin
-- case item.kind is
-- when animate =>
-- 	return field_array.belong(item.animate_fields,field_name);
-- when place =>
-- 	return field_array.belong(item.place_fields,field_name);
-- when entity=>
-- 	return field_array.belong(item.entity_fields,field_name);
-- when word | unknown=>
-- 	return false;
-- end case;
--end;

--function field_exist (item : in object;field_name : in string) return boolean is
function field_exist (item : in object;field_index : in natural) return boolean is

list : field_list;
local_ok : boolean;

begin
 get_fields(item,list,local_ok);
 if local_ok then 
--		return field_list.belong(list,field_name); 
		return field_list.belong(list,natural'image(field_index)); 
	else
		return false;
	end if;
end;

function is_a_subject(item : in object) return boolean is

begin
return  item.kind = animate or item.kind = place or item.kind = entity;
end;

function is_an_animate(item : in object) return boolean is

begin
return item.kind = animate;
end;

function is_a_place(item : in object) return boolean is

begin
return item.kind = place;
end;

function is_an_entity(item : in object) return boolean is

begin
return item.kind = entity;
end;

function is_a_word(item : in object) return boolean;

begin
return item.kind = word;
end;

function is_a_verb(item : in object) return boolean;

begin
return item.kind = verb;
end;

function name (item : in object) return string is

begin
case item.kind is
when animate =>
return identifier.image(item.animate_name);
when place=>
return identifier.image(item.place_name);
when entity=>
return identifier.image(item.entity_name);
when word =>
return identifier.image(item.word_value);
when verb =>
return identifier.image(item.verb_name);
when unknown =>
return "";
end case;
end;

function place(item : in object) return natural is

begin
case item.kind is
when animate =>
return item.animate_place,
when entity =>
return item.entity_place;
when place|word|unknown =>
return 0;
end case;
end;

--function field_number (Item : in Object,field_name:in string) return Integer is
function field_number (Item : in Object,field_index:in positive) return Integer is

a_field : field.object;
local_ok boolean;

begin
-- get_field(item,a_field,field_name,local_ok);
 get_field(item,a_field,field_index,local_ok);
 if local_ok then
   return field.number(a_field);
 else
 	 return 0;
 end if;
end;

--function field_sentence (Item : in Object,field_name:in string) return String is
function field_sentence (Item : in Object,field_index:in positive) return String is

a_field : field.object;
local_ok : boolean;

begin
-- get_field(item,a_field,field_name,local_ok);
 get_field(item,a_field,field_index,local_ok);
 if local_ok then
   return field.sentence(a_field);
 else
 		return "";
 end if;
end;

--function field_Enumeration (Item : in Object,field_name:in string) return Natural is
function field_Enumeration (Item : in Object,field_index:in string) return Natural is

a_field : field.object;
local_ok : boolean;

begin
-- get_field(item,a_field,field_name,local_ok);
 get_field(item,a_field,field_index,local_ok);
 if local_ok then
   return field.enumeration(a_field);
 else
 	return 0;
 end if;
end;

--function field_Literal (Item : in Object,field_name:in string) return Natural is
function field_Literal (Item : in Object,field_index:in positive) return Natural is

a_field : field.object;
local_ok : boolean;

begin
-- get_field(item,a_field,field_name,local_ok);
 get_field(item,a_field,field_index,local_ok);
 if local_ok then
   return field.literal(a_field);
 else
 	return 0;
 end if;
end;

function verb_number (item : in object) return natural is

begin
	if item.kind = verb then
		item.number;
	else
	return 0;
	end if;
	end;
	
local_ok : boolean;

begin

--create_sentence (animate_object,"nom",local_ok);
--put_sentence(animate_object,"nom","anime",local_ok);
create_sentence (animate_object,"description",local_ok);
put_sentence(animate_object,"description","Ca bouge !",local_ok);

--create_sentence (place_object,"nom",local_ok);
--put_sentence(place_object,"nom","lieu",local_ok);
create_sentence (place_object,"description",local_ok);
put_sentence(place_object,"description","C'est une piece !",local_ok);

--create_sentence (entity_object,"nom",local_ok);
--put_sentence(entity_object,"nom","entite",local_ok);
create_sentence (entity_object,"description",local_ok);
put_sentence(entity_object,"description","C'est un objet !",local_ok);

end;
end;
    
with idemtifer,complement;
package Complement_array is

max_element : constant positive;

procedure put(a_complement: in complement.object;name : in identifier.object; ok : out boolean);
procedure put_word(word : in identifier.object);
procedure put_verb(verb : in identifier.object;number : in positive);


--procedure create_number_field(subject_index : in natural;field_name: in string; ok : out boolean);
--procedure create_sentence_field(subject_index : in natural;field_name: in string; ok : out boolean);
--procedure create_enumerate_field(subject_index : in natural;field_name: in string; ok : out boolean);
--procedure field_Put_number (subject_index : in natural;field_name: in string;number : in integer; ok : out boolean);
--procedure field_Put_sentence (subject_index : in natural;field_name: in string;sentence : in string; ok : out boolean);
--procedure field_Put_enumerate (subject_index : in natural;field_name: in string;enumeration,literal : in positive; ok : out boolean);

procedure create_number_field(subject_index : in natural;field_index : in positive; ok : out boolean);
procedure create_sentence_field(subject_index : in natural;field_index : in positive; ok : out boolean);
procedure create_enumerate_field(subject_index : in natural;field_index : in positive; ok : out boolean);
procedure field_Put_number (subject_index : in natural;field_index : in positive;number : in integer; ok : out boolean);
procedure field_Put_sentence (subject_index : in natural;field_index : in positive;sentence : in string; ok : out boolean);
procedure field_Put_enumerate (subject_index : in natural;field_index : in positive;enumeration,literal : in positive; ok : out boolean);

procedure put_movement(animate_name: in string;place : in positive); 
procedure movement_init(animate_index : in natural);
procedure move(animate_index : in natural);

procedure put_exit(place_index : in natural;name,start_place,start_direction,
next_place,next_direction: in positive;ok : out boolean);
--procedure put_exit(place_index : in natural;name,start_place,start_direction,
--next_place,next_direction: in positive;ok : out boolean);
--procedure exit_put_enumerate(place_index : in natural;direction:in string;enumeration,literal : in positive; ok : out boolean);
function exit_exist(place_index: in natural;direction : in positive) return boolean;
function exits_exist(place_index : in natural) return boolean;
--function exit_enumeration(place_index: in natural;direction : in positive) return natural;
--function exit_literal(place_index: in natural;direction : in positive) return natural;
function exit_name(place_index: in natural;direction : in positive) return string;
function next_place(place_index : in natural;direction : in positive) return natural;

procedure put_place(subject_index : in natural;place : in natural;ok : out boolean); 
procedure show;

procedure list_exits_init(place_index : in natural);
procedure list_exits_next(place_index : in natural);
function list_exits_name(place_index : in natural) return string;
function list_exits_done(place_index : in natural) return boolean;

procedure list_complement_init;
procedure list_complement_next;
function list_complement_place return positive;
function list_complement_name return string;
function list_complement_done return boolean;

--function field_is_a_number (subject_index : in natural;field_name : in string) return boolean;
--function field_is_a_sentence (subject_index : in natural;field_name : in string) return boolean;
--function field_is_an_enumerate (subject_index : in natural;field_name : in string) return boolean;
--function field_exist (subject_name,field_name : in string) return boolean;
--function field_exist (subject_index:in natural;field_name : in string) return boolean;

function field_is_a_number (subject_index : in natural;field_index : in positive) return boolean;
function field_is_a_sentence (subject_index : in natural;field_index : in positive) return boolean;
function field_is_an_enumerate (subject_index : in natural;field_index : in positive) return boolean;
function field_exist (subject_name,field_index : in positive) return boolean;
function field_exist (subject_index:in natural;field_index : in positive) return boolean;

function is_a_subject(complement_name: in string) return boolean;
function is_an_animate(complement_name: in string) return boolean;
function is_a_place(complement_name: in string) return boolean;
function is_an_entity(complement_name: in string) return boolean;
function is_a_word(complement_name: in string) return boolean;
function is_a_verb(complement_name: in string) return boolean;
function belong(complement_name: in string) return boolean;

function name(subject_index: in natural) return string;
function index(complement_name: in string) return natural;
function place (subject_index: in natural) return natural;
--function field_number (subject_index : in natural;field_name:in string) return Integer;
--function field_sentence (subject_index : in natural;field_name:in string) return String;
--function field_Enumeration (subject_index : in natural;field_name:in string) return Natural;
--function field_Literal (subject_index : in natural;field_name:in string) return Natural;

function field_number (subject_index : in natural;field_index : in positive) return Integer;
function field_sentence (subject_index : in natural;field_index : in positive) return String;
function field_Enumeration (subject_index : in natural;field_index : in positive) return Natural;
function field_Literal (subject_index : in natural;field_index : in positive) return Natural;

function verb_number (verb_index : in natural) return Integer;

end;

with text_io;
package body Complement_array is

max_element : constant positive := 200;

package c_array is new Generic_String_Sort_Array
                  (Element => complement.Object,
                   Max_Element_Number => max_element,
                   Null_Element => complement.Null_Object,
                   Get_Key => complement.Name,
                   show_element => complement.show;

    the_array : c_array.object := c_array.null_object;
		the_iterator : c_array.iterator := c_array.null_iterator;


procedure put(old_subject: in complement.object;name : in identifier.object; ok : out boolean) is

new_subject : complement.object;

begin
	complement.copy(old_subject,new_subject);
	complement.put_name(new_subject,name);
	c_array.put(the_array,new_subject,ok);
end;

procedure put_word(word : in identifier.object) is

new_word : complement.object;

begin
 complement.put_word(new_word,word);
	c_array.put(the_array,new_word,ok);	
end;

procedure put_verb(verb : in identifier.object;number : in positive) is

new_verb : complement.object;

begin
	complement.put_verb(new_verb,verb_name,number);
	c_array.put(the_array,new_verb,ok);
end;

--procedure create_number_field(subject_index : in natural;field_name: in string; ok : out boolean) is
procedure create_number_field(subject_index : in natural;field_index: in positive; ok : out boolean) is

a_subject : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_subject,subject_index,local_ok);
	if local_ok then
--		complement.create_number_field(a_subject,field_name,number,ok);
		complement.create_number_field(a_subject,field_index,number,ok);
	else
		ok:=false;
	end if;
end;

--procedure create_sentence_field(subject_index : in natural;field_name: in string; ok : out boolean) is
procedure create_sentence_field(subject_index : in natural;field_index: in positive; ok : out boolean) is

a_subject : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_subject,subject_index,local_ok);
	if local_ok then
--		complement.create_sentence_field(a_subject,field_name,number,ok);
		complement.create_sentence_field(a_subject,field_index,number,ok);
	else
		ok:=false;
	end if;
end;

--procedure create_enumerate_field(subject_index : in natural;field_name: in string; ok : out boolean) is
procedure create_enumerate_field(subject_index : in natural;field_index: in string; ok : out boolean) is

a_subject : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_subject,subject_index,local_ok);
	if local_ok then
--		complement.create_enumerate_field(a_subject,field_name,number,ok);
		complement.create_enumerate_field(a_subject,field_index,number,ok);
	else
		ok:=false;
	end if;
end;

--procedure Put_number (subject_index : in natural;field_name: in string;number : in integer; ok : out boolean) is
procedure Put_number (subject_index : in natural;field_index: in positive;number : in integer; ok : out boolean) is

a_subject : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_subject,subject_index,local_ok);
	if local_ok then
--		complement.put_number(a_subject,field_name,number,ok);
		complement.put_number(a_subject,field_index,number,ok);
	else
		ok:=false;
	end if;
end;

--procedure Put_sentence (subject_index : in natural;field_name: in string;sentence : in string; ok : out boolean) is
procedure Put_sentence (subject_index : in natural;field_index: in positive;sentence : in string; ok : out boolean) is

a_subject : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_subject,subject_index,local_ok);
	if local_ok then
--		complement.put_sentence(a_subject,field_name,sentence,ok);
		complement.put_sentence(a_subject,field_index,sentence,ok);
  else
  	ok:=false;
  end if;
end;

--procedure Put_enumerate (subject_index : in natural;field_name: in string;enumeration,literal : in positive; ok : out boolean) is
procedure Put_enumerate (subject_index : in natural;field_index: in string;enumeration,literal : in positive; ok : out boolean) is

a_subject : complement.object;
other_direction : natural;
other_place : natural;
local_ok : boolean;

begin
	c_array.get(the_array,a_subject,subject_index,local_ok);
	if local_ok then
--		complement.put_enumerate(a_subject,field_name,enumeration,literal,local_ok);
		complement.put_enumerate(a_subject,field_index,enumeration,literal,local_ok);
    if local_ok and complement.exit_exist(a_subject,index(field_name)) then
--other_direction :=complement.next_direction(a_subject,index(field_name));
--other_place :=complement.next_place(a_subject,index(field_name));
other_direction :=complement.next_direction(a_subject,field_index);
other_place :=complement.next_place(a_subject,field_index);
			c_array.get(the_array,a_subject,other_place,local_ok);
 			if local_ok then
--		    complement.put_enumerate(a_subject,name(others_direction),enumeration,literal,local_ok);
		    complement.put_enumerate(a_subject,others_direction,enumeration,literal,local_ok);
 			end if;
 		end if;
  end if;
  ok:=local_ok;
end;

procedure put_movement(animate_name: in string;place : in positive) is 

an_animate : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,an_animate,animate_name,local_ok);
	if local_ok then
		complement.put_movement(a_subject,place);
  end if;
end;

procedure movement_init(animate_index : in natural) is

an_animate : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,an_animate,animate_index,local_ok) is
	if local_ok then
		complement.movement_init(an_animate);	
  end if;
end;

procedure move(animate_index : in natural) is

an_animate : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,an_animate,animate_index,local_ok);
	if local_ok then
		complement.move(an_animate);	
  end if;
end;

procedure put_exit(place_index : in natural;name,start_place,start_direction,
next_place,next_direction: in positive;ok : out boolean) is

a_place : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_place,place_index,local_ok);
	if local_ok then
complement.put_exit(a_place,name,start_place,start_direction,next_place,next_direction,ok);
 else
  	ok:=false;
  end if;
end;

--procedure put_exit(place_index : in natural;name,start_place,start_direction,
--next_place,next_direction: in positive;ok : out boolean) is

--a_place : complement.object;
--local_ok : boolean;

--begin
--	c_array.get(the_array,a_place,place_index,local_ok);
--	if local_ok then
--complement.put_exit(a_place,name,start_place,start_direction,
--next_place,next_direction,ok);
--  else
--  	ok:=false;
--  end if;
--end;

--procedure exit_put_enumerate(place_index : in natural;direction : in string;enumeration,literal : in positive; ok : out boolean) is

--a_place : complement.object;
--local_ok : boolean;

--begin
--	c_array.get(the_array,a_place,place_index,local_ok);
--	if local_ok then
--complement.exit_put_enumerate(a_place,index(direction),enumeration,literal,ok);
-- else
--  	ok:=false;
--  end if;
--end;

function exit_exist(place_index: in natural;direction : in positive) return boolean is

a_place : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_place,place_index,local_ok);
	if local_ok then
		return complement.exit_exist(a_place,direction);	
  else
  	return false;
  end if;
end;

--function exit_exist(place_index: in natural;direction : in string) return boolean is

--begin
--return exit_exist(place_index,index(direction));
--end;

function exits_exist(place_index : in natural) return boolean is

a_place : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_place,place_index,local_ok);
	if local_ok then
		return complement.exits_exist(a_place);	
  else
  	return false;
  end if;
end;

--function exit_enumeration(place_index: in natural;direction : in positive) return natural is

--a_place : complement.object;
--local_ok : boolean;

--begin
--	c_array.get(the_array,a_place,place_index,local_ok);
--	if local_ok then
--		return complement.enumeration_exit(a_place,direction);	
-- else
--  	return 0;
-- end if;
--end;

--function exit_literal(place_index: in natural;direction : in positive) return natural is

--a_place : complement.object;
--local_ok : boolean;

--begin
--	c_array.get(the_array,a_place,place_index,local_ok);
--	if local_ok then
--		return complement.literal_exit(a_place,direction);	
--  else
--  	return 0;
--  end if;
--end;

function exit_name(place_index : in natural;direction : in positive) return string is

a_place : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_place,place_index,local_ok);
	if local_ok then
		return name(complement.exit_name(a_place,direction));	
  else
  	return "";
  end if;
end;

function next_place(place_index : in natural;direction : in positive) return natural is

a_place : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_place,place_index,local_ok);
	if local_ok then
		return complement.next_place(a_place,direction);	
  else
  	return 0;
  end if;
end;

procedure put_place(subject_index: in natural;place : in natural;ok : out boolean) is

a_subject : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_subject,subject_index,local_ok);
	if local_ok then
		complement.put_place(a_subject,place,ok);	
  else
  	ok:=false;
  end if;
end;

procedure show;

begin
	text_io.put_line("Complement Array :");
	c_array.show(the_array);
end;

procedure list_exits_init(place_index : in natural) is

a_place : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_place,place_index,local_ok);
	if local_ok then
		complement.list_exits_init(a_place);	
  end if;
end;

procedure list_exits_next(place_index : in natural) is

a_place : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_place,place_index,local_ok);
	if local_ok then
		complement.list_exits_next(a_place);	
  end if;
end;

function list_exits_name(place_index : in natural) return string is

a_place : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_place,place_index,local_ok);
	if local_ok then
		return name(complement.list_exits_name(a_place));	
  else
  	return "";
  end if;
end;

function list_exits_done(place_index : in natural) return boolean is

a_place : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_place,place_index,local_ok);
	if local_ok then
		complement.list_exits_done(a_place);	
  else
  	return true;
  end if;
end;

procedure list_complement_init is

begin
	c_array.list_init(the_array,the_iterator);
end;

procedure list_complement_next is

begin
	c_array.list_next(the_iterator);
end;

function list_complement_place return positive is

begin
	return complement.place(c_array.list_value(the_iterator));
end;

function list_complement_name return string is

begin
	return complement.name(c_array.list_value(the_iterator));
end;

function list_complement_done return boolean is


begin
	c_array.list_done(the_iterator);
end;

--function field_is_a_number (subject_index : in natural;field_name : in string) return boolean is
function field_is_a_number (subject_index : in natural;field_index : in positive) return boolean is

a_subject : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_subject,subject_index,local_ok);
	if local_ok then
--		return complement.field_is_a_number(a_subject,field_name);	
		return complement.field_is_a_number(a_subject,field_index);	
  else
  	return false;
  end if;
end;

--function field_is_a_sentence (subject_index : in natural;field_name : in string) return boolean is
function field_is_a_sentence (subject_index : in natural;field_index : in positive) return boolean is

a_subject : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_subject,subject_index,local_ok);
	if local_ok then
--		return complement.field_is_a_sentence(a_subject,field_name);	
		return complement.field_is_a_sentence(a_subject,field_index);	
  else
  	return false;
  end if;
end;

--function field_is_an_enumerate (subject_index : in natural;field_name : in string) return boolean is
function field_is_an_enumerate (subject_index : in natural;field_index : in positive) return boolean is

a_subject : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_subject,subject_index,local_ok);
	if local_ok then
--		return complement.field_is_an_enumerate(a_subject,field_name);	
		return complement.field_is_an_enumerate(a_subject,field_index);	
  else
  	return false;
  end if;
end;

--function field_exist (subject_name,field_name : in string) return boolean is
function field_exist (subject_name,field_index: in positive) return boolean is

a_subject : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_subject,subject_name,local_ok);
	if local_ok then
--		return complement.field_exist(a_subject,field_name);
		return complement.field_exist(a_subject,field_index);
  else
  	return false;
  end if;
end;

--function field_exist (subject_index:in natural;field_name : in string) return boolean is
function field_exist (subject_index:in natural;field_index : in positive) return boolean is

a_subject : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_subject,subject_index,local_ok);
	if local_ok then
--		return complement.field_exist(a_subject,field_name);	
		return complement.field_exist(a_subject,field_index);	
  else
  	return false;
  end if;
end;


function is_an_subject(complement_name: in string) return boolean is

a_complement : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_complement,complement_name,local_ok);
	if local_ok then
		return complement.is_a_subject(a_complement);
  else
  	return false;
  end if;
end;

function is_an_animate(complement_name: in string) return boolean is

a_complement : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_complement,complement_name,local_ok);
	if local_ok then
		return complement.is_an_animate(a_complement);
  else
  	return false;
  end if;
end;

function is_a_place(complement_name: in string) return boolean is

a_complement : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_complement,complement_name,local_ok);
	if local_ok then
		return complement.is_a_place(a_complement);	
  else
  	return false;
  end if;
end;

function is_an_entity(complement_name: in string) return boolean is

a_complement : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_complement,complement_name,local_ok);
	if local_ok then
		return complement.is_an_entity(a_complement);	
  else
  	return false;
  end if;
end;

function is_a_word(complement_name: in string) return boolean is

a_complement: complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_complement,complement_name,local_ok);
	if local_ok then
		return complement.is_a_word(a_complement);	
  else
  	return false;
  end if;
end;

function is_a_verb(complement_name: in string) return boolean is

a_complement : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_complement,complement_name,local_ok);
	if local_ok then
		return complement.is_a_verb(a_complement);	
  else
  	return false;
  end if;
end;

function belong(complement_name: in string) return boolean is

begin
	return c_array.belong(the_array,complement_name);
end;

function name(subject_index: in natural) return string is

a_complement : complement.object;
local_ok : boolean;

begin
		c_array.get(the_array,a_complement,subject_index,local_ok);
		if local_ok then
			return complement.name(a_complement);
		else
			return "";
		end if;
end;

function index(complement_name: in string) return natural is

begin
	return c_array.index(the_array,complement_name);
end;

function place (subject_index: in natural) return natural is

a_subject : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_subject,subject_index,local_ok);
	if local_ok then
		return complement.place(a_subject);	
  else
  	return 0;
  end if;
end;

--function field_number (subject_index : in natural;field_name:in string) return Integer is
function field_number (subject_index : in natural;field_index:in positive) return Integer is

a_subject : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_subject,subject_index,local_ok);
	if local_ok then
--		return complement.field_number(a_subject,field_index);	
		return complement.field_number(a_subject,field_name);	
  else
  	return 0;
  end if;
end;

--function field_sentence (subject_index : in natural;field_name:in string) return String is
function field_sentence (subject_index : in natural;field_index:in positive) return String is

a_subject : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_subject,subject_index,local_ok);
	if local_ok then
--		return complement.field_sentence(a_subject,field_name);	
		return complement.field_sentence(a_subject,field_index);	
  else
  	return "";
  end if;
end;

--function field_Enumeration (subject_index : in natural;field_name:in string) return Natural is
function field_Enumeration (subject_index : in natural;field_index:in index) return Natural is

a_subject : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_subject,subject_index,local_ok);
	if local_ok then
--		return complement.field_enumeration(a_subject,field_name);	
		return complement.field_enumeration(a_subject,field_index);	
  else
  	return 0;
  end if;
end;

--function field_Literal (subject_index : in natural;field_name:in string) return Natural is
function field_Literal (subject_index : in natural;field_index:in positive) return Natural is

a_subject : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_subject,subject_index,local_ok);
	if local_ok then
--		return complement.field_literal(a_subject,field_name);	
		return complement.field_literal(a_subject,field_index);	
  else
  	return 0;
  end if;
end;

function verb_number (verb_index : in natural) return Integer is

a_verb : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_verb,verb_index,local_ok);
	if local_ok then
		return complement.verb_number(a_verb);	
  else
  	return 0;
  end if;
end;

an_identifier : identifier.object;

begin
identifier.put(an_identifier,"ailleurs");
put_word(an_identifier);
end;

-- structure --

with complement,identifer;
package structure is

type object is private;

procedure put_name(item : in out object;name : in identifier.object);
--procedure create_number_field(item : out object;field_name: in string; ok : out boolean);
--procedure create_sentence_field(item : out object;field_name: in string; ok : out boolean);
--procedure create_enumerate_field(item : out object;field_name: in string; ok : out boolean);
--procedure field_Put_number (Item : in out Object;field_name: in string;number : in integer; ok : out boolean);
--procedure field_Put_sentence (Item : in out Object;field_name: in string;sentence : in string; ok : out boolean);
--procedure field_Put_enumerate (Item : in out Object;field_name: in string;enumeration,literal : in positive; ok : out boolean);

procedure create_number_field(item : out object;field_index: in positive; ok : out boolean);
procedure create_sentence_field(item : out object;field_index: in positive; ok : out boolean);
procedure create_enumerate_field(item : out object;field_index: in positive; ok : out boolean);
procedure field_Put_number (Item : in out Object;field_index: in positive;number : in integer; ok : out boolean);
procedure field_Put_sentence (Item : in out Object;field_index: in positive;sentence : in string; ok : out boolean);
procedure field_Put_enumerate (Item : in out Object;field_index: in positive;enumeration,literal : in positive; ok : out boolean);
procedure show(item : in object);
function name(item : in object) return string;
function subject(item : in object) return complement.object;

null_object : constant object;
animate_object : constant object;
place_object : constant object;
entity_object : constant object;

private

type object is record
name : identifier.object := identifer.null_object;
a_subject : complement.object := complement.null_object;
end record;

null_object := (name=>identifier.null_object,a_subject=>complement.null_object);
animate_object := (name=>identifier.null_object,a_subject=>complement.animate_object);
place_object := (name=>identifier.null_object,a_subject=>complement.place_object);
entity_object := (name=>identifier.null_object,a_subject=>complement.entity_object);

end;

with text_io;
package body structure is

procedure put_name(item : in out object;name : in identifier.object) is

begin
  item.name:=name;
end;

--    procedure create_number_field(item : out object;field_name: in string; ok : out boolean) is
    procedure create_number_field(item : out object;field_index: in positive; ok : out boolean) is
    
    begin
--      complement.create_number_field(item.a_complement,field_name,ok)
      complement.create_number_field(item.a_complement,field_index,ok)
    end;
    
--    procedure create_sentence_field(item : out object;field_name: in string; ok : out boolean) is
    procedure create_sentence_field(item : out object;field_index: in positive; ok : out boolean) is
    
    begin
--    complement.create_sentence_field(item.a_complement,field_name,ok);
    complement.create_sentence_field(item.a_complement,field_index,ok);
    end;
    
--    procedure create_enumerate_field(item : out object;field_name: in string; ok : out boolean) is
    procedure create_enumerate_field(item : out object;field_index: in positive; ok : out boolean) is
    
    begin
--    complement.create_enumerate_field(item.a_complement,field_name,ok);
    complement.create_enumerate_field(item.a_complement,field_index,ok);
    end;
    
--    procedure field_Put_number (Item : in out Object;field_name: in string;number : in integer; ok : out boolean) is
    procedure field_Put_number (Item : in out Object;field_index: in positive;number : in integer; ok : out boolean) is
    
    begin
--    complement.field_Put_number (Item.a_complement,field_name,number,ok);
    complement.field_Put_number (Item.a_complement,field_index,number,ok);
    end;
    
--    procedure field_Put_sentence (Item : in out Object;field_name: in string;sentence : in string; ok : out boolean) is
    procedure field_Put_sentence (Item : in out Object;field_index: in positive;sentence : in string; ok : out boolean) is
    
    begin
--    complement.field_Put_sentence (Item.a_complement,field_name,sentence,ok);
   complement.field_Put_sentence (Item.a_complement,field_index,sentence,ok);
    end;
    
--    procedure field_Put_enumerate (Item : in out Object;field_name: in string;enumeration,literal : in positive; ok : out boolean) is
    procedure field_Put_enumerate (Item : in out Object;field_index: in positive;enumeration,literal : in positive; ok : out boolean) is
    
    begin
--    complement.field_Put_enumerate (Item.a_complement,field_name,enumeration,literal,ok);
    complement.field_Put_enumerate (Item.a_complement,field_index,enumeration,literal,ok);
		end;

procedure show(item : in object) is

begin
	text_io.put_line("Structure : Name : " & name(item));
	complement.image(item.a_complement);
end;

function name(item : in object) return string is

begin
	return identifier.image(item);
end;
		
function complement(item : in object) return complement.object is

begin
	return item.a_complement;
end;

begin
 put_name(animate_object,"anime");
 put_name(place_object,"lieu");
 put_name(entity_object,"entite");
end;

-- structure array --

with complement;
package structure_array is

max_element : constant positive;

procedure put(old_name: in string;new_name : in identifier.object; ok : out boolean);

--procedure create_number_field(structure_name: in string;item : out object;field_name: in string; ok : out boolean);
--procedure create_sentence_field(structure_name: in string;item : out object;field_name: in string; ok : out boolean);
--procedure create_enumeration_field(structure_name: in string;item : out object;field_name: in string; ok : out boolean);
--procedure field_Put_number (structure_name: in string;Item : in out Object;field_name: in string;number : in integer; ok : out boolean);
--procedure field_Put_sentence (structure_name: in string;Item : in out Object;field_name: in string;sentence : in string; ok : out boolean);
--procedure field_Put_enumerate (structure_name: in string;Item : in out Object;field_name: in string;enumeration,literal : in positive; ok : out boolean);

procedure create_number_field(structure_name: in identifier.object;item : out object;field_index : in positive; ok : out boolean);
procedure create_sentence_field(structure_name: in identifier.object;item : out object;field_index : in positive; ok : out boolean);
procedure create_enumeration_field(structure_name: in identifier.object;item : out object;field_index : in positive; ok : out boolean);
procedure field_Put_number (structure_name: in identifier.object;Item : in out Object;field_index : in positive;number : in integer; ok : out boolean);
procedure field_Put_sentence (structure_name: in identifier.object;Item : in out Object;field_index : in positive;sentence : in string; ok : out boolean);
procedure field_Put_enumerate (structure_name: in identifier.object;Item : in out Object;field_index : in positive;enumeration,literal : in positive; ok : out boolean);
procedure get_subject(structure_name: in string;subject : out complement.object;ok : out boolean);
procedure show;
function subject(structure_name: in string) return complement.object;
function belong (structure_name: in string) return boolean;

end;

with text_io,structure;
package body structure_array is

max_element : constant positive := 200;

package    s_array is new Generic_String_Sort_Array
                  (Element => structure.Object,
                   Max_Element_Number => max_element,
                   Null_Element => structure.Null_Object,
                   Get_Key => structure.Name,
                   show_element => structure.show;

    the_array : s_array.object := s_array.null_object;

procedure put(old_name:in string;new_name : in identifier.object; ok : out boolean) is

new_structure : structure.object;
local_ok : boolean;

begin
	s_array.get(the_array,new_structure,old_name,local_ok);
	if local_ok then
		structure.put_name(new_structure,new_name);
	  s_array.put(the_array,new_structure,ok);	
  else
  ok:=false;
  end if;
end;

--    procedure create_number_field(structure_name: in string;item : out object;field_name: in string; ok : out boolean) is
    procedure create_number_field(structure_name: in identifier.object;item : out object;field_index : in positive; ok : out boolean) is

		a_structure : structure.object;
    local_ok : boolean;

	  begin
			s_array.get(the_array,a_structure,identifier.image(structure_name),local_ok);
			if local_ok then
--				structure.create_number_field(a_structure,field_name,ok);
				structure.create_number_field(a_structure,field_index,ok);
			end if;
		end;

--    procedure create_sentence_field(structure_name: in identifier.object;item : out object;field_name: in string; ok : out boolean) is
    procedure create_sentence_field(structure_name: in identifier.object;item : out object;field_index : in positive; ok : out boolean) is

		a_structure : structure.object;
    local_ok : boolean;

	  begin
			s_array.get(the_array,a_structure,identifier.image(structure_name),local_ok);
			if local_ok then
--				structure.create_sentence_field(a_structure,field_name,ok);	
				structure.create_sentence_field(a_structure,field_index,ok);	
			end if;
		end;

--    procedure create_enumerate_field(structure_name: in identifier.object;item : out object;field_name: in string; ok : out boolean) is
    procedure create_enumerate_field(structure_name: in identifier.object;item : out object;field_index : in positive; ok : out boolean) is

		a_structure : structure.object;
    local_ok : boolean;

	  begin
			s_array.get(the_array,a_structure,identifier.image(structure_name),local_ok);
			if local_ok then
--				structure.create_enumerate_field(a_structure,field_name,ok);	
				structure.create_enumerate_field(a_structure,field_index,ok);	
			end if;
		end;

--    procedure field_Put_number(structure_name: in identifier.object;Item : in out Object;field_name: in string;number : in integer; ok : out boolean) is
    procedure field_Put_number(structure_name: in identifier.object;Item : in out Object;field_index : in positive;number : in integer; ok : out boolean) is

		a_structure : structure.object;
    local_ok : boolean;

	  begin
			s_array.get(the_array,a_structure,identifier.image(structure_name),local_ok);
			if local_ok then
--				structure.field_put_number(a_structure,field_name,number,ok);	
				structure.field_put_number(a_structure,field_index,number,ok);	
			end if;
		end;

--    procedure field_Put_sentence(structure_name: in identifier.object;Item : in out Object;field_name: in string;sentence : in string; ok : out boolean) is
    procedure field_Put_sentence(structure_name: in identifier.object;Item : in out Object;field_index : in positive;sentence : in identifier.object; ok : out boolean) is

		a_structure : structure.object;
    local_ok : boolean;

	  begin
			s_array.get(the_array,a_structure,identifier.image(structure_name),local_ok);
			if local_ok then
--				structure.field_put_sentence(a_structure,field_name,sentence,ok);	
				structure.field_put_sentence(a_structure,field_index,sentence,ok);	
			end if;
		end;

--    procedure field_Put_enumerate (structure_name: in identifier.object;Item : in out Object;field_name: in string;enumeration,literal : in positive; ok : out boolean) is
    procedure field_Put_enumerate (structure_name: in identifier.object;Item : in out Object;field_index : in positive;enumeration,literal : in positive; ok : out boolean) is

		a_structure : structure.object;
    local_ok : boolean;

	  begin
			s_array.get(the_array,a_structure,identifier.image(structure_name),local_ok);
			if local_ok then
--				structure.field_put_enumerate(a_structure,field_name,enumeration,literal,ok);	
				structure.field_put_enumerate(a_structure,field_index,enumeration,literal,ok);	
			end if;
		end;

procedure get_subject(structure_name: in string;subject : out complement.object;ok : out boolean) is

		a_structure : structure.object;

	  begin
			s_array.get(the_array,a_structure,structure_name,ok);
			subject:=structure.subject(a_structure);
		end;

procedure show;

begin
	text_io.put_line("Structure Array :");
	s_array.show(the_array);
end;

function subject(structure_name: in string) return complement.object is

		a_structure : structure.object;
		local_ok : boolean;

	  begin
			s_array.get(the_array,a_structure,structure_name,local_ok);
			if local_ok  then
				return structure.subject(a_structure);
			else
				return complement.null_object;
		end;

function belong(structure_name : in string) return boolean is

begin
	return s_array.belong(the_array,structure_name);
end;

begin
s_array.put(the_array,structure.animate_object);
s_array.put(the_array,strucure.place_object);
s_array.put(the_array,structure.entity_object);
end;

-- order --

with moving_string;
package order is

subtype index;
type index_array;

type object is private;

procedure put_complement(item : in out object;
place : in moving_string.object;
first_complement : in moving_string.object;
second_complement : in moving_string.object;
third_complement : in moving_string.object;
fourth_complement : in moving_string.object);
procedure put_redirection(item : in out object;redirection : in index_array);
procedure make_redirection(item : in out object;complement : in string;position : in index);
procedure free(item : in object);
procedure show(item : in object);
function image(item : in object) return string;
function complement_position(item : in object;complement : in string) return natural;
function contains_complement(item : in object;complement : in string) return boolean;
function complement(item : in object;position : in index) return string;
function redirection(item : in object) return index_array;

null_object : constant object;
null_index_array : constant index_array;

private

subtype index is positive 1..5;
type index_array is array(index) of index;

type moving_string_array is array(index) of moving_string.object;

null_moving_array : constant moving_string_array :=(
moving_string.null_object,
moving_string.null_object,
moving_string.null_object,
moving_string.null_object,
moving_string.null_object);

null_index_array : constant index_array :=(0,0,0,0,0);

type object is record
the_order : moving_string_array := null_moving_string_array;
redirection : index_array := null_index_array;
end record;

null_object : constant object := (the_order => null_moving_string_array,
redirection => null_index_array);

end;

with text_io;
use moving_string;
package body order is

procedure put_complement(item : in out object;
place : in moving_string.object;
first_complement : in moving_string.object;
second_complement : in moving_string.object;
third_complement : in moving_string.object;
fourth_complement : in moving_string.object) is

begin
item.the_order(1):=place;
item.the_order(2):=first_complement;
item.the_order(3):=second_complement;
item.the_order(4):=third_complement;
item.the_order(5):=fourth_complement; 
end;

procedure put_redirection(item : in out object;redirection : in index_array) is

begin
	item.redirection := redirection;
end;


procedure free(item : in object) is

begin
for i in index'range loop
moving_string.free(item.the_order(i));
end loop; 
end;

procedure show(item : in object) is

begin
text_io.put("Order : " & image(item));
for i in index'range loop
text_io.put(" " & index'image(item.redirection(i)));
end loop;
text_io.new_line;
end;

procedure make_redirection(item : in object;complement : in string;position : in index) is

begin
  if contains_complement(item,complement) then
  item.redirection(position):=complement_position(item,complement);
  end if;
end;

function image(item : in object) return string is

begin
return moving_string.image
(item.the_order(1) & " " &
item.the_order(2) & " " &
item.the_order(3) & " " &
item.the_order(4) & " " &
item.the_order(5));
end;

function complement_position(item : in object;complement : in string) return natural is

an_index : natural := 0;

begin
for i in index'range loop
	if moving_string.image(item.the_order(i)) := complement then 
		an_index := i;
	end if;
end loop;
return an_index;
end;

function contains_complement(item : in object;complement : in string) return boolean is

begin
return complement_position(item,complement) /= 0;
end;

function complement(item : in object;position : in index) return string is

begin
return moving_string.image(item.the_order(item.the_index(position)));
end;

function redirection(item : in object) return index_array is

begin
return item.redirection;
end;

end;

-- the order --

with order,moving_string;
package the_order is

procedure put_complement(place : in moving_string.object;
first_complement : in moving_string.object;
second_complement : in moving_string.object;
third_complement : in moving_string.object;
fourth_complement : in moving_string.object);
procedure put_redirection(redirection : in index_array);
procedure free;
procedure show;
function complement(position : in index) return natural;

end;

with text_io,complement_array;
use moving_string;
package body the_order is

current_order : order.object := order.null_object;

procedure put_complement(place : in moving_string.object;
first_complement : in moving_string.object;
second_complement : in moving_string.object;
third_complement : in moving_string.object;
fourth_complement : in moving_string.object) is

begin
 order.put_complement(current_order,place,first_complement,
second_complement,third_complement,fourth_complement);
end;

procedure put_redirection(redirection : in index_array) is

begin
	order.put_redirection(current_order,redirection);
end;

procedure free is

begin
order.free(current_order);
end;

procedure show is

begin
text_io.put("The Order : ");
order.show(current_order);
end;

function complement(position : in index) return natural is

begin
return  complement_array.index(order.complement(current_order,position));
end;

end;

-- order list --

with order;
package order_list is

procedure put(an_order : in order.object;ok : out boolean);
procedure make_redirection(complement : in string);
procedure free;
procedure show;
function contains_complement(complement : in string) return boolean;

procedure init;
procedure next;
function value return order.object;
function done return boolean;

end;

with Text_Io,exclusive_generic_list;
package body order_list is

package o_list is new exclusive_generic_list (element => order.object,
           null_element => order.null_object,
           show_element => order.show,
           get_key => order.image);

 the_list : o_list.list := o_list.nil;
 the_iterator : o_list.iterator;

procedure put(an_order : in order.object;ok : out boolean) is

begin
    o_list.make(an_order,the_list,ok);
end;

procedure make_redirection(complement : in string) is

an_iterator : o_list.iterator;
position : order.index;

begin
	if constains_complement(complement) then
		o_list.init(an_iterator,the_list);
		position := order.complement_position(o_list.value(an_iterator),complement); 
		while not o_list.done(an_iterator) loop
			order.make_redirection(o_list.value(an_iterator),complement,position);
			o_list.next(an_iterator);
		end loop;
	end if;
end;

procedure free is

an_iterator : o_list.iterator;

begin
	o_list.init(an_iterator,the_list);
		while not o_list.done(an_iterator) loop
			order.free(value(an_iterator));
			o_list.next(an_iterator);
		end loop;
	o_list.free(the_list);
end;
 
procedure show is

begin
 text_io.put_line ("Order List :");
 o_list.show(the_list);
end;

function contains_complement(complement : in string) return boolean is

found : boolean;
an_iterator : o_list.iterator;

begin
	o_list.init(an_iterator,the_list);
	if not o_list.done(an_iterator) then
		found:=true;
		while not o_list.done(an_iterator) loop
			found := found & order.contains_complement(o_list.value(an_iterator),complement);
			o_list.next(an_iterator);
		end loop;
	else
		found:=false;
	end if;	
	return found;
end;

procedure init is

begin
o_list.init(the_iterator,the_list);
end;

procedure next is

begin
o_list.next(the_iterator);
end;

function value return order.object;

begin
return o_list.value(the_iterator);
end;

function done return boolean;

begin
return o_list.done(the_iterator);
end;

end;

-- coded_order --

with order,identifer,instruction_list;
package coded_order is

type object is private;

procedure put(item : out object;an_order : in order.object;list : in instruction_list.object);
procedure run(item : in object);
procedure show(item : in object);
function order_to_code(an_order : in order.object) return integer;
function code_to_key(code : in integer) return string;
function order_to_key(an_order : in order.object) return string;
function key_to_code(key : in string) return integer;
function key(item : in object) return string; 

null_object : constant object;

private

type object is record;
key : identifier.object :=
DataMuseum.dk

Rational R1000/400

⟦d062b98c4⟧ TextFile

Derivation

TextFile
