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

⟦60f0a6ccd⟧ Ada Source

    Length: 8192 (0x2000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Items_A, seg_0488d3

Derivation

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

with Tree, List, String_Utilities, Unbounded_String;


package body Items_A 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_A;

    nblk1=7
    nid=0
    hdr6=e
        [0x00] rec0=23 rec1=00 rec2=01 rec3=076
        [0x01] rec0=22 rec1=00 rec2=02 rec3=040
        [0x02] rec0=1d rec1=00 rec2=03 rec3=01e
        [0x03] rec0=1a rec1=00 rec2=04 rec3=02e
        [0x04] rec0=1d rec1=00 rec2=05 rec3=036
        [0x05] rec0=21 rec1=00 rec2=06 rec3=034
        [0x06] rec0=03 rec1=00 rec2=07 rec3=000
    tail 0x21545d30e865a3de057cb 0x42a00088462060003