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

⟦45eb7e7f7⟧ Ada Source

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

Derivation

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

with Window_Io, Io;
separate (Spreadsheet_Generic)
package body Screen is
    package Wio renames Window_Io;

    package Fonts is
        Vanilla_Attr : constant Window_Io.Attribute := (others => False);
        Faint_Attr   : constant Window_Io.Attribute :=
           (Faint => True, others => False);
        Bold_Attr    : constant Window_Io.Attribute :=
           (Bold => True, others => False);
        Inverse_Attr : constant Window_Io.Attribute :=
           (Inverse => True, others => False);
        Normal       : constant Window_Io.Font      :=
           Window_Io.Font'(Window_Io.Plain, Vanilla_Attr);
        Inverse      : constant Window_Io.Font      :=
           Window_Io.Font'(Window_Io.Plain, Inverse_Attr);  
        High         : constant Window_Io.Font      :=
           Window_Io.Font'(Window_Io.Plain, Bold_Attr);  
    end Fonts;

    Win, Wout : Wio.File_Type;

    procedure Open (Name : String) is
    begin
        Wio.Create (Wout, Name => Name);
        Wio.Open (Win, Mode => Wio.In_File, Name => Name);
    end Open;

    procedure Close is
    begin
        Wio.Close (Win);
        Wio.Close (Wout);
    end Close;

    procedure Cursor (Offset : Integer := 0) is
    begin  
        Wio.Position_Cursor (Wout, Line (Current_Line),
                             1 + Column_Offset (Col (Current_Column)) + Offset);
    end Cursor;


    procedure Normal (S : String) is
    begin
        Wio.Overwrite (Wout, S, Image => Fonts.Normal, Kind => Wio.Protected);
    end Normal;

    procedure Highlight (S : String) is
    begin
        Wio.Overwrite (Wout, S, Image => Fonts.High, Kind => Wio.Protected);
    end Highlight;

    procedure Inverse (S : String) is
    begin
        Wio.Overwrite (Wout, S, Image => Fonts.Inverse, Kind => Wio.Protected);
    end Inverse;

    function Prompt_For (S : String) return String is
        Count : Natural := 0;
    begin
        for X in Col (Current_Column) + 1 .. Column_Number'Last loop
            Count := Count + Actual_Column_Width (X);
        end loop;
        Wio.Overwrite (Wout, S & (Count * ' '),
                       Image => Fonts.Inverse,
                       Kind  => Wio.Prompt);  
        Cursor;
        return Wio.Get_Line (Win, Prompt => "");
    exception
        when Io.End_Error =>
            return "";
    end Prompt_For;

    procedure Mark is
    begin
        Inverse (Display (Line (Current_Line), Col (Current_Column)).all);
        Cursor;
    end Mark;
    procedure Unmark is
    begin
        Normal (Display (Line (Current_Line), Col (Current_Column)).all);
        Cursor;
    end Unmark;

    procedure Refresh is
    begin  
        for L in Line_Number loop
            Wio.Position_Cursor (Wout, L, 1);
            for C in Column_Number loop
                Normal (Display (L, C).all);
            end loop;
        end loop;
        Cursor; -- bring back cursor where it was
    end Refresh;

    procedure Refresh_And_Highlight is
    begin  
        for L in Line_Number loop
            Wio.Position_Cursor (Wout, L, 1);
            for C in Column_Number loop
                if Is_Selected (Line_Type'Val (L - 1),
                                Column_Type'Val (C - 1)) then
                    Highlight (Display (L, C).all);
                else
                    Normal (Display (L, C).all);
                end if;
            end loop;
        end loop;
        Cursor; -- bring back cursor where it was
    end Refresh_And_Highlight;

    procedure Refresh_End_Of_Line is
    begin
        Cursor; -- make sure cursor is where it should be
        for C in Col (Current_Column) .. Column_Number'Last loop
            Normal (Display (Line (Current_Line), C).all);
        end loop;
        Cursor; -- bring back cursor where it was
    end Refresh_End_Of_Line;

    procedure Show (L : Line_Number; C : Column_Number) is
    begin
        if L = Line (Current_Line) and C = Col (Current_Column) then
            Mark;
        else
            Wio.Position_Cursor (Wout, L, Column_Offset (C) + 1);
            Normal (Display (L, C).all);
        end if;
        Cursor;
    end Show;

    procedure Alert (S : String := ""; Beeps : Natural := 2) is
    begin
        if S'Length > 0 then
            Io.Echo_Line (S);
        end if;
        for I in 1 .. Beeps loop
            Wio.Bell (Wout);
        end loop;
    end Alert;
    procedure Banner (F : Field := Status; Text : String := "") is
    begin
        case F is
            when Cursor_Location =>
                Wio.Set_Banner
                   (Wout, Wio.Job_Time,
                    Capitalize ("<" & Line_Type'Image (Current_Line) & "," &
                                Column_Type'Image (Current_Column) & ">"));
            when Status =>
                Wio.Set_Banner (Wout, "Field_3", Text);
        end case;
    end Banner;
end Screen;

    nblk1=7
    nid=0
    hdr6=e
        [0x00] rec0=1b rec1=00 rec2=01 rec3=026
        [0x01] rec0=01 rec1=00 rec2=07 rec3=01e
        [0x02] rec0=22 rec1=00 rec2=02 rec3=05a
        [0x03] rec0=20 rec1=00 rec2=03 rec3=056
        [0x04] rec0=1c rec1=00 rec2=04 rec3=06a
        [0x05] rec0=1e rec1=00 rec2=05 rec3=00a
        [0x06] rec0=03 rec1=00 rec2=06 rec3=000
    tail 0x217002a08815c66fe1e2e 0x42a00088462061e03