|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 68695 (0x10c57)
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«
└─⟦b00396f2f⟧
└─⟦this⟧
-- Index generic --
generic
with element_image(an_index : natural) return string;
package index is
type object is private;
procedure put (item : out object;an_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
index : natural :=0;
end record;
null_object : constant object := (index =>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 : " & image(item));
end;
function value(item : in object) return natural is
begin
return item.object;
end;
function image(item : in object) return string is
begin
return element_image(item.object);
end;
end;
-- Index Complement --
with index
package complement_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,complement_identifier_array;
package body animate_list is
animate_index is new index(element_image => complement_identifier.image);
-- avec le zero !!!!!!!!!!!
animate_index_list is new exclusive_list_generic (element => animate_index.object,
null_element=>animate_index.null_object,
show_element=>animate_index.show,
element_image=>animate_index.image);
the_list : animate_index_list.object := index_list.null_object;
the_iterator : animate_list.iterator;
procedure put(animate_index : in positive;ok : out boolean) is
iterator : animate_list.iterator;
an_index := animate_index.object;
local_ok : boolean := false;
begin
animate_index.put(an_index,animate_index);
animate_list.init(iterator,the_list); -- voir exclusive list
while not done(iterator) and not local_ok loop
local_ok := value(iterator) = an_index;
animate_list.next(iterator);
end loop;
if not local_ok then
animate_list.make(an_index,list.object); ?????????????
end if;
ok:= not local_ok;
end;
procedure show is
begin
text_io.put_line("Animate List :");
animate_list.show(the_list);
end;
procedure init is
begin
animate_list.init(the_iterator,the_list); -- voir ordre
end;
procedure next is
begin
animate_list.next(the_iterator);
end;
function value return positive is
begin
return animate_list.value(the_iterator);
end;
function done return boolean is
begin
return animate_list.done(the_iterator);
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;
-- 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;
-- 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_id_array au debut
group_index is new index(element_image => group_identifier.image);
-- avec le zero !!!!!!!!!!!
animate_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
the_group_list : group_list.object := group_list.null_object;
the_group_iterator : group_list.iterator := group_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, := (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;
-------------------------
procedure put(item : in out object;an_index : in positive;ok : out boolean) is
iterator : group_list.iterator;
an_index := group_index.object;
local_ok : boolean := false;
begin
group_index.put(an_index,group_index);
group_list.init(iterator,item.the_group_list); -- voir exclusive list
while not done(iterator) and not local_ok loop
local_ok := value(iterator) = an_index;
group_list.next(iterator);
end loop;
if not local_ok then
group_list.make(an_index,item.the_group_list); -- ???????????
end if;
ok:= not local_ok;
end;
procedure show is
begin
text_io.put_line("group List :");
group_list.show(item.the_group_list);
end;
procedure init is
begin
group_list.init(item.the_group_iterator,item.the_group_list); -- voir ordre
end;
procedure next is
begin
group_list.next(item.the_group_iterator);
end;
function value return positive is
begin
return group_list.value(item.the_group_iterator);
end;
function done return boolean is
begin
return group_list.done(the_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
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 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;
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);
c_array.put(the_array,a_subject);
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);
c_array.put(the_array,a_subject);
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);
c_array.put(the_array,a_subject);
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);
c_array.put(the_array,a_subject);
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);
c_array.put(the_array,a_subject);
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);
c_array.put(the_array,a_subject);
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);
c_array.put(the_array,an_animate);
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);
c_array.put(the_array,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);
c_array.put(the_array,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);
c_array.put(the_array,a_place);
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);
c_array.put(the_array,a_subject);
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);
c_array.put(the_array,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);
c_array.put(the_array,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 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;
-----------------------------
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;
package group_identifier_array is
procedure put(group_name : in string;ok : out boolean);
procedure show;
function length return natural;
function is_empty return boolean;
function index(group_name : in string) return natural;
function image(group_index : in natural) return string;
end;
with identifier;
package body group_identifier_array is
max_elememt : constant positive := 300;
subtype element_index is natural 0..max_element;
type unconstraint_array is array(element_index range <>) of identifier;
null_unconstraint_array : constant unconstraint_array(1..0) := (others=>identifier.null_object);
the_array is (length : element_index :=0) is
record
object : unconstraint_array := null_unconstraint_array;
end record;
procedure put(group_name : in string;ok : out boolean) is
group_index :natural;
begin
if index(group_name)=0 then
the_array.object := (length=>the_array.length+1,object=>the_array.object & identifier.from_string(group_name));
ok := true;
else
ok:=false;
end if;
end;
procedure show is
begin
text_io.put_line("Group Array : "); -- a modifier dans field array
for i in 1 .. the_array.length loop
identifier.show(the_array.object(i));
end loop;
end;
function length return natural is
begin
return the_array.length;
end;
function is_empty return boolean is
begin
return the_array.length = 0;
end;
function index(group_name : in string) return natural is
an_index : natural := 0;
found : boolean : false;
begin
if not is_empty then
while an_index <= item.length and then identifier.image(the_array.object(an_index)) != group_name then
an_index:=an_index+1;
end loop;
end if;
if identifier.image(the_array.object(an_index) = group_name then
return an_index;
else
return 0;
end if;
end;
function image(group_index : in positive) return string is
begin
if group_index <= the_array.length then
return identifier.image(the_array(group_index));
else
return "";
end if;
end;
end;