DataMuseum.dk

top - download

    Length: 4595 (0x11f3)
    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 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 Name;

    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;