|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 10467 (0x28e3)
Types: TextFile
Notes: R1k Text-file segment
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦76ab400f3⟧
└─⟦this⟧
with Text_Io, The_Hero, The_Place, Total_Actions,
Complement_Identifier_Array, Complement_Array;
package body Condition is
type Node (Kind : Node_Kind := Unknown) is
record
case Kind is
when Et | Ou =>
Left, Right : Object;
when Single_Attribute =>
An_Attribute : Attribute.Object := Attribute.Null_Object;
Compare : Compare_Kind;
Value : Expression.Object := Expression.Null_Object;
when Hero =>
A_Hero : detail.object := detail.null_object;
when Place =>
A_Place : detail.object := detail.null_object;
when Actions =>
Actions_Number : Natural := 0;
when Meet =>
Animate : detail.object := detail.null_object;
when Belong =>
An_Objet : Objet.Object := Objet.Null_Object;
Belong_subject : detail.object := detail.null_object;
Belong_Binary : Binary_Kind;
when Attribute_Exist =>
Exist_Attribute : Attribute.Object := Attribute.Null_Object;
Attribute_Binary : Binary_Kind;
when Exits_Exist =>
Exist_Objet : Objet.Object := Objet.Null_Object;
Exits_Binary : Binary_Kind;
when Subject_Exist =>
Subject : detail.object := detail.null_object;
Subject_Binary : Binary_Kind;
when Unknown =>
null;
end case;
end record;
procedure Create (Item : out Object;
Kind : in Operator;
Left, Right : in Object) is
begin
if Kind = Et then
Item := new Node'(Kind => Et, Left => Left, Right => Right);
else
Item := new Node'(Kind => Ou, Left => Left, Right => Right);
end if;
end Create;
procedure Create_Compare (Item : out Object;
An_Attribute : in Attribute.Object;
Symbol : in Compare_Kind;
An_Expression : in Expression.Object;
Ok : out Boolean) is
begin
if (Attribute.Is_A_Number (An_Attribute) and
Expression.Is_A_Number (An_Expression)) or
(Attribute.Is_An_Enumerate (An_Attribute) and
Expression.Is_An_Enumerate (An_Expression) and (Symbol = Equal or Symbol = not_Equal) then
Ok := True;
Item := new Node'(Kind => Single_Attribute,
An_Attribute => An_Attribute,
Compare => Symbol,
Value => An_Expression);
else
Ok := False;
end if;
end Create_Compare;
procedure Create_Hero (Item : out Object; A_Hero : in detail.object) is
begin
Item := new Node'(Kind => Hero, A_Hero => A_Hero);
end Create_Hero;
procedure Create_Place (Item : out Object; A_Place : in detail.object) is
begin
Item := new Node'(Kind => Place, A_Place => A_Place);
end Create_Place;
procedure Create_Actions (Item : out Object; Number : in Positive) is
begin
Item := new Node'(Kind => Actions, Actions_Number => Number);
end Create_Actions;
procedure Create_Meet (Item : out Object; Animate : in detail.object) is
begin
Item := new Node'(Kind => Meet, Animate => Animate);
end Create_Meet;
procedure Create_Belong (Item : out Object;
subject : in detail.object;
An_Objet : in Objet.Object;
Binary : in Binary_Kind) is
begin
Item := new Node'(Kind => Belong,
An_Objet => An_Objet,
belong_subject => subject,
Belong_Binary => Binary);
end Create_Belong;
procedure Create_Attribute_Exist (Item : out Object;
An_Attribute : in Attribute.Object;
Binary : in Binary_Kind) is
begin
Item := new Node'(Kind => Attribute_Exist,
Exist_Attribute => An_Attribute,
Attribute_Binary => Binary);
end Create_Attribute_Exist;
procedure Create_Exits_Exist (Item : out Object;
An_Objet : in Objet.Object;
Binary : in Binary_Kind) is
begin
Item := new Node'(Kind => Exits_Exist,
Exist_Objet => An_Objet,
Exits_Binary => Binary);
end Create_Exits_Exist;
procedure Create_Subject_Exist (Item : out Object;
Subject : in detail.object;
Binary : in Binary_Kind) is
begin
Item := new Node'(Kind => Subject_Exist,
Subject => Subject,
Subject_Binary => Binary);
end Create_Subject_Exist;
procedure Show (Item : in Object) is
begin
case Item.Kind is
when Et | Ou =>
Show (Item.Left);
Text_Io.Put (" " & Operator'Image (Item.Kind) & " ");
Show (Item.Right);
Text_Io.New_Line;
when Single_Attribute =>
Attribute.Show (Item.An_Attribute);
Text_Io.Put_Line (Compare_Kind'Image (Item.Compare));
Expression.Show (Item.Value);
when Hero =>
The_Hero.Show;
detail.show(Item.A_Hero);
when Place =>
The_Place.Show;
detail.show(Item.A_Place);
when Actions =>
Total_Actions.Show;
Text_Io.Put_Line (Natural'Image (Item.Actions_Number));
when Meet =>
Text_Io.Put_Line ("Meet : ");
detail.show(Item.Animate);
when Belong =>
Text_Io.Put_Line ("Belong : ");
detail.show(Item.Belong_subject) &
Binary_Kind'Image (Item.Belong_Binary));
Objet.Show (Item.An_Objet);
when Attribute_Exist =>
Text_Io.Put_Line ("attribute_Exist : Binary :" &
Binary_Kind'Image (Item.Attribute_Binary));
Attribute.Show (Item.Exist_Attribute);
when Exits_Exist =>
Text_Io.Put_Line ("exits_Exist : Binary :" &
Binary_Kind'Image (Item.Exits_Binary));
Objet.Show (Item.Exist_Objet);
when Subject_Exist =>
Text_Io.Put_Line
("subject_Exist : Binary : " &
Binary_Kind'Image (Item.Subject_Binary));
detail.show(Item.Subject);
when Unknown =>
Text_Io.New_Line;
end case;
end Show;
function Is_Right (Item : in Object) return Boolean is
Left, Right : Integer;
Result : Boolean;
begin
case Item.Kind is
when Et =>
Result := Is_Right (Item.Left);
if Result = True then
Result := Result and Is_Right (Item.Right);
end if;
when Ou =>
Result := Is_Right (Item.Left);
if Result = False then
Result := Result or Is_Right (Item.Right);
end if;
when Single_Attribute =>
if Attribute.Is_A_Number (Item.An_Attribute) then
Left := Attribute.Number (Item.An_Attribute);
Right := Expression.Evaluate (Item.Value);
case Item.Compare is
when Equal =>
Result := Left = Right;
when Not_Equal =>
Result := Left /= Right;
when Less =>
Result := Left < Right;
when Greater =>
Result := Left > Right;
when Less_Equal =>
Result := Left <= Right;
when Greater_Equal =>
Result := Left >= Right;
end case;
else
Result :=
(Attribute.Enumeration (Item.An_Attribute) =
Expression.Enumeration (Item.Value)) and
(Attribute.Literal (Item.An_Attribute) =
Expression.Literal (Item.Value));
end if;
when Hero =>
Result := The_Hero.Index = detail.complement(Item.A_Hero);
when Place =>
Result := The_Place.Index = detail.complement(Item.A_Place);
when Actions =>
Result := Total_Actions.Number mod Item.Actions_Number = 0;
when Meet =>
Result := Complement_Array.Place (The_Hero.Index) =
detail.complement(Item.Animate);
when Belong =>
Result := detail.complement(Item.Belong_subject) =
Objet.Complement (Item.An_Objet);
if Item.Belong_Binary = No then
Result := not Result;
end if;
when Attribute_Exist =>
Result := Attribute.Exist (Item.Exist_Attribute);
if Item.Attribute_Binary = No then
Result := not Result;
end if;
when Exits_Exist =>
Result := Complement_Array.Exits_Exist
(Objet.Complement (Item.Exist_Objet));
if Item.Exits_Binary = No then
Result := not Result;
end if;
when Subject_Exist =>
Result := Complement_Array.Place (detail.complement(Item.Subject)) /= 0;
if Item.Subject_Binary = No then
Result := not Result;
end if;
when Unknown =>
Result := False;
end case;
return Result;
end Is_Right;
end Condition