DataMuseum.dk

top - download

    Length: 4888 (0x1318)
    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 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;