DataMuseum.dk

top - download

    Length: 19957 (0x4df5)
    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« 
        └─⟦b1ed14e0e⟧ 
            └─⟦this⟧ 

TextFile

-- complement  --

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

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

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

procedure put_name(item : in out object;name : in string;ok : out boolean); 
procedure put_word(item : out object;word : in string);

procedure create_number(item : out object;field_name: in string; ok : out boolean);
procedure create_sentence(item : out object;field_name: in string; ok : out boolean);
procedure create_enumerate(item : out object;field_name: in string; ok : out boolean);
procedure Put_number (Item : in out Object;field_name: in string;number : in integer; ok : out boolean);
procedure Put_sentence (Item : in out Object;field_name: in string;sentence : in string; ok : out boolean);
procedure Put_enumerate (Item : in out Object;field_name: in string;enumeration,literal : in positive; ok : out boolean);

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

procedure put_exit(item : in out object;name,enumeration,literal,start_place,start_direction,
next_place,next_direction : in positive;ok : out boolean);
function exit_exist(item : in out object;direction : in positive) return boolean;
function enumeration_exit(item : in out object;direction : in positive) return natural;
function literal_exit(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;

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

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

function field_is_a_number (item : in object;field_name : in string) return boolean;
function field_is_a_sentence (item : in object;field_name : in string) return boolean;
function field_is_an_enumerate (item : in object;field_name : in string) return boolean;
function field_belong (item : in object;field_name : in string) 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 name (item : in object) return string;
function place (item : in object) return natural; 
function number (Item : in Object,field_name:in string) return Integer;
function sentence (Item : in Object,field_name:in string) return String;
function Enumeration (Item : in Object,field_name:in string) return Natural;
function Literal (Item : in Object,field_name:in string) return Natural;

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

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

package field_list is new list_generic (element => field.object);

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

package link_list is new list_generic (element => link.object);

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

type object(kind : complement_kind := unknown) is record
case kind is
when animate =>
   animate_name : identifier.object := idenfitifier.null_object;
--    animate_fields : field_array.object := field_array.null_object;
    animate_fields : field_list.list := field_list.nil;
		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.nil;
 	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.nil;
 entity_place : natural :=0; 
 when word =>
 word_value : identifier.object := idenfitifier.null_object;
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.nil,
		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.nil,
 	exits =>link_list.nil,
  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.nil,
 entity_place =>0);

end;

with Text_Io;
use Text_Io;
package body complement is

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

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

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

begin
  item := (kind=>word,word_value=>identifier.null_object);
  identifier.put(item.word_value,word);
end;

--procedure get_field(item : in out object;a_field : out field.object;field_name; 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 | 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 | unknown=>
 	ok := false;
 end case;
end;

procedure put_fields(item : in out object;list : in field_list) is

begin

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

iterator : field_list.iterator;
list : field_list;
the_same : boolean:=false;

begin
 get_fields(item,list,ok);
 if ok then 
		field_list.init(iterator,list);
		while not field_list.done(iterator) and not the_same loop
			a_field := field_list.value(iterator);
			the_same := name(a_field) = field_name;
			field_list.next(iterator);
		end loop;		
 		if the_same then
 			ok:=true;
 		else
 			ok:=false;
 		end if;
 end if;
end;

--function field_belong (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_belong (item : in object;field_name : in string) return boolean is

iterator : field_list.iterator;
list : field_list;
ok : boolean:=false;

begin
 get_fields(item,list,ok);
 if ok then 
		field_list.init(iterator,list);
		while not field_list.done(iterator) and not ok loop
			ok := field_name = name(field_list.value(iterator));
			field_list.next(iterator);
		end loop;		
		return ok;
	else
		return false;
	end if;
end;

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

list : field_list;

begin
 		if not field_belong(item,field_name) then
 			get_fields(item,list,ok);
 			if ok then
 				field_list.make(a_field,list);
 				put_fields(item,list);
 			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 | unknown=>
-- null;
-- end case;
--end;


    procedure create_number(item : out object;field_name: in string; ok : out boolean) is
    
    a_field : field.object;
    
    begin
			 if not field_belong(item,field_name) then
      	 field.create_number(a_field,field_name);
		 	   put_field(item,field_name);
		 	   ok := true;
		   else
	  		 ok := false;
			end if;
    end;
    
    procedure create_sentence(item : out object;field_name: in string; ok : out boolean);

    a_field : field.object;
 
    begin
			 if not field_belong(item,field_name) then
      	   field.create_sentence(a_field,field_name);
		 	     put_field(item,field_name);
		 	     ok =true;
			else 
				ok:=false;
			end if;
    end;

    procedure create_enumerate(item : out object;field_name: in string; ok : out boolean);

    a_field : field.object;
    
    begin
				 if not field_belong(item,field_name) then
      	   field.create_enumerate(a_field,field_name);
		 	     put_field(item,field_name);
		 	     ok=true;
		   else
	  		 ok := false;
			end if;
    end;

    procedure Put_number (Item : in out Object;field_name: in string;number : in integer; ok : out boolean);

    a_field : field.object;
 
    begin
			get_field(item,a_field,field_name,ok);
 			if ok then
       field.put_number(a_field,number,ok);
       if ok then
		 	 	 put_field(item,field_name);
		   end if;
		  end if;
    end;

    procedure Put_sentence (Item : in out Object;field_name: in string;sentence : in string; ok : out boolean);

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

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

    a_field : field.object;
    
    begin
			 get_field(item,a_field,field_name,ok);
 			 if ok then
      	 field.put_enumerate(a_field,enumeration,literal,ok);
      	 if ok then
		 	     put_field(item,field_name);
		   	 end if;
		   end if;
    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

the_same : boolean := false;

begin
  if item.kind = place then
  	link_list.init(item.exits_iterator,item.exits);
  	while not link_list.done(item.exits_iterator) and not the_same loop
  		the_same := link.start_direction(link_list.value(item.exits_iterator)) = direction;
  		link_list.next(item.exits_iterator);
  	end loop;
   return the_same;
   else
 return false;
end if;
end;

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

a_link : link.object;
the_same : boolean := false;

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

procedure found_link(item : in out object;direction : in positive;a_link: out link.object;ok : ou boolean) is

the_same : boolean :=false;

begin
  if item.kind = place then
  	link_list.init(item.exits_iterator,item.exits);
  	while not link_list.done(item.exits_iterator) and not the_same loop
  		the_same := link.start_direction(link_list.value(item.exits_iterator)) = direction;
  		link_list.next(item.exits_iterator);
  	end loop;
  	if the_same then
  		a_link:=link_list.value(item.exits_iterator);
  		ok:=true;
  	else
  	ok:=false;
  end if;
  else
	ok:=false;
	end if;
end;

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

a_link : link.object;
exist : boolean;

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

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

begin
 found_link(item,a_link,direction,exist);
mount df1: if exist 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

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

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

begin
 found_link(item,a_link,direction,exist);
 if exist then
	 return link.next_place(a_link);
 else
	return 0;
 end if;
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 : movement_list.iterator;
exits_iterator : link_list.iterator;

begin
	put("Complement : Kind : " & complement_kind'image(item.kind)); 
	case item.kind is
	when animate => 
	put_line (" Name : " & name(item) & " Place : " & natural'image(item.animate_place));  
  field_array.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 =>
	put_line (" Name : " & name(item)); 
	field_array.show(item.place_fields);
	link_list.init(exits_iterator,item.exits);
	while not link_list.done(exits_iterator) loop
	link.show(link_list.value(exits_iterator));
	link_list.next(exits_iterator);
	end loop;
	when entity => 
	put_line (" Name : " & name(item) & " Place : " & natural'image(item.entity_place));  
	field_array.show(item.entity_fields);
  when word =>
	put_line (" Name : " & name(item)); 
  when unknown =>
  new_line;
  end case;
end if;
end;

procedure list_exits_init(item : in out object) is

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

procedure list_exits_next(item : in out object) is

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


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

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

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

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

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

a_field : field.object;
exist : boolean;

begin
 get_field(item,a_field,field_name,exist);
 if exist then
 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

a_field : field.object;
exist : boolean;

begin
 get_field(item,a_field,field_name,exist);
 if exist 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

a_field : field.object;
exist : boolean;

begin
 get_field(item,a_field,field_name,exist);
 if exist then
   return field.is_an_enumerate(a_field);
 else
   return false;
 end if;
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 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 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 number (Item : in Object,field_name:in string) return Integer is

a_field : field.object;
exist boolean;

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

function sentence (Item : in Object,field_name:in string) return String is

a_field : field.object;
exist : boolean;

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

function Enumeration (Item : in Object,field_name:in string) return Natural is

a_field : field.object;
exist : boolean;

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

function Literal (Item : in Object,field_name:in string) return Natural is

a_field : field.object;
exist : boolean;

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

right : boolean;

begin

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

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

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

end