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

⟦6c21b11d0⟧ Ada Source

    Length: 25600 (0x6400)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Single_Selection_Line_Menus, seg_0046ff

Derivation

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

with Io;
with Fonts;
with String_Utilities;
with Job;
with Editor;
with Window_Io;
with New_Keys;
with Window_Utilities;
package body Single_Selection_Line_Menus is

    type Direction is (Forward, Backward);

    Definition_Not_Found : exception;

    package Raw renames Window_Io.Raw;

    function "=" (A, B : Raw.Key) return Boolean renames Raw."=";

    Inverse_Bold : constant Window_Io.Font :=
       Window_Io.Font'(Window_Io.Plain, (Inverse => True, others => False));

    function Make return Menu_Definition is
    begin
        return null;
    end Make;

    procedure Add (E : Element; To : in out Menu_Definition) is
        Temp  : Menu_Definition;
        Image : constant String := Line_Image (E);
    begin
        if To = null then
            To := new Node'(E, 1, Image (Image'First), 1, 1, null, null, null);
            To.Next := To;
            To.Previous := To;
        else
            Temp := To.Previous;
           Temp.Next := new Node'(E, Temp.Elem_Number + 1, Image (Image'First),
                                   1, 1, null, Temp, null);
            Temp.Next.Next := To;
            To.Previous := Temp.Next;
        end if;

    end Add;

    function Max (X, Y : Integer) return Integer is
    begin
        if X > Y then
            return X;
        else
            return Y;
        end if;
    end Max;

    procedure Initialize_Placement (Def           : in Menu_Definition;
                                    Column_Offset :    Natural;
                                    Line_Offset   :    Natural;
                                    Presentation  :    Layout;
                                    Window_Size   :    Positive) is

        Temp        : Menu_Definition := Def;
        Next_Line   : Positive        := Line_Offset + 1;
        Next_Column : Positive        := Column_Offset + 1;

        Number_Of_Elements   : Positive := Def.Previous.Elem_Number;
        Num_First_Column     : Positive;
        Second_Column_Offset : Natural  := 0;
    begin
        if Number_Of_Elements + Line_Offset > Window_Size then
            Num_First_Column     := Number_Of_Elements / 2;
            Second_Column_Offset := (78 - Column_Offset) / 2;
        else
            Num_First_Column := Number_Of_Elements;
        end if;

        Temp.Line   := Next_Line;
        Temp.Column := Next_Column;

        case Presentation is
            when Vertical =>
                Next_Line := Next_Line + 1;
            when Horizontal =>
                Next_Column := Next_Column + Line_Image (Temp.Elem)'Length + 4;

                if Next_Column + Line_Image (Temp.Next.Elem)'Length > 78 then
                    Next_Line   := Next_Line + 1;
                    Next_Column := Column_Offset + 1;
                end if;
        end case;

        Temp := Temp.Next;

        while Temp /= Def loop

            if Temp.Elem_Number > Num_First_Column then
                Num_First_Column := 99999;
                Next_Line        := Line_Offset + 1;
                Next_Column      := Second_Column_Offset + 1;
            end if;

            Temp.Line   := Next_Line;
            Temp.Column := Next_Column;

            case Presentation is
                when Vertical =>
                    if Temp.Elem_Number > Num_First_Column then
                        Num_First_Column := 99999;
                        Next_Line        := Line_Offset + 1;
                        Next_Column      := Second_Column_Offset + 1;
                    else
                        Next_Line := Next_Line + 1;
                    end if;
                when Horizontal =>
                    Next_Column := Next_Column +
                                      Line_Image (Temp.Elem)'Length + 4;

                    if Next_Column + Line_Image (Temp.Next.Elem)'Length >
                       78 then
                        Next_Column := Column_Offset + 1;
                        Next_Line   := Next_Line + 1;
                    end if;
            end case;

            Temp := Temp.Next;
        end loop;
    end Initialize_Placement;

    procedure Display (Menu_Output   : Window_Type;
                       Def           : Menu_Definition;
                       Title         : String  := "";
                       Column_Offset : Natural := 0;
                       Line_Offset   : Natural := 0;
                       Presentation  : Layout  := Vertical) is

        Temp_Def            : Menu_Definition := Def;
        Num_Lines, Num_Cols : Positive;
    begin

        if Def.Current_Node = null then
            Def.Current_Node := Def;
        end if;

        Window_Io.Report_Size (Menu_Output, Num_Lines, Num_Cols);

        Initialize_Placement (Def, Column_Offset, Line_Offset,
                              Presentation, Num_Lines);

        if Title = "" then
            null;
        else
            Window_Io.Position_Cursor
               (Menu_Output, Temp_Def.Line, Temp_Def.Column);
            Window_Io.Overwrite (Menu_Output, Title & ": ", Fonts.Normal);

            Initialize_Placement (Def, Column_Offset + 2, Line_Offset + 2,
                                  Presentation, Num_Lines);


        end if;

        Window_Io.Position_Cursor (Menu_Output, Temp_Def.Line, Temp_Def.Column);
        Window_Io.Overwrite
           (Menu_Output, Line_Image (Temp_Def.Elem), Window_Io.Normal);


        Temp_Def := Temp_Def.Next;

        while Temp_Def /= Def loop
            Window_Io.Position_Cursor
               (Menu_Output, Temp_Def.Line, Temp_Def.Column);
            Window_Io.Overwrite
               (Menu_Output, Line_Image (Temp_Def.Elem), Window_Io.Normal);

            Temp_Def := Temp_Def.Next;
        end loop;

        Window_Io.Position_Cursor (Menu_Output, Temp_Def.Line, Temp_Def.Column);

    end Display;

    function Rotate (Def : Menu_Definition; Arg : Natural; Dir : Direction)
                    return Menu_Definition is
        Temp : Menu_Definition := Def;
    begin
        case Dir is
            when Forward =>
                for I in 1 .. Arg loop
                    Temp := Temp.Next;
                end loop;
            when Backward =>
                for I in 1 .. Arg loop
                    Temp := Temp.Previous;
                end loop;
        end case;

        return Temp;
    end Rotate;

    function Find_Def (C : Character; Def : Menu_Definition)
                      return Menu_Definition is
        Temp : Menu_Definition := Def;
    begin
        if Temp = null then
            raise Definition_Not_Found;
        elsif Temp.First_Char = C then
            return Temp;
        else
            Temp := Temp.Next;

            while Temp /= Def loop
                if Temp.First_Char = C then
                    return Temp;
                else
                    Temp := Temp.Next;
                end if;
            end loop;
        end if;

        raise Definition_Not_Found;
    end Find_Def;

    procedure Hang (Output_Window : Window_Io.File_Type;
                    Input_Window  : Window_Io.File_Type;
                    Key           : Raw.Key) is
        Out_Char : Character;
    begin
        Window_Io.Position_Cursor (Output_Window);
        Window_Io.New_Line (Output_Window, 1);

        if Key = New_Keys.Up then
            Editor.Window.Previous (Repeat => 1);
        elsif Key = New_Keys.Down then
            Editor.Window.Next (Repeat => 1);
        end if;

        Job.Disconnect;
        Window_Utilities.Continue
           (Input_Window  => Input_Window,
            Output_Window => Output_Window,
            Prompt        => "Hit Enter on this window to Reconnect",
            Line          => 1,
            Column        => 1);
    end Hang;

    function Get_Response (Menu_Input  : Window_Type;
                           Menu_Output : Window_Type;
                           Def         : Menu_Definition) return Element is

        Temp_Def : Menu_Definition := Def;

        Character_Stream : Raw.Stream_Type;
        One_Key          : Raw.Key;
        Second_Key       : Raw.Key;

        Numeric_Arg : Natural := 0;

    begin

        loop
            begin
                Raw.Open (Character_Stream);
                exit;
            exception
                when Io.Status_Error =>
                    Window_Io.Position_Cursor (Menu_Output);  
                    Window_Io.New_Line (Menu_Output, 1);

                    Window_Utilities.Continue  
                       (Input_Window => Menu_Input,  
                        Output_Window => Menu_Output,  
                        Prompt => "Hit Enter on this window to Reconnect",  
                        Line => 1,  
                        Column => 1);

            end;

        end loop;

        loop
            Window_Io.Position_Cursor
               (Menu_Output, Def.Current_Node.Line, Def.Current_Node.Column);
            Window_Io.Overwrite
               (Menu_Output, Line_Image (Def.Current_Node.Elem), Inverse_Bold);

            Raw.Get (Character_Stream, One_Key);

            if One_Key = New_Keys.Up or One_Key = New_Keys.Left then

                Window_Io.Position_Cursor (Menu_Output, Def.Current_Node.Line,
                                           Def.Current_Node.Column);
                Window_Io.Overwrite
                   (Menu_Output, Line_Image (Def.Current_Node.Elem),
                    Window_Io.Normal);

                if Numeric_Arg = 0 then
                    Def.Current_Node := Def.Current_Node.Previous;
                else
                    Def.Current_Node := Rotate (Def.Current_Node,
                                                Numeric_Arg, Backward);
                    Numeric_Arg      := 0;
                end if;

                Window_Io.Position_Cursor (Menu_Output, Def.Current_Node.Line,
                                           Def.Current_Node.Column);
                Window_Io.Overwrite
                   (Menu_Output, Line_Image (Def.Current_Node.Elem),
                    Inverse_Bold);

            elsif One_Key = New_Keys.Down or One_Key = New_Keys.Right then

                Window_Io.Position_Cursor (Menu_Output, Def.Current_Node.Line,
                                           Def.Current_Node.Column);
                Window_Io.Overwrite
                   (Menu_Output, Line_Image (Def.Current_Node.Elem),
                    Window_Io.Normal);

                if Numeric_Arg = 0 then
                    Def.Current_Node := Def.Current_Node.Next;
                else
                    Def.Current_Node := Rotate (Def.Current_Node,
                                                Numeric_Arg, Forward);
                    Numeric_Arg      := 0;
                end if;

                Window_Io.Position_Cursor (Menu_Output, Def.Current_Node.Line,
                                           Def.Current_Node.Column);
                Window_Io.Overwrite
                   (Menu_Output, Line_Image (Def.Current_Node.Elem),
                    Inverse_Bold);

            elsif One_Key = New_Keys.Begin_Of then

                Window_Io.Position_Cursor (Menu_Output, Def.Current_Node.Line,
                                           Def.Current_Node.Column);
                Window_Io.Overwrite
                   (Menu_Output, Line_Image (Def.Current_Node.Elem),
                    Window_Io.Normal);

                Def.Current_Node := Def;
                Numeric_Arg      := 0;

                Window_Io.Position_Cursor (Menu_Output, Def.Current_Node.Line,
                                           Def.Current_Node.Column);
                Window_Io.Overwrite
                   (Menu_Output, Line_Image (Def.Current_Node.Elem),
                    Inverse_Bold);

            elsif One_Key = New_Keys.C_M_Up then
                Hang (Menu_Output, Menu_Input, New_Keys.Up);

            elsif One_Key = New_Keys.C_M_Down then
                Hang (Menu_Output, Menu_Input, New_Keys.Down);

            elsif One_Key = New_Keys.Window then
                Raw.Get (Character_Stream, Second_Key);

                if Second_Key = New_Keys.Up then
                    Hang (Menu_Output, Menu_Input, New_Keys.Up);
                elsif Second_Key = New_Keys.Down then
                    Hang (Menu_Output, Menu_Input, New_Keys.Down);
                else
                    Window_Io.Bell (Menu_Output);
                end if;

            elsif New_Keys.Is_Alphabet_Key (One_Key) then
                begin

                    Window_Io.Position_Cursor
                       (Menu_Output, Def.Current_Node.Line,
                        Def.Current_Node.Column);
                    Window_Io.Overwrite
                       (Menu_Output, Line_Image (Def.Current_Node.Elem),
                        Window_Io.Normal);
                    Def.Current_Node :=
                       Find_Def (String_Utilities.Upper_Case
                                    (Window_Io.Raw.Convert (One_Key)),
                                 Def.Current_Node.Next);

                exception
                    when Definition_Not_Found =>
                        Window_Io.Bell (Menu_Output);
                end;

                Window_Io.Position_Cursor (Menu_Output, Def.Current_Node.Line,
                                           Def.Current_Node.Column);
                Window_Io.Overwrite
                   (Menu_Output, Line_Image (Def.Current_Node.Elem),
                    Inverse_Bold);

            elsif One_Key = New_Keys.User_Interrupt then

                null;
                Numeric_Arg := 0;

            elsif One_Key = New_Keys.Definition then

                Raw.Close (Character_Stream, True);
                return Def.Current_Node.Elem;
            elsif New_Keys.Is_Numeric_Arg_Key (One_Key) then
                Numeric_Arg := (Numeric_Arg * 10) +
                                  New_Keys.Numeric_Value (One_Key);
            else
                Raw.Close (Character_Stream);
                Unknown_Key (One_Key, Def.Current_Node.Elem);
                Raw.Open (Character_Stream);
                Numeric_Arg := 0;

            end if;
        end loop;

    end Get_Response;
    procedure Highlight_Element (Menu_Output : Window_Type;
                                 E           : Element;
                                 Def         : Menu_Definition;
                                 Font        : Window_Io.Font) is
        Temp : Menu_Definition := Def;
    begin
        if Temp = null then
            null;
        elsif Temp.Elem = E then
            Window_Io.Position_Cursor (Menu_Output, Temp.Line, Temp.Column);
            Window_Io.Overwrite (Menu_Output, Line_Image (Temp.Elem), Font);
        else
            Temp := Temp.Next;

            while Temp /= Def loop
                if Temp.Elem = E then
                    Window_Io.Position_Cursor
                       (Menu_Output, Temp.Line, Temp.Column);
                    Window_Io.Overwrite (Menu_Output,
                                         Line_Image (Temp.Elem), Font);
                    exit;
                else
                    Temp := Temp.Next;
                end if;
            end loop;
        end if;


    end Highlight_Element;
end Single_Selection_Line_Menus;

    nblk1=18
    nid=0
    hdr6=30
        [0x00] rec0=26 rec1=00 rec2=01 rec3=008
        [0x01] rec0=00 rec1=00 rec2=18 rec3=002
        [0x02] rec0=1b rec1=00 rec2=02 rec3=070
        [0x03] rec0=01 rec1=00 rec2=16 rec3=010
        [0x04] rec0=1d rec1=00 rec2=17 rec3=042
        [0x05] rec0=00 rec1=00 rec2=03 rec3=01e
        [0x06] rec0=18 rec1=00 rec2=04 rec3=02e
        [0x07] rec0=00 rec1=00 rec2=14 rec3=030
        [0x08] rec0=1e rec1=00 rec2=15 rec3=020
        [0x09] rec0=01 rec1=00 rec2=05 rec3=016
        [0x0a] rec0=1f rec1=00 rec2=06 rec3=004
        [0x0b] rec0=1f rec1=00 rec2=07 rec3=034
        [0x0c] rec0=1f rec1=00 rec2=08 rec3=006
        [0x0d] rec0=1d rec1=00 rec2=09 rec3=048
        [0x0e] rec0=01 rec1=00 rec2=13 rec3=01a
        [0x0f] rec0=1a rec1=00 rec2=0a rec3=06a
        [0x10] rec0=16 rec1=00 rec2=0b rec3=04c
        [0x11] rec0=00 rec1=00 rec2=12 rec3=00a
        [0x12] rec0=17 rec1=00 rec2=0c rec3=018
        [0x13] rec0=00 rec1=00 rec2=11 rec3=014
        [0x14] rec0=19 rec1=00 rec2=0d rec3=074
        [0x15] rec0=18 rec1=00 rec2=0e rec3=016
        [0x16] rec0=1a rec1=00 rec2=0f rec3=022
        [0x17] rec0=17 rec1=00 rec2=10 rec3=000
    tail 0x215004eee815c677cab89 0x42a00088462061e03