DataMuseum.dk

top - download

    Length: 5778 (0x1692)
    Types: TextFile
    Names: »B«

└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
    └─ ⟦124ff5788⟧ »DATA« 
        └─⟦this⟧ 
└─⟦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;