DataMuseum.dk

top - metrics - download

    Length: 5991 (0x1767)
    Types: TextFile
    Names: »B«

└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
    └─⟦5cb1d1d7f⟧ »DATA« 
        └─⟦3b1ee7bd8⟧ 
            └─⟦this⟧ 

TextFile

with Fonts;
with Lost_Key_Name;
with New_Keys;
with Pipe;
with Window_Io;

package body Single_Selection_Electric_Menus is

    package Raw renames Window_Io.Raw;
    package Key_Ops is new Pipe.Type_Specific_Operations (Raw.Key);
    function "=" (A, B : Raw.Key) return Boolean renames Raw."=";

    task Coupler is
        entry Start;
        entry Read (The_Key : out Raw.Key);
    end Coupler;

    task body Coupler is
        Key_Pipe : Pipe.Handle;
        K : Raw.Key;
    begin
        loop
            select
                accept Start;

                Pipe.Open (Key_Pipe, Pipe.Shared_Read, Lost_Key_Name);
            or
                terminate;
            end select;

            loop
                Key_Ops.Read (Key_Pipe, K);

                select
                    accept Read (The_Key : out Raw.Key) do
                        The_Key := K;
                    end Read;

                    exit when Is_Select_Key (K);
                or
                    terminate;
                end select;
            end loop;
            Pipe.Close (Key_Pipe);
        end loop;
    end Coupler;

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

    -- function Find_Def (First : 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 = First then
    --         return Temp;
    --     else
    --         Temp := Temp.Next;
    --
    --         while Temp /= Def loop
    --             if Temp.First_Char = First then
    --                 return Temp;
    --             else
    --                 Temp := Temp.Next;
    --             end if;
    --         end loop;
    --     end if;
    --
    --     raise Definition_Not_Found;
    -- end Find_Def;

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

    end Add;

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

        Temp : Menu_Definition := Def;
        Next_Line : Positive := Line_Offset + 1;
        Next_Column : Positive := Column_Offset + 1;
    begin
        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 > 80 then
                    Next_Column := Column_Offset + 1;
                end if;
        end case;

        Temp := Temp.Next;

        while Temp /= Def loop
            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 > 80 then
                        Next_Column := Column_Offset + 1;
                    end if;
            end case;

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

    procedure Display (Menu : Window_Type;
                       Definition : Menu_Definition;
                       Column_Offset : Natural;
                       Line_Offset : Natural;
                       Presentation : Layout) is
        Temp_Def : Menu_Definition := Definition;
    begin

        Initialize_Placement (Definition, Column_Offset,
                              Line_Offset, Presentation);

        Window_Io.Position_Cursor (Menu, Temp_Def.Line, Temp_Def.Column);
        Window_Io.Overwrite (Menu, Line_Image (Temp_Def.Elem),
                             Fonts.Inverse_Bold);
        Temp_Def := Temp_Def.Next;

        while Temp_Def /= Definition loop
            Window_Io.Position_Cursor (Menu, Temp_Def.Line, Temp_Def.Column);
            Window_Io.Overwrite
               (Menu, Line_Image (Temp_Def.Elem), Fonts.Normal);

            Temp_Def := Temp_Def.Next;
        end loop;

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

    end Display;

    -- procedure Erase (Menu : Window_Type;
    --                  Definition : Menu_Definition;
    --                  Column_Offset : Natural := 0) is
    --
    --     First_Line : Window_Io.Line_Number := Definition.Line;
    --     Last_Line : Window_Io.Line_Number := Definition.Previous.Line;
    -- begin
    --     for Line in First_Line .. Last_Line loop
    --         Window_Io.Position_Cursor (Menu, Line, Column_Offset + 1);
    --         Window_Io.Delete (Menu, 80);
    --
    --     end loop;
    -- end Erase;

    function Get_User_Selection (Menu : Window_Type;
                                 Definition : Menu_Definition;
                                 Column_Offset : Natural := 0;
                                 Line_Offset : Natural := 0;
                                 Presentation : Layout := Vertical;
                                 Max_Wait : Duration := Duration'Last)
                                return Element is separate;
end Single_Selection_Electric_Menus;