DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

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 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ B T

⟦bf987c707⟧ TextFile

    Length: 10239 (0x27ff)
    Types: TextFile
    Names: »B«

Derivation

└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 

TextFile

with Class_String;
with Class_Printer;
with Class_Integer;
with Block;
with Bounded_String;
with String_Utilities;
with Bug_Report;

package body Class_Window is

    function Send (This_Message : Message.Keyword; To : Object.Reference)
                  return Object.Reference is
        type E_Message is (Tonnom, Tonx, Tony, Talargeur, Tahauteur);

        Token : E_Message;

        package Bs renames Bounded_String;
        package Su renames String_Utilities;

        Mess : Message.Keyword := This_Message;

        use Object;

    begin  
        Message.Init (This => Mess);

        while not Message.Is_Done_Name (Mess) loop  
            Token := E_Message'Value (Bs.Image
                                         (Message.Get (Name_From => Mess)));
            case Token is
                when Tonnom =>
                    if Object.Get (Class_From =>
                                      Message.Get (Argument_From => Mess)) =
                       Object.String_Class then
                        Easy_Y.Put_Title
                           (Table (Object.Get (Index_From => To)),
                            Class_String.Get
                               (Object.Get
                                   (Index_From =>
                                       Message.Get (Argument_From => Mess))));
                    else
                        raise Bug_Report.Window_Bad_Type;
                    end if;
                when Tonx =>
                    if Object.Get (Class_From =>
                                      Message.Get (Argument_From => Mess)) =
                       Object.Integer_Class then
                        Easy_Y.Put_Left
                           (Table (Object.Get (Index_From => To)),
                            Object.Get (Index_From =>
                                           Message.Get
                                              (Argument_From => Mess)));
                    else
                        raise Bug_Report.Window_Bad_Type;
                    end if;
                when Tony =>
                    if Object.Get (Class_From =>
                                      Message.Get (Argument_From => Mess)) =
                       Object.Integer_Class then
                        Easy_Y.Put_Right
                           (Table (Object.Get (Index_From => To)),
                            Object.Get (Index_From =>
                                           Message.Get
                                              (Argument_From => Mess)));
                    else
                        raise Bug_Report.Window_Bad_Type;
                    end if;
                when Talargeur =>
                    if Object.Get (Class_From =>
                                      Message.Get (Argument_From => Mess)) =
                       Object.Integer_Class then
                        Easy_Y.Put_Width
                           (Table (Object.Get (Index_From => To)),
                            Object.Get (Index_From =>
                                           Message.Get
                                              (Argument_From => Mess)));
                    else
                        raise Bug_Report.Window_Bad_Type;
                    end if;
                when Tahauteur =>
                    if Object.Get (Class_From =>
                                      Message.Get (Argument_From => Mess)) =
                       Object.Integer_Class then
                        Easy_Y.Put_Height
                           (Table (Object.Get (Index_From => To)),
                            Object.Get (Index_From =>
                                           Message.Get
                                              (Argument_From => Mess)));
                    else
                        raise Bug_Report.Window_Bad_Type;
                    end if;
            end case;
            Message.Next (Mess);
        end loop;  
        return To;
    exception
        when Constraint_Error =>
            raise Bug_Report.Unknown_Keyword_Message;
    end Send;

    function Send (This_Message : Message.Binary; To : Object.Reference)
                  return Object.Reference is
    begin
        raise Bug_Report.Unknown_Binary_Message;
        return Object.Void_Reference;
    end Send;

    function Send (This_Message : Message.Unary; To : Object.Reference)
                  return Object.Reference is
        type E_Message is (Dupliquetoi, Tonnom, Tonx, Tony, Talargeur,
                           Tahauteur, Affichetoi, Cachetoi, Entexte);

        Token : E_Message;

        package Bs renames Bounded_String;

    begin
        Token := E_Message'Value (Bs.Image
                                     (Message.Get (Name_From => This_Message)));
        case Token is
            when Dupliquetoi =>
                return Create (From => Table (Object.Get (Index_From => To)));
            when Tonnom =>
                return Class_String.Create
                          (Easy_Y.Get_Title
                              (Table (Object.Get (Index_From => To))));
            when Tonx =>
                return Class_Integer.Create
                          (Easy_Y.Get_Left
                              (Table (Object.Get (Index_From => To))));
            when Tony =>
                return Class_Integer.Create
                          (Easy_Y.Get_Right
                              (Table (Object.Get (Index_From => To))));
            when Talargeur =>
                return Class_Integer.Create
                          (Easy_Y.Get_Width
                              (Table (Object.Get (Index_From => To))));
            when Tahauteur =>
                return Class_Integer.Create
                          (Easy_Y.Get_Height
                              (Table (Object.Get (Index_From => To))));
            when Affichetoi =>
                Easy_Y.Open (Bounded_String.Image (Terminal_Name),
                             Table (Object.Get (Index_From => To)));
                Easy_Y.Update;
                return To;
            when Cachetoi =>
                Easy_Y.Close (Table (Object.Get (Index_From => To)));
                return To;
            when Entexte =>
                Put (To);
                return To;
        end case;
    exception
        when Constraint_Error =>
            raise Bug_Report.Unknown_Unary_Message;
    end Send;

    function Create (From : Easy_Y.Window_Type) return Object.Reference is
        use Object;
    begin
        Last := Last + 1;  
        Easy_Y.Put_Title (Table (Last), Easy_Y.Get_Title (From));
        Easy_Y.Put_Left (Table (Last), Easy_Y.Get_Left (From));
        Easy_Y.Put_Right (Table (Last), Easy_Y.Get_Right (From));
        Easy_Y.Put_Width (Table (Last), Easy_Y.Get_Width (From));
        Easy_Y.Put_Height (Table (Last), Easy_Y.Get_Height (From));
        return Object.Create (Class => Object.Window_Class, Object => Last);
    exception
        when Constraint_Error =>
            raise Bug_Report.Full_Block_Table;
    end Create;

    procedure Create is
        use Object;
        Node : Block.Node := Block.Get_Current_Node;
    begin
        Last := Last + 1;
        Block.Put_Into_Table
           (This_Object => Object.Create
                              (Class => Object.Window_Class, Object => Last),
            Named => Bounded_String.Value ("fenetre", 80),
            Into_Block => Node);
        Easy_Y.Put_Title (Table (1), Bounded_String.Value ("Tiny Talk", 80));
        Easy_Y.Open (Bounded_String.Image (Terminal_Name), Table (1));
        Easy_Y.Update;
    end Create;

    function Get (Index : Object.Index) return Easy_Y.Window_Type is
    begin
        return Table (Index);
    end Get;

    procedure Put (Window : Easy_Y.Window_Type; Index : Object.Index) is
    begin
        Table (Index) := Window;
    end Put;

    function Get_Terminal_Name return Object.Tiny_String is
    begin
        return Terminal_Name;
    end Get_Terminal_Name;

    procedure Put_Terminal_Name (What : Object.Tiny_String) is
    begin
        Bounded_String.Copy (Terminal_Name, What);
    end Put_Terminal_Name;

    procedure Put (An_Object : Object.Reference) is
    begin
        Class_Printer.Put ("Objet Fenetre {");
        Class_Printer.Forward (4);
        Class_Printer.New_Line;
        Class_Printer.Put ("Numero => " &
                           Object.Index'Image (Object.Get
                                                  (Index_From => An_Object)));
        Class_Printer.New_Line;
        Class_Printer.Put
           ("Title => " & '"' &
            Bounded_String.Image
               (Easy_Y.Get_Title (Table (Object.Get (An_Object)))) & '"');
        Class_Printer.New_Line;
        Class_Printer.Put ("X => " &
                           Object.Index'Image
                              (Easy_Y.Get_Left (Table
                                                   (Object.Get (An_Object)))));
        Class_Printer.New_Line;
        Class_Printer.Put ("Y => " &
                           Object.Index'Image
                              (Easy_Y.Get_Right (Table
                                                    (Object.Get (An_Object)))));
        Class_Printer.New_Line;
        Class_Printer.Put ("Largeur => " &
                           Object.Index'Image
                              (Easy_Y.Get_Width (Table
                                                    (Object.Get (An_Object)))));
        Class_Printer.New_Line;
        Class_Printer.Put ("Hauteur => " &
                           Object.Index'Image
                              (Easy_Y.Get_Height
                                  (Table (Object.Get (An_Object)))));
--        Class_Printer.New_Line;
--        Class_Printer.Put ("Block => ");
--        Class_Printer.Forward (4);
--        Class_Printer.New_Line;
--        Class_Block.Put
--           (Object.Create
--               (Class => Object.Block_Class,
--                Object => Table (Object.Get (Index_From => An_Object)).Block));
--        Class_Printer.Backward (8);
        Class_Printer.New_Line;
        Class_Printer.Backward (4);
        Class_Printer.Put_Tab ("}");
        Class_Printer.New_Line (2);
    end Put;

end Class_Window;