DataMuseum.dk

top - download

    Length: 5226 (0x146a)
    Types: TextFile
    Names: »CLASSBEHAV_ADA«

└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
    └─ ⟦6f12a12be⟧ »DATA« 
        └─⟦this⟧ 
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
    └─ ⟦d65440be7⟧ »DATA« 
        └─⟦this⟧ 

TextFile

with expertSystem,instanceCounter;

separate(expertSystem)

package body classBehavior is

  type cellElement is record
	cell   : element;
	free   : boolean := TRUE;
        masked : boolean := FALSE;
   end record;

   type eltArray is array(1..taille) of cellElement;

   type classSet is record
	classArray : eltArray;
	count      : natural := 0;
   end record;

   localClass  : idC := 1;
   contents    : classSet;
   theVisibleCollection  : collection.object;
   theCompleteCollection : collection.object;

   function allocate(initValue : element) return expertSystem.reference is
      ref : expertSystem.reference;
   begin
      if contents.count + 1 = contents.classArray'LAST then
	 raise classFull;
      end if;
      for i in contents.classArray'RANGE loop
	 if contents.classArray(i).free then
	    contents.count := contents.count + 1;
	    contents.classArray(i) := cellElement'(initValue,FALSE,FALSE);
	    ref.idObject := i;
	    exit;
	 end if;
      end loop;
      ref.idClass := localClass;
      ref.date    := instanceCounter.newObject;
      collection.add(theVisibleCollection, ref);
      collection.add(theCompleteCollection, ref);
      return ref;
   end allocate;

   procedure allocate(initValue : element) is
      r : expertSystem.reference;
   begin
      r := allocate(initValue);
   end allocate;

   procedure dispose(aRef : expertSystem.reference) is
   begin
      if aRef.idClass /= localClass then
         raise badClass;
      end if;
      if contents.classArray(aRef.idObject).free then
         raise badReference;
      end if;
      contents.classArray(aRef.idObject).free := TRUE;
      contents.classArray(aRef.idObject).masked := FALSE;
      contents.count := contents.count - 1;
      collection.remove(theVisibleCollection, aRef);
      collection.remove(theCompleteCollection, aRef);
   end dispose;

   procedure clear is
   begin
      for i in contents.classArray'RANGE loop
	 contents.classArray(i).free  :=TRUE;
	 contents.classArray(i).masked:=FALSE;
      end loop;
      collection.clear(theVisibleCollection);
      collection.clear(theCompleteCollection);
   end clear;

   procedure mask     (aRef : expertSystem.reference) is
   begin
      if aRef.idClass /= localClass then
	 raise badClass;
      end if;
      if contents.classArray(aRef.idObject).free then
         raise badReference;
      end if;
      if contents.classArray(aRef.idObject).masked=FALSE then
	 contents.classArray(aRef.idObject).masked:=TRUE;
         collection.upDate(theCompleteCollection,aRef);
         collection.remove(theVisibleCollection,aRef);
      end if;
   end mask;

   procedure maskAll is
   begin
      for i in contents.classArray'RANGE loop
	 contents.classArray(i).masked:=TRUE;
      end loop;
      collection.upDateAll(theCompleteCollection);
      collection.clear(theVisibleCollection);
   end maskAll;

   procedure unmask   (aRef : expertSystem.reference) is
      sameRef : expertSystem.reference;
      aDate   : long_integer;
   begin
      if aRef.idClass /= localClass then
	 raise badClass;
      end if;
      if contents.classArray(aRef.idObject).free then
         raise badReference;
      end if;
      if contents.classArray(aRef.idObject).masked=TRUE then
	 contents.classArray(aRef.idObject).masked:=FALSE;
         aDate:=instanceCounter.newObject;
         collection.upDate(theCompleteCollection,aRef,aDate);	
         sameRef := aRef; 
  	 sameRef.date :=aDate;
         collection.add(theVisibleCollection,sameRef);
      end if;
   end unmask;

   procedure unmaskAll is
   begin
      for i in contents.classArray'RANGE loop
	 contents.classArray(i).masked:=FALSE;
      end loop;
      collection.upDateAll(theCompleteCollection);
      theVisibleCollection:=theCompleteCollection;
   end unmaskAll;

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

   function allInstances return collection.object is
   begin
      return theCompleteCollection;
   end allInstances;

   function cardinality return natural is
   begin
      return contents.count;
   end cardinality;

   function get(aRef : expertSystem.reference) return element is
   begin
      if aRef.idClass /= localClass then
	 raise badClass;
      end if;
      if contents.classArray(aRef.idObject).free then
	 raise badReference;
      end if;
      return contents.classArray(aRef.idObject).cell;		
   end get;

   procedure set(aRef : expertSystem.reference; withValue : element) is
      aDate : long_integer;
   begin
      if aRef.idClass /= localClass then
	 raise badClass;
      end if;
      if contents.classArray(aRef.idObject).free then
         raise badReference;
      end if;
      contents.classArray(aRef.idObject).cell := withValue;
      aDate := instanceCounter.newObject;
      collection.upDate(theCompleteCollection,aRef,aDate);
      collection.upDate(theVisibleCollection,aRef,aDate);
   end set;

   function name return className is
   begin
      return surName;
   end name;

   function name(aRef : expertSystem.reference) return objectName is
   begin
      return refName(aRef);
   end name;

begin
   localClass := instanceCounter.newClass(surname);
end classBehavior;