DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦b2a13e08a⟧ Ada Source

    Length: 11264 (0x2c00)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Items, seg_048902

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦5a81ac88f⟧ »Space Info Vol 1« 
        └─⟦this⟧ 

E3 Source Code



with Tree, List, String_Utilities, Unbounded_String;


package body Items is

    package Identifier is new Unbounded_String (1);

    subtype State_String is Identifier.Variable_String;

    package States_List is new List (Element => State_String);

    type Item is
        record
            Name : Identifier.Variable_String;
            Comment : Identifier.Variable_String;
            Position : Identifier.Variable_String;
            States : States_List.Object;
        end record;

    Current_Item : Item;
--------------------

    function Equal (S1 : State_String; S2 : String) return Boolean is

    begin
        return String_Utilities.Equal (Identifier.Image (S1), S2);
    end Equal;

    function Find_State (Somebody_States : States_List.Object; A_State : String)
                        return Boolean is

    begin
        States_List.Go_First (Somebody_States);
        while not States_List.At_End (Somebody_States) loop
            if Equal (States_List.Get_Current_Element (Somebody_States),
                      A_State) then
                return True;
            end if;
            States_List.Go_Next (Somebody_States);
        end loop;
        return False;
    end Find_State;

--------------------

    function "<" (Left, Right : Item) return Boolean is

    begin
        return String_Utilities.Less_Than
                  (Identifier.Image (Left.Name), Identifier.Image (Right.Name));
    end "<";

    function ">" (Left, Right : Item) return Boolean is

    begin
        return String_Utilities.Greater_Than
                  (Identifier.Image (Left.Name), Identifier.Image (Right.Name));
    end ">";

    package Items_Tree is new Tree
                                 (Element => Item, Nb_Preallocation_Node => 10);

    --------------------

    procedure Create (Name : String) is
        A_Item : Item;
    begin
        A_Item.Name := Identifier.Value (Name);
        Items_Tree.Insert (A_Item);
    end Create;

    procedure Set_Comment (Name : String; Comment : String) is
        A_Item : Item;
    begin
        A_Item.Name := Identifier.Value (Name);
        if Items_Tree.Find (A_Item) then  
            A_Item := Items_Tree.Get_Current_Element;
            A_Item.Comment := Identifier.Value (Comment);
            Items_Tree.Set_Current_Element (A_Item);
        end if;
    end Set_Comment;

    procedure Set_Position (Name : String; Position : String) is
        A_Item : Item;
    begin
        A_Item.Name := Identifier.Value (Name);
        if Items_Tree.Find (A_Item) then
            A_Item := Items_Tree.Get_Current_Element;
            A_Item.Position := Identifier.Value (Position);
            Items_Tree.Set_Current_Element (A_Item);
        end if;
    end Set_Position;

    procedure Add_State (Name : String; State : String) is
        A_Item : Item;
    begin
        A_Item.Name := Identifier.Value (Name);
        if Items_Tree.Find (A_Item) then
            A_Item := Items_Tree.Get_Current_Element;
            if not Find_State (A_Item.States, State) then
                States_List.Insert (A_Item.States, Identifier.Value (State));
                Items_Tree.Set_Current_Element (A_Item);
            end if;
        end if;
    end Add_State;

    procedure Remove_State (Name : String; State : String) is
        A_Item : Item;
    begin
        A_Item.Name := Identifier.Value (Name);
        if Items_Tree.Find (A_Item) then
            A_Item := Items_Tree.Get_Current_Element;
            if Find_State (A_Item.States, State) then
                States_List.Remove_Current_Element (A_Item.States);
                Items_Tree.Set_Current_Element (A_Item);
            end if;
        end if;
    end Remove_State;

    function Exists (Name : String) return Boolean is
        A_Item : Item;
    begin  
        A_Item.Name := Identifier.Value (Name);
        return Items_Tree.Find (A_Item);
    end Exists;

    function Get_Comment (Name : String) return String is
        A_Item : Item;
    begin
        A_Item.Name := Identifier.Value (Name);
        if Items_Tree.Find (A_Item) then
            A_Item := Items_Tree.Get_Current_Element;
            return Identifier.Image (A_Item.Comment);
        end if;
    end Get_Comment;

    function Get_Position (Name : String) return String is
        A_Item : Item;
    begin
        A_Item.Name := Identifier.Value (Name);
        if Items_Tree.Find (A_Item) then
            A_Item := Items_Tree.Get_Current_Element;
            return Identifier.Image (A_Item.Position);
        end if;
    end Get_Position;

    function In_State (Name : String; State : String) return Boolean is
        A_Item : Item;
    begin
        A_Item.Name := Identifier.Value (Name);
        if Items_Tree.Find (A_Item) then
            A_Item := Items_Tree.Get_Current_Element;
            return Find_State (A_Item.States, State);
        end if;
    end In_State;

    procedure Set_Current_Item (Name : String) is
        A_Item : Item;
    begin
        A_Item.Name := Identifier.Value (Name);
        if Items_Tree.Find (A_Item) then
            Current_Item := Items_Tree.Get_Current_Element;
        end if;
    end Set_Current_Item;

    procedure Go_First_State is
    begin
        States_List.Go_First (Current_Item.States);
    end Go_First_State;

    procedure Go_Next_State is
    begin
        States_List.Go_Next (Current_Item.States);
    end Go_Next_State;

    function At_End_State return Boolean is
    begin
        return States_List.At_End (Current_Item.States);
    end At_End_State;

    function Get_Current_State return String is
    begin
        return Identifier.Image
                  (States_List.Get_Current_Element (Current_Item.States));
    end Get_Current_State;

end Items;

E3 Meta Data

    nblk1=a
    nid=6
    hdr6=e
        [0x00] rec0=23 rec1=00 rec2=01 rec3=076
        [0x01] rec0=01 rec1=00 rec2=0a rec3=034
        [0x02] rec0=22 rec1=00 rec2=09 rec3=010
        [0x03] rec0=1c rec1=00 rec2=05 rec3=052
        [0x04] rec0=1a rec1=00 rec2=03 rec3=05e
        [0x05] rec0=1d rec1=00 rec2=07 rec3=06a
        [0x06] rec0=24 rec1=00 rec2=04 rec3=000
        [0x07] rec0=18 rec1=00 rec2=03 rec3=080
        [0x08] rec0=06 rec1=00 rec2=05 rec3=000
        [0x09] rec0=06 rec1=00 rec2=05 rec3=000
    tail 0x21545d7f2865a3ed61a0a 0x42a00088462060003
Free Block Chain:
  0x6: 0000  00 08 00 0d 80 07 20 49 74 65 6d 73 3b 07 00 00  ┆       Items;   ┆
  0x8: 0000  00 02 03 fc 80 16 20 20 20 20 20 72 65 74 75 72  ┆           retur┆
  0x2: 0000  00 00 00 d5 80 03 6e 20 20 03 00 35 20 20 20 20  ┆      n    5    ┆