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

⟦01b4f69e1⟧ TextFile

    Length: 2880 (0xb40)
    Types: TextFile
    Names: »B«

Derivation

└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 

TextFile

with Time_Utilities;
use Time_Utilities;
with Text_Io;
package body Counter is

    Started_Time : Time := Nil;
    type Kind is
        record
            Count_Message : Integer := 0;
            First_Laps : Duration := 0.0;
            Laps : Duration := 0.0;
        end record;

    Total_Count : Integer := 0;
    Elapsed_Time : Duration;
    List_Count : array (Object.Class) of Kind;

    type Myfloat is digits 2;
    Minute : constant := 60.00;


    function Convert_Laps (Laps : Duration) return Integer is
        The_Interval : Interval;
        Total : Myfloat;
    begin
        The_Interval := Convert (Laps);
        Total := Myfloat (The_Interval.Elapsed_Seconds) +
                    (Myfloat (The_Interval.Elapsed_Minutes) * Minute);
        return Integer (Total);
    end Convert_Laps;

    function Get_Max_Message return Integer is
        Max : Integer := 0;
    begin
        for I in List_Count'Range loop
            if List_Count (I).Count_Message > Max then
                Max := List_Count (I).Count_Message;
            end if;
        end loop;
        return Max;
    end Get_Max_Message;

    function Get_Messages (Class : Object.Class) return Integer is
    begin
        return List_Count (Class).Count_Message;
    end Get_Messages;

    function Get_Time (Class : Object.Class) return Integer is
    begin  
        return Convert_Laps (List_Count (Class).Laps);
    end Get_Time;

    function Get_Total_Messages return Integer is
    begin
        return Total_Count;
    end Get_Total_Messages;

    function Get_Real_Time return Integer is
    begin
        if Convert_Laps (Elapsed_Time) > 0 then
            return Convert_Laps (Elapsed_Time);
        else
            return 1;
        end if;
    end Get_Real_Time;

    procedure Start_General_Counter is
    begin
        for I in List_Count'Range loop
            List_Count (I).Count_Message := 0;
            List_Count (I).Laps := 0.0;
        end loop;
        Started_Time := Get_Time;  
        Total_Count := 0;
        Elapsed_Time := 0.0;
    end Start_General_Counter;


    procedure Increase (Class : Object.Class) is
    begin  
        List_Count (Class).Count_Message :=
           List_Count (Class).Count_Message + 1;
        List_Count (Class).First_Laps := -Duration_Until (Started_Time);
    end Increase;


    procedure Stop_Time (Class : Object.Class) is
        Laps_Now : Duration := 0.0;
    begin  
        Laps_Now := -Duration_Until (Started_Time);
        List_Count (Class).Laps :=
           (Laps_Now - List_Count (Class).First_Laps) + List_Count (Class).Laps;
    end Stop_Time;

    procedure State_Message is
    begin
        Elapsed_Time := -Duration_Until (Started_Time);
        for I in List_Count'Range loop
            Total_Count := List_Count (I).Count_Message + Total_Count;
        end loop;
    end State_Message;

end Counter;