|
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 - metrics - download
Length: 12962 (0x32a2)
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«
└─⟦f941626bb⟧
└─⟦this⟧
with Attribute, Objet, detail,Expression;:
package Condition is
type Node_Kind is (Et, Ou, Single_Attribute, Hero, Place,
Actions, Meet, Belong, Attribute_Exist,
Exits_Exist, Subject_Exist, Unknown);
package Visible is
subtype Operator is Node_Kind range Et .. Ou;
type Compare_Kind is (Equal, Not_Equal, Less, Greater,
Greater_Equal, Less_Equal);
type Binary_Kind is (Yes, No);
end Visible;
use Visible;
type Object is private;
procedure Create (Item : out Object;
Kind : in Operator;
Left, Right : in Object);
procedure Create_Compare (Item : out Object;
An_Attribute : in Attribute.Object;
Symbol : in Compare_Kind;
An_Expression : in Expression.Object;
Ok : out Boolean);
procedure Create_Hero (Item : out Object; A_Hero : in detail.object);
procedure Create_Place (Item : out Object; A_Place : in detail.object);
procedure Create_Actions (Item : out Object; Number : in Positive);
procedure Create_Meet (Item : out Object; an_Animate : in detail.object);
procedure Create_Belong (Item : out Object;
An_Objet : in Objet.Object;
subject : detail.object;
Binary : in Binary_Kind);
procedure Create_Attribute_Exist (Item : out Object;
An_Attribute : in Attribute.Object;
Binary : in Binary_Kind);
procedure Create_Exits_Exist (Item : out Object;
A_room : in Objet.Object;
Binary : in Binary_Kind);
procedure Create_Subject_Exist (Item : out Object;
a_Subject : in detail.object;
Binary : in Binary_Kind);
procedure Show (Item : in Object);
function Is_Right (Item : in Object) return Boolean;
Null_Object : constant Object;
private
type Node (Kind : Node_Kind := Unknown);
type Object is access Node;
Null_Object : constant Object := null; --(kind=>unknown);
end Condition;
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_node, Right_node : Object;
when Single_Attribute =>
the_Attribute : Attribute.Object := Attribute.Null_Object;
Compare : Compare_Kind;
Value : Expression.Object := Expression.Null_Object;
when Hero =>
other_Hero : detail.object := detail.null_object;
when Place =>
other_Place : detail.object := detail.null_object;
when Actions =>
Actions_Number : Natural := 0;
when Meet =>
Animate : detail.object := detail.null_object;
when Belong =>
owner : 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 =>
room : Objet.Object := Objet.Null_Object;
Exits_Binary : Binary_Kind;
when Subject_Exist =>
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 _node=> Left, Right_node => 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,
the_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, other_Hero => A_Hero);
end Create_Hero;
procedure Create_Place (Item : out Object; A_Place : in detail.object) is
begin
Item := new Node'(Kind => Place, other_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; an_Animate : in detail.object) is
begin
Item := new Node'(Kind => Meet, Animate => an_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,
owner => 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;
a_room : in Objet.Object;
Binary : in Binary_Kind) is
begin
Item := new Node'(Kind => Exits_Exist,
room => A_room,
Exits_Binary => Binary);
end Create_Exits_Exist;
procedure Create_Subject_Exist (Item : out Object;
a_Subject : in detail.object;
Binary : in Binary_Kind) is
begin
Item := new Node'(Kind => Subject_Exist,
exist_Subject => a_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_node);
Text_Io.Put (" " & Operator'Image (Item.Kind) & " ");
Show (Item.Right_node);
Text_Io.New_Line;
when Single_Attribute =>
Attribute.Show (Item.the_Attribute);
Text_Io.Put_Line (Compare_Kind'Image (Item.Compare));
Expression.Show (Item.Value);
when Hero =>
The_Hero.Show;
detail.show(Item.other_Hero);
when Place =>
The_Place.Show;
detail.show(Item.other_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.owner);
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.room);
when Subject_Exist =>
Text_Io.Put_Line
("subject_Exist : Binary : " &
Binary_Kind'Image (Item.Subject_Binary));
detail.show(Item.exist_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_node);
if Result = True then
Result := Result and Is_Right (Item.Right_node);
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));
if item.compare = not_equal then
result := not result;
end if;
end if;
when Hero =>
Result := The_Hero.Index = detail.index(Item.other_Hero);
when Place =>
Result := The_Place.Index = detail.index(Item.other_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.index(Item.Belong_subject) =
Objet.Complement (Item.owner);
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.room));
if Item.Exits_Binary = No then
Result := not Result;
end if;
when Subject_Exist =>
Result := Complement_Array.Place (detail.index(Item.Subject_exist)) /= 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;