|
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: 16384 (0x4000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Condition, seg_0472b3
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Text_Io, The_Hero, The_Place, Total_Actions, Complement_Array;
package body Condition is
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_Node => Left,
Right_Node => 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;
Item := Null_Object;
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;
An_Objet : in Objet.Object;
Subject : in Detail.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);
Text_Io.Put_Line (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_Node);
if Result = False then
Result := Result or Is_Right (Item.Right_Node);
end if;
when Single_Attribute =>
if Attribute.Is_A_Number (Item.The_Attribute) then
Left := Attribute.Number (Item.The_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.The_Attribute) =
Expression.Enumeration (Item.Value)) and
(Attribute.Literal (Item.The_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) =
Complement_Array.Place
(Detail.Index (Item.Animate));
when Belong =>
Result := Complement_Array.Place
(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.Exist_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;
nblk1=f
nid=a
hdr6=18
[0x00] rec0=1e rec1=00 rec2=01 rec3=02c
[0x01] rec0=1a rec1=00 rec2=04 rec3=020
[0x02] rec0=0e rec1=00 rec2=07 rec3=028
[0x03] rec0=18 rec1=00 rec2=08 rec3=030
[0x04] rec0=1b rec1=00 rec2=0e rec3=010
[0x05] rec0=16 rec1=00 rec2=05 rec3=046
[0x06] rec0=1a rec1=00 rec2=02 rec3=010
[0x07] rec0=01 rec1=00 rec2=06 rec3=014
[0x08] rec0=15 rec1=00 rec2=0c rec3=022
[0x09] rec0=14 rec1=00 rec2=0f rec3=086
[0x0a] rec0=16 rec1=00 rec2=0b rec3=02a
[0x0b] rec0=0e rec1=00 rec2=09 rec3=000
[0x0c] rec0=0c rec1=00 rec2=0b rec3=000
[0x0d] rec0=c0 rec1=00 rec2=00 rec3=002
[0x0e] rec0=00 rec1=00 rec2=00 rec3=019
tail 0x2174a5ad686535e1576f0 0x42a00088462060003
Free Block Chain:
0xa: 0000 00 0d 00 26 80 09 61 74 65 5f 4d 65 65 74 3b 09 ┆ & ate_Meet; ┆
0xd: 0000 00 03 03 fc 80 1b 5f 42 65 6c 6f 6e 67 20 28 49 ┆ _Belong (I┆
0x3: 0000 00 00 01 13 80 2c 20 20 20 20 20 20 20 20 20 20 ┆ , ┆