|
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: 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;