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

⟦2e79d1aec⟧ Ada Source

    Length: 11264 (0x2c00)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Multiple_Selection_Object_Editor_Menu, seg_0046fb

Derivation

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

with New_Keys, Fonts, Window_Utilities;
with Window_Io;
with Set_Generic;
package body Multiple_Selection_Object_Editor_Menu is

    package Element_Set is new Set_Generic (Element);

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

    function Find_Def (E : Element; Menu_Def : Menu_Definition)
                      return Menu_Definition is
        Temp : Menu_Definition := Menu_Def;
    begin
        if Temp = null or Temp.Elem = E then
            return Temp;
        end if;

        Temp := Temp.Next;

        while Temp /= Menu_Def loop
            if Temp.Elem = E then
                return Temp;
            else
                Temp := Temp.Next;
            end if;
        end loop;

        return Menu_Def;
    end Find_Def;

    function Get_Tail (Def : Menu_Definition) return Menu_Definition is
        Temp : Menu_Definition := Def;
    begin
        if Temp = null then
            return Temp;
        else
            loop
                if Temp.Next = Def then
                    return Temp;
                else
                    Temp := Temp.Next;
                end if;
            end loop;
        end if;
    end Get_Tail;

    procedure Add (E : Element; To : in out Menu_Definition) is
        Temp : Menu_Definition := Get_Tail (To);
    begin
        if To = null then
            To          := new Menu_Node'(E, 1, null, null);
            To.Next     := To;
            To.Previous := To;
        else
            Temp.Next := new Menu_Node'(E, Temp.Line_Number + 1, null, Temp);
            Temp.Next.Next := To;
            To.Previous := Temp.Next;
        end if;

    end Add;

    procedure Display_Menu (Menu       : Menu_Window;
                            Font       : Window_Io.Font := Window_Io.Normal;
                            Definition : Menu_Definition) is

        Temp_Def : Menu_Definition := Definition;

    begin
        Window_Utilities.Home (Menu);
        Window_Utilities.Erase (Menu);
        Window_Utilities.Home (Menu);

        Window_Io.Insert (Menu, Line_Image (Temp_Def.Elem), Font);
        Window_Io.New_Line (Menu, 1);
        Temp_Def := Temp_Def.Next;

        while Temp_Def /= Definition loop
            Window_Io.Insert (Menu, Line_Image (Temp_Def.Elem), Font);
            Window_Io.New_Line (Menu, 1);
            Temp_Def := Temp_Def.Next;
        end loop;

        Window_Io.Position_Cursor (Menu);

    end Display_Menu;

    procedure Create (Menu       : Menu_Window;
                      Font       : Window_Io.Font := Window_Io.Normal;
                      Definition : Menu_Definition) is

        Current_Node : Menu_Definition := Definition;

        Set_Iterator : Element_Set.Iterator;
        My_Set       : Element_Set.Set;

        Iterator_Node : Menu_Definition;

        Selected_Font : Window_Io.Font := Fonts.Inverse_Bold;

        Redisplay_Necessary : Boolean;

        package Raw renames Window_Io.Raw;
        Character_Stream : Raw.Stream_Type;

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

        Display_Menu (Menu, Font, Definition);
        Raw.Open (Character_Stream);

        Element_Set.Initialize (My_Set);

        loop
            Raw.Get (Character_Stream, One_Key);

            if One_Key = New_Keys.Up then
                Current_Node := Current_Node.Previous;
                Window_Io.Position_Cursor (Menu, Current_Node.Line_Number);

            elsif One_Key = New_Keys.Down then
                Current_Node := Current_Node.Next;
                Window_Io.Position_Cursor (Menu, Current_Node.Line_Number);

            elsif One_Key = New_Keys.Left then
                Element_Set.Add (My_Set, Current_Node.Elem);
                Window_Io.Overwrite
                   (Menu, Line_Image (Current_Node.Elem), Selected_Font);
                Window_Io.Position_Cursor (Menu, Current_Node.Line_Number);

            elsif One_Key = New_Keys.Right then
                Element_Set.Delete (My_Set, Current_Node.Elem);
                Window_Io.Overwrite
                   (Menu, Line_Image (Current_Node.Elem), Font);
                Window_Io.Position_Cursor (Menu, Current_Node.Line_Number);

            elsif One_Key = New_Keys.Characters ('.') then
                Element_Set.Init (Set_Iterator, My_Set);

                while not Element_Set.Done (Set_Iterator) loop
                    Iterator_Node :=
                       Find_Def (Element_Set.Value (Set_Iterator), Definition);
                    Window_Io.Position_Cursor (Menu, Iterator_Node.Line_Number);
                    Window_Io.Overwrite
                       (Menu, Line_Image (Iterator_Node.Elem), Font);
                    Element_Set.Next (Set_Iterator);
                end loop;

                Window_Io.Position_Cursor (Menu, Current_Node.Line_Number);

                Element_Set.Make_Empty (My_Set);
            elsif Is_Applicative_Key (One_Key) then
                Raw.Close (Character_Stream);

                if Element_Set.Is_Empty (My_Set) then
                    Apply (One_Key, Current_Node.Elem);
                    Window_Io.Overwrite
                       (Menu, Line_Image (Current_Node.Elem), Font);
                else
                    Element_Set.Init (Set_Iterator, My_Set);
                    Element_Set.Make_Empty (My_Set);

                    while not Element_Set.Done (Set_Iterator) loop
                        Iterator_Node :=
                           Find_Def (Element_Set.Value (Set_Iterator),
                                     Definition);
                        Apply (One_Key, Iterator_Node.Elem);
                        Element_Set.Add (My_Set, Iterator_Node.Elem);
                        Window_Io.Position_Cursor (Menu,
                                                   Iterator_Node.Line_Number);
                        Window_Io.Overwrite
                           (Menu, Line_Image (Iterator_Node.Elem),
                            Selected_Font);
                        Element_Set.Next (Set_Iterator);
                    end loop;
                end if;

                Window_Io.Position_Cursor (Menu, Current_Node.Line_Number);

                Raw.Open (Character_Stream);
            elsif Is_Executable_Key (One_Key) then
                Raw.Close (Character_Stream);
                Execute (One_Key, Redisplay_Necessary);

                if Redisplay_Necessary then
                    raise Redisplay_Required;
                else
                    null;
                end if;

                Window_Io.Position_Cursor (Menu, Current_Node.Line_Number);
                Raw.Open (Character_Stream);
            elsif One_Key = New_Keys.User_Interrupt then
                null;
            elsif One_Key = Quit_Key then
                Raw.Close (Character_Stream);
                exit;
            else
                Window_Io.Bell (Menu);
            end if;

        end loop;
    end Create;

end Multiple_Selection_Object_Editor_Menu;

    nblk1=a
    nid=0
    hdr6=14
        [0x00] rec0=27 rec1=00 rec2=01 rec3=004
        [0x01] rec0=1f rec1=00 rec2=02 rec3=03a
        [0x02] rec0=00 rec1=00 rec2=0a rec3=01a
        [0x03] rec0=20 rec1=00 rec2=03 rec3=050
        [0x04] rec0=00 rec1=00 rec2=09 rec3=00c
        [0x05] rec0=1e rec1=00 rec2=04 rec3=02a
        [0x06] rec0=13 rec1=00 rec2=05 rec3=024
        [0x07] rec0=16 rec1=00 rec2=06 rec3=030
        [0x08] rec0=18 rec1=00 rec2=07 rec3=03e
        [0x09] rec0=0d rec1=00 rec2=08 rec3=000
    tail 0x215004e9a815c6771fe7b 0x42a00088462061e03