DataMuseum.dk

top - download

    Length: 24354 (0x5f22)
    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« 
        └─⟦73b9669ab⟧ 
            └─⟦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;a_word : in identifier.object);

procedure put_verb(item : out object;a_synonym,a_verb : 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 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;a_group : in identifier.object;ok : out boolean);
function group(item : in object) return string;

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

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

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

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

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


case kind is

when animate =>
   animate_name : identifier.object := idenfitifier.null_object;

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

animate_group : identifier.object:= identifier.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_group : identifier.object:= identifier.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_group : identifier.object:= identifier.null_object; 

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

 entity_fields : field_list.list := field_list.null_object;
 entity_place : natural :=0; 

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

 when word =>
 word_value : identifier.object := idenfitifier.null_object;

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

word_group : identifier.object:= identifier.null_object; 

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

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

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

when verb =>

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

	verb_value : identifier.object := identifier.null_object;

  verb_group : identifier.object:= identifier.null_object; 

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

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

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

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

animate_object : constant object, := (
kind =>animate;
   animate_name =>identifier.null_object,   

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

 animate_group =>identifier.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 => identifier.null_object,

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

 place_group =>identifier.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 =>identifier.null_object,

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

 entity_group =>identifier.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;

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

    item.animate_group:=name;
    ok:=true;
         
         -----------------------

	 when place => 
     item.place_name:=name;

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

    item.place_group:=name;
 ok:=true                                            

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

	 when entity => 
     item.entity_name:=name;

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

    item.entity_group:=name;
         ok := true;

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

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

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

ok : boolean;

begin

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

  item := (kind=>word,word_value=>a_word,word_group => a_word);

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

end;

procedure put_verb(item : out object;a_synoym,a_verb : in identifier.object);	

ok : boolean;

begin
  
  -------------------
  
  item := (kind=>verb,verb_value=>a_synonym,verb_group=>a_verb);
  
  --------------------
    
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 : in identifier.object;ok : out boolean) is

begin

case item.kind is
when animate =>
if identifier.image(item.animate_group) = name(item) then
item.animate_group:=a_group;
ok:=true;
else
ok:=false;
end if;
when place =>
if identifier.image(item.place_group) = name(item) then
item.place_group:=a_group;
ok:=true;
else
ok:=false;
end if;
when entity =>
if identifier.image(item.entity_group) = name(item) then
item.entity_group:=a_group;
ok:=true;
else
ok:=false;
end if;
when word =>
if identifier.image(item.word_group) = name(item) then
item.word_group:=a_group;
ok:=true;
else
ok:=false;
end if;
when verb | unknown =>
 ok:=false;
end case;
end;

function group(item : in object) return string;

case item.kind is
when animate =>
return identifer.image(item.animate_group);
when place =>
return identifer.image(item.place_group);
when entity =>
return identifer.image(item.entity_group);
when word =>
return identifer.image(item.word_group);
when verb =>
return identifer.image(item.verb_group);
when unknown =>
return identifer.null_object;
end case;
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;ok : out boolean);

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

procedure put_verb(a_synonym,a_verb : in identifier.object;ok : out boolean);

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

--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 put_group(complement_name: in identifier.object;a_group: in identifier.object;ok : out boolean);
function group(complement_name: in string) return string;

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

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;

modifier show de ca5 et c

a supprimer

modifier put_verb et put_word

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

end;

procedure show;

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_verb(a_synonym,a_verb : in identifier.object;ok : out boolean) is

a_complement : complement.object;

begin
  complement.put_verb(a_complement,a_synonym,a_verb);
	c_array.put(the_array,a_complement,ok);
end;

procedure put_group(complement_name: in identifier.object;a_group : in identifier.object;ok : out boolean) is

a_complement : complement.object;
local_ok : boolean;

begin
	c_array.get(the_array,a_complement,identifier.image(complement_name),local_ok);
	if local_ok then
		complement.put_group(a_complement,a_group,ok);
	c_array.put(the_array,a_complement);
	else
	  ok := false;
  end if;
end;


function group(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.group(a_complement);
	else
	return "";
  end if;
end;

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