DataMuseum.dk Presents historical artifacts from the history of: Rational R1000/400

This is an automatic "excavation" of a thematic subset of artifacts from Datamuseum.dk's BitArchive. See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software.

top - download

⟦3de887ba3⟧ Ada Source

    Length: 6144 (0x1800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Physicalobject, seg_00c7fa

Derivation

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

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;

    nblk1=5
    nid=0
    hdr6=a
        [0x00] rec0=1d rec1=00 rec2=01 rec3=024
        [0x01] rec0=1a rec1=00 rec2=02 rec3=016
        [0x02] rec0=1c rec1=00 rec2=03 rec3=034
        [0x03] rec0=1c rec1=00 rec2=04 rec3=010
        [0x04] rec0=1b rec1=00 rec2=05 rec3=000
    tail 0x2170984e082074fc9cdc7 0x42a00088462060003