DataMuseum.dk

top - download

    Length: 4185 (0x1059)
    Types: TextFile
    Notes: R1k Text-file segment

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

TextFile

with monkey;
package body physicalObject is

   package behaviour is new classBehavior(object,"PHYSICAL  ");

   procedure make  (name	  : physical_object;
		    is_at	  : coordinate;
		    weight	  : weight_type;
		    on	  	  : physical_object) is
      the_physical_object : physicalObject.object;
      unique_name         : boolean := TRUE;
      an_object_exists    : boolean := FALSE;
      ref                 : reference;
      card                : natural;
   begin
      the_physical_object.name   := name;
      the_physical_object.is_at  := is_at;
      the_physical_object.weight := weight;
      the_physical_object.on     := on;

      if (the_physical_object.name = nil) or 
         (the_physical_object.name = floor) or
         (the_physical_object.name = ceiling) then
         raise illegal_make;
      end if;
      card := collection.cardinality(behaviour.instances);
      for i in 1..card loop
         ref := collection.get(behaviour.instances, i);
         if behaviour.get(ref).name = the_physical_object.name then
            unique_name := FALSE;
            exit;
         end if;
      end loop;
      if not unique_name then
         raise illegal_make;
      end if;

      if the_physical_object.on = nil then
	 declare
	    monk : reference;

            function same_at_value(a_monkey : reference) return boolean is
            begin
               return 
                  monkey.is_at(a_monkey) = the_physical_object.is_at	and then
		  monkey.holds(a_monkey) = the_physical_object.name;
            end same_at_value;

            function find_a_monkey is new collection.findOne(same_at_value);
	 begin
  	    monk := find_a_monkey(monkey.instances);
	    if collection.isNull(monk) then
	       raise illegal_make;
	    end if;
         end;
      end if;
      if the_physical_object.on /= nil and
	 the_physical_object.on /= floor and
	 the_physical_object.on /= ceiling then
         for i in 1..card loop
            ref := collection.get(behaviour.instances, i);
            if behaviour.get(ref).name = the_physical_object.on then
               an_object_exists := TRUE;
               exit;
            end if;
         end loop;
         if not an_object_exists then
            raise illegal_make;
         end if;
      end if;
      
      behaviour.allocate(the_physical_object);      
   end make;

   function name   (the_reference : in expertSystem.reference) 
                 return physical_object is
   begin
      return behaviour.get(the_reference).name;
   end;

   function is_at  (the_reference : in expertSystem.reference)
                 return coordinate is
   begin
      return behaviour.get(the_reference).is_at;
   end is_at;

   function weight (the_reference : in expertSystem.reference)
                 return weight_type is
   begin
      return behaviour.get(the_reference).weight;
   end weight;

   function is_on  (the_reference : in expertSystem.reference)
		 return physical_object is
   begin
      return behaviour.get(the_reference).on;
   end is_on;

   procedure modify_coordinate (the_reference  : in expertSystem.reference;
				new_coordinate : in coordinate) is
      the_object : object;
   begin
      the_object := behaviour.get(the_reference);
      the_object.is_at := new_coordinate;
      behaviour.set(the_reference, the_object);
   end modify_coordinate;

   procedure modify_weight     (the_reference  : in expertSystem.reference;
				new_weight     : in weight_type) is
      the_object : object;
   begin
      the_object := behaviour.get(the_reference);
      the_object.weight := new_weight;
      behaviour.set(the_reference, the_object);
   end modify_weight;

   procedure modify_is_on      (the_reference  : in expertSystem.reference;
				new_object     : in physical_object) is
      the_object : object;
   begin
      the_object := behaviour.get(the_reference);
      the_object.on := new_object;
      behaviour.set(the_reference, the_object);
   end modify_is_on;

   function instances return collection.object is
   begin
      return behaviour.instances;
   end instances;

   procedure clear is
   begin
      behaviour.clear;
   end clear;

end physicalObject;