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

⟦dae2bc779⟧ Ada Source

    Length: 7168 (0x1c00)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Goal, seg_00c7f5

Derivation

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

with Physicalobject;
package body Goal is

    package Behaviour is new Classbehavior (Object, "GOALS     ");

    procedure Make (Status : Goal_State;
                    Goal_Type : G_Type;
                    Name : Physical_Object;
                    Go_To : Coordinate) is
        The_Goal : Goal.Object;
    begin
        The_Goal.Status := Status;
        The_Goal.Goal_Type := Goal_Type;
        The_Goal.Name := Name;
        The_Goal.Go_To := Go_To;

        if The_Goal.Goal_Type = Holds and The_Goal.Name /= Nil then
            declare
                Obj : Reference;

                function Light_Object (An_Object : Reference) return Boolean is
                begin
                    return Physicalobject.Name (An_Object) =
                              The_Goal.Name and then
                           Physicalobject.Weight (An_Object) = Light;
                end Light_Object;

                function Find_An_Object is
                   new Collection.Findone (Light_Object);
            begin
                Obj := Find_An_Object (Physicalobject.Instances);
                if Collection.Isnull (Obj) then
                    raise Illegal_Make;
                end if;
            end;
        end if;

        if The_Goal.Goal_Type = Is_On and The_Goal.Name /= Floor then
            declare
                Obj : Reference;

                function Climb_On (An_Object : Reference) return Boolean is
                begin
                    return Physicalobject.Name (An_Object) = The_Goal.Name;
                end Climb_On;

                function Find_An_Object is new Collection.Findone (Climb_On);
            begin
                Obj := Find_An_Object (Physicalobject.Instances);
                if Collection.Isnull (Obj) then
                    raise Illegal_Make;
                end if;
            end;
        end if;

        if The_Goal.Goal_Type = Is_At and The_Goal.Name /= Nil then
            declare
                Obj : Reference;

                function Move (An_Object : Reference) return Boolean is
                begin
                    return Physicalobject.Name (An_Object) = The_Goal.Name;
                end Move;

                function Find_An_Object is new Collection.Findone (Move);
            begin
                Obj := Find_An_Object (Physicalobject.Instances);
                if Collection.Isnull (Obj) then
                    raise Illegal_Make;
                end if;
            end;
        end if;

        Behaviour.Allocate (The_Goal);
    end Make;

    function Status (The_Reference : in Expertsystem.Reference)
                    return Goal_State is
    begin
        return Behaviour.Get (The_Reference).Status;
    end Status;

    function Goal_Type
                (The_Reference : in Expertsystem.Reference) return G_Type is
    begin
        return Behaviour.Get (The_Reference).Goal_Type;
    end Goal_Type;

    function Object_Name (The_Reference : in Expertsystem.Reference)
                         return Physical_Object is
    begin
        return Behaviour.Get (The_Reference).Name;
    end Object_Name;

    function Go_To (The_Reference : in Expertsystem.Reference)
                   return Coordinate is
    begin
        return Behaviour.Get (The_Reference).Go_To;
    end Go_To;

    procedure Modify_Status (The_Reference : in Expertsystem.Reference;
                             New_Status : in Goal_State) is
        The_Object : Object;
    begin
        The_Object := Behaviour.Get (The_Reference);
        The_Object.Status := New_Status;
        Behaviour.Set (The_Reference, The_Object);
    end Modify_Status;

    procedure Modify_Goal_Type (The_Reference : in Expertsystem.Reference;
                                New_Type : in G_Type) is
        The_Object : Object;
    begin
        The_Object := Behaviour.Get (The_Reference);
        The_Object.Goal_Type := New_Type;
        Behaviour.Set (The_Reference, The_Object);
    end Modify_Goal_Type;

    procedure Modify_Object_Name (The_Reference : in Expertsystem.Reference;
                                  New_Object : in Physical_Object) is
        The_Object : Object;
    begin
        The_Object := Behaviour.Get (The_Reference);
        The_Object.Name := New_Object;
        Behaviour.Set (The_Reference, The_Object);
    end Modify_Object_Name;

    procedure Modify_Go_To (The_Reference : in Expertsystem.Reference;
                            New_Location : in Coordinate) is
        The_Object : Object;
    begin
        The_Object := Behaviour.Get (The_Reference);
        The_Object.Go_To := New_Location;
        Behaviour.Set (The_Reference, The_Object);
    end Modify_Go_To;

    function Instances return Collection.Object is
    begin
        return Behaviour.Instances;
    end Instances;

    procedure Clear is
    begin
        Behaviour.Clear;
    end Clear;

end Goal;

    nblk1=6
    nid=0
    hdr6=c
        [0x00] rec0=1e rec1=00 rec2=01 rec3=014
        [0x01] rec0=1b rec1=00 rec2=02 rec3=060
        [0x02] rec0=1e rec1=00 rec2=03 rec3=042
        [0x03] rec0=1c rec1=00 rec2=04 rec3=02e
        [0x04] rec0=1a rec1=00 rec2=05 rec3=024
        [0x05] rec0=09 rec1=00 rec2=06 rec3=000
    tail 0x21508e8f882074fc47edc 0x42a00088462060003