DataMuseum.dk

top - metrics - download

    Length: 26258 (0x6692)
    Types: TextFile
    Notes: R1k Text-file segment

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─⟦cfc2e13cd⟧ »Space Info Vol 2« 
        └─⟦e368f01d3⟧ 
            └─⟦this⟧ 

TextFile

-- 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;

--------------------------

procedure put_group(item : in out : object;an_index : in positive;ok : out boolean);
procedure list_group_init(item : in out object);
procedure list_group_next(item : in out object);
function list_group_name(item : in out object) return string; -- pour list_exits_value aussi string !!!
function list_group_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);

----------------

mettre group_identifier_array au debut
 
package group_index is new index(element_image => group_identifier_array.image);
-- avec le zero !!!!!!!!!!!
package group_index_list is new exclusive_list_generic (element => group_index.object,
null_element=>group_index.null_object,
show_element=>group_index.show,
element_image=>group_index.image);

-----------------

package group_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;
----------------

null_group_iterator : group_list.iterator;

----------------

type object(kind : complement_kind := unknown) is record

group_list : group_list.object := group_index_list.null_object;
group_iterator : group_list.iterator := group_index_list.null_group_iterator;

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;
  
  plus de number ou synonyme !!!!!!!!!
  
-----------------

when unknown =>
	null;
end case;
end record;

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

animate_object : constant object, := (

   ------------------------

group_list => group_index_list.null_object;
group_iterator => group_index_list.null_group_iterator;


--------------------------


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 := (


  -------------------------


  group_list => group_index_list.null_object;
group_iterator => group_index_list.null_group_iterator;


--------------------

  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 := (

 ------------------------------

 group_list => group_index_list.null_object;
group_iterator => group_index_list.null_group_iterator;


-------------------------------

 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


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

begin
case item.kind is
	 when animate => 
     item.animate_name:=name;

     --------------------------------------

     group_identifier_array.put(name,ok);
     put(item,group_identifier_array.index(identifier.image(name)),ok);
         ok := true;

         -----------------------

	 when place => 
     item.place_name:=name;

     --------------------------------

      group_identifier_array.put(name,ok);
     put(item,group_identifier_array.index(identifier.image(name)),ok);
         ok := true;                                             

         ----------------------------

	 when entity => 
     item.entity_name:=name;

      ------------------------

      group_identifier_array.put(name,ok);
     put(item,group_identifier_array.index(identifier.image(name)),ok);
         ok := true;

         ----------------------------

     when word | verb | unknown =>
 	   ok := false;
 	 end case;
end;

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

ok : boolean;

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

   group_identifier_array.put(name,ok);
     put(item,group_identifier_array.index(identifier.image(name)),ok);

     --------------------------------
end;

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

ok : boolean;

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

group_identifier_array.put( v ,ok);
     put(item,group_identifier_array.index(identifier.image( v )),ok);

     ----------------------
end;

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



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


--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



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


--    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);

 

--    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);


--    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);

 ;

--    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);

 

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



procedure movement_init(item : in out object) is


procedure move(item : in out object) is



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


function exits_exist(item : in object) return boolean is


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


--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;direction,numeration,literal: in positive;ok : out boolean);



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



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



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



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


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


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


procedure show(item :in object) is



procedure list_exits_init(item : in out object) is



procedure list_exits_next(item : in out object) is



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


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


-------------------------



procedure put_group(item : in out object;a_group_index : in positive;ok : out boolean) is

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

begin
  group_index.put(an_index,a_group_index);
  group_index_list.put(item.group_list,an_index,ok);
end;
 
procedure show is

begin
	text_io.put_line("group List :");
	group_list.show(item.group_list);
end;

procedure init is

begin
  group_list.init(item.group_iterator,item.group_list);  -- voir ordre 
end;

procedure next is

begin
  group_list.next(item.group_iterator);
end;

function value return positive is

begin
return group_list.value(item.group_iterator);
end;

function done return boolean is

begin
return group_list.done(item.group_iterator);
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


--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



--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


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

--begin
-

--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

function is_a_subject(item : in object) return boolean is


function is_an_animate(item : in object) return boolean is


function is_a_place(item : in object) return boolean is


function is_an_entity(item : in object) return boolean is


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 is


function place(item : in object) return natural is


--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


--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



--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



--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


function verb_number (item : in object) return natural is

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 complement_show(complement_name : in string);

----------------------------------

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 put_group(complement_name: in string;an_index : in positive;ok : out boolean);
procedure list_group_init(complement_name : in string);
procedure list_group_next(complement_name : in string);
function list_group_name(place_name : in string) return string;
function list_group_done(place_name : in string) 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;


procedure show;



-----------------------


procedure complement_show(complement_name : in string) is

a_complement : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_complement,complement_name,local_ok);
        if local_ok then
        complement.show(a_complement);
        end if;
end;


-------------------------------------------


procedure list_exits_init(place_index : in natural) is

a_place : complement.object;

procedure list_exits_next(place_index : in natural) is


function list_exits_name(place_index : in natural) return string is


function list_exits_done(place_index : in natural) return boolean is

a_place : complement.object;


-------------------------


procedure put_group(complement_name: in string;an_index : in positive;ok : out 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
		complement.put_group(a_complement,an_index,ok);
	c_array.put(the_array,a_complement);
	else
	ok := false;
  end if;
end;

procedure list_group_init(complement_name : in string) is

a_complement : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_complement,complement_name,local_ok);
	if local_ok then
		complement.list_group_init(a_complement);	
	c_array.put(the_array,a_complement);
  end if;
end;

procedure list_group_next(complement_name : in string) is

a_complement : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_complement,complement_name,local_ok);
	if local_ok then
		complement.list_group_next(a_complement);	
	c_array.put(the_array,a_complement);
  end if;
end;

function list_group_name(complement_name : in string) return string 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.list_group_name(a_complement);	
  else
  	return "";
  end if;
end;

function list_group_done(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
		complement.list_group_done(a_complement);	
  else
  	return true;
  end if;
end;


-----------------------------