DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

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 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ B T

⟦bef1e4ed8⟧ TextFile

    Length: 8963 (0x2303)
    Types: TextFile
    Names: »B«

Derivation

└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
    └─ ⟦124ff5788⟧ »DATA« 
        └─⟦this⟧ 
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
    └─ ⟦6f12a12be⟧ »DATA« 
        └─⟦this⟧ 
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦9b477e385⟧ 
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
    └─ ⟦6f12a12be⟧ »DATA« 
        └─⟦9b477e385⟧ 
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
    └─ ⟦d65440be7⟧ »DATA« 
        └─⟦9b477e385⟧ 
            └─⟦this⟧ 

TextFile

separate (Time_Utilities)
package body Interval_Value is
    function Value (S : String) return Interval is
        -- format is ddDhh:mm:ss.milli
        -- upper or lower case D is a deliminator
        -- all non-numeric non delimiters are ignored
        -- if only one : is given, it is assumed to separate hrs and seconds
        --    10:17 is 10hrs 17min, :10:17 is 0hrs 10min 17sec
        Position : Natural := S'First;
        Result   : Interval;

        type Kind_Value is (Day, Hour, Minute, Second, Millisecond, Number);
        type Item;
        type Item_Ptr   is access Item;

        type Item is
            record
                Kind  : Kind_Value;
                Value : Natural;
                Next  : Item_Ptr;
            end record;

        First_Item : Item_Ptr;
        Last_Item  : Item_Ptr;

        Dot_Observed    : Boolean := False;
        Colons_Observed : Natural := 0;


        function Is_Digit (Char : Character) return Boolean is
        begin
            case Char is
                when '0' .. '9' =>
                    return True;
                when others =>
                    return False;
            end case;
        end Is_Digit;

        function Is_Delimiter (Char : Character) return Boolean is
        begin
            case Char is
                when ':' | 'D' | 'd' | '/' | '.' =>
                    return True;
                when others =>
                    return False;
            end case;
        end Is_Delimiter;

        function Get_Number return Item_Ptr is
            Start : Natural := Position;
            Last  : Natural;

            function Pad_To_Three_Digits (S : String) return Natural is
            begin
                if S'Length = 1 then
                    return Natural'Value (S & "00");
                elsif S'Length = 2 then
                    return Natural'Value (S & '0');
                else
                    return Natural'Value (S (S'First .. S'First + 2));
                end if;
            end Pad_To_Three_Digits;

            function Get_Item (N : Natural) return Item_Ptr is
            begin
                return new Item'(Kind => Number, Value => N, Next => null);
            end Get_Item;
        begin
            while Position <= S'Last and then Is_Digit (S (Position)) loop
                Position := Position + 1;
            end loop;

            if Position <= S'Last then
                Last := Position - 1;
            else
                Last := S'Last;
            end if;

            if Dot_Observed then
                return Get_Item (Pad_To_Three_Digits (S (Start .. Last)));
            else
                return Get_Item (Natural'Value (S (Start .. Last)));
            end if;
        end Get_Number;

        function Get_Item return Item_Ptr is
            Char : Character;

            function Item_Value (Ch : Character) return Item_Ptr is
                Result : Item_Ptr := new Item;
            begin
                case Ch is

                    when 'D' | 'd' | '/' =>
                        Result.Kind := Day;

                    when ':' =>
                        Result.Kind     := Hour;
                        Colons_Observed := Colons_Observed + 1;

                        if Colons_Observed > 2 then
                            raise Constraint_Error;
                        end if;

                    when '.' =>
                        Result.Kind  := Second;
                        Dot_Observed := True;

                    when others =>
                        raise Constraint_Error;
                end case;

                return Result;
            end Item_Value;
        begin
            while Position <= S'Last loop
                Char := S (Position);

                if Is_Delimiter (Char) then
                    Position := Position + 1;
                    return Item_Value (Char);
                elsif Is_Digit (Char) then
                    return Get_Number;
                else
                    Position := Position + 1;
                end if;
            end loop;

            return null;
        end Get_Item;

        procedure Build_List (First, Last : in out Item_Ptr) is
            Next_Item : Item_Ptr;
        begin
            -- build list of items
            Next_Item := Get_Item;
            First     := Next_Item;
            Last      := First;

            loop
                Next_Item := Get_Item;
                exit when Next_Item = null;

                Last.Next := Next_Item;
                Last      := Next_Item;
            end loop;
        end Build_List;

        procedure Normalize (First, Last : in out Item_Ptr) is
            Hour_Item : Item_Ptr;
            Next_Item : Item_Ptr := First;

            procedure Add (Kind : Kind_Value) is
                New_Item : Item_Ptr := new Item'(Kind, 0, null);
            begin
                Last.Next := New_Item;
                Last      := New_Item;
            end Add;
        begin
            if Colons_Observed = 2 or else Dot_Observed then
                -- find right_most hour and make it minute
                while Next_Item /= null loop
                    if Next_Item.Kind = Hour then
                        Hour_Item := Next_Item;
                    end if;

                    Next_Item := Next_Item.Next;
                end loop;

                if Hour_Item /= null then
                    Hour_Item.Kind := Minute;
                end if;
            end if;

            if Last.Kind = Number then
                if Dot_Observed then
                    Add (Millisecond);
                else
                    case Colons_Observed is
                        when 2 =>
                            Add (Second);
                        when 1 =>
                            Add (Minute);
                        when 0 =>
                            Add (Hour);
                        when others =>
                            raise Constraint_Error;
                    end case;
                end if;
            end if;
        end Normalize;

        function Build_Value (First, Last : Item_Ptr) return Interval is
            Number_Kind : constant Kind_Value := Number;

            Result    : Interval := Null_Interval;
            Next_Item : Item_Ptr := First;
            Number    : Natural  := 0;

            procedure Get_Number (Ptr   : in out Item_Ptr;
                                  Value : in out Natural) is
            begin
                if Ptr.Kind = Number_Kind then
                    Value := Ptr.Value;
                    Ptr   := Ptr.Next;
                else
                    Value := 0;
                end if;
            end Get_Number;

            procedure Set_Field (Kind   :        Kind_Value;
                                 Number :        Natural;
                                 Result : in out Interval) is
                Value : Natural := Number;
            begin
                if Value = 0 then
                    return;
                end if;

                case Next_Item.Kind is

                    when Day =>
                        Result.Elapsed_Days :=
                           Result.Elapsed_Days + Day_Count (Value);

                    when Hour =>
                        Value := Value + Natural (Result.Elapsed_Hours);
                        Set_Field (Day, Value / 24, Result);
                        Result.Elapsed_Hours := Military_Hours (Value mod 24);

                    when Minute =>
                        Value := Value + Natural (Result.Elapsed_Minutes);
                        Set_Field (Hour, Value / 60, Result);
                        Result.Elapsed_Minutes := Minutes (Value mod 60);

                    when Second =>
                        Value := Value + Natural (Result.Elapsed_Seconds);
                        Set_Field (Minute, Value / 60, Result);
                        Result.Elapsed_Seconds := Seconds (Value mod 60);

                    when Millisecond =>
                        Value := Value + Natural (Result.Elapsed_Milliseconds);
                        Set_Field (Second, Value / 1000, Result);
                        Result.Elapsed_Milliseconds :=
                           Milliseconds (Value mod 1000);

                    when others =>
                        raise Constraint_Error;
                end case;
            end Set_Field;

        begin
            while Next_Item /= null loop
                Get_Number (Next_Item, Number);
                -- increments next_item (if appropriate)

                Set_Field (Next_Item.Kind, Number, Result);
                Next_Item := Next_Item.Next;
            end loop;

            return Result;
        end Build_Value;
    begin
        Build_List (First_Item, Last_Item);
        Normalize (First_Item, Last_Item);
        return Build_Value (First_Item, Last_Item);
    end Value;
end Interval_Value;