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

⟦3189f6868⟧ Ada Source

    Length: 8192 (0x2000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, generic, package body Tool_Set, seg_0046c1, separate Spreadsheet_Generic

Derivation

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

with String_Utilities, Io;
separate (Spreadsheet_Generic)
package body Tool_Set is

    package Su renames String_Utilities;
    package Fio is new Io.Float_Io (Float);
    package Iio is new Io.Integer_Io (Integer);

    function "*" (Width : Integer; C : Character) return String is
        Result : constant String (1 .. Width) := (1 .. Width => C);
    begin
        return Result;
    end "*";

    function Left_Align (S : String; Width : Natural) return String is
        Temp : constant String (1 .. S'Length + Width) :=
           S & String'(1 .. Width => ' ');
    begin
        return Temp (1 .. Width);
    end Left_Align;

    function Right_Align (S : String; Width : Natural) return String is
        Temp : constant String (1 .. S'Length + Width) :=
           String'(1 .. Width => ' ') & S;
    begin
        return Temp (Temp'Last - Width + 1 .. Temp'Last);
    end Right_Align;

    function Center (S : String; Width : Natural) return String is
        Temp : constant String := Su.Strip (S);
    begin
        return Left_Align ((((Width - Temp'Length) / 2) * ' ') & Temp, Width);
    end Center;
    function Capitalize (S : String) return String is
    begin
        return Su.Capitalize (S);
    end Capitalize;

    generic  
        type Number is private;
        Zero : in Number;
        with procedure Get_Literal (From :     String;
                                    Item : out Number;
                                    Last : out Integer);
        with function  "+"         (X, Y : Number) return Number is <>;
        with function  "-"         (X, Y : Number) return Number is <>;
        with function  "*"         (X, Y : Number) return Number is <>;
        with function  "/"         (X, Y : Number) return Number is <>;
    function Evaluator (S : String) return Number;

    function Evaluator (S : String) return Number is separate;

    procedure Get_Float_Literal
                 (X : String; Item : out Float; Last : out Integer) is
        Int : Integer;
        L   : Integer;
    begin  
        Iio.Get (X, Int, L);
        case X (L + 1) is
            when '.' | 'e' | 'E' =>
                Fio.Get (X, Item, Last);
            when others =>
                Item := Float (Int);
                Last := L;
        end case;
    end Get_Float_Literal;

    function Float_Evaluator   is new Evaluator (Float, 0.0, Get_Float_Literal);
    function Integer_Evaluator is new Evaluator (Integer, 0, Iio.Get);

    function Float_Value (Expression : String) return Float is
    begin
        return Float_Evaluator (Expression);
    end Float_Value;

    function Integer_Value (Expression : String) return Integer is
    begin
        return Integer_Evaluator (Expression);
    end Integer_Value;


    function Image (F             : Float;
                    Width         : Natural;
                    Aft           : Natural := 2;
                    Exp           : Natural := 0;
                    Blank_If_Zero : Boolean := False) return String is
        Buf : String (1 .. Width);
    begin  
        if Blank_If_Zero and then ((abs F) <= Float'Epsilon) then
            return Width * ' ';
        end if;
        Fio.Put (To => Buf, Item => F, Aft => Aft, Exp => Exp);
        return Buf;
    exception
        when others =>
            return ' ' & (Width - 1) * '*';
    end Image;

    function Image (I             : Integer;
                    Width         : Natural;
                    K_Or_M_Suffix : Boolean := False;
                    Blank_If_Zero : Boolean := False) return String is
        Buf : String (1 .. Width);
    begin  
        if Blank_If_Zero and then (I = 0) then
            return Width * ' ';
        end if;
        Iio.Put (To => Buf, Item => I);
        return Buf;
    exception
        when others =>
            Buf := Width * '*';
            if K_Or_M_Suffix then
                if I > 1E6 then
                    Iio.Put (To => Buf (1 .. Width - 1), Item => I / 1E6);
                    Buf (Buf'Last) := 'M';
                elsif I > 1E3 then
                    Iio.Put (To => Buf (1 .. Width - 1), Item => I / 1E3);
                    Buf (Buf'Last) := 'K';
                end if;
            end if;
            return Buf;
    end Image;

    function Ask_For (Question : String) return String is
    begin
        Io.Put (Question);
        return Io.Get_Line;
    end Ask_For;

    procedure Alert (S : String; Beeps : Natural := 2) is
    begin  
        Screen.Alert (S, Beeps);
    end Alert;

end Tool_Set;

    nblk1=7
    nid=0
    hdr6=e
        [0x00] rec0=1e rec1=00 rec2=01 rec3=074
        [0x01] rec0=19 rec1=00 rec2=02 rec3=016
        [0x02] rec0=00 rec1=00 rec2=07 rec3=048
        [0x03] rec0=1f rec1=00 rec2=03 rec3=030
        [0x04] rec0=00 rec1=00 rec2=06 rec3=008
        [0x05] rec0=1d rec1=00 rec2=04 rec3=008
        [0x06] rec0=17 rec1=00 rec2=05 rec3=000
    tail 0x215004a3a815c6700420c 0x42a00088462061e03