|
|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
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⟧
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;